1unit sslbase; 2 3{$mode objfpc}{$H+} 4 5interface 6 7uses 8 Classes, SysUtils; 9 10Type 11 TSSLType = (stAny,stSSLv2,stSSLv3,stTLSv1,stTLSv1_1,stTLSv1_2); 12 13 { TSSLData } 14 15 TSSLData = Class(TPersistent) 16 private 17 FFileName: String; 18 FValue: TBytes; 19 Public 20 Function Empty : Boolean; 21 Procedure Assign(Source : TPersistent);override; 22 Property FileName : String Read FFileName Write FFileName; 23 Property Value: TBytes Read FValue Write FValue; 24 end; 25 26Const 27 SSLDataCount = 4; // 0 based. 28 StrDataCount = 2; // 0 based. 29 30Type 31 { TSSLSocketHandler } 32 33 { TCertificateData } 34 35 TCertificateData = Class(TPersistent) 36 Private 37 FStrData : Array[0..StrDataCount] of string; 38 FCertData : Array[0..SSLDataCount] of TSSLData; 39 function GetSSLData(AIndex: Integer): TSSLData; 40 procedure SetSSLData(AIndex: Integer; AValue: TSSLData); 41 function GetString(AIndex: Integer): String; 42 procedure SetString(AIndex: Integer; AValue: String); 43 Public 44 constructor Create; 45 Destructor Destroy; override; 46 Procedure Assign(Source : TPersistent); override; 47 Function NeedCertificateData : Boolean; 48 Published 49 property KeyPassword: string Index 0 read GetString write SetString; 50 property CipherList: string Index 1 read GetString write SetString; 51 Property HostName : String Index 2 read GetString write SetString; 52 property Certificate : TSSLData Index 0 Read GetSSLData Write SetSSLData; 53 property TrustedCertificate : TSSLData Index 1 Read GetSSLData Write SetSSLData; 54 property PrivateKey : TSSLData Index 2 Read GetSSLData Write SetSSLData; 55 property PFX: TSSLData Index 3 Read GetSSLData Write SetSSLData; 56 property CertCA: TSSLData Index 4 Read GetSSLData Write SetSSLData; 57 end; 58 59 { TX509Certificate } 60 TCertAndKey = Record 61 Certificate : TBytes; 62 PrivateKey : TBytes; 63 end; 64 65 TX509Certificate = Class (TObject) 66 private 67 FCommonName: string; 68 FCountry: String; 69 FHostName: string; 70 FKeySize: Integer; 71 FOrganization: String; 72 FSerial: Integer; 73 FValidFrom: TDateTime; 74 FValidTo: TDateTime; 75 FVersion: Integer; 76 function GetKeySize: Integer; 77 function GetValidFrom: TDateTime; 78 function GetValidTo: TDateTime; 79 function GetVersion: Integer; 80 Protected 81 Function GetRealSerial : Integer; 82 Public 83 Function CreateCertificateAndKey : TCertAndKey; virtual; abstract; 84 Procedure CreateCertificateAndKey(Var aCertificate,aKey : TBytes); 85 Property Country : String Read FCountry Write FCountry; 86 Property HostName : string Read FHostName Write FHostName; 87 Property CommonName : string Read FCommonName Write FCommonName; 88 Property Organization : String Read FOrganization Write FOrganization; 89 Property KeySize : Integer Read GetKeySize Write FKeySize; 90 // Valid from. Default today -1; 91 Property ValidFrom : TDateTime Read GetValidFrom Write FValidFrom; 92 // Valid To. Default today + 31; 93 Property ValidTo : TDateTime Read GetValidTo Write FValidTo; 94 // Version Default 1. 95 Property Version : Integer Read GetVersion Write FVersion; 96 // Serial. If zero, then a serial is generated. 97 Property Serial : Integer Read FSerial Write FSerial; 98 99 end; 100 101implementation 102 103{ TSSLData } 104 105Function TSSLData.Empty: Boolean; 106begin 107 Result:=(Length(Value)=0) and (FileName=''); 108end; 109 110Procedure TSSLData.Assign(Source: TPersistent); 111 112begin 113 if Source is TSSLData then 114 With TSSLData(Source) do 115 begin 116 Self.FValue:=FValue; 117 Self.FFileName:=FFileName; 118 end 119 else 120 inherited Assign(Source); 121end; 122 123{ TCertificateData } 124 125function TCertificateData.GetSSLData(AIndex: Integer): TSSLData; 126begin 127 Result:=FCertData[AIndex]; 128end; 129 130procedure TCertificateData.SetSSLData(AIndex: Integer; AValue: TSSLData); 131begin 132 FCertData[AIndex].Assign(AValue); 133end; 134 135function TCertificateData.GetString(AIndex: Integer): String; 136begin 137 Result:=FStrData[AIndex]; 138 if (AIndex=2) and (result='') then 139 Result:='localhost'; 140end; 141 142procedure TCertificateData.SetString(AIndex: Integer; AValue: String); 143begin 144 FStrData[AIndex]:=aValue; 145end; 146 147constructor TCertificateData.Create; 148 149Var 150 I : Integer; 151 152begin 153 CipherList:='DEFAULT'; 154 HostName:='localhost'; 155 For I:=0 to SSLDataCount do 156 FCertData[i]:=TSSLData.Create; 157end; 158 159destructor TCertificateData.Destroy; 160 161Var 162 I : Integer; 163 164begin 165 For I:=0 to SSLDataCount do 166 FreeAndNil(FCertData[i]); 167 inherited Destroy; 168end; 169 170procedure TCertificateData.Assign(Source: TPersistent); 171 172Var 173 CD : TCertificateData; 174 I : Integer; 175 176begin 177 if Source is TCertificateData then 178 begin 179 CD:=Source as TCertificateData; 180 For I:=0 to StrDataCount do 181 FStrData[i]:=CD.FStrData[i]; 182 For I:=0 to SSLDataCount do 183 FCertData[i].Assign(CD.FCertData[i]) 184 end 185 else 186 inherited Assign(Source); 187end; 188 189function TCertificateData.NeedCertificateData: Boolean; 190begin 191 Result:=Certificate.Empty and PFX.Empty; 192end; 193 194function TX509Certificate.GetKeySize: Integer; 195begin 196 Result:=FKeySize; 197 if Result=0 then 198 Result:=1024; 199end; 200 201function TX509Certificate.GetValidFrom: TDateTime; 202begin 203 Result:=FValidFrom; 204 If Result=0 then 205 Result:=Date-1; 206end; 207 208function TX509Certificate.GetValidTo: TDateTime; 209begin 210 Result:=FValidTo; 211 If Result=0 then 212 Result:=Date+31; 213end; 214 215 216function TX509Certificate.GetVersion: Integer; 217begin 218 Result:=FVersion; 219 if FVersion=0 then 220 FVersion:=1; 221end; 222 223function TX509Certificate.GetRealSerial: Integer; 224begin 225 Result:=FSerial; 226 if Result=0 then 227 Result:=10; // MinutesBetween(Now,EncodeDate(2019,1,1)); 228end; 229 230procedure TX509Certificate.CreateCertificateAndKey(var aCertificate, aKey: TBytes); 231 232Var 233 CK : TCertAndKey; 234 235begin 236 CK:=CreateCertificateAndKey; 237 aCertificate:=CK.Certificate; 238 aKey:=CK.PrivateKey; 239end; 240 241end. 242 243