fcl-web: added TJWTSignerRS256

packages/fcl-web/src/jwt/fpjwarsa.pp

@@ -0,0 +1,98 @@
+unit fpjwarsa;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, basenenc, fpjwt, fprsa, fpsha256;
+
+Type
+
+  { TJWTSignerRS256 }
+
+  TJWTSignerRS256 = Class(TJWTSigner)
+  Public
+    Class function AlgorithmName : String; override;
+    Function CreateSignature(aJWT : TJWT; aKey : TJWTKey) : String; override;
+    Function Verify(const aJWT : String; aKey : TJWTKey) : Boolean; override; overload;
+  end;
+
+implementation
+
+{ TJWTSignerRS256 }
+
+class function TJWTSignerRS256.AlgorithmName: String;
+begin
+  Result:='rs256';
+end;
+
+function TJWTSignerRS256.CreateSignature(aJWT: TJWT; aKey: TJWTKey): String;
+var
+  aSignInput, Hash, aSignature: TBytes;
+  RSA: TRSA;
+begin
+  Result:='';
+
+  aSignInput:=GetSignInput(aJWT);
+  if length(aSignInput)=0 then
+    raise Exception.Create('20220430010854: missing SignInput');
+
+  Hash:=nil;
+  TSHA256.DigestBytes(aSignInput,Hash);
+
+  RSACreate(RSA);
+  try
+    RSAInitFromPrivateKeyDER(RSA,aKey.AsBytes);
+    SetLength(aSignature{%H-},RSA.ModulusLen);
+    if RSAEncryptSign(RSA,@Hash[0],length(Hash),@aSignature[0],false)<RSA.ModulusLen then
+      raise Exception.Create('20220429223334');
+    Result:=Base64URL.Encode(@aSignature[0],Length(aSignature),False);
+  finally
+    RSAFree(RSA);
+  end;
+end;
+
+function TJWTSignerRS256.Verify(const aJWT: String; aKey: TJWTKey): Boolean;
+var
+  aHeader, theClaims, aSignature, aInput: String;
+  InputBytes, EncryptedHash, DecryptedHash, ActualHash: TBytes;
+  RSA: TRSA;
+  HashLen: Integer;
+begin
+  Result:=false;
+  if aJWT='' then exit;
+
+  if not GetParts(aJWT,aHeader,theClaims,aSignature) then exit;
+  if aSignature='' then exit;
+
+  EncryptedHash:=Base64URL.Decode(aSignature);
+
+  // decrypt hash
+  RSACreate(RSA);
+  try
+    RSAInitFromPrivateKeyDER(RSA,aKey.AsBytes);
+    SetLength(DecryptedHash{%H-},length(EncryptedHash));
+    HashLen:=RSADecryptVerify(RSA,@EncryptedHash[0],@DecryptedHash[0],length(DecryptedHash),false);
+    if HashLen<=0 then exit;
+    SetLength(DecryptedHash,HashLen);
+  finally
+    RSAFree(RSA);
+  end;
+
+  // hash of header.claims
+  aInput:=aHeader+'.'+theClaims;
+  SetLength(InputBytes{%H-},length(aInput));
+  Move(aInput[1],InputBytes[0],length(aInput));
+  ActualHash:=nil;
+  TSHA256.DigestBytes(InputBytes,ActualHash);
+
+  // check decrypted hash and actual hash fit
+  Result:=(length(DecryptedHash)=length(ActualHash))
+    and CompareMem(@DecryptedHash[0],@ActualHash[0],length(DecryptedHash));
+end;
+
+initialization
+  TJWTSignerRS256.Register;
+end.
+

packages/fcl-web/src/jwt/fpjwt.pp

@@ -130,6 +130,7 @@ Type
   TClaimsClass = Class of TClaims;
 
   { TJWT }
+
   TJWT = Class;
 
   TJWTClass = Class of TJWT;
@@ -470,7 +471,7 @@ constructor TJWT.Create;
 begin
   Inherited;
   FJOSE:=CreateJOSE;
-  FClaims:=CreateCLaims;
+  FClaims:=CreateClaims;
 end;
 
 destructor TJWT.Destroy;
