Files
DUTAS/CICS/RCSIGNON.cob
2025-09-17 04:43:28 -04:00

135 lines
3.5 KiB
COBOL

IDENTIFICATION DIVISION.
PROGRAM-ID. RCSIGNON.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-RESP PIC S9(8) COMP.
01 WS-RESP2 PIC S9(8) COMP.
01 WS-USER PIC X(56) VALUE SPACES.
01 WS-PASS PIC X(50).
01 WS-USERID PIC X(8) VALUE SPACES.
*To generate the xml and copybook of the logon screen
* rcbms -GenBasedSymbolicMap -Language=cobol SIGNON.bms
COPY SIGNON.
* COPY DFHBMSCA.
* COPY DFHAID.
COPY DFHRESP.
LINKAGE SECTION.
01 DFHCOMMAREA.
05 LK-DATA PIC X(1).
PROCEDURE DIVISION.
IF EIBCALEN = 0
EXEC CICS
GETMAIN SET(ADDRESS OF DFHCOMMAREA)
FLENGTH(LENGTH OF DFHCOMMAREA)
END-EXEC
MOVE 0 TO LK-DATA
PERFORM SEND-MAP
END-IF.
IF LK-DATA = 0
MOVE 1 TO LK-DATA
PERFORM REC-MAP
END-IF.
DISPLAY "=== You should never get here!".
GOBACK.
SEND-MAP.
EXEC CICS
SEND MAP('LOGONM') MAPSET('SIGNON')
ERASE
RESP(WS-RESP)
RESP2(WS-RESP2)
END-EXEC
IF WS-RESP NOT = DFHRESP(NORMAL)
*Should be replaced with better error-handling
DISPLAY '=== SEND FAILED'
GOBACK
END-IF
EXEC CICS
RETURN TRANSID('logo')
COMMAREA(DFHCOMMAREA)
LENGTH(LENGTH OF DFHCOMMAREA)
END-EXEC.
REC-MAP.
EXEC CICS
RECEIVE MAP('LOGONM') MAPSET('SIGNON')
RESP(WS-RESP)
RESP2(WS-RESP2)
END-EXEC
IF WS-RESP NOT = DFHRESP(NORMAL)
*Should be replaced with better error-handling
DISPLAY '=== RECEIVE FAILED'
EXEC CICS RETURN END-EXEC
END-IF
MOVE USERNO TO WS-USER
MOVE PASSWO TO WS-PASS
* Remove from possible mem dumps
MOVE SPACES TO PASSWO
EXEC CICS SIGNON
* USERID('LETMEIN0')
USERID(' ')
OIDCARD(WS-USER)
PHRASE(WS-PASS)
PHRASELEN(50)
RESP(WS-RESP)
RESP2(WS-RESP2)
END-EXEC
* Remove from possible mem dumps.
MOVE SPACES TO WS-PASS
IF WS-RESP = DFHRESP(NORMAL)
DISPLAY "=== Signon success!"
ELSE
*Should be replaced with better error-handling
DISPLAY "=== Signon failed!"
MOVE ZERO TO LK-DATA
MOVE 'Login unsuccessful, please try again.'
TO INFMSI
EXEC CICS
SEND MAP('LOGONM') MAPSET('SIGNON')
ERASE
RESP(WS-RESP)
RESP2(WS-RESP2)
END-EXEC
EXEC CICS
RETURN TRANSID('logo')
COMMAREA(DFHCOMMAREA)
LENGTH(LENGTH OF DFHCOMMAREA)
END-EXEC
END-IF
EXEC CICS
SET TERMINAL(EIBTRMID)
UCTRANST(DFHVALUE(UCTRAN))
END-EXEC
EXEC CICS
SEND MAP('SUXESS') MAPSET('SIGNON')
ERASE
RESP(WS-RESP)
RESP2(WS-RESP2)
END-EXEC
EXEC CICS
RETURN TRANSID('DTS')
END-EXEC.