Bugfixes in OpenSSL, enhanced OpenSSL support, enhanced binary MIME (all by Petr Fejfar)

git-svn-id: https://svn.code.sf.net/p/synalist/code/trunk@147 7c85be65-684b-0410-a082-b2ed4fbef004

blcksock.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 009.008.004 |
+| Project : Ararat Synapse                                       | 009.008.005 |
 |==============================================================================|
 | Content: Library base                                                        |
 |==============================================================================|
-| Copyright (c)1999-2011, Lukas Gebauer                                        |
+| Copyright (c)1999-2012, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,7 +33,7 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)1999-2011.                |
+| Portions created by Lukas Gebauer are Copyright (c)1999-2012.                |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -81,6 +81,8 @@ Core with implementation basic socket classes.
 {$Q-}
 {$H+}
 {$M+}
+{$TYPEDADDRESS OFF}
+
 
 //old Delphi does not have MSWINDOWS define.
 {$IFDEF WIN32}
@@ -1297,6 +1299,9 @@ type
     {:Return subject of remote SSL peer.}
     function GetPeerSubject: string; virtual;
 
+    {:Return Serial number if remote X509 certificate.}
+    function GetPeerSerialNo: integer; virtual;
+
     {:Return issuer certificate of remote SSL peer.}
     function GetPeerIssuer: string; virtual;
 
@@ -1304,6 +1309,10 @@ type
      if certificate is generated for remote side IP name.}
     function GetPeerName: string; virtual;
 
+    {:Returns has of peer name from remote side certificate. This is good
+     for fast remote side authentication.}
+    function GetPeerNameHash: cardinal; virtual;
+
     {:Return fingerprint of remote SSL peer.}
     function GetPeerFingerprint: string; virtual;
 
@@ -2682,7 +2691,7 @@ end;
 
 function TBlockSocket.ResolveIPToName(IP: string): string;
 begin
-  if not IsIP(IP) or not IsIp6(IP) then
+  if not IsIP(IP) and not IsIp6(IP) then
     IP := ResolveName(IP);
   Result := synsock.ResolveIPToName(IP, FamilyToAF(FFamily), GetSocketProtocol, GetSocketType);
 end;
@@ -4224,11 +4233,21 @@ begin
   Result := '';
 end;
 
+function TCustomSSL.GetPeerSerialNo: integer;
+begin
+  Result := -1;
+end;
+
 function TCustomSSL.GetPeerName: string;
 begin
   Result := '';
 end;
 
+function TCustomSSL.GetPeerNameHash: cardinal;
+begin
+  Result := 0;
+end;
+
 function TCustomSSL.GetPeerIssuer: string;
 begin
   Result := '';

ftpsend.pas

@@ -52,6 +52,9 @@ Used RFC: RFC-959, RFC-2228, RFC-2428
   {$MODE DELPHI}
 {$ENDIF}
 {$H+}
+{$TYPEINFO ON}// Borland changed defualt Visibility from Public to Published
+                // and it requires RTTI to be generated $M+
+{$M+}
 
 {$IFDEF UNICODE}
   {$WARN IMPLICIT_STRING_CAST OFF}

mimemess.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 002.005.002 |
+| Project : Ararat Synapse                                       | 002.006.000 |
 |==============================================================================|
 | Content: MIME message object                                                 |
 |==============================================================================|
-| Copyright (c)1999-2006, Lukas Gebauer                                        |
+| Copyright (c)1999-2012, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,7 +33,8 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2000-2006.                |
+| Portions created by Lukas Gebauer are Copyright (c)2000-2012.                |
+| Portions created by Petr Fejfar are Copyright (c)2011-2012.                  |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -50,6 +51,7 @@ Classes for easy handling with e-mail message.
   {$MODE DELPHI}
 {$ENDIF}
 {$H+}
+{$M+}
 
 unit mimemess;
 
@@ -269,6 +271,20 @@ type
     {:Decode message from @link(Lines) to @link(MessagePart). Massage headers
      are parsed into @link(Header) object.}
     procedure DecodeMessage;
