small fixes and more failsafes in svg upload

This commit is contained in:
nek0 2016-11-20 04:05:07 +01:00
parent 4535f4054a
commit daef00e946
2 changed files with 19 additions and 18 deletions

View file

@ -88,15 +88,11 @@ postDirectUploadR albumId = do
isOk <- liftIO $ checkCVE_2016_3714 path mime isOk <- liftIO $ checkCVE_2016_3714 path mime
if isOk if isOk
then do then do
meta <- generateThumbs path ownerId albumId meta <- generateThumbs path ownerId albumId mime
tempName <- if length indFils == 1 tempName <- if length indFils == 1
then return $ fileBulkPrefix temp then return $ fileBulkPrefix temp
else return (fileBulkPrefix temp `T.append` " " `T.append` T.pack (show (index :: Int)) `T.append` " of " `T.append` T.pack (show (length indFils))) else return (fileBulkPrefix temp `T.append` " " `T.append` T.pack (show (index :: Int)) `T.append` " of " `T.append` T.pack (show (length indFils)))
let medium = Medium tempName ('/' : path) ('/' : metaThumbPath meta) mime (fileBulkTime temp) (fileBulkOwner temp) (fileBulkDesc temp) (fileBulkTags temp) albumId ('/' : metaPreviewPath meta) let medium = Medium tempName ('/' : path) ('/' : metaThumbPath meta) mime (fileBulkTime temp) (fileBulkOwner temp) (fileBulkDesc temp) (fileBulkTags temp) albumId ('/' : metaPreviewPath meta)
-- mId <- runDB $ I.insert medium
-- inALbum <- runDB $ getJust albumId
-- let newMediaList = mId : albumContent inALbum
-- runDB $ update albumId [AlbumContent =. newMediaList]
insertMedium medium albumId insertMedium medium albumId
return Nothing return Nothing
else do else do
@ -140,15 +136,19 @@ generateThumbs
:: FP.FilePath -- ^ Path to original image :: FP.FilePath -- ^ Path to original image
-> UserId -- ^ Uploading user -> UserId -- ^ Uploading user
-> AlbumId -- ^ Destination album -> AlbumId -- ^ Destination album
-> T.Text -- ^ MIME-Type (used for svg et al.)
-> Handler ThumbsMeta -- ^ Resulting metadata to store -> Handler ThumbsMeta -- ^ Resulting metadata to store
generateThumbs path uId aId = do generateThumbs path uId aId mime = do
eimg <- liftIO $ readImageWithMetadata path eimg <- liftIO $ readImage path
orig <- case eimg of orig <- case eimg of
Left _ -> do Left err -> -- This branch contains svg and other data formats. to be extended for pdf et al.
svg <- liftIO $ loadSvgFile path case mime of
(img, _) <- liftIO $ renderSvgDocument emptyFontCache Nothing 100 $ fromJust svg "image/svg+xml" -> do
return img svg <- liftIO $ loadSvgFile path
Right (img, _) -> do (img, _) <- liftIO $ renderSvgDocument emptyFontCache Nothing 100 $ fromJust svg
return img
_ -> error err
Right img -> do -- This branch contains "classical" image formats like bmp or png
return $ convertRGBA8 img return $ convertRGBA8 img
let thumbName = FP.takeBaseName path ++ "_thumb.jpg" let thumbName = FP.takeBaseName path ++ "_thumb.jpg"
prevName = FP.takeBaseName path ++ "_preview.jpg" prevName = FP.takeBaseName path ++ "_preview.jpg"
@ -191,10 +191,11 @@ writeOnDrive :: FileInfo -> UserId -> AlbumId -> Handler FP.FilePath
writeOnDrive fil userId albumId = do writeOnDrive fil userId albumId = do
--filen <- return $ fileName fil --filen <- return $ fileName fil
album <- runDB $ getJust albumId album <- runDB $ getJust albumId
let [PersistInt64 int] = if albumContent album == [] then [PersistInt64 1] else keyToValues $ maximum $ albumContent album let ac = albumContent album
let filen = show $ fromIntegral int + 1 [PersistInt64 int] = if L.null ac then [PersistInt64 1] else keyToValues $ maximum $ ac
let ext = FP.takeExtension $ T.unpack $ fileName fil filen = show $ fromIntegral int + 1
let path = "static" FP.</> "data" FP.</> T.unpack (extractKey userId) FP.</> T.unpack (extractKey albumId) FP.</> filen ++ ext ext = FP.takeExtension $ T.unpack $ fileName fil
path = "static" FP.</> "data" FP.</> T.unpack (extractKey userId) FP.</> T.unpack (extractKey albumId) FP.</> filen ++ ext
dde <- liftIO $ doesDirectoryExist $ FP.dropFileName path dde <- liftIO $ doesDirectoryExist $ FP.dropFileName path
if not dde if not dde
then then
@ -292,7 +293,7 @@ postUploadR = do
isOk <- liftIO $ checkCVE_2016_3714 path mime isOk <- liftIO $ checkCVE_2016_3714 path mime
if isOk if isOk
then do then do
meta <- generateThumbs path ownerId inAlbumId meta <- generateThumbs path ownerId inAlbumId mime
tempName <- if tempName <- if
length indFils == 1 length indFils == 1
then return $ fileBulkPrefix temp then return $ fileBulkPrefix temp

View file

@ -1,5 +1,5 @@
name: eidolon name: eidolon
version: 0.1.3.2 version: 0.1.3.3
synopsis: Image gallery in Yesod synopsis: Image gallery in Yesod
homepage: https://eidolon.nek0.eu homepage: https://eidolon.nek0.eu
license: AGPL-3 license: AGPL-3