fcl-hash: asn check boundary, added rsa private/public key parse functions

packages/fcl-hash/src/fpasn.pp

@@ -5,7 +5,7 @@ unit fpasn;
 interface
 
 uses
- Basenenc, Classes, SysUtils, fphashutils;
+  Basenenc, Classes, SysUtils, fphashutils;
 
 const
   ASN1_BOOL       = $01;
@@ -49,29 +49,26 @@ const
 //------------------------------------------------------------------------------
 // ASN
 //------------------------------------------------------------------------------
-procedure ASNEncodeOID(const Value: Int64; var Result: AnsiString);
-function ASNDecodeOID(var Start: Integer; const S: AnsiString): Int64; overload;
+procedure ASNEncodeOID(const Value: Int64; var Result: String);
+function ASNDecodeOID(var Start: Integer; const S: String): Int64; overload;
 function ASNDecodeOID(var Buffer: PByte; BufferEnd: PByte): Int64; overload;
 function ASNGetEncodedLen(const Len: Integer): Integer;
 procedure ASNEncodeLen(const Len: Integer; var Buffer: TBytes);
-function ASNReadLen(const Buffer: TBytes; var Offset: Int32): Int32;
+function ASNReadLen(var Buffer: PByte; BufferEnd: PByte): Int32;
 procedure ASNEncodeInt(Value: Int64; var Result: TBytes);
 procedure ASNEncodeUInt(Value: Integer; var Result: TBytes);
 // Encodes ASN.1 object to binary form
-procedure ASNObject(const Data: Ansistring; const ASNType: Integer; var Buffer: TBytes);
-// Encodes an MIB OID Ansistring to binary form
-procedure MibToId(Mib: Ansistring; var Result: AnsiString);
-// Decodes MIB OID from binary form to Ansistring form.
-procedure IdToMib(const Id: Ansistring; var Result: Ansistring); overload;
+procedure ASNObject(const Data: String; const ASNType: Integer; var Buffer: TBytes);
+// Encodes an MIB OID String to binary form
+procedure MibToId(Mib: String; var Result: String);
+// Decodes MIB OID from binary form to String form.
+procedure IdToMib(const Id: String; var Result: String); overload;
 function IdToMib(Buffer, BufferEnd: PByte): string; overload;
 procedure ASNDebug(const Buffer: TBytes; var Output: TBytes);
 procedure ASNParse(const Buffer: TBytes; List: TStrings);
-procedure PemToDER(const PEM: AnsiString; const BeginTag, EndTag: Ansistring; Out DER: TBytes); overload;
-procedure PemToDER(PEM: TBytes; const BeginTag, EndTag: Ansistring; Out DER: TBytes); overload;
-procedure ASNParsePemSection(const PEM: TBytes; List: TStrings; const BeginTag, EndTag: Ansistring);
-procedure ASNParsePemSection(const PEM: AnsiString; List: TStrings; const BeginTag, EndTag: Ansistring);
+procedure ASNParse_GetItem(List: TStrings; Index: integer; out ASNType, ASNSize: integer);
+function ASNParse_GetIntBytes(List: TStrings; ListIndex: integer; ID: int64): TBytes;
 
-function ASNFetch(const Buffer: TBytes; var Offset: Int32; Out ASNType, ASNSize: Int32): Boolean; overload;
 function ASNFetch(var Buffer: PByte; BufferEnd: PByte; Out ASNType, ASNSize: Int32): Boolean; overload;
 function ASNFetchOID(var Buffer: PByte; BufferEnd: PByte; out OID: String): Boolean; overload;
 
@@ -81,13 +78,13 @@ implementation
 // ASN
 //------------------------------------------------------------------------------
 
-procedure ASNEncodeOID(const Value: Int64; var Result: Ansistring);
+procedure ASNEncodeOID(const Value: Int64; var Result: String);
 var
   B: Boolean;
   I: Integer;
   x: Int64;
   Modulo: Byte;
-  S: Ansistring;
+  S: String;
 
 begin
   S:='';
@@ -107,7 +104,7 @@ begin
 end;
 
 // @Start=0
-function ASNDecodeOID(var Start: Integer; const S: AnsiString): Int64;
+function ASNDecodeOID(var Start: Integer; const S: String): Int64;
 var
   x: Integer;
 begin
@@ -138,7 +135,7 @@ end;
 procedure ASNEncodeLen(const Len: Integer; var Buffer: TBytes);
 var
   x, y: Integer;
-  S: AnsiString;
+  S: String;
 
 begin
   if Len < $80 then
@@ -175,25 +172,24 @@ begin
   end;
 end;
 
-function ASNReadLen(const Buffer: TBytes; var Offset: Int32): Int32;
+function ASNReadLen(var Buffer: PByte; BufferEnd: PByte): Int32;
 var
   Len: Integer;
 begin
-  Result := Buffer[Offset];
-  Inc(Offset);
+  if Buffer>BufferEnd then
+    raise Exception.Create('20220428135218');
+  Result := Buffer^;
+  Inc(Buffer);
   if Result < $80 then
     Exit;
   Len := Result and $7F;
-  if (Len>4) or (Offset+Len >= length(Buffer)) then
-  begin
-    Offset:=length(Buffer)+1;
-    exit;
-  end;
+  if (Len>4) or (BufferEnd-Buffer < Len) then
+    raise Exception.Create('20220428135333');
   Result := 0;
   while Len > 0 do
   begin
-    Result := Result*256 + Buffer[Offset];
-    Inc(Offset);
+    Result := Result*256 + Buffer^;
+    Inc(Buffer);
     Dec(Len);
   end;
 end;
@@ -204,7 +200,7 @@ var
   x: Int64;
   y: byte;
   neg: Boolean;
-  S : AnsiString;
+  S : String;
 begin
   S:='';
   neg := Value < 0;
@@ -230,7 +226,7 @@ procedure ASNEncodeUInt(Value: Integer; var Result: TBytes);
 var
   x, y: Integer;
   neg: Boolean;
-  S : AnsiString;
+  S : String;
 
 begin
   neg := Value < 0;
@@ -249,7 +245,7 @@ begin
     Result:=Concat(Result,[Ord(S[y])]);
 end;
 
-Procedure AppendStringToBuffer(var Buffer: TBytes; const aString : AnsiString);
+Procedure AppendStringToBuffer(var Buffer: TBytes; const aString : String);
 
 Var
   Buflen,sLen : integer;
@@ -262,7 +258,7 @@ begin
     Move(aString[1],Buffer[Buflen],sLen);
 end;
 
-procedure ASNObject(const Data: AnsiString; const ASNType: Integer; var Buffer: TBytes);
+procedure ASNObject(const Data: String; const ASNType: Integer; var Buffer: TBytes);
 
 
 begin
@@ -271,7 +267,7 @@ begin
   AppendStringToBuffer(Buffer,Data);
 end;
 
-procedure DumpExStr(const S: AnsiString; var Output: TBytes);
+procedure DumpExStr(const S: String; var Output: TBytes);
 var
   I: Integer;
   x: Byte;
@@ -291,7 +287,7 @@ begin
   end;
 end;
 
