pdf-toolbox-document 0.0.4.0 → 0.0.5.0

raw patch · 5 files changed

+158/−35 lines, 5 filesdep +cipher-aesdep +crypto-apiPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: cipher-aes, crypto-api

API changes (from Hackage documentation)

Files

• changelog.md +3/−0
• lib/Pdf/Toolbox/Document/Encryption.hs +143/−30
• lib/Pdf/Toolbox/Document/Page.hs +7/−2
• lib/Pdf/Toolbox/Document/Pdf.hs +2/−2
• pdf-toolbox-document.cabal +3/−1

@@ -1,3 +1,6 @@+0.0.5.0++* support crypto handler version 4 (V2 and AESV2)  0.0.4.0 

@@ -7,10 +7,12 @@   Decryptor,   defaultUserPassword,   mkStandardDecryptor,-  decryptObject+  decryptObject,+  DecryptorScope(..), ) where +import Data.Functor import Data.Bits (xor) import Data.IORef import Data.ByteString (ByteString)@@ -20,12 +22,20 @@ import Control.Monad import qualified System.IO.Streams as Streams import qualified Crypto.Cipher.RC4 as RC4+import qualified Crypto.Cipher.AES as AES import qualified Crypto.Hash.MD5 as MD5+import qualified Crypto.Padding as Padding  import Pdf.Toolbox.Core +-- | Encryption handler may specify different encryption keys for strings+-- and streams+data DecryptorScope+  = DecryptString+  | DecryptStream+ -- | Decrypt input stream-type Decryptor = Ref -> IS -> IO IS+type Decryptor = Ref -> DecryptorScope -> IS -> IO IS  -- | Decrypt object with the decryptor decryptObject :: (IS -> IO IS) -> Object a -> IO (Object a)@@ -64,12 +74,70 @@   Name filterType <- lookupDict "Filter" enc >>= fromObject   unless (filterType == "Standard") $ left $ UnexpectedError $ "Unsupported encryption handler: " ++ show filterType   vVal <- lookupDict "V" enc >>= fromObject >>= intValue-  n <- case vVal of-         1 -> return 5-         2 -> do-           len <- lookupDict "Length" enc >>= fromObject >>= intValue-           return $ len `div` 8-         _ -> left $ UnexpectedError $ "Unsuported encryption handler version: " ++ show vVal++  if vVal == 4+    then mk4+    else mk12 vVal++  where+  mk12 vVal = do+    n <- case vVal of+           1 -> return 5+           2 -> do+             len <- lookupDict "Length" enc >>= fromObject >>= intValue+             return $ len `div` 8+           _ -> left $ UnexpectedError $ "Unsuported encryption handler version: " ++ show vVal++    ekey <- mkKey tr enc pass n+    ok <- verifyKey tr enc ekey+    return $+      if not ok+        then Nothing+        else Just $ \ref _ is -> mkDecryptor V2 ekey n ref is++  mk4 = do+    Dict cryptoFilters <- lookupDict "CF" enc >>= fromObject++    keysMap <- forM cryptoFilters $ \(name, obj) -> do+      dict <- fromObject obj+      n <- lookupDict "Length" dict >>= fromObject >>= intValue+      algName <- lookupDict "CFM" dict >>= toName+      alg <-+        case algName of+          "V2" -> return V2+          "AESV2" -> return AESV2+          _ -> left $ UnexpectedError $ "Unknown crypto method: " ++ show algName+      ekey <- mkKey tr enc pass n+      return (name, (ekey, n, alg))++    (stdCfKey, _, _) <-+      case lookup "StdCF" keysMap of+        Nothing -> left $ UnexpectedError "StdCF is missing"+        Just v -> return v+    ok <- verifyKey tr enc stdCfKey+    if not ok+      then return Nothing++      else do+        strFName <- lookupDict "StrF" enc >>= toName+        (strFKey, strFN, strFAlg) <-+          case lookup strFName keysMap of+            Nothing -> left $ UnexpectedError $ "Crypto filter not found: " ++ show strFName+            Just v -> return v++        stmFName <- lookupDict "StmF" enc >>= toName+        (stmFKey, stmFN, stmFAlg) <-+          case lookup stmFName keysMap of+            Nothing -> left $ UnexpectedError $ "Crypto filter not found: " ++ show stmFName+            Just v -> return v++        return $ Just $ \ref scope is ->+          case scope of+            DecryptString -> mkDecryptor strFAlg strFKey strFN ref is+            DecryptStream -> mkDecryptor stmFAlg stmFKey stmFN ref is++mkKey :: Monad m => Dict -> Dict -> ByteString -> Int -> PdfE m ByteString+mkKey tr enc pass n = do   Str oVal <- lookupDict "O" enc >>= fromObject   pVal <- (BS.pack . BSL.unpack . toLazyByteString . word32LE . fromIntegral)     `liftM` (lookupDict "P" enc >>= fromObject >>= intValue)@@ -78,12 +146,34 @@     case ids of       [] -> left $ UnexpectedError $ "ID array is empty"       (x:_) -> fromObject x-  let ekey' = BS.take n $ MD5.hash $ BS.concat [pass, oVal, pVal, idVal]   rVal <- lookupDict "R" enc >>= fromObject >>= intValue++  encMD <-+    case lookupDict' "EncryptMetadata" enc of+      Nothing -> return True+      Just o -> do+        Boolean b <- toBoolean o+        return b++  let ekey' = BS.take n $ MD5.hash $ BS.concat [pass, oVal, pVal, idVal, pad]+      pad =+        if rVal < 4 || encMD+          then BS.empty+          else BS.pack (replicate 4 255)+   let ekey = if rVal < 3                then ekey'                else foldl (\bs _ -> BS.take n $ MD5.hash bs) ekey'  [1 :: Int .. 50]+  return ekey +verifyKey :: Monad m => Dict -> Dict -> ByteString -> PdfE m Bool+verifyKey tr enc ekey = do+  Str idVal <- do+    Array ids <- lookupDict "ID" tr >>= fromObject+    case ids of+      [] -> left $ UnexpectedError $ "ID array is empty"+      (x:_) -> fromObject x+  rVal <- lookupDict "R" enc >>= fromObject >>= intValue   Str uVal <- lookupDict "U" enc >>= fromObject   let ok =         case rVal of@@ -96,26 +186,49 @@                 loop 20 input = input                 loop i input = loop (i + 1) $ snd $ RC4.combine (RC4.initCtx $ BS.map (`xor` i) ekey) input             in BS.take 16 uVal == BS.take 16 uVal'+  return ok -  let decryptor = \(Ref index gen) is -> do-        let key = BS.take (16 `min` n + 5) $ MD5.hash $ BS.concat [-              ekey,-              BS.pack $ take 3 $ BSL.unpack $ toLazyByteString $ int32LE $ fromIntegral index,-              BS.pack $ take 2 $ BSL.unpack $ toLazyByteString $ int32LE $ fromIntegral gen-              ]-            ctx = RC4.initCtx key-        ioRef <- newIORef ctx-        let readNext = do-              chunk <- Streams.read is-              case chunk of-                Nothing -> return Nothing-                Just c -> do-                  ctx' <- readIORef ioRef-                  let (ctx'', res) = RC4.combine ctx' c-                  writeIORef ioRef ctx''-                  return (Just res)-        Streams.makeInputStream readNext+data Algorithm+  = V2+  | AESV2+  deriving (Show) -  if ok-    then return $ Just decryptor-    else return Nothing+mkDecryptor+  :: Algorithm+  -> ByteString+  -> Int+  -> Ref+  -> IS+  -> IO IS+mkDecryptor alg ekey n (Ref index gen) is = do+  let key = BS.take (16 `min` n + 5) $ MD5.hash $ BS.concat+        [ ekey+        , BS.pack $ take 3 $ BSL.unpack $ toLazyByteString+                  $ int32LE $ fromIntegral index+        , BS.pack $ take 2 $ BSL.unpack $ toLazyByteString+                  $ int32LE $ fromIntegral gen+        , salt alg+        ]+      salt V2 = ""+      salt AESV2 = "sAlT"++  case alg of+    V2 -> do+      ioRef <- newIORef $ RC4.initCtx key+      let readNext = do+            chunk <- Streams.read is+            case chunk of+              Nothing -> return Nothing+              Just c -> do+                ctx' <- readIORef ioRef+                let (ctx'', res) = RC4.combine ctx' c+                writeIORef ioRef ctx''+                return (Just res)+      Streams.makeInputStream readNext++    AESV2 -> do+      content <- BS.concat <$> Streams.toList is+      let initV = BS.take 16 content+          aes = AES.initAES key+          decrypted = AES.decryptCBC aes initV $ BS.drop 16 content+      Streams.fromByteString $ Padding.unpadPKCS5 decrypted

