callback.p
Example callback routine that authenticates against an active directory
Note: Assumes that domain provided is a valid active directory domain.
*/
ROUTINE-LEVEL ON ERROR UNDO, THROW.
USING Progress.Security.*.
USING System.DirectoryServices.AccountManagement.*.
LOG-MANAGER:LOGFILE-NAME = "callback.log".
/*LOG-MANAGER:CLEAR-LOG().*/
PROCEDURE AuthenticateUser:
DEFINE INPUT PARAMETER phCP AS HANDLE NO-UNDO.
DEFINE INPUT PARAMETER pcSystemOptions AS CHARACTER EXTENT NO-UNDO.
DEFINE OUTPUT PARAMETER piPAMStatus AS INTEGER INITIAL ? NO-UNDO.
DEFINE OUTPUT PARAMETER pcErrorMsg AS CHARACTER NO-UNDO.
DEFINE VARIABLE objContext AS PrincipalContext.
DEFINE VARIABLE objUser AS UserPrincipal.
DEFINE BUFFER bUser FOR rtb._user.
LOG-MANAGER:WRITE-MESSAGE('*** Executing AuthenticateUser ***').
LOG-MANAGER:WRITE-MESSAGE('User is: ' + phCP:USER-ID).
LOG-MANAGER:WRITE-MESSAGE('Domain is: ' + phCP:DOMAIN-NAME).
LOG-MANAGER:WRITE-MESSAGE('Attemping to validate against active directory..').
/*
Domain name provided at login should be valid AD domain.
*/
objContext = NEW PrincipalContext(ContextType:Domain,phCP:DOMAIN-NAME).
IF objContext:ValidateCredentials(phCP:USER-ID,phCP:PRIMARY-PASSPHRASE) THEN DO:
piPAMStatus = PAMStatus:Success.
LOG-MANAGER:WRITE-MESSAGE('Success.').
/*
If user does not exist in _user table, create user account.
*/
FIND bUser NO-LOCK
WHERE bUser._userid = phCP:USER-ID NO-ERROR.
IF NOT AVAILABLE(bUser) THEN DO TRANSACTION ON ERROR UNDO:
LOG-MANAGER:WRITE-MESSAGE('Attemping to create _user record..').
objUser = UserPrincipal:FindByIdentity(objContext,phCP:USER-ID).
CREATE bUser.
ASSIGN
bUser._userid = phCP:USER-ID
bUser._user-name = objUser:NAME
bUser._password = ENCODE("").
CATCH e AS PROGRESS.Lang.SysError:
piPAMStatus = PAMStatus:Custom.
pcErrorMsg = "Unable to create _user record. " + e:getMessage(1).
LOG-MANAGER:WRITE-MESSAGE(pcErrorMsg).
END CATCH.
FINALLY:
DELETE OBJECT e NO-ERROR.
END FINALLY.
END.
END.
ELSE DO:
piPAMStatus = PAMStatus:Custom.
pcErrorMsg = "You shall not pass!".
LOG-MANAGER:WRITE-MESSAGE(pcErrorMsg).
END.
RETURN.
FINALLY:
DELETE OBJECT objContext NO-ERROR.
DELETE OBJECT objUser NO-ERROR.
END FINALLY.
END. /* AuthenticateUser */
PROCEDURE AfterSetIdentity:
DEFINE INPUT PARAMETER phCP AS HANDLE NO-UNDO.
DEFINE INPUT PARAMETER pcSysOptions AS CHARACTER EXTENT NO-UNDO.
LOG-MANAGER:WRITE-MESSAGE("*** Executing AfterSetIdentity ***").
LOG-MANAGER:WRITE-MESSAGE(SUBSTITUTE('QUALIFIED USER: &1', phCP:QUALIFIED-USER-ID)).
LOG-MANAGER:WRITE-MESSAGE(SUBSTITUTE('LOGIN-STATE: &1', phCP:LOGIN-STATE)).
LOG-MANAGER:WRITE-MESSAGE(SUBSTITUTE('LOGIN-STATE-DETAIL: &1', phCP:STATE-DETAIL)).
LOG-MANAGER:WRITE-MESSAGE(SUBSTITUTE('SESSION ID: &1', phCP:SESSION-ID)).
LOG-MANAGER:WRITE-MESSAGE(SUBSTITUTE('EXPIRATION: &1', phCP:LOGIN-EXPIRATION-TIMESTAMP)).
LOG-MANAGER:WRITE-MESSAGE(SUBSTITUTE('DOMAIN TYPE: &1', phCP:DOMAIN-TYPE)).
LOG-MANAGER:WRITE-MESSAGE(SUBSTITUTE('DOMAIN: &1', phCP:DOMAIN-NAME)).
LOG-MANAGER:WRITE-MESSAGE(SUBSTITUTE('SEALED: &1', phCP:SEAL-TIMESTAMP)).
RETURN.
FINALLY:
LOG-MANAGER:CLOSE-LOG().
END FINALLY.
END.