{-# LANGUAGE OverloadedStrings #-}
module Pdf.Core.File
( File(..)
, withPdfFile
, fromHandle
, fromBytes
, fromBuffer
, lastTrailer
, findObject
, streamContent
, rawStreamContent
, EncryptionStatus(..)
, encryptionStatus
, setUserPassword
, setDecryptor
, NotFound(..)
)
where
import Data.ByteString (ByteString)
import qualified Data.ByteString as ByteString
import Data.IORef
import qualified Data.HashMap.Strict as HashMap
import Control.Monad
import Control.Exception (Exception, throwIO, catch)
import System.IO (Handle)
import qualified System.IO as IO
import System.IO.Streams (InputStream)
import Pdf.Core.Object
import Pdf.Core.Object.Util
import Pdf.Core.Exception
import Pdf.Core.XRef
import Pdf.Core.Stream (StreamFilter)
import Pdf.Core.Util
import qualified Pdf.Core.Stream as Stream
import Pdf.Core.IO.Buffer (Buffer)
import qualified Pdf.Core.IO.Buffer as Buffer
import Pdf.Core.Encryption
data File = File
{ File -> XRef
fileLastXRef :: XRef
, File -> Buffer
fileBuffer :: Buffer
, File -> [StreamFilter]
fileFilters :: [StreamFilter]
, File -> IORef (Maybe Decryptor)
fileDecryptor :: IORef (Maybe Decryptor)
}
lastTrailer :: File -> IO Dict
lastTrailer :: File -> IO Dict
lastTrailer File
file = Buffer -> XRef -> IO Dict
trailer (File -> Buffer
fileBuffer File
file) (File -> XRef
fileLastXRef File
file)
findObject :: File -> Ref -> IO Object
findObject :: File -> Ref -> IO Object
findObject File
file Ref
ref = do
Maybe Entry
mentry <- (Entry -> Maybe Entry) -> IO Entry -> IO (Maybe Entry)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Entry -> Maybe Entry
forall a. a -> Maybe a
Just (File -> Ref -> IO Entry
lookupEntryRec File
file Ref
ref)
IO (Maybe Entry)
-> (UnknownXRefStreamEntryType -> IO (Maybe Entry))
-> IO (Maybe Entry)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(UnknownXRefStreamEntryType Int
_) -> Maybe Entry -> IO (Maybe Entry)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Entry
forall a. Maybe a
Nothing
case Maybe Entry
mentry of
Maybe Entry
Nothing -> Object -> IO Object
forall (m :: * -> *) a. Monad m => a -> m a
return Object
Null
Just Entry
entry -> File -> Entry -> IO Object
readObjectForEntry File
file Entry
entry
streamContent :: File -> Ref -> Stream -> IO (InputStream ByteString)
streamContent :: File -> Ref -> Stream -> IO (InputStream ByteString)
streamContent File
file Ref
ref Stream
s = do
InputStream ByteString
is <- File -> Ref -> Stream -> IO (InputStream ByteString)
rawStreamContent File
file Ref
ref Stream
s
[StreamFilter]
-> Stream -> InputStream ByteString -> IO (InputStream ByteString)
Stream.decodeStream (File -> [StreamFilter]
fileFilters File
file) Stream
s InputStream ByteString
is
rawStreamContent :: File -> Ref -> Stream -> IO (InputStream ByteString)
rawStreamContent :: File -> Ref -> Stream -> IO (InputStream ByteString)
rawStreamContent File
file Ref
ref (S Dict
dict Int64
pos) = do
Int
len <- do
Object
obj <- Either String Object -> IO Object
forall a. Either String a -> IO a
sure (Either String Object -> IO Object)
-> Either String Object -> IO Object
forall a b. (a -> b) -> a -> b
$ Name -> Dict -> Maybe Object
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
"Length" Dict
dict
Maybe Object -> String -> Either String Object
forall a. Maybe a -> String -> Either String a
`notice` String
"Length missing in stream"
case Object
obj of
Number Scientific
_ -> Either String Int -> IO Int
forall a. Either String a -> IO a
sure (Either String Int -> IO Int) -> Either String Int -> IO Int
forall a b. (a -> b) -> a -> b
$ Object -> Maybe Int
intValue Object
obj
Maybe Int -> String -> Either String Int
forall a. Maybe a -> String -> Either String a
`notice` String
"Length should be an integer"
Ref Ref
r -> do
Object
o <- File -> Ref -> IO Object
findObject File
file Ref
r
Either String Int -> IO Int
forall a. Either String a -> IO a
sure (Either String Int -> IO Int) -> Either String Int -> IO Int
forall a b. (a -> b) -> a -> b
$ Object -> Maybe Int
intValue Object
o Maybe Int -> String -> Either String Int
forall a. Maybe a -> String -> Either String a
`notice` String
"Length should be an integer"
Object
_ -> Corrupted -> IO Int
forall e a. Exception e => e -> IO a
throwIO (Corrupted -> IO Int) -> Corrupted -> IO Int
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Corrupted
Corrupted String
"Length should be an integer" []
InputStream ByteString
is <- Buffer -> Int -> Int64 -> IO (InputStream ByteString)
Stream.rawStreamContent (File -> Buffer
fileBuffer File
file) Int
len Int64
pos
Maybe Decryptor
mdecryptor <- IORef (Maybe Decryptor) -> IO (Maybe Decryptor)
forall a. IORef a -> IO a
readIORef (File -> IORef (Maybe Decryptor)
fileDecryptor File
file)
case Maybe Decryptor
mdecryptor of
Maybe Decryptor
Nothing -> InputStream ByteString -> IO (InputStream ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return InputStream ByteString
is
Just Decryptor
decryptor -> Decryptor
decryptor Ref
ref DecryptorScope
DecryptStream InputStream ByteString
is
data EncryptionStatus
= Encrypted
| Decrypted
| Plain
deriving (Int -> EncryptionStatus -> ShowS
[EncryptionStatus] -> ShowS
EncryptionStatus -> String
(Int -> EncryptionStatus -> ShowS)
-> (EncryptionStatus -> String)
-> ([EncryptionStatus] -> ShowS)
-> Show EncryptionStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EncryptionStatus] -> ShowS
$cshowList :: [EncryptionStatus] -> ShowS
show :: EncryptionStatus -> String
$cshow :: EncryptionStatus -> String
showsPrec :: Int -> EncryptionStatus -> ShowS
$cshowsPrec :: Int -> EncryptionStatus -> ShowS
Show, EncryptionStatus -> EncryptionStatus -> Bool
(EncryptionStatus -> EncryptionStatus -> Bool)
-> (EncryptionStatus -> EncryptionStatus -> Bool)
-> Eq EncryptionStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EncryptionStatus -> EncryptionStatus -> Bool
$c/= :: EncryptionStatus -> EncryptionStatus -> Bool
== :: EncryptionStatus -> EncryptionStatus -> Bool
$c== :: EncryptionStatus -> EncryptionStatus -> Bool
Eq, Int -> EncryptionStatus
EncryptionStatus -> Int
EncryptionStatus -> [EncryptionStatus]
EncryptionStatus -> EncryptionStatus
EncryptionStatus -> EncryptionStatus -> [EncryptionStatus]
EncryptionStatus
-> EncryptionStatus -> EncryptionStatus -> [EncryptionStatus]
(EncryptionStatus -> EncryptionStatus)
-> (EncryptionStatus -> EncryptionStatus)
-> (Int -> EncryptionStatus)
-> (EncryptionStatus -> Int)
-> (EncryptionStatus -> [EncryptionStatus])
-> (EncryptionStatus -> EncryptionStatus -> [EncryptionStatus])
-> (EncryptionStatus -> EncryptionStatus -> [EncryptionStatus])
-> (EncryptionStatus
-> EncryptionStatus -> EncryptionStatus -> [EncryptionStatus])
-> Enum EncryptionStatus
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: EncryptionStatus
-> EncryptionStatus -> EncryptionStatus -> [EncryptionStatus]
$cenumFromThenTo :: EncryptionStatus
-> EncryptionStatus -> EncryptionStatus -> [EncryptionStatus]
enumFromTo :: EncryptionStatus -> EncryptionStatus -> [EncryptionStatus]
$cenumFromTo :: EncryptionStatus -> EncryptionStatus -> [EncryptionStatus]
enumFromThen :: EncryptionStatus -> EncryptionStatus -> [EncryptionStatus]
$cenumFromThen :: EncryptionStatus -> EncryptionStatus -> [EncryptionStatus]
enumFrom :: EncryptionStatus -> [EncryptionStatus]
$cenumFrom :: EncryptionStatus -> [EncryptionStatus]
fromEnum :: EncryptionStatus -> Int
$cfromEnum :: EncryptionStatus -> Int
toEnum :: Int -> EncryptionStatus
$ctoEnum :: Int -> EncryptionStatus
pred :: EncryptionStatus -> EncryptionStatus
$cpred :: EncryptionStatus -> EncryptionStatus
succ :: EncryptionStatus -> EncryptionStatus
$csucc :: EncryptionStatus -> EncryptionStatus
Enum)
encryptionStatus :: File -> IO EncryptionStatus
encryptionStatus :: File -> IO EncryptionStatus
encryptionStatus File
file = do
Dict
tr <- File -> IO Dict
lastTrailer File
file
case Name -> Dict -> Maybe Object
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
"Encrypt" Dict
tr of
Maybe Object
Nothing -> EncryptionStatus -> IO EncryptionStatus
forall (m :: * -> *) a. Monad m => a -> m a
return EncryptionStatus
Plain
Just Object
_ -> do
Maybe Decryptor
decr <- IORef (Maybe Decryptor) -> IO (Maybe Decryptor)
forall a. IORef a -> IO a
readIORef (File -> IORef (Maybe Decryptor)
fileDecryptor File
file)
case Maybe Decryptor
decr of
Maybe Decryptor
Nothing -> EncryptionStatus -> IO EncryptionStatus
forall (m :: * -> *) a. Monad m => a -> m a
return EncryptionStatus
Encrypted
Just Decryptor
_ -> EncryptionStatus -> IO EncryptionStatus
forall (m :: * -> *) a. Monad m => a -> m a
return EncryptionStatus
Decrypted
setUserPassword :: File -> ByteString -> IO Bool
setUserPassword :: File -> ByteString -> IO Bool
setUserPassword File
file ByteString
password = String -> IO Bool -> IO Bool
forall a. String -> IO a -> IO a
message String
"setUserPassword" (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ do
Dict
tr <- File -> IO Dict
lastTrailer File
file
Dict
enc <-
case Name -> Dict -> Maybe Object
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
"Encrypt" Dict
tr of
Maybe Object
Nothing -> Unexpected -> IO Dict
forall e a. Exception e => e -> IO a
throwIO (String -> [String] -> Unexpected
Unexpected String
"document is not encrypted" [])
Just Object
o -> do
Object
o' <- File -> Object -> IO Object
deref File
file Object
o
case Object
o' of
Dict Dict
d -> Dict -> IO Dict
forall (m :: * -> *) a. Monad m => a -> m a
return Dict
d
Object
Null -> Corrupted -> IO Dict
forall e a. Exception e => e -> IO a
throwIO (String -> [String] -> Corrupted
Corrupted String
"encryption encryption dict is null" [])
Object
_ -> Corrupted -> IO Dict
forall e a. Exception e => e -> IO a
throwIO (String -> [String] -> Corrupted
Corrupted String
"document Encrypt should be a dictionary" [])
let either_decryptor :: Either String (Maybe Decryptor)
either_decryptor = Dict -> Dict -> ByteString -> Either String (Maybe Decryptor)
mkStandardDecryptor Dict
tr Dict
enc
(Int -> ByteString -> ByteString
ByteString.take Int
32 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
password ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
`mappend` ByteString
defaultUserPassword)
case Either String (Maybe Decryptor)
either_decryptor of
Left String
err -> Corrupted -> IO Bool
forall e a. Exception e => e -> IO a
throwIO (Corrupted -> IO Bool) -> Corrupted -> IO Bool
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Corrupted
Corrupted String
err []
Right Maybe Decryptor
Nothing -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Right (Just Decryptor
decryptor) -> do
File -> Decryptor -> IO ()
setDecryptor File
file Decryptor
decryptor
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
where
deref :: File -> Object -> IO Object
deref File
f (Ref Ref
ref) = File -> Ref -> IO Object
findObject File
f Ref
ref
deref File
_ Object
o = Object -> IO Object
forall (m :: * -> *) a. Monad m => a -> m a
return Object
o
setDecryptor :: File -> Decryptor -> IO ()
setDecryptor :: File -> Decryptor -> IO ()
setDecryptor File
file Decryptor
decryptor =
IORef (Maybe Decryptor) -> Maybe Decryptor -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (File -> IORef (Maybe Decryptor)
fileDecryptor File
file) (Decryptor -> Maybe Decryptor
forall a. a -> Maybe a
Just Decryptor
decryptor)
fromBuffer :: [StreamFilter] -> Buffer -> IO File
fromBuffer :: [StreamFilter] -> Buffer -> IO File
fromBuffer [StreamFilter]
filters Buffer
buffer = do
XRef
xref <- Buffer -> IO XRef
lastXRef Buffer
buffer
IORef (Maybe Decryptor)
decryptor <- Maybe Decryptor -> IO (IORef (Maybe Decryptor))
forall a. a -> IO (IORef a)
newIORef Maybe Decryptor
forall a. Maybe a
Nothing
File -> IO File
forall (m :: * -> *) a. Monad m => a -> m a
return File :: XRef -> Buffer -> [StreamFilter] -> IORef (Maybe Decryptor) -> File
File
{ fileLastXRef :: XRef
fileLastXRef = XRef
xref
, fileBuffer :: Buffer
fileBuffer = Buffer
buffer
, fileFilters :: [StreamFilter]
fileFilters = [StreamFilter]
filters
, fileDecryptor :: IORef (Maybe Decryptor)
fileDecryptor = IORef (Maybe Decryptor)
decryptor
}
fromHandle :: [StreamFilter] -> Handle -> IO File
fromHandle :: [StreamFilter] -> Handle -> IO File
fromHandle [StreamFilter]
filters Handle
handle = do
Buffer
buffer <- Handle -> IO Buffer
Buffer.fromHandle Handle
handle
[StreamFilter] -> Buffer -> IO File
fromBuffer [StreamFilter]
filters Buffer
buffer
fromBytes :: [StreamFilter] -> ByteString -> IO File
fromBytes :: [StreamFilter] -> ByteString -> IO File
fromBytes [StreamFilter]
filters ByteString
bytes = do
Buffer
buffer <- ByteString -> IO Buffer
Buffer.fromBytes ByteString
bytes
[StreamFilter] -> Buffer -> IO File
fromBuffer [StreamFilter]
filters Buffer
buffer
withPdfFile :: FilePath -> (File -> IO a) -> IO a
withPdfFile :: String -> (File -> IO a) -> IO a
withPdfFile String
path File -> IO a
action =
String -> IOMode -> (Handle -> IO a) -> IO a
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
IO.withBinaryFile String
path IOMode
IO.ReadMode ((Handle -> IO a) -> IO a) -> (Handle -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Handle
handle -> do
File
file <- [StreamFilter] -> Handle -> IO File
fromHandle [StreamFilter]
Stream.knownFilters Handle
handle
File -> IO a
action File
file
lookupEntryRec :: File -> Ref -> IO Entry
lookupEntryRec :: File -> Ref -> IO Entry
lookupEntryRec File
file Ref
ref = XRef -> IO Entry
loop (File -> XRef
fileLastXRef File
file)
where
loop :: XRef -> IO Entry
loop XRef
xref = do
Maybe Entry
res <- File -> Ref -> XRef -> IO (Maybe Entry)
lookupEntry File
file Ref
ref XRef
xref
case Maybe Entry
res of
Just Entry
e -> Entry -> IO Entry
forall (m :: * -> *) a. Monad m => a -> m a
return Entry
e
Maybe Entry
Nothing -> do
Maybe XRef
prev <- Buffer -> XRef -> IO (Maybe XRef)
prevXRef (File -> Buffer
fileBuffer File
file) XRef
xref
case Maybe XRef
prev of
Just XRef
p -> XRef -> IO Entry
loop XRef
p
Maybe XRef
Nothing -> NotFound -> IO Entry
forall e a. Exception e => e -> IO a
throwIO (String -> NotFound
NotFound (String -> NotFound) -> String -> NotFound
forall a b. (a -> b) -> a -> b
$ String
"The Ref not found: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Ref -> String
forall a. Show a => a -> String
show Ref
ref)
lookupEntry :: File -> Ref -> XRef -> IO (Maybe Entry)
lookupEntry :: File -> Ref -> XRef -> IO (Maybe Entry)
lookupEntry File
file Ref
ref xref :: XRef
xref@(XRefTable Int64
_) =
Buffer -> XRef -> Ref -> IO (Maybe Entry)
lookupTableEntry (File -> Buffer
fileBuffer File
file) XRef
xref Ref
ref
lookupEntry File
file Ref
ref (XRefStream Int64
_ s :: Stream
s@(S Dict
dict Int64
_)) = do
InputStream ByteString
content <- File -> Ref -> Stream -> IO (InputStream ByteString)
streamContent File
file Ref
ref Stream
s
Dict -> InputStream ByteString -> Ref -> IO (Maybe Entry)
lookupStreamEntry Dict
dict InputStream ByteString
content Ref
ref
readObjectForEntry :: File -> Entry -> IO Object
readObjectForEntry :: File -> Entry -> IO Object
readObjectForEntry File
_ EntryFree{} = Object -> IO Object
forall (m :: * -> *) a. Monad m => a -> m a
return Object
Null
readObjectForEntry File
file (EntryUsed Int64
off Int
gen) = do
(Ref
ref, Object
obj) <- Buffer -> Int64 -> IO (Ref, Object)
readObjectAtOffset (File -> Buffer
fileBuffer File
file) Int64
off
let R Int
_ Int
gen' = Ref
ref
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
gen' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
gen) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Corrupted -> IO ()
forall e a. Exception e => e -> IO a
throwIO (String -> [String] -> Corrupted
Corrupted String
"readObjectForEntry" [String
"object generation missmatch"])
File -> Ref -> Object -> IO Object
decrypt File
file Ref
ref Object
obj
readObjectForEntry File
file (EntryCompressed Int
index Int
num) = do
let ref :: Ref
ref= Int -> Int -> Ref
R Int
index Int
0
objStream :: Stream
objStream@(S Dict
dict Int64
_) <- do
Object
o <- File -> Ref -> IO Object
findObject File
file Ref
ref
Either String Stream -> IO Stream
forall a. Either String a -> IO a
sure (Either String Stream -> IO Stream)
-> Either String Stream -> IO Stream
forall a b. (a -> b) -> a -> b
$ Object -> Maybe Stream
streamValue Object
o Maybe Stream -> String -> Either String Stream
forall a. Maybe a -> String -> Either String a
`notice` String
"Compressed entry should be in stream"
Int
first <- Either String Int -> IO Int
forall a. Either String a -> IO a
sure (Either String Int -> IO Int) -> Either String Int -> IO Int
forall a b. (a -> b) -> a -> b
$ (Name -> Dict -> Maybe Object
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
"First" Dict
dict Maybe Object -> (Object -> Maybe Int) -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Object -> Maybe Int
intValue)
Maybe Int -> String -> Either String Int
forall a. Maybe a -> String -> Either String a
`notice` String
"First should be an integer"
InputStream ByteString
content <- File -> Ref -> Stream -> IO (InputStream ByteString)
streamContent File
file Ref
ref Stream
objStream
InputStream ByteString -> Int64 -> Int -> IO Object
readCompressedObject InputStream ByteString
content (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
first) Int
num
decrypt :: File -> Ref -> Object -> IO Object
decrypt :: File -> Ref -> Object -> IO Object
decrypt File
file Ref
ref Object
o = do
Maybe Decryptor
maybe_decr <- IORef (Maybe Decryptor) -> IO (Maybe Decryptor)
forall a. IORef a -> IO a
readIORef (File -> IORef (Maybe Decryptor)
fileDecryptor File
file)
case Maybe Decryptor
maybe_decr of
Maybe Decryptor
Nothing -> Object -> IO Object
forall (m :: * -> *) a. Monad m => a -> m a
return Object
o
Just Decryptor
decr -> Decryptor -> Ref -> Object -> IO Object
decryptObject Decryptor
decr Ref
ref Object
o
data NotFound = NotFound String
deriving (Int -> NotFound -> ShowS
[NotFound] -> ShowS
NotFound -> String
(Int -> NotFound -> ShowS)
-> (NotFound -> String) -> ([NotFound] -> ShowS) -> Show NotFound
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NotFound] -> ShowS
$cshowList :: [NotFound] -> ShowS
show :: NotFound -> String
$cshow :: NotFound -> String
showsPrec :: Int -> NotFound -> ShowS
$cshowsPrec :: Int -> NotFound -> ShowS
Show)
instance Exception NotFound