327 lines
12 KiB
ObjectPascal
327 lines
12 KiB
ObjectPascal
{******************************************************************************}
|
|
{ }
|
|
{ Library: Fundamentals 5.00 }
|
|
{ File name: flcPEM.pas }
|
|
{ File version: 5.03 }
|
|
{ Description: PEM file parsing }
|
|
{ }
|
|
{ Copyright: Copyright (c) 2010-2020, David J Butler }
|
|
{ All rights reserved. }
|
|
{ Redistribution and use in source and binary forms, with }
|
|
{ or without modification, are permitted provided that }
|
|
{ the following conditions are met: }
|
|
{ Redistributions of source code must retain the above }
|
|
{ copyright notice, this list of conditions and the }
|
|
{ following disclaimer. }
|
|
{ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND }
|
|
{ CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED }
|
|
{ WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED }
|
|
{ WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A }
|
|
{ PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL }
|
|
{ THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, }
|
|
{ INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR }
|
|
{ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, }
|
|
{ PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF }
|
|
{ USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) }
|
|
{ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER }
|
|
{ IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING }
|
|
{ NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE }
|
|
{ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE }
|
|
{ POSSIBILITY OF SUCH DAMAGE. }
|
|
{ }
|
|
{ Github: https://github.com/fundamentalslib }
|
|
{ E-mail: fundamentals.library at gmail.com }
|
|
{ }
|
|
{ Revision history: }
|
|
{ }
|
|
{ 2011/10/18 0.01 Initial development. }
|
|
{ 2016/01/10 0.02 String changes. }
|
|
{ 2018/07/17 5.03 Revised for Fundamentals 5. }
|
|
{ }
|
|
{******************************************************************************}
|
|
|
|
{$INCLUDE ..\flcInclude.inc}
|
|
|
|
{$IFDEF DEBUG}
|
|
{$IFDEF TEST}
|
|
{$DEFINE PEM_TEST}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
unit flcPEM;
|
|
|
|
interface
|
|
|
|
uses
|
|
{ System }
|
|
|
|
SysUtils,
|
|
|
|
{ Fundamentals }
|
|
|
|
flcStdTypes;
|
|
|
|
|
|
|
|
{ TPEMFile }
|
|
|
|
type
|
|
TPEMFile = class
|
|
private
|
|
FCertificates : array of RawByteString;
|
|
FRSAPrivateKey : RawByteString;
|
|
|
|
procedure Clear;
|
|
procedure AddCertificate(const CertificatePEM: RawByteString);
|
|
procedure SetRSAPrivateKey(const RSAPrivateKeyPEM: RawByteString);
|
|
procedure ParsePEMContent(const Content: RawByteString);
|
|
|
|
function GetCertificateCount: Integer;
|
|
function GetCertificate(const Idx: Integer): RawByteString;
|
|
|
|
public
|
|
procedure LoadFromText(const Txt: RawByteString);
|
|
procedure LoadFromFile(const FileName: String);
|
|
|
|
property CertificateCount: Integer read GetCertificateCount;
|
|
property Certificate[const Idx: Integer]: RawByteString read GetCertificate;
|
|
property RSAPrivateKey: RawByteString read FRSAPrivateKey;
|
|
end;
|
|
|
|
EPEMFile = class(Exception);
|
|
|
|
|
|
|
|
{$IFDEF PEM_TEST}
|
|
procedure Test;
|
|
{$ENDIF}
|
|
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
{ System }
|
|
|
|
Classes,
|
|
|
|
{ Fundamentals }
|
|
|
|
flcStrings,
|
|
flcBase64;
|
|
|
|
|
|
|
|
{ TPEMFile }
|
|
|
|
procedure TPEMFile.Clear;
|
|
begin
|
|
FCertificates := nil;
|
|
FRSAPrivateKey := '';
|
|
end;
|
|
|
|
procedure TPEMFile.AddCertificate(const CertificatePEM: RawByteString);
|
|
var
|
|
L : Integer;
|
|
C : RawByteString;
|
|
begin
|
|
C := MIMEBase64Decode(CertificatePEM);
|
|
L := Length(FCertificates);
|
|
SetLength(FCertificates, L + 1);
|
|
FCertificates[L] := C;
|
|
end;
|
|
|
|
procedure TPEMFile.SetRSAPrivateKey(const RSAPrivateKeyPEM: RawByteString);
|
|
begin
|
|
FRSAPrivateKey := MIMEBase64Decode(RSAPrivateKeyPEM);
|
|
end;
|
|
|
|
procedure TPEMFile.ParsePEMContent(const Content: RawByteString);
|
|
var
|
|
S : RawByteString;
|
|
|
|
function GetTextBetween(const Start, Stop: RawByteString; var Between: RawByteString): Boolean;
|
|
var I, J : Integer;
|
|
begin
|
|
I := PosStrB(Start, S, 1, False);
|
|
if I > 0 then
|
|
begin
|
|
J := PosStrB(Stop, S, 1, False);
|
|
if J = 0 then
|
|
J := Length(S) + 1;
|
|
Between := CopyRangeB(S, I + Length(Start), J - 1);
|
|
Delete(S, I, J + Length(Stop) - I);
|
|
Between := StrRemoveCharSetB(Between, [#0..#32]);
|
|
Result := True;
|
|
end
|
|
else
|
|
Result := False;
|
|
end;
|
|
|
|
var
|
|
Found : Boolean;
|
|
Cert : RawByteString;
|
|
RSAPriv : RawByteString;
|
|
|
|
begin
|
|
S := Content;
|
|
repeat
|
|
Found := GetTextBetween('-----BEGIN CERTIFICATE-----', '-----END CERTIFICATE-----', Cert);
|
|
if Found then
|
|
AddCertificate(Cert);
|
|
until not Found;
|
|
Found := GetTextBetween('-----BEGIN RSA PRIVATE KEY-----', '-----END RSA PRIVATE KEY-----', RSAPriv);
|
|
if Found then
|
|
SetRSAPrivateKey(RSAPriv);
|
|
end;
|
|
|
|
procedure TPEMFile.LoadFromText(const Txt: RawByteString);
|
|
begin
|
|
Clear;
|
|
ParsePEMContent(Txt);
|
|
end;
|
|
|
|
procedure TPEMFile.LoadFromFile(const FileName: String);
|
|
var
|
|
F : TFileStream;
|
|
B : RawByteString;
|
|
L : Int64;
|
|
N : Integer;
|
|
begin
|
|
try
|
|
F := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
|
|
try
|
|
L := F.Size;
|
|
if L > 16 * 1024 * 1024 then
|
|
raise EPEMFile.Create('File too large');
|
|
N := L;
|
|
if N = 0 then
|
|
B := ''
|
|
else
|
|
begin
|
|
SetLength(B, N);
|
|
F.ReadBuffer(B[1], N);
|
|
end;
|
|
finally
|
|
F.Free;
|
|
end;
|
|
except
|
|
on E : Exception do
|
|
raise EPEMFile.CreateFmt('Error loading PEM file: %s: %s', [E.ClassName, E.Message]);
|
|
end;
|
|
LoadFromText(B);
|
|
end;
|
|
|
|
function TPEMFile.GetCertificateCount: Integer;
|
|
begin
|
|
Result := Length(FCertificates);
|
|
end;
|
|
|
|
function TPEMFile.GetCertificate(const Idx: Integer): RawByteString;
|
|
begin
|
|
Result := FCertificates[Idx];
|
|
end;
|
|
|
|
|
|
|
|
{$IFDEF PEM_TEST}
|
|
{$ASSERTIONS ON}
|
|
const
|
|
TestPEMText1 = // stunnel.pem
|
|
'-----BEGIN RSA PRIVATE KEY-----'#13#10 +
|
|
'MIICXAIBAAKBgQCxUFMuqJJbI9KnB8VtwSbcvwNOltWBtWyaSmp7yEnqwWel5TFf'#13#10 +
|
|
'cOObCuLZ69sFi1ELi5C91qRaDMow7k5Gj05DZtLDFfICD0W1S+n2Kql2o8f2RSvZ'#13#10 +
|
|
'qD2W9l8i59XbCz1oS4l9S09L+3RTZV9oer/Unby/QmicFLNM0WgrVNiKywIDAQAB'#13#10 +
|
|
'AoGAKX4KeRipZvpzCPMgmBZi6bUpKPLS849o4pIXaO/tnCm1/3QqoZLhMB7UBvrS'#13#10 +
|
|
'PfHj/Tejn0jjHM9xYRHi71AJmAgzI+gcN1XQpHiW6kATNDz1r3yftpjwvLhuOcp9'#13#10 +
|
|
'tAOblojtImV8KrAlVH/21rTYQI+Q0m9qnWKKCoUsX9Yu8UECQQDlbHL38rqBvIMk'#13#10 +
|
|
'zK2wWJAbRvVf4Fs47qUSef9pOo+p7jrrtaTqd99irNbVRe8EWKbSnAod/B04d+cQ'#13#10 +
|
|
'ci8W+nVtAkEAxdqPOnCISW4MeS+qHSVtaGv2kwvfxqfsQw+zkwwHYqa+ueg4wHtG'#13#10 +
|
|
'/9+UgxcXyCXrj0ciYCqURkYhQoPbWP82FwJAWWkjgTgqsYcLQRs3kaNiPg8wb7Yb'#13#10 +
|
|
'NxviX0oGXTdCaAJ9GgGHjQ08lNMxQprnpLT8BtZjJv5rUOeBuKoXagggHQJAaUAF'#13#10 +
|
|
'91GLvnwzWHg5p32UgPsF1V14siX8MgR1Q6EfgKQxS5Y0Mnih4VXfnAi51vgNIk/2'#13#10 +
|
|
'AnBEJkoCQW8BTYueCwJBALvz2JkaUfCJc18E7jCP7qLY4+6qqsq+wr0t18+ogOM9'#13#10 +
|
|
'JIY9r6e1qwNxQ/j1Mud6gn6cRrObpRtEad5z2FtcnwY='#13#10 +
|
|
'-----END RSA PRIVATE KEY-----'#13#10 +
|
|
'-----BEGIN CERTIFICATE-----'#13#10 +
|
|
'MIICDzCCAXigAwIBAgIBADANBgkqhkiG9w0BAQQFADBCMQswCQYDVQQGEwJQTDEf'#13#10 +
|
|
'MB0GA1UEChMWU3R1bm5lbCBEZXZlbG9wZXJzIEx0ZDESMBAGA1UEAxMJbG9jYWxo'#13#10 +
|
|
'b3N0MB4XDTk5MDQwODE1MDkwOFoXDTAwMDQwNzE1MDkwOFowQjELMAkGA1UEBhMC'#13#10 +
|
|
'UEwxHzAdBgNVBAoTFlN0dW5uZWwgRGV2ZWxvcGVycyBMdGQxEjAQBgNVBAMTCWxv'#13#10 +
|
|
'Y2FsaG9zdDCBnzANBgkqhkiG9w0BAQEFAAOBjQAwgYkCgYEAsVBTLqiSWyPSpwfF'#13#10 +
|
|
'bcEm3L8DTpbVgbVsmkpqe8hJ6sFnpeUxX3Djmwri2evbBYtRC4uQvdakWgzKMO5O'#13#10 +
|
|
'Ro9OQ2bSwxXyAg9FtUvp9iqpdqPH9kUr2ag9lvZfIufV2ws9aEuJfUtPS/t0U2Vf'#13#10 +
|
|
'aHq/1J28v0JonBSzTNFoK1TYissCAwEAAaMVMBMwEQYJYIZIAYb4QgEBBAQDAgZA'#13#10 +
|
|
'MA0GCSqGSIb3DQEBBAUAA4GBAAhYFTngWc3tuMjVFhS4HbfFF/vlOgTu44/rv2F+'#13#10 +
|
|
'ya1mEB93htfNxx3ofRxcjCdorqONZFwEba6xZ8/UujYfVmIGCBy4X8+aXd83TJ9A'#13#10 +
|
|
'eSjTzV9UayOoGtmg8Dv2aj/5iabNeK1Qf35ouvlcTezVZt2ZeJRhqUHcGaE+apCN'#13#10 +
|
|
'TC9Y'#13#10 +
|
|
'-----END CERTIFICATE-----'#13#10;
|
|
|
|
TestPEMText2 =
|
|
'-----BEGIN CERTIFICATE-----' +
|
|
'MIIDQjCCAiqgAwIBAgIJAKDslQh3d8kdMA0GCSqGSIb3DQEBBQUAMB8xHTAbBgNV' +
|
|
'BAMTFHd3dy5ldGVybmFsbGluZXMuY29tMB4XDTExMTAxODEwMzYwOVoXDTIxMTAx' +
|
|
'NTEwMzYwOVowHzEdMBsGA1UEAxMUd3d3LmV0ZXJuYWxsaW5lcy5jb20wggEiMA0G' +
|
|
'CSqGSIb3DQEBAQUAA4IBDwAwggEKAoIBAQCw/7d6zyehR69DaJCGbk3oMP7pSWya' +
|
|
'U1tDMG+CdqikLqHoo3SBshbvquOVFcy9yY8fECTbNXfOjhV0M6SJgGQ/SP/nfZgx' +
|
|
'MHAK9sWc5G6V5sqPqrTRgkv0Wu25mdO6FRh8DIxOMY0Ppqno5hHZ0emSj1amvtWX' +
|
|
'zBD6pXNGgrFln6HL2eyCwqlL0wTXWO/YrvblF/83Ln9i6luVQ9NtACQBiPcYqoNM' +
|
|
'1OG142xYNpRNp7zrHkNCQeXVxmC6goCgj0BmcSqrUPayLdgkgv8hniUwLYQIt91r' +
|
|
'cxJwGNWxlbLgqQqTdhecKp01JVgO8jy3yFpMEoqCj9+BuuxVqDfvHK1tAgMBAAGj' +
|
|
'gYAwfjAdBgNVHQ4EFgQUbLgD+S3ZSNlU1nxTsjTmAQIfpCQwTwYDVR0jBEgwRoAU' +
|
|
'bLgD+S3ZSNlU1nxTsjTmAQIfpCShI6QhMB8xHTAbBgNVBAMTFHd3dy5ldGVybmFs' +
|
|
'bGluZXMuY29tggkAoOyVCHd3yR0wDAYDVR0TBAUwAwEB/zANBgkqhkiG9w0BAQUF' +
|
|
'AAOCAQEACSQTcPC8ga5C/PysnoTNAk4OB+hdgMoS3Fv7ROUV9GqgYED6rJo0+CxD' +
|
|
'g19GLlKt/aBlglh4Ddc7X84dWtftS4JIjjVVkWevt8/sDoZ+ISd/tC9aDX3gOAlW' +
|
|
'RORhfp3Qtyy0AjZcIOAGNkzkotuMG/uOVifPFhTNXwa8hHOGN60riGXEj5sNFFop' +
|
|
'EaxplTfakVq8TxlQivnIETjrEbVX8XkOl4nlsHevC2suXE1ZkQIbQoaAy0WzGGUR' +
|
|
'54GBIzXf32t80S71w5rs/mzVaGOeTZYcHtv5Epd9CNVrEle6w0NW9R7Ov4gXI9n8' +
|
|
'GV9jITGfsOdqu7j9Iaf7MVj+JRE7Dw==' +
|
|
'-----END CERTIFICATE-----' +
|
|
'-----BEGIN RSA PRIVATE KEY-----' +
|
|
'MIIEpQIBAAKCAQEAsP+3es8noUevQ2iQhm5N6DD+6UlsmlNbQzBvgnaopC6h6KN0' +
|
|
'gbIW76rjlRXMvcmPHxAk2zV3zo4VdDOkiYBkP0j/532YMTBwCvbFnORulebKj6q0' +
|
|
'0YJL9FrtuZnTuhUYfAyMTjGND6ap6OYR2dHpko9Wpr7Vl8wQ+qVzRoKxZZ+hy9ns' +
|
|
'gsKpS9ME11jv2K725Rf/Ny5/YupblUPTbQAkAYj3GKqDTNThteNsWDaUTae86x5D' +
|
|
'QkHl1cZguoKAoI9AZnEqq1D2si3YJIL/IZ4lMC2ECLfda3MScBjVsZWy4KkKk3YX' +
|
|
'nCqdNSVYDvI8t8haTBKKgo/fgbrsVag37xytbQIDAQABAoIBAQCdnZnOCtrHjAZO' +
|
|
'iLbqfx9xPPBC3deQNdp3IpKqIvBaBAy6FZSSSfySwCKZiCgieXKxvraTXjGqBmyk' +
|
|
'ZbiHmYWrtV3szrLQWsnreYTQCbtQUYzgEquiRd1NZAt907XvZwm+rY3js8xhu5Bi' +
|
|
'jT4oMf1FPc9z/UxHOLmF+f+FMqy2SM2Fxh3jAsxJBaMVEJXpqdQDI86CATgYrqVY' +
|
|
'mlAWQcQ8pL0wwRctZ+XgjQH52V3sk4cIzqIBTO+MN6emmxDl9JdrGZKRei9YEIhG' +
|
|
'mFeXH7rsGg+TZtfvu1M9Kfy2fdgNwTUoTTn93v8gcrwCbyvl5JCzKy07Om/aOXFr' +
|
|
'I8bSWXIhAoGBANu07hegU99zIhvTWmh2Fuml0Lr+cHcZTObh+oeZg1xaDUrlnFOY' +
|
|
'3fyA5x5Jxib3V7OOAeIz/AsmcYq/649nR8NfeiizY5or84Fy1mazRR8diGDV3nUG' +
|
|
'ZATv6yaOY/z31FOLaxT95tDvqWK+Qr5cykq4e6XDDp9P8odCIjJmUdt7AoGBAM48' +
|
|
'vCjtGQ99BVwkcFIj0IacRj3YKzsp06W6V2Z+czlKctJAMAQN8hu9IcXMEIUsi9GD' +
|
|
'MkyzzxjvGRdmIuS58IFqRbr/fIAQLVpY9SPAL771ZCFHmIrKrCYiLYAcg/BSoR29' +
|
|
'me6aFaEcLBFvzHPFNymdyMsaOHSRMZYUlq6VUbI3AoGBAINJeMURf00VRZqPD4VA' +
|
|
'm6x+813qUVY5/iQxgT2qVD7JaQwKbQHfZTdP58vHlesO/o9DGokLO1+GV27sBF0r' +
|
|
'AE0VLrBHkgs8nEQMVWYFVhaj1SzYYBhZ+0af/0qI5+LwTSanNxPSLS1JKVTiEIwk' +
|
|
'cpV37Bs/letJIMoGkNzBG8UlAoGBAKrSfZt8f3RnvmfKusoeZhsJF9kj0vMHOwob' +
|
|
'ZUc8152Nf7uMdPj2wCGfr3iRBOH5urnH7ILBsHjbmjHaZG6FYKMg7i7sbSf5vkcG' +
|
|
'Rc3d4u5NfSlfjwbuxlYzmvJxLAuDtXXX1MdgEyhGGG485uDBamZrDaTEzBwpIyRH' +
|
|
'W2OxxGBTAoGAZHJQKTajcqQQoRSgPPWWU3X8zdlu5hCgNU54bXaPAfJ6IBWvicMZ' +
|
|
'QLw+9mtshtz+Xy0aBbkxUeUlwwzexb9rg1KZppTq/yRqkOlEkI3ZdqiclTK13BCh' +
|
|
'6r6dC2qqq+DVm9Nlm/S9Gab9YSIA0g5MFg5WLwu1KNwuOODE4Le/91c=' +
|
|
'-----END RSA PRIVATE KEY-----';
|
|
|
|
procedure Test;
|
|
var P : TPEMFile;
|
|
begin
|
|
P := TPEMFile.Create;
|
|
try
|
|
P.LoadFromText(TestPEMText1);
|
|
P.LoadFromText(TestPEMText2);
|
|
finally
|
|
P.Free;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
|
|
|
|
end.
|
|
|