@@ -29,6 +29,7 @@ import Pdf.Toolbox.Document.Monad import Pdf.Toolbox.Document.PageNode import Pdf.Toolbox.Document.FontDict+import Pdf.Toolbox.Document.Encryption import Pdf.Toolbox.Document.Internal.Types import Pdf.Toolbox.Document.Internal.Util @@ -117,11 +118,15 @@     return (s, ref, len)    -- parse content streams-  decryptor <- fromMaybe (const return) <$> getDecryptor+  maybe_decr <- getDecryptor+  let decr =+        case maybe_decr of+          Nothing -> \_ is -> return is+          Just decryptor -> \ref is -> decryptor ref DecryptStream is    ris <- getRIS   filters <- getStreamFilters-  is <- parseContentStream ris filters decryptor streams+  is <- parseContentStream ris filters decr streams    -- use content stream processor to extract text   let loop p = do

@@ -73,7 +73,7 @@       dec <- getDecryptor       case dec of         Nothing -> return return-        Just d -> return $ d ref+        Just d -> return $ d ref DecryptStream     takeStreamContent decryptor s   getDecryptor = lift $ Pdf' $ gets stDecryptor   getRIS = lift $ Pdf' $ gets stRIS@@ -246,4 +246,4 @@   decryptor <- getDecryptor   case decryptor of     Nothing -> return o-    Just decr -> liftIO $ decryptObject (decr ref) o+    Just decr -> liftIO $ decryptObject (decr ref DecryptString) o

@@ -1,5 +1,5 @@ name:                pdf-toolbox-document-version:             0.0.4.0+version:             0.0.5.0 synopsis:            A collection of tools for processing PDF files. license:             BSD3 license-file:        LICENSE@@ -42,6 +42,8 @@                        bytestring,                        io-streams,                        cipher-rc4,+                       cipher-aes,                        cryptohash,+                       crypto-api,                        pdf-toolbox-core >=0.0.2 && <0.0.4,                        pdf-toolbox-content ==0.0.3.*