Browse Source

fcl-web: TJWTSignerPS256, TJWTSignerPS384, TJWTSignerPS512

mattias 3 years ago
parent
commit
37d107a953
3 changed files with 357 additions and 63 deletions
  1. 126 54
      packages/fcl-hash/src/fprsa.pas
  2. 142 1
      packages/fcl-web/src/jwt/fpjwarsa.pp
  3. 89 8
      packages/fcl-web/tests/tcjwt.pp

+ 126 - 54
packages/fcl-hash/src/fprsa.pas

@@ -9,7 +9,7 @@ interface
 {off $DEFINE CRYPTO_DEBUG}
 {off $DEFINE CRYPTO_DEBUG}
 
 
 uses
 uses
-  sysutils, Classes, sha1, fpsha256, fpTLSBigInt, fphashutils, fpasn, basenenc;
+  sysutils, Classes, sha1, fpsha512, fpsha256, fpTLSBigInt, fphashutils, fpasn, basenenc;
 
 
 const
 const
   RSAPublicKeyOID = '1.2.840.113549.1.1.1';
   RSAPublicKeyOID = '1.2.840.113549.1.1.1';
@@ -121,15 +121,17 @@ type
   TRSAHashFuncInfo = record
   TRSAHashFuncInfo = record
     Func: TRSAHashFunction;
     Func: TRSAHashFunction;
     DigestLen: Word;
     DigestLen: Word;
-    procedure InitSHA1;
-    procedure InitSHA256;
+    procedure UseSHA1;
+    procedure UseSHA256;
+    procedure UseSHA384;
+    procedure UseSHA512;
   end;
   end;
   PRSAHashFuncInfo = ^TRSAHashFuncInfo;
   PRSAHashFuncInfo = ^TRSAHashFuncInfo;
 
 
 { Perform PSASSA-PSS signing using MGF1 and a hash function
 { Perform PSASSA-PSS signing using MGF1 and a hash function
   RSA: The RSA context containing the private key
   RSA: The RSA context containing the private key
   Input: The data to be signed
   Input: The data to be signed
-  Len: The size of the input data in bytes (Must be <= Modulus length - HashLen - SaltLen - 2)
+  Len: The size of the input data in bytes
   Output: The buffer for the signature result (Must always be RSA.ModulusLen)
   Output: The buffer for the signature result (Must always be RSA.ModulusLen)
   SaltLen: length in bytes of the random number Salt, can be RSA_PSS_SaltLen_HashLen or RSA_PSS_SaltLen_Max
   SaltLen: length in bytes of the random number Salt, can be RSA_PSS_SaltLen_HashLen or RSA_PSS_SaltLen_Max
   Result: The number of bytes of the signature or on error -1 or exception }
   Result: The number of bytes of the signature or on error -1 or exception }
