-
Notifications
You must be signed in to change notification settings - Fork 4
/
Email Client.cob
382 lines (352 loc) · 14.2 KB
/
Email Client.cob
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
IDENTIFICATION DIVISION.
PROGRAM-ID. EMAIL.
INSTALLATION.
AUTHOR. SUPERK.
DATE-WRITTEN. 4/8/2006.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT REXX-FILE ASSIGN TO UT-S-SYSPROC
ORGANIZATION IS SEQUENTIAL
ACCESS IS SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD REXX-FILE
LABEL RECORD STANDARD
BLOCK 0 RECORDS
RECORDING MODE F
RECORD CONTAINS 255 CHARACTERS.
01 REXX-RECORD PIC X(255).
WORKING-STORAGE SECTION.
01 MAILBOX-ADDRESS PIC X(64).
01 REPLYTO-ADDRESS PIC X(64).
01 DEBUG-ACTION PIC X(5).
01 FILLER.
05 WS-DUMMY PIC S9(8) COMP.
05 WS-RETURN-CODE PIC S9(8) COMP.
05 WS-REASON-CODE PIC S9(8) COMP.
05 WS-INFO-CODE PIC S9(8) COMP.
05 WS-CPPL-ADDRESS PIC S9(8) COMP.
05 WS-FLAGS PIC X(4) VALUE X'00010001'.
05 WS-BUFFER PIC X(256).
05 WS-LENGTH PIC S9(8) COMP VALUE 256.
01 JOB-NAME PIC X(8).
01 PROC-STEP PIC X(8).
01 STEP-NAME PIC X(8).
01 JOB-NUMBER PIC X(8).
01 PROGRAM-NAME PIC X(8).
01 USER-ID PIC X(8).
01 GROUP-NAME PIC X(8).
01 USER-NAME PIC X(20).
01 BATCH-OR-CICS PIC X(5).
01 FOUR-BYTES.
05 FULL-WORD PIC S9(8) COMP.
01 JOB-NAMEX PIC X(8).
01 SMTP-SERVER-1 PIC X(64) VALUE
'SMTP.SERVER.1'.
01 SMTP-SERVER-2 PIC X(64) VALUE
'SMTP.SERVER.2'.
01 SMTP-SERVER-3 PIC X(64) VALUE
'SMTP.SERVER.3'.
01 MESSAGE-TABLE.
05 MESSAGE-TEXT OCCURS 30 TIMES.
10 FILLER PIC X(80).
01 IDX PIC 9(2) COMP.
LINKAGE SECTION.
01 CB1.
05 PTR1 POINTER OCCURS 256.
01 CB2.
05 PTR2 POINTER OCCURS 256.
01 PARM.
05 PARM-LENGTH PIC S9(04) COMP SYNC.
05 THE-PARM PIC X(100).
PROCEDURE DIVISION USING PARM.
UNSTRING THE-PARM
DELIMITED BY ',' INTO MAILBOX-ADDRESS
REPLYTO-ADDRESS
DEBUG-ACTION.
INSPECT MAILBOX-ADDRESS REPLACING ALL LOW-VALUES BY SPACES.
INSPECT REPLYTO-ADDRESS REPLACING ALL LOW-VALUES BY SPACES.
INSPECT DEBUG-ACTION REPLACING ALL LOW-VALUES BY SPACES.
MOVE SPACES TO MESSAGE-TABLE.
PERFORM GET-MESSAGE-TEXT
VARYING IDX FROM 1 BY 1
UNTIL IDX = 30.
CALL 'IKJTSOEV' USING WS-DUMMY WS-RETURN-CODE WS-REASON-CODE
WS-INFO-CODE WS-CPPL-ADDRESS.
IF WS-RETURN-CODE > 0
DISPLAY 'IKJTSOEV FAILED, RETURN-CODE=' WS-RETURN-CODE
' REASON-CODE=' WS-REASON-CODE 'INFO-CODE=' WS-INFO-CODE
UPON CONSOLE
MOVE WS-RETURN-CODE TO RETURN-CODE
STOP RUN.
MOVE SPACES TO WS-BUFFER.
MOVE 'ALLOC DD(SYSOUT) SYSOUT(*) REUSE'
TO WS-BUFFER.
CALL 'IKJEFTSR' USING WS-FLAGS WS-BUFFER WS-LENGTH
WS-RETURN-CODE WS-REASON-CODE WS-DUMMY.
DISPLAY WS-BUFFER UPON CONSOLE.
IF WS-RETURN-CODE > 0
DISPLAY 'IKJEFTSR FAILED, RETURN-CODE=' WS-RETURN-CODE
' REASON-CODE=' WS-REASON-CODE
UPON CONSOLE
MOVE WS-RETURN-CODE TO RETURN-CODE
STOP RUN.
SET ADDRESS OF CB1 TO NULL.
SET ADDRESS OF CB1 TO PTR1(136).
SET ADDRESS OF CB2 TO PTR1(4).
MOVE CB2(1:8) TO JOB-NAME.
MOVE CB2(9:8) TO PROC-STEP.
MOVE CB2(17:8) TO STEP-NAME.
SET ADDRESS OF CB2 TO PTR1(46).
MOVE CB2(361:8) TO PROGRAM-NAME.
SET ADDRESS OF CB2 TO PTR2(80).
MOVE CB2(13:8) TO JOB-NUMBER.
SET ADDRESS OF CB2 TO PTR1(53).
IF CB2(21:4) = LOW-VALUES THEN
MOVE 'BATCH' TO BATCH-OR-CICS
ELSE
MOVE 'CICS ' TO BATCH-OR-CICS
END-IF.
SET ADDRESS OF CB1 TO NULL.
SET ADDRESS OF CB1 TO PTR1(138).
SET ADDRESS OF CB2 TO PTR1(28).
MOVE CB2(193:8) TO USER-ID.
SET ADDRESS OF CB2 TO PTR2(51).
MOVE CB2(31:8) TO GROUP-NAME.
SET ADDRESS OF CB1 TO PTR2(26).
MOVE ZERO TO FULL-WORD.
MOVE CB1(1:1) TO FOUR-BYTES(4:1).
MOVE CB1(2:FULL-WORD) TO USER-NAME.
MOVE JOB-NAME TO JOB-NAMEX.
INSPECT JOB-NAMEX REPLACING ALL ' ' BY '@'.
MOVE SPACES TO WS-BUFFER.
IF DEBUG-ACTION IS NOT EQUAL TO 'DEBUG'
STRING 'ALLOC DD(SYSPROC)'
' DA('
QUOTE
'PPDD.'
JOB-NAMEX
'.REXX'
QUOTE
') NEW REUSE DELETE RECFM(F B) LRECL(255)'
' BLKSIZE(0) SPACE(1,1) CYLINDERS'
' UNIT(SYSDA)'
DELIMITED BY SIZE INTO WS-BUFFER
ELSE
STRING 'ALLOC DD(SYSPROC)'
' DA('
QUOTE
'HLQ.'
JOB-NAMEX
'.REXX'
QUOTE
') NEW REUSE CATALOG RECFM(F B) LRECL(255)'
' BLKSIZE(0) SPACE(1,1) CYLINDERS'
' UNIT(SYSDA)'
DELIMITED BY SIZE INTO WS-BUFFER.
CALL 'IKJEFTSR' USING WS-FLAGS WS-BUFFER WS-LENGTH
WS-RETURN-CODE WS-REASON-CODE WS-DUMMY.
IF DEBUG-ACTION IS EQUAL TO 'DEBUG'
DISPLAY WS-BUFFER.
IF WS-RETURN-CODE > 0
DISPLAY 'IKJEFTSR FAILED, RETURN-CODE=' WS-RETURN-CODE
' REASON-CODE=' WS-REASON-CODE
MOVE WS-RETURN-CODE TO RETURN-CODE
STOP RUN.
OPEN OUTPUT REXX-FILE.
MOVE SPACES TO REXX-RECORD.
MOVE '/* REXX */' TO REXX-RECORD.
WRITE REXX-RECORD.
MOVE 'TRACE O' TO REXX-RECORD.
WRITE REXX-RECORD.
MOVE 'CRLF = X2C("0D25")' TO REXX-RECORD.
WRITE REXX-RECORD.
MOVE SPACES TO REXX-RECORD.
STRING 'JOBNAME = STRIP("'
JOB-NAME
'")'
DELIMITED BY SIZE INTO REXX-RECORD.
WRITE REXX-RECORD.
MOVE SPACES TO REXX-RECORD.
STRING 'JOBID = STRIP("'
JOB-NUMBER
'")'
DELIMITED BY SIZE INTO REXX-RECORD.
WRITE REXX-RECORD.
MOVE SPACES TO REXX-RECORD.
STRING 'SMTP_ADDRESS1 = STRIP("'
SMTP-SERVER-1
'")'
DELIMITED BY SIZE INTO REXX-RECORD.
WRITE REXX-RECORD.
MOVE SPACES TO REXX-RECORD.
STRING 'SMTP_ADDRESS2 = STRIP("'
SMTP-SERVER-2
'")'
DELIMITED BY SIZE INTO REXX-RECORD.
WRITE REXX-RECORD.
MOVE SPACES TO REXX-RECORD.
STRING 'SMTP_ADDRESS3 = STRIP("'
SMTP-SERVER-3
'")'
DELIMITED BY SIZE INTO REXX-RECORD.
WRITE REXX-RECORD.
MOVE SPACES TO REXX-RECORD.
STRING 'SMTP_MAILBOX = STRIP("'
MAILBOX-ADDRESS
'")'
DELIMITED BY SIZE INTO REXX-RECORD.
WRITE REXX-RECORD.
MOVE SPACES TO REXX-RECORD.
STRING 'SMTP_REPLYTO = STRIP("'
REPLYTO-ADDRESS
'")'
DELIMITED BY SIZE INTO REXX-RECORD.
WRITE REXX-RECORD.
MOVE SPACES TO REXX-RECORD.
STRING 'SMTP_SUBJECT = "MESSAGE FROM "'
'||JOBNAME||"."||JOBID||"@TIAA-CREF.ORG"'
DELIMITED BY SIZE INTO REXX-RECORD.
WRITE REXX-RECORD.
MOVE 'STR = SOCKET("INITIALIZE",DATE(B))' TO REXX-RECORD.
WRITE REXX-RECORD.
MOVE 'STR = SOCKET("SOCKET","AF_INET","STREAM","TCP")'
TO REXX-RECORD.
WRITE REXX-RECORD.
MOVE 'PARSE VAR STR SOCKRC SOCKID' TO REXX-RECORD.
WRITE REXX-RECORD.
MOVE SPACES TO REXX-RECORD.
STRING 'STR = SOCKET("SETSOCKOPT",SOCKID,"SOL_SOCKET",'
'"SO_ASCII","ON")'
DELIMITED BY SIZE INTO REXX-RECORD.
WRITE REXX-RECORD.
MOVE 'SERVER_INFO="AF_INET 25 "SMTP_ADDRESS1' TO REXX-RECORD.
WRITE REXX-RECORD.
MOVE 'STR = SOCKET("CONNECT",SOCKID,SERVER_INFO)'
TO REXX-RECORD.
WRITE REXX-RECORD.
MOVE 'STR = SOCKET("RECV",SOCKID,10000)' TO REXX-RECORD.
WRITE REXX-RECORD.
MOVE 'MSG = "HELO "||SMTP_ADDRESS1||CRLF' TO REXX-RECORD.
WRITE REXX-RECORD.
MOVE 'SAY MSG' TO REXX-RECORD.
WRITE REXX-RECORD.
MOVE 'STR = SOCKET("SEND",SOCKID,MSG)' TO REXX-RECORD.
WRITE REXX-RECORD.
MOVE 'STR = SOCKET("RECV",SOCKID,10000)' TO REXX-RECORD.
WRITE REXX-RECORD.
MOVE 'PARSE VAR STR SOCKRC DATA_LENGTH SMTP_RESPONSE'
TO REXX-RECORD.
WRITE REXX-RECORD.
MOVE 'SAY "RECV:"STR' TO REXX-RECORD.
WRITE REXX-RECORD.
MOVE SPACES TO REXX-RECORD.
STRING 'MSG = "MAIL FROM:<AUTOOPERATOR@TIAA-CREF.ORG>"'
'||CRLF'
DELIMITED BY SIZE INTO REXX-RECORD.
WRITE REXX-RECORD.
MOVE 'STR = SOCKET("SEND",SOCKID,MSG)' TO REXX-RECORD.
WRITE REXX-RECORD.
MOVE 'STR = SOCKET("RECV",SOCKID,10000)' TO REXX-RECORD.
WRITE REXX-RECORD.
MOVE 'PARSE VAR STR SOCKRC DATA_LENGTH SMTP_RESPONSE'
TO REXX-RECORD.
WRITE REXX-RECORD.
MOVE 'MSG = "RCPT TO:<"||SMTP_MAILBOX||">"||CRLF'
TO REXX-RECORD.
WRITE REXX-RECORD.
MOVE 'STR = SOCKET("SEND",SOCKID,MSG)' TO REXX-RECORD.
WRITE REXX-RECORD.
MOVE 'STR = SOCKET("RECV",SOCKID,10000)' TO REXX-RECORD.
WRITE REXX-RECORD.
MOVE 'PARSE VAR STR SOCKRC DATA_LENGTH SMTP_RESPONSE'
TO REXX-RECORD.
WRITE REXX-RECORD.
MOVE 'MSG = "DATA"||CRLF' TO REXX-RECORD.
WRITE REXX-RECORD.
MOVE 'STR = SOCKET("SEND",SOCKID,MSG)' TO REXX-RECORD.
WRITE REXX-RECORD.
MOVE 'STR = SOCKET("RECV",SOCKID,10000)' TO REXX-RECORD.
WRITE REXX-RECORD.
MOVE 'PARSE VAR STR SOCKRC DATA_LENGTH SMTP_RESPONSE'
TO REXX-RECORD.
WRITE REXX-RECORD.
MOVE 'MSG = "TO:"||SMTP_MAILBOX||CRLF,' TO REXX-RECORD.
WRITE REXX-RECORD.
MOVE '||"REPLY-TO:"||SMTP_REPLYTO||CRLF,' TO REXX-RECORD.
WRITE REXX-RECORD.
MOVE '||"SUBJECT:"SMTP_SUBJECT||CRLF,' TO REXX-RECORD.
WRITE REXX-RECORD.
MOVE '||"X-MAILER: REXX EXEC ON MVS"||CRLF' TO REXX-RECORD.
WRITE REXX-RECORD.
MOVE 'STR = SOCKET("SEND",SOCKID,MSG)' TO REXX-RECORD.
WRITE REXX-RECORD.
MOVE 'STR = SOCKET("SEND",SOCKID,CRLF)' TO REXX-RECORD.
WRITE REXX-RECORD.
PERFORM WRITE-MESSAGE-TEXT
VARYING IDX FROM 1 BY 1
UNTIL IDX = 30.
MOVE 'MSG = CRLF||"."||CRLF' TO REXX-RECORD.
WRITE REXX-RECORD.
MOVE 'STR = SOCKET("SEND",SOCKID,MSG)' TO REXX-RECORD.
WRITE REXX-RECORD.
MOVE 'STR = SOCKET("RECV",SOCKID,10000)' TO REXX-RECORD.
WRITE REXX-RECORD.
MOVE 'PARSE VAR STR SOCKRC DATA_LENGTH SMTP_RESPONSE'
TO REXX-RECORD.
WRITE REXX-RECORD.
MOVE 'MSG = "QUIT"||CRLF' TO REXX-RECORD.
WRITE REXX-RECORD.
MOVE 'STR = SOCKET("SEND",SOCKID,MSG)' TO REXX-RECORD.
WRITE REXX-RECORD.
MOVE 'STR = SOCKET("CLOSE",SOCKID)' TO REXX-RECORD.
WRITE REXX-RECORD.
MOVE 'STR = SOCKET("TERMINATE",SUBTASKID)' TO REXX-RECORD.
WRITE REXX-RECORD.
MOVE 'SAY "EMAIL SENT TO "||SMTP_MAILBOX' TO REXX-RECORD.
WRITE REXX-RECORD.
MOVE 'EXIT 0' TO REXX-RECORD.
WRITE REXX-RECORD.
CLOSE REXX-FILE.
MOVE SPACES TO WS-BUFFER.
STRING 'EXEC '
QUOTE
'PPDD.'
JOB-NAMEX
'.REXX'
QUOTE
DELIMITED BY SIZE INTO WS-BUFFER.
CALL 'IKJEFTSR' USING WS-FLAGS WS-BUFFER WS-LENGTH
WS-RETURN-CODE WS-REASON-CODE WS-DUMMY.
IF DEBUG-ACTION IS EQUAL TO 'DEBUG'
DISPLAY WS-BUFFER.
IF WS-RETURN-CODE > 0
DISPLAY 'IKJEFTSR FAILED, RETURN-CODE=' WS-RETURN-CODE
' REASON-CODE=' WS-REASON-CODE
MOVE WS-RETURN-CODE TO RETURN-CODE
STOP RUN.
MOVE SPACES TO WS-BUFFER.
MOVE 'FREE DD(SYSPROC)' TO WS-BUFFER.
CALL 'IKJEFTSR' USING WS-FLAGS WS-BUFFER WS-LENGTH
WS-RETURN-CODE WS-REASON-CODE WS-DUMMY.
IF DEBUG-ACTION IS EQUAL TO 'DEBUG'
DISPLAY WS-BUFFER.
IF WS-RETURN-CODE > 0
DISPLAY 'IKJEFTSR FAILED, RETURN-CODE=' WS-RETURN-CODE
' REASON-CODE=' WS-REASON-CODE
MOVE WS-RETURN-CODE TO RETURN-CODE
STOP RUN.
MOVE 0 TO RETURN-CODE.
STOP RUN.
GET-MESSAGE-TEXT.
ACCEPT MESSAGE-TEXT(IDX) FROM SYSIN.
WRITE-MESSAGE-TEXT.
MOVE SPACES TO REXX-RECORD.
STRING 'MSG = STRIP("'
MESSAGE-TEXT(IDX)
'")||CRLF'
DELIMITED BY SIZE INTO REXX-RECORD.
WRITE REXX-RECORD.
MOVE 'STR = SOCKET("SEND",SOCKID,MSG)' TO REXX-RECORD.
WRITE REXX-RECORD.