+
+    {pf}
+    {: HTTP message is received by @link(THTTPSend) component in two parts:
+     headers are stored in @link(THTTPSend.Headers) and a body in memory stream
+     @link(THTTPSend.Document).
+
+     On the top of it, HTTP connections are always 8-bit, hence data are
+     transferred in native format i.e. no transfer encoding is applied.
+
+     This method operates the similiar way and produces the same
+     result as @link(DecodeMessage).
+    }
+    procedure DecodeMessageBinary(AHeader:TStrings; AData:TMemoryStream);
+    {/pf}
   published
     {:@link(TMimePart) object with decoded MIME message. This object can handle
      any number of nested @link(TMimePart) objects itself. It is used for handle
@@ -821,4 +837,15 @@ begin
   FMessagePart.DecomposeParts;
 end;
 
+{pf}
+procedure TMimeMess.DecodeMessageBinary(AHeader:TStrings; AData:TMemoryStream);
+begin
+  FHeader.Clear;
+  FLines.Clear;
+  FLines.Assign(AHeader);
+  FHeader.DecodeHeaders(FLines);
+  FMessagePart.DecomposePartsBinary(AHeader,PANSIChar(AData.Memory),PANSIChar(AData.Memory)+AData.Size);
+end;
+{/pf}
+
 end.

mimepart.pas

@@ -1,10 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 002.008.000 |
+| Project : Ararat Synapse                                       | 002.009.000 |
 |==============================================================================|
 | Content: MIME support procedures and functions                               |
 |==============================================================================|
-| Copyright (c)1999-2008, Lukas Gebauer                                        |
+| Copyright (c)1999-200812                                                         |
-| All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
 | modification, are permitted provided that the following conditions are met:  |
@@ -33,7 +32,8 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2000-2008.                |
+| Portions created by Lukas Gebauer are Copyright (c)2000-2012.                |
+| Portions created by Petr Fejfar are Copyright (c)2011-2012.                  |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -54,6 +54,7 @@ Used RFC: RFC-2045
 {$H+}
 {$Q-}
 {$R-}
+{$M+}
 
 {$IFDEF UNICODE}
   {$WARN IMPLICIT_STRING_CAST OFF}
@@ -137,6 +138,7 @@ type
     FAttachInside: boolean;
     FConvertCharset: Boolean;
     FForcedHTMLConvert: Boolean;
+    FBinaryDecomposer: boolean;
     procedure SetPrimary(Value: string);
     procedure SetEncoding(Value: string);
     procedure SetCharset(Value: string);
@@ -204,6 +206,20 @@ type
      method @link(GetSubPart)).}
     procedure DecomposeParts;
 
+    {pf}
+    {: HTTP message is received by @link(THTTPSend) component in two parts:
+     headers are stored in @link(THTTPSend.Headers) and a body in memory stream
+     @link(THTTPSend.Document).
+
+     On the top of it, HTTP connections are always 8-bit, hence data are
+     transferred in native format i.e. no transfer encoding is applied.
+
+     This method operates the similiar way and produces the same
+     result as @link(DecomposeParts).
+    }
+    procedure DecomposePartsBinary(AHeader:TStrings; AStx,AEtx:PANSIChar);
+    {/pf}
+
     {:This part and all subparts is composed into one MIME message stored in
      @link(Lines) property.}
     procedure ComposeParts;
@@ -535,6 +551,7 @@ var
   end;
 
 begin
+  FBinaryDecomposer := false;
   x := 0;
   Clear;
   //extract headers
@@ -624,6 +641,95 @@ begin
   end;
 end;
 
+procedure TMIMEPart.DecomposePartsBinary(AHeader:TStrings; AStx,AEtx:PANSIChar);
+var
+  x:    integer;
+  s:    ANSIString;
+  Mime: TMimePart;
+  BOP:  PANSIChar; // Beginning of Part
+  EOP:  PANSIChar; // End of Part
+
+  function ___HasUUCode(ALines:TStrings): boolean;
+  var
+    x: integer;
+  begin
+    Result := FALSE;
+    for x:=0 to ALines.Count-1 do
+      if IsUUcode(ALInes[x]) then
+      begin
+        Result := TRUE;
+        exit;
+      end;
+  end;
+
+begin
+  FBinaryDecomposer := true;
+  Clear;
+  // Parse passed headers (THTTPSend returns HTTP headers and body separately)
+  x := 0;
+  while x<AHeader.Count do
+    begin
+      s := NormalizeHeader(AHeader,x);
+      if s = '' then
+        Break;
+      FHeaders.Add(s);
+    end;
+  DecodePartHeader;
+  // Extract prepart
+  if FPrimaryCode=MP_MULTIPART then
+    begin
+      CopyLinesFromStreamUntilBoundary(AStx,AEtx,FPrePart,FBoundary);
+      FAttachInside := FAttachInside or ___HasUUCode(FPrePart);
+    end;
+  // Extract body part
+  if FPrimaryCode=MP_MULTIPART then
+    begin
+      repeat
+        if CanSubPart then
+          begin
+            Mime := AddSubPart;
+            BOP  := AStx;
+            EOP  := SearchForBoundary(AStx,AEtx,FBoundary);
+            CopyLinesFromStreamUntilNullLine(BOP,EOP,Mime.Lines);
+            Mime.DecomposePartsBinary(Mime.Lines,BOP,EOP);
+          end
+        else
+          begin
+            EOP := SearchForBoundary(AStx,AEtx,FBoundary);
+            FPartBody.Add(BuildStringFromBuffer(AStx,EOP));
+          end;
+        //
+        BOP := MatchLastBoundary(EOP,AEtx,FBoundary);
+        if Assigned(BOP) then
+          begin
+            AStx := BOP;
+            Break;
+          end;
+      until FALSE;
+    end;
+  // Extract nested MIME message
+  if (FPrimaryCode=MP_MESSAGE) and CanSubPart then
+    begin
+      Mime := AddSubPart;
+      SkipNullLines(AStx,AEtx);
+      CopyLinesFromStreamUntilNullLine(AStx,AEtx,Mime.Lines);
+      Mime.DecomposePartsBinary(Mime.Lines,AStx,AEtx);
+    end
+  // Extract body of single part
+  else
+    begin
+      FPartBody.Add(BuildStringFromBuffer(AStx,AEtx));
+      FAttachInside := FAttachInside or ___HasUUCode(FPartBody);
+    end;
+  // Extract postpart
+  if FPrimaryCode=MP_MULTIPART then
+    begin
+      CopyLinesFromStreamUntilBoundary(AStx,AEtx,FPostPart,'');
+      FAttachInside := FAttachInside or ___HasUUCode(FPostPart);
+    end;
+end;
+{/pf}
+
 {==============================================================================}
 
 procedure TMIMEPart.ComposeParts;