-procedure OutputHexa(var Output: TBytes; const S: AnsiString);
+procedure OutputHexa(var Output: TBytes; const S: String);
 
 var
   I: Integer;
@@ -307,9 +303,9 @@ begin
 end;
 
 // @Result[256]
-procedure MibToId(Mib: AnsiString; var Result: AnsiString);
+procedure MibToId(Mib: String; var Result: String);
 
-  function WalkInt(var S: AnsiString): Integer;
+  function WalkInt(var S: String): Integer;
   var
     P : Integer;
 
@@ -335,7 +331,7 @@ begin
 end;
 
 // @Result[256]
-procedure IdToMib(const ID: AnsiString; var Result: AnsiString);
+procedure IdToMib(const Id: String; var Result: String);
 var
   x, y, Index: Integer;
 begin
@@ -354,7 +350,7 @@ begin
   end;
 end;
 
-function ASNParseInt(const Buffer: TBytes; var Start: Integer; const ASNSize: Integer): Int64;
+function ASNParseInt(var Buffer: PByte; BufferEnd: PByte; const ASNSize: Integer): Int64;
 var
   I: Integer;
   Negative: Boolean;
@@ -364,64 +360,73 @@ begin
   Negative := False;
   for I := 1 to ASNSize do
   begin
-    X := Buffer[Start];
+    if Buffer>=BufferEnd then
+      raise Exception.Create('20220428134948');
+    X := Buffer^;
     if (I = 1) and (X > $7F) then
       Negative := True;
     if Negative then
       X := not X;
     Result := Result*256 + X;
-    Inc(Start);
+    if Result>high(longint) then
+      raise Exception.Create('20220428135614');
+    Inc(Buffer);
   end;
   if Negative then
     Result := -(Result + 1);
 end;
 
-function ASNParseUInt(const Buffer: TBytes; var Start: Integer; const ASNSize: Integer): Int64;
+function ASNParseUInt(var Buffer: PByte; BufferEnd: PByte; const ASNSize: Integer): Int64;
 var
   I: Integer;
 begin
   Result := 0;
   for I := 1 to ASNSize do
   begin
-    Result := Result*256 + Buffer[Start];
-    Inc(Start);
+    if Buffer>=BufferEnd then
+      raise Exception.Create('20220428135002');
+    Result := Result*256 + Buffer^;
+    if Result>high(dword) then
+      raise Exception.Create('20220428135614');
+    Inc(Buffer);
   end;
 end;
 
-// Beginning with the @Start position, decode the ASN.1 item of the next element in @Buffer. Type of item is stored in @ASNType
-procedure ASNDebugItem(const Buffer: TBytes; var Start: Integer; Out ASNType, ASNSize: Integer; var Output: TBytes);
+// Decode the ASN.1 item of the next element in @Buffer. Type of item is stored in @ASNType
+procedure ASNDebugItem(var Buffer: PByte; BufferEnd: PByte; Out ASNType, ASNSize: Integer; var Output: TBytes);
 
-  procedure BufToString(out S : AnsiString);
+  procedure BufToString(out S : String);
 
   begin
     S:='';
     SetLength(S,ASNSize);
     if ASNSize>0 then
-      Move(Buffer[Start],S[1],ASNSize);
+    begin
+      Move(Buffer^,S[1],ASNSize);
+      inc(Buffer,ASNSize);
+    end;
   end;
 
-
 var
-  l, n: Integer;
-  S, S2: AnsiString;
+  n: Integer;
+  S, S2: String;
   y: Int64;
+  OldBuffer: PByte;
 begin
   S:='';
   S2:='';
   ASNType := ASN1_NULL;
-  l := Length(Buffer);
-  if Start > l then
+  if Buffer>=BufferEnd then
     Exit;
-  ASNType := Buffer[Start];
-  Inc(Start);
-  ASNSize := ASNReadLen(Buffer, Start);
-  if (Start + ASNSize) > l then
+  ASNType := Buffer^;
+  Inc(Buffer);
+  ASNSize := ASNReadLen(Buffer, BufferEnd);
+  if BufferEnd-Buffer < ASNSize then
     Exit;
   AppendStringToBuffer(Output,'$');
   AppendStringToBuffer(Output, HexStr(ASNType,2));
   if (ASNType and $20) > 0 then
   begin
-//    XBufferAppend(Output, Buffer, Start, ASNSize)
     if ASNType = ASN1_SEQ then
       AppendStringToBuffer(Output, ' SEQUENCE: length ')
     else if ASNType = ASN1_SETOF then
@@ -442,7 +447,7 @@ begin
           AppendStringToBuffer(Output, ' ENUM: ');
         if ASNSize < 8 then
         begin
-          y := ASNParseInt(Buffer, Start, ASNSize);
+          y := ASNParseInt(Buffer, BufferEnd, ASNSize);
           AppendStringToBuffer(Output, IntToStr(y));
         end else
         begin
@@ -451,7 +456,6 @@ begin
             Delete(S,1,1);
           AppendStringToBuffer(Output, '$');
           OutputHexa(Output, S);
-          Inc(Start, ASNSize);
         end;
       end;
     ASN1_COUNTER, ASN1_GAUGE, ASN1_TIMETICKS, ASN1_COUNTER64:
@@ -466,14 +470,13 @@ begin
           AppendStringToBuffer(Output, ' COUNTER64: ');
         if ASNSize < 8 then
         begin
-          y := ASNParseUInt(Buffer, Start, ASNSize);
+          y := ASNParseUInt(Buffer, BufferEnd, ASNSize);
           AppendStringToBuffer(Output, IntToStr(y));
         end else
         begin
           BufToString(S);
           AppendStringToBuffer(Output, '$');
           OutputHexa(Output, S);
-          Inc(Start, ASNSize);
         end;
       end;
     ASN1_OCTSTR, ASN1_OPAQUE:
@@ -484,27 +487,26 @@ begin
           AppendStringToBuffer(Output, ' OPAQUE: ');
         BufToString(S);
         OutputHexa(Output, S);
-        Inc(Start, ASNSize);
       end;
     ASN1_UTCTIME:
       begin // 180131123456Z -> 2018-01-31 12:34:56
         AppendStringToBuffer(Output, ' UTCTIME: ');
         BufToString(S);
         AppendStringToBuffer(Output, S);
-        Inc(Start, ASNSize);
       end;
     ASN1_BITSTR:
       begin
         AppendStringToBuffer(Output, ' BITSTR: ');
-        Inc(Start); // this is the Trailing Length in bits
+        Inc(Buffer); // this is the Trailing Length in bits
         Dec(ASNSize);
+        OldBuffer:=Buffer;
         BufToString(S);
         OutputHexa(Output, S);
-        if (ASNType = ASN1_BITSTR) and (Buffer[Start] = ASN1_SEQ) then
+        if (ASNType = ASN1_BITSTR) and (OldBuffer^ = ASN1_SEQ) then
         begin
           // continue to decode the bitstring as ASN.1 formatted content
-        end else
-          Inc(Start, ASNSize);
+          Buffer:=OldBuffer;
+        end;
       end;
     ASN1_UTF8STRING, ASN1_PRINTABLESTRING, ASN1_IA5STRING:
       begin
