Figure 1, in assembler language,
limits logon to netnames L77A and L77B. The model names used are known
in advance. A logon request from any other terminal, or a request
for a model which cannot be found, is rejected. Figure 1. Example of how to customize the DFHZATDX sample program (part
1)
* REGISTER CONVENTIONS = *
* R0 free *
* R1 free *
* R2 Base for Input parameters *
* R3 Base for code addressability *
* R4 Base for model name list *
* R5 Base for output parameter list *
* R6 Work register *
* R7 -----"------- *
* R8 -----"------- *
* R9 free *
* R10 Internal subroutine linkage return *
* R11 Base for EIB *
* R12 free *
* R13 Base for dynamic storage *
* R14 free *
* R15 free *
*
* SELECT MODEL
*
LH R6,TABLEN Number of valid netnames
LA R7,TABLE Address the table
*
LOOP1 CLC NETNAME(4),0(R7) Is this netname in table?
BE VALIDT
*
LA R7,16(R7) Next table entry
BCT R6,LOOP1
*
* Now we know its not a valid netname
* return and the logon is rejected
*
B RETURN
*
Figure 2. Example of how to customize the DFHZATDX sample
program (part 2)
* R7 now points to model name
VALIDT CLI SELECTED_MODELNAME,C' ' MTS model name supplied?
BNE VALIDM1 Yes
LH R6,MODELNAME_COUNT Count of models
LTR R6,R6 Were any presented?
BZ RETURN No
LA R8,MODELNAME First model name
*
LOOP2 CLC 8(8,R7),0(R8) Is this model name here?
BE VALIDM
*
LA R8,L'MODELNAME(R8) Next model name
BCT R6,LOOP2
*
* Now we know the required model name was not presented
* to this exit by CICS, a return rejects the logon
*
B RETURN
*
* At this point the model name was found in those presented
* It is given to CICS and the new termid is
* the netname
*
VALIDM MVC SELECTED_MODELNAME,0(R8) R8 was left pointing at
* model name
VALIDM1 DS 0H
MVC SELECTED_TERM_ID,NETNAME Use netname for termid
* (4 chars)
*
*
* SELECTIONS COMPLETE, RETURN
*
MVI SELECTED_RETURN_CODE,X'00' Indicate all OK
B RETURN Exit program
*
* Table of netnames allowed to log on and the model name
* necessary for the logon to be successful
*
* Format of table :
* Bytes 1 to 8 Netname allowed to log on
* 9 to 16 Model required for netname
*
DS 0D
TABLE DC CL8'L77A',CL8'3270064'
DC CL8'L77B',CL8'3270065'
TABLEN DC Y((*-TABLE)/16)
*