forked from synopse/mORMot2
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathmormot.db.proxy.pas
2157 lines (1964 loc) · 77.3 KB
/
mormot.db.proxy.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
/// Database Framework Remote HTTP Access Using Binary Proxy Communication
// - 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.db.proxy;
{
*****************************************************************************
Allow Remote HTTP Access of any mormot.db.sql connections via a Proxy
- Shared Proxy Information
- Server-Side Proxy Remote Protocol
- Client-Side Proxy Remote Protocol
- HTTP Server Classes for Remote Access
- HTTP Client Classes for Remote Access
This unit contains the communication-abstracted logic to handle a
remote DB connection using an efficient proprietary binary protocol.
*****************************************************************************
}
interface
{$I ..\mormot.defines.inc}
uses
sysutils,
classes,
variants,
mormot.core.base,
mormot.core.os,
mormot.core.buffers,
mormot.core.data,
mormot.core.unicode,
mormot.core.text,
mormot.core.datetime,
mormot.core.variants,
mormot.core.json,
mormot.core.rtti,
mormot.crypt.secure,
mormot.db.core,
mormot.db.sql,
mormot.net.sock,
mormot.net.http,
mormot.net.client,
mormot.net.server;
{ ************ Shared Proxy Information }
type
/// exception raised during remote connection process
ESqlDBRemote = class(ESqlDBException);
/// proxy commands implemented by TSqlDBProxyConnectionProperties.Process()
// - method signature expect "const Input" and "var Output" arguments
// - Input is not used for cConnect, cDisconnect, cGetForeignKeys,
// cTryStartTransaction, cCommit, cRollback and cServerTimestamp
// - Input is the TSqlDBProxyConnectionProperties instance for cInitialize
// - Input is the RawUtf8 table name for most cGet* metadata commands
// - Input is the SQL statement and associated bound parameters for cExecute,
// cExecuteToBinary, cExecuteToJson, and cExecuteToExpandedJson, encoded as
// TSqlDBProxyConnectionCommandExecute record
// - Output is not used for cConnect, cDisconnect, cCommit, cRollback and cExecute
// - Output is TSqlDBDefinition (i.e. DBMS type) for cInitialize
// - Output is TTimeLog for cServerTimestamp
// - Output is boolean for cTryStartTransaction
// - Output is TSqlDBColumnDefineDynArray for cGetFields
// - Output is TSqlDBIndexDefineDynArray for cGetIndexes
// - Output is TSynNameValue (fForeignKeys) for cGetForeignKeys
// - Output is TRawUtf8DynArray for cGetTableNames
// - Output is RawByteString result data for cExecuteToBinary
// - Output is UpdateCount: integer text for cExecute
// - Output is RawUtf8 result data for cExecuteToJson and cExecuteToExpandedJson
// - calls could be declared as such:
// ! Process(cGetToken,?,result: Int64);
// ! Process(cGetDbms,User#1Hash: RawUtf8,fDbms: TSqlDBDefinition);
// ! Process(cConnect,?,?);
// ! Process(cDisconnect,?,?);
// ! Process(cTryStartTransaction,?,started: boolean);
// ! Process(cCommit,?,?);
// ! Process(cRollback,?,?);
// ! Process(cServerTimestamp,?,result: TTimeLog);
// ! Process(cGetFields,aTableName: RawUtf8,Fields: TSqlDBColumnDefineDynArray);
// ! Process(cGetIndexes,aTableName: RawUtf8,Indexes: TSqlDBIndexDefineDynArray);
// ! Process(cGetTableNames,?,Tables: TRawUtf8DynArray);
// ! Process(cGetForeignKeys,?,fForeignKeys: TSynNameValue);
// ! Process(cExecute,Request: TSqlDBProxyConnectionCommandExecute,UpdateCount: integer);
// ! Process(cExecuteToBinary,Request: TSqlDBProxyConnectionCommandExecute,Data: RawByteString);
// ! Process(cExecuteToJson,Request: TSqlDBProxyConnectionCommandExecute,JSON: RawUtf8);
// ! Process(cExecuteToExpandedJson,Request: TSqlDBProxyConnectionCommandExecute,JSON: RawUtf8);
// - cExceptionRaised is a pseudo-command, used only for sending an exception
// to the client in case of execution problem on the server side
TSqlDBProxyConnectionCommand = (
cGetToken,
cGetDbms,
cConnect,
cDisconnect,
cTryStartTransaction,
cCommit,
cRollback,
cServerTimestamp,
cGetFields,
cGetIndexes,
cGetTableNames,
cGetForeignKeys,
cExecute,
cExecuteToBinary,
cExecuteToJson,
cExecuteToExpandedJson,
cQuit,
cExceptionRaised);
/// server-side process flags for TSqlDBProxyConnectionCommandExecute.Force
TSqlDBProxyConnectionCommandExecuteForce = set of (
fBlobAsNull,
fDateWithMS,
fNoUpdateCount);
/// structure to embedd all needed parameters to execute a SQL statement
// - used for cExecute, cExecuteToBinary, cExecuteToJson and cExecuteToExpandedJson
// commands of TSqlDBProxyConnectionProperties.Process()
// - set by TSqlDBProxyStatement.ParamsToCommand() protected method
TSqlDBProxyConnectionCommandExecute = packed record
/// the associated SQL statement
Sql: RawUtf8;
/// input parameters
// - trunked to the exact number of parameters
Params: TSqlDBParamDynArray;
/// if input parameters expected BindArray() process
ArrayCount: integer;
/// how server side would handle statement execution
// - fBlobAsNull and fDateWithMS do match ForceBlobAsNull and ForceDateWithMS
// ISqlDBStatement properties
// - fNoUpdateCount avoids to call ISqlDBStatement.UpdateCount method, e.g.
// for performance reasons
Force: TSqlDBProxyConnectionCommandExecuteForce;
end;
/// retrieve the ready-to-be displayed text of proxy commands implemented by
// TSqlDBProxyConnectionProperties.Process()
function ToText(cmd: TSqlDBProxyConnectionCommand): PShortString; overload;
{ ************ Server-Side Proxy Remote Protocol }
type
/// server-side implementation of a proxy connection to any mormot.db.sql engine
// - this default implementation will send the data without compression,
// digital signature, nor encryption
// - inherit from this class to customize the transmission layer content
TSqlDBProxyConnectionProtocol = class
protected
fAuthenticate: TSynAuthenticationAbstract;
fTransactionSessionID: integer;
fTransactionRetryTimeout: Int64;
fTransactionActiveTimeout: Int64;
fTransactionActiveAutoReleaseTicks: Int64;
fSafe: TOSLock;
function GetAuthenticate: TSynAuthenticationAbstract;
/// default Handle*() will just return the incoming value
function HandleInput(const input: RawByteString): RawByteString; virtual;
function HandleOutput(const output: RawByteString): RawByteString; virtual;
/// default trial transaction
function TransactionStarted(connection: TSqlDBConnection;
sessionID: integer): boolean; virtual;
procedure TransactionEnd(sessionID: integer); virtual;
public
/// initialize a protocol, with a given authentication scheme
// - if no authentication is given, none will be processed
constructor Create(aAuthenticate: TSynAuthenticationAbstract); reintroduce;
/// release associated authentication class
destructor Destroy; override;
/// server-side implementation of a remote connection to any mormot.db.sql engine
// - follow the compressed binary message format expected by the
// TSqlDBRemoteConnectionPropertiesAbstract.ProcessMessage method
// - any transmission protocol could call this method to execute the
// corresponding TSqlDBProxyConnectionCommand on the current connection
// - replaces TSqlDBConnection.RemoteProcessMessage from mORMot 1.18
procedure RemoteProcessMessage(const Input: RawUtf8;
out Output: RawUtf8; Connection: TSqlDBConnection); virtual;
/// the associated authentication information
// - you can manage users via AuthenticateUser/DisauthenticateUser methods
property Authenticate: TSynAuthenticationAbstract
read GetAuthenticate write fAuthenticate;
end;
/// server-side implementation of a remote connection to any mormot.db.sql engine
// - implements digitally signed SynLZ-compressed binary message format,
// with simple symmetric encryption, as expected by this unit
TSqlDBRemoteConnectionProtocol = class(TSqlDBProxyConnectionProtocol)
protected
/// SynLZ decompression + digital signature + encryption
function HandleInput(const input: RawByteString): RawByteString; override;
/// SynLZ compression + digital signature + encryption
function HandleOutput(const output: RawByteString): RawByteString; override;
public
end;
/// specify the class of a proxy/remote connection to any mormot.db.sql engine
TSqlDBProxyConnectionProtocolClass = class of TSqlDBProxyConnectionProtocol;
{ ************ Client-Side Proxy Remote Protocol }
type
/// implements a proxy-like virtual connection statement to a DB engine
// - will generate TSqlDBProxyConnection kind of connection
TSqlDBProxyConnectionPropertiesAbstract = class(TSqlDBConnectionProperties)
protected
fHandleConnection: boolean;
fProtocol: TSqlDBProxyConnectionProtocol;
fCurrentSession: integer;
fStartTransactionTimeOut: Int64;
/// abstract process of internal commands
// - one rough unique method is used, in order to make easier several
// implementation schemes and reduce data marshalling as much as possible
// - should raise an exception on error
// - returns the session ID (if any)
function Process(Command: TSqlDBProxyConnectionCommand;
const Input; var Output): integer; virtual; abstract;
/// calls Process(cGetToken) + Process(cGetDbms)
// - override this method and set fProtocol before calling inherited
procedure SetInternalProperties; override;
/// calls Process(cGetForeignKeys,self,fForeignKeys)
procedure GetForeignKeys; override;
public
/// will notify for proxy disconnection
destructor Destroy; override;
/// create a new TSqlDBProxyConnection instance
// - the caller is responsible of freeing this instance
function NewConnection: TSqlDBConnection; override;
/// retrieve the column/field layout of a specified table
// - calls Process(cGetFields,aTableName,Fields)
procedure GetFields(const aTableName: RawUtf8; out Fields: TSqlDBColumnDefineDynArray); override;
/// retrieve the advanced indexed information of a specified Table
// - calls Process(cGetIndexes,aTableName,Indexes)
procedure GetIndexes(const aTableName: RawUtf8; out Indexes: TSqlDBIndexDefineDynArray); override;
/// get all table names
// - this default implementation will use protected SqlGetTableNames virtual
// - calls Process(cGetTableNames,self,Tables)
procedure GetTableNames(out Tables: TRawUtf8DynArray); override;
/// determine if the SQL statement can be cached
// - always returns false, to force a new fake statement to be created
function IsCacheable(P: PUtf8Char): boolean; override;
published
/// Connect and Disconnect won't really connect nor disconnect the
// remote connection
// - you can set this property to TRUE if you expect the remote connection
// by in synch with the remote proxy connection (should not be used in
// most cases, unless you are sure you have only one single client at a time
property HandleConnection: boolean
read fHandleConnection write fHandleConnection;
/// milliseconds to way until StartTransaction is allowed by the server
// - in the current implementation, there should be a single transaction
// at once on the server side: this is the time to try before reporting
// an ESqlDBRemote exception failure
property StartTransactionTimeOut: Int64
read fStartTransactionTimeOut write fStartTransactionTimeOut;
end;
/// implements an abstract proxy-like virtual connection to a DB engine
// - can be used e.g. for remote access or execution in a background thread
TSqlDBProxyConnection = class(TSqlDBConnection)
protected
fConnected: boolean;
fProxy: TSqlDBProxyConnectionPropertiesAbstract;
function GetServerDateTime: TDateTime; override;
public
/// connect to a specified database engine
constructor Create(aProperties: TSqlDBConnectionProperties); override;
/// connect to the specified database
procedure Connect; override;
/// stop connection to the specified database
procedure Disconnect; override;
/// return TRUE if Connect has been already successfully called
function IsConnected: boolean; override;
/// initialize a new SQL query statement for the given connection
function NewStatement: TSqlDBStatement; override;
/// begin a Transaction for this connection
procedure StartTransaction; override;
/// commit changes of a Transaction for this connection
procedure Commit; override;
/// discard changes of a Transaction for this connection
procedure Rollback; override;
/// low-level direct access to the actual associated TSqlDBConnectionProperties
property Proxy: TSqlDBProxyConnectionPropertiesAbstract
read fProxy;
end;
/// implements a proxy-like virtual connection statement to a DB engine
// - abstract class, with no corresponding kind of connection, but allowing
// access to the mapped data via Column*() methods
// - will handle an internal binary buffer when the statement returned rows
// data, as generated by TSqlDBStatement.FetchAllToBinary()
TSqlDBProxyStatementAbstract = class(TSqlDBStatementWithParamsAndColumns)
protected
fDataRowCount: integer;
fDataRowReaderOrigin, fDataRowReader: PByte;
fDataRowNullSize: cardinal;
fDataCurrentRowNullLen: cardinal;
fDataCurrentRowNull: TByteDynArray;
fDataCurrentRowValues: array of pointer;
fDataCurrentRowValuesStart: pointer;
fDataCurrentRowValuesSize: cardinal;
// per-row column type (SQLite3 only) e.g. select coalesce(column,0) from ..
fDataCurrentRowColTypes: array of TSqlDBFieldType;
function InternalColumnType(Col: integer; out Data: PByte): TSqlDBFieldType;
{$ifdef HASINLINE}inline;{$endif}
procedure InternalHeaderProcess(Data: PByte; DataLen: PtrInt);
procedure InternalFillDataCurrent(
var Reader: PByte; IgnoreColumnDataSize: boolean);
public
/// the Column type of the current Row
function ColumnType(Col: integer;
FieldSize: PInteger = nil): TSqlDBFieldType; override;
/// returns TRUE if the column contains NULL
function ColumnNull(Col: integer): boolean; override;
/// return a Column integer value of the current Row, first Col is 0
function ColumnInt(Col: integer): Int64; override;
/// return a Column floating point value of the current Row, first Col is 0
function ColumnDouble(Col: integer): double; override;
/// return a Column floating point value of the current Row, first Col is 0
function ColumnDateTime(Col: integer): TDateTime; override;
/// return a Column currency value of the current Row, first Col is 0
// - should retrieve directly the 64 bit Currency content, to avoid
// any rounding/conversion error from floating-point types
function ColumnCurrency(Col: integer): currency; override;
/// return a Column UTF-8 encoded text value of the current Row, first Col is 0
function ColumnUtf8(Col: integer): RawUtf8; override;
/// return a Column text value as RTL string of the current Row, first Col is 0
function ColumnString(Col: integer): string; override;
/// return a Column as a blob value of the current Row, first Col is 0
function ColumnBlob(Col: integer): RawByteString; override;
/// return one column value into JSON content
procedure ColumnToJson(Col: integer; W: TJsonWriter); override;
/// direct access to the data buffer of the current row
// - points to Double/Currency value, or variable-length Int64/UTF-8/Blob
// - points to nil if the column value is NULL
function ColumnData(Col: integer): pointer;
/// append current row content as binary stream
// - will save one data row in optimized binary format (if not in Null)
// - virtual method called by FetchAllToBinary()
// - follows the format expected by TSqlDBProxyStatement
procedure ColumnsToBinary(W: TBufferWriter; Null: pointer;
const ColTypes: TSqlDBFieldTypeDynArray); override;
/// read-only access to the number of data rows stored
property DataRowCount: integer
read fDataRowCount;
end;
/// implements a proxy-like virtual connection statement to a DB engine
// - is generated by TSqlDBProxyConnection kind of connection
// - will use an internal binary buffer when the statement returned rows data,
// as generated by TSqlDBStatement.FetchAllToBinary() or JSON for
// ExecutePreparedAndFetchAllAsJson() method (as expected by our ORM)
TSqlDBProxyStatement = class(TSqlDBProxyStatementAbstract)
protected
fDataInternalCopy: RawByteString;
fUpdateCount: integer;
fForceNoUpdateCount: boolean;
procedure ParamsToCommand(var Input: TSqlDBProxyConnectionCommandExecute);
public
/// Execute a SQL statement
// - for TSqlDBProxyStatement, preparation and execution are processed in
// one step, when this method is executed - as such, Prepare() won't call
// the remote process, but will just set fSql
// - this overridden implementation will use out optimized binary format
// as generated by TSqlDBStatement.FetchAllToBinary(), and not JSON
procedure ExecutePrepared; override;
/// execute a prepared SQL statement and return all rows content as a JSON string
// - JSON data is retrieved with UTF-8 encoding
// - if Expanded is true, JSON output is a standard array of objects, for
// direct use with any Ajax or .NET client:
// & [{"f1":"1v1","f2":1v2},{"f2":"2v1","f2":2v2}...]
// - if Expanded is false, JSON data is serialized in non-expanded format:
// & {"fieldCount":2,"values":["f1","f2","1v1",1v2,"2v1",2v2...],"rowCount":20}
// resulting in lower space use and faster process - it could be parsed by
// TOrmTableJson or TDocVariantData.InitArrayFromResults
// - BLOB field value is saved as Base64, in the '"\uFFF0base64encodedbinary"'
// format and contains true BLOB data
// - this overridden implementation will use JSON for transmission, and
// binary encoding only for parameters (to avoid unneeded conversions, e.g.
// when called from mormot.orm.sql.pas)
procedure ExecutePreparedAndFetchAllAsJson(Expanded: boolean;
out Json: RawUtf8; ReturnedRowCount: PPtrInt = nil); override;
/// append all rows content as binary stream
// - will save the column types and name, then every data row in optimized
// binary format (faster and smaller than JSON)
// - you can specify a LIMIT for the data extent (default 0 meaning all data)
// - generates the format expected by TSqlDBProxyStatement
// - this overriden method will use the internal data copy of the binary
// buffer retrieved by ExecutePrepared, so would be almost immediate,
// and would allow e.g. direct consumption via our TSynSqlStatementDataSet
// - note that DataRowPosition won't be set by this method: will be done
// e.g. in TSqlDBProxyStatementRandomAccess.Create
function FetchAllToBinary(Dest: TStream; MaxRowCount: cardinal = 0;
DataRowPosition: PCardinalDynArray = nil): cardinal; override;
/// gets a number of updates made by latest executed statement
// - this overriden method will return the integer value returned by
// cExecute command
function UpdateCount: integer; override;
/// force no UpdateCount method call on server side
// - may be needed to reduce server load, if this information is not needed
property ForceNoUpdateCount: boolean
read fForceNoUpdateCount write fForceNoUpdateCount;
/// after a statement has been prepared via Prepare() + ExecutePrepared() or
// Execute(), this method must be called one or more times to evaluate it
function Step(SeekFirst: boolean = false): boolean; override;
end;
/// client-side implementation of a remote connection to any mormot.db.sql engine
// - will compute binary compressed messages for the remote processing,
// ready to be served e.g. over HTTP
// - abstract class which should override its protected ProcessMessage() method
// e.g. by TSqlDBRemoteConnectionPropertiesTest or
TSqlDBRemoteConnectionPropertiesAbstract = class(TSqlDBProxyConnectionPropertiesAbstract)
protected
/// will build and interpret binary messages to be served with ProcessMessage
// - would raise an exception in case of error, even on the server side
function Process(Command: TSqlDBProxyConnectionCommand;
const Input; var Output): integer; override;
/// abstract method to override for the expected transmission protocol
// - could raise an exception on transmission error
procedure ProcessMessage(const Input: RawUtf8; out Output: RawUtf8);
virtual; abstract;
end;
/// fake proxy class for testing the remote connection to any mormot.db.sql engine
// - resulting overhead due to our binary messaging: unnoticeable :)
TSqlDBRemoteConnectionPropertiesTest = class(TSqlDBRemoteConnectionPropertiesAbstract)
protected
fProps: TSqlDBConnectionProperties;
// this overriden method will just call fProtocol.RemoteProcessMessage()
procedure ProcessMessage(const Input: RawUtf8; out Output: RawUtf8); override;
public
/// create a test redirection to an existing local connection property
// - you can specify a User/Password credential pair to also test the
// authentication via TSynAuthentication
constructor Create(aProps: TSqlDBConnectionProperties;
const aUserID, aPassword: RawUtf8;
aProtocol: TSqlDBProxyConnectionProtocolClass); reintroduce;
end;
/// implements a virtual statement with direct data access
// - is generated with no connection, but allows direct random access to any
// data row retrieved from TSqlDBStatement.FetchAllToBinary() binary data
// - GotoRow() method allows direct access to a row data via Column*()
// - is used e.g. by TSynSqlStatementDataSet of SynDBVCL unit
TSqlDBProxyStatementRandomAccess = class(TSqlDBProxyStatementAbstract)
protected
fRowData: TCardinalDynArray;
fLastGotoRow: integer;
public
/// initialize the internal structure from a given memory buffer
// - by default, ColumnDataSize would be computed from the supplied data,
// unless you set IgnoreColumnDataSize=true to set the value to 0 (and
// force e.g. SynDBVCL TSynBinaryDataSet.InternalInitFieldDefs define the
// field as ftDefaultMemo)
constructor Create(Data: PByte; DataLen: integer;
DataRowPosition: PCardinalDynArray = nil;
IgnoreColumnDataSize: boolean = false); reintroduce;
/// Execute a prepared SQL statement
// - this unexpected overridden method will raise a ESqlDBRemote
procedure ExecutePrepared; override;
/// Change cursor position to the next available row
// - this unexpected overridden method will raise a ESqlDBRemote
function Step(SeekFirst: boolean = false): boolean; override;
/// change the current data Row
// - if Index<DataRowCount, returns TRUE and you can access to the data
// via regular Column*() methods
// - can optionally raise an ESqlDBRemote if Index is not correct
function GotoRow(Index: integer;
RaiseExceptionOnWrongIndex: boolean = false): boolean;
/// search for a value within the internal binary stream
// - used to implement e.g. TDataSet.Locate
function ColumnSearch(Col: integer; const Value: variant;
CaseInsensitive: boolean): integer;
end;
{ ************ HTTP Server Classes for Remote Access }
const
/// default HTTP port to be used for mormot.db.proxy remote access if none is specified
SYNDB_DEFAULT_HTTP_PORT = '8092';
type
/// used to define the HTTP server class for publishing a mormot.db.proxy connection
TSqlDBServerClass = class of TSqlDBServerAbstract;
/// implements a generic HTTP server, able to publish any mormot.db.proxy connection
// - do not instantiate this class, but rather use TSqlDBServerHttpApi or
// TSqlDBServerSockets - this abstract class won't set any HTTP server
TSqlDBServerAbstract = class
protected
fServer: THttpServerGeneric;
fThreadPoolCount: integer;
fPort, fDatabaseName: RawUtf8;
fHttps: boolean;
fProperties: TSqlDBConnectionProperties;
fProtocol: TSqlDBProxyConnectionProtocol;
fSafe: TSynLocker;
fProcessLocked: boolean;
// this is where the process would take place
function Process(Ctxt: THttpServerRequestAbstract): cardinal;
public
/// publish the mormot.db.sql connection on a given HTTP port and URI
// - this generic constructor won't initialize the HTTP server itself:
// use overriden constructors instead
// - URI would follow the supplied aDatabaseName parameter on the given port
// e.g. http://serverip:8092/remotedb for
// ! Create(aProps,'remotedb');
// - you can optionally register one user credential, or change the
// transmission Protocol which is TSqlDBRemoteConnectionProtocol by default
// - aProperties.ThreadingMode will be set to the optional aThreadMode
// parameter tmMainConnection by default, which would also set ProcessLocked
// to TRUE - in fact, you should better use a single thread for the process,
// but you may define a small thread pool for the process IF the provider
// supports it
constructor Create(aProperties: TSqlDBConnectionProperties;
const aDatabaseName: RawUtf8; const aPort: RawUtf8 = SYNDB_DEFAULT_HTTP_PORT;
const aUserName: RawUtf8 = ''; const aPassword: RawUtf8 = '';
aHttps: boolean = false; aThreadPoolCount: integer = 1;
aProtocol: TSqlDBProxyConnectionProtocolClass = nil;
aThreadMode: TSqlDBConnectionPropertiesThreadSafeThreadingMode = tmMainConnection;
aAuthenticate: TSynAuthenticationAbstract = nil); virtual;
/// released used memory
destructor Destroy; override;
/// the associated database connection properties
property Properties: TSqlDBConnectionProperties
read fProperties write fProperties;
/// the associated port number
property Port: RawUtf8
read fPort;
/// the associated database name
property DatabaseName: RawUtf8
read fDatabaseName;
/// the associated communication protocol
// - to manage user authentication, use AuthenticateUser/DisauthenticateUser
// methods of Protocol.Authenticate
property Protocol: TSqlDBProxyConnectionProtocol
read fProtocol write fProtocol;
/// if the internal Process() method would be protected by a critical section
// - set to TRUE if constructor's aThreadMode is left to its default
// tmMainConnection value
property ProcessLocked: boolean
read fProcessLocked write fProcessLocked;
end;
/// implements a mormot.db.proxy HTTP server via the user-land Sockets API
TSqlDBServerSockets = class(TSqlDBServerAbstract)
protected
public
/// publish the mormot.db.sql connection on a given HTTP port and URI using sockets
// - URI would follow the supplied aDatabaseName parameter on the given port
// e.g. http://serverip:8092/remotedb for
// ! Create(aProps,'remotedb');
// - you can optionally register one user credential
// - parameter aHttps is ignored by this class
// - is implemented via a THttpServer instance, which will maintain one
// thread per client connection, which is as expected by some DB drivers,
// e.g. for transaction consistency
constructor Create(aProperties: TSqlDBConnectionProperties;
const aDatabaseName: RawUtf8; const aPort: RawUtf8 = SYNDB_DEFAULT_HTTP_PORT;
const aUserName: RawUtf8 = ''; const aPassword: RawUtf8 = '';
aHttps: boolean = false; aThreadPoolCount: integer = 1;
aProtocol: TSqlDBProxyConnectionProtocolClass = nil;
aThreadMode: TSqlDBConnectionPropertiesThreadSafeThreadingMode = tmMainConnection;
aAuthenticate: TSynAuthenticationAbstract = nil); override;
end;
{$ifdef USEHTTPSYS}
/// implements a mormot.db.proxy HTTP server using fast http.sys kernel-mode server
// - under Windows, this class may be more integrated with the operating system
// than plain TSqlDBServerSockets
TSqlDBServerHttpApi = class(TSqlDBServerAbstract)
protected
public
/// publish the mormot.db.sql connection on a given HTTP port and URI using http.sys
// - URI would follow the supplied aDatabaseName parameter on the given port
// e.g. http://serverip:8092/remotedb for
// ! Create(aProps,'remotedb');
// - you can optionally register one user credential
constructor Create(aProperties: TSqlDBConnectionProperties;
const aDatabaseName: RawUtf8; const aPort: RawUtf8 = SYNDB_DEFAULT_HTTP_PORT;
const aUserName: RawUtf8 = ''; const aPassword: RawUtf8 = '';
aHttps: boolean = false; aThreadPoolCount: integer = 1;
aProtocol: TSqlDBProxyConnectionProtocolClass = nil;
aThreadMode: TSqlDBConnectionPropertiesThreadSafeThreadingMode = tmMainConnection;
aAuthenticate: TSynAuthenticationAbstract = nil); override;
end;
{$endif USEHTTPSYS}
/// the default mormot.db.proxy HTTP server class on each platform
// - won't default to TSqlDBServerHttpApi on Windows, because even if this
// class seems more "native", it won't maintain one thread per client
TSqlDBServerRemote = TSqlDBServerSockets;
{ ************ HTTP Client Classes for Remote Access }
type
/// implements a generic HTTP client, able to access remotely any mormot.db.sql
// - do not instantiate this class, but rather use TSqlDBSocketConnectionProperties
// TSqlDBWinHttpConnectionProperties TSqlDBWinINetConnectionProperties
TSqlDBHttpConnectionPropertiesAbstract = class(TSqlDBRemoteConnectionPropertiesAbstract)
protected
fKeepAliveMS: cardinal;
fUri: TUri;
function GetServer: RawByteString;
{$ifdef HASINLINE}inline;{$endif}
function GetPort: RawByteString;
{$ifdef HASINLINE}inline;{$endif}
/// you could inherit from it and set your custom fProtocol instance
procedure SetInternalProperties; override;
procedure SetServerName(const aServerName: RawUtf8);
// this overriden method will just call InternalRequest
procedure ProcessMessage(const Input: RawUtf8; out Output: RawUtf8); override;
/// to be overriden to process low-level HTTP/1.1 request
function InternalRequest(var Data, DataType: RawByteString): integer; virtual; abstract;
published
/// the associated server IP address or name
property Server: RawByteString
read GetServer;
/// the associated port number
property Port: RawByteString
read GetPort;
/// time (in milliseconds) to keep the connection alive with the server
// - default is 60000, i.e. one minute
property KeepAliveMS: cardinal
read fKeepAliveMS write fKeepAliveMS;
end;
/// implements a HTTP client via sockets, able to access remotely any mormot.db.sql
TSqlDBSocketConnectionProperties = class(TSqlDBHttpConnectionPropertiesAbstract)
protected
fSocket: THttpClientSocket;
function InternalRequest(var Data, DataType: RawByteString): integer; override;
public
/// initialize the properties for remote access via HTTP using sockets
// - aServerName should be the HTTP server address as 'server:port'
// - aDatabaseName would be used to compute the URI as in TSqlDBServerAbstract
// - the user/password credential should match server-side authentication
constructor Create(const aServerName, aDatabaseName, aUserID,aPassWord: RawUtf8); override;
/// released used memory
destructor Destroy; override;
/// low-level direct access to the Socket implementation instance
property Socket: THttpClientSocket
read fSocket;
end;
{$ifdef USEHTTPREQUEST}
/// implements an abstract HTTP client via THttpRequest abstract class,
// able to access remotely any mormot.db.sql
// - never instantiate this class, but rather TSqlDBWinHttpConnectionProperties
// or TSqlDBWinINetConnectionProperties
TSqlDBHttpRequestConnectionProperties = class(TSqlDBHttpConnectionPropertiesAbstract)
protected
fClient: THttpRequest;
function InternalRequest(var Data, DataType: RawByteString): integer; override;
public
/// released used memory
destructor Destroy; override;
/// low-level direct access to the WinHttp implementation instance
property Client: THttpRequest
read fClient;
end;
{$endif USEHTTPREQUEST}
{$ifdef USELIBCURL}
/// implements a HTTP client via the libcurl API, able to access remotely
// any mormot.db.sql
TSqlDBCurlConnectionProperties = class(TSqlDBHttpRequestConnectionProperties)
public
/// initialize the properties for remote access via HTTP using libcurl
// - aServerName should be the HTTP server address as 'server:port'
// - aDatabaseName would be used to compute the URI as in TSqlDBServerAbstract
// - the user/password credential should match server-side authentication
constructor Create(const aServerName,aDatabaseName, aUserID,aPassWord: RawUtf8); override;
end;
{$endif USELIBCURL}
{$ifdef USEWININET}
/// implements a HTTP client via WinHttp API, able to access remotely
// any mormot.db.sql
TSqlDBWinHttpConnectionProperties = class(TSqlDBHttpRequestConnectionProperties)
public
/// initialize the properties for remote access via HTTP using WinHttp
// - aServerName should be the HTTP server address as 'server:port'
// - aDatabaseName would be used to compute the URI as in TSqlDBServerAbstract
// - the user/password credential should match server-side authentication
constructor Create(const aServerName,aDatabaseName, aUserID,aPassWord: RawUtf8); override;
end;
/// implements a HTTP client via WinINet API, able to access remotely
// any mormot.db.sql
TSqlDBWinINetConnectionProperties = class(TSqlDBHttpRequestConnectionProperties)
public
/// initialize the properties for remote access via HTTP using WinINet
// - aServerName should be the HTTP server address as 'server:port'
// - aDatabaseName would be used to compute the URI as in TSqlDBServerAbstract
// - the user/password credential should match server-side authentication
constructor Create(const aServerName,aDatabaseName, aUserID,aPassWord: RawUtf8); override;
end;
{$endif USEWININET}
implementation
{ ************ Shared Proxy Information }
function ToText(cmd: TSqlDBProxyConnectionCommand): PShortString;
begin
result := GetEnumName(TypeInfo(TSqlDBProxyConnectionCommand), ord(cmd));
end;
{ ************ Server-Side Proxy Remote Protocol }
const
REMOTE_MAGIC = 1;
type
TRemoteMessageHeader = packed record
Magic: byte;
SessionID: integer;
Command: TSqlDBProxyConnectionCommand;
end;
PRemoteMessageHeader = ^TRemoteMessageHeader;
constructor TSqlDBProxyConnectionProtocol.Create(
aAuthenticate: TSynAuthenticationAbstract);
begin
fAuthenticate := aAuthenticate;
fTransactionRetryTimeout := 100;
fTransactionActiveTimeout := 120000; // after 2 minutes, clear any transaction
fSafe.Init;
end;
function TSqlDBProxyConnectionProtocol.GetAuthenticate: TSynAuthenticationAbstract;
begin
if self = nil then
result := nil
else
result := fAuthenticate;
end;
function TSqlDBProxyConnectionProtocol.HandleInput(
const input: RawByteString): RawByteString;
begin
result := input;
end;
function TSqlDBProxyConnectionProtocol.HandleOutput(
const output: RawByteString): RawByteString;
begin
result := output;
end;
function TSqlDBProxyConnectionProtocol.TransactionStarted(
connection: TSqlDBConnection; sessionID: integer): boolean;
var
tixend, tix: Int64;
begin
if sessionID = 0 then
ESqlDBRemote.RaiseUtf8(
'%.TransactionStarted: Remote transaction expects authentication/session',
[self]);
if connection.Properties.InheritsFrom(TSqlDBConnectionPropertiesThreadSafe) and
(TSqlDBConnectionPropertiesThreadSafe(connection.Properties).
ThreadingMode = tmThreadPool) then
ESqlDBRemote.RaiseUtf8(
'%.TransactionStarted: Remote transaction expects %.ThreadingMode<>tmThreadPool: ' +
'commit/execute/rollback should be in the same thread/connection',
[self, connection.Properties]);
tix := GetTickCount64;
tixend := tix + fTransactionRetryTimeout;
repeat
fSafe.Lock;
try
if (fTransactionActiveAutoReleaseTicks <> 0) and
(tix > fTransactionActiveAutoReleaseTicks) then
try
connection.Rollback;
finally
fTransactionSessionID := 0;
fTransactionActiveAutoReleaseTicks := 0;
end;
result := fTransactionSessionID = 0;
if result then
begin
fTransactionSessionID := sessionID;
fTransactionActiveAutoReleaseTicks := tix + fTransactionActiveTimeout;
connection.StartTransaction;
end;
finally
fSafe.UnLock;
end;
if result or
(tix > tixend) then
break;
SleepHiRes(1);
tix := GetTickCount64;
until tix > tixend;
end;
procedure TSqlDBProxyConnectionProtocol.TransactionEnd(sessionID: integer);
begin
if sessionID = 0 then
ESqlDBRemote.RaiseUtf8(
'%: Remote transaction expects authentication/session', [self]);
fSafe.Lock;
try
if sessionID <> fTransactionSessionID then
ESqlDBRemote.RaiseUtf8('Invalid %.TransactionEnd(%) - expected %',
[self, sessionID, fTransactionSessionID]);
fTransactionSessionID := 0;
fTransactionActiveAutoReleaseTicks := 0;
finally
fSafe.UnLock;
end;
end;
destructor TSqlDBProxyConnectionProtocol.Destroy;
begin
fAuthenticate.Free;
fSafe.Done;
inherited Destroy;
end;
function TSqlDBRemoteConnectionProtocol.HandleInput(
const input: RawByteString): RawByteString;
begin
result := input;
SymmetricEncrypt(REMOTE_MAGIC, result);
result := AlgoSynLZ.Decompress(result); // also check crc32c
end;
function TSqlDBRemoteConnectionProtocol.HandleOutput(
const output: RawByteString): RawByteString;
begin
result := AlgoSynLZ.Compress(output); // includes cr32c hashing
SymmetricEncrypt(REMOTE_MAGIC, result);
end;
procedure TSqlDBProxyConnectionProtocol.RemoteProcessMessage(
const Input: RawUtf8; out Output: RawUtf8; Connection: TSqlDBConnection);
var
stmt: ISqlDBStatement;
data: TRawByteStringStream;
msgin, msgout: RawUtf8;
header: PRemoteMessageHeader;
P: PAnsiChar;
i, session: integer;
user: RawUtf8;
exec: TSqlDBProxyConnectionCommandExecute;
execwithres: boolean;
colarr: TSqlDBColumnDefineDynArray;
defarr: TSqlDBIndexDefineDynArray;
outarr: TRawUtf8DynArray;
procedure AppendOutput(value: Int64);
var
len: PtrInt;
begin
len := Length(msgout);
SetLength(msgout, len + SizeOf(Int64));
PInt64(@PByteArray(msgout)[len])^ := value;
end;
begin
// follow TSqlDBRemoteConnectionPropertiesAbstract.Process binary layout
if self = nil then
raise ESqlDBRemote.Create('RemoteProcessMessage: unexpected self=nil');
if Connection = nil then
ESqlDBRemote.RaiseUtf8(
'%.RemoteProcessMessage(connection=nil)', [self]);
msgin := HandleInput(Input);
header := pointer(msgin);
if (header = nil) or
(header.Magic <> REMOTE_MAGIC) then
ESqlDBRemote.RaiseUtf8(
'Incorrect %.RemoteProcessMessage() input magic/version', [self]);
if (Authenticate <> nil) and
(Authenticate.UsersCount > 0) and
not (header.Command in [cGetToken, cGetDbms]) then
if not Authenticate.SessionExists(header.SessionID) then
raise ESqlDBRemote.Create('You do not have the right to be here');
P := pointer(msgin);
inc(P, SizeOf(header^));
try
FastSetString(msgout, pointer(msgin), SizeOf(header^));
case header.Command of
cGetToken:
AppendOutput(Authenticate.CurrentToken);
cGetDbms:
begin
session := 0;
if (Authenticate <> nil) and
(Authenticate.UsersCount > 0) then
begin
GetNextItem(PUtf8Char(P), #1, user);
session := Authenticate.CreateSession(user, PCardinal(P)^);
if session = 0 then
ESqlDBRemote.RaiseUtf8('%.RemoteProcessMessage: ' +
'CreateSession failed - check connection and User/Password',
[self]);
end;
PRemoteMessageHeader(msgout)^.sessionID := session;
Append(msgout, AnsiChar(Connection.Properties.Dbms));
end;
cConnect:
Connection.Connect;
cDisconnect:
Connection.Disconnect;
cTryStartTransaction:
Append(msgout, AnsiChar(TransactionStarted(Connection, header.SessionID)));
cCommit:
begin
TransactionEnd(header.SessionID);
Connection.Commit;
end;
cRollback:
begin
TransactionEnd(header.SessionID);
Connection.Rollback;
end;
cServerTimestamp:
AppendOutput(Connection.ServerTimestamp);
cGetFields:
begin
Connection.Properties.GetFields(P, colarr);
Append(msgout, DynArraySave(
colarr, TypeInfo(TSqlDBColumnDefineDynArray)));
end;
cGetIndexes:
begin
Connection.Properties.GetIndexes(P, defarr);
Append(msgout, DynArraySave(
defarr, TypeInfo(TSqlDBIndexDefineDynArray)));
end;
cGetTableNames:
begin
Connection.Properties.GetTableNames(outarr);
Append(msgout, DynArraySave(
outarr, TypeInfo(TRawUtf8DynArray)));
end;
cGetForeignKeys:
begin
Connection.Properties.GetForeignKey('', ''); // ensure Dest.fForeignKeys exists
Append(msgout, Connection.Properties.ForeignKeysData);
end;
cExecute,
cExecuteToBinary,
cExecuteToJson,
cExecuteToExpandedJson:
begin
RecordLoad(exec, P, TypeInfo(TSqlDBProxyConnectionCommandExecute),
nil, PAnsiChar(pointer(msgin)) + length(msgin));
execwithres := header.Command <> cExecute;
stmt := Connection.NewStatementPrepared(exec.Sql,
execwithres, true);
if fBlobAsNull in exec.Force then
stmt.ForceBlobAsNull := true;
if fDateWithMS in exec.Force then
stmt.ForceDateWithMS := true;
for i := 1 to Length(exec.Params) do
with exec.Params[i - 1] do
if exec.ArrayCount = 0 then
case VType of
ftNull:
stmt.BindNull(i, VInOut);
ftInt64:
stmt.Bind(i, VInt64, VInOut);
ftDouble:
stmt.Bind(i, unaligned(PDouble(@VInt64)^), VInOut);
ftCurrency:
stmt.Bind(i, PCurrency(@VInt64)^, VInOut);
ftDate: