Skip to content

Commit

Permalink
Made encryption work for pdf-driver
Browse files Browse the repository at this point in the history
  • Loading branch information
Mike Dodds committed Oct 23, 2020
1 parent 83c4b03 commit 91bce41
Show file tree
Hide file tree
Showing 3 changed files with 81 additions and 38 deletions.
1 change: 1 addition & 0 deletions .gitignore
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,3 +6,4 @@ dist
/test-parser-gen-output
.*.swp
/icc_tests
.DS_Store
38 changes: 18 additions & 20 deletions pdf-driver/src/dom/Main.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -53,28 +53,26 @@ main =
ParseOk a -> pure a
ParseAmbig {} -> quit "BUG: Ambiguous result"
ParseErr e -> quit (show (pp e))

makeEncContext (Ref ro rg) =
case (getField @"encrypt" trail, getField @"id" trail) of
(Nothing, _) -> pure Nothing
(Just d, Just id) -> do
enc <- run (pEncryptionDict d) Nothing
let len = fromIntegral $ getField @"encLength" enc
encO = vecToRep $ getField @"encO" enc
encP = fromIntegral $ getField @"encP" enc
firstid = vecToRep $ getField @"firstid" id
-- XXX: note the hardcoded password here
filekey = makeFileKey len (password opts) encO encP firstid
pure $ Just EncContext { key = filekey
, keylen = len
, robj = fromIntegral ro
, rgen = fromIntegral rg
}
(_, Nothing) -> quit "BUG: Missing ID field"

fileEC <- case (getField @"encrypt" trail, getField @"id" trail) of
(Nothing, _) -> pure Nothing
(Just d, Just id) -> do
enc <- run (pEncryptionDict d) Nothing
let len = fromIntegral $ getField @"encLength" enc
encO = vecToRep $ getField @"encO" enc
encP = fromIntegral $ getField @"encP" enc
firstid = vecToRep $ getField @"firstid" id
filekey = makeFileKey len (password opts) encO encP firstid
pure $ Just EncContext { key = filekey, keylen = len }
(_, Nothing) -> quit "BUG: Missing ID field"

let makeEncContext (Ref ro rg) =
case fileEC of
Nothing -> Nothing
Just ec -> Just (ec { robj = fromIntegral ro, rgen = fromIntegral rg } )

ppRef pref r =
do ec <- makeEncContext r
res <- runParser refs ec (pResolveRef r) topInput
do res <- runParser refs (makeEncContext r) (pResolveRef r) topInput
case res of
ParseOk a ->
case a of
Expand Down
80 changes: 62 additions & 18 deletions pdf-driver/src/driver/Main.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -17,14 +17,19 @@ import Text.PrettyPrint hiding ((<>))
import Control.Monad(when)
import Control.Monad.IO.Class(MonadIO(..))
import Control.Exception(evaluate)
import RTS.Vector(vecFromRep,vecToString)
import RTS.Vector(vecFromRep,vecToString,vecToRep)
import RTS.Input

import Common
import PdfMonad
import XRef
import PdfParser
import PdfDemo
import Primitives.Decrypt(makeFileKey)

import Debug.Trace

defaultPW = BS.pack "password"

main :: IO ()
main =
Expand Down Expand Up @@ -126,14 +131,30 @@ fmtDriver fmt file =
Just r -> pure r
rootFound fmt root

res <- runParser refs (pCatalogIsOK root) topInput
res <- runParser refs Nothing (pCatalogIsOK root) topInput
case res of
ParseOk ok -> catalogOK fmt ok
ParseAmbig _ -> error "BUG: Validation of the catalog is ambiguous?"
ParseErr e -> catalogParseError fmt e

mapM_ (checkDecl fmt topInput refs) (Map.toList refs)
-- XXX: ugly hack to make it work quickly
fileEC <- case (getField @"encrypt" trail, getField @"id" trail) of
(Nothing, _) -> pure Nothing
(Just d, Just id) -> do
enc <-
do res <- runParser refs Nothing (pEncryptionDict d) topInput
case res of
ParseOk ok -> pure ok
_ -> error "BUG: bad encryption dictionary"
let len = fromIntegral $ getField @"encLength" enc
encO = vecToRep $ getField @"encO" enc
encP = fromIntegral $ getField @"encP" enc
firstid = vecToRep $ getField @"firstid" id
filekey = makeFileKey len defaultPW encO encP firstid
pure $ Just EncContext { key = filekey, keylen = len }
(_, Nothing) -> error "BUG: Missing ID field"

mapM_ (checkDecl fmt fileEC topInput refs) (Map.toList refs)



Expand All @@ -147,17 +168,17 @@ data DeclResult' a = DeclResult
, declResult :: a
}

