diff --git a/messages/uniworx/categories/settings/de-de-formal.msg b/messages/uniworx/categories/settings/de-de-formal.msg index ac114ffe3..a83448d11 100644 --- a/messages/uniworx/categories/settings/de-de-formal.msg +++ b/messages/uniworx/categories/settings/de-de-formal.msg @@ -27,6 +27,16 @@ WarningDaysTip: Wie viele Tage im Voraus sollen Fristen von Prüfungen etc. auf ShowSex: Geschlechter anderer Nutzer:innen anzeigen ShowSexTip: Sollen in Kursteilnehmer:innen-Tabellen u.Ä. die Geschlechter der Nutzer:innen angezeigt werden? +PDFPassword: Passwort zur Verschlüsselung von PDF Anhängen an Email Benachrichtigungen +PDFPasswordTip: Achtung, dieses Passwort ist für FRADrive Administratoren einsehbar und wird unverschlüsselt gespeichert! +PDFPasswordInvalid: Bitte ein nicht-triviales Passwort ohne Leerzeichen für PDF Email Anhänge eintragen! +PrefersPostal: Sollen Benachrichtigung möglichst per Post versendet werden anstatt per Email? +PostalTip: Postversand kann in Rechnung gestellt werden und ist derzeit nur für Benachrichtigungen über Erneuerung und Ablauf von Qualifikation, wie z.B. Führerscheine, verfügbar. +PostAddress: Postalische Adresse +PostAddressTip: Mindestens eine Zeile mit Straße und Hausnummer und eine Zeile mit Postleitzahl und Ort. Kein Empfängername, denn dieser wird später automatisch hinzugefügt. +UserPostalInvalid: Postadresse muss mindestens eine Zeile mit Straße und Hausnummer und eine separate Zeile mit Postleitzahl und Ort enthalten! +UserPrefersPostalInvalid: Entweder postalische Benachrichtigungen deaktivieren oder eine Postadresse angeben! + FormNotifications: Benachrichtigungen UserSchools: Relevante Institute diff --git a/messages/uniworx/categories/settings/en-eu.msg b/messages/uniworx/categories/settings/en-eu.msg index 4b5113ba7..c8b275f6e 100644 --- a/messages/uniworx/categories/settings/en-eu.msg +++ b/messages/uniworx/categories/settings/en-eu.msg @@ -27,6 +27,16 @@ WarningDaysTip: How many days ahead should deadlines regarding exams etc. be dis ShowSex: Show sex of other users ShowSexTip: Should users' sex be displayed in (among others) lists of course participants? +PDFPassword: Password to lock PDF email attachments +PDFPasswordTip: Please note that this password is displayed to FRADrive admins and is saved unencrypted +PDFPasswordInvalid: Please supply a sensible password for encrypting PDF email attachments! +PrefersPostal: Should notifications preferably send by post instead of email? +PostalTip: Mailing may incur a fee and is currently only avaulable for qualification expiry notifications, such as driving lincence renewal. +PostAddress: Postal address +PostAddressTip: Should contain at least one line with street and house number and another line featuring zip code and town. Omit a recipient name, since it will be added later. +UserPostalInvalid: Postal address must have at least one line with street and house number and another with zip code and town! +UserPrefersPostalInvalid: Either deactivate postal notification or supply a valid postal address! + FormNotifications: Notifications UserSchools: Relevant departments diff --git a/messages/uniworx/categories/user/de-de-formal.msg b/messages/uniworx/categories/user/de-de-formal.msg index e7a9e1669..8c794e228 100644 --- a/messages/uniworx/categories/user/de-de-formal.msg +++ b/messages/uniworx/categories/user/de-de-formal.msg @@ -15,6 +15,7 @@ AdminUserFDepartment: Abteilung AdminUserPostAddress: Postalische Anschrift AdminUserPrefersPostal: Briefe anstatt Email bevorzugt AdminUserPinPassword: Passwort zur Verschlüsselung von PDF Anhängen in Emails +AdminUserNoPassword: Kein Passwort gesetzt AdminUserAssimilate: Benutzer assimilieren UserAdded: Benutzer erfolgreich angelegt UserCollision: Benutzer konnte wegen Eindeutigkeit nicht angelegt werden diff --git a/messages/uniworx/categories/user/en-eu.msg b/messages/uniworx/categories/user/en-eu.msg index b918f5bde..53d03d0a7 100644 --- a/messages/uniworx/categories/user/en-eu.msg +++ b/messages/uniworx/categories/user/en-eu.msg @@ -14,7 +14,8 @@ AdminUserFPersonalNumber: Personalnumber (Fraport AG only) AdminUserFDepartment: Department AdminUserPostAddress: Postal Address AdminUserPrefersPostal: Prefers postal letters over email -AdminUserPinPassword: Password used for all PDF attachments to emails +AdminUserPinPassword: Password used for PDF attachments to emails +AdminUserNoPassword: No password set AdminUserAssimilate: Assimilate user UserAdded: Successfully added user UserCollision: Could not create user due to uniqueness constraint diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index 3e2852395..b014a6a4e 100644 --- a/src/Handler/Profile.hs +++ b/src/Handler/Profile.hs @@ -13,6 +13,8 @@ import Import import Handler.Utils import Handler.Utils.Profile +import Utils.Print (validCmdArgument) + -- import Colonnade hiding (fromMaybe, singleton) -- import Yesod.Colonnade import Data.Map ((!)) @@ -57,6 +59,11 @@ data SettingsForm = SettingsForm , stgDownloadFiles :: Bool , stgWarningDays :: NominalDiffTime , stgShowSex :: Bool + + , stgPinPassword :: Text + , stgPrefersPostal :: Bool + , stgPostAddress :: Maybe StoredMarkup + , stgExamOfficeSettings :: ExamOfficeSettings , stgSchools :: Set SchoolId , stgNotificationSettings :: NotificationSettings @@ -130,8 +137,13 @@ makeSettingForm template html = do & setTooltip MsgWarningDaysTip ) (stgWarningDays <$> template) <*> apopt checkBoxField (fslI MsgShowSex & setTooltip MsgShowSexTip) (stgShowSex <$> template) - <*> examOfficeForm (stgExamOfficeSettings <$> template) + <* aformSection MsgFormNotifications + <*> areq (textField & cfStrip) (fslI MsgPDFPassword & setTooltip MsgPDFPasswordTip) (stgPinPassword <$> template) + <*> apopt checkBoxField (fslI MsgPrefersPostal & setTooltip MsgPostalTip) (stgPrefersPostal <$> template) + <*> aopt htmlField (fslI MsgPostAddress & setTooltip MsgPostAddressTip) (stgPostAddress <$> template) + + <*> examOfficeForm (stgExamOfficeSettings <$> template) <*> schoolsForm (stgSchools <$> template) <*> notificationForm (stgNotificationSettings <$> template) <*> allocationNotificationForm (stgAllocationNotificationSettings <$> template) @@ -426,10 +438,23 @@ examOfficeForm template = wFormToAForm $ do validateSettings :: User -> FormValidator SettingsForm Handler () validateSettings User{..} = do userDisplayName' <- use _stgDisplayName - guardValidation MsgUserDisplayNameInvalid $ validDisplayName userTitle userFirstName userSurname userDisplayName' + userPinPassword' <- use _stgPinPassword + guardValidation MsgPDFPasswordInvalid $ + validCmdArgument userPinPassword' -- used as CMD argument for pdftk + + userPostAddress' <- use _stgPostAddress + let postalNotSet = isNothing userPostAddress' + postalIsValid = validPostAddress userPostAddress' + guardValidation MsgUserPostalInvalid $ + postalNotSet || postalIsValid + + userPrefersPostal' <- use _stgPrefersPostal + guardValidation MsgUserPrefersPostalInvalid $ + not $ userPrefersPostal' && postalNotSet + data ButtonResetTokens = BtnResetTokens deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable) @@ -478,6 +503,9 @@ postProfileR = do , stgNotificationSettings = userNotificationSettings , stgWarningDays = userWarningDays , stgShowSex = userShowSex + , stgPinPassword = fromMaybe "" userPinPassword + , stgPostAddress = userPostAddress + , stgPrefersPostal = userPrefersPostal , stgExamOfficeSettings = ExamOfficeSettings { eosettingsGetSynced = userExamOfficeGetSynced , eosettingsGetLabels = userExamOfficeGetLabels @@ -501,6 +529,9 @@ postProfileR = do , UserWarningDays =. stgWarningDays , UserNotificationSettings =. stgNotificationSettings , UserShowSex =. stgShowSex + , UserPinPassword =. Just stgPinPassword + , UserPostAddress =. stgPostAddress + , UserPrefersPostal =. stgPrefersPostal , UserExamOfficeGetSynced =. (stgExamOfficeSettings & eosettingsGetSynced) , UserExamOfficeGetLabels =. (stgExamOfficeSettings & eosettingsGetLabels) ] ++ [ UserDisplayEmail =. stgDisplayEmail | userDisplayEmail == stgDisplayEmail ] diff --git a/src/Handler/Utils/Profile.hs b/src/Handler/Utils/Profile.hs index ed3894955..082048456 100644 --- a/src/Handler/Utils/Profile.hs +++ b/src/Handler/Utils/Profile.hs @@ -1,12 +1,16 @@ module Handler.Utils.Profile ( checkDisplayName , validDisplayName - , fixDisplayName + , fixDisplayName + , validPostAddress ) where import Import.NoFoundation +import Data.Char import qualified Data.Text as Text +import qualified Data.Text.Lazy as LT + import qualified Data.MultiSet as MultiSet import qualified Data.Set as Set @@ -49,3 +53,13 @@ validDisplayName (fmap Text.strip -> mTitle) (Text.strip -> fName) (Text.strip - isAdd = (`Set.member` addLetters) splitAdd = Text.split isAdd makeMultiSet = MultiSet.fromList . filter (not . Text.null) . splitAdd + +-- | Primitive postal address requires at least one alphabetic character, one digit and a line break +validPostAddress :: Maybe StoredMarkup -> Bool +validPostAddress (Just StoredMarkup {markupInput = addr}) + | Just _ <- LT.find isLetter addr + , Just _ <- LT.find isNumber addr + -- , Just _ <- LT.find ((LineSeparator ==) . generalCategory) addr -- THIS DID NOT WORK + , 1 < length (LT.lines addr) + = True +validPostAddress _ = False diff --git a/src/Utils/Icon.hs b/src/Utils/Icon.hs index 3b9013506..b9d3420a8 100644 --- a/src/Utils/Icon.hs +++ b/src/Utils/Icon.hs @@ -106,6 +106,7 @@ data Icon | IconReset | IconBlocked | IconPrintCenter + | IconAt deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic, Typeable) deriving anyclass (Universe, Finite, NFData) @@ -144,7 +145,7 @@ iconText = \case IconSFTHint -> "life-ring" -- for SheetFileType only IconSFTSolution -> "exclamation-circle" -- for SheetFileType only IconSFTMarking -> "check-circle" -- for SheetFileType only - IconEmail -> "envelope" + IconEmail -> "envelope" -- envelope is no longer unamibuous IconRegisterTemplate -> "file-alt" IconApplyTrue -> "file-alt" IconApplyFalse -> "trash" @@ -195,6 +196,7 @@ iconText = \case IconReset -> "undo" -- From fontawesome v6 onwards: "arrow-rotate-left" IconBlocked -> "ban" IconPrintCenter -> "mail-bulk" -- From fontawesome v6 onwards: "envelope-bulk" + IconAt -> "at" nullaryPathPiece ''Icon $ camelToPathPiece' 1 deriveLift ''Icon diff --git a/src/Utils/Print.hs b/src/Utils/Print.hs index e118ab525..6e54d84ee 100644 --- a/src/Utils/Print.hs +++ b/src/Utils/Print.hs @@ -4,6 +4,7 @@ module Utils.Print ( pdfRenewal , sendLetter , encryptPDF + , sanitizeCmdArg, validCmdArgument , templateDIN5008 , templateRenewal -- , compileTemplate, makePDF @@ -271,8 +272,8 @@ sendLetter printJobName pdf printJobRecipient printJobSender printJobCourse prin nameCourse = CI.original . courseShorthand <$> course nameQuali = CI.original . qualificationShorthand <$> quali let printJobAcknowledged = Nothing - jobFullName = unpack $ T.replace " " "-" (T.intercalate "_" . catMaybes $ [Just printJobName, nameQuali, nameCourse, nameSender, nameRecipient]) - printJobFilename = jobFullName <> ".pdf" + jobFullName = T.replace " " "-" (T.intercalate "_" . catMaybes $ [Just printJobName, nameQuali, nameCourse, nameSender, nameRecipient]) + printJobFilename = T.unpack $ jobFullName <> ".pdf" -- printJobFile <- sinkFileDB True $ yield $ LBS.toStrict pdf -- for PrintJobFile :: FileContentReference use this code printJobFile = LBS.toStrict pdf lprPDF jobFullName pdf >>= \case @@ -328,6 +329,12 @@ readProcess' pc = do return (ec, st_err, st_out) +sanitizeCmdArg :: Text -> Text +sanitizeCmdArg t = + T.snoc (T.cons '"' $ T.filter (\c -> '"' /= c && '\\' /= c) t) '"' +-- | Pin Password is used as a commandline argument in Utils.Print.encryptPDF and hence poses a security risk +validCmdArgument :: Text -> Bool +validCmdArgument t = not (T.null t) && (T.cons '"' (T.snoc t '"') == sanitizeCmdArg t) ----------- -- pdftk -- @@ -342,10 +349,11 @@ readProcess' pc = do encryptPDF :: MonadIO m => Text -> LBS.ByteString -> m (Either Text LBS.ByteString) encryptPDF pw bs = over _Left (decodeUtf8 . LBS.toStrict) . exit2either <$> readProcess pc where - pc = setStdin (byteStringInput bs) $ + pw' = sanitizeCmdArg pw + pc = setStdin (byteStringInput bs) $ proc "pdftk" [ "-" -- read from stdin , "output", "-" -- write to stdout - , "user_pw", T.unpack pw -- encrypt pdf content + , "user_pw", T.unpack pw' -- encrypt pdf content , "dont_ask" -- no interaction , "allow", "Printing" -- allow printing despite encryption ] @@ -366,7 +374,7 @@ encryptPDF pw bs = over _Left (decodeUtf8 . LBS.toStrict) . exit2either <$> read -- > lpr -P fradrive -H fravm017173.fra.fraport.de:515 -T printJobName - -- | Internal only, use `sendLetter` instead -lprPDF :: (MonadHandler m, HasAppSettings (HandlerSite m)) => String -> LBS.ByteString -> m (Either Text Text) +lprPDF :: (MonadHandler m, HasAppSettings (HandlerSite m)) => Text -> LBS.ByteString -> m (Either Text Text) lprPDF jb bs = do lprServerArg <- $cachedHereBinary ("lprServer"::Text) getLprServerArg let pc = setStdin (byteStringInput bs) $ @@ -376,7 +384,8 @@ lprPDF jb bs = do , "-" -- read from stdin ] jobname | null jb = [] - | otherwise = ["-J " <> jb] + | otherwise = ["-J " <> jb'] + jb' = T.unpack $ sanitizeCmdArg jb exit2either <$> readProcess' pc where getLprServerArg = do @@ -397,4 +406,4 @@ lprPDF' jb bs = do jobname | null jb = [] | otherwise = ["-J " <> jb] exit2either <$> readProcess' pc --} \ No newline at end of file +-} diff --git a/templates/profileData.hamlet b/templates/profileData.hamlet index 95a25aa46..9ca6dba55 100644 --- a/templates/profileData.hamlet +++ b/templates/profileData.hamlet @@ -19,14 +19,14 @@ $newline never
#{matnr} $maybe addr <- userPostAddress +
+ _{MsgPrefersPostal} +
+ #{icon (bool IconAt IconPrintCenter userPrefersPostal)}
_{MsgAdminUserPostAddress}
#{addr} -
- _{MsgAdminUserPrefersPostal} -
- #{show userPrefersPostal}
_{MsgTableEmail}
@@ -39,10 +39,10 @@ $newline never
_{MsgAdminUserPinPassword}
- $maybe _pass <- userPinPassword - OK + $maybe pass <- userPinPassword + #{pass} $nothing - NO + _{MsgAdminUserNoPassword} $maybe telephonenr <- userTelephone
_{MsgUserTelephone}