source: Network/synapse/ssl_openssl.pas

Last change on this file was 300, checked in by chronos, 14 years ago
  • Added: Synapse library with package file. Cryptlib units are not included in package file list.
File size: 21.4 KB
Line 
1{==============================================================================|
2| Project : Ararat Synapse | 001.001.000 |
3|==============================================================================|
4| Content: SSL support by OpenSSL |
5|==============================================================================|
6| Copyright (c)1999-2008, 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)2005-2008. |
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//requires OpenSSL libraries!
46
47{:@abstract(SSL plugin for OpenSSL)
48
49You need OpenSSL libraries version 0.9.7. It can work with 0.9.6 too, but
50application mysteriously crashing when you are using freePascal on Linux.
51Use Kylix on Linux is OK! If you have version 0.9.7 on Linux, then I not see
52any problems with FreePascal.
53
54OpenSSL libraries are loaded dynamicly - you not need OpenSSl librares even you
55compile your application with this unit. SSL just not working when you not have
56OpenSSL libraries.
57
58This plugin have limited support for .NET too! Because is not possible to use
59callbacks with CDECL calling convention under .NET, is not supported
60key/certificate passwords and multithread locking. :-(
61
62For handling keys and certificates you can use this properties:
63
64@link(TCustomSSL.CertificateFile) for PEM or ASN1 DER (cer) format. @br
65@link(TCustomSSL.Certificate) for ASN1 DER format only. @br
66@link(TCustomSSL.PrivateKeyFile) for PEM or ASN1 DER (key) format. @br
67@link(TCustomSSL.PrivateKey) for ASN1 DER format only. @br
68@link(TCustomSSL.CertCAFile) for PEM CA certificate bundle. @br
69@link(TCustomSSL.PFXFile) for PFX format. @br
70@link(TCustomSSL.PFX) for PFX format from binary string. @br
71
72This plugin is capable to create Ad-Hoc certificates. When you start SSL/TLS
73server without explicitly assigned key and certificate, then this plugin create
74Ad-Hoc key and certificate for each incomming connection by self. It slowdown
75accepting of new connections!
76}
77
78{$IFDEF FPC}
79 {$MODE DELPHI}
80{$ENDIF}
81{$H+}
82
83unit ssl_openssl;
84
85interface
86
87uses
88 SysUtils, Classes,
89 blcksock, synsock, synautil,
90{$IFDEF CIL}
91 System.Text,
92{$ENDIF}
93 ssl_openssl_lib;
94
95type
96 {:@abstract(class implementing OpenSSL SSL plugin.)
97 Instance of this class will be created for each @link(TTCPBlockSocket).
98 You not need to create instance of this class, all is done by Synapse itself!}
99 TSSLOpenSSL = class(TCustomSSL)
100 protected
101 FSsl: PSSL;
102 Fctx: PSSL_CTX;
103 function SSLCheck: Boolean;
104 function SetSslKeys: boolean;
105 function Init(server:Boolean): Boolean;
106 function DeInit: Boolean;
107 function Prepare(server:Boolean): Boolean;
108 function LoadPFX(pfxdata: ansistring): Boolean;
109 function CreateSelfSignedCert(Host: string): Boolean; override;
110 public
111 {:See @inherited}
112 constructor Create(const Value: TTCPBlockSocket); override;
113 destructor Destroy; override;
114 {:See @inherited}
115 function LibVersion: String; override;
116 {:See @inherited}
117 function LibName: String; override;
118 {:See @inherited and @link(ssl_cryptlib) for more details.}
119 function Connect: boolean; override;
120 {:See @inherited and @link(ssl_cryptlib) for more details.}
121 function Accept: boolean; override;
122 {:See @inherited}
123 function Shutdown: boolean; override;
124 {:See @inherited}
125 function BiShutdown: boolean; override;
126 {:See @inherited}
127 function SendBuffer(Buffer: TMemory; Len: Integer): Integer; override;
128 {:See @inherited}
129 function RecvBuffer(Buffer: TMemory; Len: Integer): Integer; override;
130 {:See @inherited}
131 function WaitingData: Integer; override;
132 {:See @inherited}
133 function GetSSLVersion: string; override;
134 {:See @inherited}
135 function GetPeerSubject: string; override;
136 {:See @inherited}
137 function GetPeerIssuer: string; override;
138 {:See @inherited}
139 function GetPeerName: string; override;
140 {:See @inherited}
141 function GetPeerFingerprint: string; override;
142 {:See @inherited}
143 function GetCertInfo: string; override;
144 {:See @inherited}
145 function GetCipherName: string; override;
146 {:See @inherited}
147 function GetCipherBits: integer; override;
148 {:See @inherited}
149 function GetCipherAlgBits: integer; override;
150 {:See @inherited}
151 function GetVerifyCert: integer; override;
152 end;
153
154implementation
155
156{==============================================================================}
157
158{$IFNDEF CIL}
159function PasswordCallback(buf:PAnsiChar; size:Integer; rwflag:Integer; userdata: Pointer):Integer; cdecl;
160var
161 Password: AnsiString;
162begin
163 Password := '';
164 if TCustomSSL(userdata) is TCustomSSL then
165 Password := TCustomSSL(userdata).KeyPassword;
166 if Length(Password) > (Size - 1) then
167 SetLength(Password, Size - 1);
168 Result := Length(Password);
169 StrLCopy(buf, PAnsiChar(Password + #0), Result + 1);
170end;
171{$ENDIF}
172
173{==============================================================================}
174
175constructor TSSLOpenSSL.Create(const Value: TTCPBlockSocket);
176begin
177 inherited Create(Value);
178 FCiphers := 'DEFAULT';
179 FSsl := nil;
180 Fctx := nil;
181end;
182
183destructor TSSLOpenSSL.Destroy;
184begin
185 DeInit;
186 inherited Destroy;
187end;
188
189function TSSLOpenSSL.LibVersion: String;
190begin
191 Result := SSLeayversion(0);
192end;
193
194function TSSLOpenSSL.LibName: String;
195begin
196 Result := 'ssl_openssl';
197end;
198
199function TSSLOpenSSL.SSLCheck: Boolean;
200var
201{$IFDEF CIL}
202 sb: StringBuilder;
203{$ENDIF}
204 s : AnsiString;
205begin
206 Result := true;
207 FLastErrorDesc := '';
208 FLastError := ErrGetError;
209 ErrClearError;
210 if FLastError <> 0 then
211 begin
212 Result := False;
213{$IFDEF CIL}
214 sb := StringBuilder.Create(256);
215 ErrErrorString(FLastError, sb, 256);
216 FLastErrorDesc := Trim(sb.ToString);
217{$ELSE}
218 s := StringOfChar(#0, 256);
219 ErrErrorString(FLastError, s, Length(s));
220 FLastErrorDesc := s;
221{$ENDIF}
222 end;
223end;
224
225function TSSLOpenSSL.CreateSelfSignedCert(Host: string): Boolean;
226var
227 pk: EVP_PKEY;
228 x: PX509;
229 rsa: PRSA;
230 t: PASN1_UTCTIME;
231 name: PX509_NAME;
232 b: PBIO;
233 xn, y: integer;
234 s: AnsiString;
235{$IFDEF CIL}
236 sb: StringBuilder;
237{$ENDIF}
238begin
239 Result := True;
240 pk := EvpPkeynew;
241 x := X509New;
242 try
243 rsa := RsaGenerateKey(1024, $10001, nil, nil);
244 EvpPkeyAssign(pk, EVP_PKEY_RSA, rsa);
245 X509SetVersion(x, 2);
246 Asn1IntegerSet(X509getSerialNumber(x), 0);
247 t := Asn1UtctimeNew;
248 try
249 X509GmtimeAdj(t, -60 * 60 *24);
250 X509SetNotBefore(x, t);
251 X509GmtimeAdj(t, 60 * 60 * 60 *24);
252 X509SetNotAfter(x, t);
253 finally
254 Asn1UtctimeFree(t);
255 end;
256 X509SetPubkey(x, pk);
257 Name := X509GetSubjectName(x);
258 X509NameAddEntryByTxt(Name, 'C', $1001, 'CZ', -1, -1, 0);
259 X509NameAddEntryByTxt(Name, 'CN', $1001, host, -1, -1, 0);
260 x509SetIssuerName(x, Name);
261 x509Sign(x, pk, EvpGetDigestByName('SHA1'));
262 b := BioNew(BioSMem);
263 try
264 i2dX509Bio(b, x);
265 xn := bioctrlpending(b);
266{$IFDEF CIL}
267 sb := StringBuilder.Create(xn);
268 y := bioread(b, sb, xn);
269 if y > 0 then
270 begin
271 sb.Length := y;
272 s := sb.ToString;
273 end;
274{$ELSE}
275 setlength(s, xn);
276 y := bioread(b, s, xn);
277 if y > 0 then
278 setlength(s, y);
279{$ENDIF}
280 finally
281 BioFreeAll(b);
282 end;
283 FCertificate := s;
284 b := BioNew(BioSMem);
285 try
286 i2dPrivatekeyBio(b, pk);
287 xn := bioctrlpending(b);
288{$IFDEF CIL}
289 sb := StringBuilder.Create(xn);
290 y := bioread(b, sb, xn);
291 if y > 0 then
292 begin
293 sb.Length := y;
294 s := sb.ToString;
295 end;
296{$ELSE}
297 setlength(s, xn);
298 y := bioread(b, s, xn);
299 if y > 0 then
300 setlength(s, y);
301{$ENDIF}
302 finally
303 BioFreeAll(b);
304 end;
305 FPrivatekey := s;
306 finally
307 X509free(x);
308 EvpPkeyFree(pk);
309 end;
310end;
311
312function TSSLOpenSSL.LoadPFX(pfxdata: Ansistring): Boolean;
313var
314 cert, pkey, ca: SslPtr;
315 b: PBIO;
316 p12: SslPtr;
317begin
318 Result := False;
319 b := BioNew(BioSMem);
320 try
321 BioWrite(b, pfxdata, Length(PfxData));
322 p12 := d2iPKCS12bio(b, nil);
323 if not Assigned(p12) then
324 Exit;
325 try
326 cert := nil;
327 pkey := nil;
328 ca := nil;
329 if PKCS12parse(p12, FKeyPassword, pkey, cert, ca) > 0 then
330 if SSLCTXusecertificate(Fctx, cert) > 0 then
331 if SSLCTXusePrivateKey(Fctx, pkey) > 0 then
332 Result := True;
333 finally
334 PKCS12free(p12);
335 end;
336 finally
337 BioFreeAll(b);
338 end;
339end;
340
341function TSSLOpenSSL.SetSslKeys: boolean;
342var
343 st: TFileStream;
344 s: string;
345begin
346 Result := False;
347 if not assigned(FCtx) then
348 Exit;
349 try
350 if FCertificateFile <> '' then
351 if SslCtxUseCertificateChainFile(FCtx, FCertificateFile) <> 1 then
352 if SslCtxUseCertificateFile(FCtx, FCertificateFile, SSL_FILETYPE_PEM) <> 1 then
353 if SslCtxUseCertificateFile(FCtx, FCertificateFile, SSL_FILETYPE_ASN1) <> 1 then
354 Exit;
355 if FCertificate <> '' then
356 if SslCtxUseCertificateASN1(FCtx, length(FCertificate), FCertificate) <> 1 then
357 Exit;
358 SSLCheck;
359 if FPrivateKeyFile <> '' then
360 if SslCtxUsePrivateKeyFile(FCtx, FPrivateKeyFile, SSL_FILETYPE_PEM) <> 1 then
361 if SslCtxUsePrivateKeyFile(FCtx, FPrivateKeyFile, SSL_FILETYPE_ASN1) <> 1 then
362 Exit;
363 if FPrivateKey <> '' then
364 if SslCtxUsePrivateKeyASN1(EVP_PKEY_RSA, FCtx, FPrivateKey, length(FPrivateKey)) <> 1 then
365 Exit;
366 SSLCheck;
367 if FCertCAFile <> '' then
368 if SslCtxLoadVerifyLocations(FCtx, FCertCAFile, '') <> 1 then
369 Exit;
370 if FPFXfile <> '' then
371 begin
372 try
373 st := TFileStream.Create(FPFXfile, fmOpenRead or fmShareDenyNone);
374 try
375 s := ReadStrFromStream(st, st.Size);
376 finally
377 st.Free;
378 end;
379 if not LoadPFX(s) then
380 Exit;
381 except
382 on Exception do
383 Exit;
384 end;
385 end;
386 if FPFX <> '' then
387 if not LoadPFX(FPfx) then
388 Exit;
389 SSLCheck;
390 Result := True;
391 finally
392 SSLCheck;
393 end;
394end;
395
396function TSSLOpenSSL.Init(server:Boolean): Boolean;
397var
398 s: AnsiString;
399begin
400 Result := False;
401 FLastErrorDesc := '';
402 FLastError := 0;
403 Fctx := nil;
404 case FSSLType of
405 LT_SSLv2:
406 Fctx := SslCtxNew(SslMethodV2);
407 LT_SSLv3:
408 Fctx := SslCtxNew(SslMethodV3);
409 LT_TLSv1:
410 Fctx := SslCtxNew(SslMethodTLSV1);
411 LT_all:
412 Fctx := SslCtxNew(SslMethodV23);
413 else
414 Exit;
415 end;
416 if Fctx = nil then
417 begin
418 SSLCheck;
419 Exit;
420 end
421 else
422 begin
423 s := FCiphers;
424 SslCtxSetCipherList(Fctx, s);
425 if FVerifyCert then
426 SslCtxSetVerify(FCtx, SSL_VERIFY_PEER, nil)
427 else
428 SslCtxSetVerify(FCtx, SSL_VERIFY_NONE, nil);
429{$IFNDEF CIL}
430 SslCtxSetDefaultPasswdCb(FCtx, @PasswordCallback);
431 SslCtxSetDefaultPasswdCbUserdata(FCtx, self);
432{$ENDIF}
433
434 if server and (FCertificateFile = '') and (FCertificate = '')
435 and (FPFXfile = '') and (FPFX = '') then
436 begin
437 CreateSelfSignedcert(FSocket.ResolveIPToName(FSocket.GetRemoteSinIP));
438 end;
439
440 if not SetSSLKeys then
441 Exit
442 else
443 begin
444 Fssl := nil;
445 Fssl := SslNew(Fctx);
446 if Fssl = nil then
447 begin
448 SSLCheck;
449 exit;
450 end;
451 end;
452 end;
453 Result := true;
454end;
455
456function TSSLOpenSSL.DeInit: Boolean;
457begin
458 Result := True;
459 if assigned (Fssl) then
460 sslfree(Fssl);
461 Fssl := nil;
462 if assigned (Fctx) then
463 begin
464 SslCtxFree(Fctx);
465 Fctx := nil;
466 ErrRemoveState(0);
467 end;
468 FSSLEnabled := False;
469end;
470
471function TSSLOpenSSL.Prepare(server:Boolean): Boolean;
472begin
473 Result := false;
474 DeInit;
475 if Init(server) then
476 Result := true
477 else
478 DeInit;
479end;
480
481function TSSLOpenSSL.Connect: boolean;
482var
483 x: integer;
484begin
485 Result := False;
486 if FSocket.Socket = INVALID_SOCKET then
487 Exit;
488 if Prepare(False) then
489 begin
490{$IFDEF CIL}
491 if sslsetfd(FSsl, FSocket.Socket.Handle.ToInt32) < 1 then
492{$ELSE}
493 if sslsetfd(FSsl, FSocket.Socket) < 1 then
494{$ENDIF}
495 begin
496 SSLCheck;
497 Exit;
498 end;
499 x := sslconnect(FSsl);
500 if x < 1 then
501 begin
502 SSLcheck;
503 Exit;
504 end;
505 if FverifyCert then
506 if GetVerifyCert <> 0 then
507 Exit;
508 FSSLEnabled := True;
509 Result := True;
510 end;
511end;
512
513function TSSLOpenSSL.Accept: boolean;
514var
515 x: integer;
516begin
517 Result := False;
518 if FSocket.Socket = INVALID_SOCKET then
519 Exit;
520 if Prepare(True) then
521 begin
522{$IFDEF CIL}
523 if sslsetfd(FSsl, FSocket.Socket.Handle.ToInt32) < 1 then
524{$ELSE}
525 if sslsetfd(FSsl, FSocket.Socket) < 1 then
526{$ENDIF}
527 begin
528 SSLCheck;
529 Exit;
530 end;
531 x := sslAccept(FSsl);
532 if x < 1 then
533 begin
534 SSLcheck;
535 Exit;
536 end;
537 FSSLEnabled := True;
538 Result := True;
539 end;
540end;
541
542function TSSLOpenSSL.Shutdown: boolean;
543begin
544 if assigned(FSsl) then
545 sslshutdown(FSsl);
546 DeInit;
547 Result := True;
548end;
549
550function TSSLOpenSSL.BiShutdown: boolean;
551var
552 x: integer;
553begin
554 if assigned(FSsl) then
555 begin
556 x := sslshutdown(FSsl);
557 if x = 0 then
558 begin
559 Synsock.Shutdown(FSocket.Socket, 1);
560 sslshutdown(FSsl);
561 end;
562 end;
563 DeInit;
564 Result := True;
565end;
566
567function TSSLOpenSSL.SendBuffer(Buffer: TMemory; Len: Integer): Integer;
568var
569 err: integer;
570{$IFDEF CIL}
571 s: ansistring;
572{$ENDIF}
573begin
574 FLastError := 0;
575 FLastErrorDesc := '';
576 repeat
577{$IFDEF CIL}
578 s := StringOf(Buffer);
579 Result := SslWrite(FSsl, s, Len);
580{$ELSE}
581 Result := SslWrite(FSsl, Buffer , Len);
582{$ENDIF}
583 err := SslGetError(FSsl, Result);
584 until (err <> SSL_ERROR_WANT_READ) and (err <> SSL_ERROR_WANT_WRITE);
585 if err = SSL_ERROR_ZERO_RETURN then
586 Result := 0
587 else
588 if (err <> 0) then
589 FLastError := err;
590end;
591
592function TSSLOpenSSL.RecvBuffer(Buffer: TMemory; Len: Integer): Integer;
593var
594 err: integer;
595{$IFDEF CIL}
596 sb: stringbuilder;
597 s: ansistring;
598{$ENDIF}
599begin
600 FLastError := 0;
601 FLastErrorDesc := '';
602 repeat
603{$IFDEF CIL}
604 sb := StringBuilder.Create(Len);
605 Result := SslRead(FSsl, sb, Len);
606 if Result > 0 then
607 begin
608 sb.Length := Result;
609 s := sb.ToString;
610 System.Array.Copy(BytesOf(s), Buffer, length(s));
611 end;
612{$ELSE}
613 Result := SslRead(FSsl, Buffer , Len);
614{$ENDIF}
615 err := SslGetError(FSsl, Result);
616 until (err <> SSL_ERROR_WANT_READ) and (err <> SSL_ERROR_WANT_WRITE);
617 if err = SSL_ERROR_ZERO_RETURN then
618 Result := 0
619 else
620 if (err <> 0) then
621 FLastError := err;
622end;
623
624function TSSLOpenSSL.WaitingData: Integer;
625begin
626 Result := sslpending(Fssl);
627end;
628
629function TSSLOpenSSL.GetSSLVersion: string;
630begin
631 if not assigned(FSsl) then
632 Result := ''
633 else
634 Result := SSlGetVersion(FSsl);
635end;
636
637function TSSLOpenSSL.GetPeerSubject: string;
638var
639 cert: PX509;
640 s: ansistring;
641{$IFDEF CIL}
642 sb: StringBuilder;
643{$ENDIF}
644begin
645 if not assigned(FSsl) then
646 begin
647 Result := '';
648 Exit;
649 end;
650 cert := SSLGetPeerCertificate(Fssl);
651 if not assigned(cert) then
652 begin
653 Result := '';
654 Exit;
655 end;
656{$IFDEF CIL}
657 sb := StringBuilder.Create(4096);
658 Result := X509NameOneline(X509GetSubjectName(cert), sb, 4096);
659{$ELSE}
660 setlength(s, 4096);
661 Result := X509NameOneline(X509GetSubjectName(cert), s, Length(s));
662{$ENDIF}
663 X509Free(cert);
664end;
665
666function TSSLOpenSSL.GetPeerName: string;
667var
668 s: ansistring;
669begin
670 s := GetPeerSubject;
671 s := SeparateRight(s, '/CN=');
672 Result := Trim(SeparateLeft(s, '/'));
673end;
674
675function TSSLOpenSSL.GetPeerIssuer: string;
676var
677 cert: PX509;
678 s: ansistring;
679{$IFDEF CIL}
680 sb: StringBuilder;
681{$ENDIF}
682begin
683 if not assigned(FSsl) then
684 begin
685 Result := '';
686 Exit;
687 end;
688 cert := SSLGetPeerCertificate(Fssl);
689 if not assigned(cert) then
690 begin
691 Result := '';
692 Exit;
693 end;
694{$IFDEF CIL}
695 sb := StringBuilder.Create(4096);
696 Result := X509NameOneline(X509GetIssuerName(cert), sb, 4096);
697{$ELSE}
698 setlength(s, 4096);
699 Result := X509NameOneline(X509GetIssuerName(cert), s, Length(s));
700{$ENDIF}
701 X509Free(cert);
702end;
703
704function TSSLOpenSSL.GetPeerFingerprint: string;
705var
706 cert: PX509;
707 x: integer;
708{$IFDEF CIL}
709 sb: StringBuilder;
710{$ENDIF}
711begin
712 if not assigned(FSsl) then
713 begin
714 Result := '';
715 Exit;
716 end;
717 cert := SSLGetPeerCertificate(Fssl);
718 if not assigned(cert) then
719 begin
720 Result := '';
721 Exit;
722 end;
723{$IFDEF CIL}
724 sb := StringBuilder.Create(EVP_MAX_MD_SIZE);
725 X509Digest(cert, EvpGetDigestByName('MD5'), sb, x);
726 sb.Length := x;
727 Result := sb.ToString;
728{$ELSE}
729 setlength(Result, EVP_MAX_MD_SIZE);
730 X509Digest(cert, EvpGetDigestByName('MD5'), Result, x);
731 SetLength(Result, x);
732{$ENDIF}
733 X509Free(cert);
734end;
735
736function TSSLOpenSSL.GetCertInfo: string;
737var
738 cert: PX509;
739 x, y: integer;
740 b: PBIO;
741 s: AnsiString;
742{$IFDEF CIL}
743 sb: stringbuilder;
744{$ENDIF}
745begin
746 if not assigned(FSsl) then
747 begin
748 Result := '';
749 Exit;
750 end;
751 cert := SSLGetPeerCertificate(Fssl);
752 if not assigned(cert) then
753 begin
754 Result := '';
755 Exit;
756 end;
757 b := BioNew(BioSMem);
758 try
759 X509Print(b, cert);
760 x := bioctrlpending(b);
761{$IFDEF CIL}
762 sb := StringBuilder.Create(x);
763 y := bioread(b, sb, x);
764 if y > 0 then
765 begin
766 sb.Length := y;
767 s := sb.ToString;
768 end;
769{$ELSE}
770 setlength(s,x);
771 y := bioread(b,s,x);
772 if y > 0 then
773 setlength(s, y);
774{$ENDIF}
775 Result := ReplaceString(s, LF, CRLF);
776 finally
777 BioFreeAll(b);
778 end;
779end;
780
781function TSSLOpenSSL.GetCipherName: string;
782begin
783 if not assigned(FSsl) then
784 Result := ''
785 else
786 Result := SslCipherGetName(SslGetCurrentCipher(FSsl));
787end;
788
789function TSSLOpenSSL.GetCipherBits: integer;
790var
791 x: integer;
792begin
793 if not assigned(FSsl) then
794 Result := 0
795 else
796 Result := SSLCipherGetBits(SslGetCurrentCipher(FSsl), x);
797end;
798
799function TSSLOpenSSL.GetCipherAlgBits: integer;
800begin
801 if not assigned(FSsl) then
802 Result := 0
803 else
804 SSLCipherGetBits(SslGetCurrentCipher(FSsl), Result);
805end;
806
807function TSSLOpenSSL.GetVerifyCert: integer;
808begin
809 if not assigned(FSsl) then
810 Result := 1
811 else
812 Result := SslGetVerifyResult(FSsl);
813end;
814
815{==============================================================================}
816
817initialization
818 if InitSSLInterface then
819 SSLImplementation := TSSLOpenSSL;
820
821end.
Note: See TracBrowser for help on using the repository browser.