@@ -525,7 +526,6 @@ begin
 end;
 
 procedure TBaseJWT.SetAsEncodedString(AValue: String);
-
 begin
   AsString:=DecodeString(AValue);
 end;
@@ -605,7 +605,6 @@ procedure TBaseJWT.DoSaveToJSON(JSON: TJSONObject; All: Boolean);
 
 
 Var
-  D : TJSONEnum;
   P : PPropinfo;
   PL : PPropList;
   I,VI,Count : Integer;
@@ -709,7 +708,7 @@ end;
 
 class function TBaseJWT.Base64URLToBase64(AValue: string): string;
 var
-  i,l: integer;
+  l: integer;
 begin
   Result := StringsReplace(AValue, ['-', '_'], ['+', '/'], [rfReplaceAll]);
   l := length(Result) mod 4;

packages/fcl-web/tests/tcjwt.pp

@@ -5,11 +5,10 @@ unit tcjwt;
 interface
 
 uses
-  Classes, SysUtils, fpcunit, testregistry, fpjwt;
+  Classes, SysUtils, fpcunit, testregistry, DateUtils, fpjwt, fpjwarsa;
 
 type
 
-
   { TMyClaims }
 
   TMyClaims = Class(TClaims)
@@ -36,6 +35,7 @@ type
   protected
     procedure SetUp; override;
     procedure TearDown; override;
+    function CreateUnsignedInput(JOSEAlg, ClaimsIssuer: string): string;
     Property JWT : TJWT Read FJWT;
     Property Key : TJWTKey Read FKey;
   published
@@ -49,6 +49,7 @@ type
     procedure TestVerifySHA384;
     procedure TestVerifyES256;
     procedure TestVerifyES256Pem;
+    procedure TestVerifyRS256Pem;
   end;
 
 implementation
@@ -116,7 +117,7 @@ Const
 
 
 begin
-  FKey:=TJWTKey.Create('your-256-bit-secret');
+  FKey.AsString:='your-256-bit-secret';
   FVerifyResult:=TJWT.ValidateJWT(JWTText,FKey);
   AssertNotNull('Have result',FVerifyResult);
   AssertEquals('Have correct algorithm','HS256',FVerifyResult.JOSE.Alg);
@@ -152,7 +153,6 @@ Const
             'FEBOl5fjgnPe4gcc5ElXrHDl0jWsshiJ9rS0hlehItc-PKQEzwRKbhcz69V8kwRCUM2rDtuwaXK6DJfO1VOZdw';
 
 begin
-  FKey:=TJWTKey.Create('mysecretkey');
   FVerifyResult:=TMyJWT.ValidateJWT(JWTText,FKey);
   AssertNotNull('Have result',FVerifyResult);
   AssertEquals('Correct class',TMyJWT,FVerifyResult.ClassType);
@@ -194,7 +194,6 @@ Const
      '8XBKpuFoIEyTxqiP7Rw32VkkxSPGrujBw2ZiKgcX5ZgjH3M8OmTWfYeRDAR6NRVB';
 
 begin
-  FKey:=TJWTKey.Create('mysecretkey');
   FVerifyResult:=TMyJWT.ValidateJWT(JWTText,FKey);
   AssertNotNull('Have result',FVerifyResult);
   AssertEquals('Correct class',TMyJWT,FVerifyResult.ClassType);
@@ -267,6 +266,7 @@ begin
     S.Free;
   end;
   FKey:=TJWTKey.Create(@aPrivateKey,SizeOf(TEccPrivateKey));
+  writeln('AAA1 TTestJWT.TestVerifyES256Pem ');
   FVerifyResult:=TMyJWT.ValidateJWT(aInput,FKey);
   AssertNotNull('Have result',FVerifyResult);
   AssertEquals('Correct class',TMyJWT,FVerifyResult.ClassType);
@@ -279,9 +279,72 @@ begin
   AssertEquals('Have correct admin',False,(TMyJWT(FVerifyResult).Claims as TMyClaims).Admin);
 end;
 
