diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg index 3d52ca2b6..fff9e6611 100644 --- a/messages/uniworx/de-de-formal.msg +++ b/messages/uniworx/de-de-formal.msg @@ -2880,4 +2880,16 @@ SystemExamOffice: Prüfungsverwaltung SystemFaculty: Fakultätsmitglied ChangelogItemFeature: Feature -ChangelogItemBugfix: Bugfix \ No newline at end of file +ChangelogItemBugfix: Bugfix + +InvalidCredentialsADNoSuchObject: Benutzereintrag existiert nicht +InvalidCredentialsADLogonFailure: Ungültiges Passwort +InvalidCredentialsADAccountRestriction: Kontobeschränkungen verhindern Login +InvalidCredentialsADInvalidLogonHours: Benutzer darf sich zur aktuellen Tageszeit nicht anmelden +InvalidCredentialsADInvalidWorkstation: Benutzer darf sich von diesem System aus nicht anmelden +InvalidCredentialsADPasswordExpired: Passwort abgelaufen +InvalidCredentialsADAccountDisabled: Benutzereintrag gesperrt +InvalidCredentialsADTooManyContextIds: Benutzereintrag trägt zu viele Sicherheitskennzeichen +InvalidCredentialsADAccountExpired: Benutzereintrag abgelaufen +InvalidCredentialsADPasswordMustChange: Passwort muss geändert werden +InvalidCredentialsADAccountLockedOut: Benutzereintrag wurde durch Eindringlingserkennung gesperrt \ No newline at end of file diff --git a/messages/uniworx/en-eu.msg b/messages/uniworx/en-eu.msg index 41d77282b..74fb98ab2 100644 --- a/messages/uniworx/en-eu.msg +++ b/messages/uniworx/en-eu.msg @@ -2883,3 +2883,15 @@ SystemFaculty: Faculty member ChangelogItemFeature: Feature ChangelogItemBugfix: Bugfix + +InvalidCredentialsADNoSuchObject: User entry does not exist +InvalidCredentialsADLogonFailure: Invalid passwod +InvalidCredentialsADAccountRestriction: Account restrictions are preventing login +InvalidCredentialsADInvalidLogonHours: User may not login at the current time of day +InvalidCredentialsADInvalidWorkstation: User may not login from this system +InvalidCredentialsADPasswordExpired: Password expired +InvalidCredentialsADAccountDisabled: Account disabled +InvalidCredentialsADTooManyContextIds: Account carries to many security identifiers +InvalidCredentialsADAccountExpired: Account expired +InvalidCredentialsADPasswordMustChange: Password needs to be changed +InvalidCredentialsADAccountLockedOut: Account disabled by intruder detection diff --git a/package.yaml b/package.yaml index f74e06638..5d3e8bc73 100644 --- a/package.yaml +++ b/package.yaml @@ -70,6 +70,7 @@ dependencies: - blaze-html - conduit-resumablesink >=0.2 - parsec + - parsec-numbers - attoparsec - uuid - exceptions diff --git a/src/Auth/LDAP.hs b/src/Auth/LDAP.hs index 007178793..c8e49ab16 100644 --- a/src/Auth/LDAP.hs +++ b/src/Auth/LDAP.hs @@ -1,5 +1,6 @@ module Auth.LDAP ( apLdap + , ADError(..), ADInvalidCredentials(..) , campusLogin , CampusUserException(..) , campusUser, campusUser' @@ -26,6 +27,8 @@ import qualified Data.Text.Encoding as Text import qualified Yesod.Auth.Message as Msg +import Auth.LDAP.AD + data CampusLogin = CampusLogin { campusIdent :: CI Text @@ -155,6 +158,13 @@ campusUserMatr' pool mode +newtype ADInvalidCredentials = ADInvalidCredentials ADError + deriving (Eq, Ord, Read, Show, Generic, Typeable) + +isUnusualADError :: ADError -> Bool +isUnusualADError = flip notElem [ADNoSuchObject, ADLogonFailure] + + campusForm :: ( RenderMessage (HandlerSite m) FormMessage , RenderMessage (HandlerSite m) (ValueRequired (HandlerSite m)) , RenderMessage (HandlerSite m) CampusMessage @@ -174,6 +184,7 @@ campusLogin :: forall site. , RenderMessage site CampusMessage , RenderMessage site AFormMessage , RenderMessage site (ValueRequired site) + , RenderMessage site ADInvalidCredentials , Button site ButtonSubmit ) => Failover (LdapConf, LdapPool) -> FailoverMode -> AuthPlugin site campusLogin pool mode = AuthPlugin{..} @@ -203,6 +214,14 @@ campusLogin pool mode = AuthPlugin{..} $logErrorS apName $ "Error during login: " <> tshow err observeLoginOutcome apName LoginError loginErrorMessageI LoginR Msg.AuthError + Right (Left (Ldap.ResponseErrorCode _ errCode _ errTxt)) + | Right adError <- parseADError errCode errTxt + , isUnusualADError adError -> do + $logInfoS apName [st|#{campusIdent}: #{toPathPiece adError}|] + observeLoginOutcome apName LoginADInvalidCredentials + setSessionJson SessionError . InternalError $ toPathPiece adError + MsgRenderer mr <- liftHandler getMsgRenderer + loginErrorMessage (tp LoginR) . mr $ ADInvalidCredentials adError Right (Left bindErr) -> do case bindErr of Ldap.ResponseErrorCode _ _ _ errTxt -> diff --git a/src/Auth/LDAP/AD.hs b/src/Auth/LDAP/AD.hs new file mode 100644 index 000000000..58d0ca4f8 --- /dev/null +++ b/src/Auth/LDAP/AD.hs @@ -0,0 +1,76 @@ +module Auth.LDAP.AD + ( ADError(..) + , parseADError + ) where + +import Import.NoFoundation hiding (try) + +import Model.Types.TH.PathPiece + +import qualified Data.IntMap.Strict as IntMap +import qualified Data.Map.Strict as Map + +import Text.Parsec hiding ((<|>)) +import Text.Parsec.String +import Text.ParserCombinators.Parsec.Number (hexnum) + +import Ldap.Client (ResultCode(..)) + + +-- | Copied from +data ADError + = ADNoSuchObject + | ADLogonFailure + | ADAccountRestriction + | ADInvalidLogonHours + | ADInvalidWorkstation + | ADPasswordExpired + | ADAccountDisabled + | ADTooManyContextIds + | ADAccountExpired + | ADPasswordMustChange + | ADAccountLockedOut + deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable) + deriving anyclass (Universe, Finite) + +nullaryPathPiece ''ADError $ camelToPathPiece' 1 +pathPieceJSON ''ADError +pathPieceJSONKey ''ADError +derivePersistFieldPathPiece ''ADError + + +fromADErrorCode :: ResultCode -> Word32 -> Maybe ADError +fromADErrorCode resCode subResCode = IntMap.lookup (fromIntegral subResCode) =<< Map.lookup resCode errorCodes + where + errorCodes = Map.fromList + [ ( InvalidCredentials + , IntMap.fromList + [ ( 0x525, ADNoSuchObject ) + , ( 0x52e, ADLogonFailure ) + , ( 0x52f, ADAccountRestriction ) + , ( 0x530, ADInvalidLogonHours ) + , ( 0x531, ADInvalidWorkstation ) + , ( 0x532, ADPasswordExpired ) + , ( 0x533, ADAccountDisabled ) + , ( 0x568, ADTooManyContextIds ) + , ( 0x701, ADAccountExpired ) + , ( 0x773, ADPasswordMustChange ) + , ( 0x775, ADAccountLockedOut ) + , ( 0x80090346, ADAccountLockedOut ) + ] + ) + ] + +parseADError :: ResultCode -> Text -> Either ParseError ADError +parseADError resCode = parse (pADError resCode <* eof) "LDAP" . unpack + +pADError :: ResultCode -> Parser ADError +pADError resCode = do + void . manyTill anyChar . try $ string ": " + let pItem = asum + [ do + void $ string "data " + fmap Just $ hexnum >>= hoistMaybe . fromADErrorCode resCode + , Nothing <$ manyTill anyChar (lookAhead . try $ void (string ", ") <|> eof) + ] + (hoistMaybe =<<) $ ala First foldMap <$> pItem `sepBy1` try (string ", ") diff --git a/src/Foundation/I18n.hs b/src/Foundation/I18n.hs index 1d5ac1248..ac5e31cb0 100644 --- a/src/Foundation/I18n.hs +++ b/src/Foundation/I18n.hs @@ -231,6 +231,8 @@ embedRenderMessage ''UniWorX ''AuthenticationMode id embedRenderMessage ''UniWorX ''RatingValidityException id +embedRenderMessageVariant ''UniWorX ''ADInvalidCredentials ("InvalidCredentials" <>) + newtype ShortSex = ShortSex Sex embedRenderMessageVariant ''UniWorX ''ShortSex ("Short" <>) diff --git a/src/Import/NoModel.hs b/src/Import/NoModel.hs index 23e4f09b3..97cd8d3d7 100644 --- a/src/Import/NoModel.hs +++ b/src/Import/NoModel.hs @@ -175,6 +175,7 @@ import Data.Word.Word24.Instances as Import () import Control.Monad.Trans.Memo.StateCache.Instances as Import (hoistStateCache) import Database.Persist.Sql.Types.Instances as Import () import Control.Monad.Catch.Instances as Import () +import Ldap.Client.Instances as Import () import Crypto.Hash as Import (Digest, SHA3_256, SHA3_512) import Crypto.Random as Import (ChaChaDRG, Seed) diff --git a/src/Ldap/Client/Instances.hs b/src/Ldap/Client/Instances.hs new file mode 100644 index 000000000..ca45d6cc1 --- /dev/null +++ b/src/Ldap/Client/Instances.hs @@ -0,0 +1,11 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Ldap.Client.Instances + ( + ) where + +import ClassyPrelude +import Ldap.Client + + +deriving instance Ord ResultCode diff --git a/src/Utils/Metrics.hs b/src/Utils/Metrics.hs index c1f6a7abf..f8b21dad5 100644 --- a/src/Utils/Metrics.hs +++ b/src/Utils/Metrics.hs @@ -305,6 +305,7 @@ observeFavouritesQuickActionsDuration act = do data LoginOutcome = LoginSuccessful | LoginInvalidCredentials + | LoginADInvalidCredentials | LoginError deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable) deriving anyclass (Universe, Finite) diff --git a/templates/i18n/changelog/ldap-ad-errors.de-de-formal.hamlet b/templates/i18n/changelog/ldap-ad-errors.de-de-formal.hamlet new file mode 100644 index 000000000..0a8eeebdf --- /dev/null +++ b/templates/i18n/changelog/ldap-ad-errors.de-de-formal.hamlet @@ -0,0 +1,2 @@ +$newline never +Bessere Fehlermeldungen bei fehlgeschlagenem Login diff --git a/templates/i18n/changelog/ldap-ad-errors.en-eu.hamlet b/templates/i18n/changelog/ldap-ad-errors.en-eu.hamlet new file mode 100644 index 000000000..401d12e67 --- /dev/null +++ b/templates/i18n/changelog/ldap-ad-errors.en-eu.hamlet @@ -0,0 +1,2 @@ +$newline never +Better error messages on failed login diff --git a/test/Auth/LDAP/ADSpec.hs b/test/Auth/LDAP/ADSpec.hs new file mode 100644 index 000000000..790dc32f4 --- /dev/null +++ b/test/Auth/LDAP/ADSpec.hs @@ -0,0 +1,18 @@ +module Auth.LDAP.ADSpec where + +import TestImport + +import Auth.LDAP.AD +import Ldap.Client + + +spec :: Spec +spec = do + describe "parseADError" $ do + it "parses some examples" . mapM_ exampleEntry $ + [ ( InvalidCredentials, ADAccountDisabled, "80090308: LdapErr: DSID-0C090446, comment: AcceptSecurityContext error, data 533, v2580") + , ( InvalidCredentials, ADLogonFailure , "80090308: LdapErr: DSID-0C090446, comment: AcceptSecurityContext error, data 52e, v2580") + ] + +exampleEntry :: ( ResultCode, ADError, Text ) -> Expectation +exampleEntry ( resCode, adError, errMsg ) = example $ parseADError resCode errMsg `shouldBe` Right adError