| 
* * * ce pgm est associé au point d'exit QIBM_QTG_DEVINIT * * il peut : refuser une connexion entrante * forcer un nom d'unité * by-passer le signon et forcer un profil. * *===================================================================== * pseudo types de variables Dbinaire S 10I 0 Dnomvalide S 10 * déclaration des variables Duser ds D userlg like(binaire) D profil like(nomvalide) D curlib like(nomvalide) D menu like(nomvalide) Ddevice ds D unite like(nomvalide) D format 8 D filler 2 D offset like(binaire) D dspd0100lg like(binaire) d dspd0100 12 d clavier 3 overlay(dspd0100) d codepage overlay(dspd0100:5) like(binaire) d charset overlay(dspd0100:9) like(binaire) Dconnection ds D connectlg like(binaire) D adresseclient 20 D adrtaille 1 overlay(adresseclient) D adrtype 1 overlay(adresseclient:2) D adrport 2 overlay(adresseclient:3) D adresse 16 overlay(adresseclient:5) D ip12 5I 0 overlay(adresse) D ip34 5I 0 overlay(adresse:3) D password 1 |
|
D adresseip c x'02'
D adresseipx c x'06'
D pas_de_pwd c 0
D pwd_en_clair c 1
D pwd_crypte c 2
Denv S 32
Denvlg S like(binaire)
Dconnect S 1
D connect_refus c '0'
D connect_ok c '1'
Dsaut_signon S 1
D saut_refus c '0'
D saut_ok c '1'
Dmessage s 1024
Dmessagelg s inz(%size(message)) like(binaire)
Dmessagetype s 10 inz('*INFO')
Dmessageq s 20 inz('DSP01 *LIBL')
Dmessageqnb s inz(1) like(binaire)
DCODERR DS
D LGCOD like(binaire) INZ(16)
D LGUTIL like(binaire)
D MSGID 7
D RESERV 1
Dadrchar ds
D dec1 3 0
D dec2 3 0
D dec3 3 0
D dec4 3 0
C *entry plist
C parm user
C parm device
C parm connection
C parm env
C parm envlg
C parm connect
C parm saut_signon
|
|
c ip12 div 256 dec1 c mvr dec2 c ip34 div 256 dec3 c mvr dec4 * adresse LAN valide ? c if (dec1 = 10) and c (dec2 = 2 or dec2 = 3) c eval connect = connect_ok c eval saut_signon = saut_refus c eval format = 'DSPD0100' c eval offset = 29 c eval dspd0100lg = 12 * si euro compatible c eval clavier = 'FAE' c eval codepage = 1147 c eval charset = 695 * sinon c* eval clavier = 'FAB' c* eval codepage = 297 c* eval charset = 697 c select * machines linux c when dec3 = 1 and dec4 = 9 c eval unite = 'LINUX' c when dec3 = 1 and dec4 = 10 c eval unite = 'LINUX2' * * etc .... (sauf à envisager les noms d'unité dans un fichier BdeD) * c endsl * pour accepter le saut de signon (TN5250 uniquement) c* eval saut_signon = saut_OK c* eval PROFIL = 'QPGMR' c* eval USERLG = %SIZE(userlg) + %size(profil) c else |
|
* machine ne venant pas du lan (autre que 10.2.* ou 10.3.*)
c eval connect = connect_refus
c eval message = 'demande recue depuis ' +
c adrchar + '(' + %trim(profil) + ')'
c + 'rejetée !'
c call 'QMHSNDBM'
c parm message
c parm messagelg
c parm messagetype
c parm messageq
c parm messageqnb
c parm messageq
c parm coderr
c endif
* fin
c eval *inlr = *on
|
