Browse Source

* Add demo to show OnVerifyCertificate, part of issue #39998

Michaël Van Canneyt 1 year ago
parent
commit
c1be8e590d
1 changed files with 61 additions and 0 deletions
  1. 61 0
      packages/fcl-net/examples/testverify.pp

+ 61 - 0
packages/fcl-net/examples/testverify.pp

@@ -0,0 +1,61 @@
+{
+  Program to demonstrate verification of a certificate.
+  Created by Bernd K. for issue:
+  https://gitlab.com/freepascal.org/fpc/source/-/issues/39998
+}
+program testverify;
+
+uses
+  Sysutils, Classes, sockets, ssockets, sslsockets, openssl, opensslsockets;
+
+
+type
+
+  { TApp }
+
+  TApp = class
+    Sock: TInetSocket;
+    SSLHandler: TSSLSocketHandler;
+    constructor Create;
+    destructor Destroy; override;
+    procedure OnVerify(Sender: TObject; var Allow: Boolean);
+  end;
+
+var
+  App: TApp;
+
+{ TApp }
+
+constructor TApp.Create;
+begin
+  SSLHandler := TSSLSocketHandler.GetDefaultHandler;
+  SSLHandler.OnVerifyCertificate := @OnVerify;
+  //SSLHandler.VerifyPeerCert := True;
+  Sock := TInetSocket.Create('test.mosquitto.org', 8883, 1000, SSLHandler);
+
+  writeln('begin connect');
+  Sock.Connect;
+  writeln('end connect');
+
+end;
+
+destructor TApp.Destroy;
+begin
+  Sock.Free;
+  inherited Destroy;
+end;
+
+procedure TApp.OnVerify(Sender: TObject; var Allow: Boolean);
+var
+  S: TOpenSSLSocketHandler;
+begin
+  Writeln('OnVerify');
+  S := Sender as TOpenSSLSocketHandler;
+  writeln('cert assigned: ', Assigned(S.SSL.PeerCertificate));
+  writeln('cert info:     ', S.SSL.CertInfo);
+end;
+
+begin
+  App := TApp.Create;
+  App.Free;
+end.