parseDecl :: DbgMode => Input -> ObjIndex -> (R, ObjLoc) -> IO DeclResult
parseDecl topInput refMap (ref,loc) =
parseDecl :: DbgMode => Maybe EncContext -> Input -> ObjIndex -> (R, ObjLoc) -> IO DeclResult
parseDecl fileEC topInput refMap (ref,loc) =
do start <- getCPUTime
result <- evaluate =<< runParser refMap parser topInput
result <- evaluate =<< runParser refMap objEC parser topInput
end <- getCPUTime
pure DeclResult { declTime = fromIntegral ((end-start) `div` (10^(6::Int)))
, declCompressed = compressed
, declResult = result
}
where
(parser,compressed) =
(parser,compressed,objEC) =
case loc of

InFileAt off ->
Expand All @@ -168,6 +189,10 @@ parseDecl topInput refMap (ref,loc) =
Nothing -> pError' FromUser []
("XRef entry outside file: " ++ show off)
, False
, case fileEC of
Nothing -> Nothing
Just ec -> Just (ec { robj = (fromIntegral (refObj ref)),
rgen = (fromIntegral (refGen ref)) } )
)

InObj o idx ->
Expand All @@ -177,15 +202,17 @@ parseDecl topInput refMap (ref,loc) =
(toInteger (refGen o))
(toInteger idx)
, True
, Nothing
)

--------------------------------------------------------------------------------




checkDecl :: DbgMode => Format -> Input -> ObjIndex -> (R, ObjLoc) -> IO ()
checkDecl fmt topInput refMap d@(ref,loc) =
do res <- parseDecl topInput refMap d
checkDecl :: DbgMode => Format -> Maybe EncContext -> Input -> ObjIndex -> (R, ObjLoc) -> IO ()
checkDecl fmt ec topInput refMap d@(ref,loc) =
do res <- parseDecl ec topInput refMap d
case declResult res of
ParseAmbig {} -> error "BUG: Ambiguous parse?"
ParseErr e -> declErr fmt ref loc res { declResult = e }
Expand All @@ -203,33 +230,50 @@ driver opts = runReport opts $
("unable to find %%EOF" <+> parens (text err))
Right idx -> return idx

(refs, root) <-
(refs, root, trail) <-
liftIO (parseXRefs topInput idx) >>= \res ->
case res of
ParseOk (r,t) -> case getField @"root" t of
Nothing ->
reportCritical file 0 "Missing document root"

Just ro -> pure (r,ro)
Just ro -> pure (r,ro,t)
ParseAmbig _ ->
reportCritical file 0 "Ambiguous results?"
ParseErr e ->
reportCritical file (peOffset e) (ppParserError e)

res <- liftIO (runParser refs (pCatalogIsOK root) topInput)
res <- liftIO (runParser refs Nothing (pCatalogIsOK root) topInput)
case res of
ParseOk True -> report RInfo file 0 "Catalog (page tree) is OK"
ParseOk False -> report RUnsafe file 0 "Catalog (page tree) contains cycles"
ParseAmbig _ -> report RError file 0 "Ambiguous results?"
ParseErr e -> report RError file (peOffset e) (hang "Parsing Catalog/Page tree" 2 (ppParserError e))

parseObjs file topInput refs

parseObjs :: DbgMode => FilePath -> Input -> ObjIndex -> ReportM ()
parseObjs fileN topInput refMap = mapM_ doOne (Map.toList refMap)
-- XXX: ugly hack to make it work quickly
fileEC <- case (getField @"encrypt" trail, getField @"id" trail) of
(Nothing, _) -> pure Nothing
(Just d, Just id) -> do
enc <-
do res <- liftIO (runParser refs Nothing (pEncryptionDict d) topInput)
case res of
ParseOk ok -> pure ok
_ -> error "BUG: bad encryption dictionary"
let len = fromIntegral $ getField @"encLength" enc
encO = vecToRep $ getField @"encO" enc
encP = fromIntegral $ getField @"encP" enc
firstid = vecToRep $ getField @"firstid" id
filekey = makeFileKey len defaultPW encO encP firstid
pure $ Just EncContext { key = filekey, keylen = len }
(_, Nothing) -> error "BUG: Missing ID field"

parseObjs file fileEC topInput refs

parseObjs :: DbgMode => FilePath -> Maybe EncContext -> Input -> ObjIndex -> ReportM ()
parseObjs fileN ec topInput refMap = mapM_ doOne (Map.toList refMap)
where
doOne d@(ref,_) =
do res <- liftIO (parseDecl topInput refMap d)
do res <- liftIO (parseDecl ec topInput refMap d)
let sayTimed cl msg =
do let timeMsg = parens (hcat [int (declTime res), "us"])
oidMsg = "OID" <+> int (refObj ref) <+> int (refGen ref)
Expand Down

0 comments on commit 91bce41

Please sign in to comment.