*********************************************************************
*
* I255606
*
* TCP/IP Password Server
*
* Written by William van den Heuvel, 1998
*
* Update: 1998-11-10
*
*********************************************************************
*
* This program is a TCP/IP server.
*
* It provides Password services submitted by the client program.
* The client is a program that may run on any platform that
* supports TCP/IP.
* The client program submits the request by sending a TCP/IP message.
* The server listens on this port and returns a reply.
*
***********************************************************************
*
* on entry,
* register 1 points to the API parameters.
*
*......................................................................
*
* on completion,
* register 15 will contain a return code (RC):
*
* RC=0 - normal completion (always)
*
***********************************************************************
**********************************************************************
*
I255606 CSECT
I255606 AMODE ANY
I255606 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,'I255606: entry'
***********************************************************************
*
* get parameters pased by caller
L REQUEST,PARM_REQUEST request message
L REPLY,PARM_REPLY reply message
*
***********************************************************************
***********************************************************************
*
* get request message
*
A100 EQU *
*
*......................................................................
*
* trace request message (before translating to EBCDIC)
L 2,REQUEST_LENGTH
*** LEMTRACE 0,'I255606: ISO-8859-1: ',(REQUEST_MESSAGE,(2),X)
*
*......................................................................
*
* translate reply message from ISO-8859-1 to EBCDIC
L R1,REQUEST_LENGTH
EX R3,A110 execute TR instruction
B A120
*
* the length of the first operand is supplied in R1
A110 TR REQUEST_MESSAGE(0),EBCDIC
*
*......................................................................
*
* trace request message (after translation to EBCDIC)
A120 EQU *
L 2,REQUEST_LENGTH
*** LEMTRACE 0,'I255606: request: ',(REQUEST_MESSAGE,(2),C)
*
***********************************************************************
***********************************************************************
*
* If the request message is terminated by a CR or LF (or both)
* then remove them.
* The CR and LF denotes the end of a line.
* They will normally be sent by a PC.
*
L R15,REQUEST_LENGTH
LA R1,REQUEST_MESSAGE(R15) R1 -> beyond last byte
*
* check last byte of request message
C R15,=F'1' do we have at least one byte?
BL A133 no
BCTR R1,0 R1 -> last byte of request message
CLI 0(R1),X'0A'
BNE A130
MVI 0(R1),C' '
A130 CLI 0(R1),X'0D'
BNE A131
MVI 0(R1),C' '
*
* check second last byte of request message
A131 EQU *
C R15,=F'2' do we have at least two bytes?
BL A133 no
BCTR R1,0 R1 -> second last byte of message
CLI 0(R1),X'0A'
BNE A132
MVI 0(R1),C' '
A132 CLI 0(R1),X'0D'
BNE A133
MVI 0(R1),C' '
*
A133 EQU *
*
***********************************************************************
***********************************************************************
*
* process request message
*
B100 EQU *
L R3,REQUEST_LENGTH R3 = length
LA R2,REQUEST_MESSAGE R2 = address
*
*......................................................................
*
* get command code (first word)
B110 EQU *
CLI 0(R2),C' '
BE B111
LA R2,1(R2) R2 -> next byte in request message
BCT R3,B110
*
* R2 -> beyond first word of request message
* R3 = remaining length of request message
*
* copy first word to DSA_COMMAND
B111 EQU *
L R15,REQUEST_LENGTH R15 = length
LA R14,REQUEST_MESSAGE R14 = address
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
*
* make command code uppercase
OC DSA_COMMAND,=8X'40'
*
*** LEMTRACE 0,'I255606: COMMAND: ',(DSA_COMMAND,8,C)
*** LEMTRACE 0,'I255606: COMMAND: ',(DSA_COMMAND,8,X)
*
*......................................................................
*
* if command is "SHUTDOWN"
* then return to caller with RC=4
*
* The RC is checked by I255605 to determine it it
* should accept the next connection or if it should
* return to its caller to terminate the program
*
* shutdown?
CLC DSA_COMMAND,=CL8'SHUTDOWN'
BNE B120 not shutdown
*
* shutdown request
LEMTRACE 0,'I255606: SHUTDOWN requested'
*
* confirm SHUTDOWN
MVC REPLY_LENGTH,=F'17'
MVC REPLY_MESSAGE,=CL17'OK, will shutdown'
*
* return to caller with RC=4 (causes shutdown)
MVC DSA_RC,=F'4'
B C100
*
*......................................................................
*
* if command is "VERIFY"
* then call I255607 to service the password request
*
B120 EQU *
*
* VERIFY?
CLC DSA_COMMAND,=CL8'VERIFY'
BNE B130 not VERIFY
*
* call I255607 to verify password
LR R1,PARM
L R15,=V(I255607)
BASR R14,R15
*
* I255607 is expected to have completed the REPLY
*
* return to caller with RC=0 (accept next request)
MVC DSA_RC,=F'0'
B C100
*
*......................................................................
*
* command unknown (not "SHUTDOWN" and not "VERIFY")
B130 EQU *
*
* echo request message
MVC REPLY_LENGTH,REQUEST_LENGTH
MVC REPLY_MESSAGE,REQUEST_MESSAGE
*
* return to caller with RC=0 (accept next request)
MVC DSA_RC,=F'0'
B C100
*
***********************************************************************
***********************************************************************
*
* return REPLY message
*
C100 EQU *
*
*......................................................................
*
* trace reply message (before translating to ISO_8859-1)
L 2,REPLY_LENGTH
*** LEMTRACE 0,'I255606: reply: ',(REPLY_MESSAGE,(2),C)
*
*......................................................................
*
* translate reply message to ISO-8859-1
L R1,REPLY_LENGTH
EX R1,C110 execute TR instruction
B C120
*
* the length of the first operand is supplied in R1
C110 TR REPLY_MESSAGE(0),ISO_8859_1
*
*......................................................................
*
* trace reply message (after translation to ISO_8859-1)
C120 EQU *
L 2,REPLY_LENGTH
*** LEMTRACE 0,'I255606: ISO-8859-1: ',(REPLY_MESSAGE,(2),X)
*
***********************************************************************
**********************************************************************
*
* return to caller
X100 EQU *
*** LEMTRACE 0,'I255606: exit'
*
* DSA_RC contains the return code (RC)
L R15,DSA_RC
LEMEXIT RC=(15)
*
*********************************************************************
**********************************************************************
*
* translation table from ISO-8859-1 to EBCDIC
*
EBCDIC 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'40217F7B5B6C507D4D5D5C4E6B604B61' 2.
DC X'F0F1F2F3F4F5F6F7F8F97A5E4D7E6E6F' 3.
DC X'7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6' 4.
DC X'D7D8D9E2E3E4E5E6E7E8E95BE05D5E6D' 5.
DC X'79818283848586878889919293949596' 6.
DC X'979899A2A3A4A5A6A7A8A9C07CD07E7F' 7.
DC X'808182838485868788898A8B8C8D8E8F' 8.
DC X'909192939495969798999A9B9C9D9E9F' 9.
DC X'A0A1A2B1A4A56AA7A8B4AA8AACADAEAF' A.
DC X'908FB2B3B4B5B6B7B8B9BA8BBCBDBEBF' B.
DC X'6465626663679E687471727378757677' C.
DC X'D069EDEEEBEFECD7FBFDFEDBFCDDDE59' D.
DC X'E0E1E2E343E5E6E754515253ECEDEEEF' E.
DC X'8CF1CDCECBCFCCF7F8F9DEDBDCDDFEDF' F.
* .0.1.2.3.4.5.6.7.8.9.A.B.C.D.E.F
*
*********************************************************************
**********************************************************************
*
* translation table from EBCDIC TO ISO-8859-1
*
ISO_8859_1 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'204142E44445464748494A2E3C282B4F' 4.
DC X'26E9EAEBE855565758DF5A242A293B5F' 5.
DC X'2D2FC2C4C0C1C3C5C7D1A62C255F3E3F' 6.
DC X'70C9CACBC8CDCECFCC603A2340273D22' 7.
DC X'80616263646566676869ABBBF08D8EB1' 8.
DC X'B06A6B6C6D6E6F7071729A9B9C9DC69F' 9.
DC X'A0A1737475767778797AAAABACADAEAF' A.
DC X'B0A3B2B3A9B5B6B7B8B9BABBBCBDBEBF' B.
DC X'7B414243444546474849CAF4F6F2F3F5' C.
DC X'7D4A4B4C4D4E4F505152DAFBFCFDFAFF' D.
DC X'5CE1535455565758595AEAD4D6D2D3D5' E.
DC X'30313233343536373839FAD8DCD9DAFF' 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_COMMAND DS CL8 command (first word of request message)
DSA_RC DS F return code (RC)
*
*......................................................................
*
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