From 77fe8051d23e11a472b89b242ef1ab17d1dccf5f Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Wed, 21 Sep 2022 13:24:27 +0200 Subject: [PATCH] refactor(lms): correct pdf password sanitation and validation --- .../categories/settings/de-de-formal.msg | 5 +++-- .../uniworx/categories/settings/en-eu.msg | 3 ++- src/Handler/Profile.hs | 9 ++++---- src/Utils.hs | 22 +++++++++++++++++++ src/Utils/Print.hs | 14 ++++++------ 5 files changed, 39 insertions(+), 14 deletions(-) diff --git a/messages/uniworx/categories/settings/de-de-formal.msg b/messages/uniworx/categories/settings/de-de-formal.msg index a83448d11..3e28acf22 100644 --- a/messages/uniworx/categories/settings/de-de-formal.msg +++ b/messages/uniworx/categories/settings/de-de-formal.msg @@ -27,9 +27,10 @@ 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 +PDFPassword: Passwort zur Verschlüsselung von PDF Anhängen an Email Benachrichtigungens 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! +PDFPasswordInvalid c@Char: Bitte ein nicht-triviales Passwort für PDF Email Anhänge eintragen! Ungültiges Zeichen: #{char2Text c} +PDFPasswordTooShort n@Int: Bitte ein PDF Passwort mit mindestens #{show n} Zeichen wählen. 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 diff --git a/messages/uniworx/categories/settings/en-eu.msg b/messages/uniworx/categories/settings/en-eu.msg index c8b275f6e..aabf912ab 100644 --- a/messages/uniworx/categories/settings/en-eu.msg +++ b/messages/uniworx/categories/settings/en-eu.msg @@ -29,7 +29,8 @@ ShowSexTip: Should users' sex be displayed in (among others) lists of course par 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! +PDFPasswordInvalid c: Please supply a sensible password for encrypting PDF email attachments! Invalid character #{char2Text c} +PDFPasswordTooShort n: Please provide a password with at least #{show n} characters. 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 diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index 2d75f2ac1..3b79e91f7 100644 --- a/src/Handler/Profile.hs +++ b/src/Handler/Profile.hs @@ -440,12 +440,13 @@ validateSettings User{..} = do userDisplayName' <- use _stgDisplayName guardValidation MsgUserDisplayNameInvalid $ userDisplayName == userDisplayName' || -- unchanged or valid (invalid displayNames delivered by LDAP are preserved) - validDisplayName userTitle userFirstName userSurname userDisplayName' - + validDisplayName userTitle userFirstName userSurname userDisplayName' userPinPassword' <- use _stgPinPassword - guardValidation MsgPDFPasswordInvalid $ - validCmdArgument userPinPassword' -- used as CMD argument for pdftk + let pinBad = validCmdArgument userPinPassword' + pinMinChar = 5 + whenIsJust pinBad (tellValidationError . MsgPDFPasswordInvalid) -- used as CMD argument for pdftk + guardValidation (MsgPDFPasswordTooShort pinMinChar) $ pinMinChar <= length userPinPassword' userPostAddress' <- use _stgPostAddress let postalNotSet = isNothing userPostAddress' diff --git a/src/Utils.hs b/src/Utils.hs index f2c1be58c..d5ae8b839 100644 --- a/src/Utils.hs +++ b/src/Utils.hs @@ -275,6 +275,11 @@ addAttrsClass cl attrs = ("class", cl') : noClAttrs stripAll :: Text -> Text stripAll = Text.filter (not . isSpace) +-- | take first line, only +cropText :: Text -> Text +cropText (Text.lines -> l:_) = Text.take 80 l +cropText t = Text.take 80 t + -- | strip leading and trailing whitespace and make case insensitive -- also helps to avoid the need to import just for CI.mk stripCI :: Text -> CI Text @@ -292,6 +297,11 @@ citext2string = Text.unpack . CI.original text2Html :: Text -> Html text2Html = toHtml +char2Text :: Char -> Text +char2Text c + | isSpace c = "" + | otherwise = Text.singleton c + -- | Convert text as it is to Message, may prevent ambiguous types -- This function definition is mainly for documentation purposes text2message :: Text -> SomeMessage site @@ -327,6 +337,18 @@ withFragment form html = flip fmap form $ over _2 (toWidget html >>) charSet :: Text -> Set Char charSet = Text.foldl (flip Set.insert) mempty +-- | Returns Nothing iff both texts are identical, +-- otherwise a differing character is returned, preferable from the first argument +textDiff :: Text -> Text -> Maybe Char +textDiff (Text.uncons -> xs) (Text.uncons -> ys) + | Just (x,xt) <- xs + , Just (y,yt) <- ys + = if x == y + then textDiff xt yt + else Just x + | otherwise + = fst <$> (xs <|> ys) + -- | Convert `part` and `whole` into percentage including symbol -- showing trailing zeroes and to decimal digits textPercent :: Real a => a -> a -> Text diff --git a/src/Utils/Print.hs b/src/Utils/Print.hs index 04b088fb6..1bf9088b4 100644 --- a/src/Utils/Print.hs +++ b/src/Utils/Print.hs @@ -14,9 +14,10 @@ module Utils.Print ) where -- import Import.NoModel -import qualified Data.Foldable as Fold +import Data.Char (isSeparator) import qualified Data.Text as T import qualified Data.CaseInsensitive as CI +import qualified Data.Foldable as Fold import qualified Data.ByteString.Lazy as LBS import Control.Monad.Except @@ -332,12 +333,11 @@ readProcess' pc = do sanitizeCmdArg :: Text -> Text -sanitizeCmdArg t = - T.snoc (T.cons '\'' $ T.filter (\c -> '\'' /= 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) - +sanitizeCmdArg = T.filter (\c -> c /= '\'' && c /= '"' && c/= '\\' && not (isSeparator c)) +-- | Returns Nothing if ok, otherwise the first mismatching character +-- Pin Password is used as a commandline argument in Utils.Print.encryptPDF and hence poses a security risk +validCmdArgument :: Text -> Maybe Char +validCmdArgument t = t `textDiff` sanitizeCmdArg t -----------