@@ -713,6 +819,33 @@ var
   b: Boolean;
 begin
   FDecodedLines.Clear;
+  {pf}
+  // The part decomposer passes data via TStringList which appends trailing line
+  // break inherently. But in a case of native 8-bit data transferred withouth
+  // encoding (default e.g. for HTTP protocol), the redundant line terminators
+  // has to be removed
+  if FBinaryDecomposer and (FPartBody.Count=1) then
+    begin
+      case FEncodingCode of
+          ME_QUOTED_PRINTABLE:
+            s := DecodeQuotedPrintable(FPartBody[0]);
+          ME_BASE64:
+            s := DecodeBase64(FPartBody[0]);
+          ME_UU, ME_XX:
+            begin
+              s := '';
+              for n := 0 to FPartBody.Count - 1 do
+                if FEncodingCode = ME_UU then
+                  s := s + DecodeUU(FPartBody[n])
+                else
+                  s := s + DecodeXX(FPartBody[n]);
+            end;
+        else
+          s := FPartBody[0];
+        end;
+    end
+  else
+  {/pf}
   case FEncodingCode of
     ME_QUOTED_PRINTABLE:
       s := DecodeQuotedPrintable(FPartBody.Text);

smtpsend.pas

@@ -372,7 +372,6 @@ function TSMTPSend.AuthPlain: Boolean;
 var
   s: ansistring;
 begin
-  Result := False;
   s := ansichar(0) + FUsername + ansichar(0) + FPassword;
   FSock.SendString('AUTH PLAIN ' + EncodeBase64(s) + CRLF);
   Result := ReadResult = 235;

ssl_cryptlib.pas

@@ -3,7 +3,7 @@
 |==============================================================================|
 | Content: SSL/SSH support by Peter Gutmann's CryptLib                         |
 |==============================================================================|
-| Copyright (c)1999-2005, Lukas Gebauer                                        |
+| Copyright (c)1999-2012, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,7 +33,7 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2005.                     |
+| Portions created by Lukas Gebauer are Copyright (c)2005-2012.                |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -84,6 +84,7 @@ unit ssl_cryptlib;
 interface
 
 uses
+  Windows,
   SysUtils,
   blcksock, synsock, synautil, synacode,
   cryptlib;
@@ -233,7 +234,6 @@ var
   cert: CRYPT_CERTIFICATE;
   publicKey: CRYPT_CONTEXT;
 begin
-  Result := False;
   if FPrivatekeyFile = '' then
     FPrivatekeyFile := GetTempFile('', 'key');
   cryptCreateContext(privateKey, CRYPT_UNUSED, CRYPT_ALGO_RSA);
@@ -402,7 +402,7 @@ begin
   FcryptSession := CRYPT_SESSION(CRYPT_SESSION_NONE);
   FSSLEnabled := False;
   if FDelCert then
-    Deletefile(FPrivatekeyFile);
+    SysUtils.DeleteFile(FPrivatekeyFile);
 end;
 
 function TSSLCryptLib.Prepare(server:Boolean): Boolean;
@@ -459,8 +459,8 @@ end;
 
 function TSSLCryptLib.BiShutdown: boolean;
 begin
-//  if FcryptSession <> CRYPT_SESSION(CRYPT_SESSION_NONE) then
+  if FcryptSession <> CRYPT_SESSION(CRYPT_SESSION_NONE) then
-//    cryptSetAttribute(FCryptSession, CRYPT_SESSINFO_ACTIVE, 0); //no-op
+    cryptSetAttribute(FCryptSession, CRYPT_SESSINFO_ACTIVE, 0);
   DeInit;
   FReadBuffer := '';
   Result := True;
