⇧ initProcess - 29/03/2025 17:18:30
Capable de process préemptif
ON ERR CALL(Formula(traceHandler).source)
Capable de process préemptif
ON ERR CALL(Formula(traceHandler).source)
If (True) //False)
var $trace : cs._Trace
$trace:=cs._Trace.me
var $params : Object
$params:=New object
$params.Commande:="Afficher"
$params.sourceLogs:=ALV Client APP
$params.wndTitre:="Logs application ALV"
$params.nbrMaxLogs:=2000
cs.xSDK.EvenementsALV.me.AfficherEditeur($params)
$trace.Initialiser(Current method name)
$trace.Error:=-43
$trace.ErrorDescription:="test"
$trace.LeverException([msgk_event; msgk_log])
Use (Storage.Host)
Storage.Host.Session_Etat:=(Storage.Host.Session_Etat ?+ 6) ?+ 8
End use
//$trace.DebugerMethode("SSL"; Current method name; "openssl version : \""+"xxx"+"\". [OK]")
End if
If (False)
var $cmd; $x; $y; $certPem; $path : Text
var $request : Object
var $f : 4D.File
var $b : Boolean
var $blob : Blob
//$cmd:="/usr/bin/openssl x509 -checkend 0 -inform PEM"
$f:=File("/Users/philippe/Sites/WebCertificats/cert.pem")
$blob:=$f.getContent()
$path:=$f.platformPath
$b:=Test path name($path)=Is a document
$cmd:="x509 -noout -text -inform PEM"
cs._libOpenSSL.new().LancerOpenSSL($cmd; ->$blob; ->$x; ->$y)
End if
Capable de process préemptif
#DECLARE($classe : Object; $params : Object)->$numProc : Integer
var $nomTache : Text
var $data : Object
var $trace : cs._Trace
$trace:=cs._Trace.me
$numProc:=0
Case of
: (Not(OB Is defined($params; "functionID")))
$trace.EnvoyerMessages([msgk_event; msgk_log]; "Initialisation :"; Current method name; "'functionID' n'est pas défini dans $params")
: (Value type($params.functionID)#Is text)
$trace.EnvoyerMessages([msgk_event; msgk_log]; "Initialisation :"; Current method name; "'$params.functionID' n'est pas un texte")
: (Not(OB Is defined($params; "nomTache")))
// nécessaire pour tuer la tâche
$trace.EnvoyerMessages([msgk_event; msgk_log]; "Initialisation :"; Current method name; "'nomTache' n'est pas défini dans $params")
: (Not(OB Is defined($params; "numProcessAppelant")))
$trace.EnvoyerMessages([msgk_event; msgk_log]; "Initialisation :"; Current method name; "'numProcessAppelant' n'est pas défini dans $params")
: ($params.numProcessAppelant=-1)
$nomTache:=$params.nomTache
// supprimer la tâche existante
cs.xSDK.RegistreTaches.new().Tuer($nomTache)
// créer le nouveau process
$params.numProcessAppelant:=Current process
$numProc:=New process(Current method name; 0; "$SSL_process_"+$nomTache; $classe; $params; *)
Else
// c'est ok
// construire la classe
$data:=$classe.new()
If ($data[$params.functionID]#Null)
// créer la tâche associée
// numProcessAppelant est nécessaire pour tuer toutes les tâches d'un même process
$params.tache:=cs.xSDK.RegistreTaches.new().Inscrire(New object("nomProcess"; Current process name; "nomTache"; $params.nomTache; "numProcessAppelant"; $params.numProcessAppelant))
// lancer le traitement demandé
$data[$params.functionID]($params)
// désinscrire la tâche 'nomTache'
$params.tache.DésInscrire()
Else
$trace.EnvoyerMessages([msgk_event; msgk_log]; "Initialisation :"; Current method name; "La classe "+$classe.name+" n'est pas de function "+$params.functionID)
End if
$numProc:=Current process
End case
cs._Trace.me.Intercepter()
Pas de code
property trace : cs._Trace
Class extends _libOpenSSL
Class constructor()
Super()
This.trace:=cs._Trace.me
//---------------------------
//MARK:Certificat
//---------------------------
Function getInformations($params : Object)
// le resultat est dans $params
var $data; $dossier : Object
var $keyText; $certText; $vt_certDate; $vt_timestamp; $vt_certificate : Text
// lire le chemin des certificats du serveur demandé
Case of
: (OB Is defined($params; "nomDossierSSL"))
// chemin du dossier du certificat
$params.CertificatSSLFolderPath:=Folder(Get 4D folder(Current resources folder; *); fk platform path).folder("SSL").folder($params.nomDossierSSL).platformPath
// fixer le dossier du certificat
Use (Storage.System)
Storage.System.CertificatSSLFolderPath:=$params.CertificatSSLFolderPath
End use
: (OB Is defined($params; "CertificatSSLFolderPath"))
// fixer le dossier du certificat
Use (Storage.System)
Storage.System.CertificatSSLFolderPath:=$params.CertificatSSLFolderPath
End use
Else
// fixer le dossier du certificat
Use (Storage.System)
Storage.System.CertificatSSLFolderPath:="vide"
End use
End case
$data:=New object("Production"; New object; "Génération"; New object)
// certificat en production
If (This.getCertCurrent(->$certText; ->$keyText))
$vt_certDate:=This.CertToText(->$certText; "enddate")
$vt_timestamp:=This.parseCertDate($vt_certDate)
$data.Production.exists:=True
$data.Production.UTC:=$vt_timestamp
$data.Production.date:=Date($vt_timestamp)
$data.Production.heure:=Time($vt_timestamp)
$data.Production.libellé:="Le certificat expire le "+String($data.Production.date; System date abbreviated)+" à "+String(Time($data.Production.heure); HH MM SS)
// check if the certificate will expire within the next x seconds (dans 30 jours)
$data.Production.aRenouveler:=This.checkCertEnd($certText; 30*24*60*60)
$data.Production.Invalide:=This.checkCertEnd($certText; 0)
// renvoyer le contenu du certificat
$vt_certificate:=Storage.System.CertificatSSLFolderPath
$data.certActiveDir:=Folder($vt_certificate; fk platform path).platformPath
$vt_certificate:=Document to text($data.certActiveDir+"cert.pem"; Document with LF)
$data.Production.certificateInfos:=This.CertChainToText($vt_certificate)
Else
// no certificates
$data.Production.exists:=False
$data.Production.libellé:="Pas de certificat"
$data.Production.certificateInfos:="Pas d'information"
End if
// certificat généré
$data.Génération.exists:=False
$dossier:=Folder(Get 4D folder(Current resources folder; *); fk platform path).folder("SSL").folder("Certificat_LetsEncrypt")
$data.Génération.certFile:=$dossier.file("cert.pem")
$data.Génération.keyFile:=$dossier.file("key.pem")
// ajouter ce fichier pour éviter sa régénération au lancement du serveur APP (occupe 97% des ressources CPU)
$data.Génération.dhparamsFile:=$dossier.file("dhparams.pem")
Case of
: (Not($dossier.exists))
: (Not($data.Génération.certFile.exists))
: (Not($data.Génération.keyFile.exists))
Else
$data.Génération.exists:=True
End case
// les infos sont dans $params
$params.infos:=OB Copy($data)
Function getCertCurrent($vp_certPtr : Pointer; $vp_keyPtr : Pointer)->$result : Boolean
// This function loads the current certificate and rsa private key (optional)
var $vb_valid : Boolean
var $vt_4dCertDir; $vt_keyPath; $vt_certPath; $vt_algorithmeSSL : Text
ASSERT((Type($vp_certPtr->)=Is BLOB) | (Type($vp_certPtr->)=Is text); "$1 should be a text or blob pointer")
ASSERT(Type($vp_certPtr->)=Type($vp_keyPtr->); "$1 and $2 should be of same type")
$result:=False
Case of
: ((Type($vp_certPtr->)=Is BLOB))
SET BLOB SIZE($vp_certPtr->; 0)
SET BLOB SIZE($vp_keyPtr->; 0)
$vt_4dCertDir:=Storage.System.CertificatSSLFolderPath
$vt_keyPath:=$vt_4dCertDir+"key.pem"
$vt_certPath:=$vt_4dCertDir+"cert.pem"
// tester le fichier 'cert.pem'
If (($vt_certPath#"") & (Test path name($vt_certPath)=Is a document))
DOCUMENT TO BLOB($vt_certPath; $vp_certPtr->)
ASSERT(ok=1; "error loading file \""+$vt_certPath+"\"")
ASSERT(This.trace.DebugerMethode("Cert"; Current method name; "loading file \""+$vt_certPath+"\". "+Choose(ok=1; "[OK]"; "[KO]")+" "+$vt_algorithmeSSL))
//-----BEGIN CERTIFICATE-----
// <base64 data>
//-----END CERTIFICATE-----
$vb_valid:=This.checkPemFormat($vp_certPtr; "CERTIFICATE")
ASSERT($vb_valid; "invalid certificate PEM file")
If (Not($vb_valid))
ASSERT(This.trace.DebugerMethode("Cert"; Current method name; "file \""+$vt_certPath+"\" : pem is "+Choose($vb_valid; "valid. [OK]"; "invalid. [KO]")))
End if
$result:=True
Else
ASSERT(This.trace.DebugerMethode("Cert"; Current method name; "certificate file \""+$vt_certPath+"\" : file not found. [KO]"))
End if
// tester le fichier 'key.pem'
If (Test path name($vt_keyPath)=Is a document)
DOCUMENT TO BLOB($vt_keyPath; $vp_keyPtr->)
ASSERT(ok=1; "error loading file \""+$vt_keyPath+"\"")
ASSERT(This.trace.DebugerMethode("Cert"; Current method name; "loading file \""+$vt_keyPath+"\". "+Choose(ok=1; "[OK]"; "[KO]")))
//-----BEGIN RSA PRIVATE KEY-----
// <base64 data>
//-----END RSA PRIVATE KEY-----
$vt_algorithmeSSL:="Certificat avec clé privée RSA"
$vb_valid:=This.checkPemFormat($vp_keyPtr; "RSA PRIVATE KEY")
If (Not($vb_valid))
// PhS essayer clé EDCSA
//-----BEGIN PRIVATE KEY-----
// <base64 data>
//-----END PRIVATE KEY-----
$vt_algorithmeSSL:="Certificat avec clé privée EDCSA"
$vb_valid:=This.checkPemFormat($vp_keyPtr; "PRIVATE KEY")
If (Not($vb_valid))
// PhS 08/10/2023 essayer rien !!!
$vt_algorithmeSSL:="Certificat avec clé privée inconnue"
$vb_valid:=This.checkPemFormat($vp_keyPtr; "CERTIFICATE")
End if
End if
ASSERT(This.trace.DebugerMethode("Cert"; Current method name; "file \""+$vt_keyPath+"\" : pem is "+Choose($vb_valid; "valid. [OK]"; "invalid. [KO]")))
This.trace.EnvoyerMessages([msgk_event; msgk_log]; $vt_algorithmeSSL; Current method name; "file \""+$vt_keyPath+"\" : pem is "+Choose($vb_valid; "valid. [OK]"; "invalid. [KO]"))
Else
ASSERT(This.trace.DebugerMethode("Cert"; Current method name; "rsa private key file \""+$vt_keyPath+"\" : file not found. [KO]"))
This.trace.EnvoyerMessages([msgk_event; msgk_log]; "Fichier non trouvé"; Current method name; $vt_keyPath)
$result:=False
End if
: ((Type($vp_certPtr->)=Is text))
SET BLOB SIZE($vx_cert; 0)
SET BLOB SIZE($vx_key; 0)
$result:=This.getCertCurrent(->$vx_cert; ->$vx_key)
$vp_keyPtr->:=""
If (BLOB size($vx_key)>0)
$vp_keyPtr->:=Convert to text($vx_key; "UTF-8")
ASSERT(ok=1; "error convertir utf8 blob to text (rsa private key in pem format)")
End if
$vp_certPtr->:=""
If (BLOB size($vx_cert)>0)
$vp_certPtr->:=Convert to text($vx_cert; "UTF-8")
ASSERT(ok=1; "error convertir utf8 blob to text (certificate in pem format)")
End if
SET BLOB SIZE($vx_cert; 0)
SET BLOB SIZE($vx_key; 0)
End case
Function checkPemFormat($vp_pemDataPtr : Pointer; $vt_pemTypeKey : Text)->$result : Boolean
// This function check some pem data
var $vt_pem; $vt_pemDebug : Text
var $vb_exit : Boolean
var $vl_start; $vl_count; $vl_countValid : Integer
var $vt_startTag; $vt_endTag; $vt_regex; $vt_pemData : Text
var $vl_posStart; $vl_posEnd : Integer
$result:=False
$vt_pem:=Convert to text($vp_pemDataPtr->; "UTF-8")
$vt_pemDebug:=Replace string(Replace string($vt_pem; "\r"; "<CR>"; *); "\n"; "<LF>"; *)
// force indentation to "\n"
$vt_pem:=This.normalizeEndOfLine($vt_pem; Document with LF)
$vb_exit:=False
$vl_start:=1
$vl_count:=0
$vl_countValid:=0
$vt_startTag:="-----BEGIN "+$vt_pemTypeKey+"-----\n"
$vt_endTag:="-----END "+$vt_pemTypeKey+"-----\n"
// pattern to search for non base64 chracters
$vt_regex:="^[-A-Za-z0-9+/]+$"
//$vt_regex:="[^-A-Za-z0-9+/=]"
//$vt_regex:="[^-A-Za-z0-9+/=]|=[^=]|={3,}$"
Repeat
$vl_posStart:=Position($vt_startTag; $vt_pem; $vl_start)
$vl_posEnd:=Position($vt_endTag; $vt_pem; $vl_start)
If (($vl_posStart>0) & ($vl_posEnd>0) & ($vl_posEnd>$vl_posStart))
$vl_count:=$vl_count+1
$vt_pemData:=Substring($vt_pem; $vl_posStart+Length($vt_startTag); $vl_posEnd-$vl_posStart-Length($vt_startTag))
// remove indentation
$vt_pemData:=Replace string($vt_pemData; "\n"; ""; *)
If (Length($vt_pemData)>0) // should not be empty
If ((Length($vt_pemData)%4)=0) // base64 encoded data is multiple of 4
// remove padding ("=" or "==")
Case of
: (Substring($vt_pemData; Length($vt_pemData)-1)="==")
$vt_pemData:=Substring($vt_pemData; 1; Length($vt_pemData)-2)
: (Substring($vt_pemData; Length($vt_pemData))="=")
$vt_pemData:=Substring($vt_pemData; 1; Length($vt_pemData)-1)
End case
If (Match regex($vt_regex; $vt_pemData; 1; *))
//Si (Non(Trouver regex($vt_regex;$vt_pemData;1;*))) // check that is is clean base64 data
$vl_countValid:=$vl_countValid+1
End if
End if
End if
$vt_pem:=Substring($vt_pem; $vl_posEnd+Length($vt_endTag))
Else
$vb_exit:=True
End if
Until ($vb_exit)
$result:=(($vl_count>0) & ($vl_count=$vl_countValid))
ASSERT(This.trace.DebugerMethode("SSL"; Current method name; "pem data \""+$vt_pemDebug+"\" "+Choose($result; " valid. [OK]"; " invalid. [KO]")))
Function checkCertEnd($vt_cert : Text; $vl_nbSeconds : Integer)->$result : Boolean
// This function returns TRUE si the certificates will expire expires in the next $2 seconds
var $vt_inform; $vt_args; $vt_in; $vt_out; $vt_err : Text
var $vb_ok : Boolean
ASSERT(Count parameters>0; "requires 1 parameter")
ASSERT(Length($vt_cert)>0; "cert is empty")
$result:=True
If (Count parameters>0)
If (Count parameters=1)
$vl_nbSeconds:=0
End if
If ($vl_nbSeconds<0)
$vl_nbSeconds:=0
End if
If (Length($vt_cert)>0)
If (Is Windows)
//$vt_uuid:=Generer UUID
//$vt_certTempPath:=Dossier temporaire+"acme_component_checkend_"+$vt_uuid+".crt"
//$vt_batTempPath:=Dossier temporaire+"acme_component_checkend_"+$vt_uuid+".bat"
//$vt_inform:="PEM"
//$vt_bat:="@ECHO OFF\r"+"set OPENSSL_CONF="+acme__opensslConfigDefaultSub+"\r"+acme__opensslPathGet+" x509 -noout -checkend "+Chaîne($vl_nbSeconds)+" -inform "+$vt_inform+" -in "+UTL_pathToPosixConvert($vt_certTempPath)+"\r"+"echo %ERRORLEVEL%\r"
//// write UTF8 file without bom with CRLF as line separator
//UTL_textToDocument($vt_certTempPath; TXT_endOfLineNormalize($vt_cert; Document avec CRLF))
//UTL_textToDocument($vt_batTempPath; TXT_endOfLineNormalize($vt_bat; Document avec CRLF))
//$vb_ok:=acme__executeBatFile($vt_batTempPath; ->$vt_out; ->$vt_err)
//acme__log(4; Nom méthode courante; "bat file :\r"+$vt_bat+"\rout : \""+Remplacer chaîne(Remplacer chaîne($vt_out; ""; "<LF>"; *); ""; "<CR>"; *)+"\"\rerr : \""+Remplacer chaîne(Remplacer chaîne($vt_err; ""; "<LF>"; *); ""; "<CR>"; *))
//Si ($vb_ok)
//$result:=(Remplacer chaîne($vt_out; "\r\n"; ""; *)="1")
//acme__log(4; Nom méthode courante; "nb seconds : "+Chaîne($vl_nbSeconds)+", windows (execute bat ok), out : \""+Remplacer chaîne($vt_out; "\r\n"; ""; *)+"\" => "+Choisir($result; "invalid"; "valid"))
//Sinon
//$result:=Vrai
//acme__log(4; Nom méthode courante; "nb seconds : "+Chaîne($vl_nbSeconds)+", windows (execute bat ko) => invalid")
//Fin de si
//Si (Tester chemin acces($vt_certTempPath)=Est un document)
//SUPPRIMER DOCUMENT($vt_certTempPath)
//ASSERT(ok=1; "error deleting file \""+$vt_certTempPath+"\"")
//Fin de si
//Si (Tester chemin acces($vt_batTempPath)=Est un document)
//SUPPRIMER DOCUMENT($vt_batTempPath)
//ASSERT(ok=1; "error deleting file \""+$vt_batTempPath+"\"")
//Fin de si
Else
$vt_inform:="PEM"
$vt_args:="x509 "+\
" -checkend "+String($vl_nbSeconds)+\
" -inform "+$vt_inform
//" -noout " => "Certificate will not expire" or "Certificate will expire" output
$vt_in:=$vt_cert
$vt_out:=""
$vt_err:=""
$vb_ok:=This.LancerOpenSSL($vt_args; ->$vt_in; ->$vt_out; ->$vt_err)
If ($vb_ok)
$vt_out:=Replace string($vt_out; "\n"; ""; *)
$vt_out:=Replace string($vt_out; "\r"; ""; *)
//out : "Certificate will not expire"
//out : "Certificate will expire"
Case of
: ($vt_out="Certificate will expire")
$result:=True // the certificat will expire in the next $vl_nbSeconds second
: ($vt_out="Certificate will not expire")
$result:=False
Else
$result:=True
ASSERT(False; "unexpected value \""+$vt_out+"\"")
End case
ASSERT(This.trace.DebugerMethode("Cert"; Current method name; "nb seconds : "+String($vl_nbSeconds)+", os x (lpe ok) => valid"))
Else
$result:=True
ASSERT(This.trace.DebugerMethode("Cert"; Current method name; "nb seconds : "+String($vl_nbSeconds)+", os x (lpe ko) => invalid"))
End if
End if
End if
End if
Function CertChainToText($vt_pem : Text)->$result : Text
// This function returns certificates as text from a pem certificate chain file
var $vl_certificateTotalCount; $vl_certificateIndex; $i : Integer
var $vt_lineSep; $vt_type; $vt_pemData; $vt_lineSepOriginal; $vt_certInfos : Text
ASSERT(Count parameters>0; "require 1 parameter")
$result:=""
// parse the pem file into an array of individual pem with their types
ARRAY TEXT($tt_pemData; 0)
ARRAY TEXT($tt_type; 0)
This.pemFormatChainToArray($vt_pem; ->$tt_pemData; ->$tt_type)
$vl_certificateTotalCount:=Count in array($tt_type; "X509 CERTIFICATE")+Count in array($tt_type; "CERTIFICATE")
$vl_certificateIndex:=0
$vt_lineSep:=This.getlineSeparateur($vt_pem)
For ($i; 1; Size of array($tt_type))
$vt_type:=$tt_type{$i}
$vt_pemData:=$tt_pemData{$i}
// make everything "\n"
$vt_lineSepOriginal:=This.getlineSeparateur($vt_pemData)
If ($vt_lineSepOriginal#"\n")
$vt_pemData:=Replace string($vt_pemData; $vt_lineSepOriginal; "\n"; *)
End if
Case of
: (($vt_type="X509 CERTIFICATE") | ($vt_type="CERTIFICATE"))
$vl_certificateIndex:=$vl_certificateIndex+1
$vt_certInfos:=This.CertToText(->$vt_pemData)
If ($vt_lineSepOriginal#"\n")
$vt_certInfos:=Replace string($vt_certInfos; "\n"; $vt_lineSepOriginal; *)
End if
$result:=$result+"Certificate "+String($vl_certificateIndex)+" / "+String($vl_certificateTotalCount)+$vt_lineSep
$result:=$result+$vt_certInfos
End case
End for
//---------------------------
//MARK:Utilitaires
//---------------------------
Function normalizeEndOfLine($vt_in : Text; $vl_mode : Integer)->$result : Text
// This function will convert the end of line characters
$result:=""
If (Length($vt_in)>0)
Case of
: ($vl_mode=Document unchanged) // 0
$result:=$vt_in
: ($vl_mode=Document with native format) // 1
If (Is Windows)
//$result:=UTL_normalize ($vt_in;Document avec CRLF)
$result:=Replace string($vt_in; "\r\n"; "\r"; *)
$result:=Replace string($result; "\n"; "\r"; *)
$result:=Replace string($result; "\r"; "\r\n"; *)
Else
//$result:=UTL_normalize ($vt_in;Document avec CR)
$result:=Replace string($vt_in; "\r\n"; "\r"; *)
$result:=Replace string($result; "\n"; "\r"; *)
End if
: ($vl_mode=Document with CRLF) // 2
$result:=Replace string($vt_in; "\r\n"; "\r"; *)
$result:=Replace string($result; "\n"; "\r"; *)
$result:=Replace string($result; "\r"; "\r\n"; *)
: ($vl_mode=Document with CR) // 3
$result:=Replace string($vt_in; "\r\n"; "\r"; *)
$result:=Replace string($result; "\n"; "\r"; *)
: ($vl_mode=Document with LF) // 4
$result:=Replace string($vt_in; "\r\n"; "\n"; *)
$result:=Replace string($result; "\r"; "\n"; *)
Else
ASSERT(False; "invalid mode : "+String($vl_mode))
End case
End if
Function CertToText($vp_inPtr : Pointer; $vt_param : Text; $vt_inform : Text)->$result : Text
// This function returns text data about a private key, a csr, or certificate in PEM or DER format
var $vt_text; $vt_args; $vt_err : Text
var $vb_ok : Boolean
$vt_text:=""
ASSERT(Count parameters>0; "requires 1 parameter")
ASSERT((Type($1->)=Is text) | (Type($1->)=Is BLOB); "$1 should be a text or blob pointer")
$vb_ok:=False
// openssl x509 -noout -text -in cert.pem
Case of
: (Count parameters=1)
$vt_param:="" //"text"
$vt_inform:=""
: (Count parameters=2)
$vt_inform:=""
End case
If (($vt_inform="DER") | ($vt_inform="PEM"))
$vt_inform:=Uppercase($vt_inform)
Else
$vt_inform:=Choose(Type($vp_inPtr->)=Is BLOB; "DER"; "PEM")
End if
$vt_param:=Lowercase($vt_param)
Case of
: ($vt_param="text")
: ($vt_param="startdate")
: ($vt_param="enddate")
: ($vt_param="dates")
: ($vt_param="serial")
: ($vt_param="hash")
: ($vt_param="subject_hash")
: ($vt_param="subject_hash_old")
: ($vt_param="issuer_hash")
: ($vt_param="issuer_hash_old")
: ($vt_param="subject")
: ($vt_param="issuer")
: ($vt_param="email")
: ($vt_param="purpose")
: ($vt_param="modulus")
: ($vt_param="fingerprint")
: ($vt_param="ocspid")
: ($vt_param="ocsp_uri")
: ($vt_param="pubkey")
: ($vt_param="alias")
Else
End case
If (Length($vt_param)=0)
// -serial - print serial number value
// -subject_hash - print subject hash value
// -subject_hash_old - print old-style (MD5) subject hash value
// -issuer_hash - print issuer hash value
// -issuer_hash_old - print old-style (MD5) issuer hash value
// -subject - print subject DN
// -issuer - print issuer DN
// -email - print email address(es)
// -purpose - print out certificate purposes
// -modulus - print the RSA key modulus
// -fingerprint - print the certificate fingerprint
// -ocspid - print OCSP hash values for the subject name and public key
// -ocsp_uri - print OCSP Responder URL(s)
// -text - print the certificate in text form
// -C - print out C code forms
$vt_param:="text"
End if
$vt_args:="x509 "+" -noout "+" -"+$vt_param+" "+" -inform "+$vt_inform
$vt_err:=""
If (This.LancerOpenSSL($vt_args; $vp_inPtr; ->$vt_text; ->$vt_err))
$vb_ok:=True
ASSERT(This.trace.DebugerMethode("Cert"; Current method name; "openssl "+$vt_args+" \r"+$vt_text+"\r [OK]"))
Else
ASSERT(This.trace.DebugerMethode("Cert"; Current method name; "openssl "+$vt_args+" ("+$vt_err+"). [KO]"))
End if
$result:=$vt_text
Function parseCertDate($vt_certDate : Text)->$result : Text
// This function converts a certificate date and time into a timestamp
var $vt_regex; $vt_month; $vt_day; $vt_time; $vt_year : Text
var $vl_found : Integer
ASSERT(Count parameters>0; "requires 1 parameter")
$result:=""
If (Length($vt_certDate)>0)
$vt_regex:="(Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec) +(\\d{1,2}) (\\d{2}:\\d{2}:\\d{2}) (\\d{4}) GMT"
ARRAY LONGINT($tl_pos; 0)
ARRAY LONGINT($tl_len; 0)
If (Match regex($vt_regex; $vt_certDate; 1; $tl_pos; $tl_len))
$vt_month:=Substring($vt_certDate; $tl_pos{1}; $tl_len{1})
$vt_day:=Substring($vt_certDate; $tl_pos{2}; $tl_len{2})
$vt_time:=Substring($vt_certDate; $tl_pos{3}; $tl_len{3})
//$vt_time:=Remplacer chaîne($vt_time; ":"; ""; *)
$vt_year:=Substring($vt_certDate; $tl_pos{4}; $tl_len{4})
ARRAY TEXT($tt_month; 12)
$tt_month{January}:="Jan" //1
$tt_month{February}:="Feb" //2
$tt_month{March}:="Mar" //3
$tt_month{April}:="Apr" //4
$tt_month{May}:="May" //5
$tt_month{June}:="Jun" //6
$tt_month{July}:="Jul" //7
$tt_month{August}:="Aug" //8
$tt_month{September}:="Sep" //9
$tt_month{October}:="Oct" //10
$tt_month{November}:="Nov" //11
$tt_month{December}:="Dec" //12
ARRAY TEXT($tt_monthNum; 12)
$tt_monthNum{January}:="01" //1
$tt_monthNum{February}:="02" //2
$tt_monthNum{March}:="03" //3
$tt_monthNum{April}:="04" //4
$tt_monthNum{May}:="05" //5
$tt_monthNum{June}:="06" //6
$tt_monthNum{July}:="07" //7
$tt_monthNum{August}:="08" //8
$tt_monthNum{September}:="09" //9
$tt_monthNum{October}:="10" //10
$tt_monthNum{November}:="11" //11
$tt_monthNum{December}:="12" //12
$vl_found:=Find in array($tt_month; $vt_month)
If ($vl_found>0)
$result:=$vt_year+"-"+\
$tt_monthNum{$vl_found}+"-"+\
((2-Length($vt_day))*"0")+$vt_day+"T"+\
$vt_time+"Z"
End if
ARRAY TEXT($tt_month; 0)
ARRAY TEXT($tt_monthNum; 0)
End if
End if
Function pemFormatChainToArray($vt_pem : Text; $vp_pemDataArrPtr : Pointer; $vp_pemTypeArrPtr : Pointer)
// This method parse a pem data (a certificate chain for instance) into a pem array
var $vt_lineSepOriginal; $vt_pemTypeKey; $vt_tag : Text
var $vt_regexStart; $vt_regexEnd; $vt_regexCheck : Text
var $vt_pemData; $vt_pemDataPure : Text
var $vl_start; $vl_pos; $vl_len : Integer
ASSERT(Count parameters>2; "requires 3 parameters")
ASSERT(Type($vp_pemDataArrPtr->)=Text array; "$vp_pemDataArrPtr should be a text array")
ASSERT(Type($vp_pemTypeArrPtr->)=Text array; "$vp_pemTypeArrPtr should be a text array")
// make everything "\n"
$vt_lineSepOriginal:=This.getlineSeparateur($vt_pem)
If ($vt_lineSepOriginal#"\n")
$vt_pem:=Replace string($vt_pem; $vt_lineSepOriginal; "\n"; *)
End if
$vt_pemTypeKey:=\
"X509 CERTIFICATE|"+\
"CERTIFICATE|"+\
"TRUSTED CERTIFICATE|"+\
"NEW CERTIFICATE REQUEST|"+\
"CERTIFICATE REQUEST|"+\
"X509 CRL|"+\
"ANY PRIVATE KEY|"+\
"PUBLIC KEY|"+\
"RSA PRIVATE KEY|"+\
"RSA PUBLIC KEY|"+\
"DSA PRIVATE KEY|"+\
"DSA PUBLIC KEY|"+\
"PKCS7|"+\
"PKCS #7 SIGNED DATA|"+\
"ENCRYPTED PRIVATE KEY|"+\
"PRIVATE KEY|"+\
"DH PARAMETERS|"+\
"X9\\.42 DH PARAMETERS|"+\
"SSL SESSION PARAMETERS|"+\
"DSA PARAMETERS|"+\
"ECDSA PUBLIC KEY|"+\
"EC PARAMETERS|"+\
"EC PRIVATE KEY|"+\
"PARAMETERS|"+\
"CMS"
ARRAY TEXT($tt_pemData; 0)
ARRAY TEXT($tt_pemType; 0)
If (Length($vt_pem)>0)
$vt_regexStart:="(?m)-----BEGIN ("+$vt_pemTypeKey+")-----\n" //"(.*)+\n-----END ("+$vt_pemTypeKey+")-----"
$vl_start:=1
ARRAY LONGINT($tl_pos; 0)
ARRAY LONGINT($tl_len; 0)
// find the next start tag
While (Match regex($vt_regexStart; $vt_pem; $vl_start; $tl_pos; $tl_len))
$vt_tag:=Substring($vt_pem; $tl_pos{1}; $tl_len{1})
// find the corresponding end tag
$vt_regexEnd:="\n-----END "+$vt_tag+"-----\n"
$vl_start:=$tl_pos{0}+$tl_len{0}
If (Match regex($vt_regexEnd; $vt_pem; $vl_start; $vl_pos; $vl_len))
// get the text including the start and end tags
$vt_pemData:=Substring($vt_pem; $tl_pos{0}; $vl_pos+$vl_len-$tl_pos{0})
// get the text without the tags (to check it is "clean")
$vt_pemDataPure:=Substring($vt_pem; $tl_pos{0}+$tl_len{0}; $vl_pos-$tl_pos{0}-$tl_len{0})
// -----BEGIN RSA PRIVATE KEY-----
// Proc-Type: 4,ENCRYPTED
// DEK-Info: AES-256-CBC,D60C7F6
//
// kDVqIxEbnN/jQp6429HeILy3vYqOWYUuKDlclHxC753JKitPn3Dfhg4g918osVqR
// ...
// 1Zxh2TRysMLLsiDmqxjMqLBU1RtZWrLJXAsGPtznTpPIEVsjSZbG8fe6/Q2pi1yW
// -----END RSA PRIVATE KEY-----
If (Length($vt_pemDataPure)>0) // make sure the pem data is "clean"
$vt_regexCheck:="(?m)^(?:[-A-Za-z0-9+/ :,\n]+\n\n)?[-A-Za-z0-9+/\n]+$"
//$vt_regexCheck:="(?m)^[-A-Za-z0-9+/\n]+$"
If (Match regex($vt_regexCheck; $vt_pemDataPure; 1; *))
If ($vt_lineSepOriginal#"\n")
$vt_pemData:=Replace string($vt_pemData; "\n"; $vt_lineSepOriginal; *)
End if
APPEND TO ARRAY($tt_pemData; $vt_pemData)
APPEND TO ARRAY($tt_pemType; $vt_tag)
End if
End if
$vl_start:=$vl_pos+$vl_len
End if
End while
ARRAY LONGINT($tl_pos; 0)
ARRAY LONGINT($tl_len; 0)
End if
//%W-518.1
COPY ARRAY($tt_pemData; $vp_pemDataArrPtr->)
COPY ARRAY($tt_pemType; $vp_pemTypeArrPtr->)
//%W+518.1
Function getlineSeparateur($vt_text : Text; $vt_lineSepDefault : Text)->$result : Text
var $i; $vl_length; $vl_ascii : Integer
ASSERT(Count parameters>0; "requires 1 parameters")
$result:=""
If (Count parameters=1)
If (Is Windows)
$result:="\r\n"
Else
$result:="\r"
End if
End if
$vl_length:=Length($vt_text)
For ($i; 1; $vl_length)
$vl_ascii:=Character code($vt_text[[$i]])
Case of
: ($vl_ascii=0x000A) // 10 i.e. LF
$result:="\n"
$i:=$vl_length+1
: ($vl_ascii=0x000D) // 13 i.e. CR
$result:="\r" //$vt_text[[$i]]
If ($i<$vl_length)
If (Character code($vt_text[[$i+1]])=0x000A) // 10 i.e. LF
$result:="\r\n" //$vt_text[[$i]]
End if
End if
$i:=$vl_length+1
End case
End for
property trace : cs._Trace
property componentInfos; environment : Text
Class constructor()
This.trace:=cs._Trace.me
// -----------------------------
// MARK:Installation
// -----------------------------
Function InitVariablesSSL()
var $data : Object
Use (Storage)
Storage["System"]:=New shared object
Storage["STR"]:=New shared object
Storage["Host"]:=New shared object
End use
Use (Storage.System)
// sert, en particulier, pour les process de type monitoring
Storage.System.ArrêtAPP:=False
Storage.System.estExecuteDansHote:=False
Storage.System.estExecuteDansAPP:=False
Storage.System.AlertesHôte:=6 // gère les messages d'alerte
$data:=cs.xSDK.EnvironnementALV.new()
Storage.System.typeApplication:=$data.typeApplication()
Storage.System.estServeur:=$data.estServeur()
Storage.System.estClient:=$data.estClient()
End use
// pour un fonctionnement hors BDDmère
Use (Storage.Host)
Storage.Host.Session_Etat:=0
End use
// partager des ressources
// aucune
Function Installer()
// gestion d'erreur par déafut
ON ERR CALL(Formula(traceHandler).source; ek global)
// démarrer le worker
CALL WORKER("WK_Composant_SSL"; Formula(ON ERR CALL("")))
Use (Storage.System)
Storage.System.estExecuteDansAPP:=cs.xSDK.EnvironnementALV.new().estExecuteDansAPP()
End use
This.InstallerDonnéesHote()
Function InstallerDonnéesHote()
// lire les données d'installation
var $attribut : Text
var $data : Object
Case of
: (Not(Storage.System.estExecuteDansHote))
// exécution du composant en local
: (Not(Storage.System.estExecuteDansAPP))
// exécution du composant dans un composant
: (Storage.System.typeApplication=ALV Client APP)
: (Storage.System.typeApplication=4D Remote mode)
// filtrer
Else
$data:=New object
EXECUTE METHOD(Lire Données Hôte Partagées; $data)
// recopier les données reçues
Use (Storage.Host)
For each ($attribut; OB Keys($data))
Storage.Host[$attribut]:=$data[$attribut]
End for each
End use
End case
//---------------------------
//MARK:SSL
//---------------------------
Function initACME()
//================================================================================
//@xdoc-start : en
//@name : acme__init
//@scope : private
//@deprecated : no
//@description : This method will be called once when the component is initialized
//@notes :
//@example : acme__init
//@see :
//@version : 1.00.00
//@author : Bruno LEGAY (BLE) - Copyrights A&C Consulting - 2008
//@history : CREATION : Bruno LEGAY (BLE) - 28/06/2019, 20:10:02 - v1.00.00
//@xdoc-end
//================================================================================
var $vt_directoryUrl; $vt_workingDir : Text
var $vb_execBitForced : Boolean
var $vo_acmeConfig : Object
If (Not(OB Is defined(Storage; "acme")))
// composant needs to be "inited"
// default values
$vt_workingDir:=Get 4D folder(Database folder; *)
// "Macintosh HD:Users:ble:Documents:Projets:BaseRef_v15:acme_component:source:acme_component.4dbase:"
$vt_directoryUrl:="https://acme-v02.api.letsencrypt.org/directory"
// execBitForced is only required on OS X, so on Windows let's say it is already forced...
$vb_execBitForced:=Choose(Is Windows; True; False)
// set the values for the acme config in a shared object
$vo_acmeConfig:=New shared object(\
"workingDir"; $vt_workingDir; \
"directoryUrl"; $vt_directoryUrl; \
"execBitForced"; $vb_execBitForced)
// create a new config shared object with the config object properties
// "Storage.acme" will be "private" to the component
Use (Storage)
Storage.acme:=New shared object("config"; $vo_acmeConfig)
End use
If (Storage.System.estExecuteDansHote)
This.componentInfos:=", "+Choose(Is compiled mode; "compiled"; "interpreted")
Else
This.componentInfos:=", component "+Choose(Is compiled mode; "compiled"; "interpreted")+\
", host "+Choose(Is compiled mode(*); "compiled"; "interpreted")
End if
This.environment:=Application version+" "+\
Choose(True; "(64 bits)"; "(32 bits)")+" "+\
Choose(Is Windows; "Windows"; "macOS")+\
This.componentInfos+\
", openssl binary version : \""+cs._libOpenSSL.new().getVersionSSL()+"\""+\
", 4D openssl version : \""+cs._libOpenSSL.new().get4DVersion()+"\""
// "4D v15.6 Final (Build 222813) (32 bits) macOS, compiled, openssl binary version : "OpenSSL 1.0.2o 27 Mar 2018", 4D openssl version : "OpenSSL 1.0.2j 26 Sep 2016""
// "4D v18.0 Final (Build 246707) (64 bits) macOS, compiled, openssl binary version : "OpenSSL 1.0.2o 27 Mar 2018", 4D openssl version : "OpenSSL 1.1.1d 10 Sep 2019""
// send some infos in the log file
ASSERT(This.trace.DebugerMethode("ACME"; Current method name; "component acme v"+cs._libOpenSSL.new().getVersionSSL()+" ("+This.environment+") init"))
ASSERT(This.trace.DebugerMethode("ACME"; Current method name; "\"workingDir\" default : \""+$vt_workingDir+"\""))
ASSERT(This.trace.DebugerMethode("ACME"; Current method name; "\"directoryUrl\" default : \""+$vt_directoryUrl+"\""))
End if
Function forceExecuteBit($vt_cmdPath : Text)
//================================================================================
//@xdoc-start : en
//@name : acme__execbitForce
//@scope : private
//@deprecated : no
//@description : This method sets the permissions (execute bit) on a os x binary (chmod 755)
//@parameter[1-IN-cmdPath-TEXT] : executable path (posix, can be within '' on os x)
//@notes :
// with 4D, on a client, the resources are copied from server and are sometimes losing the unix permissions (and the execute permission)
// does nothing on Windows
//@example : acme__execbitForce
//@see :
//@version : 1.00.00
//@author : Bruno LEGAY (BLE) - Copyrights A&C Consulting - 2008
//@history : CREATION : Bruno LEGAY (BLE) - 30/06/2018, 09:06:47 - v1.00.00
//@xdoc-end
//================================================================================
var $vb_doForce; $vb_ok : Boolean
var $vt_cmd; $vt_in; $vt_out; $vt_err : Text
ASSERT(Count parameters>0; "requires 1 parameter")
ASSERT(Length($vt_cmdPath)>0; "$1 cmd path cannot be empty")
This.initACME()
$vb_doForce:=False
If (Not(Storage.acme.config.execBitForced))
$vb_doForce:=True
Use (Storage.acme) // locking "Storage.acme" or "Storage.acme.config" is juste the same
Storage.acme.config.execBitForced:=True
End use
End if
If ($vb_doForce)
If (Is Windows)
// windows
Else
// os x
$vt_cmd:="/bin/ls -l "+$vt_cmdPath
$vt_in:=""
$vt_out:=""
$vt_err:=""
// v11.0.10 attention ici pb avec .LancerOpenSSL()
// _4D_OPTION_BLOCKING_EXTERNAL_PROCESS" is "true" by default
SET ENVIRONMENT VARIABLE("_4D_OPTION_CURRENT_DIRECTORY"; Get 4D folder(Database folder; *))
LAUNCH EXTERNAL PROCESS($vt_cmd; $vt_in; $vt_out; $vt_err)
$vb_ok:=(ok=1)
$vt_out:=This.removeLastWhitespaces($vt_out)
$vt_err:=This.removeLastWhitespaces($vt_err)
If (Substring($vt_out; 1; 10)#"-rwxr-xr-x")
//$vt_cmd:="/bin/chmod ugo+rx,go-w "+$vt_cmdPath
$vt_cmd:="/bin/chmod 755 "+$vt_cmdPath
$vt_in:=""
$vt_out:=""
$vt_err:=""
LAUNCH EXTERNAL PROCESS($vt_cmd; $vt_in; $vt_out; $vt_err)
$vb_ok:=(ok=1)
$vt_out:=This.removeLastWhitespaces($vt_out)
$vt_err:=This.removeLastWhitespaces($vt_err)
ASSERT(This.trace.DebugerMethode("Cert"; Current method name; "command : \""+$vt_cmd+"\", in : \""+$vt_in+"\", out : \""+$vt_out+"\", err : \""+$vt_err+"\". "+Choose($vb_ok; "[OK]"; "[KO]")))
End if
End if
End if
Function removeLastWhitespaces($vt_in : Text)->$result : Text
//================================================================================
//@xdoc-start : en
//@name : acme__removeLastWhitespaces
//@scope : public
//@deprecated : no
//@description : This function returns a text without the trailing whitespaces
//@parameter[0-OUT-textIn-TEXT] : text out
//@parameter[1-IN-textOut-TEXT] : text in
//@notes :
//@example : acme__removeLastWhitespaces
//@see :
//@version : 1.00.00
//@author : Bruno LEGAY (BLE) - Copyrights A&C Consulting 2018
//@history :
// CREATION : Bruno LEGAY (BLE) - 30/06/2018, 08:52:37 - 1.0
//@xdoc-end
//================================================================================
var $vt_out; $vt_regex : Text
$vt_out:=""
$vt_regex:="^(?s)(.*?)\\s*$"
If (cs._libOpenSSL.new().regexGetMatchingGroup($vt_regex; $vt_in; 1; ->$vt_out))
End if
$result:=$vt_out
//interface avec openSSL du systeme
property trace : cs._Trace
Class constructor()
This.trace:=cs._Trace.me
//---------------------------
//MARK:Acces lib openSSL
//---------------------------
Function LancerOpenSSL($vt_args : Text; $vp_inPtr : Pointer; $vp_outPtr : Pointer; $vp_errPtr : Pointer)->$result : Boolean
// This function runs some openssl command
// parameter[0-OUT-ok-BOOLEAN] : TRUE if ok, FALSE otherwise
// parameter[1-IN-args-TEXT] : openssl args
// parameter[2-IN-inPtr-POINTER] : input stream text of blob pointer (not modified)
// parameter[3-OUT-outPtr-POINTER] : output stream text of blob pointer (modified)
// parameter[4-OUT-errPtr-POINTER] : error stream text of blob pointer (modified)
var $request : 4D.SystemWorker
var $vt_openSslPath : Text
ASSERT(Count parameters>3; "requires 4 parameters")
ASSERT(Length($vt_args)>0; "$1 openssl args cannot be empty")
ASSERT((Type($vp_inPtr->)=Is text) | (Type($vp_inPtr->)=Is BLOB); "$vp_inPtr should be a text or blob pointer")
ASSERT((Type($vp_outPtr->)=Is text) | (Type($vp_outPtr->)=Is BLOB); "$vp_outPtr should be a text or blob pointer")
ASSERT((Type($vp_errPtr->)=Is text) | (Type($vp_errPtr->)=Is BLOB); "$vp_errPtr should be a text or blob pointer")
$vt_openSslPath:=This.getOpenSslPath()
cs._composant.new().forceExecuteBit($vt_openSslPath)
$vt_openSslPath:=$vt_openSslPath+" "+$vt_args
$request:=4D.SystemWorker.new($vt_openSslPath)
$request.postMessage($vp_inPtr->)
$request.closeInput()
$request.wait()
If ($request.terminated)
$vp_outPtr->:=$request.response
$vp_errPtr->:=$request.responseError
End if
$result:=($request.responseError="")
Function getOpenSslPath()->$result : Text
//================================================================================
//@xdoc-start : en
//@name : acme__opensslPathGet
//@scope : private
//@deprecated : no
//@description : This function returns the openssl executable path
//@parameter[0-OUT-openSslPath-TEXT] : openssl executable path
//@notes :
// => "'/Users/ble/Documents/Projets/BaseRef_v15/acme_component/source/acme_component.4dbase/Resources/openssl/osx/openssl'"
//@example : acme__opensslPathGet
//@see :
//@version : 1.00.00
//@author :
//@history :
// CREATION : Bruno LEGAY (BLE) - 23/06/2018, 12:45:56 - 1.00.00
//@xdoc-end
//================================================================================
var $trace : cs._Trace
$trace:=cs._Trace.me.Initialiser(Current method name)
If (Is Windows)
$result:=Get 4D folder(Current resources folder)+"openssl"+Folder separator+Choose(True; "win64"; "win32")+Folder separator+"openssl.exe"
Else
// use os x default openssl binary
$result:=Folder(fk system folder).parent.folder("usr/bin").file("openssl").platformPath
//$result:=Dossier 4D(Dossier Resources courant)+"openssl"+Séparateur dossier+"osx"+Séparateur dossier+"openssl"
$trace.Error:=-43*Num(Not(Test path name($result)=Is a document))
$trace.ErrorDescription:=$result
End if
$trace.LeverException([msgk_event; msgk_log])
$result:=This.convertPathToPosix($result; True)
Function getVersionSSL()->$result : Text
// renvoie la version de openSSL installée sur la machine
//================================================================================
//@xdoc-start : en
//@name : acme__opensslVersionGet
//@scope : private
//@deprecated : no
//@description : This function returns the openssl version
//@parameter[0-OUT-opensslVersion-TEXT] : openssl version (e.g. "OpenSSL 0.9.8zg 14 July 2015", "OpenSSL 1.0.2o 27 Mar 2018")
//@notes :
//@example : acme__opensslVersionGet
//@see :
//@version : 1.00.00
//@author :
//@history :
// CREATION : Bruno LEGAY (BLE) - 23/06/2018, 12:29:47 - 1.00.00
//@xdoc-end
//================================================================================
var $vt_opensslVersion; $vt_in; $vt_out; $vt_err; $vt_regex : Text
$vt_opensslVersion:=""
If (This.LancerOpenSSL("version"; ->$vt_in; ->$vt_out; ->$vt_err))
// composant ACME de B. LEGUAY "OpenSSL 1.0.2o 27 Mar 2018\n"
// macOS ventura "LibreSSL 3.3.6\n"
// remove leading and trailing white spaces from the text
$vt_regex:="^(?s)\\s*(.+?)\\s*$"
If (This.regexGetMatchingGroup($vt_regex; $vt_out; 1; ->$vt_opensslVersion))
ASSERT(This.trace.DebugerMethode("SSL"; Current method name; "openssl version : \""+$vt_opensslVersion+"\". [OK]"))
Else
ASSERT(This.trace.DebugerMethode("SSL"; Current method name; "reged \""+$vt_regex+"\" failed on \""+$vt_out+"\". [KO]"))
End if
Else
ASSERT(This.trace.DebugerMethode("SSL"; Current method name; "openssl version unknown, out : \""+$vt_out+"\", err : \""+$vt_err+"\". [KO]"))
End if
$result:=$vt_opensslVersion
Function get4DVersion()->$result : Text
// renvoie la version de openSSL utilisée par le serveur Web
//================================================================================
//@xdoc-start : en
//@name : acme__openssl4dVersion
//@scope : public
//@deprecated : no
//@description : This function returns 4D openssl library version
//@parameter[0-OUT-openssl4dVersion-TEXT] : openssl 4D internal vesion (e.g. "OpenSSL 1.0.2j 26 Sep 2016")
//@notes :
//@example : acme__openssl4dVersion
//@see :
//@version : 1.00.00
//@author : Bruno LEGAY (BLE) - Copyrights A&C Consulting 2019
//@history :
// CREATION : Bruno LEGAY (BLE) - 06/12/2019, 14:52:24 - 0.90.11
//@xdoc-end
//================================================================================
var $serveur : Object
$serveur:=WEB Get server info
$result:=$serveur.security.openSSLVersion
//---------------------------
//MARK:Utilitaires
//---------------------------
Function convertPathToPosix($vt_path : Text; $stringPath : Boolean)->$result : Text
//================================================================================
//@xdoc-start : en
//@name : UTL_pathToPosixConvert
//@scope : private
//@deprecated : no
//@description : This function converts a local file path to posix
//@parameter[0-OUT-posix-TEXT] : filepath posix
//@parameter[1-IN-path-TEXT] : path
//@parameter[2-IN-enclose-BOOLEAN] : add enclose quotes
//@notes :
//@example : UTL_pathToPosixConvert
//@see :
//@version : 1.00.00
//@author :
//@history :
// CREATION : Bruno LEGAY (BLE) - 23/06/2018, 22:07:34 - 1.00.00
//@xdoc-end
//================================================================================
// avec $stringPath, on renvoie un path 'encodé' chaine (ex pour insertion dans une chaine)
ASSERT(Count parameters>0; "requires 1 parameter")
$result:=""
If (Is Windows)
$result:=$vt_path
If ($stringPath)
$result:="\""+$result+"\""
End if
Else
$result:=Convert path system to POSIX($vt_path)
If ($stringPath)
$result:="'"+$result+"'"
End if
End if
Function regexGetMatchingGroup($vt_regex : Text; $vt_text : Text; $vl_start : Integer; $vp_matchingGroupPtr : Pointer)->$result : Boolean
//================================================================================
//@xdoc-start : en
//@name : TXT_regexGetMatchingGroup
//@scope : private
//@deprecated : no
//@description : This function will perform a regex and extract text with matching groups
//@parameter[0-OUT-match-BOOLEAN] : TRUE if regex match, FALSE otherwise
//@parameter[1-IN-regex-TEXT] : regular expression
//@parameter[2-IN-text-TEXT] : text
//@parameter[3-IN-start-LONGINT] : start position (should be <= Length($2) )
//@parameter[{4..n}-OUT-matchingGroup-POINTER] : matching group text pointer (modified)
//@notes :
//@example : TXT_regexGetMatchingGroup
//@see :
//@version : 1.00.00
//@author :
//@history :
// CREATION : Bruno LEGAY (BLE) - 23/06/2018, 18:55:11 - 1.00.00
//@xdoc-end
//================================================================================
var $vl_type : Integer
var $vt_matchingGroup : Text
$result:=False
$vl_type:=Type($vp_matchingGroupPtr->)
Case of
: (($vl_type=Is text) | ($vl_type=Is alpha field))
$vp_matchingGroupPtr->:=""
: (($vl_type=Is real) | ($vl_type=Is integer) | ($vl_type=Is longint) | ($vl_type=Is integer 64 bits))
$vp_matchingGroupPtr->:=0
End case
If ((Length($vt_text)>=$vl_start) & ($vl_start>0))
ARRAY LONGINT($tl_pos; 0)
ARRAY LONGINT($tl_len; 0)
If (Match regex($vt_regex; $vt_text; $vl_start; $tl_pos; $tl_len))
If (Size of array($tl_pos)>=1)
$result:=True
$vt_matchingGroup:=Substring($vt_text; $tl_pos{1}; $tl_len{1})
$vl_type:=Type($vp_matchingGroupPtr->)
Case of
: (($vl_type=Is text) | ($vl_type=Is alpha field))
$vp_matchingGroupPtr->:=$vt_matchingGroup
: (($vl_type=Is real) | ($vl_type=Is integer) | ($vl_type=Is longint) | ($vl_type=Is integer 64 bits))
$vp_matchingGroupPtr->:=Num($vt_matchingGroup)
End case
End if
End if
End if
Function getVarPointer($vp_pointer : Pointer)->$result : Text
//================================================================================
//@xdoc-start : en
//@name : acme__varPtrDebug
//@scope : private
//@deprecated : no
//@description : This function returns a debug for a text or blob pointer
//@parameter[0-OUT-varDebug-TEXT] : var debug
//@parameter[1-IN-varPtr-POINTER] : blob or text var pointer (not modified)
//@notes :
//@example : acme__varPtrDebug
//@see :
//@version : 1.00.00
//@author : Bruno LEGAY (BLE) - Copyrights A&C Consulting - 2008
//@history : CREATION : Bruno LEGAY (BLE) - 09/10/2020, 18:58:34 - v1.00.00
//@xdoc-end
//================================================================================
var $vl_type : Integer
$vl_type:=Type($vp_pointer->)
Case of
: ($vl_type=Is text)
$result:=$vp_pointer->
: ($vl_type=Is BLOB)
$result:=String(BLOB size($vp_pointer->))+" byte(s)"
Else
$result:=""
End case
property cible : cs.xSDK.Traces
property success : Boolean
singleton Class constructor()
This.cible:=cs.xSDK.Traces.new()
This.success:=False
Function set Error($numError : Integer)
This.cible.Error:=$numError
Function get Error()->$result : Integer
$result:=This.cible.Error
Function set ErrorDescription($description : Text)
This.cible.ErrorDescription:=$description
Function get ErrorDescription()->$result : Text
$result:=This.cible.ErrorDescription
Function Intercepter()
var $ErrorNum : Integer
$ErrorNum:=This.cible.Intercepter("SSL"; Error; Error method; Error line; Error formula)
Function Initialiser($nomMethode : Text)->$result : Object
This.cible.CréerErreur("SSL"; 0; $nomMethode; "")
$result:=This
Function Créer($Error : Integer; $nomMethode : Text; $ErrorDescription : Text)->$result : Object
This.cible.CréerErreur("SSL"; $Error; $nomMethode; $ErrorDescription)
$result:=This
Function FixerSuccess()
This.cible.FixerSuccess()
This.success:=This.cible.success
Function LeverException($options : Collection)
// renseigner le label de l'erreur
This.cible.ErrorLabel:=Localized string(String(This.cible.Error))
// lancer le traitement de l'erreur
This.cible.LeverException($options)
Function EnvoyerMessages($options : Collection; $libellé : Text; $source : Text; $description : Text)
This.cible.EnvoyerMessages($options; "SSL"; $libellé; $source; $description)
Function DebugerMethode($libellé : Text; $source : Text; $description : Text)->$result : Boolean
// mettre à jour l'état (activation / désactivation des ASSERT)
cs._composant.new().InstallerDonnéesHote()
$result:=This.cible.DebugerMethode(Storage.Host; "SSL"; $libellé; $source; $description)
Class extends _libOpenSSL
Class constructor()
Super()
//---------------------------
//MARK:Certificat SSL autosigné
//---------------------------
Function CreateRsaCertSelfSigned($vp_keyPtr : Pointer; $vp_certPtr : Pointer; $vo_csrObj : Object; $vl_validity : Integer; $vl_keySize : Integer)->$result : Boolean
// This function generates a self signed certificate
var $vt_cmd; $vt_in; $vt_out; $vt_err : Text
var $vl_nbParam : Integer
var $vt_structureDir; $vt_uuid; $vt_keyPath; $vt_certPath; $vt_confPath : Text
var $vt_keyPathPosix; $vt_certPathPosix; $vt_confPathPosix : Text
var $vt_signature; $vt_subject; $vt_csrConf : Text
var $vx_key; $vx_cert : Object
var $vb_newKey : Boolean
ASSERT(Count parameters>1; "expecting 2 parameters")
ASSERT(Not(Is nil pointer($vp_keyPtr)); "$1 should not be nil")
ASSERT((Type($vp_keyPtr->)=Is BLOB) | (Type($vp_keyPtr->)=Is text); "$1 should be a text or blob pointer")
ASSERT(Not(Is nil pointer($vp_certPtr)); "$2 should not be nil")
ASSERT(Type($vp_keyPtr->)=Type($vp_certPtr->); "$1 and $2 should be of same type")
$result:=False
$vl_nbParam:=Count parameters
If ($vl_nbParam>2)
Case of
: ($vl_nbParam=3)
$vl_validity:=365
$vl_keySize:=2048
: ($vl_nbParam=4)
$vl_keySize:=2048
Else
End case
If (False)
// req [options] <infile >outfile
// where options are
// -inform arg input format - DER or PEM
// -outform arg output format - DER or PEM
// -in arg input file
// -out arg output file
// -text text form of request
// -pubkey output public key
// -noout do not output REQ
// -verify verify signature on REQ
// -modulus RSA modulus
// -nodes don't encrypt the output key
// -engine e use engine e, possibly a hardware device
// -subject output the request's subject
// -passin private key password source
// -key file use the private key contained in file
// -keyform arg key file format
// -keyout arg file to send the key to
// -rand file:file:...
// load the file (or the files in the directory) into
// the random number generator
// -newkey rsa:bits generate a new RSA key of 'bits' in size
// -newkey dsa:file generate a new DSA key, parameters taken from CA in 'file'
// -newkey ec:file generate a new EC key, parameters taken from CA in 'file'
// -[digest] Digest to sign with (md5, sha1, md2, mdc2, md4)
// -config file request template file.
// -subj arg set or modify request subject
// -multivalue-rdn enable support for multivalued RDNs
// -new new request.
// -batch do not ask anything during request generation
// -x509 output a x509 structure instead of a cert. req.
// -days number of days a certificate generated by -x509 is valid for.
// -set_serial serial number to use for a certificate generated by -x509.
// -newhdr output "NEW" in the header lines
// -asn1-kludge Output the 'request' in a format that is wrong but some CA's
// have been reported as requiring
// -extensions .. specify certificate extension section (override value in config file)
// -reqexts .. specify request extension section (override value in config file)
// -utf8 input characters are UTF8 (default ASCII)
// -nameopt arg - various certificate name options
// -reqopt arg - various request text options
End if
cs._composant.new().initACME()
ASSERT(Type($vp_keyPtr->)=Type($vp_certPtr->))
Case of
: (Type($vp_keyPtr->)=Is BLOB)
$vt_structureDir:=Temporary folder //cert__dirPath
$vt_uuid:=Generate UUID
$vt_keyPath:=$vt_structureDir+$vt_uuid+"-key-rsa.pem"
$vt_certPath:=$vt_structureDir+$vt_uuid+"-cert-rsa.pem"
$vt_confPath:=$vt_structureDir+$vt_uuid+"-cert.conf"
$vt_keyPathPosix:=This.convertPathToPosix($vt_keyPath)
$vt_certPathPosix:=This.convertPathToPosix($vt_certPath)
$vt_confPathPosix:=This.convertPathToPosix($vt_confPath)
$vt_csrConf:=This.csrReqConfObjectToText($vo_csrObj)
This.textToFile($vt_confPath; $vt_csrConf)
If (BLOB size($vp_keyPtr->)=0)
If (True)
$vt_cmd:="req "+\
" -new "+\
" -days "+String($vl_validity)+" "+\
" -x509 "+\
" -newkey rsa:"+String($vl_keySize)+" "+\
" -nodes "+\
" -config "+$vt_confPathPosix+\
" -keyout "+$vt_keyPathPosix+" "+\
" -out "+$vt_certPathPosix
Else
$vt_cmd:="req "+\
" -new "+\
" -x509 "+\
" -days "+String($vl_validity)+" "+\
" -"+$vt_signature+" "+\
" -newkey rsa:"+String($vl_keySize)+" "+\
" -nodes "+\
" -keyout "+$vt_keyPathPosix+" "+\
" -subj '"+$vt_subject+"' "+\
" -out "+$vt_certPathPosix
End if
$result:=This.LancerOpenSSL($vt_cmd; ->$vt_in; ->$vt_out; ->$vt_err)
If (Test path name($vt_keyPath)=Is a document)
DOCUMENT TO BLOB($vt_keyPath; $vp_keyPtr->)
Else
SET BLOB SIZE($vp_keyPtr->; 0)
End if
If (Test path name($vt_keyPath)=Is a document)
DOCUMENT TO BLOB($vt_certPath; $vp_certPtr->)
Else
SET BLOB SIZE($vp_certPtr->; 0)
End if
Else
BLOB TO DOCUMENT($vt_keyPath; $vp_keyPtr->)
If (True)
$vt_cmd:="req "+\
" -new "+\
" -key "+$vt_keyPathPosix+" "+\
" -x509 "+\
" -days "+String($vl_validity)+" "+\
" -config "+$vt_confPathPosix+\
" -out "+$vt_certPathPosix
Else
$vt_cmd:="req "+\
" -new "+\
" -key "+$vt_keyPathPosix+" "+\
" -"+$vt_signature+" "+\
" -x509 "+\
" -days "+String($vl_validity)+" "+\
" -subj '"+$vt_subject+"' "+\
" -out "+$vt_certPathPosix
End if
$result:=This.LancerOpenSSL($vt_cmd; ->$vt_in; ->$vt_out; ->$vt_err)
DOCUMENT TO BLOB($vt_certPath; $vp_certPtr->)
End if
DELETE DOCUMENT($vt_keyPath)
DELETE DOCUMENT($vt_certPath)
DELETE DOCUMENT($vt_confPath)
: (Type($vp_keyPtr->)=Is text)
SET BLOB SIZE($vx_key; 0)
SET BLOB SIZE($vx_cert; 0)
$vb_newKey:=(Length($vp_keyPtr->)=0)
If (Not($vb_newKey))
CONVERT FROM TEXT($vp_keyPtr->; "us-ascii"; $vx_key)
End if
$result:=This.CreateRsaCertSelfSigned(->$vx_key; ->$vx_cert; $vo_csrObj; $vl_validity; $vl_keySize)
If ($vb_newKey)
$vp_keyPtr->:=Convert to text($vx_key; "us-ascii")
End if
$vp_certPtr->:=Convert to text($vx_cert; "us-ascii")
SET BLOB SIZE($vx_key; 0)
SET BLOB SIZE($vx_cert; 0)
End case
End if
Function NewCsrReqConfObject($vo_dn : Object; $vo_altNames : Object)->$result : Object
// This function returns a csr request configuration object from a "dn" object and an optional "alt_names" object
var $vb_altNames : Boolean
var $vo_req; $vo_reqExt : Object
ASSERT(Count parameters>0; "requires 1 parameter")
ASSERT(OB Is defined($1); "$1 should be defined")
If (Count parameters=1)
$vb_altNames:=False
End if
$vb_altNames:=OB Is defined($vo_altNames)
OB SET($vo_req; "default_bits"; 2048)
OB SET($vo_req; "prompt"; False)
OB SET($vo_req; "default_md"; "sha256")
If ($vb_altNames)
OB SET($vo_req; "req_extensions"; "req_ext")
End if
OB SET($vo_req; "distinguished_name"; "dn")
OB SET($result; "req"; $vo_req)
CLEAR VARIABLE($vo_req)
OB SET($result; "dn"; $vo_dn)
CLEAR VARIABLE($vo_dn)
If ($vb_altNames)
OB SET($vo_reqExt; "subjectAltName"; "@alt_names")
OB SET($result; "req_ext"; $vo_reqExt)
CLEAR VARIABLE($vo_reqExt)
OB SET($result; "alt_names"; $vo_altNames)
End if
//---------------------------
//MARK:Utilitaires
//---------------------------
Function csrReqConfObjectToText($vo_csr : Object)->$result : Text
var $vt_endLine : Text
ASSERT(Count parameters>0; "requires 1 parameter")
ASSERT(OB Is defined($vo_csr); "$1 should be defined")
$result:=""
If (Is Windows)
$vt_endLine:="\r\n"
Else
$vt_endLine:="\n"
End if
$result:=This.csrReqConfObjectToTextSub($vo_csr; $vt_endLine)
Function csrReqConfObjectToTextSub($vo_object : Object; $vt_endLine : Text)->$result : Text
var $vl_properyIndex; $vl_propertyType : Integer
var $vt_propertyName : Text
ASSERT(Count parameters>0; "requires 1 parameter")
ASSERT(OB Is defined($vo_object); "$1 should be defined")
ASSERT(Length($vt_endLine)>0; "$2 endLine is empty")
$result:=""
If (OB Is defined($vo_object))
ARRAY TEXT($tt_propertyNames; 0)
ARRAY LONGINT($tl_propertyTypes; 0)
OB GET PROPERTY NAMES($vo_object; $tt_propertyNames; $tl_propertyTypes)
For ($vl_properyIndex; 1; Size of array($tl_propertyTypes))
$vl_propertyType:=$tl_propertyTypes{$vl_properyIndex}
$vt_propertyName:=$tt_propertyNames{$vl_properyIndex}
Case of
: ($vl_propertyType=Is boolean)
$result:=$result+$vt_propertyName+" = "+Choose(OB Get($vo_object; $vt_propertyName; $vl_propertyType); "yes"; "no")+$vt_endLine
: ($vl_propertyType=Is real)
$result:=$result+$vt_propertyName+" = "+String(OB Get($vo_object; $vt_propertyName; $vl_propertyType))+$vt_endLine
: ($vl_propertyType=Is text)
$result:=$result+$vt_propertyName+" = "+OB Get($vo_object; $vt_propertyName; $vl_propertyType)+$vt_endLine
: ($vl_propertyType=Is object)
$result:=$result+"["+$vt_propertyName+"]"+$vt_endLine
$result:=$result+This.csrReqConfObjectToTextSub(OB Get($vo_object; $vt_propertyName; $vl_propertyType); $vt_endLine)
$result:=$result+$vt_endLine
End case
End for
ARRAY TEXT($tt_propertyNames; 0)
ARRAY LONGINT($tl_propertyTypes; 0)
End if
Function textToFile($vt_filepath : Text; $vt_text : Text; $vt_encoding : Text)
//This function writes a text to a file (without any BOM)
var $vx_blob : Blob
ASSERT(Count parameters>1; "requires 2 parameters")
If (Count parameters=2)
$vt_encoding:="UTF-8"
End if
SET BLOB SIZE($vx_blob; 0)
CONVERT FROM TEXT($vt_text; $vt_encoding; $vx_blob)
ASSERT(ok=1; "convert text to blob failed with encoding \""+$vt_encoding+"\"")
If (ok=1)
BLOB TO DOCUMENT($vt_filepath; $vx_blob)
ASSERT(ok=1; "writing to file \""+$vt_filepath+"\" failed")
End if
SET BLOB SIZE($vx_blob; 0)
property trace : cs._Trace
property nomTache : Text:="MaintenanceSSL"
property Taches : Collection
Class extends $lectureCERT
Class constructor()
Super()
cs._composant.new().InstallerDonnéesHote()
This.trace:=cs._Trace.me
// -----------------------------
// MARK:Maintenance
// -----------------------------
Function FixerListeTaches()
// lister les tâches à exécuter
var $data : Object
This.Taches:=New collection
$data:=New object
$data.functionID:="GererCertificatSSL"
// démarrage à 6 h
$data.dateTache:=String(Current date; ISO date GMT; ?06:00:00?)
// toutes les jours
$data.période:=New object("jour"; 1; "seconde"; 0)
$data.initialiser:=(Storage.Host.Session_Etat ?? 6) // = vrai pour test en particulier
This.Taches.push(OB Copy($data))
This.trace.EnvoyerMessages([msgk_event]; "Maintenance"; Current method name; "tâche 'GererCertificatSSL' programmée (voir détails dans Logs)")
This.trace.EnvoyerMessages([msgk_log]; "Maintenance GererCertificatSSL"; Current method name; JSON Stringify($data))
Function Demarrer()
// exécuter dans un process externe
var $data : Object
var $numProc : Integer
Case of
: (Not(Storage.System.estServeur) & (Not(Storage.Host.Session_Etat ?? 6)))
// serveur APP (ou HTTP pour test) seul uniquement, ou mode debug
Else
$data:=New object
$data.functionID:="SuperviserLesTaches"
$data.nomTache:=This.nomTache
$data.numProcessAppelant:=-1
$numProc:=Exécuter Function Préemptive(cs._maintenance; $data)
End case
Function Arreter()
var $nomTache : Text
$nomTache:=This.nomTache
cs.xSDK.RegistreTaches.new().Tuer($nomTache)
This.trace.EnvoyerMessages([msgk_event; msgk_log]; "Maintenance"; Current method name; "Arrêt du monitoring")
Function SuperviserLesTaches($data : Object)
// gérer les tâches de la maintenance des certificats SSL
var $tâche : Object
var $nbre : Integer
// attendre la fin du démarrage de l'hôte ...
Waiting(60*30)
This.trace.EnvoyerMessages([msgk_event; msgk_log]; "Maintenance"; Current method name; "Démarrage du monitoring")
This.FixerListeTaches()
// lancer le monitoring des tâches
Repeat
For each ($tâche; This.Taches)
Case of
: (Not(OB Is defined($tâche; "functionID")))
: (Not(OB Is defined($tâche; "dateTache")))
: (Not(OB Is defined($tâche; "initialiser")))
: (Not(($tâche.initialiser) | (String(Current date; ISO date GMT; Current time)>$tâche.dateTache)))
// attendre
Else
// ok, on a tout pour cette tâche
This[$tâche.functionID]($data.tache)
// date de la prochaine maintenance
// nombre de jours
// . on peut avoir rater des périodes ; combien?
$nbre:=Current date-Date($tâche.dateTache)
// . ajouter la période
$nbre:=$nbre+$tâche.période.jour+((Time($tâche.dateTache)+$tâche.période.seconde)\(24*3600))
// . nouvelle date (au cas où, on se resynchronise aussi sur l'heure)
$tâche.dateTache:=String(Add to date(Date($tâche.dateTache); 0; 0; $nbre); ISO date GMT; Time(Current time+$tâche.période.seconde))
$tâche.initialiser:=False
End case
End for each
// *** attendre la période suivante
Waiting(60*60)
Until ($data.tache.partage.Tuer.signaled)
This.trace.EnvoyerMessages([msgk_event; msgk_log]; "Maintenance"; Current method name; "Fin du monitoring")
// -----------------------------
// MARK:Certificat
// -----------------------------
Function GererCertificatSSL($params : Object)
var $c : Collection
var $texte : Text
This.trace.EnvoyerMessages([msgk_event; msgk_log]; "Maintenance"; Current method name; "Démarrage du traitement")
// lister les certificats à tester
$c:=Folder(fk resources folder; *).folder("SSL").folders().extract("name")
For each ($texte; $c)
$params.nomDossierSSL:=$texte
This.getInformations($params)
Case of
: (Not(OB Is defined($params; "infos")))
: ($params.infos=Null)
: (Not($params.infos.Production.exists))
This.trace.EnvoyerMessages([msgk_event; msgk_log; msgk_mail]; "Maintenance"; Current method name; "Le certificat '"+$texte+"' n'existe pas")
: ($params.infos.Production.aRenouveler)
This.trace.EnvoyerMessages([msgk_event; msgk_log; msgk_mail]; "Maintenance"; Current method name; "Le certificat '"+$texte+"' doit être renouvelé (date limite = "+$params.infos.Production.UTC+")")
: ($params.infos.Production.Invalide)
This.trace.EnvoyerMessages([msgk_event; msgk_log; msgk_mail]; "Maintenance"; Current method name; "Le certificat '"+$texte+"' est invalide (date expirée = "+$params.infos.Production.UTC+")")
End case
End for each
ON ERR CALL(Formula(traceHandler).source; ek global)
cs._composant.new().InitVariablesSSL()
CALL WORKER("WK_Composant_SSL"; Formula(initProcess).source)
// ne s'exécute pas dans une base hôte
// exporter le code du composant si pas compilé
ON ERR CALL(Formula(traceHandler).source; ek local)
cs.xSDK.ExportCode4D.new().DémarrerComposant()
#DECLARE($event : Integer)
Case of
: ($event=On before host database startup)
// ici pas d'interaction avec les autres composants et la BDDmère
ON ERR CALL(Formula(ErrorHandler).source; ek local)
cs._composant.new().InitVariablesSSL()
Use (Storage.System)
Storage.System.estExecuteDansHote:=True
End use
// installer les ressources du composant
// rien ici
// déactiver les ASSERT si le composant est compilé (réactivable par les options d'appel du composant)
SET ASSERT ENABLED(Not(Is compiled mode))
CALL WORKER("WK_Composant_SSL"; Formula(initProcess).source)
: ($event=On after host database startup)
// à faire ici tout est initialisé, en particulier le monde extérieur
ON ERR CALL(Formula(traceHandler).source; ek global)
cs._composant.new().Installer()
// lancer la maintenance
cs._maintenance.new().Demarrer()
: ($event=On before host database exit)
// placer ici le code à exécuter avant le "Sur fermeture" de la base hôte
// arrêter la maintenance
cs._maintenance.new().Arreter()
: ($event=On after host database exit)
// placer ici le code à exécuter après le "Sur fermeture" de la base hôte
End case