*********************************************************************
*
* I255608
*
* TCP/IP Password Server
*
* Written by William van den Heuvel, 1998
*
* Update: 1998-12-04
*
*********************************************************************
*
* This module calls RACF passing USERID, PASSWORD and NEWPASSWORD
* RACF is called using the RACROUTE macro
*
* The return code from RACROUTE will be translated in a 2-byte
* reply code that will be send back to the client:
*
* Reply code;
* 21 - ok, password is valid
* 22 - ok, password is changed
* 23 - user is unknown
* 24 - user is known but access is revoked
* 25 - password invalid
* 26 - password expired
* 27 - new password is invalid (not changed)
* 29 - unexpected return code from RACF
*
*********************************************************************
*
* on entry,
* register 1 points to the parameters passed by the caller (I255608)
* 1.- pointer to USERID input L-string (L is 1-8)
* 2.- pointer to PASSWORD input L-string (L is 1-8)
* 3.- pointer to NEWPASSWORD input L-string (L is 0-8)
* 4.- pointer to REPLY output LL-string (LL will be 02)
*
*......................................................................
*
* on completion,
* register 15 will contain a return code (RC):
*
* RC=0 - normal completion (always)
*
***********************************************************************
**********************************************************************
*
I255608 CSECT
I255608 AMODE ANY
I255608 RMODE ANY
*
R0 EQU 0
R1 EQU 1
R2 EQU 2
R3 EQU 3
R4 EQU 4
R5 EQU 5
R6 EQU 6
R7 EQU 7
R8 EQU 8
R9 EQU 9
R10 EQU 10 PARM - address of pointer to parameters
R11 EQU 11 BASE - base register of this program
R12 EQU 12 CAA - reserved for LE
R13 EQU 13 DSA - Dynamic Storage Area
R14 EQU 14 return address
R15 EQU 15 entry point address
*
DSA EQU R13
CAA EQU R12
BASE EQU R11
*
PARM EQU R10 parameters passed caller
USERID EQU R9 USERID
PASSWORD EQU R8 PASSWORD
NEWPASSWORD EQU R7 NEWPASSWORD
REPLY EQU R6 REPLY
*
USING PARM_DSECT,PARM
USING DSA_DSECT,DSA
USING REPLY_DSECT,REPLY
*
SAF EQU R5 base register for RACROUTE parameter list
USING SAFP,SAF RACROUTE parameter list
*
**********************************************************************
**********************************************************************
*
LEMENTRY BASE=BASE,LENGTH=DSA_DSECT_LENGTH,PARAM=PARM TRACE=0
*
* note:
* PARM -> PARM_DSECT
* DSA -> DSA_DSECT
*
***********************************************************************
LEMTRACE 0,'I255608: entry'
***********************************************************************
*
* get parameters pased by caller
L USERID,PARM_USERID
L PASSWORD,PARM_PASSWORD
L NEWPASSWORD,PARM_NEWPASSWORD
L REPLY,PARM_REPLY
*
***********************************************************************
**********************************************************************
*
* make parameter list for RACF
*
* relocate parameter list for RACROUTE macro
MVC DSA_RACROUTE,RACROUTE
*
* issue RACROUTE macro using relocated parameter list
RACROUTE REQUEST=VERIFY,MF=(E,DSA_RACROUTE), X
USERID=(USERID), X
PASSWRD=(PASSWORD), X
NEWPASS=(NEWPASSWORD), X
PASSCHK=YES, X
WORKA=DSA_RACF_WORK
*
* check return code from RACROUTE
ST R15,DSA_SAF_RETURN
LR 2,R15
LEMTRACE 0,'I255608: return code from RACF: ',(2,B)
*
* get RACROUTE parameters
LA SAF,DSA_RACROUTE
L 2,SAFPRRET RACF return code
L 3,SAFPRREA RACF reason code
ST 2,DSA_RACF_RETURN
ST 3,DSA_RACF_REASON
LEMTRACE 0,'I255608: RACF return code ',(2,B),', reason ',(3,B)
*
***********************************************************************
*
* if SAF return code = 0 (ok)
* then reply = "21" or "22"
B110 EQU *
L R15,DSA_SAF_RETURN
C R15,=F'0'
BNE B112
*
* if password changed then "22", else "21"
CLI 0(NEWPASSWORD),0
BNE B111
*
* password not changed
MVC REPLY_LENGTH,=A(2) length
MVC REPLY_MESSAGE(2),=C'21' "ok, passwort g?ltig"
B X100
*
* password changed
B111 EQU *
MVC REPLY_LENGTH,=A(2) length
MVC REPLY_MESSAGE(2),=C'22' "ok, passwort ge„ndert"
B X100
*
*......................................................................
*
* if SAF return code = 4 (user not defined)
* then reply = "23"
B112 EQU *
L R15,DSA_SAF_RETURN
C R15,=F'4'
BNE B120
MVC REPLY_LENGTH,=A(2) length
MVC REPLY_MESSAGE(2),=C'23' "Benutzer unbekannt"
B X100
*
* SAF return code is 8
B120 EQU *
*
* check RACF return code
L R15,DSA_RACF_RETURN
C R15,=F'4' "user profile not defined"
BNE B121
MVC REPLY_LENGTH,=A(2)
MVC REPLY_MESSAGE(2),=C'23' "Benutzer unbekannt"
B X100
*
* check RACF return code
B121 EQU *
L R15,DSA_RACF_RETURN
C R15,=F'20' "user not defined to group"
BNE B122
MVC REPLY_LENGTH,=A(2)
MVC REPLY_MESSAGE(2),=C'23' "Benutzer unbekannt"
B X100
*
* check RACF return code
B122 EQU *
L R15,DSA_RACF_RETURN
C R15,=F'28' "user access revoked"
BNE B123
MVC REPLY_LENGTH,=A(2)
MVC REPLY_MESSAGE(2),=C'24' "Benutzer gesperrt"
B X100
*
* check RACF return code
B123 EQU *
L R15,DSA_RACF_RETURN
C R15,=F'36' "user access revoked from group"
BNE B124
MVC REPLY_LENGTH,=A(2)
MVC REPLY_MESSAGE(2),=C'24' "Benutzer gesperrt"
B X100
*
* check RACF return code
B124 EQU *
L R15,DSA_RACF_RETURN
C R15,=F'8' "password not authorized"
BNE B125
MVC REPLY_LENGTH,=A(2)
MVC REPLY_MESSAGE(2),=C'25' "passwort ung?ltig"
B X100
*
* check RACF return code
B125 EQU *
L R15,DSA_RACF_RETURN
C R15,=F'12' "password expired"
BNE B126
MVC REPLY_LENGTH,=A(2)
MVC REPLY_MESSAGE(2),=C'26' "passwort abgelaufen"
B X100
*
* check RACF return code
B126 EQU *
L R15,DSA_RACF_RETURN
C R15,=F'16' "new password invalid"
BNE B127
MVC REPLY_LENGTH,=A(2)
MVC REPLY_MESSAGE(2),=C'27' "neues Passwort ung?ltig"
B X100
*
B127 EQU *
MVC REPLY_LENGTH,=A(2)
MVC REPLY_MESSAGE(2),=C'29' "unbekannter Fehler"
*
***********************************************************************
**********************************************************************
*
* return to caller
X100 EQU *
LEMTRACE 0,'I255608: exit'
*
LEMEXIT
*
*********************************************************************
*
DS 0D D-align what follows:
RACROUTE RACROUTE REQUEST=VERIFY,MF=L
RACROUTE_END DS 0D
*
***********************************************************************
*
* DSA - Dynamic Storage Area (pointed to by register 13)
*
DSA_DSECT LEMDSA
*
*......................................................................
*
* relocated parameter list for RACROUTE macro
*
DS 0D D-align what follows
DSA_RACROUTE DS XL(RACROUTE_END-RACROUTE)
*
DSA_RACF_WORK DS CL512
*
*......................................................................
*
DSA_SAF_RETURN DS F return code from SAF
DSA_RACF_RETURN DS F return code from RACF
DSA_RACF_REASON DS F reason code from RACF
*
*......................................................................
*
DS 0D D-align what follows
DSA_DSECT_LENGTH EQU *-DSA_DSECT
*
***********************************************************************
***********************************************************************
*
* the following macro ICHSAFP generates dsect SAFP
* which maps the RACROUTE parameter list in DSA_RACROUTE
*
ICHSAFP
*
***********************************************************************
***********************************************************************
*
* PARM - parameters passed by caller via register 1
*
PARM_DSECT DSECT
PARM_USERID DS A pointer to USERID
PARM_PASSWORD DS A pointer to PASSWORD
PARM_NEWPASSWORD DS A pointer to NEWPASSWORD
PARM_REPLY DS A pointer to REPLY
*
***********************************************************************
*
* REPLY - reply message pointed to by PARM_REPLY
*
REPLY_DSECT DSECT
REPLY_LENGTH DS F length of reply message (maximum 80)
REPLY_MESSAGE DS CL80 reply message
*
***********************************************************************
END