@@ -516,7 +518,6 @@ begin
           AppendStringToBuffer(Output, ' IA5STRING: ');
         BufToString(S);
         AppendStringToBuffer(Output, S);
-        Inc(Start, ASNSize);
       end;
     ASN1_OBJID:
       begin
@@ -525,31 +526,29 @@ begin
         S:='';
         IdToMib(S2, S);
         AppendStringToBuffer(Output, S);
-        Inc(Start, ASNSize);
       end;
     ASN1_IPADDR:
       begin
         AppendStringToBuffer(Output, ' IPADDR: ');
         for n := 1 to ASNSize do
         begin
-          if n <> 1 then
+          if n > 1 then
             AppendStringToBuffer(Output, '.');
-          y := Buffer[Start];
-          Inc(Start);
+          y := Buffer^;
+          Inc(Buffer);
           AppendStringToBuffer(Output, IntToStr(y));
         end;
       end;
     ASN1_NULL:
       begin
         AppendStringToBuffer(Output, ' NULL: ');
-        Inc(Start, ASNSize);
+        Inc(Buffer, ASNSize);
       end;
   else // unknown
     begin
       AppendStringToBuffer(Output, ' unknown: ');
       BufToString(S);
       OutputHexa(Output, S);
-      Inc(Start, ASNSize);
     end;
   end;
 end;
@@ -577,94 +576,76 @@ end;
 procedure ASNDebug(const Buffer: TBytes; var Output: TBytes);
 
 const
-  SSpaces: AnsiString = '                                                                     ';
+  SSpaces: String = '                                                                     ';
 
 var
-  ASNSize, ASNType, Index, n: Integer;
+  ASNSize, ASNType, n: Integer;
   Indent: Integer;
   IndentList: Array of Integer;
+  p, EndP: PByte;
 
 begin
+  if length(Buffer)=0 then exit;
   IndentList:=[];
   Indent:=0;
-  Index := 0;
-  while Index < Length(Buffer) do
+  p:=@Buffer[0];
+  EndP:=p+length(Buffer);
+  while p<EndP do
   begin
+    // check if any sequence/set has ended and unindent
     for n := Length(IndentList)-1 downto 0 do
     begin
       ASNSize := IndentList[n];
-      if ASNSize <= Index then
+      if EndP-p >= ASNSize then
       begin
         Delete(IndentList,n,1);
         Dec(Indent, 2);
       end;
     end;
     AppendStringToBuffer(Output, Copy(SSpaces,1,Indent));
-    ASNDebugItem(Buffer, Index, ASNType, ASNSize, Output);
+    ASNDebugItem(p, EndP, ASNType, ASNSize, Output);
     if (ASNType and $20) > 0 then
     begin
+      // sequence/set -> indent
       Inc(Indent, 2);
