*********************************************************************
*
* I255607
*
* TCP/IP Password Server
*
* Written by William van den Heuvel, 1998
*
* Update: 1998-11-10
*
*********************************************************************
*
* This module analyses the REQUEST message (input)
*
* The first word is expected to be the command code VERIFY
*
* The second word is expected to be the USERID
*
* The third word is expected to be the PASSWORD
*
* The fourth word is optional but if is there it is expected to
* the NEWPASSWORD
*
*....................................................................
*
* reply codes that may be send back to the client:
* 11 - USERID missing
* 12 - USERID longer than 8 bytes
* 13 - PASSWORD missing
* 14 - PASSWORD longer than 8 bytes
* 15 - NEWPASSWORD longer than 8 bytes
*
*********************************************************************
*
* on entry,
* register 1 points to the API parameters.
* 1.- pointer to REQUEST input LL-string (request from client)
* 2.- pointer to REPLY output LL-string (reply to client)
*
*......................................................................
*
* on completion,
* register 15 will contain a return code (RC):
*
* RC=0 - normal completion (always)
*
***********************************************************************
**********************************************************************
*
I255607 CSECT
I255607 AMODE ANY
I255607 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 PARM-string)
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
REQUEST EQU R9 request message
REPLY EQU R8 reply message
*
USING PARM_DSECT,PARM
USING DSA_DSECT,DSA
USING REQUEST_DSECT,REQUEST
USING REPLY_DSECT,REPLY
*
**********************************************************************
**********************************************************************
*
LEMENTRY BASE=BASE,LENGTH=DSA_DSECT_LENGTH,PARAM=PARM TRACE=0
*
* note:
* PARM -> PARM_DSECT
* DSA -> DSA_DSECT
*
***********************************************************************
LEMTRACE 0,'I255607: entry'
***********************************************************************
*
* get parameters pased by caller
L REQUEST,PARM_REQUEST request message
L REPLY,PARM_REPLY reply message
*
*......................................................................
*
* get length/address of request message
L R3,REQUEST_LENGTH R3 = length
LA R2,REQUEST_MESSAGE R2 = address
STM R2,R3,DSA_REQUEST
*
***********************************************************************
LEMTRACE 0,'I255607: REQUEST: ',((2),(3),X)
***********************************************************************
*
* ensure first word of request message is "VERIFY"
*
A100 EQU *
*
LM R2,R3,DSA_REQUEST
*
*......................................................................
*
* skip over leading blanks
A110 EQU *
CLI 0(R2),C' '
BNE A111
LA R2,1(R2)
BCT R3,A110
B A130 nothing found
*
* begin of first word found
A111 EQU *
STM R2,R3,DSA_REQUEST
*
*......................................................................
*
* Find end of first word
* (the first word is terminated by a blank)
A120 EQU *
CLI 0(R2),C' '
BE A121
LA R2,1(R2) R2 -> next byte in request message
BCT R3,A120
*
* R2 -> beyond first word
* R3 = remaining length
*
* copy first word to DSA_COMMAND
A121 EQU *
LM R14,R15,DSA_REQUEST R14/R15 = length/address of word
SR R15,R3 R15 = length of first word
ICM R15,B'1000',=C' ' padd with blanks
LA R0,DSA_COMMAND
LA R1,L'DSA_COMMAND
MVCL R0,R14
*
* first word found
STM R2,R3,DSA_REQUEST
*
*......................................................................
*
* turn all characters of word into capitels
OC DSA_COMMAND,=8X'40'
*
* check if it is "VERIFY"
CLC DSA_COMMAND,=CL8'VERIFY'
BE B100 ok
*
*......................................................................
*
* first word is not "VERIFY"
A130 EQU *
LEMTRACE 0,'I255607: COMMAND: ',(DSA_COMMAND,8,C)
*
* echo request message
MVC REPLY_LENGTH,REQUEST_LENGTH
MVC REPLY_MESSAGE,REQUEST_MESSAGE
*
* return to caller
B X100
*
***********************************************************************
***********************************************************************
*
* USERID
*
* the second word is expected to be the userid
*
B100 EQU *
*
*......................................................................
*
* init USERID
*
MVI DSA_USERID,0 1-byte length of USERID
MVC DSA_USERID+1(8),=CL8' '
*
*......................................................................
*
* restart scan beyond command code "VERIFY"
LM R2,R3,DSA_REQUEST
LTR R3,R3
BZ B130 nothing left
*
*......................................................................
*
* skip over leading blanks
B110 EQU *
CLI 0(R2),C' '
BNE B111
LA R2,1(R2)
BCT R3,B110
B B130 nothing found
*
* begin of USERID found
B111 EQU *
STM R2,R3,DSA_REQUEST
*
*......................................................................
*
* Find end of USERID
* (the USERID is terminated by a blank)
B120 EQU *
CLI 0(R2),C' '
BE B121 end of word found
LA R2,1(R2) R2 -> next byte in request message
BCT R3,B120
*
* R2 -> beyond second word
* R3 = remaining length
*
* copy second word to DSA_USERID
* the first byte of DSA_USERID is a 1-byte length field
* the remaining 8 bytes is for the userid
B121 EQU *
LM R14,R15,DSA_REQUEST R14/R15 = length/address of word
SR R15,R3 R15 = length of first word
STC R15,DSA_USERID 1-byte length of USERID
ICM R15,B'1000',=C' ' padd with blanks
LA R0,DSA_USERID+1
LA R1,8
MVCL R0,R14
*
* USERID found
STM R2,R3,DSA_REQUEST
*
*......................................................................
*
* check minimum length of USERID (1 byte)
*
B130 EQU *
CLI DSA_USERID,1
BNL B140
*
* USERID missing
MVC REPLY_LENGTH,=F'02'
MVC REPLY_MESSAGE,=C'11' Benutzer-ID fehlt
*
* return to caller
B X100
*
*......................................................................
*
* check maximum length of USERID (8 bytes)
B140 EQU *
*
CLI DSA_USERID,8
BNH B150
*
* USERID too long
MVC REPLY_LENGTH,=F'02'
MVC REPLY_MESSAGE,=C'12' Benutzer-ID falsch (zu lange)
*
XR 2,2
IC 2,DSA_USERID
LA 2,1(2)
LEMTRACE 0,'I255607: USERID: ',(DSA_USERID,(2),X)
*
* return to caller
B X100
*
*......................................................................
*
* translate USERID to uppercase
B150 EQU *
XR R1,R1
ICM R1,B'0001',DSA_USERID
BZ B152
EX R1,B151 execute TR instruction
B B152
*
* the length of the first operand is supplied in R1
B151 TR DSA_USERID+1(0),UPPERCASE
B152 EQU *
LEMTRACE 0,'I255607: USERID: ',(DSA_USERID,(2),X)
*
***********************************************************************
***********************************************************************
*
* PASSWORD
*
* the third word is expected to be the password
*
C100 EQU *
*
*......................................................................
*
* init PASSWORD
*
MVI DSA_PASSWORD,0 1-byte length of PASSWORD
MVC DSA_PASSWORD+1(8),=CL8' '
*
*......................................................................
*
* restart scan beyond USERID
LM R2,R3,DSA_REQUEST
LTR R3,R3
BZ C130 nothing left
*
*......................................................................
*
* skip over leading blanks
C110 EQU *
CLI 0(R2),C' '
BNE C111
LA R2,1(R2)
BCT R3,C110
B C130 nothing found
*
* begin of PASSWORD found
C111 EQU *
STM R2,R3,DSA_REQUEST
*
*......................................................................
*
* Find end of PASSWORD
* (the PASSWORD is terminated by a blank)
C120 EQU *
CLI 0(R2),C' '
BE C121 end of word found
LA R2,1(R2) R2 -> next byte in request message
BCT R3,C120
*
* R2 -> beyond third word
* R3 = remaining length
*
* copy third word to DSA_PASSWORD
* the first byte of DSA_PASSWORD is a 1-byte length field
* the remaining 8 bytes is for the password
C121 EQU *
LM R14,R15,DSA_REQUEST R14/R15 = length/address of word
SR R15,R3 R15 = length of word
STC R15,DSA_PASSWORD 1-byte length of PASSWORD
ICM R15,B'1000',=C' ' padd with blanks
LA R0,DSA_PASSWORD+1
LA R1,8
MVCL R0,R14
*
* PASSWORD found
STM R2,R3,DSA_REQUEST
*
*......................................................................
*
* check minimum length of PASSWORD (1 byte)
*
C130 EQU *
CLI DSA_PASSWORD,1
BNL C140
*
* PASSWORD missing
MVC REPLY_LENGTH,=F'02'
MVC REPLY_MESSAGE,=C'13' Passwort fehlt
*
* return to caller
B X100
*
*......................................................................
*
* check maximum length of PASSWORD (8 bytes)
C140 EQU *
*
CLI DSA_PASSWORD,8
BNH C150
*
* PASSWORD too long
MVC REPLY_LENGTH,=F'02'
MVC REPLY_MESSAGE,=C'14' Passwort falsch (zu lange)
*
XR 2,2
IC 2,DSA_PASSWORD
LA 2,1(2)
LEMTRACE 0,'I255607: PASSWORD: ',(DSA_PASSWORD,(2),X)
*
* return to caller
B X100
*
*......................................................................
*
* translate PASSWORD to uppercase
C150 EQU *
XR R1,R1
ICM R1,B'0001',DSA_PASSWORD
BZ C152
EX R1,C151 execute TR instruction
B C152
*
* the length of the first operand is supplied in R1
C151 TR DSA_PASSWORD+1(0),UPPERCASE
C152 EQU *
LEMTRACE 0,'I255607: PASSWORD: ',(DSA_PASSWORD,(2),X)
*
***********************************************************************
***********************************************************************
*
* NEWPASSWORD
*
* the fourth word is optional but if it is specified
* then it is expected to be the new password
*
D100 EQU *
*
*......................................................................
*
* init NEWPASSWORD
*
MVI DSA_NEWPASSWORD,0 1-byte length of NEWPASSWORD
MVC DSA_NEWPASSWORD+1(8),=CL8' '
*
*......................................................................
*
* restart scan beyond PASSWORD
LM R2,R3,DSA_REQUEST
LTR R3,R3
BZ D130 nothing left
*
*......................................................................
*
* skip over leading blanks
D110 EQU *
CLI 0(R2),C' '
BNE D111
LA R2,1(R2)
BCT R3,D110
B D130 nothing found
*
* begin of PASSWORD found
D111 EQU *
STM R2,R3,DSA_REQUEST
*
*......................................................................
*
* Find end of PASSWORD
* (the PASSWORD is terminated by a blank)
D120 EQU *
CLI 0(R2),C' '
BE D121 end of word found
LA R2,1(R2) R2 -> next byte in request message
BCT R3,D120
*
* R2 -> beyond word
* R3 = remaining length
*
* copy word to DSA_NEWPASSWORD
* the first byte of DSA_NEWPASSWORD is a 1-byte length field
* the remaining 8 bytes is for the new password
D121 EQU *
LM R14,R15,DSA_REQUEST R14/R15 = length/address of word
SR R15,R3 R15 = length of word
STC R15,DSA_NEWPASSWORD 1-byte length of NEWPASSWORD
ICM R15,B'1000',=C' ' padd with blanks
LA R0,DSA_NEWPASSWORD+1
LA R1,8
MVCL R0,R14
*
* NEWPASSWORD found
STM R2,R3,DSA_REQUEST
*
*......................................................................
*
* check maximum length of NEWPASSWORD (8 bytes)
D130 EQU *
*
CLI DSA_NEWPASSWORD,8
BNH D140
*
* NEWPASSWORD too long
MVC REPLY_LENGTH,=F'02'
MVC REPLY_MESSAGE,=C'15' neues Passwort falsch (zu lange)
*
XR 2,2
IC 2,DSA_NEWPASSWORD
LA 2,1(2)
LEMTRACE 0,'I255607: NEWPASSWORD: ',(DSA_NEWPASSWORD,(2),X)
*
* return to caller
B X100
*
*......................................................................
*
D140 EQU *
XR 2,2
IC 2,DSA_NEWPASSWORD
LA 2,1(2)
LEMTRACE 0,'I255607: NEWPASSWORD: ',(DSA_NEWPASSWORD,(2),X)
*
*......................................................................
*
* translate NEWPASSWORD to uppercase
D150 EQU *
XR R1,R1
ICM R1,B'0001',DSA_NEWPASSWORD
BZ D152
EX R1,D151 execute TR instruction
B D152
*
* the length of the first operand is supplied in R1
D151 TR DSA_NEWPASSWORD+1(0),UPPERCASE
D152 EQU *
LEMTRACE 0,'I255607: NEWPASSWORD: ',(DSA_NEWPASSWORD,(2),X)
*
***********************************************************************
***********************************************************************
*
* call I255608 to let RACF do the work
*
* make parameter list
LA R0,DSA_USERID
ST R0,DSA_I255608_USERID
LA R0,DSA_PASSWORD
ST R0,DSA_I255608_PASSWORD
LA R0,DSA_NEWPASSWORD
ST R0,DSA_I255608_NEWPASSWORD
LA R0,REPLY_DSECT
ST R0,DSA_I255608_REPLY
*
* call
LA R1,DSA_I255608
L R15,=V(I255608)
BASR R14,R15
*
***********************************************************************
**********************************************************************
*
* return to caller
X100 EQU *
LEMTRACE 0,'I255607: exit'
*
LEMEXIT RC=(15)
*
*********************************************************************
**********************************************************************
*
* translation table from lower case EBCDIC to upper case EBCDIC
*
UPPERCASE EQU *
* .0.1.2.3.4.5.6.7.8.9.A.B.C.D.E.F
DC X'000102030405060708090A0B0C0D0E0F' 0.
DC X'101112131415161718191A1B1C1D1E1F' 1.
DC X'202122232425262728292A2B2C2D2E2F' 2.
DC X'303132333435363738393A3B3C3D3E3F' 3.
DC X'404142434445464748494A4B4C4D4E4F' 4.
DC X'505152535455565758595A5B5C5D5E5F' 5.
DC X'606162636465666768696A6B6C6D6E6F' 6.
DC X'707172737475767778797A7B7C7D7E7F' 7.
DC X'80C1C2C3C4C5C6C7C8C98A8B8C8D8E8F' 8.
DC X'90D1D2D3D4D5D6D7D8D99A9B9C9D9E9F' 9.
DC X'A0A1E2E3E4E5E6E7E8E9AAABACADAEAF' A.
DC X'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF' B.
DC X'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF' C.
DC X'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF' D.
DC X'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF' E.
DC X'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF' F.
* .0.1.2.3.4.5.6.7.8.9.A.B.C.D.E.F
*
*********************************************************************
***********************************************************************
*
* DSA - Dynamic Storage Area (pointed to by register 13)
*
DSA_DSECT LEMDSA
*
*......................................................................
*
DSA_REQUEST DS F,A length/address
*
*......................................................................
*
DSA_COMMAND DS CL8 command code "VERIFY"
DSA_USERID DS AL1,CL8 1-byte length followed by 8-byte userid
DSA_PASSWORD DS AL1,CL8 1-byte length followed by 8-byte password
DSA_NEWPASSWORD DS AL1,CL8 1-byte length followed by 8-byte newpassword
*
*......................................................................
*
DSA_I255608 DS 0D
DSA_I255608_USERID DS A pointer to DSA_USERID
DSA_I255608_PASSWORD DS A pointer to DSA_PASSWORD
DSA_I255608_NEWPASSWORD DS A pointer to DSA_NEWPASSWORD
DSA_I255608_REPLY DS A pointer to REPLY
*
*......................................................................
*
DS 0D D-align what follows
DSA_DSECT_LENGTH EQU *-DSA_DSECT
*
***********************************************************************
***********************************************************************
*
* PARM - parameters passed by caller via register 1
*
PARM_DSECT DSECT
PARM_REQUEST DS A pointer to REQUEST
PARM_REPLY DS A pointer to REPLY
*
***********************************************************************
*
* REQUEST - request message pointed to by PARM_REQUEST
*
REQUEST_DSECT DSECT
REQUEST_LENGTH DS F length of request message (maximum 80)
REQUEST_MESSAGE DS CL80 request message
*
***********************************************************************
*
* 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