MFmainframe-rea
WS carddemo · 26f629ef

Converted program · 120 lines of TypeScript from 260 lines of COBOL · 157 COBOL lines cited (60%)COSGN00C

Run it on the 3270 →Analysis →All programs

TypeScript carddemo-ts/src/programs/COSGN00C.ts

1/**
2 * COSGN00C — CardDemo sign-on (transaction CC00).
3 * Converted from app/cbl/COSGN00C.cbl; screen COSGN00/COSGN0A; file USRSEC.
4 */
5import { isBlank, upper } from "../runtime/cobol.js";
6import { RESP, type Cics, type Program } from "../runtime/cics.js";
7import type { SymbolicMap } from "../runtime/screen.js";
8import type { SecUserData } from "../generated/records.js";
9import { CCDA_MSG_INVALID_KEY, CCDA_MSG_THANK_YOU, populateHeaderInfo } from "./common.js";
10
11const WS_PGMNAME = "COSGN00C";
12const WS_TRANID = "CC00";
13const WS_USRSEC_FILE = "USRSEC";
14
15export const COSGN00C: Program = {
16 name: WS_PGMNAME,
17 source: "app/cbl/COSGN00C.cbl",
18 run(ctx: Cics) {
19 // WS-VARIABLES (COSGN00C.cbl:35-48)
20 const ws = { message: "", errFlg: "N", userId: "", userPwd: "" };
21 const out = ctx.map("COSGN00", "COSGN0A");
22
23 // MAIN-PARA (COSGN00C.cbl:73-102)
24 ws.errFlg = "N";
25 ws.message = "";
26 out.set("ERRMSG", "");
27
28 if (ctx.eib.calen === 0) {
29 out.clear();
30 out.cursor("USERID");
31 sendSignonScreen(ctx, out, ws);
32 } else {
33 switch (ctx.eib.aid) {
34 case "ENTER":
35 processEnterKey(ctx, out, ws);
36 break;
37 case "PF3":
38 ws.message = CCDA_MSG_THANK_YOU;
39 sendPlainText(ctx, ws);
40 break;
41 default:
42 ws.errFlg = "Y";
43 ws.message = CCDA_MSG_INVALID_KEY;
44 sendSignonScreen(ctx, out, ws);
45 }
46 }
47 // EXEC CICS RETURN TRANSID(WS-TRANID) COMMAREA(CARDDEMO-COMMAREA)
48 ctx.return(WS_TRANID, ctx.area());
49 },
50};
51
52/** PROCESS-ENTER-KEY (COSGN00C.cbl:108-140) */
53function processEnterKey(ctx: Cics, out: SymbolicMap, ws: { message: string; errFlg: string; userId: string; userPwd: string }): void {
54 const { map: input } = ctx.receiveMap("COSGN00", "COSGN0A");
55 if (isBlank(input.get("USERID"))) {
56 ws.errFlg = "Y";
57 ws.message = "Please enter User ID ...";
58 out.cursor("USERID");
59 sendSignonScreen(ctx, out, ws);
60 } else if (isBlank(input.get("PASSWD"))) {
61 ws.errFlg = "Y";
62 ws.message = "Please enter Password ...";
63 out.cursor("PASSWD");
64 sendSignonScreen(ctx, out, ws);
65 }
66
67 // MOVE FUNCTION UPPER-CASE(USERIDI) TO WS-USER-ID CDEMO-USER-ID
68 ws.userId = upper(input.get("USERID")).padEnd(8).slice(0, 8);
69 ctx.area().userId = ws.userId;
70 ws.userPwd = upper(input.get("PASSWD")).padEnd(8).slice(0, 8);
71
72 if (ws.errFlg !== "Y") readUserSecFile(ctx, out, ws);
73}
74
75/** SEND-SIGNON-SCREEN (COSGN00C.cbl:145-157) */
76function sendSignonScreen(ctx: Cics, out: SymbolicMap, ws: { message: string }): void {
77 populateHeaderInfo(ctx, out, WS_TRANID, WS_PGMNAME);
78 // POPULATE-HEADER-INFO also fills APPLID / SYSID via EXEC CICS ASSIGN (COSGN00C.cbl:197-203).
79 out.set("APPLID", "CARDDEMO");
80 out.set("SYSID", "NODE");
81 out.set("ERRMSG", ws.message);
82 ctx.sendMap(out, { erase: true, cursor: true });
83}
84
85/** SEND-PLAIN-TEXT (COSGN00C.cbl:162-172) */
86function sendPlainText(ctx: Cics, ws: { message: string }): never {
87 ctx.sendText(ws.message);
88 ctx.return();
89}
90
91/** READ-USER-SEC-FILE (COSGN00C.cbl:209-257) */
92function readUserSecFile(ctx: Cics, out: SymbolicMap, ws: { message: string; errFlg: string; userId: string; userPwd: string }): void {
93 const { resp, record } = ctx.read<SecUserData>(WS_USRSEC_FILE, ws.userId);
94 if (resp === RESP.NORMAL && record) {
95 if (record.secUsrPwd === ws.userPwd) {
96 const area = ctx.area();
97 area.fromTranid = WS_TRANID;
98 area.fromProgram = WS_PGMNAME;
99 area.userId = ws.userId;
100 area.userType = record.secUsrType;
101 area.pgmContext = 0;
102 if (area.userType === "A") ctx.xctl("COADM01C", area);
103 else ctx.xctl("COMEN01C", area);
104 } else {
105 ws.message = "Wrong Password. Try again ...";
106 out.cursor("PASSWD");
107 sendSignonScreen(ctx, out, ws);
108 }
109 } else if (resp === RESP.NOTFND) {
110 ws.errFlg = "Y";
111 ws.message = "User not found. Try again ...";
112 out.cursor("USERID");
113 sendSignonScreen(ctx, out, ws);
114 } else {
115 ws.errFlg = "Y";
116 ws.message = "Unable to verify the User ...";
117 out.cursor("USERID");
118 sendSignonScreen(ctx, out, ws);
119 }
120}