-      IndentList:=Concat(IndentList,[ASNSize+Index-1]);
+      IndentList:=Concat(IndentList,[ASNSize+integer(EndP-p)]);
     end;
     AppendStringToBuffer(Output, #13#10);
   end;
 end;
 
-procedure ASNParseAdd(List: TStrings; const S: AnsiString; const ASNType, ASNSize: Integer);
+procedure ASNParseAdd(List: TStrings; const S: String; const ASNType, ASNSize: Integer);
 begin
+  if ASNSize>high(word) then
+    raise Exception.Create('20220428160845');
+  if ASNType>high(word) then
+    raise Exception.Create('20220428160853');
   List.AddObject(S, TObject(PtrInt (ASNType shl 16) or (ASNSize)));
 end;
 
-procedure ASNParseAddInt(const Buffer: TBytes; var Start: Integer; List: TStrings; const ASNType, ASNSize: Integer);
+procedure ASNParseAddInt(var Buffer: PByte; BufferEnd: PByte; List: TStrings; const ASNType, ASNSize: Integer; Signed: boolean);
 
-  procedure BufToString(var S : AnsiString);
+  procedure BufToString(var S : String);
 
   begin
     SetLength(S,ASNSize);
-    if ASNSize>0 then
-      Move(Buffer[Start],S[1],ASNSize);
-  end;
-
-var
-  S, S2: AnsiString;
-  y: Int64;
-begin
-  S:='';
-  S2:='';
-  if ASNSize < 8 then
-  begin
-    y := ASNParseInt(Buffer, Start, ASNSize);
-    S:=IntToStr(y);
-  end else
-  begin
-    BufToString(S2);
-    if S2[1] = Char(#00) then
-      Delete(S2,1,1);
-    BytesToHexStr(S,TEncoding.UTF8.GetAnsiBytes(S2));
-    Inc(Start, ASNSize);
+    if ASNSize=0 then exit;
+    Move(Buffer^,S[1],ASNSize);
+    inc(Buffer, ASNSize);
   end;
-  ASNParseAdd(List, S, ASNType, ASNSize);
-end;
-
-procedure ASNParseAddUInt(const Buffer: TBytes; var Start: Integer; List: TStrings; const ASNType, ASNSize: Integer);
-
-  procedure BufToString(out S : AnsiString);
 
-  begin
-    S:='';
-    SetLength(S,ASNSize);
-    if ASNSize>0 then
-      Move(Buffer[Start],S[1],ASNSize);
-  end;
 var
-  S, S2: AnsiString;
+  S, S2: String;
   y: Int64;
 begin
   S:='';
   S2:='';
   if ASNSize < 8 then
   begin
-    y := ASNParseUInt(Buffer, Start, ASNSize);
+    if Signed then
+      y := ASNParseInt(Buffer, BufferEnd, ASNSize)
+    else
+      y := ASNParseUInt(Buffer, BufferEnd, ASNSize);
     S:=IntToStr(y);
   end else
   begin
@@ -672,27 +653,10 @@ begin
     if S2[1] = Char(#00) then
       Delete(S2,1,1);
     BytesToHexStr(S,TEncoding.UTF8.GetAnsiBytes(S2));
-    Inc(Start, ASNSize);
   end;
   ASNParseAdd(List, S, ASNType, ASNSize);
 end;
 
-function ASNFetch(const Buffer: TBytes; var Offset: Int32; Out ASNType, ASNSize: Int32): Boolean;
-var
-  Len: Int32;
-begin
-  Result := False;
-  Len := Length(Buffer);
-  if Offset+2 > Len then
-    Exit;
-  ASNType := Buffer[Offset];
-  Inc(Offset);
-  ASNSize := ASNReadLen(Buffer, Offset);
-  if (Offset + ASNSize) > Len then
-    Exit;
-  Result := True;
-end;
-
 function ASNFetch(var Buffer: PByte; BufferEnd: PByte; out ASNType,
   ASNSize: Int32): Boolean;
 var
@@ -747,75 +711,77 @@ end;
 // Beginning with the @Start position, decode the ASN.1 item of the next element in @Buffer. Type of item is stored in @ASNType
 // @Offset starts at 0
 
-procedure ASNParseItem(const Buffer: TBytes; var Offset: Int32; List: TStrings);
-
-  procedure BufToString(var S : AnsiString; P : PByte; Len : Integer);
+function ASNParseItem(var Buffer: PByte; BufferEnd: PByte; List: TStrings): boolean;
 
+  function BufToString(Len : Integer): String;
   begin
-    SetLength(S,Len);
-    if Len>0 then
-      Move(P^,S[1],Len);
+    SetLength(Result{%H-},Len);
+    if Len=0 then exit;
+    Move(Buffer^,Result[1],Len);
+    inc(Buffer, Len);
   end;
 
 var
   ASNType, ASNSize: Integer;
   n: Integer;
-  S, S2: AnsiString;
+  S, S2: String;
   y: Int64;
+  OldBuffer: PByte;
 
 begin
-  if not ASNFetch(Buffer, Offset, ASNType, ASNSize) then
+  Result:=false;
+  if not ASNFetch(Buffer, BufferEnd, ASNType, ASNSize) then
     Exit;
   if (ASNType and $20) > 0 then
   begin // constructed
     ASNParseAdd(List, '', ASNType, ASNSize);
     Exit;
   end;
+  if (BufferEnd-Buffer) < ASNSize then
+    Exit;
   S:='';
   S2:='';
   case ASNType of
     ASN1_INT, ASN1_ENUM, ASN1_BOOL:
       begin
-        ASNParseAddInt(Buffer, Offset, List, ASNType, ASNSize);
+        ASNParseAddInt(Buffer, BufferEnd, List, ASNType, ASNSize, true);
       end;
     ASN1_COUNTER, ASN1_GAUGE, ASN1_TIMETICKS, ASN1_COUNTER64:
       begin
-        ASNParseAddUInt(Buffer, Offset, List, ASNType, ASNSize);
+        ASNParseAddInt(Buffer, BufferEnd, List, ASNType, ASNSize, false);
       end;
     ASN1_BITSTR, ASN1_OCTSTR, ASN1_OPAQUE:
       begin
         if ASNType = ASN1_BITSTR then
         begin // this is the Trailing Length in bits
-          Inc(Offset);
+          Inc(Buffer);
           Dec(ASNSize);
         end;
-        BufToString(S2, @Buffer[Offset], ASNSize);
+        OldBuffer:=Buffer;
+        S2 := BufToString(ASNSize);
         S:=BytesToHexStr(S2);
         ASNParseAdd(List, S, ASNType, ASNSize);
-        if (ASNType = ASN1_BITSTR) and (Buffer[Offset] = ASN1_SEQ) then
+        if (ASNType = ASN1_BITSTR) and (OldBuffer^ = ASN1_SEQ) then
         begin
           // continue to decode the bitstring as ASN.1 formatted content
-        end else
-          Inc(Offset, ASNSize);
+          Buffer:=OldBuffer;
+        end;
       end;
     ASN1_UTF8STRING, ASN1_PRINTABLESTRING, ASN1_IA5STRING:
       begin
-        BufToString(S2, @Buffer[Offset], ASNSize);
+        S2 := BufToString(ASNSize);
         ASNParseAdd(List, S2, ASNType, ASNSize);
-        Inc(Offset, ASNSize);
       end;
     ASN1_UTCTIME:
       begin // 180131123456Z -> 2018-01-31 12:34:56
-        BufToString(S2, @Buffer[Offset], ASNSize);
+        S2 := BufToString(ASNSize);
         ASNParseAdd(List, S2, ASNType, ASNSize);
-        Inc(Offset, ASNSize);
       end;
     ASN1_OBJID:
       begin
-        BufToString(S2, @Buffer[Offset], ASNSize);
+        S2 := BufToString(ASNSize);
         IdToMib(S2, S);
         ASNParseAdd(List, S, ASNType, ASNSize);
-        Inc(Offset, ASNSize);
       end;
     ASN1_IPADDR:
       begin
@@ -823,8 +789,8 @@ begin
         begin
           if n <> 1 then
             S:=S+'.';
-          y := Buffer[Offset];
-          Inc(Offset);
+          y := Buffer^;
+          Inc(Buffer);
           S:=S+IntToStr(y);
         end;
         ASNParseAdd(List, S, ASNType, ASNSize);
@@ -832,69 +798,50 @@ begin
     ASN1_NULL:
       begin
         ASNParseAdd(List, '', ASNType, ASNSize);
-        Inc(Offset, ASNSize);
+        Inc(Buffer, ASNSize);
       end;
   else // unknown
     begin
-      BufToString(S2, @Buffer[Offset], ASNSize);
+      S2 := BufToString(ASNSize);
       S:=BytesToHexStr(S2);
       ASNParseAdd(List, S, ASNType, ASNSize);
-      Inc(Offset, ASNSize);
     end;
   end;
 end;
 
-// Convert ASN.1 DER encoded buffer to human readable form for debugging
 procedure ASNParse(const Buffer: TBytes; List: TStrings);
 var
-  Index: integer;
-begin
-  Index := 0;
-  while Index < Length(Buffer) do
-    ASNParseItem(Buffer, Index, List);
-end;
-
-procedure PemToDER(PEM: TBytes; const BeginTag, EndTag: AnsiString; out DER: TBytes);
-
+  P, EndP: PByte;
 begin
-  PemToDER(TEncoding.UTF8.GetAnsiString(PEM),BeginTag,EndTag,DER);
+  if length(Buffer)=0 then exit;
+  P:=@Buffer[0];
+  EndP:=P+length(Buffer);
+  while P < EndP do
+    ASNParseItem(p, EndP, List);
 end;
 
-procedure PemToDER(Const PEM: AnsiString; const BeginTag, EndTag: AnsiString; Out DER: TBytes);
-
+procedure ASNParse_GetItem(List: TStrings; Index: integer; out ASNType,
+  ASNSize: integer);
 var
-  Content: AnsiString;
-
+  h: PtrUInt;
 begin
-  DER:=[];
-  Content:=ExtractBetween(Pem, BeginTag, EndTag);
-  Content:=Trim(Content);
-  if Length(Content) = 0 then
-    Exit;
-  DER:=Base64.Decode(Content,True);
-end;
-
-procedure ASNParsePemSection(const PEM: TBytes; List: TStrings; const BeginTag, EndTag: AnsiString);
-
-begin
-  ASNParsePemSection(TEncoding.UTF8.GetAnsiString(PEM),List,BeginTag,EndTag);
+  h:=PtrUInt(List.Objects[Index]);
+  ASNType:=h shr 16;
+  ASNSize:=h and $ffff;
 end;
 
-procedure ASNParsePemSection(const PEM: AnsiString; List: TStrings; const BeginTag, EndTag: AnsiString);
-
+function ASNParse_GetIntBytes(List: TStrings; ListIndex: integer; ID: int64
+  ): TBytes;
 var
-  BufferSection: TBytes;
-//  S : AnsiString;
-
+  ASNType, ASNSize: Integer;
 begin
-  List.Clear;
-  PemToDER(PEM, BeginTag, EndTag, BufferSection);
-  {ASNDebug(BufferSection,Res);
-  S:=TEncoding.UTF8.GetAnsiString(Res);
-  Writeln('ASN Debug: ',S);}
-  ASNParse(BufferSection, List);
+  ASNParse_GetItem(List,ListIndex,ASNType,ASNSize);
+  if ASNType<>ASN1_INT then
+    raise Exception.Create(IntToStr(Id));
+  Result:=HexStrToBytes(List[ListIndex]);
+  if length(Result)<1 then
+    raise Exception.Create(IntToStr(Id));
 end;
 
-
 end.
 

packages/fcl-hash/src/fphashutils.pp

@@ -102,7 +102,7 @@ begin
   HexStrToBytes(aHexStr,aBytes);
   l:=length(aBytes);
   if l=0 then exit;
-  SetLength(Result,l);
+  SetLength(Result{%H-},l);
   Move(aBytes[0],Result[1],l);
 end;
 

packages/fcl-hash/src/fppem.pp

@@ -5,7 +5,7 @@ unit fppem;
 interface
 
 uses
-  Classes, SysUtils, fpecc;
+  Classes, SysUtils, basenenc, fpsha256, fpasn, fphashutils, fpecc;
 
 const
   _BEGIN_CERTIFICATE = '-----BEGIN CERTIFICATE-----';
@@ -18,23 +18,37 @@ const
   _END_RSA_PRIVATE_KEY = '-----END RSA PRIVATE KEY-----';
   _BEGIN_PRIVATE_KEY = '-----BEGIN PRIVATE KEY-----';
   _END_PRIVATE_KEY = '-----END PRIVATE KEY-----';
+  _BEGIN_PUBLIC_KEY = '-----BEGIN PUBLIC KEY-----';
+  _END_PUBLIC_KEY = '-----END PUBLIC KEY-----';
 
+type
+  TPrivateKeyType = (pktNone, pktPKCS8, pktRSA, pktEC);
 
-Function PemIsECDSA(const aStream : TStream; List: TStrings): Boolean;
-Function PemIsECDSA(const FileName: String; List: TStrings): Boolean;
+function PemIsECDSA(const aStream : TStream; List: TStrings): Boolean;
+function PemIsECDSA(const FileName: String; List: TStrings): Boolean;
 
 procedure PemLoadPublicKey64FromList(List: TStrings; out PrivateKey: TEccPrivateKey; out PublicKey: TEccPublicKey; out PublicKeyX64, PublicKeyY64, ThumbPrint: AnsiString);
 procedure PemLoadPublicKey64FromList(List: TStrings; out PrivateKey: TEccPrivateKey; out PublicKey: TEccPublicKey; out PublicKeyX64, PublicKeyY64: AnsiString);
 
-Function PemLoadECDSA(const FileName: String; out PrivateKey: TEccPrivateKey; out PublicKey: TEccPublicKey; out PublicKeyX64, PublicKeyY64, ThumbPrint: AnsiString) : Boolean;
-Function PemLoadECDSA(const FileName: String; out PrivateKey: TEccPrivateKey; out PublicKey: TEccPublicKey; out PublicKeyX64, PublicKeyY64: AnsiString): Boolean;
-Function PemLoadECDSA(const aStream : TStream; out PrivateKey: TEccPrivateKey; out PublicKey: TEccPublicKey; out PublicKeyX64, PublicKeyY64, ThumbPrint: AnsiString) : Boolean;
-Function PemLoadECDSA(const aStream : TStream; out PrivateKey: TEccPrivateKey; out PublicKey: TEccPublicKey; out PublicKeyX64, PublicKeyY64: AnsiString): Boolean;
+function PemLoadECDSA(const FileName: String; out PrivateKey: TEccPrivateKey; out PublicKey: TEccPublicKey; out PublicKeyX64, PublicKeyY64, ThumbPrint: AnsiString) : Boolean;
+function PemLoadECDSA(const FileName: String; out PrivateKey: TEccPrivateKey; out PublicKey: TEccPublicKey; out PublicKeyX64, PublicKeyY64: AnsiString): Boolean;
+function PemLoadECDSA(const aStream : TStream; out PrivateKey: TEccPrivateKey; out PublicKey: TEccPublicKey; out PublicKeyX64, PublicKeyY64, ThumbPrint: AnsiString) : Boolean;
+function PemLoadECDSA(const aStream : TStream; out PrivateKey: TEccPrivateKey; out PublicKey: TEccPublicKey; out PublicKeyX64, PublicKeyY64: AnsiString): Boolean;
 
+procedure PemLoadPrivateKeyAsDER(const PEM: String; out PrivateKey, ECParams: TBytes; out PrivateKeyType: TPrivateKeyType);
+function PemParseValidUntil(List: TStrings): String;
 
-implementation
+function PemLineIsTag(const Line, Tag: string): boolean; // true if Line contains Tag, ignoring leading and trailing spaces
+function PemLineIsBase64(const Line: string): boolean; // true if Line contains only spaces and base64 chars
+function PemFindTags(List: TStrings; const BeginTag, EndTag: string; out StartIndex, EndIndex: integer): boolean;
+function PemExtractBetween(const PEM, BeginTag, EndTag: String): String;
+function PemToDER(const PEM, BeginTag, EndTag: String): TBytes; overload;
+procedure PemToDER(PEM: TBytes; const BeginTag, EndTag: String; out DER: TBytes); overload;
 
-uses basenenc, fpsha256, fpasn, fphashutils;
+procedure ASNParsePemSection(const PEM: TBytes; List: TStrings; const BeginTag, EndTag: String);
+procedure ASNParsePemSection(const PEM: String; List: TStrings; const BeginTag, EndTag: String);
+
+implementation
 
 procedure PemLoadPublicKey64FromList(List: TStrings; out PrivateKey: TEccPrivateKey; out PublicKey: TEccPublicKey; out PublicKeyX64, PublicKeyY64, ThumbPrint: AnsiString);
 
@@ -84,7 +98,9 @@ begin
 end;
 
 
-Function PemLoadECDSA(const FileName: String; Out PrivateKey: TEccPrivateKey; Out PublicKey: TEccPublicKey; Out PublicKeyX64, PublicKeyY64: AnsiString) : Boolean;
+function PemLoadECDSA(const FileName: String; out PrivateKey: TEccPrivateKey;
+  out PublicKey: TEccPublicKey; out PublicKeyX64, PublicKeyY64: AnsiString
+  ): Boolean;
 
 var
   List: TStrings;
@@ -101,7 +117,9 @@ begin
 end;
 
 
-Function PemLoadECDSA(const FileName: String; out PrivateKey: TEccPrivateKey; out PublicKey: TEccPublicKey; out PublicKeyX64, PublicKeyY64, ThumbPrint: AnsiString) : Boolean;
+function PemLoadECDSA(const FileName: String; out PrivateKey: TEccPrivateKey;
+  out PublicKey: TEccPublicKey; out PublicKeyX64, PublicKeyY64,
+  ThumbPrint: AnsiString): Boolean;
 
 var
   List: TStrings;
@@ -135,7 +153,9 @@ begin
   Result := (CurveOID=ASN_secp256r1);
 end;
 
-Function PemLoadECDSA(const aStream : TStream; out PrivateKey: TEccPrivateKey; out PublicKey: TEccPublicKey; out PublicKeyX64, PublicKeyY64, ThumbPrint: AnsiString) : Boolean;
+function PemLoadECDSA(const aStream: TStream; out PrivateKey: TEccPrivateKey;
+  out PublicKey: TEccPublicKey; out PublicKeyX64, PublicKeyY64,
+  ThumbPrint: AnsiString): Boolean;
 
 var
   List: TStrings;
@@ -151,7 +171,9 @@ begin
   end;
 end;
 
-Function PemLoadECDSA(const aStream: Tstream; Out PrivateKey: TEccPrivateKey; Out PublicKey: TEccPublicKey; Out PublicKeyX64, PublicKeyY64: AnsiString) : Boolean;
+function PemLoadECDSA(const aStream: TStream; out PrivateKey: TEccPrivateKey;
+  out PublicKey: TEccPublicKey; out PublicKeyX64, PublicKeyY64: AnsiString
+  ): Boolean;
 
 var
   List: TStrings;
@@ -167,6 +189,179 @@ begin
   end;
 end;
 
+procedure PemLoadPrivateKeyAsDER(const PEM: String; out PrivateKey,
+  ECParams: TBytes; out PrivateKeyType: TPrivateKeyType);
+begin
+  PrivateKeyType := pktNone;
+  ECParams:=[];
+  PrivateKey := PemToDER(PEM, _BEGIN_EC_PRIVATE_KEY, _END_EC_PRIVATE_KEY);
+  if length(PrivateKey)>0 then
+  begin
+    PrivateKeyType := pktEC;
+    ECParams := PemToDER(PEM, _BEGIN_EC_PARAMETERS, _END_EC_PARAMETERS);
+    Exit;
+  end;
+  PrivateKey := PemToDER(PEM, _BEGIN_RSA_PRIVATE_KEY, _END_RSA_PRIVATE_KEY);
+  if length(PrivateKey)>0 then
+  begin
+    PrivateKeyType := pktRSA;
+    Exit;
+  end;
+  PrivateKey := PemToDER(PEM, _BEGIN_PRIVATE_KEY, _END_PRIVATE_KEY);
+  if length(PrivateKey)>0 then
+  begin
+    PrivateKeyType := pktPKCS8;
+    Exit;
+  end;
+end;
+
+function PemParseValidUntil(List: TStrings): String;
+var
+  ASNType: LongInt;
+  S: String;
+  i: Integer;
+begin
+  for i := 0 to List.Count-2 do
+  begin
+    ASNType := StrToIntDef(List[i],0) shr 16;
+    if ASNType <> ASN1_UTCTIME then
+      Continue;
+    S := List.Strings[i+1];
+    ASNType := StrToIntDef(S,0) shr 16;
+    if ASNType <> ASN1_UTCTIME then
+      Continue;
+    if (S.Length > 6) and (S[length(s)] = 'Z') then
+      SetLength(S,6); // 181231
+    Result:='20'+S; // 20181231
+    Break;
+  end;
+end;
+
+function PemLineIsTag(const Line, Tag: string): boolean;
+var
+  LineLen, TagLen: SizeInt;
+  p: Integer;
+  LineP, TagP: PChar;
+begin
+  Result:=false;
+  LineLen:=length(Line);
+  TagLen:=length(Tag);
+  if LineLen<TagLen then exit;
+  LineP:=PChar(Line);
+  TagP:=PChar(Tag);
+  for p:=0 to LineLen-TagLen do
+  begin
+    if CompareMem(LineP,TagP,TagLen) then
+    begin
+      inc(LineP,TagLen);
+      while LineP^ in [' ',#9] do inc(LineP);
+      Result:=LineP^ in [#0,#10,#13];
+    end else if LineP^ in [' ',#9] then
+      inc(LineP)
+    else
+      exit;
+  end;
+end;
+
+function PemFindTags(List: TStrings; const BeginTag, EndTag: string; out
+  StartIndex, EndIndex: integer): boolean;
+begin
+  Result:=false;
+  StartIndex:=0;
+  while (StartIndex<List.Count) do
+  begin
+    if PemLineIsTag(List[StartIndex],BeginTag) then
+    begin
+      EndIndex:=StartIndex+1;
+      while (EndIndex<List.Count) do
+        if PemLineIsTag(List[EndIndex],EndTag) then
+          exit(true)
+        else
+          inc(EndIndex);
+    end else
+      inc(StartIndex);
+  end;
+  // BeginTag missing
+  StartIndex:=0;
+  EndIndex:=0;
+end;
+
+function PemExtractBetween(const PEM, BeginTag, EndTag: String): String;
+var
+  StartP, EndP: SizeInt;
+begin
+  Result:='';
+  StartP:=Pos(BeginTag,PEM);
+  if StartP<1 then exit;
+  inc(StartP,length(BeginTag));
+  // skip trailing spaces
+  while (StartP<=length(PEM)) and (PEM[StartP] in [' ',#9]) do inc(StartP);
+  // skip line end and empty lines
+  while (StartP<=length(PEM)) and (PEM[StartP] in [#10,#13]) do inc(StartP);
+  EndP:=Pos(EndTag,PEM,StartP);
+  if EndP<1 then exit;
+  // skip leading spaces
+  while (EndP>StartP) and (PEM[EndP-1] in [' ',#9]) do dec(EndP);
+  Result:=copy(PEM,StartP,EndP-StartP);
+end;
+
+function PemLineIsBase64(const Line: string): boolean;
+const
+  Alphabet = ['a'..'z','A'..'Z','0'..'9','+','/','=', ' ', #9];
+var
+  i: Integer;
+begin
+  for i:=1 to length(Line) do
+    if not (Line[i] in Alphabet) then
+      exit(false);
+  Result:=true;
+end;
+
+function PemToDER(const PEM, BeginTag, EndTag: String): TBytes;
+var
+  sl: TStringList;
+  Line, TxtBase64: String;
+  StartIndex, EndIndex, i: Integer;
+begin
+  Result:=[];
+  sl:=TStringList.Create;
+  try
+    sl.Text:=PEM;
+    if not PemFindTags(sl,BeginTag,EndTag,StartIndex,EndIndex) then
+      exit;
+    // todo: encryption
+    TxtBase64:='';
+    for i:=StartIndex+1 to EndIndex-1 do
+    begin
+      Line:=sl[i];
+      if not PemLineIsBase64(Line) then
+        exit;
+      TxtBase64:=TxtBase64+Line;
+    end;
+    Result:=basenenc.Base64.Decode(TxtBase64,True);
+  finally
+    sl.Free;
+  end;
+end;
+
+procedure PemToDER(PEM: TBytes; const BeginTag, EndTag: String; out DER: TBytes);
+begin
+  DER:=PemToDER(TEncoding.UTF8.GetAnsiString(PEM),BeginTag,EndTag);
+end;
+
+procedure ASNParsePemSection(const PEM: TBytes; List: TStrings; const BeginTag, EndTag: String);
+begin
+  ASNParsePemSection(TEncoding.UTF8.GetAnsiString(PEM),List,BeginTag,EndTag);
+end;
+
+procedure ASNParsePemSection(const PEM: String; List: TStrings; const BeginTag, EndTag: String);
+var
+  DER: TBytes;
+begin
+  List.Clear;
+  DER:=PemToDER(PEM, BeginTag, EndTag);
+  ASNParse(DER, List);
+end;
 
 end.
 

packages/fcl-hash/src/fprsa.pas

@@ -7,7 +7,10 @@ unit fprsa;
 interface
 
 uses
-  sysutils, fpTLSBigInt, fphashutils, fpasn;
+  sysutils, Classes, fpTLSBigInt, fphashutils, fpasn;
+
+const
+  RSAPublicKeyOID = '1.2.840.113549.1.1.1';
 
 type
   TRSA = record
@@ -23,17 +26,56 @@ type
     Context: TBigIntContext;
   end;
 
-procedure RSACreate(var RSA: TRSA);
+  TX509RSAPrivateKey = record
+    Version: integer;
+    Modulus,
+    PublicExponent,
+    PrivateExponent,
+    Prime1,
+    Prime2,
+    Exponent1,
+    Exponent2,
+    Coefficient: TBytes;
+  end;
+
+  TX509RSAPublicKey = record
+    Modulus: TBytes;
+    Exponent: TBytes;
+  end;
+
+procedure RSACreate(out RSA: TRSA);
 procedure RSAFree(var RSA: TRSA);
+
 procedure RsaPublicKeyToHexa(const Modulus, Exponent: String; var PublicKeyHexa: String);
 procedure RsaPublicKeyFromHexa(const PublicKeyHexa: String; out Modulus, Exponent: String);
-{$IFDEF TLS}
-procedure RSAInitFromPrivateKey(var RSA: TRSA; const RSAPrivateKey: TX509RSAPrivateKey);
-procedure RSAInitFromPublicKey(var RSA: TRSA; const RSAPublicKey: TX509RSAPublicKey); overload;
-{$ENDIF}
 procedure RsaInitFromPublicKey(var RSA: TRSA; const Modulus, Exponent: String); overload;
+procedure RSAInitFromPublicKey(var RSA: TRSA; const RSAPublicKey: TX509RSAPublicKey); overload;
+procedure RSAInitFromPublicKeyDER(var RSA: TRSA; const PublicKeyDER: TBytes);
+procedure X509RsaPublicKeyInitFromDER(out RSA: TX509RSAPublicKey; const PublicKeyDER: TBytes);
+
+procedure RSAInitFromX509PrivateKey(var RSA: TRSA; const RSAPrivateKey: TX509RSAPrivateKey);
+procedure RSAInitFromPrivateKeyDER(var RSA: TRSA; const PrivateKeyDER: TBytes);
+procedure X509RsaPrivateKeyInitFromDER(out RSA: TX509RSAPrivateKey; const PrivateKeyDER: TBytes);
+
+{ Perform PKCS1.5 Encryption or Signing
+  Context: The RSA context containing Private and/or Public keys
+  Input: The data to be encrypted
+  Len: The size of the input data in bytes (Must be <= Modulus length - 11 to
+       make the padding at least 8 bytes as recommended by RFC2313)
+  Output: The buffer for the encrypted result (Must always be Modulus length)
+  Sign: If true then sign instead of encrypting
+  Return: The number of bytes encrypted or -1 on error }
 function RSAEncryptSign(var RSA: TRSA; const Input: PByte; Len: Integer; Output: PByte; Sign: Boolean): Integer;
+
+{ Perform PKCS1.5 Decryption or Verification
+  Context: The RSA context containing Private and/or Public keys
+  Input: The data to be decrypted (Must always be Modulus length)
+  Output: The buffer for the decrypted result
+  Len: The size of the output buffer in bytes
+  Verify: If true then verify instead of decrypting
+  Return: The number of bytes decrypted or -1 on error }
 function RSADecryptVerify(var RSA: TRSA; const Input: PByte; Output: PByte; Len: Integer; Verify: Boolean): Integer;
+
 function RS256VerifyFromPublicKeyHexa(const PublicKeyHexa, SignatureBaseHash, Signature: String): Boolean;
 function TestRS256Verify: Boolean;
 
@@ -42,8 +84,9 @@ implementation
 const
   RSA_MODULUS_BYTES_MAX = 512; // 4096 bit maximum
 
-procedure RSACreate(var RSA: TRSA);
+procedure RSACreate(out RSA: TRSA);
 begin
+  RSA:=Default(TRSA);
   BIInitialize(RSA.Context);
 end;
 
@@ -83,17 +126,192 @@ begin
   BIPermanent(RSA.E);
 end;
 
+procedure RSAInitFromPublicKey(var RSA: TRSA;
+  const RSAPublicKey: TX509RSAPublicKey);
+begin
+  if RSAPublicKey.Modulus = nil then
+    Exit;
+  if RSAPublicKey.Exponent = nil then
+    Exit;
+  RSA.ModulusLen := length(RSAPublicKey.Modulus);
+  RSA.M := BIImport(RSA.Context, RSAPublicKey.Modulus);
+  BISetMod(RSA.Context, RSA.M, BIGINT_M_OFFSET);
+  RSA.E := BIImport(RSA.Context, RSAPublicKey.Exponent);
+  BIPermanent(RSA.E);
+end;
+
+procedure RSAInitFromPublicKeyDER(var RSA: TRSA; const PublicKeyDER: TBytes);
+var
+  X508PublicKey: TX509RSAPublicKey;
+begin
+  X509RsaPublicKeyInitFromDER(X508PublicKey,PublicKeyDER);
+  RSAInitFromPublicKey(RSA,X508PublicKey);
+end;
+
+procedure X509RsaPublicKeyInitFromDER(out RSA: TX509RSAPublicKey;
+  const PublicKeyDER: TBytes);
+var
+  ASNType, ASNSize: integer;
+  List: TStringList;
+begin
+  RSA:=Default(TX509RSAPublicKey);
+  List:=TStringList.Create;
+  try
+    ASNParse(PublicKeyDER,List);
+
+    //for i:=0 to List.Count-1 do begin
+    //  ASNParse_GetItem(List,i,ASNType,ASNSize);
+    //  writeln('X509RsaPublicKeyInitFromDER ',i,'/',List.Count,' ASNType=',hexstr(ASNType,2),' ASNSize=',ASNSize,' S="',List[i],'"');
+    //end;
+
+    if List.Count<7 then
+      raise Exception.Create('20220428180055');
+
+    // check sequence
+    ASNParse_GetItem(List,0,ASNType,ASNSize);
+    if ASNType<>ASN1_SEQ then
+      raise Exception.Create('20220428180058');
+
+    // check sequence
+    ASNParse_GetItem(List,1,ASNType,ASNSize);
+    if ASNType<>ASN1_SEQ then
+      raise Exception.Create('20220428183025');
+
+    // check algorithm OID
+    ASNParse_GetItem(List,2,ASNType,ASNSize);
+    if ASNType<>ASN1_OBJID then
+      raise Exception.Create('20220428180512');
+    if List[2]<>RSAPublicKeyOID then
+      raise Exception.Create('20220428181542');
+
+    // check null
+    ASNParse_GetItem(List,3,ASNType,ASNSize);
+    writeln('X509RsaPublicKeyInitFromDER ',ASNType,' ',ASNSize);
+    if ASNType<>ASN1_NULL then
+      raise Exception.Create('20220428181659');
+
+    // check optional algorithm params
+    ASNParse_GetItem(List,4,ASNType,ASNSize);
+    if ASNType<>ASN1_BITSTR then
+      raise Exception.Create('20220428181913');
+
+    // check sequence
+    ASNParse_GetItem(List,5,ASNType,ASNSize);
+    if ASNType<>ASN1_SEQ then
+      raise Exception.Create('20220428181933');
+
+    // public key
+    RSA.Modulus:=ASNParse_GetIntBytes(List,6,20220428182235);
+    RSA.Exponent:=ASNParse_GetIntBytes(List,7,20220428182241);
+
+    {$IFDEF TLS_DEBUG}
+    writeln('X509RsaPublicKeyInitFromDER: ');
+    writeln('  Modulus=',BytesToHexStr(RSA.Modulus));
+    writeln('  Exponent=',BytesToHexStr(RSA.Exponent));
+    {$ENDIF}
+  finally
+    List.Free;
+  end;
+end;
+
+procedure RSAInitFromX509PrivateKey(var RSA: TRSA;
+  const RSAPrivateKey: TX509RSAPrivateKey);
+begin
+  if RSAPrivateKey.PrivateExponent = nil then
+    Exit;
+  if RSAPrivateKey.Prime1 = nil then
+    Exit;
+  if RSAPrivateKey.Prime2 = nil then
+    Exit;
+  if RSAPrivateKey.Exponent1 = nil then
+    Exit;
+  if RSAPrivateKey.Exponent2 = nil then
+    Exit;
+  if RSAPrivateKey.Coefficient = nil then
+    Exit;
+  if RSAPrivateKey.Modulus = nil then
+    Exit;
+  if RSAPrivateKey.PublicExponent = nil then
+    Exit;
+  RSA.ModulusLen := length(RSAPrivateKey.Modulus);
+  RSA.M := BIImport(RSA.Context, RSAPrivateKey.Modulus);
+  BISetMod(RSA.Context, RSA.M, BIGINT_M_OFFSET);
+  RSA.E := BIImport(RSA.Context, RSAPrivateKey.PublicExponent);
+  BIPermanent(RSA.E);
+  RSA.D := BIImport(RSA.Context, RSAPrivateKey.PrivateExponent);
+  BIPermanent(RSA.D);
+  RSA.P := BIImport(RSA.Context, RSAPrivateKey.Prime1);
+  RSA.Q := BIImport(RSA.Context, RSAPrivateKey.Prime2);
+  RSA.DP := BIImport(RSA.Context, RSAPrivateKey.Exponent1);
+  RSA.DQ := BIImport(RSA.Context, RSAPrivateKey.Exponent2);
+  RSA.QInv := BIImport(RSA.Context, RSAPrivateKey.Coefficient);
+  BIPermanent(RSA.DP);
+  BIPermanent(RSA.DQ);
+  BIPermanent(RSA.QInv);
+  BISetMod(RSA.Context, RSA.P, BIGINT_P_OFFSET);
+  BISetMod(RSA.Context, RSA.Q, BIGINT_Q_OFFSET);
+end;
+
+procedure RSAInitFromPrivateKeyDER(var RSA: TRSA; const PrivateKeyDER: TBytes);
+var
+  X509RSA: TX509RSAPrivateKey;
+begin
+  X509RsaPrivateKeyInitFromDER(X509RSA,PrivateKeyDER);
+  RSAInitFromX509PrivateKey(RSA,X509RSA);
+end;
+
+procedure X509RsaPrivateKeyInitFromDER(out RSA: TX509RSAPrivateKey; const PrivateKeyDER: TBytes);
+var
+  List: TStringList;
+  ASNType, ASNSize: integer;
+begin
+  RSA:=Default(TX509RSAPrivateKey);
+  List:=TStringList.Create;
+  try
+    ASNParse(PrivateKeyDER,List);
+    if List.Count<10 then
+      raise Exception.Create('20220428161533');
+
+    // check sequence
+    ASNParse_GetItem(List,0,ASNType,ASNSize);
+    if ASNType<>ASN1_SEQ then
+      raise Exception.Create('20220428161631');
+
+    // version
+    ASNParse_GetItem(List,1,ASNType,ASNSize);
+    if ASNType<>ASN1_INT then
+      raise Exception.Create('20220428161716');
+    RSA.Version:=StrToIntDef(List[1],0);
+
+    RSA.Modulus:=ASNParse_GetIntBytes(List,2,20220428173827);
+    RSA.PublicExponent:=ASNParse_GetIntBytes(List,3,20220428173840);
+    RSA.PrivateExponent:=ASNParse_GetIntBytes(List,4,20220428173852);
+    RSA.Prime1:=ASNParse_GetIntBytes(List,5,20220428173906);
+    RSA.Prime2:=ASNParse_GetIntBytes(List,6,20220428173915);
+    RSA.Exponent1:=ASNParse_GetIntBytes(List,7,20220428173923);
+    RSA.Exponent2:=ASNParse_GetIntBytes(List,8,20220428173930);
+    RSA.Coefficient:=ASNParse_GetIntBytes(List,9,20220428173939);
+
+    {$IFDEF TLS_DEBUG}
+    with RSA do begin
+      writeln('RsaInitFromPrivateKey ');
+      writeln('   Modulus=',BytesToHexStr(Modulus));
+      writeln('   PublicExponent=',BytesToHexStr(PublicExponent));
+      writeln('   PrivateExponent=',BytesToHexStr(PrivateExponent));
+      writeln('   Prime1=',BytesToHexStr(Prime1));
+      writeln('   Prime2=',BytesToHexStr(Prime2));
+      writeln('   Exponent1=',BytesToHexStr(Exponent1));
+      writeln('   Exponent2=',BytesToHexStr(Exponent2));
+      writeln('   Coefficient=',BytesToHexStr(Coefficient));
+    end;
+    {$ENDIF}
+  finally
+    List.Free;
+  end;
+end;
+
 function RSAEncryptSign(var RSA: TRSA; const Input: PByte; Len: Integer;
   Output: PByte; Sign: Boolean): Integer;
-{ Perform PKCS1.5 Encryption or Signing
-  Context: The RSA context containing Private and/or Public keys
-  Input: The data to be encrypted
-  Len: The size of the input data in bytes (Must be <= Modulus length - 11 to
-       make the padding at least 8 bytes as recommended by RFC2313)
-  Output: The buffer for the encrypted result (Must always be Modulus length)
-  Sign: If true then sign instead of encrypting
-  Return: The number of bytes encrypted or -1 on error
-}
 var
   Size: Integer;
   Padding: Integer;
@@ -178,13 +396,6 @@ end;
 
 function RSADecryptVerify(var RSA: TRSA; const Input: PByte; Output: PByte;
   Len: Integer; Verify: Boolean): Integer;
-// Perform PKCS1.5 Decryption or Verification
-// Context: The RSA context containing Private and/or Public keys
-// @Input: The data to be decrypted (Must always be Modulus length)
-// @Output: The buffer for the decrypted result
-// Len: The size of the output buffer in bytes
-// Verify: If true then verify instead of decrypting
-// Return: The number of bytes decrypted or -1 on error
 var
   Size: Integer;
   Count: Integer;