|
|
|
|
Member
LOGON
in
WEBSECURE / QRPGLESRC
|
|
|
|
1.00 |
********************************************************************* |
2.00 |
* RPG ILE MODULE WEBSECURE/LOGON |
3.00 |
* |
4.00 |
* After compiling this RPG MODULE, |
5.00 |
* create the related program with the following command: |
6.00 |
* |
7.00 |
* CRTPGM WEBSECURE/LOGON MODULE(WEBSECURE/LOGON) |
8.00 |
* BNDDIR(WEBSECURE/WEBSECURE) |
9.00 |
* ACTGRP(LOGON) AUT(*USE) |
10.00 |
* |
11.00 |
********************************************************************* |
12.00 |
/copy websecure/qrpglesrc,hspecs |
13.00 |
/copy WEBSECURE/qrpglesrc,prototypeb |
14.00 |
/copy WEBSECURE/brpglesrc,webproto |
15.00 |
/copy WEBSECURE/qrpglesrc,usec |
16.00 |
* Variables for using CGISRVPGM2 service program |
17.00 |
/copy WEBSECURE/qrpglesrc,variables3 |
18.00 |
* Variables for using WEBSECUREservice program |
19.00 |
/copy WEBSECURE/brpglesrc,webvar |
20.00 |
*-------------------------------------------------------------------- |
21.00 |
* Variables specific to this program |
22.00 |
*-------------------------------------------------------------------- |
23.00 |
* Variables from input query string |
24.00 |
D xrequest s 10a |
25.00 |
D usnam s 10a |
26.00 |
D uspwd s 10a |
27.00 |
D uspwdn s 10a |
28.00 |
*-------------------------------------------------------------------- |
29.00 |
* Prolog common to most CGIs using CGISRVPGM2 service program |
30.00 |
*-------------------------------------------------------------------- |
31.00 |
C eval xrequest= *blanks |
32.00 |
C eval usnam = *blanks |
33.00 |
C eval uspwd = *blanks |
34.00 |
/copy WEBSECURE/qrpglesrc,prolog3 |
35.00 |
C eval usnam = zhbgetvar('usnam') |
36.00 |
C eval uspwd = zhbgetvar('uspwd') |
37.00 |
C eval xrequest = zhbgetvarUpper('xrequest') |
38.00 |
*=========================================================================== |
39.00 |
* Mainline |
40.00 |
*=========================================================================== |
41.00 |
* Read skeleton output html, etc. |
42.00 |
C callp gethtml('HTMLSRC': |
43.00 |
C 'WEBSECURE': |
44.00 |
C 'LOGON') |
45.00 |
* Retrieve server name |
46.00 |
C exsr RtvSrvNam |
47.00 |
*=================== |
48.00 |
* Start html |
49.00 |
C Restart tag |
50.00 |
C lw:up xlate xrequest xrequest |
51.00 |
*=================== |
52.00 |
* xrequest=blank, let user enter logon information |
53.00 |
C xrequest ifeq *blanks |
54.00 |
C exsr Askpwd |
55.00 |
C exsr Exit |
56.00 |
C endif |
57.00 |
*=================== |
58.00 |
* xrequest=CHECK, check user profile and password |
59.00 |
C xrequest IFEQ 'CHECK' |
60.00 |
C usnam ifeq *blanks |
61.00 |
C uspwd oreq *blanks |
62.00 |
C eval xrequest = *blanks |
63.00 |
C goto Restart |
64.00 |
C endif |
65.00 |
C exsr ChKPwd |
66.00 |
C exsr Exit |
67.00 |
C ENDIF |
68.00 |
*=================== |
69.00 |
* xrequest=unknown, quit |
70.00 |
C exsr SetTop |
71.00 |
C callp wrtsection('topnoca') |
72.00 |
C callp wrtsection('header') |
73.00 |
C callp wrtsection('notunders') |
74.00 |
C exsr Exit |
75.00 |
*---------------------------------------------------------------------****** |
76.00 |
* Let user enter logon information |
77.00 |
*---------------------------------------------------------------------****** |
78.00 |
C Askpwd begsr |
79.00 |
C exsr SetTop |
80.00 |
C callp wrtsection('topnoca') |
81.00 |
C callp wrtsection('header') |
82.00 |
C callp wrtsection('askpwd') |
83.00 |
C endsr |
84.00 |
*---------------------------------------------------------------------****** |
85.00 |
* Send user menu |
86.00 |
*---------------------------------------------------------------------****** |
87.00 |
C Menu begsr |
88.00 |
C exsr SetTop |
89.00 |
C callp wrtsection('topnoca') |
90.00 |
* Select menu depending on user profile name |
91.00 |
C exsr SetMenu |
92.00 |
*================== |
93.00 |
* 1)User profile logged in has SECADM authorities |
94.00 |
C UsrAdm IFEQ 'Y' |
95.00 |
C callp wrtsection('secadmmnu') |
96.00 |
C UsNam ifeq 'WEBSECOFR' |
97.00 |
C callp wrtsection('chgcode') |
98.00 |
C endif |
99.00 |
C ENDIF |
100.00 |
*================== |
101.00 |
* 2)User profile logged has no SECADM authorities |
102.00 |
C UsrAdm IFNE 'Y' |
103.00 |
C movel UsNam UsNam6 6 |
104.00 |
C UsNam6 ifeq 'webusr' |
105.00 |
C callp wrtsection('usrmnu') |
106.00 |
C else |
107.00 |
C callp wrtsection('nomnu') |
108.00 |
C endif |
109.00 |
C ENDIF |
110.00 |
* |
111.00 |
*================== |
112.00 |
C callp wrtsection('logoff') |
113.00 |
* |
114.00 |
C exsr exit |
115.00 |
C endsr |
116.00 |
*=====================================================================****** |
117.00 |
* Check user profile and password |
118.00 |
* |
119.00 |
* Checks the password of a web user profile |
120.00 |
* returns a 22 char string ("pwdret") containing |
121.00 |
* "PwdAcp" 01-01 (01) Y/N password accepted / not accepted |
122.00 |
* "UsrAdm" 02-02 (01) Y = security administrator |
123.00 |
* "myusnampls" 03-12 (10) user profile name |
124.00 |
* with imbedded blanks |
125.00 |
* replaced by + 's |
126.00 |
* "myuspwdpls" 13-22 (10) user profile password |
127.00 |
* with imbedded blanks |
128.00 |
* replaced by + 's |
129.00 |
*=====================================================================****** |
130.00 |
C ChkPwd begsr |
131.00 |
* Check the password |
132.00 |
C eval uspwdn = *blanks |
133.00 |
C eval pwdret =ChkUsrPwd(usnam:uspwd) |
134.00 |
* If the password is no good |
135.00 |
C PwdAcp ifne 'Y' |
136.00 |
C exsr exit |
137.00 |
C endif |
138.00 |
* If the password is good, |
139.00 |
* send out user menu |
140.00 |
C exsr Menu |
141.00 |
C endsr |
142.00 |
*---------------------------------------------------------------------****** |
143.00 |
* Close html output buffer and quit |
144.00 |
*---------------------------------------------------------------------****** |
145.00 |
C Exit begsr |
146.00 |
C callp wrtsection('end') |
147.00 |
* Do not delete the call to wrtsection with section name *fini. It is needed |
148.00 |
* to ensure that all output html that has been buffered gets output. |
149.00 |
C callp wrtsection('*fini') |
150.00 |
* Quit |
151.00 |
C return |
152.00 |
C endsr |
153.00 |
*--------------------------------------------------------------------- |
154.00 |
* Retrieve server name |
155.00 |
*--------------------------------------------------------------------- |
156.00 |
C RtvSrvNam begsr |
157.00 |
C eval S_Name =getenv('SERVER_NAME': |
158.00 |
C qusec) |
159.00 |
C endsr |
160.00 |
*---------------------------------------------------------------------****** |
161.00 |
* Set variable data for section /$top... |
162.00 |
*---------------------------------------------------------------------****** |
163.00 |
C SetTop begsr |
164.00 |
* Server name |
165.00 |
C callp updHtmlVar('S_NAME':S_Name) |
166.00 |
C endsr |
167.00 |
*---------------------------------------------------------------------****** |
168.00 |
* Set variable data for section /$menu |
169.00 |
*---------------------------------------------------------------------****** |
170.00 |
C SetMenu begsr |
171.00 |
* User profile (with imbedded blanks) |
172.00 |
C callp updHtmlVar('USNAM':usnam) |
173.00 |
* Password (with imbedded blanks) |
174.00 |
C callp updHtmlVar('USPWD':uspwd) |
175.00 |
* User profile (without imbedded blanks) |
176.00 |
C callp updHtmlVar('USNAM1':myusnampls) |
177.00 |
* Password (without imbedded blanks) |
178.00 |
C callp updHtmlVar('USPWD1':myuspwdpls) |
179.00 |
C endsr |