Browse files

Add X-Hails-Sensitive header if result label is above lpub

  • Loading branch information...
1 parent 8aa09ec commit cddd217c3cc628a8430400e6b42d10fd221199a1 @alevy alevy committed Apr 30, 2012
Showing with 14 additions and 7 deletions.
  1. +14 −7 Hails/HttpServer.hs
View
21 Hails/HttpServer.hs
@@ -49,15 +49,22 @@ httpApp authFunc lrh = mkInumM $ do
| otherwise -> do
let userLabel = newDC (appUser appC) (<>)
req = appReq appC
+ body <- inumHttpBody req .| pureI
-- Set current label to be public, clearance to the user's label
-- and privilege to the app's privilege.
- liftLIO $ do taint lpub
- lowerClr userLabel
- setPrivileges (appPriv appC)
- body <- inumHttpBody req .| pureI
- -- TODO: catch exceptions:
- resp <- liftLIO $ lrh req (labelTCB (newDC (<>) (appUser appC)) body)
- resultLabel <- liftLIO getLabel
+ (resp, resultLabel) <- liftLIO $ do
+ lowerClr userLabel
+ setPrivileges (appPriv appC)
+ -- TODO: catch exceptions:
+ respRaw <- lrh req (labelTCB (newDC (<>) (appUser appC)) body)
+ resultLabel <- getLabel
+ let resp = if resultLabel `leq` lpub
+ then respRaw
+ else respRaw {
+ respHeaders =
+ ("X-Hails-Sensitive", "Yes"):(respHeaders respRaw)
+ }
+ return (resp, resultLabel)
return $ if resultLabel `leq` userLabel
then resp
else resp500 "App violated IFC"

0 comments on commit cddd217

Please sign in to comment.