Merge pull request #53 from nek0/pdf_upload

pdf support implemented

Handler/Commons.hs

@@ -37,6 +37,9 @@ import Graphics.Svg
 import Graphics.Rasterific.Svg
 import Graphics.Text.TrueType
 import Graphics.HsExif
+import Graphics.Rendering.Cairo as Cairo
+import Graphics.UI.Gtk.Poppler.Document
+import Graphics.UI.Gtk.Poppler.Page
 
 import Debug.Trace
 
@@ -260,6 +263,32 @@ generateThumbs path uId aId mime = do
               Just (nwidth, nheight)
       (img, _) <- liftIO $ renderSvgDocument emptyFontCache scale 100 $ fromJust svg
       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
       eimg <- liftIO $ readImage path
       case eimg of
@@ -318,17 +347,18 @@ generateThumbs path uId aId mime = do
 checkCVE_2016_3714 :: FP.FilePath -> T.Text -> IO Bool
 checkCVE_2016_3714 p m =
   case m of
-    "image/jpeg"     -> isJpeg p
+    "image/jpeg"      -> isJpeg p
-    "image/jpg"      -> isJpeg p
+    "image/jpg"       -> isJpeg p
-    "image/png"      -> isPng p
+    "image/png"       -> isPng p
-    "image/x-ms-bmp" -> isBmp p
+    "image/x-ms-bmp"  -> isBmp p
-    "image/x-bmp"    -> isBmp p
+    "image/x-bmp"     -> isBmp p
-    "image/bmp"      -> isBmp p
+    "image/bmp"       -> isBmp p
-    "image/tiff"     -> isTiff p
+    "image/tiff"      -> isTiff p
-    "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
-    _                -> return False
+    "application/pdf" -> return True -- PDF is inherently insecure. can't check here.
+    _                 -> return False
 
 writeOnDrive :: FileInfo -> UserId -> AlbumId -> UploadSpec -> Handler FP.FilePath
 writeOnDrive fil userId albumId spec = do

Helper.hs

@@ -179,6 +179,8 @@ acceptedTypes =
   , "image/tiff-fx"
     -- SVG
   , "image/svg+xml"
+    -- PDF
+  , "application/pdf"
   ]
 
 iso8601 :: FormatTime t => t -> String

eidolon.cabal

@@ -129,6 +129,8 @@ library
                  , JuicyPixels-scale-dct
                  , hsexif
                  , classy-prelude-yesod          >= 1.0
+                 , poppler
+                 , cairo
                  -- svg stuff
                  , rasterific-svg                >= 0.3.3
                  , svg-tree