fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

feat(submissions): ignore additional filename components

Browse Source
This commit is contained in:
Gregor Kleen 2020-04-17 11:57:02 +02:00
parent 9a2913d722
commit 38f69c3aed
1 changed files with 6 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/Handler/Utils/Submission.hs
View File

@ -678,12 +678,13 @@ sinkMultiSubmission userId isUpdate = do
acc (Just sId, fp) segment = return (Just sId, fp ++ [segment]) acc (Just sId, fp) segment = return (Just sId, fp ++ [segment])
acc (Nothing , fp) segment = do acc (Nothing , fp) segment = do
let let
tryDecrypt (Text.pack -> ciphertext) segments' = filter (not . Text.null) . Text.split (flip Set.notMember cryptoIdChars . CI.mk) $ Text.pack segment
tryDecrypt ciphertext
| Just cID <- fromPathPiece ciphertext = do | Just cID <- fromPathPiece ciphertext = do
sId <- decrypt (cID :: CryptoFileNameSubmission) sId <- decrypt (cID :: CryptoFileNameSubmission)
Just sId <$ get404 sId Just sId <$ get404 sId
| otherwise = return Nothing | otherwise = return Nothing
msId <- lift (lift (tryDecrypt segment) `catches` [ E.Handler handleCryptoID, E.Handler (handleHCError $ Right fileTitle) ]) Alt msId <- lift . flip foldMapM segments' $ \seg -> Alt <$> lift (tryDecrypt seg) `catches` [ E.Handler handleCryptoID, E.Handler (handleHCError $ Right fileTitle) ]
return (msId, fp) return (msId, fp)
(msId, (joinPath -> fileTitle')) <- foldM acc (Nothing, []) $ splitDirectories fileTitle (msId, (joinPath -> fileTitle')) <- foldM acc (Nothing, []) $ splitDirectories fileTitle
case msId of case msId of
@ -708,6 +709,9 @@ sinkMultiSubmission userId isUpdate = do
handleCryptoID :: CryptoIDError -> _ (Maybe a) handleCryptoID :: CryptoIDError -> _ (Maybe a)
handleCryptoID _ = return Nothing handleCryptoID _ = return Nothing
cryptoIdChars :: Set (CI Char)
cryptoIdChars = Set.fromList . map CI.mk $ "uwa" ++ "ABCDEFGHIJKLMNOPQRSTUVWXYZ234567"
submissionMatchesSheet :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> DB SubmissionId submissionMatchesSheet :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> DB SubmissionId
submissionMatchesSheet tid ssh csh shn cid = do submissionMatchesSheet tid ssh csh shn cid = do