@@ -478,8 +478,6 @@ begin
 end;
 
 function TSSLCryptLib.RecvBuffer(Buffer: TMemory; Len: Integer): Integer;
-var
-  l: integer;
 begin
   FLastError := 0;
   FLastErrorDesc := '';

ssl_openssl.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 001.001.001 |
+| Project : Ararat Synapse                                       | 001.002.000 |
 |==============================================================================|
 | Content: SSL support by OpenSSL                                              |
 |==============================================================================|
@@ -33,7 +33,8 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2005-2008.                |
+| Portions created by Lukas Gebauer are Copyright (c)2005-2012.                |
+| Portions created by Petr Fejfar are Copyright (c)2011-2012.                  |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -139,10 +140,14 @@ type
     {:See @inherited}
     function GetPeerSubject: string; override;
     {:See @inherited}
+    function GetPeerSerialNo: integer; override; {pf}
+    {:See @inherited}
     function GetPeerIssuer: string; override;
     {:See @inherited}
     function GetPeerName: string; override;
     {:See @inherited}
+    function GetPeerNameHash: cardinal; override; {pf}
+    {:See @inherited}
     function GetPeerFingerprint: string; override;
     {:See @inherited}
     function GetCertInfo: string; override;
@@ -331,10 +336,18 @@ begin
       cert := nil;
       pkey := nil;
       ca := nil;
+      try {pf}
         if PKCS12parse(p12, FKeyPassword, pkey, cert, ca) > 0 then
           if SSLCTXusecertificate(Fctx, cert) > 0 then
             if SSLCTXusePrivateKey(Fctx, pkey) > 0 then
               Result := True;
+      {pf}
+      finally
+        EvpPkeyFree(pkey);
+        X509free(cert);
+        SkX509PopFree(ca,_X509Free); // for ca=nil a new STACK was allocated...
+      end;
+      {/pf}
     finally
       PKCS12free(p12);
     end;
@@ -622,8 +635,11 @@ begin
     err := SslGetError(FSsl, Result);
   until (err <> SSL_ERROR_WANT_READ) and (err <> SSL_ERROR_WANT_WRITE);
   if err = SSL_ERROR_ZERO_RETURN then
-    Result := 0;
+    Result := 0
-  if (err <> 0) then
+  {pf}// Verze 1.1.0 byla s else tak jak to ted mam,
+      // ve verzi 1.1.1 bylo ELSE zruseno, ale pak je SSL_ERROR_ZERO_RETURN
+      // propagovano jako Chyba.
+  {pf} else {/pf} if (err <> 0) then   
     FLastError := err;
 end;
 
@@ -669,6 +685,31 @@ begin
   X509Free(cert);
 end;
 
+
+function TSSLOpenSSL.GetPeerSerialNo: integer; {pf}
+var
+  cert: PX509;
+  SN:   PASN1_INTEGER;
+begin
+  if not assigned(FSsl) then
+  begin
+    Result := -1;
+    Exit;
+  end;
+  cert := SSLGetPeerCertificate(Fssl);
+  try
+    if not assigned(cert) then
+    begin
+      Result := -1;
+      Exit;
+    end;
+    SN := X509GetSerialNumber(cert);
+    Result := Asn1IntegerGet(SN);
+  finally
+    X509Free(cert);
+  end;
+end;
+
 function TSSLOpenSSL.GetPeerName: string;
 var
   s: ansistring;
@@ -678,6 +719,28 @@ begin
   Result := Trim(SeparateLeft(s, '/'));
 end;
 
+function TSSLOpenSSL.GetPeerNameHash: cardinal; {pf}
+var
+  cert: PX509;
+begin
+  if not assigned(FSsl) then
+  begin
+    Result := 0;
+    Exit;
+  end;
+  cert := SSLGetPeerCertificate(Fssl);
+  try
+    if not assigned(cert) then
+    begin
+      Result := 0;
+      Exit;
+    end;
+    Result := X509NameHash(X509GetSubjectName(cert));
+  finally
+    X509Free(cert);
+  end;
+end;
+
 function TSSLOpenSSL.GetPeerIssuer: string;
 var
   cert: PX509;
@@ -760,11 +823,12 @@ begin
     Result := '';
     Exit;
   end;
+  try {pf}
     b := BioNew(BioSMem);
     try
       X509Print(b, cert);
       x := bioctrlpending(b);
-{$IFDEF CIL}
+  {$IFDEF CIL}
       sb := StringBuilder.Create(x);
       y := bioread(b, sb, x);
       if y > 0 then
@@ -772,16 +836,21 @@ begin
         sb.Length := y;
         s := sb.ToString;
       end;
-{$ELSE}
+  {$ELSE}
       setlength(s,x);
       y := bioread(b,s,x);
       if y > 0 then
         setlength(s, y);
-{$ENDIF}
+  {$ENDIF}
       Result := ReplaceString(s, LF, CRLF);
     finally
       BioFreeAll(b);
     end;
