ssl_openssl_lib.pas

Synapse The synchronyous socket library. File content: 1.) About Synapse 2.) Distribution pa

{==============================================================================|
| Project : Ararat Synapse                                       | 003.004.001 |
|==============================================================================|
| Content: SSL support by OpenSSL                                              |
|==============================================================================|
| Copyright (c)1999-2005, Lukas Gebauer                                        |
| 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.                             |
|                                                                              |
| Redistributions in binary form must reproduce the above copyright notice,    |
| this list of conditions and the following disclaimer in the documentation    |
| and/or other materials provided with the distribution.                       |
|                                                                              |
| Neither the name of Lukas Gebauer nor the names of its contributors may      |
| be used to endorse or promote products derived from this software without    |
| specific prior written permission.                                           |
|                                                                              |
| 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.                                                                      |
|==============================================================================|
| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
| Portions created by Lukas Gebauer are Copyright (c)2002-2005.                |
| All Rights Reserved.                                                         |
|==============================================================================|
| Contributor(s):                                                              |
|==============================================================================|
| History: see HISTORY.HTM from distribution package                           |
|          (Found at URL: http://www.ararat.cz/synapse/)                       |
|==============================================================================}

{
Special thanks to Gregor Ibic <[e-mail]>
 (Intelicom d.o.o., http://www.intelicom.si)
 for good inspiration about begin with SSL programming.
}

{$IFDEF FPC}
  {$MODE DELPHI}
{$ENDIF}
{$H+}
{$IFDEF VER125}
  {$DEFINE BCB}
{$ENDIF}
{$IFDEF BCB}
  {$ObjExportAll On}
  (*$HPPEMIT 'namespace ssl_openssl_lib { using System::Shortint; }' *)
{$ENDIF}

{:@abstract(OpenSSL support)

This unit is Pascal interface to OpenSSL library (used by @link(ssl_openssl) unit).
OpenSSL is loaded dynamicly on-demand. If this library is not found in system,
requested OpenSSL function just return errorcode.
}
unit ssl_openssl_lib;

interface

uses
{$IFDEF CIL}
  System.Runtime.InteropServices,
  System.Text,
{$ENDIF}
  Classes,
  synafpc,
{$IFNDEF WIN32}
  Libc, SysUtils;
{$ELSE}
  Windows;
{$ENDIF}


{$IFDEF CIL}
const
  {$IFDEF LINUX}
  DLLSSLName = 'libssl.so';
  DLLUtilName = 'libcrypto.so';
  {$ELSE}
  DLLSSLName = 'ssleay32.dll';
  DLLUtilName = 'libeay32.dll';
  {$ENDIF}
{$ELSE}
var
  {$IFNDEF WIN32}
  DLLSSLName: string = 'libssl.so';
  DLLUtilName: string = 'libcrypto.so';
  {$ELSE}
  DLLSSLName: string = 'ssleay32.dll';
  DLLSSLName2: string = 'libssl32.dll';
  DLLUtilName: string = 'libeay32.dll';
  {$ENDIF}
{$ENDIF}

type
{$IFDEF CIL}
  SslPtr = IntPtr;
{$ELSE}
  SslPtr = Pointer;
{$ENDIF}
  PSslPtr = ^SslPtr;
  PSSL_CTX = SslPtr;
  PSSL = SslPtr;
  PSSL_METHOD = SslPtr;
  PX509 = SslPtr;
  PX509_NAME = SslPtr;
  PEVP_MD	= SslPtr;
  PInteger = ^Integer;
  PBIO_METHOD = SslPtr;
  PBIO = SslPtr;
  EVP_PKEY = SslPtr;
  PRSA = SslPtr;
  PASN1_UTCTIME = SslPtr;
  PASN1_INTEGER = SslPtr;
  PPasswdCb = SslPtr;
  PFunction = procedure;

  DES_cblock = array[0..7] of Byte;
  PDES_cblock = ^DES_cblock;
  des_ks_struct = packed record
    ks: DES_cblock;
    weak_key: Integer;
  end;
  des_key_schedule = array[1..16] of des_ks_struct;

const
  EVP_MAX_MD_SIZE = 16 + 20;

  SSL_ERROR_NONE = 0;
  SSL_ERROR_SSL = 1;
  SSL_ERROR_WANT_READ = 2;
  SSL_ERROR_WANT_WRITE = 3;
  SSL_ERROR_WANT_X509_LOOKUP = 4;
  SSL_ERROR_SYSCALL = 5; //look at error stack/return value/errno
  SSL_ERROR_ZERO_RETURN = 6;
  SSL_ERROR_WANT_CONNECT = 7;
  SSL_ERROR_WANT_ACCEPT = 8;

  SSL_OP_NO_SSLv2 = $01000000;
  SSL_OP_NO_SSLv3 = $02000000;
  SSL_OP_NO_TLSv1 = $04000000;
  SSL_OP_ALL = $000FFFFF;
  SSL_VERIFY_NONE = $00;
  SSL_VERIFY_PEER = $01;

  OPENSSL_DES_DECRYPT = 0;
  OPENSSL_DES_ENCRYPT = 1;

  X509_V_OK =	0;
  X509_V_ILLEGAL = 1;
  X509_V_ERR_UNABLE_TO_GET_ISSUER_CERT = 2;
  X509_V_ERR_UNABLE_TO_GET_CRL = 3;
  X509_V_ERR_UNABLE_TO_DECRYPT_CERT_SIGNATURE = 4;
  X509_V_ERR_UNABLE_TO_DECRYPT_CRL_SIGNATURE = 5;
  X509_V_ERR_UNABLE_TO_DECODE_ISSUER_PUBLIC_KEY = 6;
  X509_V_ERR_CERT_SIGNATURE_FAILURE = 7;
  X509_V_ERR_CRL_SIGNATURE_FAILURE = 8;
  X509_V_ERR_CERT_NOT_YET_VALID = 9;
  X509_V_ERR_CERT_HAS_EXPIRED = 10;
  X509_V_ERR_CRL_NOT_YET_VALID = 11;
  X509_V_ERR_CRL_HAS_EXPIRED = 12;
  X509_V_ERR_ERROR_IN_CERT_NOT_BEFORE_FIELD = 13;
  X509_V_ERR_ERROR_IN_CERT_NOT_AFTER_FIELD = 14;
  X509_V_ERR_ERROR_IN_CRL_LAST_UPDATE_FIELD = 15;
  X509_V_ERR_ERROR_IN_CRL_NEXT_UPDATE_FIELD = 16;
  X509_V_ERR_OUT_OF_MEM = 17;
  X509_V_ERR_DEPTH_ZERO_SELF_SIGNED_CERT = 18;
  X509_V_ERR_SELF_SIGNED_CERT_IN_CHAIN = 19;
  X509_V_ERR_UNABLE_TO_GET_ISSUER_CERT_LOCALLY = 20;
  X509_V_ERR_UNABLE_TO_VERIFY_LEAF_SIGNATURE = 21;
  X509_V_ERR_CERT_CHAIN_TOO_LONG = 22;
  X509_V_ERR_CERT_REVOKED = 23;
  X509_V_ERR_INVALID_CA = 24;
  X509_V_ERR_PATH_LENGTH_EXCEEDED = 25;
  X509_V_ERR_INVALID_PURPOSE = 26;
  X509_V_ERR_CERT_UNTRUSTED = 27;
  X509_V_ERR_CERT_REJECTED = 28;
  //These are 'informational' when looking for issuer cert
  X509_V_ERR_SUBJECT_ISSUER_MISMATCH = 29;
  X509_V_ERR_AKID_SKID_MISMATCH = 30;
  X509_V_ERR_AKID_ISSUER_SERIAL_MISMATCH = 31;
  X509_V_ERR_KEYUSAGE_NO_CERTSIGN = 32;
  X509_V_ERR_UNABLE_TO_GET_CRL_ISSUER = 33;
  X509_V_ERR_UNHANDLED_CRITICAL_EXTENSION = 34;
  //The application is not happy
  X509_V_ERR_APPLICATION_VERIFICATION = 50;

  SSL_FILETYPE_ASN1	= 2;
  SSL_FILETYPE_PEM = 1;
  EVP_PKEY_RSA = 6;

var
  SSLLibHandle: TLibHandle = 0;
  SSLUtilHandle: TLibHandle = 0;
  SSLLibFile: string = '';
  SSLUtilFile: string = '';

{$IFDEF CIL}
  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
    SetLastError = False, CallingConvention= CallingConvention.cdecl,
    EntryPoint = 'SSL_get_error')]
    function SslGetError(s: PSSL; ret_code: Integer): Integer; external;

  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
    SetLastError = False, CallingConvention= CallingConvention.cdecl,
    EntryPoint = 'SSL_library_init')]
    function SslLibraryInit: Integer; external;

  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
    SetLastError = False, CallingConvention= CallingConvention.cdecl,
    EntryPoint = 'SSL_load_error_strings')]
    procedure SslLoadErrorStrings; external;

  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
    SetLastError = False, CallingConvention= CallingConvention.cdecl,
    EntryPoint = 'SSL_CTX_set_cipher_list')]
    function SslCtxSetCipherList(arg0: PSSL_CTX; var str: String): Integer; external;

  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
    SetLastError = False, CallingConvention= CallingConvention.cdecl,
    EntryPoint = 'SSL_CTX_new')]
    function SslCtxNew(meth: PSSL_METHOD):PSSL_CTX;  external;

  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
    SetLastError = False, CallingConvention= CallingConvention.cdecl,
    EntryPoint = 'SSL_CTX_free')]
    procedure SslCtxFree (arg0: PSSL_CTX);   external;

  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
    SetLastError = False, CallingConvention= CallingConvention.cdecl,
    EntryPoint = 'SSL_set_fd')]
    function SslSetFd(s: PSSL; fd: Integer):Integer;    external;

  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
    SetLastError = False, CallingConvention= CallingConvention.cdecl,
    EntryPoint = 'SSLv2_method')]
    function SslMethodV2 : PSSL_METHOD; external;

  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
    SetLastError = False, CallingConvention= CallingConvention.cdecl,
    EntryPoint = 'SSLv3_method')]
    function SslMethodV3 : PSSL_METHOD;  external;

  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
    SetLastError = False, CallingConvention= CallingConvention.cdecl,
    EntryPoint = 'TLSv1_method')]
    function SslMethodTLSV1:PSSL_METHOD;  external;

  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
    SetLastError = False, CallingConvention= CallingConvention.cdecl,
    EntryPoint = 'SSLv23_method')]
    function SslMethodV23 : PSSL_METHOD; external;

  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
    SetLastError = False, CallingConvention= CallingConvention.cdecl,
    EntryPoint = 'SSL_CTX_use_PrivateKey')]
    function SslCtxUsePrivateKey(ctx: PSSL_CTX; pkey: SslPtr):Integer;  external;

  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
    SetLastError = False, CallingConvention= CallingConvention.cdecl,
    EntryPoint = 'SSL_CTX_use_PrivateKey_ASN1')]
    function SslCtxUsePrivateKeyASN1(pk: integer; ctx: PSSL_CTX; d: String; len: integer):Integer;  external;

  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
    SetLastError = False, CallingConvention= CallingConvention.cdecl,
    EntryPoint = 'SSL_CTX_use_RSAPrivateKey_file')]
    function SslCtxUsePrivateKeyFile(ctx: PSSL_CTX; const _file: String; _type: Integer):Integer;  external;

  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
    SetLastError = False, CallingConvention= CallingConvention.cdecl,
    EntryPoint = 'SSL_CTX_use_certificate')]
    function SslCtxUseCertificate(ctx: PSSL_CTX; x: SslPtr):Integer; external;

  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
    SetLastError = False, CallingConvention= CallingConvention.cdecl,
    EntryPoint = 'SSL_CTX_use_certificate_ASN1')]
    function SslCtxUseCertificateASN1(ctx: PSSL_CTX; len: integer; d: String):Integer; external;

  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
    SetLastError = False, CallingConvention= CallingConvention.cdecl,
    EntryPoint = 'SSL_CTX_use_certificate_file')]
    function SslCtxUseCertificateFile(ctx: PSSL_CTX; const _file: String; _type: Integer):Integer;external;

  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
    SetLastError = False, CallingConvention= CallingConvention.cdecl,
    EntryPoint = 'SSL_CTX_use_certificate_chain_file')]
    function SslCtxUseCertificateChainFile(ctx: PSSL_CTX; const _file: String):Integer;external;

  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
    SetLastError = False, CallingConvention= CallingConvention.cdecl,
    EntryPoint = 'SSL_CTX_check_private_key')]
    function SslCtxCheckPrivateKeyFile(ctx: PSSL_CTX):Integer; external;

  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
    SetLastError = False, CallingConvention= CallingConvention.cdecl,
    EntryPoint = 'SSL_CTX_set_default_passwd_cb')]
    procedure SslCtxSetDefaultPasswdCb(ctx: PSSL_CTX; cb: PPasswdCb); external;

  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
    SetLastError = False, CallingConvention= CallingConvention.cdecl,
    EntryPoint = 'SSL_CTX_set_default_passwd_cb_userdata')]
    procedure SslCtxSetDefaultPasswdCbUserdata(ctx: PSSL_CTX; u: IntPtr); external;

  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
    SetLastError = False, CallingConvention= CallingConvention.cdecl,
    EntryPoint = 'SSL_CTX_load_verify_locations')]
    function SslCtxLoadVerifyLocations(ctx: PSSL_CTX; CAfile: string; CApath: String):Integer; external;

  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
    SetLastError = False, CallingConvention= CallingConvention.cdecl,
    EntryPoint = 'SSL_new')]
    function SslNew(ctx: PSSL_CTX):PSSL;  external;

  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
    SetLastError = False, CallingConvention= CallingConvention.cdecl,
    EntryPoint = 'SSL_free')]
    procedure SslFree(ssl: PSSL); external;

  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
    SetLastError = False, CallingConvention= CallingConvention.cdecl,
    EntryPoint = 'SSL_accept')]
    function SslAccept(ssl: PSSL):Integer; external;

  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
    SetLastError = False, CallingConvention= CallingConvention.cdecl,
    EntryPoint = 'SSL_connect')]
    function SslConnect(ssl: PSSL):Integer; external;

  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
    SetLastError = False, CallingConvention= CallingConvention.cdecl,
    EntryPoint = 'SSL_shutdown')]
    function SslShutdown(s: PSSL):Integer;  external;

  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
    SetLastError = False, CallingConvention= CallingConvention.cdecl,