Projet TOTP - code non fonctionnel demande d'aide

Codes specifiques à Windows
Avatar de l’utilisateur
caussatjerome
Messages : 50
Inscription : lun. 24/sept./2012 20:57
Localisation : Somme

Projet TOTP - code non fonctionnel demande d'aide

Message par caussatjerome »

Bonjour la communauté Purebasic !

Je viens vers la communauté car je bloque depuis un moment sur la création d'une fonction de génération de code à usage unique "TOTP" (norme très présente maintenant sur divers sites et services)
le fameux codes valide 30 secondes et générer depuis les application "Google Authenticator" ou "Microsoft Authenticator" pour ne cité qu'eux.

Pour mes tests, j'ai installer l'application Google Auth, inventer une clé secrète et tester avec l'application et divers services en ligne la génération pour pouvoir ensuite comparer les résultats avec mon code source.
la clé secrète est : "HOTPTESTSUPERSECRET"
en base32 cela donne (norme d'affichage et de stockage pour tous les services) : "JBHVIUCUIVJVIU2VKBCVEU2FINJEKVA="

voici un site qui permet directement de générer un code valide :
"https://cable.ayra.ch/totp/#{%22c%22:%2 ... ,%22d%22:6}"

Voici les divers sites, sources que j'ai pu trouver :
https://www.purebasic.fr/english/viewto ... tp#p538931

(code de 2019, ne donne pas le bon résultat comparé à google auth ou le site cable.ayra.ch ci-dessus)

https://www.unixtime.fr/
https://blog.cybercod.com/2014/05/25/hotp-et-totp/
https://dumas.ccsd.cnrs.fr/dumas-02023261/document
https://www.ionos.fr/digitalguide/serve ... rite/totp/
https://fr.wikipedia.org/wiki/Mot_de_pa ... r_le_temps

Si une âme charitable veut bien m'aider ?



base32.pbi :

Code : Tout sélectionner

;site de test : https://www.dcode.fr/code-base-32
Procedure.s text_to_bin(texte.s)
Protected a.l,binaire.s
For a=1 To Len(texte.s)
binaire.s+RSet(Bin(Asc(Mid(texte.s,a,1)),#PB_Byte),8,"0")
Next a.l
ProcedureReturn binaire.s
EndProcedure

Procedure.s Bin_to_text(binaire.s)
Protected a.l,sortie.s
For a=1 To Len(binaire.s) Step 8
sortie.s+Chr(Val("%"+Mid(binaire.s,a,8)))
Next a.l
ProcedureReturn sortie.s
EndProcedure

Procedure.s Base32Encode(text.s)
  Protected table.s = "ABCDEFGHIJKLMNOPQRSTUVWXYZ234567"
  Protected conv_binaire.s,a.l,b.l,scinder_cinq_bits.s,output.s
  conv_binaire.s=text_to_bin(text.s)
  For a.l=1 To Len(conv_binaire.s) Step 5
  scinder_cinq_bits.s=LSet(Mid(conv_binaire.s,a,5),5,"0")
  decimal.l=Val("%"+scinder_cinq_bits)+1
  output.s+Mid(table.s,decimal.l,1)
Next a
While Not Len(output.s) % 8 =0
output.s+"="
Wend
ProcedureReturn output.s
EndProcedure

Procedure.s Base32Decode(text.s)
  Protected base.s=RemoveString(text.s,"="),table.s = "ABCDEFGHIJKLMNOPQRSTUVWXYZ234567"
  Protected a.l,car.s,decimal.l,vb.s
  For a.l=1 To Len(base.s)
    car.s=Mid(base.s,a,1)
    decimal.l=FindString(table.s,car.s)-1
    chainebinaire.s+RSet(Bin(decimal.l),5,"0")
  Next a.l
  chainebinaire.s=Left(chainebinaire.s,Len(chainebinaire.s)-(Len(chainebinaire.s)%8))
  output.s=Bin_to_text(chainebinaire.s)
  ProcedureReturn output.s
EndProcedure

; Exemple d'utilisation
;encoded.s = Base32Encode("HOTPTESTSUPERSECRET")
;Debug "Texte encodé en base32 :"+ encoded.s
;decoded.s= Base32Decode(encoded.s)
;Debug "Base32 en Texte :"+decoded.s
;encoded.s = Base32Encode("Hello World!")
;Debug "Texte encodé en base32 :"+ encoded.s
;decoded.s= Base32Decode(encoded)
;Debug "Base32 en Texte :"+decoded.s
Dernière modification par caussatjerome le mar. 27/juin/2023 23:31, modifié 2 fois.
Avatar de l’utilisateur
caussatjerome
Messages : 50
Inscription : lun. 24/sept./2012 20:57
Localisation : Somme

Re: Projet TOTP

Message par caussatjerome »

hmac_fonctions.pbi : (le code de base n'était pas de moi, je l'ai modifié)

Code : Tout sélectionner

EnableExplicit
;    HMAC function implementation
;   2016         (c) Luna Sole


; convert hex string into raw bytes
; Out()      unsigned char array to receive result
; Hex$      string with hex data
; RETURN:   decimal value is placed to Out() array
Procedure Hex2Dec(Array Out.a (1), Hex$)
   Protected i2, max = Len(Hex$)
   ReDim Out((max + 1) / 2)
   For i2 = 1 To max Step 2
      Out(i2 / 2) = Val("$" + Mid(Hex$, i2, 2))
   Next i2
EndProcedure

; generates HMAC signature for specified message and key
; NOTE:         This function forces strings conversion to ASCII, both for key and message
;             I'm not sure how right to do that, but let it be for now (I don't want to do a painful debug of unicode version also ^^)
; PB_Cipher      what hashing to use (MD5, SHA1, SHA256 and some others)
; Message$      data to hash
; Key$         a very secret key
; RETURN:      string, representing HMAC hash
Procedure$ StringHMAC(PB_Cipher, Message$, Key$)
   UseMD5Fingerprint() : UseSHA1Fingerprint() : UseSHA2Fingerprint() : UseSHA3Fingerprint(); currently only verified with these algorithms
   #HMAC_BLOCKSIZE = 64 ; blocksize is 64 (bytes) when using one of the following hash functions: SHA-1, MD5, RIPEMD-128/160.

   ; First of all, convert key from string to binary
   ; If key is longer than block size, replace it with hash(key)
   Protected Dim key_bdata.a (#HMAC_BLOCKSIZE)
   If (StringByteLength(Key$, #PB_Ascii) > #HMAC_BLOCKSIZE)
      PokeS(@key_bdata(0), StringFingerprint(Key$, PB_Cipher), -1, #PB_Ascii | #PB_String_NoZero)
   Else
      PokeS(@key_bdata(0), Key$, -1, #PB_Ascii | #PB_String_NoZero)
   EndIf
   
   ; Now introduce o_key_pad/i_key_pad and XOR them with some magic numbers
   Protected Dim i_key_pad.a (0)
   Protected Dim o_key_pad.a (0)
   Protected Tmp
   CopyArray(key_bdata(), i_key_pad())
   CopyArray(key_bdata(), o_key_pad())
   For Tmp = 0 To #HMAC_BLOCKSIZE
      i_key_pad(Tmp) ! $36
      o_key_pad(Tmp) ! $5c
   Next Tmp
   
   ; At last, start hashing
   Protected Hash_i$, Hash_o$         ; there are two steps, those variables storing result for step 1 and 2
   Protected hHash                  ; handle to initiated hash routine
   Protected Dim TempRaw.a (0)         ; a temporary buffer for data transfer
   
   ; First, hash using i_key_pad() and data
   ReDim TempRaw(StringByteLength(Message$, #PB_Ascii))
   PokeS(@TempRaw(0), Message$, -1, #PB_Ascii | #PB_String_NoZero)
   hHash = StartFingerprint (#PB_Any, PB_Cipher)
   AddFingerprintBuffer (hHash, @i_key_pad(0), #HMAC_BLOCKSIZE)
   If ArraySize(TempRaw())
      AddFingerprintBuffer (hHash, @TempRaw(0), ArraySize(TempRaw()))
   EndIf
   Hash_i$ = FinishFingerprint(hHash)
   
   ; Finally, hash once more using o_key_pad() + result of previous hashing
   Hex2Dec(TempRaw(), Hash_i$)
   hHash = StartFingerprint (#PB_Any, PB_Cipher)
   AddFingerprintBuffer (hHash, @o_key_pad(0), #HMAC_BLOCKSIZE)
   AddFingerprintBuffer (hHash, @TempRaw(0), ArraySize(TempRaw()))
   Hash_o$ = FinishFingerprint(hHash)
   
   ProcedureReturn Hash_o$
EndProcedure
DisableExplicit

;Debug "* HMAC of control data to check is it OK *"
;Debug "MD5:   "+StringHMAC(#PB_Cipher_MD5,  "The quick brown fox jumps over the lazy dog", "Secret") ; MD5 = 0x80070713463e7749b90c2dc24911e275
;Debug "SHA1:  "+StringHMAC(#PB_Cipher_SHA1, "The quick brown fox jumps over the lazy dog", "Secret")   ; SHA1 = 0xde7c9b85b8b78aa6bc8a7a36f70a90701c9db4d9
;Debug "SHA2:  "+StringHMAC(#PB_Cipher_SHA2, "The quick brown fox jumps over the lazy dog", "Secret")   ; SHA256 = 0xf7bc83f430538424b13298e6aa6fb143ef4d59a14946175997479dbc2d1a3cd8
;Debug "SHA3:  "+StringHMAC(#PB_Cipher_SHA3, "The quick brown fox jumps over the lazy dog", "Secret")   ; 
;Debug "* fin *"

; Control data and resulting HMAC-hashes for it taken from wiki page:
;     https://en.wikipedia.org/wiki/Hash-based_message_authentication_code#Examples
Avatar de l’utilisateur
caussatjerome
Messages : 50
Inscription : lun. 24/sept./2012 20:57
Localisation : Somme

Re: Projet TOTP

Message par caussatjerome »

mon code qui ne donne pas le résultat valide :

Code : Tout sélectionner

;https://www.ionos.fr/digitalguide/serveur/securite/totp/
;https://chat.openai.com/c/2858755d-577b-4a13-a2e0-4b1e2e9643cc
;https://www.unixtime.fr/
;https://www.cyberforum.ru/pure-basic/thread2714737.html
;https://grafikart.fr/tutoriels/authentification-2-facteurs-totp-630
;https://blog.cybercod.com/2014/05/25/hotp-et-totp/
;https://dumas.ccsd.cnrs.fr/dumas-02023261/document
;https://fr.wikipedia.org/wiki/Mot_de_passe_%C3%A0_usage_unique_bas%C3%A9_sur_le_temps

XIncludeFile "base32.pbi"
XIncludeFile "hmac_fonctions.pbi"

Procedure.s hex2dec2(entrer.s);-string.s=hex2asc("54657374")
Protected sortie.s,a.l
For a = 1 To Len(entrer.s) Step 2
sortie.s+Str(Val("$"+Mid(entrer.s,a,2)))
Next a
ProcedureReturn sortie.s
EndProcedure

Procedure.s hex2asc(entrer.s);-string.s=hex2asc("54657374")
Protected sortie.s,a.l
For a = 1 To Len(entrer.s) Step 2
sortie.s+Chr(Val("$"+Mid(entrer.s,a,2)))
Next a
ProcedureReturn sortie.s
EndProcedure

Procedure.s ASC2HEX(entrer.s);-hexa.s=asc2hex("Test")
Protected sortie.s,a.l
For a=1 To Len(entrer.s)
sortie.s + Hex(Asc(Mid(entrer.s,a,1)))
Next a
ProcedureReturn sortie.s
EndProcedure

Procedure.s GenerateTOTP(secretKey.s, timePeriod.i, hashAlgorithm.l)

  ; Conversion de la clé secrète en une clé utilisable
  Protected key.s
  key = Base32Decode(secretKey)
  Debug "secret key décoder :"+key

  ; Conversion du temps actuel en un compteur basé sur la période de temps
  counter.s = Str(Date()/timePeriod)

  ; Conversion du compteur en une chaîne de bytes (8 octets) en big endian
  counterBytes = Val(counter)

  ; Calcul du HMAC en utilisant la fonction de hachage et la clé secrète
  hmacDigest.s = StringHMAC(hashAlgorithm.l,key.s,counter.s)

  ; Décodage du HMAC pour obtenir la valeur en entier
  hmacValue = Val(hex2dec2(hmacDigest.s))

  ; Troncature du HMAC pour obtenir un code TOTP de 6 chiffres
  totp = hmacValue % 1000000

  ; Formattage du code TOTP avec des zéros de remplissage
  totpFormatted.s = LSet(Str(totp),6,"0")

  ProcedureReturn totpFormatted
EndProcedure

; Clé secrète partagée entre l'utilisateur et le système de validation
secretKey.s = "JBHVIUCUIVJVIU2VKBCVEU2FINJEKVA="
; Période de temps fixe en secondes
timePeriod.i = 30
; Fonction de hachage utilisée (SHA1, SHA256, etc.)
hashAlgorithm.l = #PB_Cipher_SHA1

; Génération du code TOTP actuel
currentTOTP.s = GenerateTOTP(secretKey, timePeriod, hashAlgorithm)
Debug "Code TOTP actuel :"+ currentTOTP

; Vérification du code TOTP
userProvidedTOTP.s=InputRequester("TOTP test :","Veuillez entrer le code TOTP actuel :","")

If userProvidedTOTP = currentTOTP
  Debug "Code TOTP valide. Authentification réussie !"
Else
  Debug "Code TOTP invalide. Authentification échouée."
EndIf
Avatar de l’utilisateur
caussatjerome
Messages : 50
Inscription : lun. 24/sept./2012 20:57
Localisation : Somme

Re: Projet TOTP - code non fonctionnel demande d'aide

Message par caussatjerome »

autre code pour tacher de mieux comprendre mes erreurs :

Code : Tout sélectionner

XIncludeFile "base32.pbi"
XIncludeFile "hmac_fonctions.pbi"

Procedure.s GenerateTOTP(secretKey.s, timePeriod.l, hashAlgorithm.l, timeset.l=0,seckey_attendu.s="",hmac_attendu.s="",counter_attendu.s="",hmac_attendu_trunc.s="",totp_attendu.s="")

  ; Conversion de la clé secrète en une clé utilisable
  Protected key.s
  key = Base32Decode(secretKey)
  Debug key.s
  Debug "ou"
  Debug "secret key décoder :"+LCase(Base32DecodeHEX(secretKey))
  Debug "attendu en test :"+seckey_attendu.s
  
  ; Conversion du temps actuel en un compteur basé sur la période de temps
  If timeset.l=0:timeset.l=Date():EndIf
  
  counter.s = Str(timeset.l/timePeriod)
  Debug "counter (TC) :"+counter.s
  Debug "attendu en test :"+counter_attendu.s

  ; Calcul du HMAC en utilisant la fonction de hachage et la clé secrète
  hmacDigest.s = StringHMAC(hashAlgorithm.l,counter.s,key.s)
  Debug "hmac obtenu :"+hmacDigest.s
  Debug "attendu en test :"+hmac_attendu.s
    
  ; Troncature du HMAC pour obtenir un code TOTP de 6 chiffres
  ;pas sure de comprendre le principe du dynamic truncation.. de la source 1 :
  hmac_trunc.s=Mid(hmacDigest,21,8)+Right(hmacDigest,2)
  Debug "hmac trunc obtenu :"+hmac_trunc.s
  Debug "attendu en test :"+hmac_attendu_trunc.s
  
  ;le rest je teste pas encore...
  totp = Val(hmacValue.s) % 1000000
  Debug "totp : "+Str(totp)
  Debug "attendu en tes :"+totp_attendu.s

  ; Formattage du code TOTP avec des zéros de remplissage
  totpFormatted.s = LSet(Str(totp),6,"0")

  ProcedureReturn totpFormatted
EndProcedure

  
Debug "test 1 :"
Debug "source 1 : https://blog.cybercod.com/2014/05/25/hotp-et-totp/"
secretkey.s="LVACVMXXD4AIPVLFZ6QL337GS2MM7X5Y"
enexadoitdonner.s="5d402ab2f71f0087d565cfa0bdefe69698cfdfb8"
heuretestunix.l=1400320015
tc_attendu.s="46677333"
tc_converti_hexa.s="2C83D55"
sur_huit_contets.s="0000000002C83D55"
fonctionhamc_doit_donner.s="e562f2dadefc81a384551c3278d5ec42417ab4da"
hmac_trunc_attendu.s="1c3278d5"
totp_attendu.s="069781"
GenerateTOTP(secretkey.s,30,#PB_Cipher_SHA1,heuretestunix.l,enexadoitdonner.s,fonctionhamc_doit_donner.s,tc_attendu,hmac_trunc_attendu,totp_attendu)

Debug "----------------------------------------"
Debug "test 2 :"
Debug "source 2 : https://www.ionos.fr/digitalguide/serveur/securite/totp/"
;Debug base32encode(">cHSB_UQ#O5m;~b")
secretkey.s="HZRUQU2CL5KVCI2PGVWTW7TC"
enexadoitdonner.s="3E634853425F5551234F356D3B7E62"
heuretestunix.l=1548322860
tc_attendu.s="51610762"
tc_converti_hexa.s="313848A"
sur_huit_contets.s="000000000313848A"
fonctionhamc_doit_donner.s="c0623794dd377a3af09122081f216f9b174b1745"
hmac_trunc_attendu.s="1c3278d5"
totp_attendu.s="757360"
GenerateTOTP(secretkey.s,30,#PB_Cipher_SHA1,heuretestunix.l,enexadoitdonner.s,fonctionhamc_doit_donner.s,tc_attendu,hmac_trunc_attendu,totp_attendu)

Mesa
Messages : 1093
Inscription : mer. 14/sept./2011 16:59

Re: Projet TOTP - code non fonctionnel demande d'aide

Message par Mesa »

J'ai testé le code plusieurs fois et il me donne parfois un code négatif parfois un code positif.
Quand le code est positif, tout fontionne bien.

1) Je pencherais donc pour un problème de typage de données, d'autant plus que t'utilises des .l, ce qui n'est pas conseillé par Fred.
De plus PureBasic n'utilise que des integer signés et pour avoir des integer non signés (ce qui est peut être nécessaire ici), on peut utiliser des quad .q
Essaie de tout transformer en .q pour voir.

2) J'ai vu qu'il y avait une division "entière" par 30 dans une procedure, es-tu sûr que le résultat ne donne jamais un nombre à virgule ?

3) Il y a aussi beaucoup de calculs avec des strings comme argument. PureBasic utilise par défaut UTF8, qui code certains caractères sur 1 octet et d'autres sur 2 octets ce qui pourrait occasionner des erreurs. Essaie de tout mettre en ascii ou tout en unicode pour voir.

Voilà.

M.
holzhacker
Messages : 1
Inscription : ven. 18/août/2023 20:13

Re: Projet TOTP - code non fonctionnel demande d'aide

Message par holzhacker »

Bonjour!

J'ai vu ce code sur le forum B4X (android), je l'ai testé et ça marche (au moins PHP et Android).

J'espère que cela aide, malheureusement je n'ai pas de projets écrits en PB pour l'instant, je me suis souvenu de ce sujet ici sur le forum PB et je voulais aider, si c'est utile, partager le résultat.

Code : Tout sélectionner

function GetOTP($otpsecret)
{
    
    $secret_seed = bin2hex(Base64_Decode($otpsecret)) ;
    //$secret_seed = bin2hex('Test');

    // Determine the time window
    $time_window = 30;

    // Get the exact time from the server
    //$exact_time = 48958981; //microtime(true);
    $exact_time = time(); //microtime(true);

    // Round the time down to the time window
    $rounded_time = floor($exact_time/$time_window);

    // Pack the counter into binary
    $packed_time = pack("N", $rounded_time);

    // Make sure the packed time is 8 characters long
    $padded_packed_time = str_pad($packed_time,8, chr(0), STR_PAD_LEFT);

    // Pack the secret seed into a binary string
    $packed_secret_seed = pack("H*", $secret_seed);

    // Generate the hash using the SHA1 algorithm
    $hash = hash_hmac ('sha1', $padded_packed_time, $packed_secret_seed, true);

    // Extract the 6 digit number fromt the hash as per RFC 6238
    $offset = ord($hash[19]) & 0xf;
    $otp = (
        ((ord($hash[$offset+0]) & 0x7f) << 24 ) |
        ((ord($hash[$offset+1]) & 0xff) << 16 ) |
        ((ord($hash[$offset+2]) & 0xff) << 8 ) |
        (ord($hash[$offset+3]) & 0xff)
    ) % pow(10, 6);

    // Add any missing zeros to the left of the numerical output
    $otp = str_pad($otp, 6, "0", STR_PAD_LEFT);

   
    return $otp;

}
Article original contenant du code pour Android (b4a):

https://www.b4x.com/android/forum/threa ... ed.130169/
BarJo
Messages : 6
Inscription : jeu. 08/juil./2021 18:08

Re: Projet TOTP - code non fonctionnel demande d'aide

Message par BarJo »

Voici un code qui fonctionne et que j'utilise.

GenerateOTP.pb (code que j'ai fait à l'aide d'info trouvé sur le net)

Code : Tout sélectionner

XIncludeFile "include\hmac2.pb"
XIncludeFile "include\inc.base32.pbi"

ImportC "":time(*tloc = #Null):EndImport ;unix timestamp crossplattform 

Procedure.l Reverse(*ptr,length=8) ;pack Quad
  Define *mem=AllocateMemory(length)
  CopyMemory(*ptr+3,*mem+4,1)
  CopyMemory(*ptr+2,*mem+5,1)
  CopyMemory(*ptr+1,*mem+6,1)
  CopyMemory(*ptr+0,*mem+7,1)  
  ProcedureReturn *mem
EndProcedure

Procedure.s GenerateOTP(secrect$,digits=6,interval=30,nextkey=0)
  Protected OTP=0, modNumber=0, offset=0, FullOtp=0
  Protected Dim HashByteArray.a (0)  
  Protected secretbase32Hex$=base32Encode(secrect$,"hex") ;create base32 Hex String
  Protected SecretLen=Len(secretbase32Hex$)/2             ;size byte array
  Protected Dim Secret.a (0) 
  ReDim Secret(SecretLen)
  Hex2Dec(Secret(), secretbase32Hex$) ;create byte array from string
                                      ;ShowMemoryViewer(@Secret(),SecretLen)
  Protected timestamp=((time()+(nextkey * interval))/interval)
  ;Debug time()
  Protected *timestamp=Reverse(@timestamp)
  Protected signature$ = hmac_sha1binMod(@Secret(),SecretLen, *timestamp,8)
  ;ShowMemoryViewer(*timestamp,8)
  FreeMemory(*timestamp)
  ;Debug "signature$: " + signature$
  Protected len=Len(signature$)/2
  ReDim  HashByteArray(len)
  Hex2Dec(HashByteArray(), signature$)
  
  offset= HashByteArray(ArraySize(HashByteArray())-1) & $F
  FullOtp=(HashByteArray(offset) & $7f) * Pow(2, 24)
  FullOtp = FullOtp + (HashByteArray(offset + 1) & $ff) * Pow(2, 16)
  FullOtp = FullOtp + (HashByteArray(offset + 2) & $ff) * Pow(2, 8)
  FullOtp = FullOtp + (HashByteArray(offset + 3)  & $ff)
  modNumber = Pow(10, digits)
  OTP= FullOtp % modNumber
  ProcedureReturn RSet(Str(OTP), digits,"0")
EndProcedure

; Clé privé fournie par l'application securisé
Define key.s = "JBSWY3DPEHPK3PXP"

key = ReplaceString(key, "-", "")
key = UCase(key)

CodeLen = 6
interval = 30
nb = 5

For i = 0 To nb
  timestamp = (time()+(i * interval))
  sec.s = Right(FormatDate("%dd.%mm.%yyyy %hh:%ii:%ss", timestamp ),2)
  
  If Val(sec) >= 30
    timestamp = timestamp - Val(sec) + 30
    sec = "30"
  Else
    timestamp = timestamp - Val(sec) 
    sec = "00"
  EndIf
  time.s = Left(FormatDate("%dd.%mm.%yyyy %hh:%ii:%ss", timestamp ),17) + sec
  ;timestamp = (time()+(i * interval))
  Debug GenerateOTP(key,CodeLen,interval,i) +" => " + time  +" => " + timestamp
Next

;Debug GenerateOTP(key,6,30,1)
;Debug GenerateOTP(key,6,30,2)

hmac2.pb (qui n'est pas de moi, je remercie son créateur dont j'ignore le nom)

Code : Tout sélectionner

;EnableExplicit
;    HMAC function implementation
;   2016         (c) Luna Sole

UseMD5Fingerprint() : UseSHA1Fingerprint() : UseSHA2Fingerprint() ; currently only verified with these algorithms


; convert hex string into raw bytes
; Out()      unsigned char array to receive result
; Hex$      string with hex data
; RETURN:   decimal value is placed to Out() array
Procedure Hex2Dec (Array Out.a (1), Hex$)
  Protected i2, max = Len(Hex$)
  ReDim Out((max + 1) / 2)
  For i2 = 1 To max Step 2
    Out(i2 / 2) = Val("$" + Mid(Hex$, i2, 2))
  Next i2
EndProcedure

; generates HMAC signature for specified message and key
; NOTE:         This function forces strings conversion to ASCII, both for key and message
;             I'm not sure how right to do that, but let it be for now (I don't want to do a painful debug of unicode version also ^^)
; PB_Cipher      what hashing to use (MD5, SHA1, SHA256 and some others)
; Message$      data to hash
; Key$         a very secret key
; RETURN:      string, representing HMAC hash
Procedure$ StringHMAC (PB_Cipher, Message$, Key$)
  
  #HMAC_BLOCKSIZE = 64 ; blocksize is 64 (bytes) when using one of the following hash functions: SHA-1, MD5, RIPEMD-128/160.
  
  ; First of all, convert key from string to binary
  ; If key is longer than block size, replace it with hash(key)
  Protected Dim key_bdata.a (#HMAC_BLOCKSIZE)
  If (StringByteLength(Key$, #PB_Ascii) > #HMAC_BLOCKSIZE)
    PokeS(@key_bdata(0), StringFingerprint(Key$, PB_Cipher), -1, #PB_Ascii | #PB_String_NoZero)
  Else
    PokeS(@key_bdata(0), Key$, -1, #PB_Ascii | #PB_String_NoZero)
  EndIf
  
  ; Now introduce o_key_pad/i_key_pad and XOR them with some magic numbers
  Protected Dim i_key_pad.a (0)
  Protected Dim o_key_pad.a (0)
  Protected Tmp
  CopyArray(key_bdata(), i_key_pad())
  CopyArray(key_bdata(), o_key_pad())
  For Tmp = 0 To #HMAC_BLOCKSIZE
    i_key_pad(Tmp) ! $36
    o_key_pad(Tmp) ! $5c
  Next Tmp
  
  ; At last, start hashing
  Protected Hash_i$, Hash_o$         ; there are two steps, those variables storing result for step 1 and 2
  Protected hHash                    ; handle to initiated hash routine
  Protected Dim TempRaw.a (0)        ; a temporary buffer for data transfer
  
  ; First, hash using i_key_pad() and data
  ReDim TempRaw(StringByteLength(Message$, #PB_Ascii))
  PokeS(@TempRaw(0), Message$, -1, #PB_Ascii | #PB_String_NoZero)
  hHash = StartFingerprint (#PB_Any, PB_Cipher)
  AddFingerprintBuffer (hHash, @i_key_pad(0), #HMAC_BLOCKSIZE)
  If ArraySize(TempRaw())
    AddFingerprintBuffer (hHash, @TempRaw(0), ArraySize(TempRaw()))
  EndIf
  Hash_i$ = FinishFingerprint(hHash)
  ; Finally, hash once more using o_key_pad() + result of previous hashing
  Hex2Dec(TempRaw(), Hash_i$)
  hHash = StartFingerprint (#PB_Any, PB_Cipher)
  AddFingerprintBuffer (hHash, @o_key_pad(0), #HMAC_BLOCKSIZE)
  AddFingerprintBuffer (hHash, @TempRaw(0), ArraySize(TempRaw()))
  Hash_o$ = FinishFingerprint(hHash)
  
  ProcedureReturn Hash_o$
EndProcedure

;Mod to handle binary data
Procedure.s hmac_sha1binMod(*SecretByteArray, SecretLen,*msg,msglen, blocksize.i=64, opad.a=$5C, ipad.a=$36) 
  Protected.i KeyLength, x
  Protected Result$, i_key$
  Protected *key, *o_key_pad, *i_key_pad, *i, *o
  
  KeyLength = SecretLen
  ;Debug "KeyLength: " + KeyLength
  If KeyLength > blocksize
    *key = AllocateMemory(KeyLength)
  ElseIf KeyLength < blocksize
    *key = AllocateMemory(blocksize)
  EndIf
  
  If *key
    CopyMemory(*SecretByteArray,*key,KeyLength)
    ;ShowMemoryViewer(*key,blocksize)
    *o_key_pad = AllocateMemory(blocksize, #PB_Memory_NoClear)
    If *o_key_pad
      For x = 0 To blocksize - 1
        PokeA(*o_key_pad + x, PeekA(*key + x) ! opad)
      Next x
      
      *i_key_pad = AllocateMemory(blocksize, #PB_Memory_NoClear)
      If *i_key_pad
        For x = 0 To blocksize - 1
          PokeA(*i_key_pad + x, PeekA(*key + x) ! ipad)
        Next x
        
        *i = AllocateMemory(blocksize + msglen)
        If *i
          CopyMemory(*i_key_pad, *i, blocksize)
          ;this work with bytes
          CopyMemory(*msg,*i + blocksize, msglen)
          ;ShowMemoryViewer(*msg,msglen)
          i_key$ = Fingerprint(*i, MemorySize(*i),#PB_Cipher_SHA1)
          FreeMemory(*i)
          
          *o = AllocateMemory(blocksize + 20)
          If *o
            CopyMemory(*o_key_pad, *o, blocksize)
            For x = 0 To 19
              PokeA(*o + blocksize + x, Val("$" + Mid(i_key$, x * 2 + 1, 2)))
            Next x
            
            Result$ = Fingerprint(*o, MemorySize(*o),#PB_Cipher_SHA1)
            FreeMemory(*o)
          EndIf
          
        EndIf
        FreeMemory(*i_key_pad)
      EndIf
      FreeMemory(*o_key_pad)
    EndIf
    FreeMemory(*key)
  EndIf
  ProcedureReturn Result$
EndProcedure

Procedure.s hmac_sha1(key$, msg$, blocksize.i=64, opad.a=$5C, ipad.a=$36)
  
  Protected.i KeyLength, x
  Protected Result$, i_key$
  Protected *key, *o_key_pad, *i_key_pad, *i, *o
  
  
  KeyLength = StringByteLength(key$, #PB_UTF8)
  If KeyLength > blocksize
    *key = AllocateMemory(KeyLength)
    If *key
      PokeS(*key, key$, -1, #PB_UTF8|#PB_String_NoZero)
      key$ = Fingerprint(*key, MemorySize(*key),#PB_Cipher_SHA1)
      FreeMemory(*key)
      KeyLength = StringByteLength(key$, #PB_UTF8)
      *key = AllocateMemory(KeyLength)
    EndIf
  ElseIf KeyLength < blocksize
    *key = AllocateMemory(blocksize)
  EndIf
  
  If *key
    PokeS(*key, key$, -1, #PB_UTF8|#PB_String_NoZero)
    
    *o_key_pad = AllocateMemory(blocksize, #PB_Memory_NoClear)
    If *o_key_pad
      For x = 0 To blocksize - 1
        PokeA(*o_key_pad + x, PeekA(*key + x) ! opad)
      Next x
      
      *i_key_pad = AllocateMemory(blocksize, #PB_Memory_NoClear)
      If *i_key_pad
        For x = 0 To blocksize - 1
          PokeA(*i_key_pad + x, PeekA(*key + x) ! ipad)
        Next x
        
        *i = AllocateMemory(blocksize + StringByteLength(msg$, #PB_UTF8))
        If *i
          CopyMemory(*i_key_pad, *i, blocksize)
          PokeS(*i + blocksize, msg$, -1, #PB_UTF8|#PB_String_NoZero)
          i_key$ = Fingerprint(*i, MemorySize(*i),#PB_Cipher_SHA1)
          FreeMemory(*i)
          
          *o = AllocateMemory(blocksize + 20)
          If *o
            CopyMemory(*o_key_pad, *o, blocksize)
            For x = 0 To 19
              PokeA(*o + blocksize + x, Val("$" + Mid(i_key$, x * 2 + 1, 2)))
            Next x
            
            Result$ = Fingerprint(*o, MemorySize(*o),#PB_Cipher_SHA1)
            FreeMemory(*o)
          EndIf
          
        EndIf
        FreeMemory(*i_key_pad)
      EndIf
      FreeMemory(*o_key_pad)
    EndIf
    FreeMemory(*key)
  EndIf
  
  ProcedureReturn Result$
  
EndProcedure




Procedure.s hmac_md5(key$, msg$, blocksize.i=64, opad.a=$5C, ipad.a=$36)
  
  Protected.i KeyLength, x
  Protected Result$, i_key$
  Protected *key, *o_key_pad, *i_key_pad, *i, *o
  
  
  KeyLength = StringByteLength(key$, #PB_UTF8)
  If KeyLength > blocksize
    *key = AllocateMemory(KeyLength)
    If *key
      PokeS(*key, key$, -1, #PB_UTF8|#PB_String_NoZero)
      key$ = Fingerprint(*key, MemorySize(*key),#PB_Cipher_MD5)
      FreeMemory(*key)
      KeyLength = StringByteLength(key$, #PB_UTF8)
      *key = AllocateMemory(KeyLength)
    EndIf
  ElseIf KeyLength < blocksize
    *key = AllocateMemory(blocksize)
  EndIf
  
  If *key
    PokeS(*key, key$, -1, #PB_UTF8|#PB_String_NoZero)
    
    *o_key_pad = AllocateMemory(blocksize, #PB_Memory_NoClear)
    If *o_key_pad
      For x = 0 To blocksize - 1
        PokeA(*o_key_pad + x, PeekA(*key + x) ! opad)
      Next x
      
      *i_key_pad = AllocateMemory(blocksize, #PB_Memory_NoClear)
      If *i_key_pad
        For x = 0 To blocksize - 1
          PokeA(*i_key_pad + x, PeekA(*key + x) ! ipad)
        Next x
        
        *i = AllocateMemory(blocksize + StringByteLength(msg$, #PB_UTF8))
        If *i
          CopyMemory(*i_key_pad, *i, blocksize)
          PokeS(*i + blocksize, msg$, -1, #PB_UTF8|#PB_String_NoZero)
          i_key$ = Fingerprint(*i, MemorySize(*i),#PB_Cipher_MD5)
          FreeMemory(*i)
          
          *o = AllocateMemory(blocksize + 16)
          If *o
            CopyMemory(*o_key_pad, *o, blocksize)
            For x = 0 To 15
              PokeA(*o + blocksize + x, Val("$" + Mid(i_key$, x * 2 + 1, 2)))
            Next x
            
            Result$ = Fingerprint(*o, MemorySize(*o),#PB_Cipher_MD5)
            FreeMemory(*o)
          EndIf
          
        EndIf
        FreeMemory(*i_key_pad)
      EndIf
      FreeMemory(*o_key_pad)
    EndIf
    FreeMemory(*key)
  EndIf
  
  ProcedureReturn Result$
  
EndProcedure
inc base32.pbi (idem pour celui-ci)

Code : Tout sélectionner

Procedure.s base32decode(in1.s)
  keyStr$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ234567="
  For i = 1 To Len(in1)
   vvll=FindString(keyStr$,Mid(in1,i,1))-1
    If vvll >= 0 And vvll < 32
      buffer << 5;
      buffer | vvll;
      bitsLeft + 5;
      If bitsLeft >= 8
        dStr$ + Chr((buffer >> (bitsLeft - 8)) & 255); + $FF;
        bitsLeft - 8                                    
      EndIf            
    EndIf      
  Next   
  ProcedureReturn dStr$
EndProcedure

Procedure.s base32Encode(base32$,outputFormat$="bin") ;encode base32 string; outputFormat$ bin/hex
  
  Protected key$="ABCDEFGHIJKLMNOPQRSTUVWXYZ234567", output$=""
  Protected i=0, buffer=0, bitsLeft=0
  
  While i < Len(base32$)
    val=FindString(key$,Mid(base32$,i+1,1))-1
    If  val>=0 And val<32
      buffer= (buffer << 5 ) | val
      bitsLeft=bitsLeft+5
      If  bitsLeft>=8
        If outputFormat$="hex"
          output$=output$ + RSet(Hex((buffer >> (bitsLeft - 8)) & $FF),2,"0") ;0x1F;
        Else
          output$=output$ + Chr((buffer >> (bitsLeft - 8)) & $FF)
        EndIf
        bitsLeft=bitsLeft-8
      EndIf 
    EndIf 
    i=i+1
  Wend
  
  If bitsLeft>2;0
    buffer=buffer<<5
    If outputFormat$="hex"
      output$=output$ + RSet(Hex((buffer >> (bitsLeft - 3)) & $FF),2,"0")
    Else
      output$=output$ + Chr((buffer >> (bitsLeft - 3)) & $FF)
    EndIf
  EndIf
  
  ProcedureReturn output$
EndProcedure

Procedure.s Hex2Bin(hex.s)
  For i = 1 To Len(hex) /2 Step 2
    bin$ = bin$ + Val("$"+ Mid(Hex,i,2))
  Next
  ProcedureReturn bin$
EndProcedure
Pour info, il me semble avoir modifié du code dans l'un des 2 includes.
En effet de façon aléatoire, j'avais aussi un problème, mais je ne saurais dire lequel !

J'espère que mon post résistera au modérateur, dans le passé j'ai posté sur ce forum, mais mets post ont été supprimés !
Répondre