+  {pf}
+  finally
+    X509Free(cert);
+  end;
+  {/pf}
 end;
 
 function TSSLOpenSSL.GetCipherName: string;

ssl_openssl_lib.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 003.006.003 |
+| Project : Ararat Synapse                                       | 003.007.000 |
 |==============================================================================|
 | Content: SSL support by OpenSSL                                              |
 |==============================================================================|
-| Copyright (c)1999-2011, Lukas Gebauer                                        |
+| Copyright (c)1999-2012, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,7 +33,8 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2002-2011.                |
+| Portions created by Lukas Gebauer are Copyright (c)2002-2012.                |
+| Portions created by Petr Fejfar are Copyright (c)2011-2012.                  |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -143,6 +144,9 @@ type
   PASN1_INTEGER = SslPtr;
   PPasswdCb = SslPtr;
   PFunction = procedure;
+  PSTACK = SslPtr; {pf}
+  TSkPopFreeFunc = procedure(p:SslPtr); cdecl; {pf}
+  TX509Free = procedure(x: PX509); cdecl; {pf}
 
   DES_cblock = array[0..7] of Byte;
   PDES_cblock = ^DES_cblock;
@@ -770,7 +774,13 @@ var
   function Asn1UtctimeNew: PASN1_UTCTIME;
   procedure Asn1UtctimeFree(a: PASN1_UTCTIME);
   function Asn1IntegerSet(a: PASN1_INTEGER; v: integer): integer;
+  function Asn1IntegerGet(a: PASN1_INTEGER): integer; {pf}
   function i2dX509bio(b: PBIO; x: PX509): integer;
+  function d2iX509bio(b:PBIO; x:PX509):  PX509;    {pf}
+  function PEMReadBioX509(b:PBIO; {var x:PX509;}x:PSslPtr; callback:PFunction; cb_arg: SslPtr):  PX509;    {pf}
+  procedure SkX509PopFree(st: PSTACK; func: TSkPopFreeFunc); {pf}
+
+
   function i2dPrivateKeyBio(b: PBIO; pkey: EVP_PKEY): integer;
 
   // 3DES functions
@@ -784,6 +794,9 @@ function IsSSLloaded: Boolean;
 function InitSSLInterface: Boolean;
 function DestroySSLInterface: Boolean;
 
+var
+  _X509Free: TX509Free = nil; {pf}
+
 implementation
 
 uses SyncObjs;
@@ -836,7 +849,6 @@ type
 
 // libeay.dll
   TX509New = function: PX509; cdecl;
-  TX509Free = procedure(x: PX509); cdecl;
   TX509NameOneline = function(a: PX509_NAME; buf: PAnsiChar; size: Integer):PAnsiChar; cdecl;
   TX509GetSubjectName = function(a: PX509):PX509_NAME; cdecl;
   TX509GetIssuerName = function(a: PX509):PX509_NAME; cdecl;
@@ -880,7 +892,11 @@ type
   TAsn1UtctimeNew = function: PASN1_UTCTIME; cdecl;
   TAsn1UtctimeFree = procedure(a: PASN1_UTCTIME); cdecl;
   TAsn1IntegerSet = function(a: PASN1_INTEGER; v: integer): integer; cdecl;
+  TAsn1IntegerGet = function(a: PASN1_INTEGER): integer; cdecl; {pf}
   Ti2dX509bio = function(b: PBIO; x: PX509): integer; cdecl;
+  Td2iX509bio = function(b:PBIO;  x:PX509):   PX509;   cdecl; {pf}
+  TPEMReadBioX509 = function(b:PBIO;  {var x:PX509;}x:PSslPtr; callback:PFunction; cb_arg:SslPtr): PX509;   cdecl; {pf}
+  TSkX509PopFree = procedure(st: PSTACK; func: TSkPopFreeFunc); cdecl; {pf}
   Ti2dPrivateKeyBio= function(b: PBIO; pkey: EVP_PKEY): integer; cdecl;
 
   // 3DES functions
@@ -936,7 +952,6 @@ var
 
 // libeay.dll
   _X509New: TX509New = nil;
-  _X509Free: TX509Free = nil;
   _X509NameOneline: TX509NameOneline = nil;
   _X509GetSubjectName: TX509GetSubjectName = nil;
   _X509GetIssuerName: TX509GetIssuerName = nil;
@@ -979,7 +994,11 @@ var
   _Asn1UtctimeNew: TAsn1UtctimeNew = nil;
   _Asn1UtctimeFree: TAsn1UtctimeFree = nil;
   _Asn1IntegerSet: TAsn1IntegerSet = nil;
+  _Asn1IntegerGet: TAsn1IntegerGet = nil; {pf}
   _i2dX509bio: Ti2dX509bio = nil;
