pdf-toolbox-document 0.0.1.0 → 0.0.2.0
raw patch · 8 files changed
+260/−49 lines, 8 filesdep +pdf-toolbox-contentdep +textdep ~pdf-toolbox-core
Dependencies added: pdf-toolbox-content, text
Dependency ranges changed: pdf-toolbox-core
Files
- lib/Pdf/Toolbox/Document.hs +2/−0
- lib/Pdf/Toolbox/Document/Encryption.hs +45/−26
- lib/Pdf/Toolbox/Document/FontDict.hs +113/−0
- lib/Pdf/Toolbox/Document/Internal/Types.hs +7/−1
- lib/Pdf/Toolbox/Document/Monad.hs +8/−0
- lib/Pdf/Toolbox/Document/Page.hs +66/−1
- lib/Pdf/Toolbox/Document/Pdf.hs +14/−19
- pdf-toolbox-document.cabal +5/−2
lib/Pdf/Toolbox/Document.hs view
@@ -23,6 +23,7 @@ module Pdf.Toolbox.Document.PageNode, module Pdf.Toolbox.Document.Page, module Pdf.Toolbox.Document.Info,+ module Pdf.Toolbox.Document.FontDict, module Pdf.Toolbox.Core.Error, module Pdf.Toolbox.Core.Object.Types, module Pdf.Toolbox.Core.Object.Util@@ -41,3 +42,4 @@ import Pdf.Toolbox.Document.Catalog import Pdf.Toolbox.Document.PageNode import Pdf.Toolbox.Document.Page+import Pdf.Toolbox.Document.FontDict
lib/Pdf/Toolbox/Document/Encryption.hs view
@@ -5,12 +5,13 @@ module Pdf.Toolbox.Document.Encryption ( Decryptor,- defaultUserPassord,+ defaultUserPassword, mkStandardDecryptor, decryptObject ) where +import Data.Bits (xor) import Data.IORef import Data.ByteString (ByteString) import qualified Data.ByteString as BS@@ -46,8 +47,8 @@ return (key, res) -- | The default user password-defaultUserPassord :: ByteString-defaultUserPassord = BS.pack [+defaultUserPassword :: ByteString+defaultUserPassword = BS.pack [ 0x28, 0xBF, 0x4E, 0x5E, 0x4E, 0x75, 0x8A, 0x41, 0x64, 0x00, 0x4E, 0x56, 0xFF, 0xFA, 0x01, 0x08, 0x2E, 0x2E, 0x00, 0xB6, 0xD0, 0x68, 0x3E, 0x80, 0x2F, 0x0C, 0xA9, 0xFE, 0x64, 0x53, 0x69, 0x7A@@ -57,17 +58,18 @@ mkStandardDecryptor :: Monad m => Dict -- ^ document trailer -> Dict -- ^ encryption dictionary- -> ByteString -- ^ user password- -> PdfE m Decryptor+ -> ByteString -- ^ user password (32 bytes exactly, see 7.6.3.3 Encryption Key Algorithm)+ -> PdfE m (Maybe Decryptor) mkStandardDecryptor tr enc pass = do 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- _ -> do+ 2 -> do len <- lookupDict "Length" enc >>= fromObject >>= intValue return $ len `div` 8+ _ -> left $ UnexpectedError $ "Unsuported encryption handler version: " ++ show vVal Str oVal <- lookupDict "O" enc >>= fromObject pVal <- (BS.pack . BSL.unpack . toLazyByteString . word32LE . fromIntegral) `liftM` (lookupDict "P" enc >>= fromObject >>= intValue)@@ -76,27 +78,44 @@ 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]- pass' = pass -- XXX: padding+ let ekey' = BS.take n $ MD5.hash $ BS.concat [pass, oVal, pVal, idVal] rVal <- lookupDict "R" enc >>= fromObject >>= intValue let ekey = if rVal < 3 then ekey' else foldl (\bs _ -> BS.take n $ MD5.hash bs) ekey' [1 :: Int .. 50]- return $ \(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++ Str uVal <- lookupDict "U" enc >>= fromObject+ let ok =+ case rVal of+ 2 ->+ let uVal' = snd $ RC4.combine (RC4.initCtx ekey) defaultUserPassword+ in uVal == uVal'+ _ ->+ let pass1 = snd $ RC4.combine (RC4.initCtx ekey) $ BS.take 16 $ MD5.hash $ BS.concat [defaultUserPassword, idVal]+ uVal' = loop 1 pass1+ 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'++ 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++ if ok+ then return $ Just decryptor+ else return Nothing
+ lib/Pdf/Toolbox/Document/FontDict.hs view
@@ -0,0 +1,113 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Font dictionary++module Pdf.Toolbox.Document.FontDict+(+ FontDict,+ FontSubtype(..),+ fontDictSubtype,+ fontDictLoadInfo+)+where++import Data.Monoid+import Data.Functor+import Control.Monad+import qualified System.IO.Streams as Streams++import Pdf.Toolbox.Core+import Pdf.Toolbox.Content++import Pdf.Toolbox.Document.Internal.Types+import Pdf.Toolbox.Document.Monad++-- | Font subtypes+data FontSubtype+ = FontType0+ | FontType1+ | FontMMType1+ | FontType3+ | FontTrueType+ deriving (Show, Eq)++-- | Get font subtype+fontDictSubtype :: Monad m => FontDict -> PdfE m FontSubtype+fontDictSubtype (FontDict dict) = do+ Name str <- lookupDict "Subtype" dict >>= fromObject+ case str of+ "Type0" -> return FontType0+ "Type1" -> return FontType1+ "MMType1" -> return FontMMType1+ "Type3" -> return FontType3+ "TrueType" -> return FontTrueType+ _ -> left $ UnexpectedError $ "Unexpected font subtype: " ++ show str++-- | Load font info for the font+fontDictLoadInfo :: (MonadPdf m, MonadIO m) => FontDict -> PdfE m FontInfo+fontDictLoadInfo fd@(FontDict fontDict) = do+ subtype <- fontDictSubtype fd+ case subtype of+ FontType0 -> FontInfoComposite <$> loadFontInfoComposite fontDict+ _ -> FontInfoSimple <$> loadFontInfoSimple fontDict++loadFontInfoComposite :: (MonadPdf m, MonadIO m) => Dict -> PdfE m FIComposite+loadFontInfoComposite fontDict = do+ toUnicode <- loadUnicodeCMap fontDict+ descFont <- do+ descFontArr <- lookupDict "DescendantFonts" fontDict >>= deref >>= fromObject+ case descFontArr of+ Array [o] -> deref o >>= fromObject+ _ -> left $ UnexpectedError "Unexpected value of DescendantFonts key in font dictionary"+ defaultWidth <-+ case lookupDict' "DW" descFont of+ Nothing -> return 1000+ Just o -> deref o >>= fromObject >>= realValue+ widths <-+ case lookupDict' "W" descFont of+ Nothing -> return mempty+ Just o -> deref o >>= fromObject >>= makeCIDFontWidths+ return $ FIComposite {+ fiCompositeUnicodeCMap = toUnicode,+ fiCompositeWidths = widths,+ fiCompositeDefaultWidth = defaultWidth+ }++loadFontInfoSimple :: (MonadPdf m, MonadIO m) => Dict -> PdfE m FISimple+loadFontInfoSimple fontDict = do+ toUnicode <- loadUnicodeCMap fontDict+ encoding <-+ case lookupDict' "Encoding" fontDict of+ Just (OName "WinAnsiEncoding") -> return $ Just SimpleFontEncodingWinAnsi+ Just (OName "MacRomanEncoding") -> return $ Just SimpleFontEncodingMacRoman+ _ -> return Nothing+ widths <-+ case lookupDict' "Widths" fontDict of+ Nothing -> return Nothing+ Just v -> do+ Array array <- deref v >>= fromObject+ widths <- mapM (fromObject >=> realValue) array+ firstChar <- lookupDict "FirstChar" fontDict >>= fromObject >>= intValue+ lastChar <- lookupDict "LastChar" fontDict >>= fromObject >>= intValue+ return $ Just (firstChar, lastChar, widths)+ return $ FISimple {+ fiSimpleUnicodeCMap = toUnicode,+ fiSimpleEncoding = encoding,+ fiSimpleWidths = widths+ }++loadUnicodeCMap :: (MonadPdf m, MonadIO m) => Dict -> PdfE m (Maybe UnicodeCMap)+loadUnicodeCMap fontDict =+ case lookupDict' "ToUnicode" fontDict of+ Nothing -> return Nothing+ Just o -> do+ ref <- fromObject o+ toUnicode <- lookupObject ref+ case toUnicode of+ OStream s -> do+ Stream _ is <- streamContent ref s+ content <- mconcat <$> liftIO (Streams.toList is)+ case parseUnicodeCMap content of+ Left e -> left $ UnexpectedError $ "can't parse cmap: " ++ show e+ Right cmap -> return $ Just cmap+ _ -> left $ UnexpectedError "ToUnicode: not a stream"
lib/Pdf/Toolbox/Document/Internal/Types.hs view
@@ -1,3 +1,4 @@+{-# OPTIONS_HADDOCK not-home #-} -- | Internal type declarations @@ -8,7 +9,8 @@ PageTree(..), PageNode(..), Page(..),- Info(..)+ Info(..),+ FontDict(..) ) where @@ -40,4 +42,8 @@ -- | Information dictionary data Info = Info Ref Dict+ deriving Show++-- | Font dictionary+data FontDict = FontDict Dict deriving Show
lib/Pdf/Toolbox/Document/Monad.hs view
@@ -12,6 +12,8 @@ import Pdf.Toolbox.Core +import Pdf.Toolbox.Document.Encryption+ -- | Interface to the underlying PDF file class Monad m => MonadPdf m where -- | find object by it's reference@@ -21,6 +23,12 @@ -- Note: the 'IS' returned is valid only until the next 'lookupObject' -- or any other operation, that requares seek streamContent :: Ref -> Stream Int64 -> PdfE m (Stream IS)+ -- | Current decryptor+ getDecryptor :: PdfE m (Maybe Decryptor)+ -- | Get random access input stream for direct access to the PDF file+ getRIS :: PdfE m RIS+ -- | Get all stream filters+ getStreamFilters :: PdfE m [StreamFilter] -- | Recursively load indirect object deref :: (MonadPdf m, Show a) => Object a -> PdfE m (Object ())
lib/Pdf/Toolbox/Document/Page.hs view
@@ -7,18 +7,28 @@ Page, pageParentNode, pageContents,- pageMediaBox+ pageMediaBox,+ pageFontDicts,+ pageExtractText ) where +import Data.Functor+import qualified Data.Traversable as Traversable+import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Map as Map import Control.Monad import Pdf.Toolbox.Core+import Pdf.Toolbox.Content import Pdf.Toolbox.Document.Types import Pdf.Toolbox.Document.Monad import Pdf.Toolbox.Document.PageNode+import Pdf.Toolbox.Document.FontDict import Pdf.Toolbox.Document.Internal.Types+import Pdf.Toolbox.Document.Internal.Util -- | Page's parent node pageParentNode :: MonadPdf m => Page -> PdfE m PageNode@@ -65,3 +75,58 @@ Just p -> return $ PageTreeNode p PageTreeLeaf page -> PageTreeNode `liftM` pageParentNode page mediaBox parent++-- | Font dictionaries for the page+pageFontDicts :: MonadPdf m => Page -> PdfE m [(Name, FontDict)]+pageFontDicts (Page _ dict) =+ case lookupDict' "Resources" dict of+ Nothing -> return []+ Just res -> do+ resDict <- deref res >>= fromObject+ case lookupDict' "Font" resDict of+ Nothing -> return []+ Just fonts -> do+ Dict fontsDict <- deref fonts >>= fromObject+ forM fontsDict $ \(name, font) -> do+ fontDict <- deref font >>= fromObject+ ensureType "Font" fontDict+ return (name, FontDict fontDict)++-- | Extract text from the page+--+-- Right now it doesn't even try to insert additional spaces or newlines,+-- and returns text as it is embeded. But someday it will.+pageExtractText :: (MonadPdf m, MonadIO m) => Page -> PdfE m Text+pageExtractText page = do+ -- load fonts and create glyph decoder+ fontDicts <- Map.fromList <$> pageFontDicts page+ glyphDecoders <- Traversable.forM fontDicts $ \fontDict ->+ fontInfoDecodeGlyphs <$> fontDictLoadInfo fontDict+ let glyphDecoder fontName = \str ->+ case Map.lookup fontName glyphDecoders of+ Nothing -> []+ Just decode -> decode str++ -- prepare content streams+ contents <- pageContents page+ streams <- forM contents $ \ref -> do+ s@(Stream dict _) <- lookupObject ref >>= toStream+ len <- lookupDict "Length" dict >>= deref >>= fromObject >>= intValue+ return (s, ref, len)++ -- parse content streams+ decryptor <- fromMaybe (const return) <$> getDecryptor++ ris <- getRIS+ filters <- getStreamFilters+ is <- parseContentStream ris filters decryptor streams++ -- use content stream processor to extract text+ let loop p = do+ next <- readNextOperator is+ case next of+ Nothing -> return $ Text.concat $ mapMaybe glyphText $ concat $ prGlyphs p+ Just op -> processOp op p >>= loop+ loop $ mkProcessor {+ prGlyphDecoder = glyphDecoder+ }
lib/Pdf/Toolbox/Document/Pdf.hs view
@@ -12,19 +12,19 @@ document, flushObjectCache, withoutObjectCache,- getRIS, knownFilters, isEncrypted, setUserPassword,- defaultUserPassord,+ defaultUserPassword, decrypt,- getDecryptor, MonadIO(..) ) where +import Data.Monoid import Data.Int import Data.ByteString (ByteString)+import qualified Data.ByteString as BS import Data.Map (Map) import qualified Data.Map as Map import Control.Monad@@ -74,6 +74,9 @@ Nothing -> return return Just d -> return $ d ref takeStreamContent decryptor s+ getDecryptor = lift $ Pdf' $ gets stDecryptor+ getRIS = lift $ Pdf' $ gets stRIS+ getStreamFilters = lift $ Pdf' $ gets stFilters readObjectForEntry :: MonadIO m => Ref -> XRefEntry -> Pdf m (Object Int64) readObjectForEntry ref (XRefTableEntry entry)@@ -154,15 +157,6 @@ lift $ Pdf' $ modify $ \st -> st {stLastXRef = Just xref} return xref --- | Access to the underlying random access input stream.--- Can be used when you need to switch from high level--- to low level of details-getRIS :: Monad m => Pdf m RIS-getRIS = lift $ Pdf' $ gets stRIS----lookupM :: MonadIO m => Ref -> Pdf m (Object ())---lookupM r = mapObject (const ()) `liftM` lookupObject r- getFromCache :: Monad m => Ref -> Pdf m (Maybe (Object Int64)) getFromCache ref = do cache <- lift $ Pdf' $ gets stObjectCache@@ -230,19 +224,20 @@ Just _ -> return True -- | Set the password to be user for decryption-setUserPassword :: MonadIO m => ByteString -> Pdf m ()+--+-- Returns False when the password is wrong+setUserPassword :: MonadIO m => ByteString -> Pdf m Bool setUserPassword pass = annotateError "setUserPassword" $ do ris <- getRIS tr <- lastXRef ris >>= trailer ris enc <- case lookupDict' "Encrypt" tr of Nothing -> left $ UnexpectedError "The document is not encrypted" Just enc -> deref enc >>= fromObject- decryptor <- mkStandardDecryptor tr enc pass- lift $ Pdf' $ modify $ \s -> s {stDecryptor = Just decryptor}---- | Decryptor-getDecryptor :: Monad m => Pdf m (Maybe Decryptor)-getDecryptor = lift $ Pdf' $ gets stDecryptor+ decryptor <- mkStandardDecryptor tr enc $ BS.take 32 $ pass `mappend` defaultUserPassword+ lift $ Pdf' $ modify $ \s -> s {stDecryptor = decryptor}+ case decryptor of+ Nothing -> return False+ _ -> return True -- | Decrypt PDF object using user password is set decrypt :: MonadIO m => Ref -> Object a -> Pdf m (Object a)
pdf-toolbox-document.cabal view
@@ -1,5 +1,5 @@ name: pdf-toolbox-document-version: 0.0.1.0+version: 0.0.2.0 synopsis: A collection of tools for processing PDF files. license: BSD3 license-file: LICENSE@@ -30,14 +30,17 @@ Pdf.Toolbox.Document.Catalog Pdf.Toolbox.Document.PageNode Pdf.Toolbox.Document.Page+ Pdf.Toolbox.Document.FontDict Pdf.Toolbox.Document.Encryption Pdf.Toolbox.Document.Internal.Types Pdf.Toolbox.Document.Internal.Util build-depends: base ==4.6.*, transformers, containers,+ text, bytestring, io-streams, cipher-rc4, cryptohash,- pdf-toolbox-core ==0.0.1.*+ pdf-toolbox-core ==0.0.2.*,+ pdf-toolbox-content ==0.0.2.*