diff --git a/src/Auth/LDAP.hs b/src/Auth/LDAP.hs index d8672bfe8..77269ffa9 100644 --- a/src/Auth/LDAP.hs +++ b/src/Auth/LDAP.hs @@ -36,6 +36,20 @@ data CampusMessage = MsgCampusIdentNote | MsgCampusInvalidCredentials +findUser :: LdapConf -> Ldap.Ldap -> Text -> [Ldap.Attr] -> IO [Ldap.SearchEntry] +findUser LdapConf{..} ldap campusIdent = Ldap.search ldap ldapBase userSearchSettings userFilter + where + userFilter = userPrincipalName Ldap.:= Text.encodeUtf8 campusIdent + userSearchSettings = mconcat + [ Ldap.scope ldapScope + , Ldap.size 2 + , Ldap.time ldapTimeout + , Ldap.derefAliases Ldap.DerefAlways + ] + +userPrincipalName :: Ldap.Attr +userPrincipalName = Ldap.Attr "userPrincipalName" + campusForm :: ( RenderMessage site FormMessage , RenderMessage site CampusMessage , Button site SubmitButton @@ -53,7 +67,7 @@ campusLogin :: forall site. , Button site SubmitButton , Show (ButtonCssClass site) ) => LdapConf -> AuthPlugin site -campusLogin LdapConf{..} = AuthPlugin{..} +campusLogin conf@LdapConf{..} = AuthPlugin{..} where apName = "LDAP" apDispatch :: Text -> [Text] -> HandlerT Auth (HandlerT site IO) TypedContent @@ -68,15 +82,7 @@ campusLogin LdapConf{..} = AuthPlugin{..} ldapResult <- liftIO . Ldap.with ldapHost ldapPort $ \ldap -> do Ldap.bind ldap (Ldap.Dn campusIdent) (Ldap.Password $ Text.encodeUtf8 campusPassword) Ldap.bind ldap ldapDn ldapPassword - let - userFilter = userPrincipalName Ldap.:= Text.encodeUtf8 campusIdent - userSearchSettings = mconcat - [ Ldap.scope ldapScope - , Ldap.size 2 - , Ldap.time ldapTimeout - , Ldap.derefAliases Ldap.DerefAlways - ] - Ldap.search ldap ldapBase userSearchSettings userFilter [userPrincipalName] + findUser conf ldap campusIdent [userPrincipalName] case ldapResult of Left err | Ldap.ResponseError (Ldap.ResponseErrorCode _ Ldap.InvalidCredentials _ _) <- err @@ -101,11 +107,7 @@ campusLogin LdapConf{..} = AuthPlugin{..} (login, loginEnctype) <- handlerToWidget . generateFormPost $ renderAForm FormStandard campusForm $(widgetFile "widgets/campus-login-form") -userPrincipalName :: Ldap.Attr -userPrincipalName = Ldap.Attr "userPrincipalName" - data CampusUserException = CampusUserLdapError Ldap.LdapError - | CampusUserNoDN | CampusUserNoResult | CampusUserAmbiguous deriving (Show, Eq, Typeable) @@ -113,19 +115,20 @@ data CampusUserException = CampusUserLdapError Ldap.LdapError instance Exception CampusUserException campusUser :: (MonadIO m, MonadThrow m) => LdapConf -> Creds site -> m (Ldap.AttrList []) -campusUser LdapConf{..} Creds{..} = liftIO $ either (throwM . CampusUserLdapError) return <=< Ldap.with ldapHost ldapPort $ \ldap -> do - userDN <- case lookup "DN" credsExtra of - Just userDN -> return userDN - Nothing -> throwM CampusUserNoDN - let userFilter = userPrincipalName Ldap.:= Text.encodeUtf8 credsIdent - userSearchSettings = mconcat - [ Ldap.scope Ldap.BaseObject - , Ldap.size 2 - , Ldap.time ldapTimeout - , Ldap.derefAliases Ldap.DerefAlways - ] +campusUser conf@LdapConf{..} Creds{..} = liftIO $ either (throwM . CampusUserLdapError) return <=< Ldap.with ldapHost ldapPort $ \ldap -> do Ldap.bind ldap ldapDn ldapPassword - results <- Ldap.search ldap (Ldap.Dn userDN) userSearchSettings userFilter [] + results <- case lookup "DN" credsExtra of + Just userDN -> do + let userFilter = Ldap.Present userPrincipalName + userSearchSettings = mconcat + [ Ldap.scope Ldap.BaseObject + , Ldap.size 2 + , Ldap.time ldapTimeout + , Ldap.derefAliases Ldap.DerefAlways + ] + Ldap.search ldap (Ldap.Dn userDN) userSearchSettings userFilter [] + Nothing -> do + findUser conf ldap credsIdent [] case results of [] -> throwM CampusUserNoResult [Ldap.SearchEntry _ attrs] -> return attrs diff --git a/src/Foundation.hs b/src/Foundation.hs index 566f5068b..af8334958 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -1099,7 +1099,7 @@ instance YesodAuth UniWorX where case appLdapConf of Just ldapConf -> do - ldapData <- campusUser ldapConf creds + ldapData <- campusUser ldapConf $ Creds userPlugin userIdent credsExtra let userMatrikelnummer' = lookup (Attr "LMU-Stud-Matrikelnummer") ldapData diff --git a/src/Settings.hs b/src/Settings.hs index b7aa64493..399e029e7 100644 --- a/src/Settings.hs +++ b/src/Settings.hs @@ -125,7 +125,10 @@ instance FromJSON AppSettings where #endif appStaticDir <- o .: "static-dir" appDatabaseConf <- o .: "database" - appLdapConf <- o .:? "ldap" + let nonEmptyHost LdapConf{..} = case ldapHost of + Ldap.Tls host _ -> not $ null host + Ldap.Plain host -> not $ null host + appLdapConf <- (>>= (\c -> c <$ guard (nonEmptyHost c))) <$> o .:? "ldap" appRoot <- o .:? "approot" appHost <- fromString <$> o .: "host" appPort <- o .: "port"