COBOL app/cbl/COSGN00C.cbl

1 ******************************************************************
2 * Program : COSGN00C.CBL
3 * Application : CardDemo
4 * Type : CICS COBOL Program
5 * Function : Signon Screen for the CardDemo Application
6 ******************************************************************
7 * Copyright Amazon.com, Inc. or its affiliates.
8 * All Rights Reserved.
9 *
10 * Licensed under the Apache License, Version 2.0 (the "License").
11 * You may not use this file except in compliance with the License.
12 * You may obtain a copy of the License at
13 *
14 * http://www.apache.org/licenses/LICENSE-2.0
15 *
16 * Unless required by applicable law or agreed to in writing,
17 * software distributed under the License is distributed on an
18 * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND,
19 * either express or implied. See the License for the specific
20 * language governing permissions and limitations under the License
21 ******************************************************************
22 IDENTIFICATION DIVISION.
23 PROGRAM-ID. COSGN00C.
24 AUTHOR. AWS.
25
26 ENVIRONMENT DIVISION.
27 CONFIGURATION SECTION.
28
29 DATA DIVISION.
30 *----------------------------------------------------------------*
31 * WORKING STORAGE SECTION
32 *----------------------------------------------------------------*
33 WORKING-STORAGE SECTION.
34
35 01 WS-VARIABLES.
36 05 WS-PGMNAME PIC X(08) VALUE 'COSGN00C'.
37 05 WS-TRANID PIC X(04) VALUE 'CC00'.
38 05 WS-MESSAGE PIC X(80) VALUE SPACES.
39 05 WS-USRSEC-FILE PIC X(08) VALUE 'USRSEC '.
40 05 WS-ERR-FLG PIC X(01) VALUE 'N'.
41 88 ERR-FLG-ON VALUE 'Y'.
42 88 ERR-FLG-OFF VALUE 'N'.
43 05 WS-RESP-CD PIC S9(09) COMP VALUE ZEROS.
44 05 WS-REAS-CD PIC S9(09) COMP VALUE ZEROS.
45 05 WS-USER-ID PIC X(08).
46 05 WS-USER-PWD PIC X(08).
47
48 COPY COCOM01Y.
49
50 COPY COSGN00.
51
52 COPY COTTL01Y.
53 COPY CSDAT01Y.
54 COPY CSMSG01Y.
55 COPY CSUSR01Y.
56
57 COPY DFHAID.
58 COPY DFHBMSCA.
59 *COPY DFHATTR.
60
61 *----------------------------------------------------------------*
62 * LINKAGE SECTION
63 *----------------------------------------------------------------*
64 LINKAGE SECTION.
65 01 DFHCOMMAREA.
66 05 LK-COMMAREA PIC X(01)
67 OCCURS 1 TO 32767 TIMES DEPENDING ON EIBCALEN.
68
69 *----------------------------------------------------------------*
70 * PROCEDURE DIVISION
71 *----------------------------------------------------------------*
72 PROCEDURE DIVISION.
73 MAIN-PARA.
74
75 SET ERR-FLG-OFF TO TRUE
76
77 MOVE SPACES TO WS-MESSAGE
78 ERRMSGO OF COSGN0AO
79
80 IF EIBCALEN = 0
81 MOVE LOW-VALUES TO COSGN0AO
82 MOVE -1 TO USERIDL OF COSGN0AI
83 PERFORM SEND-SIGNON-SCREEN
84 ELSE
85 EVALUATE EIBAID
86 WHEN DFHENTER
87 PERFORM PROCESS-ENTER-KEY
88 WHEN DFHPF3
89 MOVE CCDA-MSG-THANK-YOU TO WS-MESSAGE
90 PERFORM SEND-PLAIN-TEXT
91 WHEN OTHER
92 MOVE 'Y' TO WS-ERR-FLG
93 MOVE CCDA-MSG-INVALID-KEY TO WS-MESSAGE
94 PERFORM SEND-SIGNON-SCREEN
95 END-EVALUATE
96 END-IF.
97
98 EXEC CICS RETURN
99 TRANSID (WS-TRANID)
100 COMMAREA (CARDDEMO-COMMAREA)
101 LENGTH(LENGTH OF CARDDEMO-COMMAREA)
102 END-EXEC.
103
104
105 *----------------------------------------------------------------*
106 * PROCESS-ENTER-KEY
107 *----------------------------------------------------------------*
108 PROCESS-ENTER-KEY.
109
110 EXEC CICS RECEIVE
111 MAP('COSGN0A')
112 MAPSET('COSGN00')
113 RESP(WS-RESP-CD)
114 RESP2(WS-REAS-CD)
115 END-EXEC.
116
117 EVALUATE TRUE
118 WHEN USERIDI OF COSGN0AI = SPACES OR LOW-VALUES
119 MOVE 'Y' TO WS-ERR-FLG
120 MOVE 'Please enter User ID ...' TO WS-MESSAGE
121 MOVE -1 TO USERIDL OF COSGN0AI
122 PERFORM SEND-SIGNON-SCREEN
123 WHEN PASSWDI OF COSGN0AI = SPACES OR LOW-VALUES
124 MOVE 'Y' TO WS-ERR-FLG
125 MOVE 'Please enter Password ...' TO WS-MESSAGE
126 MOVE -1 TO PASSWDL OF COSGN0AI
127 PERFORM SEND-SIGNON-SCREEN
128 WHEN OTHER
129 CONTINUE
130 END-EVALUATE.
131
132 MOVE FUNCTION UPPER-CASE(USERIDI OF COSGN0AI) TO
133 WS-USER-ID
134 CDEMO-USER-ID
135 MOVE FUNCTION UPPER-CASE(PASSWDI OF COSGN0AI) TO
136 WS-USER-PWD
137
138 IF NOT ERR-FLG-ON
139 PERFORM READ-USER-SEC-FILE
140 END-IF.
141
142 *----------------------------------------------------------------*
143 * SEND-SIGNON-SCREEN
144 *----------------------------------------------------------------*
145 SEND-SIGNON-SCREEN.
146
147 PERFORM POPULATE-HEADER-INFO
148
149 MOVE WS-MESSAGE TO ERRMSGO OF COSGN0AO
150
151 EXEC CICS SEND
152 MAP('COSGN0A')
153 MAPSET('COSGN00')
154 FROM(COSGN0AO)
155 ERASE
156 CURSOR
157 END-EXEC.
158
159 *----------------------------------------------------------------*
160 * SEND-PLAIN-TEXT
161 *----------------------------------------------------------------*
162 SEND-PLAIN-TEXT.
163
164 EXEC CICS SEND TEXT
165 FROM(WS-MESSAGE)
166 LENGTH(LENGTH OF WS-MESSAGE)
167 ERASE
168 FREEKB
169 END-EXEC.
170
171 EXEC CICS RETURN
172 END-EXEC.
173
174 *----------------------------------------------------------------*
175 * POPULATE-HEADER-INFO
176 *----------------------------------------------------------------*
177 POPULATE-HEADER-INFO.
178
179 MOVE FUNCTION CURRENT-DATE TO WS-CURDATE-DATA
180
181 MOVE CCDA-TITLE01 TO TITLE01O OF COSGN0AO
182 MOVE CCDA-TITLE02 TO TITLE02O OF COSGN0AO
183 MOVE WS-TRANID TO TRNNAMEO OF COSGN0AO
184 MOVE WS-PGMNAME TO PGMNAMEO OF COSGN0AO
185
186 MOVE WS-CURDATE-MONTH TO WS-CURDATE-MM
187 MOVE WS-CURDATE-DAY TO WS-CURDATE-DD
188 MOVE WS-CURDATE-YEAR(3:2) TO WS-CURDATE-YY
189
190 MOVE WS-CURDATE-MM-DD-YY TO CURDATEO OF COSGN0AO
191
192 MOVE WS-CURTIME-HOURS TO WS-CURTIME-HH
193 MOVE WS-CURTIME-MINUTE TO WS-CURTIME-MM
194 MOVE WS-CURTIME-SECOND TO WS-CURTIME-SS
195
196 MOVE WS-CURTIME-HH-MM-SS TO CURTIMEO OF COSGN0AO
197
198 EXEC CICS ASSIGN
199 APPLID(APPLIDO OF COSGN0AO)
200 END-EXEC
201
202 EXEC CICS ASSIGN
203 SYSID(SYSIDO OF COSGN0AO)
204 END-EXEC.
205
206 *----------------------------------------------------------------*
207 * READ-USER-SEC-FILE
208 *----------------------------------------------------------------*
209 READ-USER-SEC-FILE.
210
211 EXEC CICS READ
212 DATASET (WS-USRSEC-FILE)
213 INTO (SEC-USER-DATA)
214 LENGTH (LENGTH OF SEC-USER-DATA)
215 RIDFLD (WS-USER-ID)
216 KEYLENGTH (LENGTH OF WS-USER-ID)
217 RESP (WS-RESP-CD)
218 RESP2 (WS-REAS-CD)
219 END-EXEC.
220
221 EVALUATE WS-RESP-CD
222 WHEN 0
223 IF SEC-USR-PWD = WS-USER-PWD
224 MOVE WS-TRANID TO CDEMO-FROM-TRANID
225 MOVE WS-PGMNAME TO CDEMO-FROM-PROGRAM
226 MOVE WS-USER-ID TO CDEMO-USER-ID
227 MOVE SEC-USR-TYPE TO CDEMO-USER-TYPE
228 MOVE ZEROS TO CDEMO-PGM-CONTEXT
229
230 IF CDEMO-USRTYP-ADMIN
231 EXEC CICS XCTL
232 PROGRAM ('COADM01C')
233 COMMAREA(CARDDEMO-COMMAREA)
234 END-EXEC
235 ELSE
236 EXEC CICS XCTL
237 PROGRAM ('COMEN01C')
238 COMMAREA(CARDDEMO-COMMAREA)
239 END-EXEC
240 END-IF
241 ELSE
242 MOVE 'Wrong Password. Try again ...' TO
243 WS-MESSAGE
244 MOVE -1 TO PASSWDL OF COSGN0AI
245 PERFORM SEND-SIGNON-SCREEN
246 END-IF
247 WHEN 13
248 MOVE 'Y' TO WS-ERR-FLG
249 MOVE 'User not found. Try again ...' TO WS-MESSAGE
250 MOVE -1 TO USERIDL OF COSGN0AI
251 PERFORM SEND-SIGNON-SCREEN
252 WHEN OTHER
253 MOVE 'Y' TO WS-ERR-FLG
254 MOVE 'Unable to verify the User ...' TO WS-MESSAGE
255 MOVE -1 TO USERIDL OF COSGN0AI
256 PERFORM SEND-SIGNON-SCREEN
257 END-EVALUATE.
258 *
259 * Ver: CardDemo_v1.0-15-g27d6c6f-68 Date: 2022-07-19 23:12:33 CDT
260 *