From 51a199bb97049dc0035a364ca0a33b0f41aa0e7a Mon Sep 17 00:00:00 2001 From: "tulio.sousa" Date: Mon, 3 Jul 2023 13:59:06 -0300 Subject: [PATCH 1/2] Created constant for the exception message --- src/Horse.JWT.pas | 374 +++++++++++++++++++++------------------------- 1 file changed, 169 insertions(+), 205 deletions(-) diff --git a/src/Horse.JWT.pas b/src/Horse.JWT.pas index 90c86a4..eb02374 100644 --- a/src/Horse.JWT.pas +++ b/src/Horse.JWT.pas @@ -1,64 +1,43 @@ unit Horse.JWT; {$IF DEFINED(FPC)} -{$MODE DELPHI}{$H+} + {$MODE DELPHI}{$H+} {$ENDIF} interface uses {$IF DEFINED(FPC)} - Classes, - fpjson, - SysUtils, - HTTPDefs, - fpjwt, - Base64, - DateUtils, - jsonparser, - HlpIHashInfo, - HlpConverters, - HlpHashFactory, - StrUtils, + Generics.Collections, Classes, fpjson, SysUtils, HTTPDefs, fpjwt, Base64, DateUtils, jsonparser, + HlpIHashInfo, HlpConverters, HlpHashFactory, StrUtils, {$ELSE} - System.Generics.Collections, - System.Classes, - System.JSON, - System.SysUtils, - Web.HTTPApp, - REST.JSON, - JOSE.Core.JWT, - JOSE.Core.JWK, - JOSE.Core.Builder, - JOSE.Consumer.Validators, - JOSE.Consumer, - JOSE.Context, + System.Generics.Collections, System.Classes, System.JSON, System.SysUtils, Web.HTTPApp, REST.JSON, JOSE.Core.JWT, + JOSE.Core.JWK, JOSE.Core.Builder, JOSE.Consumer.Validators, JOSE.Consumer, JOSE.Context, {$ENDIF} - Horse, - Horse.Commons; + Horse, Horse.Commons; type IHorseJWTConfig = interface - ['{71A29190-1528-4E4D-932D-86094DDA9B4A}'] - function SkipRoutes: TArray; overload; - function SkipRoutes(const ARoutes: TArray): IHorseJWTConfig; overload; - function SkipRoutes(const ARoute: string): IHorseJWTConfig; overload; - function Header: string; overload; - function Header(const AValue: string): IHorseJWTConfig; overload; - function IsRequiredSubject: Boolean; overload; - function IsRequiredSubject(const AValue: Boolean): IHorseJWTConfig; overload; - function IsRequiredIssuedAt: Boolean; overload; - function IsRequiredIssuedAt(const AValue: Boolean): IHorseJWTConfig; overload; - function IsRequiredNotBefore: Boolean; overload; - function IsRequiredNotBefore(const AValue: Boolean): IHorseJWTConfig; overload; - function IsRequiredExpirationTime: Boolean; overload; - function IsRequiredExpirationTime(const AValue: Boolean): IHorseJWTConfig; overload; - function IsRequireAudience: Boolean; overload; - function IsRequireAudience(const AValue: Boolean): IHorseJWTConfig; overload; - function ExpectedAudience: TArray; overload; - function ExpectedAudience(const AValue: TArray): IHorseJWTConfig; overload; - function SessionClass: TClass; overload; - function SessionClass(const AValue: TClass): IHorseJWTConfig; overload; + ['{71A29190-1528-4E4D-932D-86094DDA9B4A}'] + function SkipRoutes: TArray; overload; + function SkipRoutes(const ARoutes: TArray): IHorseJWTConfig; overload; + function SkipRoutes(const ARoute: string): IHorseJWTConfig; overload; + function Header: string; overload; + function Header(const AValue: string): IHorseJWTConfig; overload; + function IsRequiredSubject: Boolean; overload; + function IsRequiredSubject(const AValue: Boolean): IHorseJWTConfig; overload; + function IsRequiredIssuedAt: Boolean; overload; + function IsRequiredIssuedAt(const AValue: Boolean): IHorseJWTConfig; overload; + function IsRequiredNotBefore: Boolean; overload; + function IsRequiredNotBefore(const AValue: Boolean): IHorseJWTConfig; overload; + function IsRequiredExpirationTime: Boolean; overload; + function IsRequiredExpirationTime(const AValue: Boolean): IHorseJWTConfig; overload; + function IsRequireAudience: Boolean; overload; + function IsRequireAudience(const AValue: Boolean): IHorseJWTConfig; overload; + function ExpectedAudience: TArray; overload; + function ExpectedAudience(const AValue: TArray): IHorseJWTConfig; overload; + function SessionClass: TClass; overload; + function SessionClass(const AValue: TClass): IHorseJWTConfig; overload; end; { THorseJWTConfig } @@ -98,22 +77,34 @@ THorseJWTConfig = class(TInterfacedObject, IHorseJWTConfig) class function New: IHorseJWTConfig; end; -function HorseJWT(const ASecretJWT: string; const AConfig: IHorseJWTConfig = nil): THorseCallback; +function HorseJWT(ASecretJWT: string; AConfig: IHorseJWTConfig = nil): THorseCallback; +procedure Middleware(AHorseRequest: THorseRequest; AHorseResponse: THorseResponse; ANext: {$IF DEFINED(FPC)}TNextProc{$ELSE}TProc{$ENDIF}); implementation -{$IF DEFINED(FPC) AND NOT DEFINED(HORSE_FPC_FUNCTIONREFERENCES)} var - SecretJWT: string; Config: IHorseJWTConfig; -{$ENDIF} + SecretJWT: string; + +const + TOKEN_NOT_FOUND = 'Token not found'; + INVALID_AUTHORIZATION_TYPE = 'Invalid authorization type'; + UNAUTHORIZED = 'Unauthorized'; + +function HorseJWT(ASecretJWT: string; AConfig: IHorseJWTConfig): THorseCallback; +begin + SecretJWT := ASecretJWT; + Config := AConfig; + if not Assigned(AConfig) then + Config := THorseJWTConfig.New; + Result := {$IF DEFINED(FPC)}@Middleware{$ELSE}Middleware{$ENDIF}; +end; -procedure Middleware(AHorseRequest: THorseRequest; AHorseResponse: THorseResponse; ANext: {$IF DEFINED(FPC)}TNextProc{$ELSE}TProc{$ENDIF}; const ASecretJWT: string; const AConfig: IHorseJWTConfig); +procedure Middleware(AHorseRequest: THorseRequest; + AHorseResponse: THorseResponse; ANext: {$IF DEFINED(FPC)}TNextProc{$ELSE}TProc{$ENDIF}); var {$IF DEFINED(FPC)} LJWT: TJWT; - LStartTokenPayloadPos: Integer; - LEndTokenPayloadPos: Integer; {$ELSE} LBuilder: IJOSEConsumerBuilder; LValidations: IJOSEConsumer; @@ -123,219 +114,192 @@ procedure Middleware(AHorseRequest: THorseRequest; AHorseResponse: THorseRespons LToken, LHeaderNormalize: string; LSession: TObject; LJSON: TJSONObject; - LConfig: IHorseJWTConfig; {$IF DEFINED(FPC)} function HexToAscii(const HexStr: string): AnsiString; - var - LByte: Byte; - LCmd: string; - LLength: Integer; - LIndex: Integer; + Var + B: Byte; + Cmd: string; + I, L: Integer; begin Result := ''; - LCmd := Trim(HexStr); - LIndex := 1; - LLength := Length(LCmd); - while LIndex < LLength do + Cmd := Trim(HexStr); + I := 1; + L := Length(Cmd); + + while I < L do begin - LByte := StrToInt('$' + copy(LCmd, LIndex, 2)); - Result := Result + AnsiChar(chr(LByte)); - Inc(LIndex, 2); + B := StrToInt('$' + copy(Cmd, I, 2)); + Result := Result + AnsiChar(chr(B)); + Inc( I, 2); end; end; function ValidateSignature: Boolean; var LHMAC: IHMAC; - LSignCalc: string; + LSignCalc: String; begin if (LJWT.JOSE.alg = 'HS256') then LHMAC := THashFactory.THMAC.CreateHMAC(THashFactory.TCrypto.CreateSHA2_256) - else - if (LJWT.JOSE.alg = 'HS384') then + else if (LJWT.JOSE.alg = 'HS384') then LHMAC := THashFactory.THMAC.CreateHMAC(THashFactory.TCrypto.CreateSHA2_384) - else - if (LJWT.JOSE.alg = 'HS512') then + else if (LJWT.JOSE.alg = 'HS512') then LHMAC := THashFactory.THMAC.CreateHMAC(THashFactory.TCrypto.CreateSHA2_512) else raise Exception.Create('[alg] not implemented'); - LHMAC.Key := TConverters.ConvertStringToBytes(UTF8Encode(ASecretJWT), TEncoding.UTF8); - LSignCalc := HexToAscii(TConverters.ConvertBytesToHexString(LHMAC.ComputeString(UTF8Encode(Trim(copy(LToken, 1, NPos('.', LToken, 2) - 1))), TEncoding.UTF8).GetBytes, False)); + LHMAC.Key := TConverters.ConvertStringToBytes(UTF8Encode(SecretJWT), TEncoding.UTF8); + LSignCalc := HexToAscii(TConverters.ConvertBytesToHexString(LHMAC.ComputeString(UTF8Encode(Trim(Copy(LToken,1,NPos('.',LToken,2)-1))), TEncoding.UTF8).GetBytes,False)); LSignCalc := LJWT.Base64ToBase64URL(EncodeStringBase64(LSignCalc)); Result := (LJWT.Signature = LSignCalc); end; {$ENDIF} begin - LConfig := AConfig; - if AConfig = nil then - LConfig := THorseJWTConfig.New; LPathInfo := AHorseRequest.RawWebRequest.PathInfo; if LPathInfo = EmptyStr then LPathInfo := '/'; - if MatchRoute(LPathInfo, LConfig.SkipRoutes) then + if MatchRoute(LPathInfo, Config.SkipRoutes) then begin ANext(); Exit; end; - LHeaderNormalize := LConfig.Header; + LHeaderNormalize := Config.Header; if Length(LHeaderNormalize) > 0 then LHeaderNormalize[1] := UpCase(LHeaderNormalize[1]); - LToken := AHorseRequest.Headers[LConfig.Header]; - if LToken.Trim.IsEmpty and not AHorseRequest.Query.TryGetValue( - LConfig.Header, LToken) and not AHorseRequest.Query.TryGetValue( - LHeaderNormalize, LToken) then + LToken := AHorseRequest.Headers[Config.Header]; + if LToken.Trim.IsEmpty and not AHorseRequest.Query.TryGetValue(Config.Header, LToken) and not AHorseRequest.Query.TryGetValue(LHeaderNormalize, LToken) then begin - AHorseResponse.Send('Token not found').Status(THTTPStatus.Unauthorized); - raise EHorseCallbackInterrupted.Create; + AHorseResponse.Send(TOKEN_NOT_FOUND).Status(THTTPStatus.Unauthorized); + raise EHorseCallbackInterrupted.Create(TOKEN_NOT_FOUND); end; if Pos('bearer', LowerCase(LToken)) = 0 then begin - AHorseResponse.Send('Invalid authorization type').Status(THTTPStatus.Unauthorized); - raise EHorseCallbackInterrupted.Create; + AHorseResponse.Send(INVALID_AUTHORIZATION_TYPE).Status(THTTPStatus.Unauthorized); + raise EHorseCallbackInterrupted.Create(INVALID_AUTHORIZATION_TYPE); end; LToken := Trim(LToken.Replace('bearer', '', [rfIgnoreCase])); - try -{$IFNDEF FPC} - LBuilder := TJOSEConsumerBuilder.NewConsumer.SetVerificationKey(ASecretJWT) - .SetSkipVerificationKeyValidation; - if Assigned(LConfig) then - begin - LBuilder.SetExpectedAudience(LConfig.IsRequireAudience, LConfig.ExpectedAudience); - if LConfig.IsRequiredExpirationTime then - LBuilder.SetRequireExpirationTime; - if LConfig.IsRequiredIssuedAt then - LBuilder.SetRequireIssuedAt; - if LConfig.IsRequiredNotBefore then - LBuilder.SetRequireNotBefore; - if LConfig.IsRequiredSubject then - LBuilder.SetRequireSubject; - end; + {$IFNDEF FPC} + LBuilder := TJOSEConsumerBuilder + .NewConsumer + .SetVerificationKey(SecretJWT) + .SetSkipVerificationKeyValidation; - LJWT := TJOSEContext.Create(LToken, TJWTClaims); - try - LValidations := LBuilder.Build; - try - LValidations.ProcessContext(LJWT); - LJSON := LJWT.GetClaims.JSON; - if Assigned(LConfig.SessionClass) then - begin - LSession := LConfig.SessionClass.Create; - TJWTClaims(LSession).JSON := LJSON.Clone as TJSONObject; - end - else - LSession := LJSON.Clone; -{$ELSE} + if Assigned(Config) then + begin + LBuilder.SetExpectedAudience(Config.IsRequireAudience, Config.ExpectedAudience); + if Config.IsRequiredExpirationTime then + LBuilder.SetRequireExpirationTime; + if Config.IsRequiredIssuedAt then + LBuilder.SetRequireIssuedAt; + if Config.IsRequiredNotBefore then + LBuilder.SetRequireNotBefore; + if Config.IsRequiredSubject then + LBuilder.SetRequireSubject; + end; + + LValidations := LBuilder.Build; + {$ENDIF} + + try + {$IF DEFINED(FPC)} LJWT := TJWT.Create; - try - LJWT.AsString := LToken; - try - if (Trim(LJWT.Signature) = EmptyStr) or (not ValidateSignature) then - raise Exception.Create('Invalid signature'); + LJWT.AsString := LToken; + if (Trim(LJWT.Signature) = EmptyStr) or (not ValidateSignature) then + raise Exception.Create('Invalid signature'); - if (LJWT.Claims.exp <> 0) and (LJWT.Claims.exp < DateTimeToUnix(Now)) then - raise Exception.Create(Format( + if (LJWT.Claims.exp <> 0) and (LJWT.Claims.exp < DateTimeToUnix(Now)) then + raise Exception.Create(Format( 'The JWT is no longer valid - the evaluation time [%s] is on or after the Expiration Time [exp=%s]', [DateToISO8601(Now, False), DateToISO8601(LJWT.Claims.exp, False)])); - if (LJWT.Claims.nbf <> 0) and (LJWT.Claims.nbf < DateTimeToUnix(Now)) then - raise Exception.Create(Format('The JWT is not yet valid as the evaluation time [%s] is before the NotBefore [nbf=%s]', + if (LJWT.Claims.nbf <> 0) and (LJWT.Claims.nbf < DateTimeToUnix(Now)) then + raise Exception.Create(Format('The JWT is not yet valid as the evaluation time [%s] is before the NotBefore [nbf=%s]', [DateToISO8601(Now, False), DateToISO8601(LJWT.Claims.nbf)])); - if Assigned(LConfig) then - begin - if LConfig.IsRequireAudience and ((LJWT.Claims.aud) = EmptyStr) then - raise Exception.Create('No Audience [aud] claim present'); - - if (Length(LConfig.ExpectedAudience) > 0) and (not MatchText(LJWT.Claims.aud, LConfig.ExpectedAudience)) then - raise Exception.Create('Audience [aud] claim present in the JWT but no expected audience value(s) were provided'); - - if LConfig.IsRequiredExpirationTime and ((LJWT.Claims.exp) = 0) then - raise Exception.Create('No Expiration Time [exp] claim present'); - - if LConfig.IsRequiredIssuedAt and ((LJWT.Claims.iat) = 0) then - raise Exception.Create('No IssuedAt [iat] claim present'); - - if LConfig.IsRequiredNotBefore and ((LJWT.Claims.nbf) = 0) then - raise Exception.Create('No NotBefore [nbf] claim present'); - - if LConfig.IsRequiredSubject and ((LJWT.Claims.sub) = EmptyStr) then - raise Exception.Create('No Subject [sub] claim present'); - end; - LStartTokenPayloadPos := Pos('.', LToken) + 1; - LEndTokenPayloadPos := NPos('.', LToken, 2) - LStartTokenPayloadPos; - LJSON := GetJSON(LJWT.DecodeString(copy(LToken, LStartTokenPayloadPos, LEndTokenPayloadPos))) as TJSONObject; - if Assigned(LConfig.SessionClass) then - begin - LSession := LConfig.SessionClass.Create; - TClaims(LSession).LoadFromJSON(LJSON); - end - else - LSession := LJSON; -{$ENDIF} - AHorseRequest.Session(LSession); - except - on E: Exception do - begin - AHorseResponse.Send('Unauthorized').Status(THTTPStatus.Unauthorized); - raise EHorseCallbackInterrupted.Create; - end; - end; - finally - LJWT.Free; + if Assigned(Config) then + begin + if Config.IsRequireAudience and ((LJWT.Claims.aud) = EmptyStr) then + raise Exception.Create('No Audience [aud] claim present'); + + if (Length(Config.ExpectedAudience)>0) and (not MatchText(LJWT.Claims.aud, Config.ExpectedAudience)) then + raise Exception.Create('Audience [aud] claim present in the JWT but no expected audience value(s) were provided'); + + if Config.IsRequiredExpirationTime and ((LJWT.Claims.exp) = 0) then + raise Exception.Create('No Expiration Time [exp] claim present'); + + if Config.IsRequiredIssuedAt and ((LJWT.Claims.iat) = 0) then + raise Exception.Create('No IssuedAt [iat] claim present'); + + if Config.IsRequiredNotBefore and ((LJWT.Claims.nbf) = 0) then + raise Exception.Create('No NotBefore [nbf] claim present'); + + if Config.IsRequiredSubject and ((LJWT.Claims.sub) = EmptyStr) then + raise Exception.Create('No Subject [sub] claim present'); end; + {$ELSE} + LJWT := TJOSEContext.Create(LToken, TJWTClaims); + {$ENDIF} except - on E: EHorseCallbackInterrupted do - raise; - on E: Exception do + on E: exception do begin - AHorseResponse.Send('Invalid token authorization. ' + E.Message).Status(THTTPStatus.Unauthorized); + AHorseResponse.Send('Invalid token authorization. '+E.Message).Status(THTTPStatus.Unauthorized); raise EHorseCallbackInterrupted.Create; end; end; + try - ANext(); + try + {$IF DEFINED(FPC)} + LJSON := TJSONObject(LJWT.Claims.AsString); + {$ELSE} + LValidations.ProcessContext(LJWT); + LJSON := LJWT.GetClaims.JSON; + {$ENDIF} + + if Assigned(Config.SessionClass) then + begin + LSession := Config.SessionClass.Create; + {$IF DEFINED(FPC)} + TClaims(LSession).LoadFromJSON(LJSON); + {$ELSE} + TJWTClaims(LSession).JSON := LJSON.Clone as TJSONObject; + {$ENDIF} + end + else + {$IF DEFINED(FPC)} + LSession := LJSON; + {$ELSE} + LSession := LJSON.Clone; + {$ENDIF} + + AHorseRequest.Session(LSession); + except + on E: exception do + begin + if E.InheritsFrom(EHorseCallbackInterrupted) then + raise EHorseCallbackInterrupted(E); + AHorseResponse.Send(UNAUTHORIZED).Status(THTTPStatus.Unauthorized); + raise EHorseCallbackInterrupted.Create(UNAUTHORIZED); + end; + end; + try + ANext(); + finally + {$IFNDEF FPC} + if Assigned(LSession) then + LSession.Free; + {$ENDIF} + end; finally - LSession.Free; - end; -end; - -{$IF DEFINED(FPC) AND NOT DEFINED(HORSE_FPC_FUNCTIONREFERENCES)} -procedure Callback(AHorseRequest: THorseRequest; AHorseResponse: THorseResponse; ANext: {$IF DEFINED(FPC)}TNextProc{$ELSE}TProc{$ENDIF}); -begin - Middleware(AHorseRequest, AHorseResponse, ANext, SecretJWT, Config); -end; -{$ENDIF} - -function HorseJWT(const ASecretJWT: string; const AConfig: IHorseJWTConfig): THorseCallback; -{$IF DEFINED(FPC) AND DEFINED(HORSE_FPC_FUNCTIONREFERENCES)} - procedure InternalCallback(AHorseRequest: THorseRequest; AHorseResponse: THorseResponse; ANext: TNextProc); - begin - Middleware(AHorseRequest, AHorseResponse, ANext, ASecretJWT, AConfig); + LJWT.Free; end; -{$ENDIF} -begin -{$IF DEFINED(FPC)} -{$IF NOT DEFINED(HORSE_FPC_FUNCTIONREFERENCES)} - SecretJWT := ASecretJWT; - Config := AConfig; - Result := Callback; -{$ELSE} - Result := InternalCallback; -{$ENDIF} -{$ELSE} - Result := procedure(AHorseRequest: THorseRequest; AHorseResponse: THorseResponse; ANext: TProc) - begin - Middleware(AHorseRequest, AHorseResponse, ANext, ASecretJWT, AConfig); - end; -{$ENDIF} end; { THorseJWTConfig } @@ -351,7 +315,7 @@ function THorseJWTConfig.SkipRoutes(const ARoutes: TArray): IHorseJWTCon begin FSkipRoutes := ARoutes; for I := 0 to Pred(Length(FSkipRoutes)) do - if copy(Trim(FSkipRoutes[I]), 1, 1) <> '/' then + if Copy(Trim(FSkipRoutes[I]), 1, 1) <> '/' then FSkipRoutes[I] := '/' + FSkipRoutes[I]; Result := Self; end; From a81d147a25efbec9b702d23c8bc3e2dbcef42570 Mon Sep 17 00:00:00 2001 From: "tulio.sousa" Date: Mon, 3 Jul 2023 14:14:01 -0300 Subject: [PATCH 2/2] Created constant for the exception message --- src/Horse.JWT.pas | 361 ++++++++++++++++++++++++++-------------------- 1 file changed, 201 insertions(+), 160 deletions(-) diff --git a/src/Horse.JWT.pas b/src/Horse.JWT.pas index eb02374..47a0685 100644 --- a/src/Horse.JWT.pas +++ b/src/Horse.JWT.pas @@ -1,43 +1,64 @@ unit Horse.JWT; {$IF DEFINED(FPC)} - {$MODE DELPHI}{$H+} +{$MODE DELPHI}{$H+} {$ENDIF} interface uses {$IF DEFINED(FPC)} - Generics.Collections, Classes, fpjson, SysUtils, HTTPDefs, fpjwt, Base64, DateUtils, jsonparser, - HlpIHashInfo, HlpConverters, HlpHashFactory, StrUtils, + Classes, + fpjson, + SysUtils, + HTTPDefs, + fpjwt, + Base64, + DateUtils, + jsonparser, + HlpIHashInfo, + HlpConverters, + HlpHashFactory, + StrUtils, {$ELSE} - System.Generics.Collections, System.Classes, System.JSON, System.SysUtils, Web.HTTPApp, REST.JSON, JOSE.Core.JWT, - JOSE.Core.JWK, JOSE.Core.Builder, JOSE.Consumer.Validators, JOSE.Consumer, JOSE.Context, + System.Generics.Collections, + System.Classes, + System.JSON, + System.SysUtils, + Web.HTTPApp, + REST.JSON, + JOSE.Core.JWT, + JOSE.Core.JWK, + JOSE.Core.Builder, + JOSE.Consumer.Validators, + JOSE.Consumer, + JOSE.Context, {$ENDIF} - Horse, Horse.Commons; + Horse, + Horse.Commons; type IHorseJWTConfig = interface - ['{71A29190-1528-4E4D-932D-86094DDA9B4A}'] - function SkipRoutes: TArray; overload; - function SkipRoutes(const ARoutes: TArray): IHorseJWTConfig; overload; - function SkipRoutes(const ARoute: string): IHorseJWTConfig; overload; - function Header: string; overload; - function Header(const AValue: string): IHorseJWTConfig; overload; - function IsRequiredSubject: Boolean; overload; - function IsRequiredSubject(const AValue: Boolean): IHorseJWTConfig; overload; - function IsRequiredIssuedAt: Boolean; overload; - function IsRequiredIssuedAt(const AValue: Boolean): IHorseJWTConfig; overload; - function IsRequiredNotBefore: Boolean; overload; - function IsRequiredNotBefore(const AValue: Boolean): IHorseJWTConfig; overload; - function IsRequiredExpirationTime: Boolean; overload; - function IsRequiredExpirationTime(const AValue: Boolean): IHorseJWTConfig; overload; - function IsRequireAudience: Boolean; overload; - function IsRequireAudience(const AValue: Boolean): IHorseJWTConfig; overload; - function ExpectedAudience: TArray; overload; - function ExpectedAudience(const AValue: TArray): IHorseJWTConfig; overload; - function SessionClass: TClass; overload; - function SessionClass(const AValue: TClass): IHorseJWTConfig; overload; + ['{71A29190-1528-4E4D-932D-86094DDA9B4A}'] + function SkipRoutes: TArray; overload; + function SkipRoutes(const ARoutes: TArray): IHorseJWTConfig; overload; + function SkipRoutes(const ARoute: string): IHorseJWTConfig; overload; + function Header: string; overload; + function Header(const AValue: string): IHorseJWTConfig; overload; + function IsRequiredSubject: Boolean; overload; + function IsRequiredSubject(const AValue: Boolean): IHorseJWTConfig; overload; + function IsRequiredIssuedAt: Boolean; overload; + function IsRequiredIssuedAt(const AValue: Boolean): IHorseJWTConfig; overload; + function IsRequiredNotBefore: Boolean; overload; + function IsRequiredNotBefore(const AValue: Boolean): IHorseJWTConfig; overload; + function IsRequiredExpirationTime: Boolean; overload; + function IsRequiredExpirationTime(const AValue: Boolean): IHorseJWTConfig; overload; + function IsRequireAudience: Boolean; overload; + function IsRequireAudience(const AValue: Boolean): IHorseJWTConfig; overload; + function ExpectedAudience: TArray; overload; + function ExpectedAudience(const AValue: TArray): IHorseJWTConfig; overload; + function SessionClass: TClass; overload; + function SessionClass(const AValue: TClass): IHorseJWTConfig; overload; end; { THorseJWTConfig } @@ -77,34 +98,27 @@ THorseJWTConfig = class(TInterfacedObject, IHorseJWTConfig) class function New: IHorseJWTConfig; end; -function HorseJWT(ASecretJWT: string; AConfig: IHorseJWTConfig = nil): THorseCallback; -procedure Middleware(AHorseRequest: THorseRequest; AHorseResponse: THorseResponse; ANext: {$IF DEFINED(FPC)}TNextProc{$ELSE}TProc{$ENDIF}); +function HorseJWT(const ASecretJWT: string; const AConfig: IHorseJWTConfig = nil): THorseCallback; implementation +{$IF DEFINED(FPC) AND NOT DEFINED(HORSE_FPC_FUNCTIONREFERENCES)} var - Config: IHorseJWTConfig; SecretJWT: string; + Config: IHorseJWTConfig; +{$ENDIF} const TOKEN_NOT_FOUND = 'Token not found'; INVALID_AUTHORIZATION_TYPE = 'Invalid authorization type'; UNAUTHORIZED = 'Unauthorized'; -function HorseJWT(ASecretJWT: string; AConfig: IHorseJWTConfig): THorseCallback; -begin - SecretJWT := ASecretJWT; - Config := AConfig; - if not Assigned(AConfig) then - Config := THorseJWTConfig.New; - Result := {$IF DEFINED(FPC)}@Middleware{$ELSE}Middleware{$ENDIF}; -end; - -procedure Middleware(AHorseRequest: THorseRequest; - AHorseResponse: THorseResponse; ANext: {$IF DEFINED(FPC)}TNextProc{$ELSE}TProc{$ENDIF}); +procedure Middleware(AHorseRequest: THorseRequest; AHorseResponse: THorseResponse; ANext: {$IF DEFINED(FPC)}TNextProc{$ELSE}TProc{$ENDIF}; const ASecretJWT: string; const AConfig: IHorseJWTConfig); var {$IF DEFINED(FPC)} LJWT: TJWT; + LStartTokenPayloadPos: Integer; + LEndTokenPayloadPos: Integer; {$ELSE} LBuilder: IJOSEConsumerBuilder; LValidations: IJOSEConsumer; @@ -114,64 +128,72 @@ procedure Middleware(AHorseRequest: THorseRequest; LToken, LHeaderNormalize: string; LSession: TObject; LJSON: TJSONObject; + LConfig: IHorseJWTConfig; {$IF DEFINED(FPC)} function HexToAscii(const HexStr: string): AnsiString; - Var - B: Byte; - Cmd: string; - I, L: Integer; + var + LByte: Byte; + LCmd: string; + LLength: Integer; + LIndex: Integer; begin Result := ''; - Cmd := Trim(HexStr); - I := 1; - L := Length(Cmd); - - while I < L do + LCmd := Trim(HexStr); + LIndex := 1; + LLength := Length(LCmd); + while LIndex < LLength do begin - B := StrToInt('$' + copy(Cmd, I, 2)); - Result := Result + AnsiChar(chr(B)); - Inc( I, 2); + LByte := StrToInt('$' + copy(LCmd, LIndex, 2)); + Result := Result + AnsiChar(chr(LByte)); + Inc(LIndex, 2); end; end; function ValidateSignature: Boolean; var LHMAC: IHMAC; - LSignCalc: String; + LSignCalc: string; begin if (LJWT.JOSE.alg = 'HS256') then LHMAC := THashFactory.THMAC.CreateHMAC(THashFactory.TCrypto.CreateSHA2_256) - else if (LJWT.JOSE.alg = 'HS384') then + else + if (LJWT.JOSE.alg = 'HS384') then LHMAC := THashFactory.THMAC.CreateHMAC(THashFactory.TCrypto.CreateSHA2_384) - else if (LJWT.JOSE.alg = 'HS512') then + else + if (LJWT.JOSE.alg = 'HS512') then LHMAC := THashFactory.THMAC.CreateHMAC(THashFactory.TCrypto.CreateSHA2_512) else raise Exception.Create('[alg] not implemented'); - LHMAC.Key := TConverters.ConvertStringToBytes(UTF8Encode(SecretJWT), TEncoding.UTF8); - LSignCalc := HexToAscii(TConverters.ConvertBytesToHexString(LHMAC.ComputeString(UTF8Encode(Trim(Copy(LToken,1,NPos('.',LToken,2)-1))), TEncoding.UTF8).GetBytes,False)); + LHMAC.Key := TConverters.ConvertStringToBytes(UTF8Encode(ASecretJWT), TEncoding.UTF8); + LSignCalc := HexToAscii(TConverters.ConvertBytesToHexString(LHMAC.ComputeString(UTF8Encode(Trim(copy(LToken, 1, NPos('.', LToken, 2) - 1))), TEncoding.UTF8).GetBytes, False)); LSignCalc := LJWT.Base64ToBase64URL(EncodeStringBase64(LSignCalc)); Result := (LJWT.Signature = LSignCalc); end; {$ENDIF} begin + LConfig := AConfig; + if AConfig = nil then + LConfig := THorseJWTConfig.New; LPathInfo := AHorseRequest.RawWebRequest.PathInfo; if LPathInfo = EmptyStr then LPathInfo := '/'; - if MatchRoute(LPathInfo, Config.SkipRoutes) then + if MatchRoute(LPathInfo, LConfig.SkipRoutes) then begin ANext(); Exit; end; - LHeaderNormalize := Config.Header; + LHeaderNormalize := LConfig.Header; if Length(LHeaderNormalize) > 0 then LHeaderNormalize[1] := UpCase(LHeaderNormalize[1]); - LToken := AHorseRequest.Headers[Config.Header]; - if LToken.Trim.IsEmpty and not AHorseRequest.Query.TryGetValue(Config.Header, LToken) and not AHorseRequest.Query.TryGetValue(LHeaderNormalize, LToken) then + LToken := AHorseRequest.Headers[LConfig.Header]; + if LToken.Trim.IsEmpty and not AHorseRequest.Query.TryGetValue( + LConfig.Header, LToken) and not AHorseRequest.Query.TryGetValue( + LHeaderNormalize, LToken) then begin AHorseResponse.Send(TOKEN_NOT_FOUND).Status(THTTPStatus.Unauthorized); raise EHorseCallbackInterrupted.Create(TOKEN_NOT_FOUND); @@ -184,122 +206,141 @@ procedure Middleware(AHorseRequest: THorseRequest; end; LToken := Trim(LToken.Replace('bearer', '', [rfIgnoreCase])); + try +{$IFNDEF FPC} + LBuilder := TJOSEConsumerBuilder.NewConsumer.SetVerificationKey(ASecretJWT) + .SetSkipVerificationKeyValidation; - {$IFNDEF FPC} - LBuilder := TJOSEConsumerBuilder - .NewConsumer - .SetVerificationKey(SecretJWT) - .SetSkipVerificationKeyValidation; - - if Assigned(Config) then - begin - LBuilder.SetExpectedAudience(Config.IsRequireAudience, Config.ExpectedAudience); - if Config.IsRequiredExpirationTime then - LBuilder.SetRequireExpirationTime; - if Config.IsRequiredIssuedAt then - LBuilder.SetRequireIssuedAt; - if Config.IsRequiredNotBefore then - LBuilder.SetRequireNotBefore; - if Config.IsRequiredSubject then - LBuilder.SetRequireSubject; - end; - - LValidations := LBuilder.Build; - {$ENDIF} + if Assigned(LConfig) then + begin + LBuilder.SetExpectedAudience(LConfig.IsRequireAudience, LConfig.ExpectedAudience); + if LConfig.IsRequiredExpirationTime then + LBuilder.SetRequireExpirationTime; + if LConfig.IsRequiredIssuedAt then + LBuilder.SetRequireIssuedAt; + if LConfig.IsRequiredNotBefore then + LBuilder.SetRequireNotBefore; + if LConfig.IsRequiredSubject then + LBuilder.SetRequireSubject; + end; - try - {$IF DEFINED(FPC)} + LJWT := TJOSEContext.Create(LToken, TJWTClaims); + try + LValidations := LBuilder.Build; + try + LValidations.ProcessContext(LJWT); + LJSON := LJWT.GetClaims.JSON; + if Assigned(LConfig.SessionClass) then + begin + LSession := LConfig.SessionClass.Create; + TJWTClaims(LSession).JSON := LJSON.Clone as TJSONObject; + end + else + LSession := LJSON.Clone; +{$ELSE} LJWT := TJWT.Create; - LJWT.AsString := LToken; - if (Trim(LJWT.Signature) = EmptyStr) or (not ValidateSignature) then - raise Exception.Create('Invalid signature'); + try + LJWT.AsString := LToken; + try + if (Trim(LJWT.Signature) = EmptyStr) or (not ValidateSignature) then + raise Exception.Create('Invalid signature'); - if (LJWT.Claims.exp <> 0) and (LJWT.Claims.exp < DateTimeToUnix(Now)) then - raise Exception.Create(Format( + if (LJWT.Claims.exp <> 0) and (LJWT.Claims.exp < DateTimeToUnix(Now)) then + raise Exception.Create(Format( 'The JWT is no longer valid - the evaluation time [%s] is on or after the Expiration Time [exp=%s]', [DateToISO8601(Now, False), DateToISO8601(LJWT.Claims.exp, False)])); - if (LJWT.Claims.nbf <> 0) and (LJWT.Claims.nbf < DateTimeToUnix(Now)) then - raise Exception.Create(Format('The JWT is not yet valid as the evaluation time [%s] is before the NotBefore [nbf=%s]', + if (LJWT.Claims.nbf <> 0) and (LJWT.Claims.nbf < DateTimeToUnix(Now)) then + raise Exception.Create(Format('The JWT is not yet valid as the evaluation time [%s] is before the NotBefore [nbf=%s]', [DateToISO8601(Now, False), DateToISO8601(LJWT.Claims.nbf)])); - if Assigned(Config) then - begin - if Config.IsRequireAudience and ((LJWT.Claims.aud) = EmptyStr) then - raise Exception.Create('No Audience [aud] claim present'); - - if (Length(Config.ExpectedAudience)>0) and (not MatchText(LJWT.Claims.aud, Config.ExpectedAudience)) then - raise Exception.Create('Audience [aud] claim present in the JWT but no expected audience value(s) were provided'); - - if Config.IsRequiredExpirationTime and ((LJWT.Claims.exp) = 0) then - raise Exception.Create('No Expiration Time [exp] claim present'); - - if Config.IsRequiredIssuedAt and ((LJWT.Claims.iat) = 0) then - raise Exception.Create('No IssuedAt [iat] claim present'); - - if Config.IsRequiredNotBefore and ((LJWT.Claims.nbf) = 0) then - raise Exception.Create('No NotBefore [nbf] claim present'); - - if Config.IsRequiredSubject and ((LJWT.Claims.sub) = EmptyStr) then - raise Exception.Create('No Subject [sub] claim present'); + if Assigned(LConfig) then + begin + if LConfig.IsRequireAudience and ((LJWT.Claims.aud) = EmptyStr) then + raise Exception.Create('No Audience [aud] claim present'); + + if (Length(LConfig.ExpectedAudience) > 0) and (not MatchText(LJWT.Claims.aud, LConfig.ExpectedAudience)) then + raise Exception.Create('Audience [aud] claim present in the JWT but no expected audience value(s) were provided'); + + if LConfig.IsRequiredExpirationTime and ((LJWT.Claims.exp) = 0) then + raise Exception.Create('No Expiration Time [exp] claim present'); + + if LConfig.IsRequiredIssuedAt and ((LJWT.Claims.iat) = 0) then + raise Exception.Create('No IssuedAt [iat] claim present'); + + if LConfig.IsRequiredNotBefore and ((LJWT.Claims.nbf) = 0) then + raise Exception.Create('No NotBefore [nbf] claim present'); + + if LConfig.IsRequiredSubject and ((LJWT.Claims.sub) = EmptyStr) then + raise Exception.Create('No Subject [sub] claim present'); + end; + LStartTokenPayloadPos := Pos('.', LToken) + 1; + LEndTokenPayloadPos := NPos('.', LToken, 2) - LStartTokenPayloadPos; + LJSON := GetJSON(LJWT.DecodeString(copy(LToken, LStartTokenPayloadPos, LEndTokenPayloadPos))) as TJSONObject; + if Assigned(LConfig.SessionClass) then + begin + LSession := LConfig.SessionClass.Create; + TClaims(LSession).LoadFromJSON(LJSON); + end + else + LSession := LJSON; +{$ENDIF} + AHorseRequest.Session(LSession); + except + on E: Exception do + begin + AHorseResponse.Send(UNAUTHORIZED).Status(THTTPStatus.Unauthorized); + raise EHorseCallbackInterrupted.Create(UNAUTHORIZED); + end; + end; + finally + LJWT.Free; end; - {$ELSE} - LJWT := TJOSEContext.Create(LToken, TJWTClaims); - {$ENDIF} except - on E: exception do + on E: EHorseCallbackInterrupted do + raise; + on E: Exception do begin - AHorseResponse.Send('Invalid token authorization. '+E.Message).Status(THTTPStatus.Unauthorized); + AHorseResponse.Send('Invalid token authorization. ' + E.Message).Status(THTTPStatus.Unauthorized); raise EHorseCallbackInterrupted.Create; end; end; - try - try - {$IF DEFINED(FPC)} - LJSON := TJSONObject(LJWT.Claims.AsString); - {$ELSE} - LValidations.ProcessContext(LJWT); - LJSON := LJWT.GetClaims.JSON; - {$ENDIF} - - if Assigned(Config.SessionClass) then - begin - LSession := Config.SessionClass.Create; - {$IF DEFINED(FPC)} - TClaims(LSession).LoadFromJSON(LJSON); - {$ELSE} - TJWTClaims(LSession).JSON := LJSON.Clone as TJSONObject; - {$ENDIF} - end - else - {$IF DEFINED(FPC)} - LSession := LJSON; - {$ELSE} - LSession := LJSON.Clone; - {$ENDIF} - - AHorseRequest.Session(LSession); - except - on E: exception do - begin - if E.InheritsFrom(EHorseCallbackInterrupted) then - raise EHorseCallbackInterrupted(E); - AHorseResponse.Send(UNAUTHORIZED).Status(THTTPStatus.Unauthorized); - raise EHorseCallbackInterrupted.Create(UNAUTHORIZED); - end; - end; - try - ANext(); - finally - {$IFNDEF FPC} - if Assigned(LSession) then - LSession.Free; - {$ENDIF} - end; + ANext(); finally - LJWT.Free; + LSession.Free; + end; +end; + +{$IF DEFINED(FPC) AND NOT DEFINED(HORSE_FPC_FUNCTIONREFERENCES)} +procedure Callback(AHorseRequest: THorseRequest; AHorseResponse: THorseResponse; ANext: {$IF DEFINED(FPC)}TNextProc{$ELSE}TProc{$ENDIF}); +begin + Middleware(AHorseRequest, AHorseResponse, ANext, SecretJWT, Config); +end; +{$ENDIF} + +function HorseJWT(const ASecretJWT: string; const AConfig: IHorseJWTConfig): THorseCallback; +{$IF DEFINED(FPC) AND DEFINED(HORSE_FPC_FUNCTIONREFERENCES)} + procedure InternalCallback(AHorseRequest: THorseRequest; AHorseResponse: THorseResponse; ANext: TNextProc); + begin + Middleware(AHorseRequest, AHorseResponse, ANext, ASecretJWT, AConfig); end; +{$ENDIF} +begin +{$IF DEFINED(FPC)} +{$IF NOT DEFINED(HORSE_FPC_FUNCTIONREFERENCES)} + SecretJWT := ASecretJWT; + Config := AConfig; + Result := Callback; +{$ELSE} + Result := InternalCallback; +{$ENDIF} +{$ELSE} + Result := procedure(AHorseRequest: THorseRequest; AHorseResponse: THorseResponse; ANext: TProc) + begin + Middleware(AHorseRequest, AHorseResponse, ANext, ASecretJWT, AConfig); + end; +{$ENDIF} end; { THorseJWTConfig } @@ -315,7 +356,7 @@ function THorseJWTConfig.SkipRoutes(const ARoutes: TArray): IHorseJWTCon begin FSkipRoutes := ARoutes; for I := 0 to Pred(Length(FSkipRoutes)) do - if Copy(Trim(FSkipRoutes[I]), 1, 1) <> '/' then + if copy(Trim(FSkipRoutes[I]), 1, 1) <> '/' then FSkipRoutes[I] := '/' + FSkipRoutes[I]; Result := Self; end;