Title : MFS Format and Exit to support /SIGN Command Submitter : Ray Folwell Rolls-Royce plc PO Box 31 Derby DE2 8BJ Phone : 0332-249814 Release Submitter Details - Y Text :- This MFS block and MFS Segment Edit exit support the /SIGN ON command. The MFS Exit is used to allow the user to optionally enter a new password without having to enter the keyword 'NEWPW'. The MFS block sets the default value of the new password to '????????'. If the user does not enter a new password, the message generated by MFS will be : /SIGN ON userid password NEWPW ????????. If a new password is entered, MFS will generate : /SIGN ON userid password NEWPW newpass The exit scans the input segment for the string '????????' and replaces it and the preceeding keyword with blanks giving the correct format of command. This technique may be useful with other IMS commands as well as /SIGN. MFS source :- PRINT NOGEN * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * MFS BLOCK TO SUPPORT IMS /SIGN COMMAND USING RACF * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * SPACE 3 F0SIGN FMT DEV TYPE=(3270,2),FEAT=IGNORE,SYSMSG=SYSMS#, C PFK=(PFKIN,1='/SIGN OFF.',13='/SIGN OFF.', C 3='/RCLSDST .',15='/RCLSDST .') DIV TYPE=INOUT SPACE F0SIGND1 DPAGE CURSOR=((6,22)) TIMED# DFLD POS=(1,66),LTH=5,ATTR=(PROT) DATE3# DFLD POS=(1,72),LTH=8,ATTR=(PROT) SYSMS# DFLD POS=(24,2),LTH=74,ATTR=(NUM,PROT,HI) LTMSG# DFLD POS=(24,77),LTH=4,ATTR=(NUM,PROT,HI) DFLD '--------------------------- IMS/VS SIGN ON ------------C --------',ATTR=HI,POS=(1,2) DFLD 'ENTER SIGN ON INFORMATION BELOW',ATTR=HI,POS=(4,5) DFLD 'USERID',POS=(6,5) DFLD '===>',ATTR=HI,POS=(6,17) USERID DFLD POS=(6,22),LTH=8,ATTR=(ALPHA,MOD) DFLD 'PASSWORD',POS=(8,5) DFLD '===>',ATTR=HI,POS=(8,17) PASSWD DFLD POS=(8,22),LTH=8,ATTR=(ALPHA,MOD,NODISP) DFLD ' ',ATTR=ALPHA,POS=(8,31) DFLD 'NEW PASSWORD',POS=(8,53) DFLD '===>',ATTR=HI,POS=(8,66) NEWPWD DFLD POS=(8,71),LTH=8,ATTR=(ALPHA,NODISP) DFLD ' ',ATTR=ALPHA,POS=(8,80) FREEFRM DFLD POS=(23,2),LTH=59,ATTR=(ALPHA,NOPROT,NOMOD) DFLD 'PRESS ENTER TO SIGN ON - PF1 TO SIGN OFF - PF3 TO LEAVEC IMS',ATTR=HI,POS=(22,2) FMTEND EJECT * THE MID DESCIPTION FOR THE DISPLAY SCREEN SPACE 3 I0SIGN MSG TYPE=INPUT,SOR=F0SIGN,NXT=SIGN LPAGE SOR=(F0SIGND1) LPAGE FOR SIGN ON SEG EXIT=(126,0) MFLD FREEFRM,LTH=59,FILL=NULL MFLD (PFKIN,'/SIGN ON '),LTH=10,FILL=NULL MFLD USERID,LTH=8,FILL=NULL MFLD ' ' MFLD PASSWD,LTH=8,FILL=NULL MFLD ' NEWPW ' MFLD (NEWPWD,'????????'),LTH=8,FILL=NULL MSGEND EJECT * THE MOD DESCRIPTION FOR THE DISPLAY SCREEN SPACE 3 SIGN MSG TYPE=OUTPUT,SOR=(F0SIGN,IGNORE),OPT=1 F0SIGNL1 LPAGE SOR=F0SIGND1,NXT=I0SIGN SEG MFLD SYSMS#,LTH=72 MFLD (TIMED#,TIME) MFLD (DATE3#,DATE3) MFLD (LTMSG#,LTMSG) MSGEND END Segment Edit Exit :- E126 TITLE 'DFSME126 -- IMS SEGMENT EDIT EXIT ROUTINE ' *********************************************************************** * IMS SEGMENT EDIT EXIT ROUTINE * ******************************************************************* * * * * FUNCTION: * * THE FUNCTIONS PERFORMED BY THIS ROUTINE ARE BASED * * UPON THE ENTRY VECTOR. * * * ******************************************************************* * * VECTOR * ACTION * ******************************************************************* * * 0 IF SEGMENT IS IMS COMMAND ('/' IN FIRST POSITION) * * DELETE ANY KEYWD FOLLOWED BY '????????'. * * * * NO SEGMENT MODIFICATION IF MSG IS OPTION 3 * ******************************************************************* * * * * ENTRY REGISTERS: * * R1 A(PARM LIST) * * R13 A(SAVEAREA) * * R14 RETURN ADDRESS * * R15 DFSME126 ENTRY POINT ADDRESS * * PARM LIST * * WORD1 FLAGS,0,0,VECTOR * * WORD2 MAX SEGMENT LENGTH * * WORD3 ADDRESS OF EDITED SEGMENT * * WORD4 HIGHEST FLD EXIT RETURN CODE * * * *********************************************************************** SPACE 3 DFSME126 CSECT SAVE (14,12),,ME126 USING SAVEAREA,R13 L R13,SAVENEXT LR R12,R15 USING DFSME126,R12 LR R11,R1 USING MFSSEGE,R11 SPACE TM SEGFLAG,SEGEXIT SEGMENT EXIT BZ RETURN0 NO - SOME FOOL HAS CALLED US AS FIELD EXIT CLI SEGVECT,MAXVECT VALID VECTOR ? BH RETURN0 NO SO QUIT SPACE 3 * BRANCH TO ROUTINE FOR THIS VECTOR SR R2,R2 IC R2,SEGVECT GET VECTOR NUMBER SLL R2,2 TIMES 4 L R2,VECTAB(R2) GET ROUTINE ADDRESS BR R2 AND BRANCH TO IT EJECT RETURN0 SR R15,R15 *********************************************************************** RETURN EQU * * RETURN TO CALLER * *********************************************************************** L R13,SAVELAST RETURN (1,12) EJECT *********************************************************************** * ROUTINE FOR VECTOR 0 - DELETE KEYWORDS FROM IMS COMMAND IF NO * * OPERAND FOLLOWS * *********************************************************************** VECTOR0 DS 0H TM SEGFLAG,SEGOPT OPTION 3 ? BO RETURN0 YES - WILL NOT PROCESS THAT L R9,SEGADDR USING SEGMNT,R9 CLI SEGMDATA,C'/' IS IT IMS COMMAND ? BNE RETURN0 NO SPACE * SEGMENT NEED TO BE AT LEAST 19 BYTES LONG IE. LLZZ/CMD K ???????? LH R3,SEGMLL GET LENGTH CH R3,=H'19' IS IT LONG ENOUGH ? BL RETURN0 NO SPACE AR R3,R9 POINT AT END OF SEGENT SH R3,=H'8' LESS 8 BYTES FOR FINAL KEYWORD LA R2,1 SET UP FOR BXLE LA R9,SEGMDATA+4 POINT PAST '/CMD' SPACE SCANCMD CLI 0(R9),BLANK END OF COMMAND ? BE CMDEND YES BXLE R9,R2,SCANCMD LOOK AT NEXT BYTE B RETURN0 SEGMENT CONTAINS NO KEYWORDS SPACE CMDEND DS 0H LR R5,R9 SET LAST KEYWD POSITION TO CURRENT POS SPACE SCANBLNK DS 0H SCAN OVER ONE OR MORE BLANKS CLI 0(R9),BLANK BNE KEYWDST HAVE FOUND START OF NEXT KEYWORD BXLE R9,R2,SCANBLNK LOOP ROUND TO LOOK AT NEXT CHAR B RETURN0 HAVE GOT TO END OF SEGMENT SPACE 2 KEYWDST DS 0H START OF KEYWORD FOUND CLC 0(8,R9),NULLKYWD IS THIS ONE ???????? ? BE DELKEYWD YES SO GO TO CLEAR IT LR R5,R9 REMEMBER THE START OF THIS KEYWORD SPACE KWDSCAN DS 0H SCAN OVER THE NEXT KEYWORD CLI 0(R9),BLANK END OF KEYWORD ? BE SCANBLNK YES CLI 0(R9),C'.' END OF COMMAND ? BE RETURN0 YES BXLE R9,R2,KWDSCAN BACK FOR NEXT CHARACTER B RETURN0 GOT TO END OF SEGMENT SPACE 2 DELKEYWD DS 0H DELETE ????????? AND PRECEDING KEYWORD * NUMBER OF BYTES TO CLEAR = R9-R5+8 STARTING AT R5 LA R6,6(,R9) CALC EXEC LENGTH OF RIPPLE MOVE SR R6,R5 MVI 0(R5),BLANK MOVE IN A BLANK EX R6,CLEAR AND RIPLE IT THROUGH LA R9,8(,R9) POINT AT POSITION PAST ???????? LR R5,R9 B SCANBLNK AND CONTINUE SPACE CLEAR MVC 1(0,R5),0(R5) EXECUTED MOVE EJECT VECTAB DS 0F DC A(VECTOR0) MAXVECT EQU (*-VECTAB-4)/4 MAXIMUM ENTRY VECTOR EJECT BLANK EQU C' ' NULLKYWD DC CL8'????????' LTORG COPY MFSSEGE SPACE SEGMNT DSECT SEGMLL DS H SEGMZZ DS H SEGMDATA DS C SPACE REQUATE SAVE=YES END