pdf support implemented
This commit is contained in:
parent
61383bf719
commit
1f2c4970a4
3 changed files with 45 additions and 11 deletions
|
@ -37,6 +37,9 @@ import Graphics.Svg
|
||||||
import Graphics.Rasterific.Svg
|
import Graphics.Rasterific.Svg
|
||||||
import Graphics.Text.TrueType
|
import Graphics.Text.TrueType
|
||||||
import Graphics.HsExif
|
import Graphics.HsExif
|
||||||
|
import Graphics.Rendering.Cairo as Cairo
|
||||||
|
import Graphics.UI.Gtk.Poppler.Document
|
||||||
|
import Graphics.UI.Gtk.Poppler.Page
|
||||||
|
|
||||||
import Debug.Trace
|
import Debug.Trace
|
||||||
|
|
||||||
|
@ -260,6 +263,32 @@ generateThumbs path uId aId mime = do
|
||||||
Just (nwidth, nheight)
|
Just (nwidth, nheight)
|
||||||
(img, _) <- liftIO $ renderSvgDocument emptyFontCache scale 100 $ fromJust svg
|
(img, _) <- liftIO $ renderSvgDocument emptyFontCache scale 100 $ fromJust svg
|
||||||
return img
|
return img
|
||||||
|
"application/pdf" -> do
|
||||||
|
curDir <- liftIO getCurrentDirectory
|
||||||
|
mpdf <- liftIO $ documentNewFromFile ("file://" ++ (curDir </> path)) Nothing
|
||||||
|
case mpdf of
|
||||||
|
Nothing -> error "Empty pdf"
|
||||||
|
Just pdf -> do
|
||||||
|
page0 <- liftIO $ documentGetPage pdf 0
|
||||||
|
(pw, ph) <- liftIO $ pageGetSize page0
|
||||||
|
let tempPath = FP.takeBaseName path ++ "_temp.png"
|
||||||
|
liftIO $ withImageSurface FormatARGB32 (floor pw) (floor ph) $
|
||||||
|
\surf -> do
|
||||||
|
renderWith surf $ do
|
||||||
|
setSourceRGB 1 1 1
|
||||||
|
Cairo.rectangle 0 0 pw ph
|
||||||
|
fill
|
||||||
|
pageRender page0
|
||||||
|
surfaceWriteToPNG surf tempPath
|
||||||
|
edynimg <- liftIO $ readPng tempPath
|
||||||
|
case edynimg of
|
||||||
|
Left err -> do
|
||||||
|
liftIO $ removeFile (FP.normalise tempPath)
|
||||||
|
error err
|
||||||
|
Right dynimg -> do
|
||||||
|
let img = convertRGBA8 dynimg
|
||||||
|
liftIO $ removeFile (FP.normalise tempPath)
|
||||||
|
return img
|
||||||
_ -> do
|
_ -> do
|
||||||
eimg <- liftIO $ readImage path
|
eimg <- liftIO $ readImage path
|
||||||
case eimg of
|
case eimg of
|
||||||
|
@ -328,6 +357,7 @@ checkCVE_2016_3714 p m =
|
||||||
"image/tiff-fx" -> isTiff p
|
"image/tiff-fx" -> isTiff p
|
||||||
"image/svg+xml" -> return True -- TODO: have to check XML for that.
|
"image/svg+xml" -> return True -- TODO: have to check XML for that.
|
||||||
"image/gif" -> isGif p
|
"image/gif" -> isGif p
|
||||||
|
"application/pdf" -> return True -- PDF is inherently insecure. can't check here.
|
||||||
_ -> return False
|
_ -> return False
|
||||||
|
|
||||||
writeOnDrive :: FileInfo -> UserId -> AlbumId -> UploadSpec -> Handler FP.FilePath
|
writeOnDrive :: FileInfo -> UserId -> AlbumId -> UploadSpec -> Handler FP.FilePath
|
||||||
|
|
|
@ -179,6 +179,8 @@ acceptedTypes =
|
||||||
, "image/tiff-fx"
|
, "image/tiff-fx"
|
||||||
-- SVG
|
-- SVG
|
||||||
, "image/svg+xml"
|
, "image/svg+xml"
|
||||||
|
-- PDF
|
||||||
|
, "application/pdf"
|
||||||
]
|
]
|
||||||
|
|
||||||
iso8601 :: FormatTime t => t -> String
|
iso8601 :: FormatTime t => t -> String
|
||||||
|
|
|
@ -129,6 +129,8 @@ library
|
||||||
, JuicyPixels-scale-dct
|
, JuicyPixels-scale-dct
|
||||||
, hsexif
|
, hsexif
|
||||||
, classy-prelude-yesod >= 1.0
|
, classy-prelude-yesod >= 1.0
|
||||||
|
, poppler
|
||||||
|
, cairo
|
||||||
-- svg stuff
|
-- svg stuff
|
||||||
, rasterific-svg >= 0.3.3
|
, rasterific-svg >= 0.3.3
|
||||||
, svg-tree
|
, svg-tree
|
||||||
|
|
Loading…
Reference in a new issue