* Support PKCS#8 format for RSA private key, add demos

packages/fcl-hash/examples/demosha256.pp

@@ -1,3 +1,16 @@
+{
+  This file is part of the Free Component Library.
+  Copyright (c) 2023 by the Free Pascal team.
+
+  Demonstrate SHA 256 routines.
+
+  See the file COPYING.FPC, included in this distribution,
+  for details about the copyright.
+
+  This program is distributed in the hope that it will be useful,
+  but WITHOUT ANY WARRANTY; without even the implied warranty of
+  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
 program demosha256;
 
 {$mode objfpc}

packages/fcl-hash/examples/dumppem.lpi

@@ -0,0 +1,62 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="dumppem"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <BuildModes>
+      <Item Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+    </RunParams>
+    <Units>
+      <Unit>
+        <Filename Value="dumppem.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="dumppem"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <OtherUnitFiles Value="../src"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <Debugging>
+        <DebugInfoType Value="dsDwarf3"/>
+      </Debugging>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions>
+      <Item>
+        <Name Value="EAbort"/>
+      </Item>
+      <Item>
+        <Name Value="ECodetoolError"/>
+      </Item>
+      <Item>
+        <Name Value="EFOpenError"/>
+      </Item>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

packages/fcl-hash/examples/dumppem.lpr

@@ -0,0 +1,154 @@
+{
+  This file is part of the Free Component Library.
+  Copyright (c) 2023 by the Free Pascal team.
+
+  Demo to dump the contents of a PEM file
+
+  See the file COPYING.FPC, included in this distribution,
+  for details about the copyright.
+
+  This program is distributed in the hope that it will be useful,
+  but WITHOUT ANY WARRANTY; without even the implied warranty of
+  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
+program dumppem;
+
+uses sysutils, types, custapp, classes, fpasn, basenenc;
+
+Type
+
+  { TDumpApplication }
+
+  TDumpApplication = class(TCustomApplication)
+  private
+    FRaw : Boolean;
+    procedure DumpAsnList(aList: TStrings);
+    procedure DumpASNList(Prefix: string; aList: TStrings; AStart, aCount: Integer);
+    function GetBytes(FN: String) : TBytes;
+    procedure ShowASN(FN: String);
+    procedure Usage(aError : String);
+
+  Protected
+    procedure DoRun; override;
+  end;
+
+
+Procedure TDumpApplication.DumpASNList(Prefix : string; aList : TStrings; AStart,aCount : Integer);
+
+var
+  I : Integer;
+  ASize,aType : Integer;
+
+begin
+  I:=aStart;
+  While I<=aCount do
+    begin
+    ASNParse_GetItem(aList,i,aType,aSize);
+    writeln(Prefix,'ASNType=',ASNtypeToString(aType),' ASNSize=',aSize,' S="',aList[i],'"');
+    Inc(I);
+    end;
+end;
+
+Procedure TDumpApplication.DumpAsnList(aList : TStrings);
+
+begin
+  DumpASNList('',aList,0,aList.Count-1);
+end;
+
+function TDumpApplication.GetBytes(FN : String) : TBytes;
+
+Var
+  L : TStrings;
+  S : String;
+  I : Integer;
+
+begin
+  if FRaw then
+    Result:=GetFileContents(FN)
+  else
+    begin
+    L:=TStringList.Create;
+    try
+      L.LoadFromFile(FN);
+      S:='';
+      For I:=1 to L.Count-2 do
+        S:=S+Trim(L[i]);
+      Result:=BaseNenc.Base64.Decode(S);
+    finally
+      L.Free;
+    end;
+    end;
+end;
+
+Procedure TDumpApplication.ShowASN(FN : String);
+
+var
+  Bytes : TBytes;
+  L : TStrings;
+
+begin
+  Writeln('ASN.1 Contents of '+FN);
+  Bytes:=GetBytes(FN);
+  if HasOption('d','debug') then
+    Writeln(ASNDebug(Bytes))
+  else
+    begin
+    L:=TStringList.Create;
+    try
+      ASNParse(Bytes,L);
+      DumpAsnList(L);
+    finally
+      L.Free;
+    end;
+    end;
+end;
+
+procedure TDumpApplication.Usage(aError: String);
+begin
+  if (aError<>'') then
+    Writeln(aError);
+  Writeln('Usage : ',ExtractFileName(ParamStr(0)),' [options] FileName1 [FileName2..FileNameN]');
+  Writeln('Where options is one of:');
+  Writeln('-h  --help  This help');
+  Writeln('-r  --raw   Treat filenames as raw byte dumps (default is to assume .PEM format)');
+  Writeln('-d  --debug Use debug routine to dump content.');
+  ExitCode:=Ord(aError<>'');
+end;
+
+procedure TDumpApplication.DoRun ;
+
+const
+  Short = 'hrd';
+  Long : Array of string = ('help','raw','debug');
+
+var
+  S,FN : String;
+  NonOpt : TStringDynArray;
+
+begin
+  Terminate;
+  S:=CheckOptions(Short,Long);
+  if S='' then
+    begin
+    NonOpt:=GetNonOptions(Short,Long);
+    if 0=Length(NonOpt) then
+      S:='One or more filenames must be specified';
+    end;
+  if (S<>'') or HasOption('h','help') then
+    Usage(S)
+  else
+    begin
+    for FN in nonOpt do
+      ShowAsn(FN);
+    end;
+end;
+
+begin
+  With TDumpApplication.Create(Nil) do
+    try
+      Initialize;
+      Run;
+    finally
+      Free;
+    end;
+end.

packages/fcl-hash/examples/extractrsa.lpi

@@ -0,0 +1,62 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="extractrsa"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <BuildModes>
+      <Item Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+    </RunParams>
+    <Units>
+      <Unit>
+        <Filename Value="extractrsa.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="extractrsa"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <OtherUnitFiles Value="../src"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <Debugging>
+        <DebugInfoType Value="dsDwarf3"/>
+      </Debugging>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions>
+      <Item>
+        <Name Value="EAbort"/>
+      </Item>
+      <Item>
+        <Name Value="ECodetoolError"/>
+      </Item>
+      <Item>
+        <Name Value="EFOpenError"/>
+      </Item>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

packages/fcl-hash/examples/extractrsa.lpr

@@ -0,0 +1,144 @@
+{
+  This file is part of the Free Component Library.
+  Copyright (c) 2023 by the Free Pascal team.
+
+  Demo to dump the RSA private key in a PEM file
+
+  See the file COPYING.FPC, included in this distribution,
+  for details about the copyright.
+
+  This program is distributed in the hope that it will be useful,
+  but WITHOUT ANY WARRANTY; without even the implied warranty of
+  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
+program extractrsa;
+
+uses sysutils, types, custapp, classes, fpasn, basenenc, fprsa;
+
+Type
+
+  { TExtractRSAApplication }
+
+  TDumpApplication = class(TCustomApplication)
+  private
+    FRaw : Boolean;
+    procedure DumpX509RSA(Key: TX509RSAPrivateKey);
+    function GetBytes(FN: String) : TBytes;
+    procedure ShowASN(FN: String);
+    procedure Usage(aError : String);
+
+  Protected
+    procedure DoRun; override;
+  end;
+
+
+Procedure TDumpApplication.DumpX509RSA(Key : TX509RSAPrivateKey);
+
+  function DumpBytes(B : TBytes) : string;
+
+  begin
+    Result:=Base16.Encode(B,True);
+  end;
+
+begin
+  Writeln('X509 RSA Private Key:');
+  With key do
+    begin
+    Writeln('Version: ',Version);
+    Writeln('Modulus         (m/n): ',DumpBytes(Modulus));
+    Writeln('PublicExponent  (e)  : ',DumpBytes(PublicExponent));
+    Writeln('PrivateExponent (d)  : ',DumpBytes(PrivateExponent));
+    Writeln('Prime1          (p)  : ',DumpBytes(Prime1));
+    Writeln('Prime2          (q)  : ',DumpBytes(Prime2));
+    Writeln('Exponent1       (dp) : ',DumpBytes(Exponent1));
+    Writeln('Exponent2       (dq) : ',DumpBytes(Exponent2));
+    Writeln('Coefficient     (qi) : ',DumpBytes(Coefficient));
+    end;
+end;
+
+function TDumpApplication.GetBytes(FN : String) : TBytes;
+
+Var
+  L : TStrings;
+  S : String;
+  I : Integer;
+
+begin
+  if FRaw then
+    Result:=GetFileContents(FN)
+  else
+    begin
+    L:=TStringList.Create;
+    try
+      L.LoadFromFile(FN);
+      S:='';
+      For I:=1 to L.Count-2 do
+        S:=S+Trim(L[i]);
+      Result:=BaseNenc.Base64.Decode(S);
+    finally
+      L.Free;
+    end;
+    end;
+end;
+
+Procedure TDumpApplication.ShowASN(FN : String);
+
+var
+  Bytes : TBytes;
+  RSA : TX509RSAPrivateKey;
+
+begin
+  Writeln('ASN.1 Contents of '+FN);
+  Bytes:=GetBytes(FN);
+  X509RsaPrivateKeyInitFromDER(Rsa,Bytes);
+  DumpX509RSA(RSA);
+end;
+
+procedure TDumpApplication.Usage(aError: String);
+begin
+  if (aError<>'') then
+    Writeln(aError);
+  Writeln('Usage : ',ExtractFileName(ParamStr(0)),' [options] FileName1 [FileName2..FileNameN]');
+  Writeln('Where options is one of:');
+  Writeln('-h  --help  This help');
+  Writeln('-r  --raw   Treat filenames as raw byte dumps (default is to assume .PEM format)');
+  ExitCode:=Ord(aError<>'');
+end;
+
+procedure TDumpApplication.DoRun ;
+
+const
+  Short = 'hr';
+  Long : Array of string = ('help','raw');
+
+var
+  S,FN : String;
+  NonOpt : TStringDynArray;
+
+begin
+  Terminate;
+  S:=CheckOptions(Short,Long);
+  if S='' then
+    begin
+    NonOpt:=GetNonOptions(Short,Long);
+    if 0=Length(NonOpt) then
+      S:='One or more filenames must be specified';
+    end;
+  if (S<>'') or HasOption('h','help') then
+    Usage(S)
+  else
+    begin
+    for FN in nonOpt do
+      ShowAsn(FN);
+    end;
+end;
+
+begin
+  With TDumpApplication.Create(Nil) do
+    try
+      Initialize;
+      Run;
+    finally
+      Free;
+    end;
+end.

packages/fcl-hash/src/fpasn.pp

@@ -58,6 +58,10 @@ const
   // ASN_stateOrProvince Name = '2.5.4.8';
   // ASN_localityName = '2.5.4.7';
   ASN_ecPublicKey = '1.2.840.10045.2.1';
+  ASN_RSADSI = '1.2.840.113549';
+  ASN_PKCS = '1.2.840.113549.1';
+  ASN_PKCS_1 = '1.2.840.113549.1.1';
+  ASN_RSA_ENCRYPTION = '1.2.840.113549.1.1.1';
   // ASN_prime256v1 = '1.2.840.10045.3.1.7';
   ASN_secp256r1 = '1.2.840.10045.3.1.7';
   ASN_ecdsa_with_SHA256 = '1.2.840.10045.4.3.2';
@@ -96,6 +100,8 @@ procedure MibToId(Mib: AnsiString; var Result: AnsiString);
 procedure IdToMib(const Id: AnsiString; var Result: AnsiString); overload;
 function IdToMib(Buffer, BufferEnd: PByte): string; overload;
 
+procedure ASNDebugItem(var Buffer: PByte; BufferEnd: PByte; Out ASNType, ASNSize: Integer; var Output: TBytes);
+function ASNDebug(const Buffer: TBytes) : String;
 procedure ASNDebug(const Buffer: TBytes; var Output: TBytes);
 procedure ASNDebugList(const Prefix: string; List: TStrings);
 procedure ASNParse(const Buffer: TBytes; List: TStrings);
@@ -105,8 +111,39 @@ function ASNFetch(var Buffer: PByte; BufferEnd: PByte; Out ASNType, ASNSize: Int
 function ASNFetchOID(var Buffer: PByte; BufferEnd: PByte; out OID: UnicodeString): Boolean; overload;
 function ASNFetchOID(var Buffer: PByte; BufferEnd: PByte; out OID: AnsiString): Boolean; overload;
 
+Function ASNtypeToString(aType : Byte) : String;
+
 implementation
 
+Function ASNTypeToString(aType : Byte) : String;
+
+begin
+  Case aType of
+    ASN1_BOOL       : Result:='Boolean';
+    ASN1_INT        : Result:='INT';
+    ASN1_BITSTR     : Result:='BITSTR';
+    ASN1_OCTSTR     : Result:='OCTSTR';
+    ASN1_NULL       : Result:='NULL';
+    ASN1_OBJID      : Result:='ObjID';
+    ASN1_ENUM       : Result:='Enum';
+    ASN1_UTF8STRING : Result:='UTF8String';
+    ASN1_PRINTABLESTRING
+                    : Result:='PrintableString';
+    ASN1_IA5STRING  : Result:='IA5String';
+    ASN1_UTCTIME    : Result:='UTCTIME';
+    ASN1_SEQ        : Result:='Sequence';
+    ASN1_SETOF      : Result:='SET';
+    ASN1_IPADDR     : Result:='IPAddress';
+    ASN1_COUNTER    : Result:='Counter';
+    ASN1_GAUGE      : Result:='Gauge';
+    ASN1_TIMETICKS  : Result:='TimeTicks';
+    ASN1_OPAQUE     : Result:='Opaque';
+    ASN1_COUNTER64  : Result:='Counter64';
+  else
+    Result:=Format('Unknown(%d)',[aType]);
+  end;
+end;
+
 //------------------------------------------------------------------------------
 // ASN
 //------------------------------------------------------------------------------
@@ -710,6 +747,15 @@ begin
 end;
 
 // Convert ASN.1 DER encoded buffer to human readable form for debugging
+function ASNDebug(const Buffer: TBytes) : String;
+
+var
+  aOUtput : TBytes;
+begin
+  ASNDebug(Buffer,aOutput);
+  Result:=TEncoding.UTF8.GetAnsiString(aOutput);
+end;
+
 procedure ASNDebug(const Buffer: TBytes; var Output: TBytes);
 
 const
@@ -730,7 +776,7 @@ begin
   EndP:=StartP+length(Buffer);
   while p<EndP do
   begin
-    writeln('ASNDebug p=',p-StartP,' Type=',hexstr(p^,2),' Indent=',length(IndentList));
+    // writeln('ASNDebug p=',p-StartP,' Type=',hexstr(p^,2),' Indent=',length(IndentList));
     // check if any sequence/set has ended and unindent
     for n := Length(IndentList)-1 downto 0 do
     begin

packages/fcl-hash/src/fprsa.pas

@@ -383,37 +383,79 @@ begin
   RSAInitFromX509PrivateKey(RSA,X509RSA);
 end;
 
+function ExtractRSAFromPKCS8(List : TStrings) : TBytes;
+
+Const
+  SInvalid = 'Invalid PKCS#8 ';
+
+var
+  ASNType, ASNSize: integer;
+
+begin
+  Result:=[];
+  ASNParse_GetItem(List,0,ASNType,ASNSize);
+  if ASNType<>ASN1_SEQ then
+    raise Exception.Create(SInvalid+'Sequence 1');
+  ASNParse_GetItem(List,1,ASNType,ASNSize);
+  if ASNType<>ASN1_INT then
+    raise Exception.Create(SInvalid+'Int 1');
+  if StrToIntDef(List[1],-1)<>0 then
+    raise Exception.Create(SInvalid+'Int 1.a');
+  ASNParse_GetItem(List,2,ASNType,ASNSize);
+  if ASNType<>ASN1_SEQ then
+    raise Exception.Create(SInvalid+'Sequence 2');
+  ASNParse_GetItem(List,3,ASNType,ASNSize);
+  if ASNType<>ASN1_OBJID  then
+    raise Exception.Create(SInvalid+'ObjID');
+  ASNParse_GetItem(List,4,ASNType,ASNSize);
+  if ASNType<>ASN1_NULL then
+    raise Exception.Create(SInvalid+'Attribute');
+  ASNParse_GetItem(List,5,ASNType,ASNSize);
+  if ASNType<>ASN1_OCTSTR then
+    raise Exception.Create(SInvalid+'RSA key');
+  Result:=HexStrToBytes(List[5]);
+end;
+
+
 procedure X509RsaPrivateKeyInitFromDER(out RSA: TX509RSAPrivateKey; const PrivateKeyDER: TBytes);
 var
   List: TStringList;
   ASNType, ASNSize: integer;
+  B : TBytes;
 begin
   RSA:=Default(TX509RSAPrivateKey);
   List:=TStringList.Create;
   try
     ASNParse(PrivateKeyDER,List);
-    if List.Count<10 then
+    if Not List.Count in [6,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);
+    if List.Count = 6 then
+      begin
+      B:=ExtractRSAFromPKCS8(List);
+      X509RsaPrivateKeyInitFromDER(RSA,B);
+      end
+    else
+      begin
+      // 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);
+      end;
 
     {$IFDEF TLS_DEBUG}
     with RSA do begin