+  _d2iX509bio: Td2iX509bio = nil; {pf}
+  _PEMReadBioX509: TPEMReadBioX509 = nil; {pf}
+  _SkX509PopFree: TSkX509PopFree = nil; {pf}
   _i2dPrivateKeyBio: Ti2dPrivateKeyBio = nil;
 
   // 3DES functions
@@ -1640,6 +1659,28 @@ begin
     Result := 0;
 end;
 
+function d2iX509bio(b: PBIO; x: PX509): PX509; {pf}
+begin
+  if InitSSLInterface and Assigned(_d2iX509bio) then
+    Result := _d2iX509bio(x,b)
+  else
+    Result := nil;
+end;
+
+function PEMReadBioX509(b:PBIO; {var x:PX509;}x:PSslPtr; callback:PFunction; cb_arg: SslPtr):  PX509;    {pf}
+begin
+  if InitSSLInterface and Assigned(_PEMReadBioX509) then
+    Result := _PEMReadBioX509(b,x,callback,cb_arg)
+  else
+    Result := nil;
+end;
+
+procedure SkX509PopFree(st: PSTACK; func:TSkPopFreeFunc); {pf}
+begin
+  if InitSSLInterface and Assigned(_SkX509PopFree) then
+    _SkX509PopFree(st,func);
+end;
+
 function i2dPrivateKeyBio(b: PBIO; pkey: EVP_PKEY): integer;
 begin
   if InitSSLInterface and Assigned(_i2dPrivateKeyBio) then
@@ -1664,6 +1705,14 @@ begin
     Result := 0;
 end;
 
+function Asn1IntegerGet(a: PASN1_INTEGER): integer; {pf}
+begin
+  if InitSSLInterface and Assigned(_Asn1IntegerGet) then
+    Result := _Asn1IntegerGet(a)
+  else
+    Result := 0;
+end;
+
 function X509GetSerialNumber(x: PX509): PASN1_INTEGER;
 begin
   if InitSSLInterface and Assigned(_X509GetSerialNumber) then
@@ -1748,6 +1797,13 @@ var
   s: string;
   x: integer;
 begin
+  {pf}
+  if SSLLoaded then
+    begin
+      Result := TRUE;
+      exit;
+    end;
+  {/pf}  
   SSLCS.Enter;
   try
     if not IsSSLloaded then
@@ -1853,7 +1909,11 @@ begin
         _Asn1UtctimeNew := GetProcAddr(SSLUtilHandle, 'ASN1_UTCTIME_new');
         _Asn1UtctimeFree := GetProcAddr(SSLUtilHandle, 'ASN1_UTCTIME_free');
         _Asn1IntegerSet := GetProcAddr(SSLUtilHandle, 'ASN1_INTEGER_set');
+        _Asn1IntegerGet := GetProcAddr(SSLUtilHandle, 'ASN1_INTEGER_get'); {pf}
         _i2dX509bio := GetProcAddr(SSLUtilHandle, 'i2d_X509_bio');
+        _d2iX509bio := GetProcAddr(SSLUtilHandle, 'd2i_X509_bio'); {pf}
+        _PEMReadBioX509 := GetProcAddr(SSLUtilHandle, 'PEM_read_bio_X509'); {pf}
+        _SkX509PopFree := GetProcAddr(SSLUtilHandle, 'SK_X509_POP_FREE'); {pf}
         _i2dPrivateKeyBio := GetProcAddr(SSLUtilHandle, 'i2d_PrivateKey_bio');
 
         // 3DES functions
@@ -2038,6 +2098,8 @@ begin
     _Asn1UtctimeNew := nil;
     _Asn1UtctimeFree := nil;
     _Asn1IntegerSet := nil;
+    _Asn1IntegerGet := nil; {pf}
+    _SkX509PopFree := nil; {pf}
     _i2dX509bio := nil;
     _i2dPrivateKeyBio := nil;
 

synacode.pas

@@ -3,7 +3,7 @@
 |==============================================================================|
 | Content: Coding and decoding support                                         |
 |==============================================================================|
-| Copyright (c)1999-2010, Lukas Gebauer                                        |
+| Copyright (c)1999-2012, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,7 +33,7 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2000-2010.                |
+| Portions created by Lukas Gebauer are Copyright (c)2000-2012.                |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -49,6 +49,7 @@
 {$Q-}
 {$R-}
 {$H+}
+{$TYPEDADDRESS OFF}
 
 {$IFDEF UNICODE}
   {$WARN IMPLICIT_STRING_CAST OFF}

synamisc.pas

@@ -57,6 +57,8 @@
   {$ENDIF}
 {$ENDIF}
 
+{$TYPEDADDRESS OFF}
+
 {$IFDEF UNICODE}
   {$WARN IMPLICIT_STRING_CAST OFF}
   {$WARN IMPLICIT_STRING_CAST_LOSS OFF}

