home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 November / Chip_2002-11_cd1.bin / zkuste / delphi / kompon / d3456 / SYNAPSE.ZIP / source / lib / SynaSSL.pas < prev    next >
Pascal/Delphi Source File  |  2002-07-10  |  12KB  |  253 lines
  1. {==============================================================================|
  2. | Project : Delphree - Synapse                                   | 001.006.000 |
  3. |==============================================================================|
  4. | Content: SSL support                                                         |
  5. |==============================================================================|
  6. | Copyright (c)1999-2002, Lukas Gebauer                                        |
  7. | All rights reserved.                                                         |
  8. |                                                                              |
  9. | Redistribution and use in source and binary forms, with or without           |
  10. | modification, are permitted provided that the following conditions are met:  |
  11. |                                                                              |
  12. | Redistributions of source code must retain the above copyright notice, this  |
  13. | list of conditions and the following disclaimer.                             |
  14. |                                                                              |
  15. | Redistributions in binary form must reproduce the above copyright notice,    |
  16. | this list of conditions and the following disclaimer in the documentation    |
  17. | and/or other materials provided with the distribution.                       |
  18. |                                                                              |
  19. | Neither the name of Lukas Gebauer nor the names of its contributors may      |
  20. | be used to endorse or promote products derived from this software without    |
  21. | specific prior written permission.                                           |
  22. |                                                                              |
  23. | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
  24. | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
  25. | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
  26. | ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
  27. | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
  28. | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
  29. | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
  30. | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
  31. | LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
  32. | OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
  33. | DAMAGE.                                                                      |
  34. |==============================================================================|
  35. | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
  36. | Portions created by Lukas Gebauer are Copyright (c)2002.                     |
  37. | All Rights Reserved.                                                         |
  38. |==============================================================================|
  39. | Contributor(s):                                                              |
  40. |==============================================================================|
  41. | History: see HISTORY.HTM from distribution package                           |
  42. |          (Found at URL: http://www.ararat.cz/synapse/)                       |
  43. |==============================================================================}
  44. {
  45. Special thanks to Gregor Ibic <gregor.ibic@intelicom.si>
  46.  (Intelicom d.o.o., http://www.intelicom.si)
  47.  for good inspiration about SSL programming.
  48. }
  49.  
  50. unit SynaSSL;
  51.  
  52. interface
  53.  
  54. uses
  55. {$IFDEF LINUX}
  56.   Libc, SysUtils;
  57. {$ELSE}
  58.   Windows;
  59. {$ENDIF}
  60.  
  61. const
  62. {$IFDEF LINUX}
  63.   DLLSSLName = 'libssl.so';
  64.   DLLUtilName = 'libcrypto.so';
  65. {$ELSE}
  66.   DLLSSLName = 'libssl32.dll';
  67.   DLLSSLName2 = 'ssleay32.dll';
  68.   DLLUtilName = 'libeay32.dll';
  69. {$ENDIF}
  70.  
  71. type
  72.   PSSL_CTX = Pointer;
  73.   PSSL = Pointer;
  74.   PSSL_METHOD = Pointer;
  75.   PX509 = Pointer;
  76.   PX509_NAME = Pointer;
  77.   PEVP_MD    = Pointer;
  78.   PInteger = ^Integer;
  79.  
  80. const
  81.   EVP_MAX_MD_SIZE = 16+20;
  82.   SSL_ERROR_NONE = 0;
  83.   SSL_ERROR_SSL = 1;
  84.   SSL_ERROR_WANT_READ = 2;
  85.   SSL_ERROR_WANT_WRITE = 3;
  86.   SSL_ERROR_ZERO_RETURN = 6;
  87.   SSL_OP_NO_SSLv2 = $01000000;
  88.   SSL_OP_NO_SSLv3 = $02000000;
  89.   SSL_OP_NO_TLSv1 = $04000000;
  90.   SSL_OP_ALL = $000FFFFF;
  91.   SSL_VERIFY_NONE = $00;
  92.   SSL_VERIFY_PEER = $01;
  93.  
  94. var
  95.   SSLLibHandle: Integer = 0;
  96.   SSLUtilHandle: Integer = 0;
  97.  
  98. // libssl.dll
  99.   SslGetError : function(s: PSSL; ret_code: Integer):Integer cdecl = nil;
  100.   SslLibraryInit : function:Integer cdecl = nil;
  101.   SslLoadErrorStrings : procedure cdecl = nil;
  102.   SslCtxSetCipherList : function(arg0: PSSL_CTX; str: PChar):Integer cdecl = nil;
  103.   SslCtxNew : function(meth: PSSL_METHOD):PSSL_CTX cdecl = nil;
  104.   SslCtxFree : procedure(arg0: PSSL_CTX) cdecl = nil;
  105.   SslSetFd : function(s: PSSL; fd: Integer):Integer cdecl = nil;
  106.   SslMethodV23 : function:PSSL_METHOD cdecl = nil;
  107.   SslCtxUsePrivateKeyFile : function(ctx: PSSL_CTX; const _file: PChar; _type: Integer):Integer cdecl = nil;
  108.   SslCtxUseCertificateChainFile : function(ctx: PSSL_CTX; const _file: PChar):Integer cdecl = nil;
  109.   SslCtxCheckPrivateKeyFile : function(ctx: PSSL_CTX):Integer cdecl = nil;
  110.   SslCtxSetDefaultPasswdCb : procedure(ctx: PSSL_CTX; cb: Pointer) cdecl = nil;
  111.   SslCtxSetDefaultPasswdCbUserdata : procedure(ctx: PSSL_CTX; u: Pointer) cdecl = nil;
  112.   SslCtxLoadVerifyLocations : function(ctx: PSSL_CTX; const CAfile: PChar; const CApath: PChar):Integer cdecl = nil;
  113.   SslNew : function(ctx: PSSL_CTX):PSSL cdecl = nil;
  114.   SslFree : procedure(ssl: PSSL) cdecl = nil;
  115.   SslAccept : function(ssl: PSSL):Integer cdecl = nil;
  116.   SslConnect : function(ssl: PSSL):Integer cdecl = nil;
  117.   SslShutdown : function(ssl: PSSL):Integer cdecl = nil;
  118.   SslRead : function(ssl: PSSL; buf: PChar; num: Integer):Integer cdecl = nil;
  119.   SslPeek : function(ssl: PSSL; buf: PChar; num: Integer):Integer cdecl = nil;
  120.   SslWrite : function(ssl: PSSL; const buf: PChar; num: Integer):Integer cdecl = nil;
  121.   SslPending : function(ssl: PSSL):Integer cdecl = nil;
  122.   SslGetVersion : function(ssl: PSSL):PChar cdecl = nil;
  123.   SslGetPeerCertificate : function(ssl: PSSL):PX509 cdecl = nil;
  124.   SslCtxSetVerify : procedure(ctx: PSSL_CTX; mode: Integer; arg2: Pointer) cdecl = nil;
  125.  
  126. // libeay.dll
  127.   SslX509Free : procedure(x: PX509) cdecl = nil;
  128.   SslX509NameOneline : function(a: PX509_NAME; buf: PChar; size: Integer):PChar cdecl = nil;
  129.   SslX509GetSubjectName : function(a: PX509):PX509_NAME cdecl = nil;
  130.   SslX509GetIssuerName : function(a: PX509):PX509_NAME cdecl = nil;
  131.   SslX509NameHash : function(x: PX509_NAME):Cardinal cdecl = nil;
  132.   SslX509Digest : function(data: PX509; _type: PEVP_MD; md: PChar; len: PInteger):Integer cdecl = nil;
  133.   SslEvpMd5 : function:PEVP_MD cdecl = nil;
  134.   ErrErrorString : function(e: integer; buf: PChar): PChar cdecl = nil;
  135.   ErrGetError : function: integer cdecl = nil;
  136.   ErrClearError : procedure cdecl = nil;
  137.  
  138. function InitSSLInterface: Boolean;
  139. function DestroySSLInterface: Boolean;
  140.  
  141. implementation
  142.  
  143. uses SyncObjs;
  144.  
  145. var
  146.   SSLCS: TCriticalSection;
  147.   SSLCount: Integer = 0;
  148.  
  149. function InitSSLInterface: Boolean;
  150. begin
  151.   Result := False;
  152.   SSLCS.Enter;
  153.   try
  154.     if SSLCount = 0 then
  155.     begin
  156. {$IFDEF LINUX}
  157.       SSLLibHandle := HMODULE(dlopen(DLLSSLName, RTLD_GLOBAL));
  158.       SSLUtilHandle := HMODULE(dlopen(DLLUtilName, RTLD_GLOBAL));
  159. {$ELSE}
  160.       SSLLibHandle := LoadLibrary(PChar(DLLSSLName));
  161.       if (SSLLibHandle = 0) then
  162.         SSLLibHandle := LoadLibrary(PChar(DLLSSLName2));
  163.       SSLUtilHandle := LoadLibrary(PChar(DLLUtilName));
  164. {$ENDIF}
  165.       if (SSLLibHandle <> 0) and (SSLUtilHandle <> 0) then
  166.       begin
  167.         SslGetError := GetProcAddress(SSLLibHandle, PChar('SSL_get_error'));
  168.         SslLibraryInit := GetProcAddress(SSLLibHandle, PChar('SSL_library_init'));
  169.         SslLoadErrorStrings := GetProcAddress(SSLLibHandle, PChar('SSL_load_error_strings'));
  170.         SslCtxSetCipherList := GetProcAddress(SSLLibHandle, PChar('SSL_CTX_set_cipher_list'));
  171.         SslCtxNew := GetProcAddress(SSLLibHandle, PChar('SSL_CTX_new'));
  172.         SslCtxFree := GetProcAddress(SSLLibHandle, PChar('SSL_CTX_free'));
  173.         SslSetFd := GetProcAddress(SSLLibHandle, PChar('SSL_set_fd'));
  174.         SslMethodV23 := GetProcAddress(SSLLibHandle, PChar('SSLv23_method'));
  175.         SslCtxUsePrivateKeyFile := GetProcAddress(SSLLibHandle, PChar('SSL_CTX_use_PrivateKey_file'));
  176.         SslCtxUseCertificateChainFile := GetProcAddress(SSLLibHandle, PChar('SSL_CTX_use_certificate_chain_file'));
  177.         SslCtxCheckPrivateKeyFile := GetProcAddress(SSLLibHandle, PChar('SSL_CTX_check_private_key'));
  178.         SslCtxSetDefaultPasswdCb := GetProcAddress(SSLLibHandle, PChar('SSL_CTX_set_default_passwd_cb'));
  179.         SslCtxSetDefaultPasswdCbUserdata := GetProcAddress(SSLLibHandle, PChar('SSL_CTX_set_default_passwd_cb_userdata'));
  180.         SslCtxLoadVerifyLocations := GetProcAddress(SSLLibHandle, PChar('SSL_CTX_load_verify_locations'));
  181.         SslNew := GetProcAddress(SSLLibHandle, PChar('SSL_new'));
  182.         SslFree := GetProcAddress(SSLLibHandle, PChar('SSL_free'));
  183.         SslAccept := GetProcAddress(SSLLibHandle, PChar('SSL_accept'));
  184.         SslConnect := GetProcAddress(SSLLibHandle, PChar('SSL_connect'));
  185.         SslShutdown := GetProcAddress(SSLLibHandle, PChar('SSL_shutdown'));
  186.         SslRead := GetProcAddress(SSLLibHandle, PChar('SSL_read'));
  187.         SslPeek := GetProcAddress(SSLLibHandle, PChar('SSL_peek'));
  188.         SslWrite := GetProcAddress(SSLLibHandle, PChar('SSL_write'));
  189.         SslPending := GetProcAddress(SSLLibHandle, PChar('SSL_pending'));
  190.         SslGetPeerCertificate := GetProcAddress(SSLLibHandle, PChar('SSL_get_peer_certificate'));
  191.         SslGetVersion := GetProcAddress(SSLLibHandle, PChar('SSL_get_version'));
  192.         SslCtxSetVerify := GetProcAddress(SSLLibHandle, PChar('SSL_CTX_set_verify'));
  193.  
  194.         SslX509Free := GetProcAddress(SSLUtilHandle, PChar('X509_free'));
  195.         SslX509NameOneline := GetProcAddress(SSLUtilHandle, PChar('X509_NAME_oneline'));
  196.         SslX509GetSubjectName := GetProcAddress(SSLUtilHandle, PChar('X509_get_subject_name'));
  197.         SslX509GetIssuerName := GetProcAddress(SSLUtilHandle, PChar('X509_get_issuer_name'));
  198.         SslX509NameHash := GetProcAddress(SSLUtilHandle, PChar('X509_NAME_hash'));
  199.         SslX509Digest := GetProcAddress(SSLUtilHandle, PChar('X509_digest'));
  200.         SslEvpMd5 := GetProcAddress(SSLUtilHandle, PChar('EVP_md5'));
  201.         ErrerrorString := GetProcAddress(SSLUtilHandle, PChar('ERR_error_string'));
  202.         ErrGetError := GetProcAddress(SSLUtilHandle, PChar('ERR_get_error'));
  203.         ErrClearError := GetProcAddress(SSLUtilHandle, PChar('ERR_clear_error'));
  204.  
  205.         Result := True;
  206.       end;
  207.     end
  208.     else Result := True;
  209.     if Result then
  210.       Inc(SSLCount);
  211.   finally
  212.     SSLCS.Leave;
  213.   end;
  214. end;
  215.  
  216. function DestroySSLInterface: Boolean;
  217. begin
  218.   SSLCS.Enter;
  219.   try
  220.     Dec(SSLCount);
  221.     if SSLCount < 0 then
  222.       SSLCount := 0;
  223.     if SSLCount = 0 then
  224.     begin
  225.       if SSLLibHandle <> 0 then
  226.       begin
  227.         FreeLibrary(SSLLibHandle);
  228.         SSLLibHandle := 0;
  229.       end;
  230.       if SSLUtilHandle <> 0 then
  231.       begin
  232.         FreeLibrary(SSLUtilHandle);
  233.         SSLLibHandle := 0;
  234.       end;
  235.     end;
  236.   finally
  237.     SSLCS.Leave;
  238.   end;
  239.   Result := True;
  240. end;
  241.  
  242. initialization
  243. begin
  244.   SSLCS:= TCriticalSection.Create;
  245. end;
  246.  
  247. finalization
  248. begin
  249.   SSLCS.Free;
  250. end;
  251.  
  252. end.
  253.