fix: csp-sandbox downloads

This commit is contained in:
Gregor Kleen 2020-11-26 16:29:32 +01:00
parent 211ff5eacc
commit 50cbba114a
2 changed files with 8 additions and 1 deletions

View File

@ -37,6 +37,7 @@ import Control.Monad.Logger
sendThisFile :: DBFile -> Handler TypedContent
sendThisFile File{..}
| Just fileContent' <- fileContent = do
setCSPSandbox
setContentDisposition' . Just $ takeFileName fileTitle
let cType = simpleContentType (mimeLookup $ pack fileTitle) <> "; charset=utf-8"
respondSourceDB cType $
@ -45,7 +46,8 @@ sendThisFile File{..}
sendFileReference :: forall file a. HasFileReference file => file -> Handler a
sendFileReference (view (_FileReference . _1) -> fRef@FileReference{..}) = do
when (is _Just fileReferenceContent) $
when (is _Just fileReferenceContent) $ do
setCSPSandbox
setContentDisposition' . Just $ takeFileName fileReferenceTitle
let cType = simpleContentType (mimeLookup $ pack fileReferenceTitle) <> "; charset=utf-8"
join . runDB $ respondFileConditional Nothing cType fRef
@ -77,6 +79,7 @@ serveSomeFiles' archiveName source = do
[] -> notFound
[file] -> either sendFileReference sendThisFile file
_moreFiles -> do
setCSPSandbox
setContentDisposition' $ Just archiveName
respondSourceDB typeZip $ do
let zipComment = T.encodeUtf8 $ pack archiveName
@ -97,6 +100,7 @@ serveZipArchive' archiveName source = do
case results of
[] -> notFound
_moreFiles -> do
setCSPSandbox
setContentDisposition' $ Just archiveName
respondSourceDB typeZip $ do
let zipComment = T.encodeUtf8 $ pack archiveName

View File

@ -1052,6 +1052,9 @@ setContentDisposition cd (fmap pack -> mFName) = replaceOrAddHeader (decodeUtf8
| otherwise
= toPathPiece cd
setCSPSandbox :: MonadHandler m => m ()
setCSPSandbox = replaceOrAddHeader "Content-Security-Policy" "sandbox;"
------------------
-- Cryptography --
------------------