+procedure TTestJWT.TestVerifyRS256Pem;
+const
+  // generated with
+  //   openssl genrsa -out private.pem 2048
+  APrivateKeyPem =
+    '-----BEGIN RSA PRIVATE KEY-----'#10+
+    'MIIEpQIBAAKCAQEAvkRfGW8psCZ3G4+hBA6W/CR/FHhBLB3k3QLypamPbRFlFBxL'#10+
+    'tOK2NblBybY22vUiMLZbb5x8OoOj/IhOrJAlTqhtbTWLy/0K3qbG09vLm8V40kEK'#10+
+    '8/p0STrp3UmsxHNkccj9MRSKk7pOyEvxSCY6K5JGK1VTsMuDCS7DCYk6Vqr3zjX7'#10+
+    'qedF1PVM+Z5t0B+f//kt3oBETNlic4IooEpG/PN2GUQ0oZpa16DDtfgGu7wT3X3Q'#10+
+    'EZFWLJYQTvGc82NpachBIUvqNdIt1npbK38MXU4IPHVrSN/HdK2nQPSMLdKnTV+E'#10+
+    'h/HcxpfjBjarg+VjgDqlmqJ9bkosOVn35vsg8wIDAQABAoIBAQCZxVwujB7fFFdS'#10+
+    '2QPC6Z+w7DYgbwgNBaP/0vAUXzNhbJuKY0v0Rv4H8U9wHGm9EDyvrdG8JHZqPBX+'#10+
+    'dJNQ97aPGaRGjO4M0NdGFve+JXcqz6/UDWkywYnV3V1A0NhmdPQK2et3DSjqN7qQ'#10+
+    'OoAoVWzR5gf74Zwf2Hpwo3BRdqzFeUYVDOH7e7q1SOf2QeU54kVUG21saJR0wsyH'#10+
+    'oSX8BMU2kmg1Un8ET4FM5xEwhdTZzgFTJVZhc6EfOKVbQt6cKmW3aER3c9vR7M3l'#10+
+    'N6Oq73vqrfmy+jFMwz1SoPObQQ7UAnr7YUowaX0AzxHpYm/afyVm+Toym0qWGrrY'#10+
+    'MY/l+vNRAoGBAOsi72pJj30ApfVbSpx8/8QIpweLbEgAD+Ssd41Kgc4O/N7azB61'#10+
+    'RjzSOs1BGhpAZNU6muAAbucm9EssfG5WTAjIM2W2LVuZXXEVXqEGkIymPz9NGugf'#10+
+    'JaCWLaoibmwHkKa+ZV9kDwasmx/VkbAfAbRWaz49ejdrMmkpCW77lYjHAoGBAM8m'#10+
+    'PVJWvFhQrB21xQGSWKd5iSUn2V92gICeDoORqfVtt/UPOaDT915KzXPh4bJeOwg6'#10+
+    'Kkx5wX6UwaNSRH39loDSY1rsBYioV8bxW0BpBvEJG7KXRbBvxzr0+TJkCHgmGMns'#10+
+    'dhePYUcriCaqpQi1yzf201oLTZ6PlJxkmHQobXJ1AoGBAIgWPg576InmWCa64WHU'#10+
+    'joq8nz8kmFTLhGdK0h56IspJrlyksUKMk8wbuGCW7y6GWlV2h7BhT86Eoxrm8lVB'#10+
+    'qNvkUqrpVzMOfiA2x//WNs7QYQaX75ysejCI+oDfUJ1Be5yl0TH2TSQFvfoctycB'#10+
+    'qxDee08YcaWlaxWl5InRHeh9AoGABm3XZWDPw6XtUZa8oIncOoZpHUAZXP8eid9d'#10+
+    '7/NrZPScyvxH+5fYi5Kiwb/280Q9bMnxWiJFQRp40ArTmV1veFwPPVkp6s3eu4vu'#10+
+    'GxenYX+43lgXj5xIgKntugSkxqXYCxxNpfmLOVw+g4S0Torl3bzJXngPVqZ6JEhy'#10+
+    '+tfuXakCgYEA19/JCD/5pVPJtwyDDAYnUUESK+JfBPq1cTbsxcOq01mp5ntsqR4y'#10+
+    'dtOAmxMASvsqud3XIM5fO5m3Jpl1phiGhCw4nvVLcYzVWxYY+oWoeCSyECgu5tmT'#10+
+    'Fo8vn4EEXCkEAA2YPiEuVcrcYsWkLivCTC19lJDfUNMmpwSdiGz/tDU='#10+
+    '-----END RSA PRIVATE KEY-----'#10;
+var
+  aInput: String;
+  Signer: TJWTSignerRS256;
+begin
+  // header
+  jwt.JOSE.alg:='RS256';
+
+  // claims
+  jwt.Claims.exp:=DateTimeToUnix(Now+10);
+  jwt.Claims.iss:='FPC JWT';
+
+  // load private key from pem
+  FKey.AsBytes:=PemToDER(APrivateKeyPem,_BEGIN_RSA_PRIVATE_KEY,_END_RSA_PRIVATE_KEY);
+
+  Signer:=TJWTSignerRS256.Create;
+  try
+    aInput:=Signer.AppendSignature(JWT,Key);
+  finally
+    Signer.Free;
+  end;
+
+  FVerifyResult:=TMyJWT.ValidateJWT(aInput,FKey);
+  AssertNotNull('Have result',FVerifyResult);
+  AssertEquals('Correct class',TMyJWT,FVerifyResult.ClassType);
+  AssertNotNull('Have result.claims',FVerifyResult.Claims);
+  AssertEquals('Correct claims class',TMyClaims,FVerifyResult.Claims.ClassType);
+  AssertEquals('Have correct algorithm','RS256',FVerifyResult.JOSE.Alg);
+  AssertEquals('Have correct typ','JWT',FVerifyResult.JOSE.typ);
+  AssertEquals('Have correct sub','1234567890',FVerifyResult.Claims.sub);
+  AssertEquals('Have correct name','John Doe',(TMyJWT(FVerifyResult).Claims as TMyClaims).Name);
+  AssertEquals('Have correct admin',False,(TMyJWT(FVerifyResult).Claims as TMyClaims).Admin);
+end;
+
 procedure TTestJWT.SetUp;
