diff --git a/config/archive-types b/config/archive-types new file mode 100644 index 000000000..0599971bb --- /dev/null +++ b/config/archive-types @@ -0,0 +1,40 @@ +# Simple list of mime-types corresponding to archive-formats +# +# Comments are empty lines and any line for which the first non-whitespace symbol is ‘#’ +# +# Format is a single mime-type per line (may not contain whitespace) +# +# Largely copied from https://en.wikipedia.org/wiki/List_of_archive_formats + +application/x-archive +application/x-cpio +application/x-bcpio +application/x-shar +application/x-iso9660-image +application/x-sbx +application/x-tar +application/x-7z-compressed +application/x-ace-compressed +application/x-astrotite-afa +application/x-alz-compressed +application/vnd.android.package-archive +application/x-arj +application/x-b1 +application/vnd.ms-cab-compressed +application/x-cfs-compressed +application/x-dar +application/x-dgc-compressed +application/x-apple-diskimage +application/x-gca-compressed +application/java-archive +application/x-lzh +application/x-lzx +application/x-rar-compressed +application/x-stuffit +application/x-stuffitx +application/x-gtar +application/x-ms-wim +application/x-xar +application/zip +application/x-zoo +application/x-par2 \ No newline at end of file diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 83045e281..9ea58fd65 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -445,6 +445,7 @@ SubmissionSinkExceptionDuplicateFileTitle file@FilePath: Dateiname #{show file} SubmissionSinkExceptionDuplicateRating: Mehr als eine Bewertung gefunden. SubmissionSinkExceptionRatingWithoutUpdate: Bewertung gefunden, es ist hier aber keine Bewertung der Abgabe möglich. SubmissionSinkExceptionForeignRating smid@CryptoFileNameSubmission: Fremde Bewertung für Abgabe #{toPathPiece smid} enthalten. Bewertungen müssen sich immer auf die gleiche Abgabe beziehen! +SubmissionSinkExceptionInvalidFileTitleExtension file@FilePath: Dateiname #{show file} hat keine der für dieses Übungsblatt zulässigen Dateiendungen. MultiSinkException name@Text error@Text: In Abgabe #{name} ist ein Fehler aufgetreten: #{error} @@ -488,7 +489,7 @@ LastEdit: Letzte Änderung LastEditByUser: Ihre letzte Bearbeitung NoEditByUser: Nicht von Ihnen bearbeitet -SubmissionFilesIgnored: Es wurden Dateien in der hochgeladenen Abgabe ignoriert: +SubmissionFilesIgnored n@Int: Es #{pluralDE n "wurde" "wurden"} #{tshow n} #{pluralDE n "Datei" "Dateien"} in der hochgeladenen Abgabe ignoriert SubmissionDoesNotExist smid@CryptoFileNameSubmission: Es existiert keine Abgabe mit Nummer #{toPathPiece smid}. LDAPLoginTitle: Campus-Login @@ -507,8 +508,22 @@ DayIsOutOfLecture tid@TermId date@Text: #{date} ist außerhalb der Vorlesungszei DayIsOutOfTerm tid@TermId date@Text: #{date} liegt nicht im #{display tid} UploadModeNone: Kein Upload -UploadModeUnpack: Upload, einzelne Datei -UploadModeNoUnpack: Upload, ZIP-Archive entpacken +UploadModeAny: Upload, beliebige Datei(en) +UploadModeSpecific: Upload, vorgegebene Dateinamen + +UploadModeUnpackZips: Abgabe mehrerer Dateien +UploadModeUnpackZipsTip: Wenn die Abgabe mehrerer Dateien erlaubt ist, werden auch unterstützte Archiv-Formate zugelassen. Diese werden nach dann beim Hochladen automatisch entpackt. + +UploadModeExtensionRestriction: Zulässige Dateiendungen +UploadModeExtensionRestrictionTip: Komma-separiert. Wenn keine Dateiendungen angegeben werden erfolgt keine Einschränkung. + +UploadSpecificFiles: Vorgegebene Dateinamen +NoUploadSpecificFilesConfigured: Wenn der Abgabemodus vorgegebene Dateinamen vorsieht, muss mindestens ein vorgegebener Dateiname konfiguriert werden. +UploadSpecificFilesDuplicateNames: Vorgegebene Dateinamen müssen eindeutig sein +UploadSpecificFilesDuplicateLabels: Bezeichner für vorgegebene Dateinamen müssen eindeutig sein +UploadSpecificFileLabel: Bezeichnung +UploadSpecificFileName: Dateiname +UploadSpecificFileRequired: Zur Abgabe erforderlich NoSubmissions: Keine Abgabe CorrectorSubmissions: Abgabe extern mit Pseudonym diff --git a/routes b/routes index 40579f9e6..b1a1214bc 100644 --- a/routes +++ b/routes @@ -104,11 +104,11 @@ !/subs/new SubmissionNewR GET POST !timeANDcourse-registeredANDuser-submissions !/subs/own SubmissionOwnR GET !free -- just redirect /subs/#CryptoFileNameSubmission SubmissionR: - / SubShowR GET POST !ownerANDtime !ownerANDread !correctorANDread - /delete SubDelR GET POST !ownerANDtime + / SubShowR GET POST !ownerANDtimeANDuser-submissions !ownerANDread !correctorANDread + /delete SubDelR GET POST !ownerANDtimeANDuser-submissions /assign SAssignR GET POST !lecturerANDtime /correction CorrectionR GET POST !corrector !ownerANDreadANDrated - /invite SInviteR GET POST !ownerANDtime + /invite SInviteR GET POST !ownerANDtimeANDuser-submissions !/#SubmissionFileType SubArchiveR GET !owner !corrector !/#SubmissionFileType/*FilePath SubDownloadR GET !owner !corrector /correctors SCorrR GET POST diff --git a/src/Foundation.hs b/src/Foundation.hs index bf592b1b1..b1a1f6b97 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -280,18 +280,12 @@ embedRenderMessage ''UniWorX ''SubmissionModeDescr verbMap [_, _, v] = v <> "Submissions" verbMap _ = error "Invalid number of verbs" in verbMap . splitCamel +embedRenderMessage ''UniWorX ''UploadModeDescr id +embedRenderMessage ''UniWorX ''SecretJSONFieldException id newtype SheetTypeHeader = SheetTypeHeader SheetType embedRenderMessageVariant ''UniWorX ''SheetTypeHeader ("SheetType" <>) -instance RenderMessage UniWorX UploadMode where - renderMessage foundation ls uploadMode = case uploadMode of - NoUpload -> mr MsgUploadModeNone - Upload False -> mr MsgUploadModeNoUnpack - Upload True -> mr MsgUploadModeUnpack - where - mr = renderMessage foundation ls - instance RenderMessage UniWorX SheetType where renderMessage foundation ls sheetType = case sheetType of NotGraded -> mr $ SheetTypeHeader NotGraded diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs index 7a7cc36f8..6f13dba0c 100644 --- a/src/Handler/Admin.hs +++ b/src/Handler/Admin.hs @@ -2,7 +2,6 @@ module Handler.Admin where import Import import Handler.Utils -import Handler.Utils.Form.MassInput import Jobs import Data.Aeson.Encode.Pretty (encodePrettyToTextBuilder) @@ -261,7 +260,11 @@ postAdminErrMsgR = do [whamlet| $maybe t <- plaintext 
-          #{encodePrettyToTextBuilder t}
+          $case t
+            $of String t'
+              #{t'}
+            $of t'
+              #{encodePrettyToTextBuilder t'}
 
       ^{ctView'}
     |]
diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs
index 33bcb4992..bb547e7f7 100644
--- a/src/Handler/Corrections.hs
+++ b/src/Handler/Corrections.hs
@@ -644,7 +644,7 @@ postCorrectionR tid ssh csh shn cid = do
             }
 
       ((uploadResult, uploadForm'), uploadEncoding) <- runFormPost . identifyForm FIDcorrectionUpload . renderAForm FormStandard $
-            areq (zipFileField True) (fslI MsgRatingFiles) Nothing
+            areq (zipFileField True Nothing) (fslI MsgRatingFiles) Nothing
       let uploadForm = wrapForm uploadForm' def
             { formAction = Just . SomeRoute $ CSubmissionR tid ssh csh shn cid CorrectionR
             , formEncoding = uploadEncoding
@@ -720,7 +720,7 @@ getCorrectionsUploadR, postCorrectionsUploadR :: Handler Html
 getCorrectionsUploadR = postCorrectionsUploadR
 postCorrectionsUploadR = do
   ((uploadRes, upload), uploadEncoding) <- runFormPost . identifyForm FIDcorrectionsUpload . renderAForm FormStandard $
-       areq (zipFileField True) (fslI MsgCorrUploadField & addAttr "uw-file-input" "") Nothing
+       areq (zipFileField True Nothing) (fslI MsgCorrUploadField) Nothing
 
   case uploadRes of
     FormMissing -> return ()
diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index a274dbd92..5abd1e624 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -11,7 +11,6 @@ import Handler.Utils
 import Handler.Utils.Course
 import Handler.Utils.Tutorial
 import Handler.Utils.Communication
-import Handler.Utils.Form.MassInput
 import Handler.Utils.Delete
 import Handler.Utils.Database
 import Handler.Utils.Table.Cells
diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs
index 88af1d515..0b0b62e40 100644
--- a/src/Handler/Sheet.hs
+++ b/src/Handler/Sheet.hs
@@ -14,7 +14,6 @@ import Handler.Utils.Table.Cells
 -- import Handler.Utils.Table.Columns
 import Handler.Utils.SheetType
 import Handler.Utils.Delete
-import Handler.Utils.Form.MassInput
 import Handler.Utils.Invitations
 
 -- import Data.Time
@@ -116,7 +115,7 @@ makeSheetForm msId template = identifyForm FIDsheet $ \html -> do
             & setTooltip MsgSheetActiveFromTip)
                                                               (sfActiveFrom   <$> template)
       <*> areq utcTimeField   (fslI MsgSheetActiveTo)         (sfActiveTo     <$> template)
-      <*> submissionModeForm ((sfSubmissionMode <$> template) <|> pure (SubmissionMode False . Just $ Upload True))
+      <*> submissionModeForm ((sfSubmissionMode <$> template) <|> pure (SubmissionMode False . Just $ UploadAny True defaultExtensionRestriction))
       <*> aopt (multiFileField $ oldFileIds SheetExercise) (fslI MsgSheetExercise) (sfSheetF <$> template)
       <*> aopt utcTimeField   (fslpI MsgSheetHintFrom "Datum, sonst nur für Korrektoren"
             & setTooltip MsgSheetHintFromTip)                 (sfHintFrom     <$> template)
diff --git a/src/Handler/Submission.hs b/src/Handler/Submission.hs
index f9f04f8cc..12c605917 100644
--- a/src/Handler/Submission.hs
+++ b/src/Handler/Submission.hs
@@ -14,7 +14,6 @@ import Handler.Utils
 import Handler.Utils.Delete
 import Handler.Utils.Submission
 import Handler.Utils.Table.Cells
-import Handler.Utils.Form.MassInput
 import Handler.Utils.Invitations
 
 -- import Control.Monad.Trans.Maybe
@@ -130,8 +129,19 @@ makeSubmissionForm cid msmid uploadMode grouping isLecturer prefillUsers = ident
     fileUploadForm = case uploadMode of
       NoUpload
         -> pure Nothing
-      (Upload unpackZips)
-        -> (bool (\f fs _ -> Just <$> areq f fs Nothing) aopt $ isJust msmid) (zipFileField unpackZips) (fsm $ bool MsgSubmissionFile MsgSubmissionArchive unpackZips) Nothing
+      UploadAny{..}
+        -> (bool (\f fs _ -> Just <$> areq f fs Nothing) aopt $ isJust msmid) (zipFileField unpackZips extensionRestriction) (fsm $ bool MsgSubmissionFile MsgSubmissionArchive unpackZips) Nothing
+      UploadSpecific{..}
+        -> mergeFileSources <$> sequenceA (map specificFileForm . Set.toList $ toNullable specificFiles)
+
+    specificFileForm :: UploadSpecificFile -> AForm Handler (Maybe (Source Handler File))
+    specificFileForm spec@UploadSpecificFile{..}
+      = bool (\f fs d -> aopt f fs $ fmap Just d) (\f fs d -> Just <$> areq f fs d) specificFileRequired (specificFileField spec) (fsl specificFileLabel) Nothing
+
+    mergeFileSources :: [Maybe (Source Handler File)] -> Maybe (Source Handler File)
+    mergeFileSources (catMaybes -> sources) = case sources of
+      [] -> Nothing
+      fs -> Just $ sequence_ fs
 
     miCell' :: Markup -> Either UserEmail UserId -> Widget
     miCell' csrf (Left email) = $(widgetFile "widgets/massinput/submissionUsers/cellInvitation")
@@ -352,7 +362,9 @@ submissionHelper tid ssh csh shn mcid = do
               return (userName, submissionEdit E.^. SubmissionEditTime)
             forM raw $ \(E.Value name, E.Value time) -> (name, ) <$> formatTime SelFormatDateTime time
         return (csheet,buddies,lastEdits,maySubmit,isLecturer,isOwner)
-  ((res,formWidget'), formEnctype) <- runFormPost . makeSubmissionForm sheetCourse msmid (fromMaybe (Upload True) . submissionModeUser $ sheetSubmissionMode) sheetGrouping isLecturer $ bool id (Set.insert $ Right uid) isOwner buddies
+  -- @submissionModeUser == Nothing@ below iff we are currently serving a user with elevated rights (lecturer, admin, ...)
+  -- Therefore we do not restrict upload behaviour in any way in that case
+  ((res,formWidget'), formEnctype) <- runFormPost . makeSubmissionForm sheetCourse msmid (fromMaybe (UploadAny True Nothing) . submissionModeUser $ sheetSubmissionMode) sheetGrouping isLecturer $ bool id (Set.insert $ Right uid) isOwner buddies 
   let formWidget = wrapForm' BtnHandIn formWidget' def
         { formAction = Just $ SomeRoute actionUrl
         , formEncoding = formEnctype
diff --git a/src/Handler/Term.hs b/src/Handler/Term.hs
index 08e960581..c25ec43bb 100644
--- a/src/Handler/Term.hs
+++ b/src/Handler/Term.hs
@@ -3,7 +3,6 @@ module Handler.Term where
 import Import
 import Handler.Utils
 import Handler.Utils.Table.Cells
-import Handler.Utils.Form.MassInput
 import qualified Data.Map as Map
 
 import Utils.Lens
diff --git a/src/Handler/Tutorial.hs b/src/Handler/Tutorial.hs
index 534c7d1c1..2a98110c1 100644
--- a/src/Handler/Tutorial.hs
+++ b/src/Handler/Tutorial.hs
@@ -8,7 +8,6 @@ import Handler.Utils.Tutorial
 import Handler.Utils.Table.Cells
 import Handler.Utils.Delete
 import Handler.Utils.Communication
-import Handler.Utils.Form.MassInput
 import Handler.Utils.Form.Occurences
 import Handler.Utils.Invitations
 import Jobs.Queue
diff --git a/src/Handler/Utils/Communication.hs b/src/Handler/Utils/Communication.hs
index 843160372..042e90a52 100644
--- a/src/Handler/Utils/Communication.hs
+++ b/src/Handler/Utils/Communication.hs
@@ -9,7 +9,6 @@ module Handler.Utils.Communication
 
 import Import
 import Handler.Utils
-import Handler.Utils.Form.MassInput
 import Utils.Lens
 
 import Jobs.Queue
diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs
index 92fbccf72..a9dbe1ede 100644
--- a/src/Handler/Utils/Form.hs
+++ b/src/Handler/Utils/Form.hs
@@ -1,5 +1,6 @@
 module Handler.Utils.Form
   ( module Handler.Utils.Form
+  , module Handler.Utils.Form.MassInput
   , module Utils.Form
   , MonadWriter(..)
   ) where
@@ -35,6 +36,7 @@ import qualified Data.Map as Map
 import Control.Monad.Trans.Writer (execWriterT, WriterT)
 import Control.Monad.Trans.Except (throwE, runExceptT)
 import Control.Monad.Writer.Class
+import Control.Monad.Error.Class (MonadError(..))
 
 import Data.Scientific (Scientific)
 import Text.Read (readMaybe)
@@ -49,6 +51,13 @@ import Data.Proxy
 
 import qualified Text.Email.Validate as Email
 
+import Yesod.Core.Types (FileInfo(..))
+
+import System.FilePath (isExtensionOf)
+import Data.Text.Lens (unpacked)
+
+import Handler.Utils.Form.MassInput
+
 ----------------------------
 -- Buttons (new version ) --
 ----------------------------
@@ -341,14 +350,88 @@ studyFeaturesPrimaryFieldFor isOptional oldFeatures mbuid = selectField $ do
           }
 
 
-uploadModeField :: Field Handler UploadMode
-uploadModeField = selectField optionsFinite
+uploadModeForm :: Maybe UploadMode -> AForm Handler UploadMode
+uploadModeForm prev = multiActionA actions (fslI MsgSheetUploadMode) (classifyUploadMode <$> prev)
+  where
+    actions :: Map UploadModeDescr (AForm Handler UploadMode)
+    actions = Map.fromList
+      [ ( UploadModeNone, pure NoUpload)
+      , ( UploadModeAny
+        , UploadAny
+          <$> apreq checkBoxField (fslI MsgUploadModeUnpackZips & setTooltip MsgUploadModeUnpackZipsTip) (prev ^? _Just . _unpackZips)
+          <*> apreq extensionRestrictionField (fslI MsgUploadModeExtensionRestriction & setTooltip MsgUploadModeExtensionRestrictionTip) ((prev ^? _Just . _extensionRestriction) <|> fmap Just defaultExtensionRestriction)
+        )
+      , ( UploadModeSpecific
+        , UploadSpecific <$> specificFileForm
+        )
+      ]
+  
+    extensionRestrictionField :: Field Handler (Maybe (NonNull (Set Extension)))
+    extensionRestrictionField = convertField (fromNullable . toSet) (maybe "" $ intercalate ", " . Set.toList . toNullable) textField
+      where
+        toSet = Set.fromList . filter (not . Text.null) . map (stripDot . Text.strip) . Text.splitOn ","
+        stripDot ext
+          | Just nExt <- Text.stripPrefix "." ext = nExt
+          | otherwise = ext
+    
+    specificFileForm :: AForm Handler (NonNull (Set UploadSpecificFile))
+    specificFileForm = wFormToAForm $ do
+      Just currentRoute <- getCurrentRoute
+      let miButtonAction :: forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX)
+          miButtonAction frag = Just . SomeRoute $ currentRoute :#: frag
+      miIdent <- ("specific-files--" <>) <$> newIdent
+      postProcess =<< massInputW MassInput{..} (fslI MsgUploadSpecificFiles & setTooltip MsgMassInputTip) True (preProcess <$> prev ^? _Just . _specificFiles)
+      where
+        preProcess :: NonNull (Set UploadSpecificFile) -> Map ListPosition (UploadSpecificFile, UploadSpecificFile)
+        preProcess = Map.fromList . zip [0..] . map (\x -> (x, x)) . Set.toList . toNullable
+        
+        postProcess :: FormResult (Map ListPosition (UploadSpecificFile, UploadSpecificFile)) -> WForm Handler (FormResult (NonNull (Set UploadSpecificFile)))
+        postProcess mapResult = do
+          MsgRenderer mr <- getMsgRenderer
+          return $ do
+            mapResult' <- Set.fromList . map snd . Map.elems <$> mapResult
+            case fromNullable mapResult' of
+              Nothing -> throwError [mr MsgNoUploadSpecificFilesConfigured]
+              Just lResult -> do
+                let names = Set.map specificFileName mapResult'
+                    labels = Set.map specificFileLabel mapResult'
+                if
+                  | Set.size names /= Set.size mapResult'
+                    -> throwError [mr MsgUploadSpecificFilesDuplicateNames]
+                  | Set.size labels /= Set.size mapResult'
+                    -> throwError [mr MsgUploadSpecificFilesDuplicateLabels]
+                  | otherwise
+                    -> return lResult
+
+        sFileForm :: (Text -> Text) -> Maybe UploadSpecificFile -> Form UploadSpecificFile
+        sFileForm nudge mPrevUF csrf = do
+          (labelRes, labelView) <- mpreq textField ("" & addName (nudge "label")) $ specificFileLabel <$> mPrevUF
+          (nameRes, nameView) <- mpreq textField ("" & addName (nudge "name")) $ specificFileName <$> mPrevUF
+          (reqRes, reqView) <- mpreq checkBoxField ("" & addName (nudge "required")) $ specificFileRequired <$> mPrevUF
+
+          return ( UploadSpecificFile <$> labelRes <*> nameRes <*> reqRes
+                 , $(widgetFile "widgets/massinput/uploadSpecificFiles/form")
+                 )
+
+        miAdd _ _ nudge submitView = Just $ \csrf -> do
+          (formRes, formWidget) <- sFileForm nudge Nothing csrf
+          let formWidget' = $(widgetFile "widgets/massinput/uploadSpecificFiles/add")
+              addRes' = formRes <&> \fileRes oldRess ->
+                let iStart = maybe 0 (succ . fst) $ Map.lookupMax oldRess
+                 in pure $ Map.singleton iStart fileRes
+          return (addRes', formWidget')
+        miCell _ initFile initFile' nudge csrf =
+          sFileForm nudge (Just $ fromMaybe initFile initFile') csrf
+        miDelete = miDeleteList
+        miAllowAdd _ _ _ = True
+        miAddEmpty _ _ _ = Set.empty
+        miLayout :: MassInputLayout ListLength UploadSpecificFile UploadSpecificFile
+        miLayout lLength _ cellWdgts delButtons addWdgts = $(widgetFile "widgets/massinput/uploadSpecificFiles/layout")
+                                               
 
 submissionModeForm :: Maybe SubmissionMode -> AForm Handler SubmissionMode
 submissionModeForm prev = multiActionA actions (fslI MsgSheetSubmissionMode) $ classifySubmissionMode <$> prev
   where
-    uploadModeForm = apreq uploadModeField (fslI MsgSheetUploadMode) (preview (_Just . _submissionModeUser . _Just) $ prev)
-
     actions :: Map SubmissionModeDescr (AForm Handler SubmissionMode)
     actions = Map.fromList
       [ ( SubmissionModeNone
@@ -358,10 +441,10 @@ submissionModeForm prev = multiActionA actions (fslI MsgSheetSubmissionMode) $ c
         , pure $ SubmissionMode True  Nothing
         )
       , ( SubmissionModeUser
-        , SubmissionMode False . Just <$> uploadModeForm
+        , SubmissionMode False . Just <$> uploadModeForm (prev ^? _Just . _submissionModeUser . _Just)
         )
       , ( SubmissionModeBoth
-        , SubmissionMode True  . Just <$> uploadModeForm
+        , SubmissionMode True  . Just <$> uploadModeForm (prev ^? _Just . _submissionModeUser . _Just)
         )
       ]
 
@@ -374,17 +457,41 @@ pseudonymWordField = checkMMap doCheck CI.original $ textField & addDatalist (re
       | otherwise
       = return . Left $ MsgUnknownPseudonymWord (CI.original w)
 
-zipFileField :: Bool -- ^ Unpack zips?
-             -> Field Handler (Source Handler File)
-zipFileField doUnpack = Field{..}
+specificFileField :: UploadSpecificFile -> Field Handler (Source Handler File)
+specificFileField UploadSpecificFile{..} = Field{..}
   where
     fieldEnctype = Multipart
     fieldParse _ files
-      | [f] <- files = return . Right . Just $ bool (yieldM . acceptFile) sourceFiles doUnpack f
+      | [f] <- files
+      = return . Right . Just $ yieldM (acceptFile f) .| modifyFileTitle (const $ unpack specificFileName)
+      | null files   = return $ Right Nothing
+      | otherwise    = return . Left $ SomeMessage MsgOnlyUploadOneFile
+    fieldView fieldId fieldName attrs _ req = $(widgetFile "widgets/specificFileField")
+
+    extensions = fileNameExtensions specificFileName
+    acceptRestricted = not $ null extensions
+    accept = Text.intercalate "," . map ("." <>) $ extensions
+
+
+zipFileField :: Bool -- ^ Unpack zips?
+             -> Maybe (NonNull (Set Extension)) -- ^ Restrictions on file extensions
+             -> Field Handler (Source Handler File)
+zipFileField doUnpack permittedExtensions = Field{..}
+  where
+    fieldEnctype = Multipart
+    fieldParse _ files
+      | [f@FileInfo{..}] <- files
+      , maybe True (anyOf (re _nullable . folded . unpacked) (`isExtensionOf` unpack fileName)) permittedExtensions || doUnpack
+      = return . Right . Just $ bool (yieldM . acceptFile) sourceFiles doUnpack f
       | null files   = return $ Right Nothing
       | otherwise    = return . Left $ SomeMessage MsgOnlyUploadOneFile
     fieldView fieldId fieldName attrs _ req = $(widgetFile "widgets/zipFileField")
 
+    zipExtensions = mimeExtensions "application/zip"
+
+    acceptRestricted = isJust permittedExtensions
+    accept = Text.intercalate "," . map ("." <>) $ bool [] (Set.toList zipExtensions) doUnpack ++ toListOf (_Just . re _nullable . folded) permittedExtensions
+
 multiFileField :: Handler (Set FileId) -> Field Handler (Source Handler (Either FileId File))
 multiFileField permittedFiles' = Field{..}
   where
@@ -590,23 +697,6 @@ jsonField hide = Field{..}
     |]
     fieldEnctype = UrlEncoded
 
-secretJsonField :: ( ToJSON a, FromJSON a
-                   , MonadHandler m
-                   , HandlerSite m ~ UniWorX
-                   )
-                => Field m a
-secretJsonField = Field{..}
-  where
-    fieldParse [v] [] = bimap (\_ -> SomeMessage MsgSecretJSONFieldDecryptFailure) Just <$> runExceptT (encodedSecretBoxOpen v)
-    fieldParse [] [] = return $ Right Nothing
-    fieldParse _ _ = return . Left $ SomeMessage MsgValueRequired
-    fieldView theId name attrs val _isReq = do
-      val' <- traverse (encodedSecretBox SecretBoxShort) val
-      [whamlet|
-        
-      |]
-    fieldEnctype = UrlEncoded
-
 boolField :: ( MonadHandler m
              , HandlerSite m ~ UniWorX
              )
diff --git a/src/Handler/Utils/Form/MassInput.hs b/src/Handler/Utils/Form/MassInput.hs
index cd5e4f5ac..e9121be5f 100644
--- a/src/Handler/Utils/Form/MassInput.hs
+++ b/src/Handler/Utils/Form/MassInput.hs
@@ -17,7 +17,6 @@ module Handler.Utils.Form.MassInput
 import Import
 import Utils.Form
 import Utils.Lens
-import Handler.Utils.Form (secretJsonField)
 import Handler.Utils.Form.MassInput.Liveliness
 import Handler.Utils.Form.MassInput.TH
 
diff --git a/src/Handler/Utils/Form/Occurences.hs b/src/Handler/Utils/Form/Occurences.hs
index f39ec3323..da0e7733f 100644
--- a/src/Handler/Utils/Form/Occurences.hs
+++ b/src/Handler/Utils/Form/Occurences.hs
@@ -4,7 +4,6 @@ module Handler.Utils.Form.Occurences
 
 import Import
 import Handler.Utils.Form
-import Handler.Utils.Form.MassInput
 import Handler.Utils.DateTime
 
 import qualified Data.Set as Set
diff --git a/src/Handler/Utils/Submission.hs b/src/Handler/Utils/Submission.hs
index ef297bff4..09c59f6b3 100644
--- a/src/Handler/Utils/Submission.hs
+++ b/src/Handler/Utils/Submission.hs
@@ -318,8 +318,10 @@ extractRatingsMsg = do
   let ignoredFiles :: Set (Either CryptoFileNameSubmission FilePath)
       ignoredFiles = Right `Set.map` ignored'
   unless (null ignoredFiles) $ do
-    mr <- (toHtml . ) <$> getMessageRender
-    addMessage Warning =<< withUrlRenderer ($(ihamletFile "templates/messages/submissionFilesIgnored.hamlet") mr)
+    let ignoredModal = msgModal
+          [whamlet|_{MsgSubmissionFilesIgnored (Set.size ignoredFiles)}|]
+          (Right $(widgetFile "messages/submissionFilesIgnored"))
+    addMessageWidget Warning ignoredModal
 
 -- Nicht innerhalb von runDB aufrufen, damit das DB Rollback passieren kann!
 msgSubmissionErrors :: (MonadHandler m, MonadCatch m, HandlerSite m ~ UniWorX) => m a -> m (Maybe a)
@@ -362,10 +364,28 @@ sinkSubmission userId mExists isUpdate = do
       return sId
     Right sId -> return sId
 
-  sId <$ sinkSubmission' sId
+  Sheet{..} <- lift $ case mExists of
+    Left sheetId -> getJust sheetId
+    Right subId  -> getJust . submissionSheet =<< getJust subId
+
+  sId <$ (guardFileTitles sheetSubmissionMode .| sinkSubmission' sId)
   where
     tellSt = modify . mappend
 
+    guardFileTitles :: MonadThrow m => SubmissionMode -> Conduit SubmissionContent m SubmissionContent
+    guardFileTitles SubmissionMode{..}
+      | Just UploadAny{..} <- submissionModeUser
+      , not isUpdate
+      , Just (map unpack . Set.toList . toNullable -> exts) <- extensionRestriction
+      = Conduit.mapM $ \x -> if
+          | Left File{..} <- x
+          , none (`isExtensionOf` fileTitle) exts
+          , isn't _Nothing fileContent -- File record is not a directory, we don't care about those
+            -> throwM $ InvalidFileTitleExtension fileTitle
+          | otherwise
+            -> return x
+      | otherwise = Conduit.map id
+
     sinkSubmission' :: SubmissionId
                     -> Sink SubmissionContent (YesodJobDB UniWorX) ()
     sinkSubmission' submissionId = lift . finalize <=< execStateLC mempty . Conduit.mapM_ $ \case
diff --git a/src/Import/NoFoundation.hs b/src/Import/NoFoundation.hs
index 7006bd5e5..975ae3925 100644
--- a/src/Import/NoFoundation.hs
+++ b/src/Import/NoFoundation.hs
@@ -99,6 +99,8 @@ import Data.CaseInsensitive as Import (CI, FoldCase(..), foldedCase)
 
 import Data.Ratio as Import ((%))
 
+import Network.Mime as Import
+
 
 import Control.Monad.Trans.RWS (RWST)
 
diff --git a/src/Model/Migration.hs b/src/Model/Migration.hs
index f55638835..f220e4353 100644
--- a/src/Model/Migration.hs
+++ b/src/Model/Migration.hs
@@ -279,8 +279,8 @@ customMigrations = Map.fromListWith (>>)
                 ( Legacy.NoSubmissions       , _                   ) -> SubmissionMode False Nothing
                 ( Legacy.CorrectorSubmissions, _                   ) -> SubmissionMode True Nothing
                 ( Legacy.UserSubmissions     , Legacy.NoUpload     ) -> SubmissionMode False (Just NoUpload)
-                ( Legacy.UserSubmissions     , Legacy.Upload True  ) -> SubmissionMode False (Just $ Upload True)
-                ( Legacy.UserSubmissions     , Legacy.Upload False ) -> SubmissionMode False (Just $ Upload False)
+                ( Legacy.UserSubmissions     , Legacy.Upload True  ) -> SubmissionMode False (Just $ UploadAny True defaultExtensionRestriction)
+                ( Legacy.UserSubmissions     , Legacy.Upload False ) -> SubmissionMode False (Just $ UploadAny False defaultExtensionRestriction)
           [executeQQ| UPDATE "sheet" SET "submission_mode" = #{submissionMode'} WHERE "id" = #{shid}; |]
     )
   , ( AppliedMigrationKey [migrationVersion|11.0.0|] [version|12.0.0|]
diff --git a/src/Model/Submission.hs b/src/Model/Submission.hs
index 0f931911b..24ef1bad6 100644
--- a/src/Model/Submission.hs
+++ b/src/Model/Submission.hs
@@ -7,6 +7,7 @@ data SubmissionSinkException = DuplicateFileTitle FilePath
                              | DuplicateRating
                              | RatingWithoutUpdate
                              | ForeignRating CryptoFileNameSubmission
+                             | InvalidFileTitleExtension FilePath
   deriving (Typeable, Show)
 
 instance Exception SubmissionSinkException
diff --git a/src/Model/Types/Sheet.hs b/src/Model/Types/Sheet.hs
index a754d0d0b..6ec4ae4f0 100644
--- a/src/Model/Types/Sheet.hs
+++ b/src/Model/Types/Sheet.hs
@@ -16,7 +16,6 @@ import Generics.Deriving.Monoid (memptydefault, mappenddefault)
 import Data.Typeable (Typeable)
 import Data.Universe
 import Data.Universe.Helpers
-import Data.Universe.TH
 import Data.Universe.Instances.Reverse ()
 
 import Data.NonNull.Instances ()
@@ -34,6 +33,8 @@ import Database.Persist.TH hiding (derivePersistFieldJSON)
 import Model.Types.JSON
 import Yesod.Core.Dispatch (PathPiece(..))
 
+import Network.Mime
+
 
 
 ----
@@ -210,9 +211,11 @@ partitionFileType fs t = Map.findWithDefault Set.empty t . Map.fromListWith Set.
 data SubmissionFileType = SubmissionOriginal | SubmissionCorrected
   deriving (Show, Read, Eq, Ord, Enum, Bounded, Generic)
 
-instance Universe SubmissionFileType where universe = universeDef
+instance Universe SubmissionFileType
 instance Finite SubmissionFileType
 
+nullaryPathPiece ''SubmissionFileType $ camelToPathPiece' 1
+
 submissionFileTypeIsUpdate :: SubmissionFileType -> Bool
 submissionFileTypeIsUpdate SubmissionOriginal  = False
 submissionFileTypeIsUpdate SubmissionCorrected = True
@@ -221,41 +224,52 @@ isUpdateSubmissionFileType :: Bool -> SubmissionFileType
 isUpdateSubmissionFileType False = SubmissionOriginal
 isUpdateSubmissionFileType True  = SubmissionCorrected
 
-instance PathPiece SubmissionFileType where
-  toPathPiece SubmissionOriginal  = "original"
-  toPathPiece SubmissionCorrected = "corrected"
-  fromPathPiece = finiteFromPathPiece
 
--- instance DisplayAble SubmissionFileType where
---   display SubmissionOriginal  = "Abgabe"
---   display SubmissionCorrected = "Korrektur"
+data UploadSpecificFile = UploadSpecificFile
+  { specificFileLabel :: Text
+  , specificFileName :: FileName
+  , specificFileRequired :: Bool
+  } deriving (Show, Read, Eq, Ord, Generic)
 
-{-
-data DA = forall a . (DisplayAble a) => DA a
+deriveJSON defaultOptions
+  { fieldLabelModifier = camelToPathPiece' 2
+  } ''UploadSpecificFile
+derivePersistFieldJSON ''UploadSpecificFile
 
-instance DisplayAble DA where
-  display (DA x) = display x
--}
-
-
-data UploadMode = NoUpload | Upload { unpackZips :: Bool }
+data UploadMode = NoUpload
+                | UploadAny
+                  { unpackZips :: Bool
+                  , extensionRestriction :: Maybe (NonNull (Set Extension))
+                  }
+                | UploadSpecific
+                  { specificFiles :: NonNull (Set UploadSpecificFile)
+                  }
   deriving (Show, Read, Eq, Ord, Generic)
 
-deriveFinite ''UploadMode
+defaultExtensionRestriction :: Maybe (NonNull (Set Extension))
+defaultExtensionRestriction = fromNullable $ Set.fromList ["txt", "pdf"]
 
 deriveJSON defaultOptions
   { constructorTagModifier = camelToPathPiece
   , fieldLabelModifier = camelToPathPiece
   , sumEncoding = TaggedObject "mode" "settings"
+  , omitNothingFields = True
   }''UploadMode
 derivePersistFieldJSON ''UploadMode
 
-instance PathPiece UploadMode where
-  toPathPiece = \case
-    NoUpload     -> "no-upload"
-    Upload True  -> "unpack"
-    Upload False -> "no-unpack"
-  fromPathPiece = finiteFromPathPiece
+data UploadModeDescr = UploadModeNone
+                     | UploadModeAny
+                     | UploadModeSpecific
+  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
+instance Universe UploadModeDescr
+instance Finite UploadModeDescr
+
+nullaryPathPiece ''UploadModeDescr $ camelToPathPiece' 2
+
+classifyUploadMode :: UploadMode -> UploadModeDescr
+classifyUploadMode NoUpload = UploadModeNone
+classifyUploadMode UploadAny{} = UploadModeAny
+classifyUploadMode UploadSpecific{} = UploadModeSpecific
 
 data SubmissionMode = SubmissionMode
   { submissionModeCorrector :: Bool
@@ -263,24 +277,11 @@ data SubmissionMode = SubmissionMode
   }
   deriving (Show, Read, Eq, Ord, Generic)
 
-deriveFinite ''SubmissionMode
-
 deriveJSON defaultOptions
   { fieldLabelModifier = camelToPathPiece' 2
   } ''SubmissionMode
 derivePersistFieldJSON ''SubmissionMode
 
-finitePathPiece ''SubmissionMode
-  [ "no-submissions"
-  , "no-upload"
-  , "no-unpack"
-  , "unpack"
-  , "correctors"
-  , "correctors+no-upload"
-  , "correctors+no-unpack"
-  , "correctors+unpack"
-  ]
-
 data SubmissionModeDescr = SubmissionModeNone
                          | SubmissionModeCorrector
                          | SubmissionModeUser
@@ -336,4 +337,4 @@ instance Monoid Load where
   isByTutorial :: Load -> Bool
   isByTutorial (ByTutorial {}) = True
   isByTutorial _               = False
--}
\ No newline at end of file
+-}
diff --git a/src/Network/Mime/TH.hs b/src/Network/Mime/TH.hs
index 0fd1c2beb..486eda779 100644
--- a/src/Network/Mime/TH.hs
+++ b/src/Network/Mime/TH.hs
@@ -1,11 +1,12 @@
 module Network.Mime.TH
-  ( mimeMapFile
+  ( mimeMapFile, mimeSetFile
   ) where
 
 import ClassyPrelude.Yesod hiding (lift)
 import Language.Haskell.TH hiding (Extension)
 import Language.Haskell.TH.Syntax (qAddDependentFile, Lift(..))
 
+import qualified Data.Set as Set
 import qualified Data.Map as Map
 
 import Data.Text (Text)
@@ -18,7 +19,7 @@ import Network.Mime
 import Instances.TH.Lift ()
 
 
-mimeMapFile :: FilePath -> ExpQ
+mimeMapFile, mimeSetFile :: FilePath -> ExpQ
 mimeMapFile file = do
   qAddDependentFile file
   
@@ -36,6 +37,15 @@ mimeMapFile file = do
 
 
   lift mimeMap
+mimeSetFile file = do
+  qAddDependentFile file
+  
+  ls <- runIO $ filter (not . isComment) . Text.lines <$> Text.readFile file
+
+  let mimeSet :: Set MimeType
+      mimeSet = Set.fromList $ map (encodeUtf8 . Text.strip) ls
+
+  lift mimeSet
 
 isComment :: Text -> Bool
 isComment line = or
diff --git a/src/Settings.hs b/src/Settings.hs
index 739ac5554..a60b4597b 100644
--- a/src/Settings.hs
+++ b/src/Settings.hs
@@ -73,6 +73,9 @@ import Handler.Utils.Submission.TH
 import Network.Mime
 import Network.Mime.TH
 
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+
 
 -- | Runtime settings to configure this application. These settings can be
 -- loaded from various sources: defaults, environment variables, config files,
@@ -431,8 +434,17 @@ widgetFileSettings = def
 submissionBlacklist :: [Pattern]
 submissionBlacklist = $(patternFile compDefault "config/submission-blacklist")
 
+mimeMap :: MimeMap
+mimeMap = $(mimeMapFile "config/mimetypes")
+
 mimeLookup :: FileName -> MimeType
-mimeLookup = mimeByExt $(mimeMapFile "config/mimetypes") defaultMimeType
+mimeLookup = mimeByExt mimeMap defaultMimeType
+
+mimeExtensions :: MimeType -> Set Extension
+mimeExtensions needle = Set.fromList [ ext | (ext, typ) <- Map.toList mimeMap, typ == needle ]
+
+archiveTypes :: Set MimeType
+archiveTypes = $(mimeSetFile "config/archive-types")
 
 -- The rest of this file contains settings which rarely need changing by a
 -- user.
diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs
index ad62f224f..c11496380 100644
--- a/src/Utils/Form.hs
+++ b/src/Utils/Form.hs
@@ -24,6 +24,7 @@ import Control.Monad.Trans.Maybe (MaybeT(..))
 import Control.Monad.Reader.Class (MonadReader(..))
 import Control.Monad.Writer.Class (MonadWriter(..))
 import Control.Monad.Trans.RWS (mapRWST)
+import Control.Monad.Trans.Except (ExceptT, runExceptT)
 
 import Data.List ((!!))
 
@@ -445,6 +446,29 @@ optionsFinite = do
 rationalField :: (MonadHandler m, RenderMessage (HandlerSite m) FormMessage) => Field m Rational
 rationalField = convertField toRational fromRational doubleField
 
+data SecretJSONFieldException = SecretJSONFieldDecryptFailure
+  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
+instance Exception SecretJSONFieldException
+
+secretJsonField :: ( ToJSON a, FromJSON a
+                   , MonadHandler m
+                   , MonadSecretBox (ExceptT EncodedSecretBoxException m)
+                   , MonadSecretBox (WidgetT (HandlerSite m) IO)
+                   , RenderMessage (HandlerSite m) FormMessage
+                   , RenderMessage (HandlerSite m) SecretJSONFieldException
+                   )
+                => Field m a
+secretJsonField = Field{..}
+  where
+    fieldParse [v] [] = bimap (\_ -> SomeMessage SecretJSONFieldDecryptFailure) Just <$> runExceptT (encodedSecretBoxOpen v)
+    fieldParse [] [] = return $ Right Nothing
+    fieldParse _ _ = return . Left $ SomeMessage MsgValueRequired
+    fieldView theId name attrs val _isReq = do
+      val' <- traverse (encodedSecretBox SecretBoxShort) val
+      [whamlet|
+        
+      |]
+    fieldEnctype = UrlEncoded
 
 -----------
 -- Forms --
diff --git a/src/Utils/Lens.hs b/src/Utils/Lens.hs
index d52b852c8..51aa57fd0 100644
--- a/src/Utils/Lens.hs
+++ b/src/Utils/Lens.hs
@@ -103,6 +103,8 @@ makePrisms ''HandlerContents
 
 makePrisms ''ErrorResponse
 
+makeLenses_ ''UploadMode
+
 makeLenses_ ''SubmissionMode
 
 makePrisms ''E.Value
diff --git a/stack.yaml b/stack.yaml
index 7fadc6e4e..02b25ee57 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -51,4 +51,6 @@ extra-deps:
 
   - systemd-1.2.0
 
+  - filepath-1.4.2
+
 resolver: lts-10.5
diff --git a/templates/messages/submissionFilesIgnored.hamlet b/templates/messages/submissionFilesIgnored.hamlet
index ebb61695e..628125d9f 100644
--- a/templates/messages/submissionFilesIgnored.hamlet
+++ b/templates/messages/submissionFilesIgnored.hamlet
@@ -1,4 +1,4 @@
-_{MsgSubmissionFilesIgnored}
+
_{MsgSubmissionFilesIgnored (Set.size ignoredFiles)}