version bump with todo
This commit is contained in:
nek0
parent
6fb658d5fb
commit
eaa80952a6
3 changed files with 63 additions and 30 deletions
|
|
@ -23,9 +23,11 @@ import Data.Maybe
|
|||
import qualified Data.Text as T
|
||||
import Data.List as L
|
||||
import qualified System.FilePath as FP
|
||||
import System.Directory
|
||||
import Filesystem.Path.CurrentOS
|
||||
import Graphics.ImageMagick.MagickWand
|
||||
import Text.Blaze.Internal
|
||||
import Codec.ImageType
|
||||
|
||||
getDirectUploadR :: AlbumId -> Handler Html
|
||||
getDirectUploadR albumId = do
|
||||
|
|
@ -76,22 +78,27 @@ postDirectUploadR albumId = do
|
|||
errNames <- mapM
|
||||
(\(index, file) -> do
|
||||
let mime = fileContentType file
|
||||
if
|
||||
mime `elem` acceptedTypes
|
||||
if mime `elem` acceptedTypes
|
||||
then do
|
||||
path <- writeOnDrive file ownerId albumId
|
||||
(thumbPath, prevPath, iWidth, tWidth, pWidth) <- generateThumb path ownerId albumId
|
||||
tempName <- if
|
||||
length indFils == 1
|
||||
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)))
|
||||
let medium = Medium tempName ('/' : path) ('/' : thumbPath) mime (fileBulkTime temp) (fileBulkOwner temp) (fileBulkDesc temp) (fileBulkTags temp) iWidth tWidth albumId ('/' : prevPath) pWidth
|
||||
mId <- runDB $ I.insert medium
|
||||
inALbum <- runDB $ getJust albumId
|
||||
let newMediaList = mId : albumContent inALbum
|
||||
runDB $ update albumId [AlbumContent =. newMediaList]
|
||||
putIndexES (ESMedium mId medium)
|
||||
return Nothing
|
||||
isOk <- liftIO $ checkCVE_2016_3714 path mime
|
||||
if isOk
|
||||
then do
|
||||
(thumbPath, prevPath, iWidth, tWidth, pWidth) <- generateThumb path ownerId albumId
|
||||
tempName <- if
|
||||
length indFils == 1
|
||||
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)))
|
||||
let medium = Medium tempName ('/' : path) ('/' : thumbPath) mime (fileBulkTime temp) (fileBulkOwner temp) (fileBulkDesc temp) (fileBulkTags temp) iWidth tWidth albumId ('/' : prevPath) pWidth
|
||||
mId <- runDB $ I.insert medium
|
||||
inALbum <- runDB $ getJust albumId
|
||||
let newMediaList = mId : albumContent inALbum
|
||||
runDB $ update albumId [AlbumContent =. newMediaList]
|
||||
putIndexES (ESMedium mId medium)
|
||||
return Nothing
|
||||
else do
|
||||
liftIO $ removeFile (FP.normalise path)
|
||||
return $ Just $ fileName file
|
||||
else
|
||||
return $ Just $ fileName file
|
||||
) indFils
|
||||
|
|
@ -119,7 +126,11 @@ postDirectUploadR albumId = do
|
|||
setMessage "This Album does not exist"
|
||||
redirect $ AlbumR albumId
|
||||
|
||||
generateThumb :: FP.FilePath -> UserId -> AlbumId -> Handler (FP.FilePath, FP.FilePath, Int, Int, Int)
|
||||
generateThumb
|
||||
:: FP.FilePath
|
||||
-> UserId
|
||||
-> AlbumId
|
||||
-> Handler (FP.FilePath, FP.FilePath, Int, Int, Int)
|
||||
generateThumb path userId albumId = do
|
||||
let newName = FP.takeBaseName path ++ "_thumb.jpg"
|
||||
let newPath = "static" FP.</> "data" FP.</> T.unpack (extractKey userId) FP.</> T.unpack (extractKey albumId) FP.</> newName
|
||||
|
|
@ -149,6 +160,21 @@ generateThumb path userId albumId = do
|
|||
return (w1, w2, w3)
|
||||
return (newPath, prevPath, iWidth, tWidth, pWidth)
|
||||
|
||||
checkCVE_2016_3714 :: FP.FilePath -> Text -> IO Bool
|
||||
checkCVE_2016_3714 p m =
|
||||
case m of
|
||||
"image/jpeg" -> isJpeg p
|
||||
"image/jpg" -> isJpeg p
|
||||
"image/png" -> isPng p
|
||||
"image/x-ms-bmp" -> isBmp p
|
||||
"image/x-bmp" -> isBmp p
|
||||
"image/bmp" -> isBmp p
|
||||
"image/tiff" -> isTiff p
|
||||
"image/tiff-fx" -> isTiff p
|
||||
"image/svg+xml" -> return True -- TODO: have to check XML for that.
|
||||
"image/gif" -> isGif p
|
||||
_ -> return False
|
||||
|
||||
writeOnDrive :: FileInfo -> UserId -> AlbumId -> Handler FP.FilePath
|
||||
writeOnDrive fil userId albumId = do
|
||||
--filen <- return $ fileName fil
|
||||
|
|
@ -238,25 +264,30 @@ postUploadR = do
|
|||
errNames <- mapM
|
||||
(\(index, file) -> do
|
||||
let mime = fileContentType file
|
||||
if
|
||||
mime `elem` acceptedTypes
|
||||
if mime `elem` acceptedTypes
|
||||
then do
|
||||
let inAlbumId = fileBulkAlbum temp
|
||||
albRef <- runDB $ getJust inAlbumId
|
||||
let ownerId = albumOwner albRef
|
||||
path <- writeOnDrive file ownerId inAlbumId
|
||||
(thumbPath, prevPath, iWidth, tWidth, pWidth) <- generateThumb path ownerId inAlbumId
|
||||
tempName <- if
|
||||
length indFils == 1
|
||||
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)))
|
||||
let medium = Medium tempName ('/' : path) ('/' : thumbPath) mime (fileBulkTime temp) (fileBulkOwner temp) (fileBulkDesc temp) (fileBulkTags temp) iWidth tWidth inAlbumId ('/' : prevPath) pWidth
|
||||
mId <- runDB $ I.insert medium
|
||||
inALbum <- runDB $ getJust inAlbumId
|
||||
let newMediaList = mId : albumContent inALbum
|
||||
runDB $ update inAlbumId [AlbumContent =. newMediaList]
|
||||
putIndexES (ESMedium mId medium)
|
||||
return Nothing
|
||||
isOk <- liftIO $ checkCVE_2016_3714 path mime
|
||||
if isOk
|
||||
then do
|
||||
(thumbPath, prevPath, iWidth, tWidth, pWidth) <- generateThumb path ownerId inAlbumId
|
||||
tempName <- if
|
||||
length indFils == 1
|
||||
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)))
|
||||
let medium = Medium tempName ('/' : path) ('/' : thumbPath) mime (fileBulkTime temp) (fileBulkOwner temp) (fileBulkDesc temp) (fileBulkTags temp) iWidth tWidth inAlbumId ('/' : prevPath) pWidth
|
||||
mId <- runDB $ I.insert medium
|
||||
inALbum <- runDB $ getJust inAlbumId
|
||||
let newMediaList = mId : albumContent inALbum
|
||||
runDB $ update inAlbumId [AlbumContent =. newMediaList]
|
||||
putIndexES (ESMedium mId medium)
|
||||
return Nothing
|
||||
else do
|
||||
liftIO $ removeFile (FP.normalise path)
|
||||
return $ Just $ fileName file
|
||||
else
|
||||
return $ Just $ fileName file
|
||||
) indFils
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
name: eidolon
|
||||
version: 0.0.5
|
||||
version: 0.0.6
|
||||
synopsis: Image gallery in Yesod
|
||||
homepage: https://eidolon.nek0.eu
|
||||
license: AGPL-3
|
||||
|
|
@ -117,6 +117,7 @@ library
|
|||
, unix >= 2.7
|
||||
, bloodhound >= 0.8
|
||||
, http-types
|
||||
, image-type
|
||||
-- for Migrations
|
||||
, HDBC
|
||||
, HDBC-postgresql
|
||||
|
|
|
|||
|
|
@ -107,6 +107,7 @@ extra-deps:
|
|||
- http-date-0.0.6.1
|
||||
- http-types-0.9
|
||||
- http2-1.3.1
|
||||
- image-type-0.1.0.0
|
||||
- imagemagick-0.0.4.1
|
||||
- iproute-1.7.0
|
||||
- kan-extensions-4.2.3
|
||||
|
|
|
|||
Loading…
Reference in a new issue