Si comme nous vous avez de nombreux certificats sur vos systèmes, le ménage peut s’avérer compliqué. En effet, au fur et à mesure des renouvellements, les nouveaux certificats sont installés, les nouvelles autorités également.
Mais les suppressions de certificats sont souvent remises à plus tard. Et l’on se retrouve avec un nombre importants de certificats pour lesquels il est préférable de contrôler la non utilisation avant suppression.
SQL va nous aider ici, avec le service qsys2.certificate_info (cf https://www.ibm.com/docs/en/i/7.6.0?topic=services-certificate-info-table-function) capable de nous donner la liste des certificats et leurs attributs.
qsys2.certificate_info
Permet d’obtenir facilement les principales informations sur les certificats et autorités de certification du magasin *SYSTEM :

La même vue dans DCM :

Et on remarque donc la nécessité du ménage (dans mon cas).
Premièrement, comment faire la distinction entre les certificats et les autorités de certifications ? En utilisant la colonne PRIVATE_KEY_STORAGE_LOCATION.
Autorité de certification
select CERTIFICATE_LABEL,
VALIDITY_START,
VALIDITY_END,
DOMAIN_NAMES,
SUBJECT_COMMON_NAME,
SUBJECT_ORGANIZATION,
ISSUER_COMMON_NAME,
ISSUER_ORGANIZATION,
PRIVATE_KEY_STORAGE_LOCATION
from table (
qsys2.certificate_info(certificate_store_password => '*NOPWD')
)
where( PRIVATE_KEY_STORAGE_LOCATION <> 'SOFTWARE' or PRIVATE_KEY_STORAGE_LOCATION is null)
Certificat
select CERTIFICATE_LABEL,
VALIDITY_START,
VALIDITY_END,
DOMAIN_NAMES,
SUBJECT_COMMON_NAME,
SUBJECT_ORGANIZATION,
ISSUER_COMMON_NAME,
ISSUER_ORGANIZATION,
PRIVATE_KEY_STORAGE_LOCATION
from table (
qsys2.certificate_info(certificate_store_password => '*NOPWD')
)
where PRIVATE_KEY_STORAGE_LOCATION = 'SOFTWARE'
Validité
Le premier élément trivial : quels sont les certificats périmés :
select CERTIFICATE_LABEL,
VALIDITY_START,
VALIDITY_END,
DOMAIN_NAMES,
SUBJECT_COMMON_NAME,
SUBJECT_ORGANIZATION,
ISSUER_COMMON_NAME,
ISSUER_ORGANIZATION,
PRIVATE_KEY_STORAGE_LOCATION
from table (
qsys2.certificate_info(certificate_store_password => '*NOPWD')
)
where validity_end <= current timestamp
order by validity_end asc ;
Lien
Les certificats sont émis (signés) par des autorités de certification, le lien entre les deux est donc un élément indispensable.
Nous pouvons donc maintenant répondre aux questions suivantes :
Pour chaque certificat client/serveur, quel est l’autorité de certification ?

Mais cela génère des doublons :

En effet, nous faisons le lien via le Common Name de l’autorité. Mais celui-ci n’est pas obligatoirement unique, et c’est bien le cas sur les autorités locales créées via les assistants de configuration IBM i.
Pour avoir un identifiant unique, il nous faut utiliser les identifiants de clés, qui elles sont distinctes :

Mais cette information est absente de la fonction table qsys2.certificate_info.
Nous donnerons une solution (pas si simple) lors d’un prochain article dédié.
Malgré tout, ce problème ne concerne « que » les certificats générés depuis une autorité locale, elle même créée via les assistants IBM i, les autorités publiques ayants des noms uniques.
Si l’on prend un certificat acheté via Gandi :

On obtient bien une information unique et exploitable.
Pour chaque autorité, quels sont les certificats émis ?
Par exemple :

Extrait du résultat :

Par extension, quelles sont les autorités inutilisées ?

Produit :

Et le ménage ?
Avec les requêtes précédentes, vous pouvez isoler les certificats et autorités périmés ou les autorités inutilisés (dans notre cas les autorités n’ayant pas généré de certificat). Et vous pouvez donc les supprimer de façon ciblée.
Attention : les autorités et certificats peuvent être utiles et utilisés en dehors des liens vus ici. Ces requêtes permettent donc d’aider à la décision, mais ce n’est pas un automatisme !
Pour aller plus loin
Nous pouvons inclure l’analyse des applications DCM : liens applications/certificats.
Et également utiliser les API RSE pour automatiser la suppression des certificats.
Et rendre nos requêtes récursives pour permettre de suivre une hiérarchie à plus d’un niveau
Voir l’idea soumise pour avoir le lien certificat -> autorité dans la vue qsys2.certificate_info : https://ibm-power-systems.ideas.ibm.com/ideas/IBMI-I-4628
Dans une base de données bien définie, nos enregistrements sont identifiés par des clés (ie unique). Il existe toutefois différentes façon de matérialiser ces clés en SQL.
Première bonne résolution : on ne parlera pas ici des DDS (PF/LF) !
Quelques rappels
je n’insiste pas, mais une base de donnée relationnelle, DB2 for i dans notre cas, fonctionne à la perfection, à condition de pouvoir identifier nos enregistrements par des clés.
Cf https://fr.wikipedia.org/wiki/Forme_normale_(bases_de_donn%C3%A9es_relationnelles)
Une normalisation raisonnable pour une application de gestion est la forme normale de Boyce-Codd (dérivée de la 3ème FN).
Clés
Vous pouvez implémenter vos clés de différentes façons, voici une synthèse :
| Type | Où | Support valeur nulle ? | Support doublon ? | Commentaire |
| Contrainte de clé primaire | Table | Non | Non | Valeur nulle non admise, même si la colonne clé le supporte |
| Contrainte d’unicité | Table | Oui | non : valeurs non nulles oui : valeurs nulles | Gère des clés uniques uniquement si non nulles |
| Index unique | Index | Oui | Non | Gère des clés uniques. La valeur NULL est supportée pour 1 unique occurrence |
| Index unique where not null | Index | Ouis | non : valeurs non nulles oui : valeurs nulles | Gère des clés uniques uniquement si non nulles |
Attention donc à la définition de UNIQUE : à priori ce qui n’est pas NULL est UNIQUE.
Concrètement ?
Prenons un cas de test simpliste pour montrer la mécanique : un fichier article avec une clé et un libellé
Clé primaire

La colonne CODE admet des valeurs nulles, mais est fait l’objet de la contrainte de clé primaire.
A la création de la contrainte de clé primaire, le système créé automatiquement une contrainte de type CHECK pour interdire l’utilisation de valeur nulle dans cette colonne :

Avec :

La clé primaire joue son rôle avec des valeurs non nulles :

Et des valeurs nulles :

On retrouve ici le nom de la contrainte générée automatiquement !
Avec une contrainte de clé unique ?
Le comportement est identique sur une clé non nulle.

Mais avec une clé nulle (ou dont une partie est nulle si elle composée) :

On peut ajouter un index unique pour gérer le problème. Dans ce cas, une et une seule valeur nulle sera acceptée :

Mais dans ce cas pourquoi ne pas utiliser une clé primaire ??
Clé étrangère, jointure
Ajoutons un fichier des commandes, ici une simplification extrême : 1 commande = 1 article.

On ajoute une contrainte de clé étrangère qui matérialise la relation entre les tables commande et article. Pour cette contrainte commande_FK, il doit exister une contrainte de clé primaire ou de clé unique sur la colonne CODE dans la table article.
La contrainte se déclenche si l’article référencé n’existe pas :

Cas identique mais en s’appuyant sur la table article_unique qui dispose d’une clé unique et non primaire :

Dans ce cas les valeurs nulles sont supportées, en multiples occurrences (sauf à ajouter encore une fois un index unique au niveau de la commande).
Récapitulons ici nos données pour comprendre les jointures :

Démarrons par ARTICLE & COMMANDE :
La table ARTICLE ne peut pas avoir de clé nulle, donc pas d’ambiguïté ici

Avec right join ou full outer join nous accèderons au lignes de commande pour lesquelles CODE = null.
C’est le comportement attendu.
Voyons avec ARTICLE_UNIQUE et COMMANDE :

Ici on pourrait s’attendre à obtenir également les lignes 11 et 12 de la table COMMANDE : le CODE est nulle pour celles-ci, mais il existe une ligne d’ARTICLE pour laquelle le code est null. Il devrait donc y avoir égalité.
En réalité les jointures ne fonctionnent qu’avec des valeurs non nulles
De même que la clause WHERE :

Il faut donc utiliser ce style de syntaxe :

C’est à dire :
- soit remplacer les valeurs nulles par des valeurs inexistantes dans les données réelles
- soit explicitement indiquer la condition de nullité conjointe
Bref, syntaxiquement cela va rapidement se complexifier dans des requêtes plus évoluées.
Clé composée
Evidemment, c’est pire ! Imaginons que l’on ait une clé primaire/unique dans la table ARTICLE composée de 2 colonnes (CODE1, CODE2), et donc présentes toutes les deux dans la table COMMANDE :

Et les performances ?
En utilisant la jointure, l’optimiseur est capable de prendre en charge des accès par index :

Mais en utilisant IFNULL/COALESCE, ces valeurs deviennent des valeurs calculées, ce qui invalide l’usage des index :

Ce n’est donc pas viable sur des volumes plus importants. Il existe des solutions (index dérivés par exemple) mais la mécanique se complique encore !
Préconisations
De façon générale pour vos données de gestion, en excluant les fichier de travail (QTEMP a d’autres propriétés), les fichiers de logs, les fichier d’import/export …
- Pas de valeur NULL dans vos clés
- Pour les clés atomique c’est une évidence, pour les clés composées c’est beaucoup plus simple
- Une contrainte de clé primaire pour toutes vos tables !
- N’hésitez pas à utiliser des clés auto-incrémentées
- Des contraintes d’unicités ou des index uniques pour vos autres contraintes d’unicité, techniques ou fonctionnelles
- Pas d’excès, sinon il y a un défaut de conception (cf les formes normales)
- Si possible des contraintes de clé étrangère pour matérialiser les relations entre les tables
- Délicat sur l’existant, les traitements doivent tenir compte du sens de la relation
- Favorisez l’usage des clés, contraintes et index par l’optimiseur
- Scalabilité entre vos environnements de développement/test et la production
Vous connaissez bien désormais les services SQL qui vous permettent d’administrer de plus en plus facilement votre IBM i.
IBM fournit des services pour gérer les listes de validation :
- ADD_VALIDATION_LIST_ENTRY : ajouter une entrée à la liste (https://www.ibm.com/docs/en/i/7.6.0?topic=services-add-validation-list-entry-scalar-function)
- CHANGE_VALIDATION_LIST_ENTRY : modifier une entrée de la liste (https://www.ibm.com/docs/en/i/7.6.0?topic=services-change-validation-list-entry-scalar-function)
- REMOVE_VALIDATION_LIST_ENTRY : supprimer une entrée de la liste (https://www.ibm.com/docs/en/i/7.6.0?topic=services-remove-validation-list-entry-scalar-function)
Mais rien pour faire la liste des entrées, comme on peut trouver dans l’administration HTTP par exemple.
Nous vous proposons donc une fonction table SQL permettant d’avoir l’intégralité de la gestion via DB2 : cf https://github.com/FrenchIBMi/Outils/tree/master/Validation%20List
Cela permet de revenir sur le principe de l’implémentation via du code RPG :
- Le code est basé sur les APIs QsyFindFirstValidationLstEntry et QsyFindNextValidationLstEntry
- Le moteur DB2 appelle l’implémentation :
- 1 appel initial
- 1 appel par poste de liste à retourner
- 1 appel final
Nous utilisons __errno pour retrouver les codes erreur de l’APIs. Les différentes valeurs sont déclarées sous forme de constante.
La fonction SQL retourne les SQL STATE suivants :
- 02000 lorsque l’on attend la fin des données (fin normale)
- 38999 pour les erreurs. Cette valeur est arbitraire
Si possible, nous retrouvons le libellé de l’erreur retournée par l’API via strerror et on le retourne à DB2.
Code RPG :
**free
// Compilation / liage :
// CRTRPGMOD MODULE(NB/VLDLUDTF) SRCFILE(NB/QRPGLESRC)
// OPTION(*EVENTF) DBGVIEW(*SOURCE)
// CRTSRVPGM SRVPGM(NB/VLDLUDTF) EXPORT(*ALL) ACTGRP(*CALLER)
// Implémentation de la fonction UDTF VALIDATION_LIST_ENTRIES
// Liste les entrées d'une liste de validation
// Utilise l'API QsyFindFirstValidationLstEntry et QsyFindNextValidationLstEntry
// @todo :
// - ajouter le support de la conversion de CCSID
// - améliorer la gestion des erreurs
ctl-opt nomain option(*srcstmt : *nodebugio) ;
// Déclarations pour APIs : QsyFindFirstValidationLstEntry et QsyFindNextValidationLstEntry
dcl-ds Qsy_Qual_Name_T qualified template ;
name char(10) inz ;
lib char(10) inz ;
end-ds ;
dcl-ds Qsy_Entry_ID_Info_T qualified template ;
Entry_ID_Len int(10) inz ;
Entry_ID_CCSID uns(10) inz ;
Entry_ID char(100) inz ;
end-ds ;
dcl-ds Qsy_Rtn_Vld_Lst_Ent_T qualified template ;
dcl-ds Entry_ID_Info likeds( Qsy_Entry_ID_Info_T) inz ;
dcl-ds Encr_Data_Info ;
Encr_Data_len int(10) inz;
Encr_Data_CCSID uns(10) inz;
Encr_Data char(600) inz ;
end-ds ;
dcl-ds Entry_Data_Info ;
Entry_Data_len int(10) ;
Entry_Data_CCSID uns(10) ;
Entry_Data char(1000) ;
end-ds ;
Reserved char(4) inz ;
Entry_More_Info char(100) inz ;
end-ds ;
dcl-pr QsyFindFirstValidationLstEntry int(10) extproc('QsyFindFirstValidationLstEntry');
vldList likeds(Qsy_Qual_Name_T) const ;
vldListEntry likeds(Qsy_Rtn_Vld_Lst_Ent_T) ;
end-pr ;
dcl-pr QsyFindNextValidationLstEntry int(10) extproc('QsyFindNextValidationLstEntry');
vldList likeds(Qsy_Qual_Name_T) const ;
entryIdInfo likeds(Qsy_Entry_ID_Info_T) ;
vldListEntry likeds(Qsy_Rtn_Vld_Lst_Ent_T) ;
end-pr ;
// Retrouver le code erreur de l'API
dcl-pr getErrNo int(10) ;
end-pr ;
// Code erreur
dcl-c EACCES 3401 ;
dcl-c EAGAIN 3406 ;
dcl-c EDAMAGE 3484 ;
dcl-c EINVAL 3021 ;
dcl-c ENOENT 3025 ;
dcl-c ENOREC 3026 ;
dcl-c EUNKNOWN 3474 ;
// Retrouver le libellé du code erreur
dcl-pr strError pointer extproc(*CWIDEN : 'strerror') ;
errNo int(10) value ;
end-pr ;
// gestion UDTF
dcl-c CALL_OPEN -1;
dcl-c CALL_FETCH 0;
dcl-c CALL_CLOSE 1;
dcl-c PARM_NULL -1;
dcl-c PARM_NOTNULL 0;
// Liste les entrées de la liste de validation
// ==========================================================================
dcl-proc vldl_list export ;
// Déclarations globales
dcl-s ret int(10) inz ;
dcl-s errno int(10) inz ;
dcl-ds vldListEntry likeds(Qsy_Rtn_Vld_Lst_Ent_T) inz static ;
dcl-ds vldlname likeds(Qsy_Qual_Name_T) inz static ;
dcl-s first ind inz(*on) static ;
dcl-pi *n ;
// input parms
pvldl_lib varchar(10) const ;
pvldl_name varchar(10) const ;
// output columns
pEntry_ID varchar(100) ;
pEntry_Data varchar(1000) ;
// null indicators
pvldl_lib_n int(5) const ;
pvldl_name_n int(5) const ;
pEntry_ID_n int(5) ;
pEntry_Data_n int(5) ;
// db2sql
pstate char(5);
pFunction varchar(517) const;
pSpecific varchar(128) const;
perrorMsg varchar(1000);
pCallType int(10) const;
end-pi ;
// Paramètres en entrée
if pvldl_name_n = PARM_NULL or pvldl_lib_n = PARM_NULL;
pstate = '38999' ;
perrorMsg = 'VALIDATION_LIST_LIBRARY ou VALIDATION_LIST_NAME est null' ;
return ;
endif ;
select;
when ( pCallType = CALL_OPEN );
// appel initial : initialisation des variables statiques
vldlname.name = pvldl_name ;
vldlname.Lib = pvldl_lib ;
clear vldListEntry ;
first = *on ;
when ( pCallType = CALL_FETCH );
// retrouver l'entrée suivante
exsr doFetch ;
when ( pCallType = CALL_CLOSE );
// rien à faire
endsl;
// traitement de l'entrée suivante
begsr doFetch ;
if first ;
ret = QsyFindFirstValidationLstEntry( vldlname : vldListEntry);
first = *off ;
else ;
ret = QsyFindNextValidationLstEntry( vldlname :
vldListEntry.Entry_ID_Info : vldListEntry);
endif ;
if ret = 0 ;
// Entrée trouvée
monitor ;
pEntry_ID = %left(vldListEntry.Entry_ID_Info.Entry_ID :
vldListEntry.Entry_ID_Info.Entry_ID_Len);
pEntry_Data = %left(vldListEntry.Entry_Data_Info.Entry_Data :
vldListEntry.Entry_Data_Info.Entry_Data_len) ;
pEntry_ID_n = PARM_NOTNULL ;
pEntry_Data_n = PARM_NOTNULL ;
on-error ;
// Erreur de conversion
pstate = '38999' ;
perrorMsg = 'Erreur de conversion' ;
endmon ;
else ;
// Entrée non trouvée : erreur ou fin de lecture
errno = getErrNo() ;
select ;
when errno in %list( ENOENT : ENOREC ) ; // fin de lecture
pstate = '02000' ;
return ;
other ; // Erreur
pstate = '38999' ;
perrorMsg = %str(strError(errno)) ;
endsl ;
endif ;
endsr ;
end-proc ;
// Retrouver le code erreur de l'API
dcl-proc getErrNo ;
dcl-pr getErrNoPtr pointer ExtProc('__errno') ;
end-pr ;
dcl-pi *n int(10) ;
end-pi;
dcl-s errNo int(10) based(errNoPtr) ;
errNoPtr = getErrNoPtr() ;
return errNo ;
end-proc;
Code SQL :
set current schema = NB ;
set path = 'NB' ;
Create or replace Function VALIDATION_LIST_ENTRIES (
VALIDATION_LIST_LIBRARY varchar(10),
VALIDATION_LIST_NAME varchar(10) )
Returns Table
(
VALIDATION_USER varchar(100),
ENTRY_DATA varchar(1000)
)
external name 'VLDLUDTF(VLDL_LIST)'
language rpgle
parameter style db2sql
no sql
not deterministic
disallow parallel;
cl: DLTVLDL VLDL(NB/DEMO) ;
cl: CRTVLDL VLDL(NB/DEMO) TEXT('Démo VALIDATION_LIST_ENTRIES') ;
VALUES SYSTOOLS.ERRNO_INFO(SYSTOOLS.ADD_VALIDATION_LIST_ENTRY(
VALIDATION_LIST_LIBRARY => 'NB',
VALIDATION_LIST_NAME => 'DEMO',
VALIDATION_USER => 'user 1',
PASSWORD => 'MDP user 1',
ENTRY_DATA => 'Client 1'));
VALUES SYSTOOLS.ERRNO_INFO(SYSTOOLS.ADD_VALIDATION_LIST_ENTRY(
VALIDATION_LIST_LIBRARY => 'NB',
VALIDATION_LIST_NAME => 'DEMO',
VALIDATION_USER => 'user 2',
PASSWORD => 'MDP user 2',
ENTRY_DATA => 'Client 1'));
VALUES SYSTOOLS.ERRNO_INFO(SYSTOOLS.ADD_VALIDATION_LIST_ENTRY(
VALIDATION_LIST_LIBRARY => 'NB',
VALIDATION_LIST_NAME => 'DEMO',
VALIDATION_USER => 'user 3',
PASSWORD => 'MDP user 3',
ENTRY_DATA => 'Client 2'));
select * from table(VALIDATION_LIST_ENTRIES( VALIDATION_LIST_LIBRARY => 'NB',
VALIDATION_LIST_NAME => 'DEMO' )) ;
Cela produit :

Libre à vous maintenant d’utiliser ce résultat pour jointer avec vos fichiers de log HTTP (autorisation basique sur une liste de validation par exemple), avec le service USER_INFO_BASIC, croiser les profils présents dans vos différentes listes …
Vous voulez commencer à utiliser des webservices en étant consommateur à partir de votre partition IBMi
Et vous de ne savez pas par ou commencer voici un exemple très simple, prêt à l’emploi que vous pourrez améliorer
on a choisi le site jsonplaceholder.typicode.com qui permet un accès libre , merci à eux
On peut l’utiliser à partir d’un GET et le flux renvoyé est du JSON
On utilisera la fonction QSYS2.HTTP_GET de la manière la plus basic
On parsera le flux recu en utilisant la fonction JSON table
2 prérequis :
Vous devrez avoir une version V7R4
Votre partition devra sortir vers le site jsonplaceholder.typicode.com

**free
ctl-opt dftactgrp(*no) actgrp(*caller);
// Un exemple simple d'un appel de webservice
// on utilise le site jsonplaceholder.typicode.com
// Vous avez les numéros de 1 à 11
// Le flux renvoyé est du JSON on le parse dans une deuxième requête
//
dcl-s url varchar(256) inz('https://jsonplaceholder.typicode.com/users/1');
dcl-s Response Varchar(10000);
dcl-s nom varchar(100);
dcl-s email varchar(100);
dcl-s ville varchar(100);
dcl-s erreur varchar(200);
// Utilisation de la fonction QSYS2.HTTP_GET
exec sql
set :response = QSYS2.HTTP_GET(:url) ;
if sqlcode <> 0;
erreur = 'Erreur appel HTTP_GET : SQLCODE = ' + %char(sqlcode);
SND-MSG *INFO erreur;
return;
endif;
// Parsing du JSON avec JSON_TABLE
exec sql select name, email, address_city into
:nom, :email, :ville
from json_table(
:response, '$' columns ( name varchar(100) path '$.name',
email varchar(100) path '$.email',
address_city varchar(100) path '$.address.city' ) ) as JT;
if sqlcode <> 0;
erreur = 'Erreur parsing JSON : SQLCODE = ' + %char(sqlcode);
SND-MSG *INFO erreur;
return;
endif;
// Affichage du résultat
SND-MSG *INFO ('Nom : ' + nom);
SND-MSG *INFO ('Email : ' + email);
SND-MSG *INFO ('Ville : ' + ville);
// Fin de traitement
return;
.
Conclusion
Simple et efficace
Vous voyez qu’une connaissance de JSON et indispensable et donc au moins une V7R4
Appeler un webservice c’est assez simple
Attention la mise au point dans certains cas peut être compliqué
les idées d’amélioration seront :
Tester le httpstatus qui peut être renvoyer dans le Header
Parser le flux directement dans la requete http_get
etc …
Pour en savoir plus adressez vous à mes collègues qui sont des spécialistes
Une liste de sites libres pour vous entrainer
Une citation du philosophe Chuck Norris
https://api.chucknorris.io/jokes/random
indispensable, pour bien démarrer la journée
Bored API
https://www.boredapi.com/api/activity
Suggestion d’activité fun
Cat Facts
https://catfact.ninja/fact
Donne un fait amusant sur les chats, pour les « matouvus »
IP API (test IP)
https://ipinfo.io/json
Retourne ton IP, localisation, etc. moins fun mais intéressant
Open-Meteo (météo)
https://api.open-meteo.com/v1/forecast?…
Météo gratuite sans clé , les autres nécessitent une clé, vous devrez lui passer des coordonnées
Vous voulez protéger vos sessions 5250 de la possibilité de faire un Appel systéme
Vous devez mettre en place un programme d’exit (8 possibles)
QIBM_QWT_SYSREQPGMS
Vous devez ensuite indiquer sur chaque profil les programmes à utiliser
Schéma ci dessous

L’utilisateur quand il appuiera sur APP SYST le programme PGM1 sera appelé
Programme Exit ici le 1 , nom du programme APPSYS
**free
// programme QIBM_QWT_SYSREQPGMS contrôle d'accès à la touche
// ATTN REQUEST
// l'utilisateur à ce programme de contrôle son profil il s'exécute
// et il n'a pas le droit
ctl-opt
DFTACTGRP(*NO) ;
Dcl-Pi *N;
Reponse int(10);
// 1 ok
// 0 ko
data Char(128);
End-Pi;
//
Reponse = 0;
*inlr = *on ;
GDATA_QRPGLESRC_APPSYS.TXT
Affichage de GDATA_QRPGLESRC_APPSYS.TXT en cours...
Ce programme est simple , il interdit s’il est appelé
Pour ajouter ce programme :
ADDEXITPGM EXITPNT(QIBM_QWT_SYSREQPGMS)
FORMAT(SREQ0100)
PGMNBR(1)
PGM(Votrelib/APPSYS)
REPLACE(NO)
Dans ==>WRKREGINF pour contrôle

Programme de mise à jour des profils qui devront être concernés par le contrôle
**free
// Programme exit pour protéger appel système
// exit PGM QIBM_QWT_SYSREQPGMS
// Pour que ce programme ce déclenche il faut que vous
// l'indiquiez au niveau du profil
// 8 programmes possibles ici le 1 correspond au PGMNBR(1)
// vous devez utiliser l'API QWTSETPX
ctl-opt
DFTACTGRP(*NO) ;
// paramètre recu le profil à protéger
Dcl-Pi *N;
P_user char(10);
End-Pi;
// prototypage de l'API de mise à jour
Dcl-PR QWTSETPX ExtPgm( 'QWTSETPX');
nbrent int(10) ;
flags char(32) ;
format char(8) ;
user char(10) ;
erreur char(32) ;
End-PR;
// Variables de travail
dcl-s wnbrent int(10) ;
dcl-s wflags char(32) ;
dcl-s wformat char(8) ;
dcl-s werreur char(32) ;
// constantes figuratives
dcl-s inact char(04) inz(x'00000000') ;
dcl-s actif char(04) inz(x'00000001') ;
// Appel du programme
wformat = 'SREQ0100' ;
wnbrent = x'00000004' ;
%subst(wflags :1 : 4) = actif ; <<<<< ici
%subst(wflags :5 : 4) = inact ;
%subst(wflags :9 : 4) = inact ;
%subst(wflags :13 : 4) = inact ;
%subst(wflags :17 : 4) = inact ;
%subst(wflags :21 : 4) = inact ;
%subst(wflags :25 : 4) = inact ;
%subst(wflags :29 : 4) = inact ;
QWTSETPX(wnbrent:wflags:wformat:p_user:werreur) ;
*inlr = *on ;
Programme pour voir les programmes du profil
**free
//
// Lecture des informations sur les profils pour appel système
// sur exit pgm QIBM_QWT_SYSREQPGMS
// Rappel 8 possibilités qui correspondent au PGMNBR de l'exit PGM
//
ctl-opt
DFTACTGRP(*NO) ;
// paramétre le profil
Dcl-Pi *N;
P_user char(10);
End-Pi;
// API de lecture des postes
Dcl-PR QWTRTVPX ExtPgm( 'QWTRTVPX');
rcvvar char(40) ;
rcvlen char(4) ;
format char(8) ;
user char(10) ;
erreur char(32) ;
End-PR;
// déclaration des variables de travail
dcl-s wrcvlen char(4) inz(x'00000028') ;
dcl-s wrcvvar char(40) inz(' ') ;
dcl-s wformat char(8) ;
dcl-s werreur char(32) ;
dcl-s wflags char(32) ;
dcl-s wnbpos int(10) ;
// constantes figuratives
dcl-s inact char(04) inz(x'00000000') ;
dcl-s actif char(04) inz(x'00000001') ;
dcl-s msg char(50) inz(' ') ;
dcl-s i int(10) inz(0) ;
// Appel de l'API
wformat = 'SREQ0100' ;
QWTRTVPX(wrcvvar:wrcvlen:wformat:p_user:werreur) ;
wnbpos = 32; // 8 * 4
// extraction des informations pour les 8 programmes
wflags = %subst(wrcvvar : 9 : 32) ;
for i = 1 by 4 to wnbpos ;
if %subst(wflags : i : 4) = actif ;
msg = %trim(msg) + '*ON' ;
else ;
msg = %trim(msg) + '*OFF' ;
endif;
endfor ;
// affichage du résulat
dsply msg ;
*inlr = *on ;
Remarque :
L’utilisateur ne reçoit aucun message , mais rien ne se passe
Attention, il ne faut pas le mettre sur tous les profils, mais uniquement ceux qui le nécessitent.
Par exemple une fenêtre bloquante de ressaisie de mot de passe pour une option sensible.
Vous pouvez faire la même chose pour le programme ATTN …
Vous voulez savoir si une commande est utilisée, il y a plusieurs solutions en voici une basée sur les
programme d’exit qui est assez simple
Il existe un programme d’exit QIBM_QCA_CHG_COMMAND
Pour ajouter votre programme vous avez une commande ADDEXITPGM
ADDEXITPGM EXITPNT(QIBM_QCA_CHG_COMMAND) +
FORMAT(CHGC0100) +
PGMNBR(1) +
PGM(VOTREBIB/HSTCMD) +
TEXT('Tracer une commande') +
PGMDTA('RSTLIB QSYS')
Vous devrez lui indiquer dans la paramètre PGMDTA la commande qualifiée à tracer
exemple :
‘STRDBG QSYS’
Les données reçues sont sur le format CHGC0100 qui vous donne le découpage du buffer reçu par votre programme
Vous pouvez faire un programme générique qui va loguer l’utilisation d’une commande, vous pouvez en mettre plusieurs et la prise en compte est immédiate
Voici le source en clle du programme HSTCMD
PGM PARM(&ExitInfo &NewString &Newlength)
DCL &Class *CHAR 10
DCL &OffsetDec *DEC (7 0)
DCL &CmdLenDec *DEC (7 0)
DCL &ExitInfo *CHAR 2000 /* CHGC0100 interface data */
/* Input parameters */
DCL &ExitPoint *CHAR 20 /* Exit Point name */
DCL &ExitFormat *CHAR 8 /* Exit Point Format */
DCL &CmdName *CHAR 10 /* Command name being executed */
DCL &CmdLib *CHAR 10 /* Command Library */
DCL &Change *CHAR 1 /* Change allowed? 1=yes 0=no */
DCL &Prompt *CHAR 1 /* Prompt requested? 1=yes 0=no */
DCL &Filler *CHAR 2 /* Reserved by IBM */
DCL &Offset *CHAR 4 /* Offset to command string */
DCL &CmdLength *CHAR 4 /* Command string length */
DCL &CmdString *CHAR 2000 /* Command String */
/* Output Parameters */
DCL &NewString *CHAR 2000 /* Replace with this command */
DCL &NewLength *CHAR 4 /* Length of new command */
/* 0 = no new command */
DCL &JOB *CHAR 10
DCL &USR *CHAR 10
DCL &NBR *CHAR 6
MONMSG CPF0000 EXEC(GOTO ERROR)
/* découpage du paramètre reçu */
CHGVAR &ExitPoint %SST(&ExitInfo 1 20)
CHGVAR &ExitFormat %SST(&ExitInfo 21 8)
CHGVAR &CmdName %SST(&ExitInfo 29 10)
CHGVAR &CmdLib %SST(&ExitInfo 39 10)
CHGVAR &Change %SST(&ExitInfo 49 1)
CHGVAR &Prompt %SST(&ExitInfo 50 1)
CHGVAR &Filler %SST(&ExitInfo 51 2)
CHGVAR &Offset %SST(&ExitInfo 53 4)
CHGVAR &CmdLength %SST(&ExitInfo 57 4)
CHGVAR &CmdLenDec %BIN(&Cmdlength)
CHGVAR &OffsetDec (%BIN(&Offset) + 1) /* Set offset */
CHGVAR &CmdString %SST(&ExitInfo &OffsetDec &CmdLenDec)
/* Extraction du travail */
RTVJOBA JOB(&JOB) USER(&USR) NBR(&NBR)
/* envoi message à qsysopr */
SNDUSRMSG MSG(&job *tcat '/' *tcat &usr *tcat +
'/' *tcat &nbr *bcat %sst(&CmdString 1 +
100) ) MSGTYPE(*INFO) TOUSR(*SYSOPR)
/* passage de la commande sans transformation */
chgvar &NewString &CmdString
chgvar &NewLength &CmdLength
ERROR:
return
ENDPGM
Remarque :
Vous n’avez pas besoin de mettre en place des audits et tout est dynamique
Vous pouvez transformer une commande ou la remplacer par une autre
Pour voir les commandes que vous tracez
==> WRKREGINF QIBM_QCA_CHG_COMMAND
Exemple :
Les commandes qui commencent par DLT, je remplace par un message suppression refusée pour certain utilisateurs
Rappel :
Un programme d’exit doit être simple et ne pas planter !
Vous avez des application 5250 que vous avez décidé d’améliorer en les passant de 80 colonnes à 132 colonnes
c’est au niveau de votre écran que vous devez indiquer cette taille par le mot clé DSPSIZ(27 132 *DS4) .
Quand vous affichez votre écran sur une unité écran de type 3477 tout va bien mais quand vous l’affichez sur une unité écran de type 3179, vous avez une erreur d’entrée sortie.
Comment faire pour éviter ce plantage ?
Bien sur définir toutes les unités écrans en 132, mais on ne maitrise par forcément toujours cette démarche, beaucoup de systèmes étant en auto-configuration.
Voici une première solution minimaliste qui évitera le plantage, et qui enverra un message dans la log
Exemple.
dcl-f
VOTREECRAN WORKSTN
usropn ;
open(e) VOTREECRAN ;
if %error ;
// si erreur on considère que c’est la taille
dsply ‘Vous devez être en 132*27’ ;
// votre traitement ici
endif ;
c’est simple et efficace
Mais vous pouvez faire quelque chose d’un peu plus propre
En effet on peut avoir un mélange dans un dspf que vous allez créer
En indiquant les 2 mots clés dans votre source
Vous devez impérativement indiquer *DS4 en premier
A DSPSIZ(27 132 *DS4 –
A 24 80 *DS3)
La problématique est de trouver la taille de votre unité écran, pour l’instant il n’existe pas de vue SQL qui fasse un DSPDEVD, vous devrez utiliser les API fournies par IBM :
ici QDCRDEVD elle a un format DEVD0600 qui contient cette information.
le source de l’écran avec ses 2 formats
A*%%TS SD 20240308 152030 PLB REL-V7R4M0 5770-WDS
A* attention 132 doit être en premier
A* le premier fixe l'affichage maxi
A DSPSIZ(27 132 *DS4 -
A 24 80 *DS3)
A* Format à afficher en cas de taille 80
A R FMT80
A*%%TS SD 20240308 152030 PLB REL-V7R4M0 5770-WDS
A CA12(12)
A 5 11'Format de l''écran'
A DSPATR(UL)
A 6 11'Ecran 80'
A 7 2'F12=Retour'
A COLOR(BLU)
A* Format à afficher en cas de taille 132
A R FMT132
A*%%TS SD 20240308 152030 PLB REL-V7R4M0 5770-WDS
A CA12(12)
A 5 70'Format de l''écran'
A DSPATR(UL)
A 6 70'Ecran 132'
A 8 2'F12=Retour'
A COLOR(BLU)
Le source du programme
On a créé une procédure interne que vous pouvez facilement externaliser dans un programme de service par exemple, (dans notre exemple, il y a une variable globale liée à la SDS … )
**free
Ctl-Opt DFTACTGRP(*NO) ;
// Test d'une procédure pour déterminer la taille de l'écran DEVD
Dcl-f RTVDEVTYPE WORKSTN ;
// Contient 2 formats
// fmt132 de taille 132
// fmt80 de taille 80
// Information du Job
dcl-ds *N PSDS;
JOB Char(10) Pos(244);
end-ds;
// Variables globales
Dcl-S w_type Char(10);
// 3477 taille 132
// 3179 taille 80
// en interactif, le travail = nom de l'écran
//
w_type = getdevtyp('*') ;
If w_type = '3477' ;
exfmt fmt132 ;
Else;
exfmt fmt80 ;
EndIf;
*inlr = *on ;
// Récupération du type de l'écran
//
Dcl-Proc Getdevtyp Export;
Dcl-PI Getdevtyp Char(10);
Inp_Device Char(10) Const;
End-PI;
// Prototypes de la l'API QDCRDEVD récupération des attributs
// d'une unité
Dcl-PR QDCRDEVD ExtPgm('QDCRDEVD');
Rcvar Like(Rcvar);
Varlen Like(Varlen);
Format Like(Format);
Device Like(Device);
Apierr Like(Apierr);
End-PR;
Dcl-DS Apierr;
Bytprv BinDec(8:0) Pos(1) Inz(216);
Bytavl BinDec(8:0) Pos(5) Inz;
Errorid Char(7) Pos(9) Inz;
Reserved Char(1) Pos(16) Inz;
ErrorDesc Char(200) Pos(17) Inz;
End-DS;
Dcl-S device Char(10) INZ;
// Format pour unité écran
Dcl-S Format Char(8) Inz('DEVD0600');
Dcl-S Rcvar Char(5000) Inz;
Dcl-S Varlen BinDec(4:0) Inz(5000);
Dcl-S typ_dev Char(10) INZ;
// Si * on considère l'écran en cours
if Inp_Device = '*' ;
Device = JOB; // attention variable globale
else ;
Device = Inp_Device;
endif ;
// Appel API systéme
CallP QDCRDEVD(
Rcvar
:Varlen
:Format
:Device
:Apierr
);
If BytAvl = 0;
// Lecture position du type de DSP
typ_dev = %Subst(Rcvar:175:10);
EndIf;
Return typ_dev;
End-Proc Getdevtyp;
Remarque :
Il y a sans doute d’autres solutions, mais vous pouvez vous contenter de l’une des deux citées ci dessus.
Il peut y avoir quelques subtilités mais globalement ça fonctionne bien.
Pour traduire du texte dans un programme RPGLE, on peut utiliser un appel à une API de traduction (via SQL). Les principales API de traductions publiques sont DeepL API et Google Cloud Translation. Dans cet article nous utiliserons l’API de DeepL dans sa version gratuite, limitée à 500 000 caractères par mois, mais DeepL propose également d’autres offres payantes pour son API.
Documentation de l’API DeepL : https://www.deepl.com/docs-api
Introduction
Pour réaliser simplement un appel API en RPGLE, il est possible d’utiliser plusieurs méthodes SQL qui permettent de :
- Formater le corps d’une requête API en JSON
- Exécuter la requête API en POST
- Récupérer des informations dans la réponse JSON
Nous allons voir ensemble un exemple d’utilisation de ces méthodes pour créer un programme qui traduit un texte donné dans la langue choisie.
Cas d’exemple
Prenons donc le cas d’un programme simple qui récupère les paramètres suivants :
- Le texte à traduire
- Le code de la langue ciblée (‘FR’, ‘EN’, ‘ES’, ‘DE’, …)
Le programme affichera ensuite via un dsply le résultat de la traduction et le code retour HTTP de la requête.
On commence par les déclarations du programme.

On y retrouve :
- nos paramètres texte et langue_cible
- une ds qui contiendra les données retournées par la requête API (traduction et code HTTP)
- deux variables pour l’URL de la requête et le token d’authentification (qui s’obtient en créant un compte API sur DeepL)
On peut maintenant construire notre requête API en utilisant SQL.

La requête HTTP faite à l’API est exécutée via la fonction de table QSYS2.HTTP_POST_VERBOSE (qui est similaire à QSYS2.HTTP_POST, mais avec plus de détails en retour).
Elle prend en paramètres :
- l’URL d’appel de l’API
- le body de notre requête -> un objet JSON contenant le texte et la langue cible
- le header de notre requête -> un objet JSON contenant des informations supplémentaires requises comme le token d’authentification
Ici la traduction se fera avec une détection automatique de la langue source (celle du texte qu’on demande à traduire), mais on peut également ajouter le paramètre source_lang dans notre body si on veut préciser la langue source de notre texte.
On remarque l’usage des fonctions SQL JSON_OBJECT et JSON_ARRAY qui permettent de formater des données au format JSON (JSON_ARRAY pour un tableau JSON)
Les éléments que l’on récupère grâce à cette fonction sont au format JSON, on utilise donc la fonction JSON_VALUE pour les récupérer en VARCHAR dans notre ds résultat.
Dans notre cas, on s’intéresse au texte traduit et au code retour HTTP, c’est donc les valeurs translations et HTTP_STATUS_CODE qui sont extraites du JSON.
Vous pouvez obtenir plus d’informations sur la structure des requêtes API DeepL et leurs retours sur la documentation en ligne de l’API : https://www.deepl.com/docs-api
Pour finir, on affiche avec un simple dsply nos éléments de retour (dans le cas où la requête SQL a été exécutée sans erreur).

Test du programme
Lorsqu’on appelle notre programme avec les bons paramètres :

On obtient bien une traduction du texte saisi, et le code retour 200 (réussite).