-
-
 begin
   Inherited;
   FKey:=TJWTKey.Create('mysecretkey');
@@ -300,6 +363,18 @@ begin
   Inherited;
 end;
 
+function TTestJWT.CreateUnsignedInput(JOSEAlg, ClaimsIssuer: string): string;
+var
+  IssuedAt, Expire: Int64;
+  Header, Claims: String;
+begin
+  IssuedAt:=DateTimeToUnix(Now-1);
+  Expire:=IssuedAt+1000000;
+  Header:='{"typ":"JWT","alg":"'+JOSEAlg+'"}';
+  Claims:='{"iat":'+IntToStr(IssuedAt)+',"exp":'+IntToStr(Expire)+',"iss":"'+ClaimsIssuer+'"}';
+  Result:=Base64URL.Encode(Header,false)+'.'+Base64URL.Encode(Claims,false);
+end;
+
 initialization
   RegisterTest(TTestJWT);
 end.

packages/fcl-web/tests/testfpweb.lpi

@@ -38,7 +38,7 @@
         <PackageName Value="FCL"/>
       </Item1>
     </RequiredPackages>
-    <Units Count="8">
+    <Units Count="9">
       <Unit0>
         <Filename Value="testfpweb.lpr"/>
         <IsPartOfProject Value="True"/>
@@ -71,6 +71,10 @@
         <Filename Value="../src/jwt/fpjwaes256.pp"/>
         <IsPartOfProject Value="True"/>
       </Unit7>
+      <Unit8>
+        <Filename Value="../src/jwt/fpjwarsa.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit8>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

packages/fcl-web/tests/testfpweb.lpr

@@ -4,7 +4,7 @@ program testfpweb;
 
 uses
   Classes, consoletestrunner, tchttproute, tcjwt, jsonparser,
-  fpjwasha256, fpjwasha512, fpjwasha384, fpjwaes256;
+  fpjwasha256, fpjwasha512, fpjwasha384, fpjwaes256, fpjwarsa;
 
 type
 
@@ -19,6 +19,7 @@ var
   Application: TMyTestRunner;
 
 begin
+  Randomize;
   DefaultFormat:=fPlain;
   DefaultRunAllTests:=True;
   Application := TMyTestRunner.Create(nil);