/
mormot.net.sock.pas
4223 lines (3929 loc) · 138 KB
/
mormot.net.sock.pas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
/// low-level access to the OperatingSystem Sockets API (e.g. WinSock2)
// - this unit is a part of the Open Source Synopse mORMot framework 2,
// licensed under a MPL/GPL/LGPL three license - see LICENSE.md
unit mormot.net.sock;
{
*****************************************************************************
Cross-Platform Raw Sockets API Definition
- Socket Process High-Level Encapsulation
- MAC and IP Addresses Support
- TLS / HTTPS Encryption Abstract Layer
- Efficient Multiple Sockets Polling
- TUri parsing/generating URL wrapper
- TCrtSocket Buffered Socket Read/Write Class
The Low-Level Sockets API, which is complex and inconsistent among OS, is
not made public and shouldn't be used in end-user code. This unit
encapsultates all Sockets features into a single set of functions, and
around the TNetSocket abstract wrapper.
*****************************************************************************
Notes:
Oldest Delphis didn't include WinSock2.pas, so we defined our own.
Under POSIX, will redirect to the libc or regular FPC units.
}
interface
{$I ..\mormot.defines.inc}
uses
sysutils,
classes,
mormot.core.base,
mormot.core.os;
{ ******************** Socket Process High-Level Encapsulation }
const
cLocalhost = '127.0.0.1';
cAnyHost = '0.0.0.0';
cBroadcast = '255.255.255.255';
c6Localhost = '::1';
c6AnyHost = '::0';
c6Broadcast = 'ffff::1';
cAnyPort = '0';
cLocalhost32 = $0100007f;
{$ifdef OSWINDOWS}
SOCKADDR_SIZE = 28;
{$else}
SOCKADDR_SIZE = 110; // able to store UNIX domain socket name
{$endif OSWINDOWS}
var
/// global variable containing '127.0.0.1'
// - defined as var not as const to use reference counting from TNetAddr.IP
IP4local: RawUtf8;
type
/// the error codes returned by TNetSocket wrapper
// - convenient cross-platform error handling is not possible, mostly because
// Windows doesn't behave exactly like other targets: this enumeration
// flattens socket execution results, and allow easy ToText() text conversion
TNetResult = (
nrOK,
nrRetry,
nrNoSocket,
nrNotFound,
nrNotImplemented,
nrClosed,
nrFatalError,
nrUnknownError,
nrTooManyConnections,
nrRefused,
nrConnectTimeout);
/// exception class raised by this unit
ENetSock = class(ExceptionWithProps)
protected
fLastError: TNetResult;
public
/// reintroduced constructor with TNetResult information
constructor Create(msg: string; const args: array of const;
error: TNetResult = nrOK); reintroduce;
/// raise ENetSock if res is not nrOK or nrRetry
class procedure Check(res: TNetResult; const Context: ShortString);
/// call NetLastError and raise ENetSock if not nrOK nor nrRetry
class procedure CheckLastError(const Context: ShortString;
ForceRaise: boolean = false; AnotherNonFatal: integer = 0);
published
property LastError: TNetResult
read fLastError default nrOk;
end;
/// one data state to be tracked on a given socket
TNetEvent = (
neRead,
neWrite,
neError,
neClosed);
/// the current whole read/write state on a given socket
TNetEvents = set of TNetEvent;
/// the available socket protocol layers
// - by definition, nlUnix will return nrNotImplemented on Windows
TNetLayer = (
nlTcp,
nlUdp,
nlUnix);
/// the available socket families - mapping AF_INET/AF_INET6/AF_UNIX
TNetFamily = (
nfUnknown,
nfIP4,
nfIP6,
nfUnix);
/// the IP port to connect/bind to
TNetPort = cardinal;
const
NO_ERROR = 0;
/// the socket protocol layers over the IP protocol
nlIP = [nlTcp, nlUdp];
type
/// end-user code should use this TNetSocket type to hold a socket reference
// - then methods allow cross-platform access to the connection
TNetSocket = ^TNetSocketWrap;
/// internal mapping of an address, in any supported socket layer
TNetAddr = object
private
// opaque wrapper with len: sockaddr_un=110 (POSIX) or sockaddr_in6=28 (Win)
Addr: array[0..SOCKADDR_SIZE - 1] of byte;
public
function SetFrom(const address, addrport: RawUtf8; layer: TNetLayer): TNetResult;
function Family: TNetFamily;
function IP(localasvoid: boolean = false): RawUtf8;
function IPShort(withport: boolean = false): ShortString; overload;
{$ifdef HASINLINE}inline;{$endif}
procedure IPShort(out result: ShortString; withport: boolean = false); overload;
function IPWithPort: RawUtf8;
function Port: TNetPort;
function SetPort(p: TNetPort): TNetResult;
function Size: integer;
{$ifdef FPC}inline;{$endif}
function IsEqualAfter64(const another: TNetAddr): boolean;
{$ifdef FPC}inline;{$endif}
function IsEqual(const another: TNetAddr): boolean;
function NewSocket(layer: TNetLayer): TNetSocket;
end;
/// pointer to a socket address mapping
PNetAddr = ^TNetAddr;
TNetAddrDynArray = array of TNetAddr;
TNetSocketDynArray = array of TNetSocket;
PNetSocketDynArray = ^TNetSocketDynArray;
PTerminated = ^boolean; // on FPC system.PBoolean doesn't exist :(
/// convenient object-oriented wrapper around a socket connection
// - encapsulate a cross-platform low-level access to the socket API
// - TNetSocket is a pointer to this, so TSocket(@self) is used for OS calls
TNetSocketWrap = object
private
procedure SetOpt(prot, name: integer; value: pointer; valuelen: integer);
function GetOptInt(prot, name: integer): integer;
function SetIoMode(async: cardinal): TNetResult;
procedure SetSendBufferSize(bytes: integer);
procedure SetRecvBufferSize(bytes: integer);
function GetSendBufferSize: integer;
function GetRecvBufferSize: integer;
public
procedure SetupConnection(layer: TNetLayer; sendtimeout, recvtimeout: integer);
procedure SetSendTimeout(ms: integer);
procedure SetReceiveTimeout(ms: integer);
procedure SetKeepAlive(keepalive: boolean);
procedure SetLinger(linger: integer);
procedure SetNoDelay(nodelay: boolean);
function Accept(out clientsocket: TNetSocket; out addr: TNetAddr;
async: boolean): TNetResult;
function GetPeer(out addr: TNetAddr): TNetResult;
function MakeAsync: TNetResult;
function MakeBlocking: TNetResult;
function Send(Buf: pointer; var len: integer): TNetResult;
function Recv(Buf: pointer; var len: integer): TNetResult;
function SendTo(Buf: pointer; len: integer; const addr: TNetAddr): TNetResult;
function RecvFrom(Buf: pointer; len: integer; out addr: TNetAddr): integer;
function WaitFor(ms: integer; scope: TNetEvents; loerr: system.PInteger = nil): TNetEvents;
function RecvPending(out pending: integer): TNetResult;
function RecvWait(ms: integer; out data: RawByteString;
terminated: PTerminated = nil): TNetResult;
function SendAll(Buf: PByte; len: integer;
terminated: PTerminated = nil): TNetResult;
function ShutdownAndClose(rdwr: boolean): TNetResult;
function Close: TNetResult;
function Socket: PtrInt;
{$ifdef HASINLINE}inline;{$endif}
property SendBufferSize: integer
read GetSendBufferSize write SetSendBufferSize;
property RecvBufferSize: integer
read GetRecvBufferSize write SetRecvBufferSize;
end;
/// used by NewSocket() to cache the host names via NewSocketAddressCache global
// - defined in this unit, but implemented in mormot.net.client.pas
// - the implementation should be thread-safe
INewSocketAddressCache = interface
/// method called by NewSocket() to resolve its address
function Search(const Host: RawUtf8; out NetAddr: TNetAddr): boolean;
/// once resolved, NewSocket() will call this method to cache the TNetAddr
procedure Add(const Host: RawUtf8; const NetAddr: TNetAddr);
/// called by NewSocket() if connection failed, and force DNS resolution
procedure Flush(const Host: RawUtf8);
/// you can call this method to change the default timeout of 10 minutes
procedure SetTimeOut(aSeconds: integer);
end;
/// internal low-level function retrieving the latest socket error information
function NetLastError(AnotherNonFatal: integer = NO_ERROR;
Error: system.PInteger = nil): TNetResult;
/// internal low-level function retrieving the latest socket error message
function NetLastErrorMsg(AnotherNonFatal: integer = NO_ERROR): ShortString;
/// create a new Socket connected or bound to a given ip:port
function NewSocket(const address, port: RawUtf8; layer: TNetLayer;
dobind: boolean; connecttimeout, sendtimeout, recvtimeout, retry: integer;
out netsocket: TNetSocket; netaddr: PNetAddr = nil): TNetResult;
/// resolve the TNetAddr of the address:port layer - maybe from cache
function GetSocketAddressFromCache(const address, port: RawUtf8;
layer: TNetLayer; out addr: TNetAddr; var fromcache, tobecached: boolean): TNetResult;
/// try to connect to several address:port servers simultaneously
// - return up to neededcount connected TNetAddr, until timeoutms expires
// - sockets are closed unless sockets^[] should contain the result[] sockets
function GetReachableNetAddr(const address, port: array of RawUtf8;
timeoutms: integer = 1000; neededcount: integer = 1;
sockets: PNetSocketDynArray = nil): TNetAddrDynArray;
var
/// contains the raw Socket API version, as returned by the Operating System
SocketApiVersion: RawUtf8;
/// used by NewSocket() to cache the host names
// - avoiding DNS resolution is a always a good idea
// - implemented by mormot.net.client unit using a TSynDictionary
// - you may call its SetTimeOut or Flush methods to tune the caching
NewSocketAddressCache: INewSocketAddressCache;
/// Queue length for completely established sockets waiting to be accepted,
// a backlog parameter for listen() function. If queue overflows client count,
// ECONNREFUSED error is returned from connect() call
// - for Windows default $7fffffff should not be modified. Actual limit is 200
// - for Unix default is taken from constant (128 as in linux kernel >2.2),
// but actual value is min(DefaultListenBacklog, /proc/sys/net/core/somaxconn)
DefaultListenBacklog: integer;
/// defines if a connection from the loopback should be reported as ''
// - loopback connection will have no Remote-IP - for the default true
// - or loopback connection will be explicitly '127.0.0.1' - if equals false
// - used by both TCrtSock.AcceptRequest and THttpApiServer.Execute servers
RemoteIPLocalHostAsVoidInServers: boolean = true;
/// returns the plain English text of a network result
// - e.g. ToText(nrNotFound)='Not Found'
function ToText(res: TNetResult): PShortString; overload;
{ ******************** Mac and IP Addresses Support }
type
TIPAddress = (
tiaAny,
tiaIPv4,
tiaIPv4Public,
tiaIPv4Private,
tiaIPv6);
/// detect IANA private IPv4 address space from its 32-bit raw value
function IsPublicIP(ip4: cardinal): boolean;
/// convert an IPv4 raw value into a ShortString text
procedure IP4Short(ip4addr: PByteArray; var s: ShortString);
/// convert an IPv4 raw value into a RawUtf8 text
procedure IP4Text(ip4addr: PByteArray; var result: RawUtf8);
/// convert an IPv6 full address into a ShortString text
procedure IP6Short(psockaddr: pointer; var s: ShortString; withport: boolean);
/// convert a MAC address value into its standard RawUtf8 text representation
// - returns e.g. '12:50:b6:1e:c6:aa'
// - could be used to convert some binary buffer into human-friendly hexadecimal
// string, e.g. by asn1_string_st.ToHex() in our mormot.lib.openssl11 wrapper
function MacToText(mac: PByteArray; maclen: PtrInt = 6): RawUtf8;
/// convert a MAC address value from its standard hexadecimal text representation
// - returns e.g. '12:50:b6:1e:c6:aa' from '1250b61ec6aa' or '1250B61EC6AA'
function MacTextFromHex(const Hex: RawUtf8): RawUtf8;
/// convert a MAC address value into a RawUtf8 hexadecimal text with no ':'
// - returns e.g. '1250b61ec6aa'
function MacToHex(mac: PByteArray; maclen: PtrInt = 6): RawUtf8;
/// enumerate all IP addresses of the current computer
// - may be used to enumerate all adapters
function GetIPAddresses(Kind: TIPAddress = tiaIPv4): TRawUtf8DynArray;
/// returns all IP addresses of the current computer as a single CSV text
// - may be used to enumerate all adapters
function GetIPAddressesText(const Sep: RawUtf8 = ' ';
Kind: TIPAddress = tiaIPv4): RawUtf8;
type
/// interface name/address pairs as returned by GetMacAddresses
TMacAddress = record
/// contains e.g. 'eth0' on Linux
Name: RawUtf8;
/// contains e.g. '12:50:b6:1e:c6:aa' from /sys/class/net/eth0/adddress
Address: RawUtf8;
end;
TMacAddressDynArray = array of TMacAddress;
/// enumerate all Mac addresses of the current computer
function GetMacAddresses(UpAndDown: boolean = false): TMacAddressDynArray;
/// enumerate all Mac addresses of the current computer as 'name1=addr1 name2=addr2'
function GetMacAddressesText(WithoutName: boolean = true;
UpAndDown: boolean = false): RawUtf8;
{$ifdef OSWINDOWS}
/// remotly get the MAC address of a computer, from its IP Address
// - only works under Win2K and later, which features a ARP protocol client
// - return the MAC address as a 12 hexa chars ('0050C204C80A' e.g.)
function GetRemoteMacAddress(const IP: RawUtf8): RawUtf8;
{$endif OSWINDOWS}
{ ******************** TLS / HTTPS Encryption Abstract Layer }
type
/// pointer to TLS Options and Information for a given TCrtSocket connection
PNetTlsContext = ^TNetTlsContext;
/// callback raised by INetTls.AfterConnection to return a private key
// password - typically prompting the user for it
// - TLS is an opaque structure, typically an OpenSSL PSSL_CTX pointer
TOnNetTlsGetPassword = function(Socket: TNetSocket;
Context: PNetTlsContext; TLS: pointer): RawUtf8 of object;
/// callback raised by INetTls.AfterConnection to validate a peer
// - at this point, Context.CipherName is set, but PeerInfo, PeerIssuer and
// PeerSubject are not - it is up to the event to compute the PeerInfo value
// - TLS is an opaque structure, typically an OpenSSL PSSL pointer, so you
// could use e.g. PSSL(TLS).PeerCertificates array
TOnNetTlsPeerValidate = procedure(Socket: TNetSocket;
Context: PNetTlsContext; TLS: pointer) of object;
/// callback raised by INetTls.AfterConnection after validating a peer
// - called after standard peer validation - ignored by TOnNetTlsPeerValidate
// - Context.CipherName, LastError PeerIssuer and PeerSubject are set
// - TLS and Peer are opaque structures, typically OpenSSL PSSL and PX509
TOnNetTlsAfterPeerValidate = procedure(Socket: TNetSocket;
Context: PNetTlsContext; TLS, Peer: pointer) of object;
/// callback raised by INetTls.AfterConnection for each peer verification
// - wasok=true if the TLS library did validate the incoming certificate
// - should process the supplied peer information, and return true to continue
// and accept the connection, or false to abort the connection
// - Context.PeerIssuer and PeerSubject have been properly populated from Peer
// - TLS and Peer are opaque structures, typically OpenSSL PSSL and PX509 pointers
TOnNetTlsEachPeerVerify = function(Socket: TNetSocket; Context: PNetTlsContext;
wasok: boolean; TLS, Peer: pointer): boolean of object;
/// TLS Options and Information for a given TCrtSocket/INetTls connection
// - currently only properly implemented by mormot.lib.openssl11 - SChannel
// on Windows only recognizes IgnoreCertificateErrors and sets CipherName
// - typical usage is the following:
// $ with THttpClientSocket.Create do
// $ try
// $ TLS.WithPeerInfo := true;
// $ TLS.IgnoreCertificateErrors := true;
// $ TLS.CipherList := 'ECDHE-RSA-AES256-GCM-SHA384';
// $ OpenBind('synopse.info', '443', {bind=}false, {tls=}true);
// $ writeln(TLS.PeerInfo);
// $ writeln(TLS.CipherName);
// $ writeln(Get('/forum/', 1000), ' len=', ContentLength);
// $ writeln(Get('/fossil/wiki/Synopse+OpenSource', 1000));
// $ finally
// $ Free;
// $ end;
// - for passing a PNetTlsContext, use InitNetTlsContext for initialization
TNetTlsContext = record
/// output: set by TCrtSocket.OpenBind() method once TLS is established
Enabled: boolean;
/// input: let HTTPS be less paranoid about TLS certificates
// - on client: will avoid checking the server certificate, so will
// allow to connect and encrypt e.g. with secTLSSelfSigned servers
// - on OpenSSL server, should be true if no mutual authentication is done,
// i.e. if OnPeerValidate/OnEachPeerVerify callbacks are not set
IgnoreCertificateErrors: boolean;
/// input: if PeerInfo field should be retrieved once connected
// - ignored on SChannel
WithPeerInfo: boolean;
/// input: if deprecated TLS 1.0 or TLS 1.1 are allowed
// - default is TLS 1.2+ only, and deprecated SSL 2/3 are always disabled
AllowDeprecatedTls: boolean;
/// input: PEM/PFX file name containing a certificate to be loaded
// - (Delphi) warning: encoded as UTF-8 not UnicodeString/TFileName
// - on OpenSSL client or server, calls SSL_CTX_use_certificate_file() API
// - not used on SChannel client
// - on SChannel server, expects a .pfx / PKCS#12 file format including
// the certificate and the private key, e.g. generated from
// ICryptCert.SaveToFile(FileName, cccCertWithPrivateKey, ', ccfBinary) or
// openssl pkcs12 -inkey privkey.pem -in cert.pem -export -out mycert.pfx
CertificateFile: RawUtf8;
/// input: PEM file name containing a private key to be loaded
// - (Delphi) warning: encoded as UTF-8 not UnicodeString/TFileName
// - on OpenSSL client or server, calls SSL_CTX_use_PrivateKey_file() API
// - not used on SChannel
PrivateKeyFile: RawUtf8;
/// input: optional password to load the PrivateKey file
// - see also OnPrivatePassword callback
// - on OpenSSL client or server, calls SSL_CTX_set_default_passwd_cb_userdata() API
// - not used on SChannel
PrivatePassword: RawUtf8;
/// input: file containing a specific set of CA certificates chain
// - e.g. entrust_2048_ca.cer from https://web.entrust.com
// - (Delphi) warning: encoded as UTF-8 not UnicodeString/TFileName
// - on OpenSSL, calls the SSL_CTX_load_verify_locations() API
// - not used on SChannel
CACertificatesFile: RawUtf8;
/// input: preferred Cipher List
// - not used on SChannel
CipherList: RawUtf8;
/// input: a CSV list of host names to be validated
// - e.g. 'smtp.example.com,example.com'
// - not used on SChannel
HostNamesCsv: RawUtf8;
/// output: the cipher description, as used for the current connection
// - text format depends on the used TLS library e.g. on OpenSSL may be e.g.
// 'ECDHE-RSA-AES128-GCM-SHA256 TLSv1.2 Kx=ECDH Au=RSA Enc=AESGCM(128) Mac=AEAD'
// or 'TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256_P256 TLSv1.2' with SChannel
// (or less complete 'ECDHE256-AES128-SHA256 TLSv1.2' information on XP)
CipherName: RawUtf8;
/// output: the connected Peer issuer name
// - e.g. '/C=US/O=Let''s Encrypt/CN=R3'
// - not populated on SChannel, always on OpenSSL
PeerIssuer: RawUtf8;
/// output: the connected Peer subject name
// - e.g. 'CN=synopse.info'
// - not populated on SChannel, always on OpenSSL
PeerSubject: RawUtf8;
/// output: detailed information about the connected Peer
// - stored in the native format of the TLS library, e.g. X509_print()
// - only populated if WithPeerInfo was set to true, or an error occurred
PeerInfo: RawUtf8;
/// output: low-level details about the last error at TLS level
// - typically one X509_V_ERR_* integer constant
LastError: RawUtf8;
/// called by INetTls.AfterConnection to fully customize peer validation
// - not used on SChannel
OnPeerValidate: TOnNetTlsPeerValidate;
/// called by INetTls.AfterConnection for each peer validation
// - allow e.g. to verify CN or DNSName fields of each peer certificate
// - not used on SChannel
OnEachPeerVerify: TOnNetTlsEachPeerVerify;
/// called by INetTls.AfterConnection after standard peer validation
// - allow e.g. to verify CN or DNSName fields of the peer certificate
// - not used on SChannel
OnAfterPeerValidate: TOnNetTlsAfterPeerValidate;
/// called by INetTls.AfterConnection to retrieve a private password
// - not used on SChannel
OnPrivatePassword: TOnNetTlsGetPassword;
/// opaque pointer used by INetTls.AfterBind/AfterAccept to propagate the
// bound server certificate context into each accepted connection
// - so that certificates are decoded only once in AfterBind
AcceptCert: pointer;
end;
/// abstract definition of the TLS encrypted layer
// - is implemented e.g. by the SChannel API on Windows, or OpenSSL on POSIX
// if you include mormot.lib.openssl11 to your project
INetTls = interface
/// method called once to attach the socket from the client side
// - should make the proper client-side TLS handshake and create a session
// - should raise an exception on error
procedure AfterConnection(Socket: TNetSocket; var Context: TNetTlsContext;
const ServerAddress: RawUtf8);
/// method called once the socket has been bound on server side
// - will set Context.AcceptCert with reusable server certificates info
procedure AfterBind(var Context: TNetTlsContext);
/// method called for each new connection accepted on server side
// - should make the proper server-side TLS handshake and create a session
// - should raise an exception on error
// - BoundContext is the associated server instance with proper AcceptCert
// as filled by AfterBind()
procedure AfterAccept(Socket: TNetSocket; const BoundContext: TNetTlsContext;
LastError, CipherName: PRawUtf8);
/// retrieve the textual name of the cipher used following AfterAccept()
function GetCipherName: RawUtf8;
/// return the low-level TLS instance used, depending on the engine
// - typically a PSSL on OpenSSL, so you can use e.g. PSSL().PeerCertificate,
// or a PCtxtHandle on SChannel
function GetRawTls: pointer;
/// receive some data from the TLS layer
function Receive(Buffer: pointer; var Length: integer): TNetResult;
/// send some data from the TLS layer
function Send(Buffer: pointer; var Length: integer): TNetResult;
end;
/// signature of a factory for a new TLS encrypted layer
TOnNewNetTls = function: INetTls;
/// initialize a stack-allocated TNetTlsContext instance
procedure InitNetTlsContext(var TLS: TNetTlsContext; Server: boolean = false;
const CertificateFile: TFileName = ''; const PrivateKeyFile: TFileName = '';
const PrivateKeyPassword: RawUtf8 = ''; const CACertificatesFile: TFileName = '');
var
/// global factory for a new TLS encrypted layer for TCrtSocket
// - on Windows, this unit will set a factory using the system SChannel API
// - on other targets, could be set by the mormot.lib.openssl11.pas unit
NewNetTls: TOnNewNetTls;
{ ******************** Efficient Multiple Sockets Polling }
type
/// the events monitored by TPollSocketAbstract
// - we don't make any difference between urgent or normal read/write events
TPollSocketEvent = (
pseRead,
pseWrite,
pseError,
pseClosed);
/// set of events monitored by TPollSocketAbstract
TPollSocketEvents = set of TPollSocketEvent;
/// some opaque value (typically a pointer) associated with a polling event
TPollSocketTag = type PtrInt;
PPollSocketTag = ^TPollSocketTag;
TPollSocketTagDynArray = TPtrUIntDynArray;
/// modifications notified by TPollSocketAbstract.WaitForModified
TPollSocketResult = record
/// opaque value as defined by TPollSocketAbstract.Subscribe
// - holds typically a TPollAsyncConnection instance
tag: TPollSocketTag;
/// the events which are notified
events: TPollSocketEvents;
end;
PPollSocketResult = ^TPollSocketResult;
/// all modifications returned by TPollSocketAbstract.WaitForModified
TPollSocketResults = record
// hold [0..Count-1] notified events
Events: array of TPollSocketResult;
/// how many modifications are currently monitored in Results[]
Count: PtrInt;
end;
{$M+}
TPollSockets = class;
/// abstract parent for TPollSocket* and TPollSockets polling
TPollAbstract = class
protected
fCount: integer;
public
/// track status modifications on one specified TSocket
// - you can specify which events are monitored - pseError and pseClosed
// will always be notified
// - tag parameter will be returned as TPollSocketResult - you may set
// here the socket file descriptor value, or a transtyped class instance
// - similar to epoll's EPOLL_CTL_ADD control interface
function Subscribe(socket: TNetSocket; events: TPollSocketEvents;
tag: TPollSocketTag): boolean; virtual; abstract;
/// should finalize this processing before shutdown
procedure Terminate; virtual;
published
/// how many TSocket instances are currently tracked
property Count: integer
read fCount;
end;
{$M-}
/// abstract parent class for efficient socket polling
// - on Linux, FollowEpoll=true uses the epoll API in level-triggered (LT) mode
// - on other systems (Windows or BSD), fallback to select or poll API, with
// FollowEpoll=false - note that Subscribe/Unsubscribe should be delayed
// outside the WaitForModified() call using an async separated list
// - implements libevent-like cross-platform features
// - use PollSocketClass global function to retrieve the best class depending
// on the running Operating System
// - actual classes are hidden in the implementation section of this unit,
// and will use the fastest available API on each Operating System
TPollSocketAbstract = class(TPollAbstract)
protected
fMaxSockets: integer;
fOwner: TPollSockets;
public
/// initialize the polling
constructor Create(aOwner: TPollSockets); virtual;
/// stop status modifications tracking on one specified TSocket
// - the socket should have been monitored by a previous call to Subscribe()
// - on success, returns true and fill tag with the associated opaque value
// - similar to epoll's EPOLL_CTL_DEL control interface
function Unsubscribe(socket: TNetSocket): boolean; virtual; abstract;
/// waits for status modifications of all tracked TSocket
// - will wait up to timeoutMS milliseconds, 0 meaning immediate return
// and -1 for infinite blocking
// - returns false on error (e.g. no TSocket registered) or no event
// - returns true and results.Events[0..results.Count-1] notifications
function WaitForModified(var results: TPollSocketResults;
timeoutMS: integer): boolean; virtual; abstract;
/// if this poll has no size limit, and subscription/wait is thread safe
// with edge detection
// - false for select/poll, but true for epoll
// - follow POLLSOCKETEPOLL conditional within this unit
class function FollowEpoll: boolean;
published
/// how many TSocket instances could be tracked, at most
// - depends on the API used
property MaxSockets: integer
read fMaxSockets;
end;
/// meta-class of TPollSocketAbstract socket polling classes
// - since TPollSocketAbstract.Create is declared as virtual, could be used
// to specify the proper polling class to add
// - see PollSocketClass function and TPollSocketAbstract.New method
TPollSocketClass = class of TPollSocketAbstract;
/// TPollSockets.OnGetOneIdle callback prototype
TOnPollSocketsIdle = procedure(Sender: TObject; NowTix: Int64) of object;
// as used by TPollSockets.Subscribe for select/poll thread safety
TPollSocketsSubscribe = record
socket: TNetSocket;
tag: TPollSocketTag;
events: TPollSocketEvents;
end;
PPollSocketsSubscribe = ^TPollSocketsSubscribe;
// as used by TPollSockets.Subscribe/Unsubscribe for select/poll thread safety
TPollSocketsSubscription = record
Unsubscribe: TNetSocketDynArray;
Subscribe: array of TPollSocketsSubscribe;
UnsubscribeCount: integer;
SubscribeCount: integer;
end;
/// implements efficient polling of multiple sockets
// - will maintain a pool of TPollSocketAbstract instances, to monitor
// incoming data or outgoing availability for a set of active connections
// - call Subscribe/Unsubscribe to setup the monitored sockets
// - call GetOne from a main thread, optionally GetOnePending from sub-threads
TPollSockets = class(TPollAbstract)
protected
fPoll: array of TPollSocketAbstract; // each track up to fPoll[].MaxSockets
fPending: TPollSocketResults;
fPendingIndex: PtrInt;
fPendingSafe: TLightLock;
fPollIndex: integer;
fGettingOne: integer;
fTerminated: boolean;
fEpollGettingOne: boolean;
fUnsubscribeShouldShutdownSocket: boolean;
fPollClass: TPollSocketClass;
fOnLog: TSynLogProc;
fOnGetOneIdle: TOnPollSocketsIdle;
// used for select/poll (FollowEpoll=false) with multiple thread-unsafe fPoll[]
fSubscription: TPollSocketsSubscription;
fSubscriptionSafe: TLightLock; // dedicated not to block Accept()
fPollLock: TRTLCriticalSection;
function GetSubscribeCount: integer;
function GetUnsubscribeCount: integer;
function IsValidPending(tag: TPollSocketTag): boolean; virtual;
public
/// initialize the sockets polling
// - under Linux/POSIX, will set the open files maximum number for the
// current process to match the system hard limit: if your system has a
// low "ulimit -H -n" value, you may add the following line in your
// /etc/limits.conf or /etc/security/limits.conf file:
// $ * hard nofile 65535
constructor Create(aPollClass: TPollSocketClass = nil);
/// finalize the sockets polling, and release all used memory
destructor Destroy; override;
/// track modifications on one specified TSocket and tag
// - the supplied tag value - maybe a PtrInt(aObject) - will be part of
// GetOne/GetOnePending methods TPollSocketResult.Tag results
// - will create as many TPollSocketAbstract instances as needed, depending
// on the MaxSockets capability of the actual implementation class
// - this method is thread-safe, and the actual fPoll[].Subscribe
// will take place during the next PollForPendingEvents() call
function Subscribe(socket: TNetSocket; events: TPollSocketEvents;
tag: TPollSocketTag): boolean; override;
/// stop status modifications tracking on one specified TSocket and tag
// - the socket should have been monitored by a previous call to Subscribe()
// - this method is thread-safe, and the actual fPoll[].UnSubscribe
// will take place during the next PollForPendingEvents() call
procedure Unsubscribe(socket: TNetSocket; tag: TPollSocketTag); virtual;
/// retrieve the next pending notification, or let the poll wait for new
// - if GetOnePending returns no pending notification, will try
// PollForPendingEvents and wait up to timeoutMS milliseconds for events
// - returns true and set notif.events/tag with the corresponding notification
// - returns false if no pending event was handled within the timeoutMS period
// - warning: this method should be called from a single thread on Linux
// (PollClass.FollowEpoll=true) since epoll_wait() is used - other select/poll
// API would work on concurrent call, but with lost resources - typically, a
// main thread calls GetOne() while other threads could call GetOnePending()
function GetOne(timeoutMS: integer; const call: RawUtf8;
out notif: TPollSocketResult): boolean; virtual;
/// retrieve the next pending notification
// - returns true and set notif.events/tag with the corresponding notification
// - returns false if no pending event is available
// - this method is thread-safe, and could be called from several threads
function GetOnePending(out notif: TPollSocketResult; const call: RawUtf8): boolean;
/// let the poll check for pending events and apend them to fPending results
// - could be called when PendingCount=0, i.e. GetOnePending()=false
// - returns how many new events have been retrieved for the subscribed sockets
function PollForPendingEvents(timeoutMS: integer): integer; virtual;
/// manually append one event to the pending nodifications
// - ready to be retrieved by GetOnePending
procedure AddOnePending(aTag: TPollSocketTag; aEvents: TPollSocketEvents;
aNoSearch: boolean);
/// notify any GetOne waiting method to stop its polling loop
procedure Terminate; override;
/// indicates that Unsubscribe() should also call ShutdownAndClose(socket)
// - Destroy will also shutdown any remaining sockets if PollForPendingEvents
// has not been called before shutdown
property UnsubscribeShouldShutdownSocket: boolean
read fUnsubscribeShouldShutdownSocket write fUnsubscribeShouldShutdownSocket;
/// the actual polling class used to track socket state changes
property PollClass: TPollSocketClass
read fPollClass write fPollClass;
/// allow raw debugging via logs of the low-level process
property OnLog: TSynLogProc
read fOnLog write fOnLog;
/// callback called by GetOne when Idle
// - warning: any implementation should be very quick and non blocking
property OnGetOneIdle: TOnPollSocketsIdle
read fOnGetOneIdle write fOnGetOneIdle;
published
/// is set to true by the Terminate method
property Terminated: boolean
read fTerminated;
/// the index of the last notified event in the internal queue
property PendingIndex: PtrInt
read fPendingIndex;
/// how many notified events are currently in the internal queue
property PendingCount: PtrInt
read fPending.Count;
/// how many connections are pending to be subscribed (poll/select API)
property SubscribeCount: integer
read GetSubscribeCount default 0;
/// how many connections are pending to be unsubscribed (poll/select API)
property UnsubscribeCount: integer
read GetUnsubscribeCount default 0;
end;
function ToText(ev: TPollSocketEvents): TShort8; overload;
/// class function factory, returning a socket polling class matching
// at best the current operating system
// - return a hidden TPollSocketSelect class under Windows, TPollSocketEpoll
// under Linux, or TPollSocketPoll on BSD
function PollSocketClass: TPollSocketClass;
{ *************************** TUri parsing/generating URL wrapper }
type
/// structure used to parse an URI into its components
// - ready to be supplied e.g. to a THttpRequest sub-class
// - used e.g. by class function THttpRequest.Get()
// - will decode standard HTTP/HTTPS urls or Unix sockets URI like
// 'http://unix:/path/to/socket.sock:/url/path'
{$ifdef USERECORDWITHMETHODS}
TUri = record
{$else}
TUri = object
{$endif USERECORDWITHMETHODS}
public
/// if the server is accessible via https:// and not plain http://
Https: boolean;
/// either nlTcp for HTTP/HTTPS or nlUnix for Unix socket URI
Layer: TNetLayer;
/// if the server is accessible via something else than http:// or https://
// - e.g. 'ws' or 'wss' for ws:// or wss://
Scheme: RawUtf8;
/// the server name
// - e.g. 'www.somewebsite.com' or 'path/to/socket.sock' Unix socket URI
Server: RawUtf8;
/// the server port
// - e.g. '80'
Port: RawUtf8;
/// optional user for authentication, as retrieved before '@'
// - e.g. from 'https://user:password@server:port/address'
User: RawUtf8;
/// optional password for authentication, as retrieved before '@'
// - e.g. from 'https://user:password@server:port/address'
Password: RawUtf8;
/// the resource address, including optional parameters
// - e.g. '/category/name/10?param=1'
Address: RawUtf8;
/// reset all stored information
procedure Clear;
/// fill the members from a supplied URI
// - recognize e.g. 'http://Server:Port/Address', 'https://Server/Address',
// 'Server/Address' (as http), or 'http://unix:/Server:/Address' (as nlUnix)
// - recognize 'https://user:password@server:port/address' authentication
// - returns TRUE is at least the Server has been extracted, FALSE on error
function From(aUri: RawUtf8; const DefaultPort: RawUtf8 = ''): boolean;
/// compute the whole normalized URI
// - e.g. 'https://Server:Port/Address' or 'http://unix:/Server:/Address'
function URI: RawUtf8;
/// the server port, as integer value
function PortInt: TNetPort;
/// compute the root resource Address, without any URI-encoded parameter
// - e.g. '/category/name/10'
function Root: RawUtf8;
/// returns BinToBase64(User + ':' + Password) encoded value
function UserPasswordBase64: RawUtf8;
end;
PUri = ^TUri;
const
/// the default TCP port as text, as DEFAULT_PORT[Https]
DEFAULT_PORT: array[boolean] of RawUtf8 = (
'80', '443');
/// the default TCP port as integer, as DEFAULT_PORT_INT[Https]
DEFAULT_PORT_INT: array[boolean] of TNetPort = (
80, 443);
/// IdemPChar() like function, to avoid linking mormot.core.text
function NetStartWith(p, up: PUtf8Char): boolean;
{ ********* TCrtSocket Buffered Socket Read/Write Class }
type
/// meta-class of a TCrtSocket (sub-)type
TCrtSocketClass = class of TCrtSocket;
/// identify the incoming data availability in TCrtSocket.SockReceivePending
TCrtSocketPending = (
cspSocketError,
cspNoData,
cspDataAvailable);
TCrtSocketTlsAfter = (
cstaConnect,
cstaBind,
cstaAccept);
{$M+}
/// Fast low-level Socket implementation
// - direct access to the OS (Windows, Linux) network layer API
// - use Open constructor to create a client to be connected to a server
// - use Bind constructor to initialize a server
// - use SockIn and SockOut (after CreateSock*) to read/readln or write/writeln
// as with standard Delphi text files (see SendEmail implementation)
// - even if you do not use read(SockIn^), you may call CreateSockIn then
// read the (binary) content via SockInRead/SockInPending methods, which would
// benefit of the SockIn^ input buffer to maximize reading speed
// - to write data, CreateSockOut and write(SockOut^) is not mandatory: you
// rather may use SockSend() overloaded methods, followed by a SockFlush call
// - in fact, you can decide whatever to use none, one or both SockIn/SockOut
// - since this class rely on its internal optimized buffering system,
// TCP_NODELAY is set to disable the Nagle algorithm
// - our classes are (much) faster than the Indy or Synapse implementation
TCrtSocket = class
protected
fSock: TNetSocket;
fServer: RawUtf8;
fPort: RawUtf8;
fProxyUrl: RawUtf8;
// set by AcceptRequest() from TVarSin
fRemoteIP: RawUtf8;
fSockIn: PTextFile;
fSockOut: PTextFile;
fTimeOut: PtrInt;
fBytesIn: Int64;
fBytesOut: Int64;
fSecure: INetTls;
fSockInEofError: integer;
fWasBind: boolean;
fSocketLayer: TNetLayer;
// updated by every SockSend() call
fSndBuf: RawByteString;
fSndBufLen: integer;
// updated during UDP connection, accessed via PeerAddress/PeerPort
fPeerAddr: PNetAddr;
procedure SetKeepAlive(aKeepAlive: boolean); virtual;
procedure SetLinger(aLinger: integer); virtual;
procedure SetReceiveTimeout(aReceiveTimeout: integer); virtual;
procedure SetSendTimeout(aSendTimeout: integer); virtual;
procedure SetTcpNoDelay(aTcpNoDelay: boolean); virtual;
function GetRawSocket: PtrInt;
{$ifdef HASINLINE}inline;{$endif}
public
/// direct access to the optional low-level HTTP proxy tunnelling information
// - could have been assigned by a Tunnel.From() call
// - User/Password would be taken into consideration for authentication
Tunnel: TUri;
/// direct access to the optional low-level TLS Options and Information
// - depending on the actual INetTls implementation, some fields may not
// be used nor populated - currently only supported by mormot.lib.openssl11
TLS: TNetTlsContext;
/// can be assigned to TSynLog.DoLog class method for low-level logging
OnLog: TSynLogProc;
/// common initialization of all constructors
// - do not call directly, but use Open / Bind constructors instead
constructor Create(aTimeOut: PtrInt = 10000); reintroduce; virtual;
/// constructor to connect to aServer:aPort
// - optionaly via TLS (using the SChannel API on Windows, or by including
// mormot.lib.openssl11 unit to your project) - with custom input options
// - aTunnel could be populated from mormot.net.client GetSystemProxyUri()
// - see also SocketOpen() for a wrapper catching any connection exception
constructor Open(const aServer, aPort: RawUtf8; aLayer: TNetLayer = nlTcp;
aTimeOut: cardinal = 10000; aTLS: boolean = false;
aTLSContext: PNetTlsContext = nil; aTunnel: PUri = nil);
/// high-level constructor to connect to a given URI
constructor OpenUri(const aUri: RawUtf8; out aAddress: RawUtf8;
const aTunnel: RawUtf8 = ''; aTimeOut: cardinal = 10000;
aTLSContext: PNetTlsContext = nil); overload;
/// constructor to bind to an address
// - aAddr='1234' - bind to a port on all interfaces, the same as '0.0.0.0:1234'
// - aAddr='IP:port' - bind to specified interface only, e.g.
// '1.2.3.4:1234'
// - aAddr='unix:/path/to/file' - bind to unix domain socket, e.g.
// 'unix:/run/mormot.sock'
// - aAddr='' - bind to systemd descriptor on linux - see
// http://0pointer.de/blog/projects/socket-activation.html
constructor Bind(const aAddress: RawUtf8; aLayer: TNetLayer = nlTcp;
aTimeOut: integer = 10000);
/// low-level internal method called by Open() and Bind() constructors
// - raise an ENetSock exception on error
// - optionaly via TLS (using the SChannel API on Windows, or by including
// mormot.lib.openssl11 unit) - with custom input options in the TLS fields
procedure OpenBind(const aServer, aPort: RawUtf8; doBind: boolean;
aTLS: boolean = false; aLayer: TNetLayer = nlTcp;
aSock: TNetSocket = TNetSocket(-1));
/// initialize the instance with the supplied accepted socket
// - is called from a bound TCP Server, just after Accept()
procedure AcceptRequest(aClientSock: TNetSocket; aClientAddr: PNetAddr);
/// low-level TLS support method
procedure DoTlsAfter(caller: TCrtSocketTlsAfter);
/// initialize SockIn for receiving with read[ln](SockIn^,...)
// - data is buffered, filled as the data is available
// - read(char) or readln() is indeed very fast
// - multithread applications would also use this SockIn pseudo-text file
// - default 1KB is big enough for headers (content will be read directly)
// - by default, expect CR+LF as line feed (i.e. the HTTP way)
procedure CreateSockIn(LineBreak: TTextLineBreakStyle = tlbsCRLF;
InputBufferSize: integer = 1024);
/// initialize SockOut for sending with write[ln](SockOut^,....)
// - data is sent (flushed) after each writeln() - it's a compiler feature
// - use rather SockSend() + SockSendFlush to send headers at once e.g.
// since writeln(SockOut^,..) flush buffer each time
procedure CreateSockOut(OutputBufferSize: integer = 1024);
/// finalize SockIn receiving buffer
// - you may call this method when you are sure that you don't need the
// input buffering feature on this connection any more (e.g. after having
// parsed the HTTP header, then rely on direct socket comunication)
procedure CloseSockIn;
/// finalize SockOut receiving buffer
// - you may call this method when you are sure that you don't need the
// output buffering feature on this connection any more (e.g. after having
// parsed the HTTP header, then rely on direct socket comunication)
procedure CloseSockOut;
/// close and shutdown the connection
// - called from Destroy, but is reintrant so could be called earlier
procedure Close; virtual;
/// close the opened socket, and corresponding SockIn/SockOut