@@ -141,16 +143,26 @@ function RSASSA_PSS_Sign(var RSA: TRSA; Input: PByte; Len: Integer;
 { Perform PSASSA-PSS verification using MGF1 and a hash function
 { Perform PSASSA-PSS verification using MGF1 and a hash function
   RSA: The RSA context containing the public key
   RSA: The RSA context containing the public key
   Input: The data to be verified
   Input: The data to be verified
-  Len: The size of the input data in bytes (Must be <= Modulus length - HashLen - SaltLen - 2)
+  Len: The size of the input data in bytes
   Signature: The buffer for the encrypted result (Must always be RSA.ModulusLen)
   Signature: The buffer for the encrypted result (Must always be RSA.ModulusLen)
   SaltLen: length in bytes of the random number Salt,
   SaltLen: length in bytes of the random number Salt,
        can be RSA_PSS_SaltLen_HashLen, RSA_PSS_SaltLen_Auto or RSA_PSS_SaltLen_Max
        can be RSA_PSS_SaltLen_HashLen, RSA_PSS_SaltLen_Auto or RSA_PSS_SaltLen_Max
   Result: 0 on success or an error number }
   Result: 0 on success or an error number }
+function RSASSA_PS256_Verify(var RSA: TRSA; Input: PByte; Len: Integer;
+  Signature: PByte; SaltLen: integer = RSA_PSS_SaltLen_Auto): int64;
 function RSASSA_PSS_Verify(var RSA: TRSA; Input: PByte; Len: Integer;
 function RSASSA_PSS_Verify(var RSA: TRSA; Input: PByte; Len: Integer;
-  HashFunc: PRSAHashFuncInfo; Signature: PByte; SaltLen: integer = RSA_PSS_SaltLen_HashLen): int64;
+  HashFunc: PRSAHashFuncInfo; Signature: PByte; SaltLen: integer = RSA_PSS_SaltLen_Auto): int64;
 
 
+{ Perform EMSA_PSS_Encode
+  Input: The data to be verified
+  Len: The size of the input data in bytes
+  Output: The buffer for the encoded hash result
+       (length = (RSA.ModulusBits-1+7) div 8 -> can be one less than RSA.ModulusLen)
+  ModBits: RSA.ModulusBits-1
+  SaltLen: length in bytes of the random number Salt, can be RSA_PSS_SaltLen_HashLen or RSA_PSS_SaltLen_Max
+  Result: 0 on success or an error number }
 function EMSA_PSS_Encode(Input: PByte; InLen: Integer; HashFunc: PRSAHashFuncInfo;
 function EMSA_PSS_Encode(Input: PByte; InLen: Integer; HashFunc: PRSAHashFuncInfo;
-  Output: PByte; OutLen: integer; ModBits: integer; SaltLen: integer = RSA_PSS_SaltLen_HashLen): int64;
+  Output: PByte; ModBits: DWord; SaltLen: integer = RSA_PSS_SaltLen_HashLen): int64;
 function EMSA_PSS_Verify(Msg: PByte; MsgLen: DWord;
 function EMSA_PSS_Verify(Msg: PByte; MsgLen: DWord;
   EncodedMsg: PByte; EncodedBits: DWord; HashFunc: PRSAHashFuncInfo;
   EncodedMsg: PByte; EncodedBits: DWord; HashFunc: PRSAHashFuncInfo;
   SaltLen: integer = RSA_PSS_SaltLen_HashLen): int64;
   SaltLen: integer = RSA_PSS_SaltLen_HashLen): int64;
@@ -750,36 +762,47 @@ function RSASSA_PS256_Sign(var RSA: TRSA; Input: PByte; Len: Integer;
 var
 var
   HashFunc: TRSAHashFuncInfo;
   HashFunc: TRSAHashFuncInfo;
 begin
 begin
-  HashFunc.InitSHA256;
+  HashFunc.UseSHA256;
   Result:=RSASSA_PSS_Sign(RSA,Input,Len,@HashFunc,Output,SaltLen);
   Result:=RSASSA_PSS_Sign(RSA,Input,Len,@HashFunc,Output,SaltLen);
 end;
 end;
 
 
 function RSASSA_PSS_Sign(var RSA: TRSA; Input: PByte; Len: Integer;
 function RSASSA_PSS_Sign(var RSA: TRSA; Input: PByte; Len: Integer;
   HashFunc: PRSAHashFuncInfo; Output: PByte; SaltLen: integer): Integer;
   HashFunc: PRSAHashFuncInfo; Output: PByte; SaltLen: integer): Integer;
+// RFC 3447 Signature generation operation
 var
 var
   EncodedMsg: TBytes;
   EncodedMsg: TBytes;
-  ModBits, Size: Integer;
   EncodedBI, Encrypted: PBigInt;
   EncodedBI, Encrypted: PBigInt;
+  EncodedLen, ModBits: DWord;
+  r: Int64;
 begin
 begin
   Result:=-1;
   Result:=-1;
 
 
-  Size:=RSA.ModulusLen;
-  if ((RSA.ModulusBits+7) div 8)<>Size then
+  if ((RSA.ModulusBits+7) div 8)<>RSA.ModulusLen then
     raise Exception.Create('20220502000942 RSA n has leading zeroes');
     raise Exception.Create('20220502000942 RSA n has leading zeroes');
-  ModBits:=(RSA.ModulusBits-1) and 7;
-  if ModBits=0 then
-    ; //dec(Size); ToDo
 
 
-  SetLength(EncodedMsg{%H-},Size);
-  EMSA_PSS_Encode(Input,Len, HashFunc, @EncodedMsg[0], length(EncodedMsg), ModBits, SaltLen);
+  ModBits:=RSA.ModulusBits-1;
+  EncodedLen:=(ModBits+7) div 8; // can be one less than RSA.ModulusLen
+  SetLength(EncodedMsg{%H-},EncodedLen);
+  r:=EMSA_PSS_Encode(Input,Len, HashFunc, @EncodedMsg[0], ModBits, SaltLen);
+  if r<>0 then
+    raise Exception.Create(IntToStr(r));
 
 
   EncodedBI:=BIImport(RSA.Context,EncodedMsg);
   EncodedBI:=BIImport(RSA.Context,EncodedMsg);
   // Sign with Private Key
   // Sign with Private Key
   Encrypted:=BICRT(RSA.Context,EncodedBI,RSA.DP,RSA.DQ,RSA.P,RSA.Q,RSA.QInv); // this releases EncodedBI
   Encrypted:=BICRT(RSA.Context,EncodedBI,RSA.DP,RSA.DQ,RSA.P,RSA.Q,RSA.QInv); // this releases EncodedBI
 
 
-  BIExport(RSA.Context,Encrypted,Output,Size); // this releases Encrypted
+  BIExport(RSA.Context,Encrypted,Output,RSA.ModulusLen); // this releases Encrypted
+
+  Result:=RSA.ModulusLen;
+end;
 
 
-  Result:=Size;
+function RSASSA_PS256_Verify(var RSA: TRSA; Input: PByte; Len: Integer;
+  Signature: PByte; SaltLen: integer): int64;
+var
+  HashFunc: TRSAHashFuncInfo;
+begin
+  HashFunc.UseSHA256;
+  Result:=RSASSA_PSS_Verify(RSA,Input,Len,@HashFunc,Signature,SaltLen);
 end;
 end;
 
 
 function RSASSA_PSS_Verify(var RSA: TRSA; Input: PByte; Len: Integer;
 function RSASSA_PSS_Verify(var RSA: TRSA; Input: PByte; Len: Integer;
@@ -796,7 +819,7 @@ begin
   // "1. Length checking: If the length of the signature S is not k octets, error"
   // "1. Length checking: If the length of the signature S is not k octets, error"
   Size:=RSA.ModulusLen;
   Size:=RSA.ModulusLen;
   if ((RSA.ModulusBits+7) div 8)<>Size then
   if ((RSA.ModulusBits+7) div 8)<>Size then
-    // RSA n has leading zeroes
+    // RSA.n has leading zeroes
     exit(20220502214238);
     exit(20220502214238);
 
 
   // 2. using RSAVP1 verification primitive with public key
   // 2. using RSAVP1 verification primitive with public key
@@ -826,30 +849,40 @@ begin
 end;
 end;
 
 
 function EMSA_PSS_Encode(Input: PByte; InLen: Integer;
 function EMSA_PSS_Encode(Input: PByte; InLen: Integer;
-  HashFunc: PRSAHashFuncInfo; Output: PByte; OutLen: integer; ModBits: integer;
-  SaltLen: integer): int64;
+  HashFunc: PRSAHashFuncInfo; Output: PByte; ModBits: DWord; SaltLen: integer
+  ): int64;
 // RFC 3447 9.1.1 Encoding operation
 // RFC 3447 9.1.1 Encoding operation
 var
 var
   ZeroesHashSalt, H, DB, DBMask, MaskedDB: TBytes;
   ZeroesHashSalt, H, DB, DBMask, MaskedDB: TBytes;
   MsgHashP, SaltP: PByte;
   MsgHashP, SaltP: PByte;
-  Padding, HashLen, i: Integer;
+  Padding, HashLen, i, EncodedLen, DBLen: DWord;
 begin
 begin
   Result:=0;
   Result:=0;
 
 
   HashLen:=HashFunc^.DigestLen;
   HashLen:=HashFunc^.DigestLen;
+  EncodedLen:=(ModBits+7) div 8;
 
 
   if SaltLen = RSA_PSS_SaltLen_HashLen then
   if SaltLen = RSA_PSS_SaltLen_HashLen then
     SaltLen:=HashLen
     SaltLen:=HashLen
   else if SaltLen = RSA_PSS_SaltLen_Max then
   else if SaltLen = RSA_PSS_SaltLen_Max then
-    SaltLen:=OutLen-HashLen-2
+    SaltLen:=EncodedLen-HashLen-2
   else if SaltLen < 0 then
   else if SaltLen < 0 then
     exit(20220501233610);
     exit(20220501233610);
 
 
-  // check OutLen
-  if HashLen + SaltLen + 2 > OutLen then
+  // "2.  Let mHash = Hash(M), an octet string of length hLen."
+  // Note: directly into ZeroesHashSalt
+
+  // "3.  If emLen < hLen + sLen + 2, error"
+  if EncodedLen < HashLen + SaltLen + 2 then
     exit(20220501221837);
     exit(20220501221837);
 
 
-  // ZeroesHashSalt := 8 zeroes + InputHash + Salt
+  // "4.  Generate a random octet string salt of length sLen; if sLen = 0,
+  //      then salt is the empty string."
+  // Note: directly into ZeroesHashSalt
+
+  // "5.  Let M' = (0x)00 00 00 00 00 00 00 00 || mHash || salt;
+  //      M' is an octet string of length 8 + hLen + sLen with eight
+  //      initial zero octets."
   SetLength(ZeroesHashSalt{%H-},8+HashLen+SaltLen);
   SetLength(ZeroesHashSalt{%H-},8+HashLen+SaltLen);
   FillByte(ZeroesHashSalt[0],8,0);
   FillByte(ZeroesHashSalt[0],8,0);
   MsgHashP:=@ZeroesHashSalt[8];
   MsgHashP:=@ZeroesHashSalt[8];
@@ -859,35 +892,42 @@ begin
     if not CryptoGetRandomBytes(SaltP,SaltLen) then
     if not CryptoGetRandomBytes(SaltP,SaltLen) then
       exit(20220501222748);
       exit(20220501222748);
 
 
-  // hash ZeroesHashSalt
+  // "6.  Let H = Hash(M'), an octet string of length hLen."
   SetLength(H{%H-},HashLen);
   SetLength(H{%H-},HashLen);
   HashFunc^.Func(@ZeroesHashSalt[0],length(ZeroesHashSalt),@H[0]);
   HashFunc^.Func(@ZeroesHashSalt[0],length(ZeroesHashSalt),@H[0]);
 
 
-  // DB := padding zeroes + #1 + Salt
-  SetLength(DB{%H-},OutLen-HashLen-1);
-  Padding:=length(DB)-SaltLen-1;
+  // "7.  Generate an octet string PS consisting of emLen - sLen - hLen - 2
+  //      zero octets.  The length of PS may be 0."
+  // Note: directly in DB
+
+  // "8.  Let DB = PS || 0x01 || salt;
+  //      DB is an octet string of length emLen - hLen - 1."
+  DBLen:=EncodedLen-HashLen-1;
+  SetLength(DB{%H-},DBLen); // -1 for the trailing $bc
+  Padding:=length(DB)-SaltLen-1; // -1 for the $01 separator
   if Padding>0 then
   if Padding>0 then
     FillByte(DB[0],Padding,0);
     FillByte(DB[0],Padding,0);
-  DB[Padding]:=1;
+  DB[Padding]:=$01;
   System.Move(SaltP^,DB[Padding+1],SaltLen);
   System.Move(SaltP^,DB[Padding+1],SaltLen);
 
 
-  // dbMask := MGF(H, OutLen - HashLen - 1)
-  SetLength(DBMask{%H-},length(DB));
-  MGF1(@H[0],HashLen,HashFunc,@DBMask[0],length(DB));
+  // "9.  Let dbMask = MGF(H, emLen - hLen - 1)."
+  SetLength(DBMask{%H-},DBLen);
+  MGF1(@H[0],HashLen,HashFunc,@DBMask[0],DBLen);
 
 
-  // MaskedDB := DB xor DBMask
-  SetLength(MaskedDB{%H-},length(DB));
-  for i:=0 to length(DB) do
+  // "10. Let maskedDB = DB xor dbMask."
+  SetLength(MaskedDB{%H-},DBLen);
+  for i:=0 to DBLen-1 do
     MaskedDB[i]:=DB[i] xor DBMask[i];
     MaskedDB[i]:=DB[i] xor DBMask[i];
 
 
-  // set the leftmost bits of leftmost byte to zero
-  if ModBits>0 then
-    MaskedDB[0] := MaskedDB[0] and ($ff shr (8-ModBits));
+  // "11. Set the leftmost 8emLen - emBits bits of the leftmost octet in maskedDB to zero."
+  if (ModBits and 7)>0 then
+    MaskedDB[0] := MaskedDB[0] and ($ff shr (8-(ModBits and 7)));
 
 
-  System.Move(MaskedDB[0],Output^,length(MaskedDB));
-  inc(Output,length(MaskedDB));
-  System.Move(H[0],Output^,length(H));
-  inc(Output,length(H));
+  // "12. Let EM = maskedDB || H || 0xbc."
+  System.Move(MaskedDB[0],Output^,DBLen);
+  inc(Output,DBLen);
+  System.Move(H[0],Output^,HashLen);
+  inc(Output,HashLen);
   Output^:=$bc;
   Output^:=$bc;
 end;
 end;
 
 
@@ -898,7 +938,7 @@ var
   HashLen: Word;
   HashLen: Word;
   EncodedLen, DBLen, i, Padding: DWord;
   EncodedLen, DBLen, i, Padding: DWord;
   MaskedDB, HashP, SaltP: PByte;
   MaskedDB, HashP, SaltP: PByte;
-  Hash, DBMask, Msg2, Hash2, DB: TBytes;
+  MsgHash, DBMask, Msg2, Hash2, DB: TBytes;
 begin
 begin
   Result:=0;
   Result:=0;
 
 
@@ -917,9 +957,9 @@ begin
   else if SaltLen < RSA_PSS_SaltLen_Max then
   else if SaltLen < RSA_PSS_SaltLen_Max then
     exit(20220502205808);
     exit(20220502205808);
 
 
-  // "2. Let mHash = Hash(M), an octet string of length hLen."
-  SetLength(Hash{%H-},HashLen);
-  HashFunc^.Func(Msg,MsgLen,@Hash[0]);
+  // "2. Let mHash = MsgHash(M), an octet string of length hLen."
+  SetLength(MsgHash{%H-},HashLen);
+  HashFunc^.Func(Msg,MsgLen,@MsgHash[0]);
 
 
   // "3.  If emLen < hLen + sLen + 2, error."
   // "3.  If emLen < hLen + sLen + 2, error."
   if SaltLen = RSA_PSS_SaltLen_Auto then
   if SaltLen = RSA_PSS_SaltLen_Auto then
@@ -986,7 +1026,7 @@ begin
   //       initial zero octets.
   //       initial zero octets.
   SetLength(Msg2{%H-},8 + HashLen + SaltLen);
   SetLength(Msg2{%H-},8 + HashLen + SaltLen);
   FillByte(Msg2[0],8,0);
   FillByte(Msg2[0],8,0);
-  System.Move(Hash[0],Msg2[8],HashLen);
+  System.Move(MsgHash[0],Msg2[8],HashLen);
   System.Move(SaltP^,Msg2[8+HashLen],SaltLen);
   System.Move(SaltP^,Msg2[8+HashLen],SaltLen);
 
 
   // "13. Let H' = Hash(M'), an octet string of length hLen."
   // "13. Let H' = Hash(M'), an octet string of length hLen."
@@ -994,7 +1034,7 @@ begin
   HashFunc^.Func(@Msg2[0],length(Msg2),@Hash2[0]);
   HashFunc^.Func(@Msg2[0],length(Msg2),@Hash2[0]);
 
 
   // "14. If H = H', output consistent. Otherwise, output inconsistent."
   // "14. If H = H', output consistent. Otherwise, output inconsistent."
-  if not CompareMem(@Hash[0],@Hash2[0],HashLen) then
+  if not CompareMem(HashP,@Hash2[0],HashLen) then
     exit(20220502212747);
     exit(20220502212747);
 end;
 end;
 
 
@@ -1062,7 +1102,7 @@ function MGF1SHA1(const InputStr: string; Len: integer): string;
 var
 var
   HashFunc: TRSAHashFuncInfo;
   HashFunc: TRSAHashFuncInfo;
 begin
 begin
-  HashFunc.InitSHA1;
+  HashFunc.UseSHA1;
   Result:=MGF1(InputStr,@HashFunc,Len);
   Result:=MGF1(InputStr,@HashFunc,Len);
 end;
 end;
 
 
@@ -1070,7 +1110,7 @@ function MGF1SHA256(const InputStr: string; Len: integer): string;
 var
 var
   HashFunc: TRSAHashFuncInfo;
   HashFunc: TRSAHashFuncInfo;
 begin
 begin
-  HashFunc.InitSHA256;
+  HashFunc.UseSHA256;
   Result:=MGF1(InputStr,@HashFunc,Len);
   Result:=MGF1(InputStr,@HashFunc,Len);
 end;
 end;
 
 
@@ -1095,20 +1135,52 @@ begin
   System.Move(SHA256.Digest[0],Output^,SHA256_DIGEST_SIZE);
   System.Move(SHA256.Digest[0],Output^,SHA256_DIGEST_SIZE);
 end;
 end;
 
 
+procedure HashFuncSHA384(Input: PByte; InLen: Integer; Output: PByte);
+var
+  SHA384: TSHA384;
+begin
+  SHA384.Init;
+  SHA384.Update(Input,InLen);
+  SHA384.Final;
+  System.Move(SHA384.Digest[0],Output^,SHA384_DIGEST_SIZE);
+end;
+
+procedure HashFuncSHA512(Input: PByte; InLen: Integer; Output: PByte);
+var
+  SHA512: TSHA512;
+begin
+  SHA512.Init;
+  SHA512.Update(Input,InLen);
+  SHA512.Final;
+  System.Move(SHA512.Digest[0],Output^,SHA512_DIGEST_SIZE);
+end;
+
 { TRSAHashFuncInfo }
 { TRSAHashFuncInfo }
 
 
-procedure TRSAHashFuncInfo.InitSHA1;
+procedure TRSAHashFuncInfo.UseSHA1;
 begin
 begin
   Func:=@HashFuncSHA1;
   Func:=@HashFuncSHA1;
   DigestLen:=SizeOf(TSHA1Digest);
   DigestLen:=SizeOf(TSHA1Digest);
 end;
 end;
 
 
-procedure TRSAHashFuncInfo.InitSHA256;
+procedure TRSAHashFuncInfo.UseSHA256;
 begin
 begin
   Func:=@HashFuncSHA256;
   Func:=@HashFuncSHA256;
   DigestLen:=SHA256_DIGEST_SIZE;
   DigestLen:=SHA256_DIGEST_SIZE;
 end;
 end;
 
 
+procedure TRSAHashFuncInfo.UseSHA384;
+begin
+  Func:=@HashFuncSHA384;
+  DigestLen:=SHA384_DIGEST_SIZE;
+end;
+
+procedure TRSAHashFuncInfo.UseSHA512;
+begin
+  Func:=@HashFuncSHA512;
+  DigestLen:=SHA512_DIGEST_SIZE;
+end;
+
 { TX509RSAPrivateKey }
 { TX509RSAPrivateKey }
 
 
 procedure TX509RSAPrivateKey.InitWithHexStrings(const n, e, d, p, q, dp, dq, qi: string
 procedure TX509RSAPrivateKey.InitWithHexStrings(const n, e, d, p, q, dp, dq, qi: string

+ 142 - 1
packages/fcl-web/src/jwt/fpjwarsa.pp

@@ -5,7 +5,7 @@ unit fpjwarsa;
 interface
 interface
 
 
 uses
 uses
-  Classes, SysUtils, basenenc, fpjwt, fprsa, fpsha256, fpsha512;
+  Classes, SysUtils, basenenc, fpjwt, fprsa, fpsha256, fpsha512, fphashutils;
 
 
 Type
 Type
 
 
@@ -44,8 +44,146 @@ Type
     function ComputeASNHash(const Value: TBytes): TBytes; override;
     function ComputeASNHash(const Value: TBytes): TBytes; override;
   end;
   end;
 
 
+  { TJWTSignerRSAPSS }
+
+  TJWTSignerRSAPSS = Class(TJWTSigner)
+  Public
+    Class function AlgorithmName : String; override;
+    Class procedure GetHashFunc(var HashFunc: TRSAHashFuncInfo); virtual; abstract;
+    Function CreateSignature(aJWT : TJWT; aPrivateKey : TJWTKey) : String; override;
+    Function Verify(const aJWT : String; aPublicKey : TJWTKey) : Boolean; override; overload;
+  end;
+  TJWTSignerRSAPSSClass = class of TJWTSignerRSAPSS;
+
+  { TJWTSignerPS256 }
+
+  TJWTSignerPS256 = class(TJWTSignerRSAPSS)
+  public
+    class function AlgorithmName : String; override;
+    class procedure GetHashFunc(var HashFunc: TRSAHashFuncInfo); override;
+  end;
+
+  { TJWTSignerPS384 }
+
+  TJWTSignerPS384 = class(TJWTSignerRSAPSS)
+  public
+    class function AlgorithmName : String; override;
+    class procedure GetHashFunc(var HashFunc: TRSAHashFuncInfo); override;
+  end;
+
+  { TJWTSignerPS512 }
+
+  TJWTSignerPS512 = class(TJWTSignerRSAPSS)
+  public
+    class function AlgorithmName : String; override;
+    class procedure GetHashFunc(var HashFunc: TRSAHashFuncInfo); override;
+  end;
+
 implementation
 implementation
 
 
+{ TJWTSignerPS512 }
+
+class function TJWTSignerPS512.AlgorithmName: String;
+begin
+  Result:='PS512';
+end;
+
+class procedure TJWTSignerPS512.GetHashFunc(var HashFunc: TRSAHashFuncInfo);
+begin
+  HashFunc.UseSHA512;
+end;
+
+{ TJWTSignerPS384 }
+
+class function TJWTSignerPS384.AlgorithmName: String;
+begin
+  Result:='PS384';
+end;
+
+class procedure TJWTSignerPS384.GetHashFunc(var HashFunc: TRSAHashFuncInfo);
+begin
+  HashFunc.UseSHA384;
+end;
+
+{ TJWTSignerPS256 }
+
+class function TJWTSignerPS256.AlgorithmName: String;
+begin
+  Result:='PS256';
+end;
+
+class procedure TJWTSignerPS256.GetHashFunc(var HashFunc: TRSAHashFuncInfo);
+begin
+  HashFunc.UseSHA256;
+end;
+
+{ TJWTSignerRSAPSS }
+
+class function TJWTSignerRSAPSS.AlgorithmName: String;
+begin
+  raise Exception.Create('20220503003125 abstract class');
+  Result:='RSAPSS';
+end;
+
+function TJWTSignerRSAPSS.CreateSignature(aJWT: TJWT; aPrivateKey: TJWTKey
+  ): String;
+var
+  aSignInput, aSignature: TBytes;
+  RSA: TRSA;
+  HashFunc: TRSAHashFuncInfo;
+begin
+  Result:='';
+
+  aSignInput:=GetSignInput(aJWT);
+  if length(aSignInput)=0 then
+    raise Exception.Create('20220503003238: missing SignInput');
+
+  GetHashFunc(HashFunc);
+
+  RSACreate(RSA);
+  try
+    RSAInitFromPrivateKeyDER(RSA,aPrivateKey.AsBytes);
+    SetLength(aSignature{%H-},RSA.ModulusLen);
+    if RSASSA_PSS_Sign(RSA,@aSignInput[0],length(aSignInput),@HashFunc,@aSignature[0])<RSA.ModulusLen then
+      raise Exception.Create('20220503003617');
+    Result:=Base64URL.Encode(@aSignature[0],Length(aSignature),False);
+  finally
+    RSAFree(RSA);
+  end;
+end;
+
+function TJWTSignerRSAPSS.Verify(const aJWT: String; aPublicKey: TJWTKey
+  ): Boolean;
+var
+  aHeader, theClaims, aSignature, aSignInput: String;
+  EncryptedHash: TBytes;
+  RSA: TRSA;
+  HashFunc: TRSAHashFuncInfo;
+  r: Int64;
+begin
+  Result:=false;
+  if aJWT='' then exit;
+
+  if not GetParts(aJWT,aHeader,theClaims,aSignature) then exit;
+  if aSignature='' then exit;
+
+  aSignInput:=aHeader+'.'+theClaims;
+  EncryptedHash:=Base64URL.Decode(aSignature);
+  GetHashFunc(HashFunc);
+
+  // verify hash
+  RSACreate(RSA);
+  try
+    RSAInitFromPublicKeyDER(RSA,aPublicKey.AsBytes);
+    if length(EncryptedHash)<>RSA.ModulusLen then
+      exit;
+    r:=RSASSA_PSS_Verify(RSA,@aSignInput[1],length(aSignInput),@HashFunc,@EncryptedHash[0]);
+    Result:=r=0;
+  finally
+    RSAFree(RSA);
+  end;
+end;
+
 { TJWTSignerRS512 }
 { TJWTSignerRS512 }
 
 
 class function TJWTSignerRS512.AlgorithmName: String;
 class function TJWTSignerRS512.AlgorithmName: String;
@@ -162,5 +300,8 @@ initialization
   TJWTSignerRS256.Register;
   TJWTSignerRS256.Register;
   TJWTSignerRS384.Register;
   TJWTSignerRS384.Register;
   TJWTSignerRS512.Register;
   TJWTSignerRS512.Register;
+  TJWTSignerPS256.Register;
+  TJWTSignerPS384.Register;
+  TJWTSignerPS512.Register;
 end.
 end.
 
 

+ 89 - 8
packages/fcl-web/tests/tcjwt.pp

@@ -39,7 +39,8 @@ type
     procedure TearDown; override;
     procedure TearDown; override;
     Property JWT : TJWT Read FJWT;
     Property JWT : TJWT Read FJWT;
     Property Key : TJWTKey Read FKey;
     Property Key : TJWTKey Read FKey;
-    procedure TestVerifyRSAPem(SignerClass: TJWTSignerRSAClass); virtual;
+    procedure GetTestPEM(out aPrivateKeyPEM, aPublicKeyPEM: string);
+    procedure TestVerifyRSAPem(SignerClass: TJWTSignerClass); virtual;
   published
   published
     procedure TestSignNone;
     procedure TestSignNone;
     procedure TestVerifyNone;
     procedure TestVerifyNone;
@@ -64,7 +65,10 @@ type
     procedure TestI2OSP;
     procedure TestI2OSP;
     procedure TestMGF1SHA1;
     procedure TestMGF1SHA1;
     procedure TestMGF1SHA256;
     procedure TestMGF1SHA256;
-    procedure TestVerifyPS256; // ToDo
+    procedure TestVerifyPS256;
+    procedure TestVerifyPS256Pem;
+    procedure TestVerifyPS384Pem;
+    procedure TestVerifyPS512Pem;
   end;
   end;
 
 
 implementation
 implementation
@@ -463,9 +467,78 @@ begin
 end;
 end;
 
 
 procedure TTestJWT.TestVerifyPS256;
 procedure TTestJWT.TestVerifyPS256;
+const
+  HeaderJSON = '{"alg":"PS256"}';
+  HeaderExpected = 'eyJhbGciOiJQUzI1NiJ9';
+
+  PayloadJSON = 'In our village, folks say God crumbles up the old moon into stars.';
+  PayloadExpected = 'SW4gb3VyIHZpbGxhZ2UsIGZvbGtzIHNheSBHb2QgY3J1bWJsZXMgdXAgdGhlIG9sZCBtb29uIGludG8gc3RhcnMu';
+
+  RSA_n = 'ofgWCuLjybRlzo0tZWJjNiuSfb4p4fAkd_wWJcyQoTbji9k0l8W26mPddx'+
+          'HmfHQp-Vaw-4qPCJrcS2mJPMEzP1Pt0Bm4d4QlL-yRT-SFd2lZS-pCgNMs'+
+          'D1W_YpRPEwOWvG6b32690r2jZ47soMZo9wGzjb_7OMg0LOL-bSf63kpaSH'+
+          'SXndS5z5rexMdbBYUsLA9e-KXBdQOS-UTo7WTBEMa2R2CapHg665xsmtdV'+
+          'MTBQY4uDZlxvb3qCo5ZwKh9kG4LT6_I5IhlJH7aGhyxXFvUK-DWNmoudF8'+
+          'NAco9_h9iaGNj8q2ethFkMLs91kzk2PAcDTW9gb54h4FRWyuXpoQ';
+  RSA_e = 'AQAB';
+
+  SignatureEncoded =
+     'TRWhwRo5dMv9-8OzrInfJTwmUGYgjLfHk8lqF072ND-FmLWEBnUTOpY8oJXp'
+    +'8FdWw2SalbdOeNlrtlJjwk4XK8Ql2iJ_2qMCtxsvLPhKBOqFoAF4aBvTOEDV'
+    +'JDxf0DaBSiydEEtfTVV2iwBcjWabu5J2XieR5y7QZQtuHsn7T3qKBvCcCejN'
+    +'3Y2oqAT3qMHvu1fTms1r_91wBn_K7Wjd9UkZ1n02qQcUHJznR_OF2BgN7_KW'
+    +'IDAF9ZS9keoju2NPpPelO4yxa2XUPnehY3G7dHKoCxUEQR4d2Xc5voqDASTV'
+    +'CDqQS4PVOZdvT3Ein6-SanAlCwbWBbkvT8g6-5PImQ';
+var
+  X509RSAPublicKey: TX509RSAPublicKey;
+  RSA: TRSA;
+  HeaderEncoded, PayloadEncoded, SignInput: String;
+  r: Int64;
+  Signature: TBytes;
 begin
 begin
   // RSASSA-PSS using SHA-256 and MGF1 with SHA-256
   // RSASSA-PSS using SHA-256 and MGF1 with SHA-256
 
 
+  HeaderEncoded:=Base64URL.Encode(HeaderJSON,false);
+  AssertEquals('Header',HeaderExpected,HeaderEncoded);
+
+  PayloadEncoded:=Base64URL.Encode(PayloadJSON,false);
+  AssertEquals('Payload',PayloadExpected,PayloadEncoded);
+
+  SignInput:=HeaderEncoded+'.'+PayloadEncoded;
+
+  // load public key
+  X509RSAPublicKey.InitWithBase64UrlEncoded(RSA_n,RSA_e);
+
+  RSACreate(RSA);
+  try
+    RSAInitFromPublicKey(RSA,X509RSAPublicKey);
+    AssertEquals('RSA.ModulusLen',256,RSA.ModulusLen);
+    AssertEquals('RSA.ModulusBits',2048,RSA.ModulusBits);
+
+    Signature:=Base64URL.Decode(SignatureEncoded,false);
+    AssertEquals('length(Signature)',RSA.ModulusLen,length(Signature));
+
+    r:=RSASSA_PS256_Verify(RSA,@SignInput[1],length(SignInput),@Signature[0]);
+    AssertEquals('RSASSA_PS256_Verify',0,r);
+
+  finally
+    RSAFree(RSA);
+  end;
+end;
+
+procedure TTestJWT.TestVerifyPS256Pem;
+begin
+  TestVerifyRSAPem(TJWTSignerPS256);
+end;
+
+procedure TTestJWT.TestVerifyPS384Pem;
+begin
+  TestVerifyRSAPem(TJWTSignerPS384);
+end;
+
+procedure TTestJWT.TestVerifyPS512Pem;
+begin
+  TestVerifyRSAPem(TJWTSignerPS512);
 end;
 end;
 
 
 procedure TTestJWT.SetUp;
 procedure TTestJWT.SetUp;
@@ -487,11 +560,11 @@ begin
   Inherited;
   Inherited;
 end;
 end;
 
 
-procedure TTestJWT.TestVerifyRSAPem(SignerClass: TJWTSignerRSAClass);
+procedure TTestJWT.GetTestPEM(out aPrivateKeyPEM, aPublicKeyPEM: string);
 const
 const
   // generated with
   // generated with
   //   openssl genrsa -out private.pem 2048
   //   openssl genrsa -out private.pem 2048
-  APrivateKeyPem =
+  PrivateKeyPem =
     '-----BEGIN RSA PRIVATE KEY-----'#10+
     '-----BEGIN RSA PRIVATE KEY-----'#10+
     'MIIEpQIBAAKCAQEAvkRfGW8psCZ3G4+hBA6W/CR/FHhBLB3k3QLypamPbRFlFBxL'#10+
     'MIIEpQIBAAKCAQEAvkRfGW8psCZ3G4+hBA6W/CR/FHhBLB3k3QLypamPbRFlFBxL'#10+
     'tOK2NblBybY22vUiMLZbb5x8OoOj/IhOrJAlTqhtbTWLy/0K3qbG09vLm8V40kEK'#10+
     'tOK2NblBybY22vUiMLZbb5x8OoOj/IhOrJAlTqhtbTWLy/0K3qbG09vLm8V40kEK'#10+
@@ -519,7 +592,7 @@ const
     'dtOAmxMASvsqud3XIM5fO5m3Jpl1phiGhCw4nvVLcYzVWxYY+oWoeCSyECgu5tmT'#10+
     'dtOAmxMASvsqud3XIM5fO5m3Jpl1phiGhCw4nvVLcYzVWxYY+oWoeCSyECgu5tmT'#10+
     'Fo8vn4EEXCkEAA2YPiEuVcrcYsWkLivCTC19lJDfUNMmpwSdiGz/tDU='#10+
     'Fo8vn4EEXCkEAA2YPiEuVcrcYsWkLivCTC19lJDfUNMmpwSdiGz/tDU='#10+
     '-----END RSA PRIVATE KEY-----'#10;
     '-----END RSA PRIVATE KEY-----'#10;
-  APublicKeyPem =
+  PublicKeyPem =
     '-----BEGIN PUBLIC KEY-----'#10+
     '-----BEGIN PUBLIC KEY-----'#10+
     'MIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEAvkRfGW8psCZ3G4+hBA6W'#10+
     'MIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEAvkRfGW8psCZ3G4+hBA6W'#10+
     '/CR/FHhBLB3k3QLypamPbRFlFBxLtOK2NblBybY22vUiMLZbb5x8OoOj/IhOrJAl'#10+
     '/CR/FHhBLB3k3QLypamPbRFlFBxLtOK2NblBybY22vUiMLZbb5x8OoOj/IhOrJAl'#10+
@@ -529,13 +602,21 @@ const
     'XU4IPHVrSN/HdK2nQPSMLdKnTV+Eh/HcxpfjBjarg+VjgDqlmqJ9bkosOVn35vsg'#10+
     'XU4IPHVrSN/HdK2nQPSMLdKnTV+Eh/HcxpfjBjarg+VjgDqlmqJ9bkosOVn35vsg'#10+
     '8wIDAQAB'#10+
     '8wIDAQAB'#10+
     '-----END PUBLIC KEY-----';
     '-----END PUBLIC KEY-----';
+begin
+  aPrivateKeyPEM:=PrivateKeyPem;
+  aPublicKeyPEM:=PublicKeyPem;
+end;
+
+procedure TTestJWT.TestVerifyRSAPem(SignerClass: TJWTSignerClass);
 var
 var
-  aInput: String;
-  Signer: TJWTSignerRSA;
+  aInput, aPrivateKeyPEM, aPublicKeyPEM: String;
+  Signer: TJWTSigner;
   NewDER: TBytes;
   NewDER: TBytes;
   RSAPublic: TX509RSAPublicKey;
   RSAPublic: TX509RSAPublicKey;
   RSAPrivate: TX509RSAPrivateKey;
   RSAPrivate: TX509RSAPrivateKey;
 begin
 begin
+  GetTestPEM(aPrivateKeyPEM, aPublicKeyPEM);
+
   // header
   // header
   jwt.JOSE.alg:=SignerClass.AlgorithmName;
   jwt.JOSE.alg:=SignerClass.AlgorithmName;
 
 
@@ -552,7 +633,7 @@ begin
     Fail('TX509RSAPrivateKey.AsDER');
     Fail('TX509RSAPrivateKey.AsDER');
 
 
   // sign
   // sign
-  Signer:=TJWTSignerRSA(SignerClass.Create);
+  Signer:=TJWTSigner(SignerClass.Create);
   try
   try
     aInput:=Signer.AppendSignature(JWT,Key);
     aInput:=Signer.AppendSignature(JWT,Key);
   finally
   finally