source: trunk/Packages/synapse/source/lib/ssl_openssl.pas

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