fpc/packages/fcl-net/src/sslbase.pp

{$IFNDEF FPC_DOTTEDUNITS}
unit sslbase;
{$ENDIF FPC_DOTTEDUNITS}
{
    This file is part of the Free Pascal run time library.
    Copyright (c) 1999-2022 by Michael van Canney and other members of the
    Free Pascal development team

    SSL Base unit

    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.

 **********************************************************************}

{$mode objfpc}{$H+}

interface

{$IFDEF FPC_DOTTEDUNITS}
uses
  System.Classes, System.SysUtils;
{$ELSE FPC_DOTTEDUNITS}
uses
  Classes, SysUtils;
{$ENDIF FPC_DOTTEDUNITS}

Type
  TSSLType = (stAny,stSSLv2,stSSLv3,stTLSv1,stTLSv1_1,stTLSv1_2);

  { TSSLData }

  TSSLData = Class(TPersistent)
  private
    FFileName: String;
    FValue: TBytes;
  Public
    Function Empty : Boolean;
    Procedure Assign(Source : TPersistent);override;
    Property FileName : String Read FFileName Write FFileName;
    Property Value: TBytes Read FValue Write FValue;
  end;

Const
  SSLDataCount = 4; // 0 based.
  StrDataCount = 2; // 0 based.

Type
  { TSSLSocketHandler }

  { TCertificateData }

  TCertificateData = Class(TPersistent)
  Private
    FStrData : Array[0..StrDataCount] of string;
    FCertData : Array[0..SSLDataCount] of TSSLData;
    FTrustedCertsDir: String;
    function GetSSLData(AIndex: Integer): TSSLData;
    procedure SetSSLData(AIndex: Integer; AValue: TSSLData);
    function GetString(AIndex: Integer): String;
    procedure SetString(AIndex: Integer; const AValue: String);
  Public
    constructor Create;
    Destructor Destroy; override;
    Procedure Assign(Source : TPersistent); override;
    Function NeedCertificateData : Boolean;
  Published
    property KeyPassword: string Index 0 read GetString write SetString;
    property CipherList: string Index 1 read GetString write SetString;
    Property HostName : String Index 2 read GetString write SetString;
    property Certificate : TSSLData Index 0 Read GetSSLData Write SetSSLData;
    property TrustedCertificate : TSSLData Index 1 Read GetSSLData Write SetSSLData;
    property PrivateKey : TSSLData Index 2 Read GetSSLData Write SetSSLData;
    property PFX: TSSLData Index 3 Read GetSSLData Write SetSSLData;
    property CertCA: TSSLData Index 4 Read GetSSLData Write SetSSLData;
    // OpenSSL allows both a PEM file or a Dir. We separate out the dir.
    Property TrustedCertsDir : String Read FTrustedCertsDir Write FTrustedCertsDir;
  end;

    { TX509Certificate }
  TCertAndKey = Record
    Certificate : TBytes;
    PrivateKey : TBytes;
  end;

  TX509Certificate = Class (TObject)
  private
    FCommonName: string;
    FCountry: String;
    FHostName: string;
    FKeySize: Integer;
    FOrganization: String;
    FSerial: Integer;
    FValidFrom: TDateTime;
    FValidTo: TDateTime;
    FVersion: Integer;
    function GetKeySize: Integer;
    function GetValidFrom: TDateTime;
    function GetValidTo: TDateTime;
    function GetVersion: Integer;
  Protected
    Function GetRealSerial : Integer;
  Public
    Function CreateCertificateAndKey : TCertAndKey; virtual; abstract;
    Procedure CreateCertificateAndKey(Var aCertificate,aKey : TBytes);
    Property Country : String Read FCountry Write FCountry;
    Property HostName : string Read FHostName Write FHostName;
    Property CommonName : string Read FCommonName Write FCommonName;
    Property Organization : String Read FOrganization Write FOrganization;
    Property KeySize : Integer Read GetKeySize Write FKeySize;
    // Valid from. Default today -1;
    Property ValidFrom : TDateTime Read GetValidFrom Write FValidFrom;
    // Valid To. Default today + 31;
    Property ValidTo : TDateTime Read GetValidTo Write FValidTo;
    // Version Default 1.
    Property Version : Integer Read GetVersion Write FVersion;
    // Serial. If zero, then a serial is generated.
    Property Serial : Integer Read FSerial Write FSerial;

  end;

implementation

{ TSSLData }

Function TSSLData.Empty: Boolean;
begin
  Result:=(Length(Value)=0) and (FileName='');
end;

Procedure TSSLData.Assign(Source: TPersistent);

begin
  if Source is TSSLData then
   With TSSLData(Source) do
    begin
    Self.FValue:=FValue;
    Self.FFileName:=FFileName;
    end
  else
    inherited Assign(Source);
end;

{ TCertificateData }

function TCertificateData.GetSSLData(AIndex: Integer): TSSLData;
begin
  Result:=FCertData[AIndex];
end;

procedure TCertificateData.SetSSLData(AIndex: Integer; AValue: TSSLData);
begin
  FCertData[AIndex].Assign(AValue);
end;

function TCertificateData.GetString(AIndex: Integer): String;
begin
  Result:=FStrData[AIndex];
  if (AIndex=2) and (result='') then
    Result:='localhost';
end;

procedure TCertificateData.SetString(AIndex: Integer; const AValue: String);
begin
  FStrData[AIndex]:=aValue;
end;

constructor TCertificateData.Create;

Var
  I : Integer;

begin
  CipherList:='DEFAULT';
  HostName:='localhost';
  For I:=0 to SSLDataCount do
    FCertData[i]:=TSSLData.Create;
end;

destructor TCertificateData.Destroy;

Var
  I : Integer;

begin
  For I:=0 to SSLDataCount do
    FreeAndNil(FCertData[i]);
  inherited Destroy;
end;

procedure TCertificateData.Assign(Source: TPersistent);

Var
  CD : TCertificateData;
  I : Integer;

begin
  if Source is TCertificateData then
    begin
    CD:=Source as TCertificateData;
    For I:=0 to StrDataCount do
      FStrData[i]:=CD.FStrData[i];
    For I:=0 to SSLDataCount do
      FCertData[i].Assign(CD.FCertData[i])
    end
  else
    inherited Assign(Source);
end;

function TCertificateData.NeedCertificateData: Boolean;
begin
  Result:=Certificate.Empty and PFX.Empty;
end;

function TX509Certificate.GetKeySize: Integer;
begin
  Result:=FKeySize;
  if Result=0 then
    Result:=1024;
end;

function TX509Certificate.GetValidFrom: TDateTime;
begin
  Result:=FValidFrom;
  If Result=0 then
    Result:=Date-1;
end;

function TX509Certificate.GetValidTo: TDateTime;
begin
  Result:=FValidTo;
  If Result=0 then
    Result:=Date+31;
end;


function TX509Certificate.GetVersion: Integer;
begin
  Result:=FVersion;
  if FVersion=0 then
    FVersion:=1;
end;

function TX509Certificate.GetRealSerial: Integer;
begin
  Result:=FSerial;
  if Result=0 then
    Result:=10; // MinutesBetween(Now,EncodeDate(2019,1,1));
end;

procedure TX509Certificate.CreateCertificateAndKey(var aCertificate, aKey: TBytes);

Var
  CK : TCertAndKey;

begin
  CK:=CreateCertificateAndKey;
  aCertificate:=CK.Certificate;
  aKey:=CK.PrivateKey;
end;

end.