|
|
|
|
Member
WRKVLDLE
in
WEBSECURE / QRPGLESRC
|
|
|
|
1.00 |
********************************************************************* |
2.00 |
* RPG ILE MODULE WEBSECURE/WRKVLDLE |
3.00 |
* Work with a validation list entry |
4.00 |
* |
5.00 |
* After compiling this RPG MODULE, |
6.00 |
* create the related program with the following command: |
7.00 |
* |
8.00 |
* CRTPGM WEBSECURE/WRKVLDL MODULE(WEBSECURE/WRKVLDL |
9.00 |
* WEBSECURE/WRKVLDLE WEBSECURE/LSTVLDL) |
10.00 |
* ACTGRP(WRKVLDL) AUT(*USE) |
11.00 |
* |
12.00 |
*===================================================== |
13.00 |
* |
14.00 |
* Allows to add, change, remove entries of a validation list |
15.00 |
* |
16.00 |
* The following parameters must be passed |
17.00 |
* 1-Validation list name char 10 |
18.00 |
* 2-Validation list library name char 10 |
19.00 |
* 3-Action char 3 |
20.00 |
* ADD= Add a new entry |
21.00 |
* CHG= Change an entry |
22.00 |
* RMV= Remove an entry |
23.00 |
* 4-User name (case sensitive) char 20 |
24.00 |
* 5-User password (case sensitive) char 20 |
25.00 |
* 6-User description (case sensitive) char 50 |
26.00 |
* 7-Return code char 1 |
27.00 |
* blank=operation performed |
28.00 |
* A = entry not added |
29.00 |
* C = entry not changed |
30.00 |
* R = entry not removed |
31.00 |
* P = wrong parameters |
32.00 |
* |
33.00 |
********************************************************************* |
34.00 |
* Standard system API error structure |
35.00 |
/copy WEBSECURE/qrpglesrc,usec |
36.00 |
*===================================================================== |
37.00 |
* Validation list to be maintained |
38.00 |
DVLDL DS |
39.00 |
DVLDLNam 1 10 |
40.00 |
* validation list name |
41.00 |
DVLDLLib 11 20 |
42.00 |
* validation list library |
43.00 |
*===================================================================== |
44.00 |
* Web Security Officer |
45.00 |
DWebSecofr S 10A INZ('WEBSECOFR') DSFile & library |
46.00 |
*===================================================================== |
47.00 |
* API to be used |
48.00 |
DTHSAPI s 21 |
49.00 |
* API used for adding an entry |
50.00 |
DADDAPI s 21 inz('QSYS/QSYADVLE') |
51.00 |
* API used for changing an entry |
52.00 |
DCHGAPI s 21 inz('QSYS/QSYCHVLE') |
53.00 |
* API used for removing an entry |
54.00 |
DRMVAPI s 21 inz('QSYS/QSYRMVLE') |
55.00 |
* API used to find an entry |
56.00 |
DFNDAPI s 21 inz('QSYS/QSYFDVLE') |
57.00 |
*===================================================================== |
58.00 |
* |
59.00 |
* LAYOUTS TO ADD OR CHANGE A VALIDATION LIST ENTRY |
60.00 |
* |
61.00 |
*===================================================================== |
62.00 |
* "Entry ID" information |
63.00 |
DEIDINFO DS |
64.00 |
DEIDLen 1 4b 0 inz(10) |
65.00 |
* Length of entry ID |
66.00 |
DEIDccsid 5 8b 0 inz(9) |
67.00 |
* CCSID of entry ID |
68.00 |
DEIDdata 9 28 |
69.00 |
* Entry ID |
70.00 |
*===================================================================== |
71.00 |
* "Data to encrypt" information |
72.00 |
DEEDINFO DS |
73.00 |
DEEDLen 1 4b 0 inz(10) |
74.00 |
* Length of entry ID |
75.00 |
DEEDccsid 5 8b 0 inz(9) |
76.00 |
* CCSID of entry ID |
77.00 |
DEEDdata 9 28 |
78.00 |
* Entry ID |
79.00 |
*===================================================================== |
80.00 |
* "Entry data" information |
81.00 |
DEDTINFO DS |
82.00 |
DEDTLen 1 4b 0 inz(50) |
83.00 |
* Length of entry ID |
84.00 |
DEDTccsid 5 8b 0 inz(9) |
85.00 |
* CCSID of entry ID |
86.00 |
DEDTdata 9 58 |
87.00 |
* Entry ID |
88.00 |
*===================================================================== |
89.00 |
* "Attribute" information |
90.00 |
DEATINFO DS |
91.00 |
DEATNbr 1 4b 0 inz(1) |
92.00 |
* Number of attributes |
93.00 |
* "Attribute entry" |
94.00 |
DATTELen 5 8b 0 inz(64) |
95.00 |
* Length of attribute entry |
96.00 |
DATTloc 9 12b 0 inz(0) |
97.00 |
* Attribute location = vldl |
98.00 |
DATTtyp 13 16b 0 inz(0) |
99.00 |
* Attribute type = system defined |
100.00 |
DATTdis1 17 20b 0 inz(28) |
101.00 |
* Displacement to attribute ID |
102.00 |
DATTlen1 21 24b 0 inz(14) |
103.00 |
* Length of attribute ID |
104.00 |
DATTdis2 25 28b 0 inz(42) |
105.00 |
* Displacement to attribute data |
106.00 |
DATTlen2 29 32b 0 inz(22) |
107.00 |
* Length of attribute data |
108.00 |
*== Attribute ID |
109.00 |
DATTID 33 46 inz('QsyEncryptData') |
110.00 |
* Attribute ID |
111.00 |
*== Attribute data |
112.00 |
DATTccsid 47 50b 0 inz(-1) |
113.00 |
* CCSID of attribute |
114.00 |
DATTlen 51 54b 0 inz(1) |
115.00 |
* Length of attribute |
116.00 |
DATTrsv 55 62 |
117.00 |
* reserved (8 char) |
118.00 |
DATTval 63 63 inz('1') |
119.00 |
* Attribute value |
120.00 |
* 1 = data returned on find |
121.00 |
D 64 68 |
122.00 |
*===================================================================== |
123.00 |
* |
124.00 |
* LAYOUTS FOR FINDING A VALIDATION LIST ENTRY |
125.00 |
* |
126.00 |
*===================================================================== |
127.00 |
* 1-"Entry ID" information |
128.00 |
DFEIDINFO DS |
129.00 |
DFEIDLen 1 4b 0 inz(10) |
130.00 |
* Length of entry ID |
131.00 |
DFEIDccsid 5 8b 0 inz(9) |
132.00 |
* CCSID of entry ID |
133.00 |
DFEIDdata 9 28 |
134.00 |
* Entry ID |
135.00 |
*===================================================================== |
136.00 |
* 2-"Attribute" information |
137.00 |
DFEATINFO DS |
138.00 |
DFEATNbr 1 4b 0 inz(0) |
139.00 |
* Number of attributes |
140.00 |
* "Attribute entry" |
141.00 |
DFATTELen 5 8b 0 inz(0) |
142.00 |
* Length of attribute entry (64) |
143.00 |
DFATTloc 9 12b 0 inz(0) |
144.00 |
* Attribute location = vldl |
145.00 |
DFATTtyp 13 16b 0 inz(0) |
146.00 |
* Attribute type = system defined |
147.00 |
DFATTdis1 17 20b 0 inz(24) |
148.00 |
* Displacement to attribute ID |
149.00 |
DFATTlen1 21 24b 0 inz(14) |
150.00 |
* Length of attribute ID |
151.00 |
DFATTbyte 25 28b 0 inz(0) |
152.00 |
* Bytes provided for attribute |
153.00 |
DFATTID 29 42 inz('QsyEncryptData') |
154.00 |
* Attribute ID |
155.00 |
*===================================================================== |
156.00 |
* 3-"Return Entry" information |
157.00 |
DFERTINFO DS |
158.00 |
DFERTLen 1 4b 0 inz(10) |
159.00 |
* Length of entry ID |
160.00 |
DFERTccsid 5 8b 0 inz(9) |
161.00 |
* CCSID of entry ID |
162.00 |
DFERTdata 9 108 |
163.00 |
* Entry ID |
164.00 |
DFERTYLen 109 112b 0 inz(10) |
165.00 |
* Length of encrypted data |
166.00 |
DFERTYccsid 113 116b 0 inz(9) |
167.00 |
* CCSID of encrypted data |
168.00 |
DFERTYdata 117 716 |
169.00 |
* encrypted data |
170.00 |
DFERTDLen 717 720b 0 inz(20) |
171.00 |
* Length of data |
172.00 |
DFERTDccsid 721 724b 0 inz(9) |
173.00 |
* CCSID of data |
174.00 |
DFERTDdata 725 1724 |
175.00 |
* entry data |
176.00 |
DFERTDrsv 1725 1744 |
177.00 |
* reserved |
178.00 |
*===================================================================== |
179.00 |
* 4-"Return Attribute" information |
180.00 |
DFEATRINFO DS |
181.00 |
DFATTRLen 1 4b 0 |
182.00 |
* Length of attribute entry |
183.00 |
DFATTRbyte 5 8b 0 |
184.00 |
* Bytes returned |
185.00 |
DFATTRavai 9 12b 0 |
186.00 |
* Bytes available |
187.00 |
DFATTRlen1 13 16b 0 |
188.00 |
* Length of attribute |
189.00 |
DFATTRccsid 17 20b 0 |
190.00 |
* CCSID of attribute |
191.00 |
DFATTRval 21 44 |
192.00 |
* Attribute value |
193.00 |
*===================================================================== |
194.00 |
* |
195.00 |
* LAYOUTS TO LIST ALL VALIDATION LIST ENTRIES |
196.00 |
* |
197.00 |
*===================================================================== |
198.00 |
* Qalified name for Open Validation List API |
199.00 |
DQSYOLVLE s 21 inz('QGY/QSYOLVLE') |
200.00 |
*===================================================================== |
201.00 |
* All validation list entries, from QSYSOLVLE API (Open VLDL) |
202.00 |
DAllEntries s 32767 |
203.00 |
DAllEntrisz s 10i 0 inz(%size(AllEntries)) |
204.00 |
*===================================================================== |
205.00 |
* VLDE0100, format of an entry from QSYSOLVLE API (Open VLDL) |
206.00 |
DVLDE0100DS DS |
207.00 |
DVLDEntry 1 600 |
208.00 |
* entry |
209.00 |
DVLDElen 1 4b 0 |
210.00 |
* entry length |
211.00 |
DVLDEIddsp 5 8b 0 |
212.00 |
* displacement to entry ID |
213.00 |
DVLDEIdlen 9 12b 0 |
214.00 |
* length of entry ID |
215.00 |
DVLDEIdccs 13 16b 0 |
216.00 |
* CCSID of entry ID |
217.00 |
DVLDEYddsp 17 20b 0 |
218.00 |
* displacement to encrypted data |
219.00 |
DVLDEYdlen 21 24b 0 |
220.00 |
* length of encrypted data |
221.00 |
DVLDEYdccs 25 28b 0 |
222.00 |
* CCSID of encrypted data |
223.00 |
DVLDEEddsp 29 32b 0 |
224.00 |
* displacement to entry data |
225.00 |
DVLDEEdlen 33 36b 0 |
226.00 |
* length of entry data |
227.00 |
DVLDEEdccs 37 40b 0 |
228.00 |
* CCSID of entry data |
229.00 |
DVLDEData 44 600 |
230.00 |
* Entry ID, Encrypted data, Entry data |
231.00 |
*===================================================================== |
232.00 |
* Format of "List information" for QSYSOLVLE API (Open VLDL) |
233.00 |
DVLDELI DS |
234.00 |
DVLDELInbrt 1 4b 0 |
235.00 |
* total number of records |
236.00 |
DVLDELInbrr 5 8b 0 |
237.00 |
* records returned |
238.00 |
DVLDELIhand 9 12 |
239.00 |
* request handle |
240.00 |
DVLDELIrlen 13 16b 0 |
241.00 |
* record length |
242.00 |
DVLDELIicin 17 17 |
243.00 |
* information complete indicator |
244.00 |
DVLDELItsta 18 30 |
245.00 |
* date and time created |
246.00 |
DVLDELIlsin 31 31 |
247.00 |
* list status indicator |
248.00 |
D 32 32 |
249.00 |
* reserved |
250.00 |
DVLDELIriln 33 36b 0 |
251.00 |
* length of information returned |
252.00 |
DVLDELIfrib 37 40b 0 |
253.00 |
* first record in buffer |
254.00 |
D 41 41 |
255.00 |
* reserved |
256.00 |
*===================================================================== |
257.00 |
* Number of records to return- for QSYSOLVLE API (Open VLDL) |
258.00 |
DRecsToRet s 10i 0 inz(-1) |
259.00 |
*===================================================================== |
260.00 |
* Format name- for QSYSOLVLE API (Open VLDL) |
261.00 |
DVLDE0100 s 8 inz('VLDE0100') |
262.00 |
*===================================================================== |
263.00 |
* |
264.00 |
* LAYOUT TO MAP THE INFORMATION STORED IN THE LIST ENTRY |
265.00 |
* USED TO DEFINE THE INTERNET USER |
266.00 |
* |
267.00 |
*===================================================================== |
268.00 |
D DS |
269.00 |
DUserData 1 50 |
270.00 |
*===================================================================== |
271.00 |
*-------------------------------------------------------------------- |
272.00 |
* SOME PROGRAM VARIABLES |
273.00 |
*-------------------------------------------------------------------- |
274.00 |
* Some nice fields to help us through from lower to upper case character conversion |
275.00 |
D LW C CONST('abcdefghijklmnopqrstuvwxyz') |
276.00 |
D UP C CONST('ABCDEFGHIJKLMNOPQRSTUVWXYZ') |
277.00 |
* |
278.00 |
DVldlErrSW s 1a |
279.00 |
DVldlErrTyp s 1a |
280.00 |
*=========================================================================== |
281.00 |
* *entry parameter list |
282.00 |
*=========================================================================== |
283.00 |
C *entry plist |
284.00 |
C parm ThsVldlNam 10 |
285.00 |
C parm ThsVldlLib 10 |
286.00 |
C parm ThsAction 3 |
287.00 |
C parm ThsUsrName 20 |
288.00 |
C parm ThsUsrPwd 20 |
289.00 |
C parm ThsUsrDes 50 |
290.00 |
C parm RetCode 1 |
291.00 |
* |
292.00 |
*Set parameters |
293.00 |
C lw:up xlate ThsVldlNam VldlNam |
294.00 |
C lw:up xlate ThsVldlLib VldlLib |
295.00 |
C lw:up xlate ThsAction Action 10 |
296.00 |
C move ThsUsrName UsNamN 20 |
297.00 |
C move ThsUsrPwd UsPwdN 20 |
298.00 |
C move ThsUsrDes UsTxtN 50 |
299.00 |
C eval RetCode = *blank |
300.00 |
*=========================================================================== |
301.00 |
* Main line |
302.00 |
*=========================================================================== |
303.00 |
* Check input data (do not come back if something wrong) |
304.00 |
C exsr ChkInpDta |
305.00 |
* If Change or Remove, entry must exist |
306.00 |
C IF Action='CHG' or Action='RMV' |
307.00 |
C exsr FndEntry |
308.00 |
C if FndErrSW <> ' ' |
309.00 |
C eval RetCode = %subst(Action:1:1) |
310.00 |
C exsr Exit |
311.00 |
C endif |
312.00 |
C ENDIF |
313.00 |
* Perform maintainance Action |
314.00 |
C SELECT |
315.00 |
C when Action = 'ADD' |
316.00 |
C exsr AddEntry |
317.00 |
C when Action = 'CHG' |
318.00 |
C exsr ChgEntry |
319.00 |
C when Action = 'RMV' |
320.00 |
C exsr RmvEntry |
321.00 |
C ENDSL |
322.00 |
* Back to caller |
323.00 |
C exsr Exit |
324.00 |
*=========================================================================== |
325.00 |
* Check input data (do not come back if something wrong) |
326.00 |
*=========================================================================== |
327.00 |
C ChkInpDta begsr |
328.00 |
* |
329.00 |
* |
330.00 |
C IF Action=' ' or UsNamN=' ' |
331.00 |
C eval RetCode = 'P' |
332.00 |
C exsr exit |
333.00 |
C ENDIF |
334.00 |
* |
335.00 |
C IF Action='ADD' |
336.00 |
C if UsPwdN=' ' or UsTxtN=' ' |
337.00 |
C eval RetCode = 'P' |
338.00 |
C exsr Exit |
339.00 |
C endif |
340.00 |
C ENDIF |
341.00 |
* |
342.00 |
C IF Action='CHG' |
343.00 |
C if UsPwdN=' ' and UsTxtN=' ' |
344.00 |
C eval RetCode = 'P' |
345.00 |
C exsr Exit |
346.00 |
C endif |
347.00 |
C ENDIF |
348.00 |
* |
349.00 |
C endsr |
350.00 |
*===================================================================== |
351.00 |
* Add a validation entry |
352.00 |
*===================================================================== |
353.00 |
C AddEntry begsr |
354.00 |
* Set Entry ID information |
355.00 |
C eval EIDdata = UsNamN |
356.00 |
C ' ' checkr UsNamN EIDlen |
357.00 |
* Set Data to Encrypt information (password) |
358.00 |
C eval EEDdata = UsPwdN |
359.00 |
C ' ' checkr UsPwdN EEDlen |
360.00 |
* Set Data (description) |
361.00 |
C eval UserData = UsTxtN |
362.00 |
C eval EDTdata = UserData |
363.00 |
* Add validation list entry |
364.00 |
C eval THSAPI = ADDAPI |
365.00 |
C call THSAPI |
366.00 |
C parm VLDL |
367.00 |
C parm EIDINFO |
368.00 |
C parm EEDINFO |
369.00 |
C parm EDTINFO |
370.00 |
C parm EATINFO |
371.00 |
C parm qusec |
372.00 |
* See in any errors were returned in the error code parameter |
373.00 |
C exsr ChkErrCod |
374.00 |
C* |
375.00 |
C endsr |
376.00 |
*===================================================================== |
377.00 |
* Change a validation entry |
378.00 |
*===================================================================== |
379.00 |
C ChgEntry begsr |
380.00 |
C if FndErrSw<>' ' |
381.00 |
C eval RetCode = 'C' |
382.00 |
C goto ChgEntryX |
383.00 |
C endif |
384.00 |
* Set Entry ID information |
385.00 |
C eval EIDdata = UsNamN |
386.00 |
C ' ' checkr UsNamN EIDlen |
387.00 |
* Set Data to Encrypt information (password) |
388.00 |
C if UsPwdN=' ' |
389.00 |
C eval UsPwdN = UsPwd |
390.00 |
C endif |
391.00 |
C eval EEDdata = UsPwdN |
392.00 |
C ' ' checkr UsPwdN EEDlen |
393.00 |
* Set Data (description) |
394.00 |
C if UsTxtN=' ' |
395.00 |
C eval UsTxtN = UsTxt |
396.00 |
C endif |
397.00 |
C eval UserData = UsTxtN |
398.00 |
C eval EDTdata = UserData |
399.00 |
* perform the change |
400.00 |
C eval THSAPI = CHGAPI |
401.00 |
C call THSAPI |
402.00 |
C parm VLDL |
403.00 |
C parm EIDINFO |
404.00 |
C parm EEDINFO |
405.00 |
C parm EDTINFO |
406.00 |
C parm EATINFO |
407.00 |
C parm qusec |
408.00 |
* See in any errors were returned in the error code parameter |
409.00 |
C exsr ChkErrCod |
410.00 |
C* |
411.00 |
C ChgEntryX tag |
412.00 |
C endsr |
413.00 |
*===================================================================== |
414.00 |
* Remove a validation entry |
415.00 |
*===================================================================== |
416.00 |
C RmvEntry begsr |
417.00 |
* Set Entry ID information |
418.00 |
C eval EIDdata = UsNamN |
419.00 |
C ' ' checkr UsNamN EIDlen |
420.00 |
* Set Data to Encrypt information |
421.00 |
C eval EEDdata = UsPwdN |
422.00 |
C ' ' checkr UsPwdN EEDlen |
423.00 |
C eval THSAPI = RMVAPI |
424.00 |
C call THSAPI |
425.00 |
C parm VLDL |
426.00 |
C parm EIDINFO |
427.00 |
C parm qusec |
428.00 |
* See in any errors were returned in the error code parameter |
429.00 |
C exsr ChkErrCod |
430.00 |
C* |
431.00 |
C endsr |
432.00 |
*=====================================================================****** |
433.00 |
* Find a validation list entry for change |
434.00 |
*=====================================================================****** |
435.00 |
C FndEntry begsr |
436.00 |
C move *blank FndErrSw 1 |
437.00 |
* Find internet user |
438.00 |
C eval FEIDData = UsNamN |
439.00 |
C ' ' checkr UsNamN FEIDlen |
440.00 |
C call FNDAPI |
441.00 |
C parm VLDL |
442.00 |
C parm FEIDINFO |
443.00 |
C parm FEATINFO |
444.00 |
C parm FERTINFO |
445.00 |
C parm FEATRINFO |
446.00 |
C parm qusec |
447.00 |
* If internet user not found |
448.00 |
C if qusei<>' ' |
449.00 |
C eval FndErrSW = 'X' |
450.00 |
C goto FndEntryX |
451.00 |
C endif |
452.00 |
* Get current password |
453.00 |
C *like define UsPwdN UsPwd |
454.00 |
C eval UsPwd = %subst(FERTYData:1:FERTYLen) |
455.00 |
* Map user data |
456.00 |
C *like define UsTxtN UsTxt |
457.00 |
C eval UsTxt = %subst(FERTDData:1:50) |
458.00 |
* |
459.00 |
C FndEntryX tag |
460.00 |
C endsr |
461.00 |
*===================================================================== |
462.00 |
* See in any errors were returned in the error code parameter |
463.00 |
*===================================================================== |
464.00 |
C ChkErrCod begsr |
465.00 |
C if QUSBAVL>0 |
466.00 |
C eval RetCode = %subst(Action:1:1) |
467.00 |
C endif |
468.00 |
C endsr |
469.00 |
*===================================================================== |
470.00 |
* Back to caller |
471.00 |
*===================================================================== |
472.00 |
C Exit begsr |
473.00 |
* MUST exit with LR on |
474.00 |
C eval *inlr = *on |
475.00 |
C return |
476.00 |
C endsr |