synautil.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 004.014.001 |
+| Project : Ararat Synapse                                       | 004.015.000 |
 |==============================================================================|
 | Content: support procedures and functions                                    |
 |==============================================================================|
-| Copyright (c)1999-2010, Lukas Gebauer                                        |
+| Copyright (c)1999-2012, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,8 +33,9 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c) 1999-2010.               |
+| Portions created by Lukas Gebauer are Copyright (c) 1999-2012.               |
 | Portions created by Hernan Sanchez are Copyright (c) 2000.                   |
+| Portions created by Petr Fejfar are Copyright (c)2011-2012.                  |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -331,6 +332,34 @@ function XorString(Indata1, Indata2: AnsiString): AnsiString;
  is Splitted into multiple lines, then this procedure de-split it into one line.}
 function NormalizeHeader(Value: TStrings; var Index: Integer): string;
 
+{pf}
+{:Search for one of line terminators CR, LF or NUL. Return position of the
+ line beginning and length of text.}
+procedure SearchForLineBreak(var APtr:PANSIChar; AEtx:PANSIChar; out ABol:PANSIChar; out ALength:integer);
+{:Skip both line terminators CR LF (if any). Move APtr position forward.}
+procedure SkipLineBreak(var APtr:PANSIChar; AEtx:PANSIChar);
+{:Skip all blank lines in a buffer starting at APtr and move APtr position forward.}
+procedure SkipNullLines                   (var APtr:PANSIChar; AEtx:PANSIChar);
+{:Copy all lines from a buffer starting at APtr to ALines until empty line
+ or end of the buffer is reached. Move APtr position forward).}
+procedure CopyLinesFromStreamUntilNullLine(var APtr:PANSIChar; AEtx:PANSIChar; ALines:TStrings);
+{:Copy all lines from a buffer starting at APtr to ALines until ABoundary
+ or end of the buffer is reached. Move APtr position forward).}
+procedure CopyLinesFromStreamUntilBoundary(var APtr:PANSIChar; AEtx:PANSIChar; ALines:TStrings; const ABoundary:ANSIString);
+{:Search ABoundary in a buffer starting at APtr.
+ Return beginning of the ABoundary. Move APtr forward behind a trailing CRLF if any).}
+function  SearchForBoundary               (var APtr:PANSIChar; AEtx:PANSIChar; const ABoundary:ANSIString): PANSIChar;
+{:Compare a text at position ABOL with ABoundary and return position behind the
+ match (including a trailing CRLF if any).}
+function  MatchBoundary                   (ABOL,AETX:PANSIChar; const ABoundary:ANSIString): PANSIChar;
+{:Compare a text at position ABOL with ABoundary + the last boundary suffix
+ and return position behind the match (including a trailing CRLF if any).}
+function  MatchLastBoundary               (ABOL,AETX:PANSIChar; const ABoundary:ANSIString): PANSIChar;
+{:Copy data from a buffer starting at position APtr and delimited by AEtx
+ position into ANSIString.}
+function  BuildStringFromBuffer           (AStx,AEtx:PANSIChar): ANSIString;
+{/pf}
+
 var
   {:can be used for your own months strings for @link(getmonthnumber)}
   CustomMonthNames: array[1..12] of string;
@@ -1823,6 +1852,207 @@ begin
   Result := TrimRight(s);
 end;
 
