refactor(lms): correct pdf password sanitation and validation

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

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

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 $
+  let pinBad = validCmdArgument userPinPassword' 
-    validCmdArgument userPinPassword' -- used as CMD argument for pdftk
+      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'

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 = "<Space>"
+  | 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

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 =   
+sanitizeCmdArg =  T.filter (\c -> c /= '\'' && c /= '"' && c/= '\\' && not (isSeparator c))
-  T.snoc (T.cons '\'' $ T.filter (\c -> '\'' /= c && '"' /= c && '\\' /= c) t) '\''
+-- | 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
+--   Pin Password is used as a commandline argument in Utils.Print.encryptPDF and hence poses a security risk 
-validCmdArgument :: Text -> Bool
+validCmdArgument :: Text -> Maybe Char
-validCmdArgument t = not (T.null t) && (T.cons '\'' (T.snoc t '\'') == sanitizeCmdArg t)
+validCmdArgument t = t `textDiff` sanitizeCmdArg t
-
 
 
 -----------