+{==============================================================================}
+
+{pf}
+procedure SearchForLineBreak(var APtr:PANSIChar; AEtx:PANSIChar; out ABol:PANSIChar; out ALength:integer);
+begin
+  ABol := APtr;
+  while (APtr<AEtx) and not (APtr^ in [#0,#10,#13]) do
+    inc(APtr);
+  ALength := APtr-ABol;
+end;
+{/pf}
+
+{pf}
+procedure SkipLineBreak(var APtr:PANSIChar; AEtx:PANSIChar);
+begin
+  if (APtr<AEtx) and (APtr^=#13) then
+    inc(APtr);
+  if (APtr<AEtx) and (APtr^=#10) then
+    inc(APtr);
+end;
+{/pf}
+
+{pf}
+procedure SkipNullLines(var APtr:PANSIChar; AEtx:PANSIChar);
+var
+  bol: PANSIChar;
+  lng: integer;
+begin
+  while (APtr<AEtx) do
+    begin
+      SearchForLineBreak(APtr,AEtx,bol,lng);
+      SkipLineBreak(APtr,AEtx);
+      if lng>0 then
+        begin
+          APtr := bol;
+          Break;
+        end;
+    end;
+end;
+{/pf}
+
+{pf}
+procedure CopyLinesFromStreamUntilNullLine(var APtr:PANSIChar; AEtx:PANSIChar; ALines:TStrings);
+var
+  bol: PANSIChar;
+  lng: integer;
+  s:   ANSIString;
+begin
+  // Copying until body separator will be reached
+  while (APtr<AEtx) and (APtr^<>#0) do
+    begin
+      SearchForLineBreak(APtr,AEtx,bol,lng);
+      SkipLineBreak(APtr,AEtx);
+      if lng=0 then
+        Break;
+      SetString(s,bol,lng);
+      ALines.Add(s);
+    end;
+end;
+{/pf}
+
+{pf}
+procedure CopyLinesFromStreamUntilBoundary(var APtr:PANSIChar; AEtx:PANSIChar; ALines:TStrings; const ABoundary:ANSIString);
+var
+  bol:      PANSIChar;
+  lng:      integer;
+  s:        ANSIString;
+  BackStop: ANSIString;
+  eob1:     PANSIChar;
+  eob2:     PANSIChar;
+begin
+  BackStop := '--'+ABoundary;
+  eob2     := nil;
+  // Copying until Boundary will be reached
+  while (APtr<AEtx) do
+    begin
+      SearchForLineBreak(APtr,AEtx,bol,lng);
+      SkipLineBreak(APtr,AEtx);
+      eob1 := MatchBoundary(bol,APtr,ABoundary);
+      if Assigned(eob1) then
+        eob2 := MatchLastBoundary(bol,AEtx,ABoundary);
+      if Assigned(eob2) then
+        begin
+          APtr := eob2;
+          Break;
+        end
+      else if Assigned(eob1) then
+        begin
+          APtr := eob1;
+          Break;
+        end
+      else
+        begin
+          SetString(s,bol,lng);
+          ALines.Add(s);
+        end;
+    end;
+end;
+{/pf}
+
+{pf}
+function SearchForBoundary(var APtr:PANSIChar; AEtx:PANSIChar; const ABoundary:ANSIString): PANSIChar;
+var
+  eob:  PANSIChar;
+  Step: integer;
+begin
+  Result := nil;
+  // Moving Aptr position forward until boundary will be reached
+  while (APtr<AEtx) do
+    begin
+      if strlcomp(APtr,#13#10'--',4)=0 then
+        begin
+          eob  := MatchBoundary(APtr,AEtx,ABoundary);
+          Step := 4;
+        end
+      else if strlcomp(APtr,'--',2)=0 then
+        begin
+          eob  := MatchBoundary(APtr,AEtx,ABoundary);
+          Step := 2;
+        end
+      else
+        begin
+          eob  := nil;
+          Step := 1;
+        end;
+      if Assigned(eob) then
+        begin
+          Result := APtr;  // boundary beginning
+          APtr   := eob;   // boundary end
+          exit;
+        end
+      else
+        inc(APtr,Step);
+    end;
+end;
+{/pf}
+
+{pf}
+function MatchBoundary(ABol,AEtx:PANSIChar; const ABoundary:ANSIString): PANSIChar;
+var
+  MatchPos:   PANSIChar;
+  Lng:        integer;
+begin
+  Result   := nil;
+  MatchPos := ABol;
+  Lng := length(ABoundary);
+  if (MatchPos+2+Lng)>AETX then
+    exit;
+  if strlcomp(MatchPos,#13#10,2)=0 then
+    inc(MatchPos,2);
+  if (MatchPos+2+Lng)>AETX then
+    exit;
+  if strlcomp(MatchPos,'--',2)<>0 then
+    exit;
+  inc(MatchPos,2);
+  if strlcomp(MatchPos,PANSIChar(ABoundary),Lng)<>0 then
+    exit;
+  inc(MatchPos,Lng);
+  if ((MatchPos+2)<=AEtx) and (strlcomp(MatchPos,#13#10,2)=0) then
+    inc(MatchPos,2);
+  Result := MatchPos;
+end;
+{/pf}
+
+{pf}
+function MatchLastBoundary(ABOL,AETX:PANSIChar; const ABoundary:ANSIString): PANSIChar;
+var
+  MatchPos: PANSIChar;
+begin
+  Result   := nil;
+  MatchPos := MatchBoundary(ABOL,AETX,ABoundary);
+  if not Assigned(MatchPos) then
+    exit;
+  if strlcomp(MatchPos,'--',2)<>0 then
+    exit;
+  inc(MatchPos,2);
+  if (MatchPos+2<=AEtx) and (strlcomp(MatchPos,#13#10,2)=0) then
+    inc(MatchPos,2);
+  Result := MatchPos;
+end;
+{/pf}
+
+{pf}
+function  BuildStringFromBuffer(AStx,AEtx:PANSIChar): ANSIString;
+var
+  lng: integer;
+begin
+  Lng := 0;
+  if Assigned(AStx) and Assigned(AEtx) then
+    begin
+      Lng := AEtx-AStx;
+      if Lng<0 then
+        Lng := 0;
+    end;
+  SetString(Result,AStx,lng);
+end;
+{/pf}
+
+
+
+
 {==============================================================================}
 var
   n: integer;