forked from superflexible/TGPuttyLib
-
Notifications
You must be signed in to change notification settings - Fork 0
/
tgputtysftp.pas
1090 lines (937 loc) · 35.8 KB
/
tgputtysftp.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
unit tgputtysftp;
{$ifdef FPC}{$MODE Delphi}{$endif}
interface
uses {$ifdef SFFS}TGGlobal,Basics,{$endif}
{$ifdef MSWINDOWS}Windows,{$endif}
Classes, SysUtils, DateUtils, SyncObjs,
tgputtylib;
{$ifndef FPC}
{$ifdef CONDITIONALEXPRESSIONS}
{$if CompilerVersion >= 27.0}
{$define HASUTCPARAM}
{$ifend}
{$endif}
{$endif}
const MinimumLibraryBuildNum=8;
cDummyClearedErrorCode=-1000; // this error code means there was no real error code
cConfCount=84; // 84 since PuTTY version 0.74, previously 83
cDumpSettingsFile=false;
type TGPuttySFTPException=class(Exception);
TOnMessage=procedure(const Msg:AnsiString;const isstderr:Boolean) of object;
TOnCheckpoint=procedure(const Msg:AnsiString;const kind:Byte) of object;
TOnProgress=function(const bytescopied:Int64;const isupload:Boolean):Boolean of object;
TOnListing=function(const names:Pfxp_names):Boolean of object;
TOnGetInput=function(var cancel:Boolean):AnsiString of object;
TOnVerifyHostKey=function(const host:PAnsiChar;const port:Integer;
const fingerprint:PAnsiChar;
const verificationstatus:Integer;
var storehostkey:Boolean):Boolean of object;
TConfIntArray=array[0..cConfCount-1] of Integer;
TConfPAnsiCharArray=array[0..cConfCount-1] of PAnsiChar;
PConfIntArray=^TConfIntArray;
PConfPAnsiCharArray=^TConfPAnsiCharArray;
{ TTGPuttySFTP }
TTGPuttySFTP=class(TObject)
private
Fcontext:TTGLibraryContext;
FVerbose,FCheckpoints:Boolean;
FHostName,FUserName,FPassword,FKeyPassword:AnsiString;
FPort:Integer;
FOnMessage: TOnMessage;
FOnCheckpoint: TOnCheckpoint;
FOnProgress: TOnProgress;
FOnListing: TOnListing;
FOnGetInput: TOnGetInput;
FOnVerifyHostKey: TOnVerifyHostKey;
FUploadStream,
FDownloadStream:TStream;
FConnected:Boolean;
FPasswordAttempts:Integer;
FLastMessages:AnsiString;
FConfNames:PConfPAnsiCharArray;
FConfTypes:PConfIntArray;
FConfSubTypes:PConfIntArray;
FConfCount:Integer;
FProgressIntervalMS:Integer;
FProgressAfterBytes:Int64;
function GetHomeDir: AnsiString;
function GetWorkDir: AnsiString;
procedure SetVerbose(const Value: Boolean);
procedure SetCheckpoints(const Value: Boolean);
procedure SetKeyfile(const Value: AnsiString);
function GetLibVersion: AnsiString;
function GetErrorCode: Integer;
function GetErrorMessage: AnsiString;
function GetAborted: Boolean;
function GetConnectionTimeoutTicks: Integer;
function GetTimeoutTicks: Integer;
procedure SetAborted(const Value: Boolean);
procedure SetConnectionTimeoutTicks(const Value: Integer);
procedure SetTimeoutTicks(const Value: Integer);
procedure DumpSettingsFile;
procedure CreateConfigIndex;
function GetProxyType: TProxyTypes;
function GetProxyHost: AnsiString;
function GetProxyPassword: AnsiString;
function GetProxyUserName: AnsiString;
function GetProxyPort: Integer;
procedure SetProxyType(const Value: TProxyTypes);
procedure SetProxyHost(const Value: AnsiString);
procedure SetProxyPassword(const Value: AnsiString);
procedure SetProxyUserName(const Value: AnsiString);
procedure SetProxyPort(const Value: Integer);
procedure CP(const ACP:AnsiString);
public
tgputtylibbuild:Integer;
constructor Create(const verbose:Boolean);
destructor Destroy; override;
function MakePSFTPErrorMsg(const where:string):string;
function GetPuttyConfIndex(const name:string):Integer;
procedure Connect;
procedure Disconnect;
procedure ChangeDir(const ADirectory:AnsiString);
procedure MakeDir(const ADirectory:AnsiString);
procedure RemoveDir(const ADirectory:AnsiString);
procedure ListDir(const ADirectory:AnsiString);
procedure GetStat(const AFileName:AnsiString;out Attrs:fxp_attrs);
procedure SetStat(const AFileName:AnsiString;const Attrs:fxp_attrs);
procedure SetModifiedDate(const AFileName:AnsiString;const ATimestamp:TDateTime; const isUTC:Boolean);
procedure SetFileSize(const AFileName:AnsiString;const ASize:Int64);
procedure SetUnixMode(const AFileName:AnsiString;const AMode:Integer);
procedure Move(const AFromName,AToName:AnsiString);
procedure MoveEx(const AFromName,AToName:AnsiString;const MoveFlags:Integer);
procedure DeleteFile(const AName:AnsiString);
procedure UploadFile(const ALocalFilename,ARemoteFilename:AnsiString;const anAppend:Boolean);
procedure DownloadFile(const ARemoteFilename,ALocalFilename:AnsiString;const anAppend:Boolean);
procedure UploadStream(const ARemoteFilename:AnsiString;const AStream:TStream; const anAppend:Boolean);
procedure DownloadStream(const ARemoteFilename:AnsiString;const AStream:TStream; const anAppend:Boolean);
procedure DownloadStreamP(const ARemoteFilename:AnsiString;const AStream:TStream; const anAppend:Boolean);
function OpenFile(const apathname:AnsiString;
const anopenflags:Integer;
const attrs:Pfxp_attrs):TSFTPFileHandle;
function CloseFile(var fh:TSFTPFileHandle):Integer;
function xfer_upload_init(const fh:TSFTPFileHandle;const offset:UInt64):TSFTPTransfer;
function xfer_upload_ready(const xfer:TSFTPTransfer):Boolean;
procedure xfer_upload_data(const xfer:TSFTPTransfer;const buffer:Pointer;
const len:Integer;const anoffset:UInt64);
function xfer_download_init(const fh:TSFTPFileHandle;const offset:UInt64):TSFTPTransfer;
function xfer_download_preparequeue(const xfer:TSFTPTransfer):Boolean;
function xfer_download_data(const xfer:TSFTPTransfer;var buffer:PByte; var len:Int32):Boolean;
procedure xfer_set_error(const xfer:TSFTPTransfer);
function xfer_ensuredone(const xfer:TSFTPTransfer):Boolean;
function xfer_done(const xfer:TSFTPTransfer):Boolean;
procedure xfer_cleanup(const xfer:TSFTPTransfer);
procedure SetBooleanConfigValue(const OptionName:AnsiString;const OptionValue:Boolean);
property HostName:AnsiString read FHostName write FHostName;
property UserName:AnsiString read FUserName write FUserName;
property Port:Integer read FPort write FPort;
property Password:AnsiString read FPassword write FPassword;
property KeyPassword:AnsiString read FKeyPassword write FKeyPassword;
property HomeDir:AnsiString read GetHomeDir;
property WorkDir:AnsiString read GetWorkDir;
property LibVersion:AnsiString read GetLibVersion;
property Connected:Boolean read FConnected;
property Verbose:Boolean read FVerbose write SetVerbose;
property Checkpoints:Boolean read FCheckpoints write SetCheckpoints;
property Keyfile:AnsiString write SetKeyfile;
property LastMessages:AnsiString read FLastMessages write FLastMessages;
property ErrorCode:Integer read GetErrorCode;
property ErrorMessage:AnsiString read GetErrorMessage;
property TimeoutTicks:Integer read GetTimeoutTicks write SetTimeoutTicks;
property ConnectionTimeoutTicks:Integer read GetConnectionTimeoutTicks write SetConnectionTimeoutTicks;
property Aborted:Boolean read GetAborted write SetAborted;
property ProxyType:TProxyTypes read GetProxyType write SetProxyType;
property ProxyHost:AnsiString read GetProxyHost write SetProxyHost;
property ProxyPort:Integer read GetProxyPort write SetProxyPort;
property ProxyUserName:AnsiString read GetProxyUserName write SetProxyUserName;
property ProxyPassword:AnsiString read GetProxyPassword write SetProxyPassword;
property ProgressIntervalMS:Integer read FProgressIntervalMS write FProgressIntervalMS;
property ProgressAfterBytes:Int64 read FProgressAfterBytes write FProgressAfterBytes;
property OnMessage:TOnMessage read FOnMessage write FOnMessage;
property OnCheckpoint:TOnCheckpoint read FOnCheckpoint write FOnCheckpoint;
property OnProgress:TOnProgress read FOnProgress write FOnProgress;
property OnListing:TOnListing read FOnListing write FOnListing;
property OnGetInput:TOnGetInput read FOnGetInput write FOnGetInput;
property OnVerifyHostKey:TOnVerifyHostKey read FOnVerifyHostKey write FOnVerifyHostKey;
end;
implementation
var GPuttyConfigIndex:tStringList;
GPuttyConfigCS:TCriticalSection;
function ls_callback(const names:Pfxp_names;const libctx:PTGLibraryContext):Boolean; cdecl;
var TGPSFTP:TTGPuttySFTP;
begin
TGPSFTP:=TTGPuttySFTP(libctx.Tag);
if Assigned(TGPSFTP.OnListing) then
Result:=TGPSFTP.OnListing(names)
else
Result:=true;
end;
function getpassword_callback(const prompt:PAnsiChar;const echo:Boolean;const cancel:System.PBoolean;const libctx:PTGLibraryContext):PAnsiChar; cdecl;
var TGPSFTP:TTGPuttySFTP;
begin
Result:=nil;
TGPSFTP:=TTGPuttySFTP(libctx.Tag);
Inc(TGPSFTP.FPasswordAttempts);
if TGPSFTP.FPasswordAttempts>3 then begin
cancel^:=true;
if Assigned(TGPSFTP.OnMessage) then
TGPSFTP.OnMessage(AnsiString('Password was rejected, or no password given for ')+prompt+AnsiString('.')+sLineBreak,true);
end
else begin
if System.Pos(AnsiString('Passphrase for key'),AnsiString(prompt))>0 then
Result:=PAnsiChar(TGPSFTP.KeyPassword)
else
Result:=PAnsiChar(TGPSFTP.Password);
cancel^:=false;
end;
end;
procedure printmessage_callback(const msg:PAnsiChar;const kind:Byte;const libctx:PTGLibraryContext); cdecl;
var TGPSFTP:TTGPuttySFTP;
begin
TGPSFTP:=TTGPuttySFTP(libctx.Tag);
if kind=2 then begin
if Assigned(TGPSFTP.OnCheckpoint) then
TGPSFTP.OnCheckpoint(msg,kind);
end
else begin
if Assigned(TGPSFTP.OnMessage) then
TGPSFTP.OnMessage(msg,kind=1);
TGPSFTP.LastMessages:=TGPSFTP.LastMessages+msg;
end;
end;
function progress_callback(const bytescopied:Int64;const isupload:Boolean;const libctx:PTGLibraryContext):Boolean; cdecl;
var TGPSFTP:TTGPuttySFTP;
begin
TGPSFTP:=TTGPuttySFTP(libctx.Tag);
if Assigned(TGPSFTP.OnProgress) then
Result:=TGPSFTP.OnProgress(bytescopied,isupload)
else
Result:=true;
end;
function get_input_callback(linebuf:PAnsiChar;const maxchars:Integer;const libctx:PTGLibraryContext):Boolean; cdecl;
var line:AnsiString;
TGPSFTP:TTGPuttySFTP;
cancel:Boolean;
begin
TGPSFTP:=TTGPuttySFTP(libctx.Tag);
cancel:=false;
if Assigned(TGPSFTP.OnGetInput) then begin
line:=TGPSFTP.OnGetInput(cancel);
Result:=not cancel;
end
else
try
Write('Your Input: ');
ReadLn(line);
Result:=true;
except
raise Exception.Create('No input method available');
end;
if Result then begin
if Length(line)>maxchars then
SetLength(line,maxchars);
if line>'' then begin
Move(line[1],linebuf^,maxchars);
linebuf[Length(line)]:=#0;
end
else
linebuf^:=#0;
end;
end;
function read_from_stream(const offset:UInt64;const buffer:Pointer;const bufsize:Integer;const libctx:PTGLibraryContext):Integer; cdecl;
var TGPSFTP:TTGPuttySFTP;
begin
TGPSFTP:=TTGPuttySFTP(libctx.Tag);
if Assigned(TGPSFTP.FUploadStream) then begin
TGPSFTP.FUploadStream.Position:=Offset;
Result:=TGPSFTP.FUploadStream.Read(buffer^,bufsize);
end
else
Result:=0;
end;
function write_to_stream(const offset:UInt64;const buffer:Pointer;const bufsize:Integer;const libctx:PTGLibraryContext):Integer; cdecl;
var TGPSFTP:TTGPuttySFTP;
begin
TGPSFTP:=TTGPuttySFTP(libctx.Tag);
if Assigned(TGPSFTP.FDownloadStream) then begin
TGPSFTP.FDownloadStream.Position:=Offset;
Result:=TGPSFTP.FDownloadStream.Write(buffer^,bufsize);
if Assigned(TGPSFTP.OnProgress) then
TGPSFTP.OnProgress(Int64(Offset)+bufsize,false);
end
else
Result:=0;
end;
procedure raise_exception_callback(const msg:PAnsiChar;const srcfile:PAnsiChar;const line:Integer;const libctx:PTGLibraryContext); cdecl;
begin
{$ifdef SFFS}
if IndyLogging then begin
WriteLn(IndyLog,'NOW RAISING TTGPuttySFTP exception '+AnsiString(msg)+' at line '+
AnsiString(IntToStr(line))+' in '+AnsiString(srcfile));
CloseFile(IndyLog);
Append(IndyLog);
if Logging then begin
WriteLn(LogFile,'NOW RAISING TTGPuttySFTP exception '+
AnsiString(msg)+' at line '+
AnsiString(IntToStr(line))+' in '+AnsiString(srcfile));
CloseFile(LogFile);
Append(LogFile);
end;
end;
{$endif}
raise TGPuttySFTPException.Create('TTGPuttySFTP exception '+
{$ifdef UNICODE}Utf8ToString{$endif}(AnsiString(msg))+
' at line '+
IntToStr(line)+
' in '+
{$ifdef UNICODE}Utf8ToString{$endif}(AnsiString(srcfile)));
end;
function verify_host_key_callback(const host:PAnsiChar;const port:Integer;const keytype:PAnsiChar;
const keystr:PAnsiChar;const fingerprint:PAnsiChar;
const verificationstatus:Integer;const storehostkey:System.PBoolean;
const libctx:PTGLibraryContext):Boolean; cdecl;
var TGPSFTP:TTGPuttySFTP;
begin
TGPSFTP:=TTGPuttySFTP(libctx.Tag);
if Assigned(TGPSFTP.OnVerifyHostKey) then
Result:=TGPSFTP.OnVerifyHostKey(host,port,fingerprint,verificationstatus,storehostkey^)
else
Result:=false;
end;
{ TTGPuttySFTP }
procedure TTGPuttySFTP.CP(const ACP:AnsiString);
begin
if Assigned(OnCheckpoint) then
OnCheckpoint(ACP,2);
end;
procedure TTGPuttySFTP.ChangeDir(const ADirectory: AnsiString);
var res:Integer;
begin
FLastMessages:='';
Fcontext.fxp_errtype:=cDummyClearedErrorCode; // "clear" error field
res:=tgsftp_cd(PAnsiChar(ADirectory),@Fcontext);
if res<>1 then // 1 = success
raise TGPuttySFTPException.Create(MakePSFTPErrorMsg('tgsftp_cd'));
end;
function TTGPuttySFTP.CloseFile(var fh: TSFTPFileHandle): Integer;
begin
Result:=tgputty_closefile(@fh,@Fcontext);
end;
procedure TTGPuttySFTP.Connect;
var res:Integer;
begin
FPasswordAttempts:=0;
FLastMessages:='';
Fcontext.fxp_errtype:=cDummyClearedErrorCode; // "clear" error field
res:=tgsftp_connect(PAnsiChar(FHostName),PAnsiChar(FUserName),FPort,PAnsiChar(FPassword),@Fcontext);
FConnected:=res=0; // 0 = success
if not FConnected then
raise TGPuttySFTPException.Create(MakePSFTPErrorMsg('tgsftp_connect'));
end;
constructor TTGPuttySFTP.Create(const verbose:Boolean);
var puttyversion:Double;
begin
if not TGPuttyLibAvailable then
raise Exception.Create('TGPuttyLib is not available');
tgputtygetversions(@puttyversion,@tgputtylibbuild);
if tgputtylibbuild<MinimumLibraryBuildNum then
raise Exception.Create('tgputtylib is too old, its build number is '+
IntToStr(tgputtylibbuild)+
', but we need a minimum of '+IntToStr(MinimumLibraryBuildNum));
Fcontext.Init;
FVerbose:=verbose;
FProgressIntervalMS:=1000;
Fcontext.structsize:=sizeof(Fcontext);
if Fcontext.structsize<tggetlibrarycontextsize then
raise Exception.Create('Incorrect TTGLibraryContext record size');
Fcontext.Tag:=UInt64(NativeUInt(self));
Fcontext.ls_callback:=ls_callback;
Fcontext.getpassword_callback:=getpassword_callback;
Fcontext.printmessage_callback:=printmessage_callback;
Fcontext.progress_callback:=progress_callback;
Fcontext.read_from_stream:=read_from_stream;
Fcontext.write_to_stream:=write_to_stream;
Fcontext.get_input_callback:=get_input_callback;
Fcontext.raise_exception_callback:=raise_exception_callback;
Fcontext.verify_host_key_callback:=verify_host_key_callback;
if tgputty_initcontext(ord(verbose),@Fcontext)<>0 then
raise TGPuttySFTPException.Create('tgputty_initcontext failed - incorrect tgputtylib version?');
if not tgputty_getconfigarrays(@FConfTypes,@FConfSubTypes,@FConfNames,@FConfCount) then
raise TGPuttySFTPException.Create('tgputty_getconfigarrays failed - incorrect tgputtylib version?');
if FConfCount<>cConfCount then
printmessage_callback(PAnsiChar(AnsiString('Possibly tgputtylib version mismatch, it has ')+
AnsiString(IntToStr(FConfCount))+
AnsiString(' config strings, but we expected ')+
AnsiString(IntToStr(cConfCount))),0,@Fcontext);
if cDumpSettingsFile then
DumpSettingsFile;
CreateConfigIndex;
end;
procedure TTGPuttySFTP.CreateConfigIndex;
var i:Integer;
begin
GPuttyConfigCS.Enter;
try
if not Assigned(GPuttyConfigIndex) then begin
GPuttyConfigIndex:=tStringList.Create;
GPuttyConfigIndex.Sorted:=true;
for i:=0 to FConfCount-1 do
GPuttyConfigIndex.AddObject(string(FConfNames[i]),TObject(NativeUInt(i)));
end;
finally
GPuttyConfigCS.Leave;
end;
end;
procedure TTGPuttySFTP.DeleteFile(const AName: AnsiString);
var res:Integer;
begin
FLastMessages:='';
Fcontext.fxp_errtype:=cDummyClearedErrorCode; // "clear" error field
res:=tgsftp_rm(PAnsiChar(AName),@Fcontext);
if res<>1 then // 1 = success
raise TGPuttySFTPException.Create(MakePSFTPErrorMsg('tgsftp_rm'));
end;
destructor TTGPuttySFTP.Destroy;
begin
Disconnect;
tgputtyfree(@Fcontext);
inherited;
end;
procedure TTGPuttySFTP.Disconnect;
begin
if FConnected then begin
tgsftp_close(@Fcontext);
FConnected:=false;
end;
end;
procedure TTGPuttySFTP.DownloadFile(const ARemoteFilename, ALocalFilename: AnsiString; const anAppend: Boolean);
var res:Integer;
begin
FLastMessages:='';
Fcontext.fxp_errtype:=cDummyClearedErrorCode; // "clear" error field
res:=tgsftp_getfile(PAnsiChar(ARemoteFilename),PAnsiChar(ALocalFilename),anAppend,@Fcontext);
if res<>1 then
raise TGPuttySFTPException.Create(MakePSFTPErrorMsg('tgsftp_getfile'));
end;
procedure TTGPuttySFTP.DownloadStream(const ARemoteFilename: AnsiString; const AStream: TStream; const anAppend: Boolean);
var res:Integer;
begin
FLastMessages:='';
FDownloadStream:=AStream;
Fcontext.fxp_errtype:=cDummyClearedErrorCode; // "clear" error field
try
res:=tgsftp_getfile(PAnsiChar(ARemoteFilename),nil,anAppend,@Fcontext);
if res<>1 then
raise TGPuttySFTPException.Create(MakePSFTPErrorMsg('tgsftp_getfile'));
finally
FDownloadStream:=nil;
end;
end;
procedure TTGPuttySFTP.DownloadStreamP(const ARemoteFilename: AnsiString; const AStream: TStream; const anAppend: Boolean);
var fh:TSFTPFileHandle;
pktin,req,xfer:Pointer;
offset:UInt64;
canceled, shown_err: Boolean;
attrs:fxp_attrs;
starttick,idlesincetick,TotalBytes,
LastProgressBytes,
lastprogresstick,endtick:UInt64;
buf,vbuf:PByte;
retd, wpos, wlen: Int64; // signed!
PrevTotalBytes: UInt64;
len: Integer;
ErrMsg:string;
Result,WriteException:Boolean;
EClass:ExceptClass;
ErrAddr:Pointer;
begin
if (tgputtylibbuild<12)
{$ifndef MSWINDOWS}
or not Assigned(tgputty_xfer_download_init)
{$endif}
then begin
DownloadStream(ARemoteFileName,AStream,anAppend);
Exit;
end;
CP('psftp_getf');
ErrMsg:='';
Fcontext.fxp_errtype:=cDummyClearedErrorCode; // "clear" error field
if not tgsftp_getstat(PAnsiChar(ARemoteFilename),@Attrs,@Fcontext) then
attrs.flags := 0;
fh := tgputty_openfile(PAnsiChar(ARemoteFilename),SSH_FXF_READ,nil,@Fcontext);
if not Assigned(fh) then
raise TGPuttySFTPException.Create(MakePSFTPErrorMsg('DownloadStreamP'));
CP('psgetf30');
if anAppend then
offset := AStream.Seek(0,soEnd)
else
offset := AStream.Position;
if Fcontext.timeoutticks<1000 then
Fcontext.timeoutticks:=60000;
Result := true;
starttick:=GetTickCount64();
idlesincetick:=0;
TotalBytes:=0;
lastprogresstick:=starttick;
LastProgressBytes:=0;
canceled:=false;
WriteException:=false;
CP('psgetf60');
xfer := xfer_download_init(fh, offset);
CP('psgetf61');
while (Result and not xfer_done(xfer) and not canceled and not Fcontext.aborted) do begin
CP('psgetf62');
PrevTotalBytes := TotalBytes; // TG
CP('psgetf63');
Result:=xfer_download_preparequeue(xfer);
CP('psgetf70');
while Result and xfer_download_data(xfer, vbuf, len) do begin
CP('psgetf71');
buf := vbuf;
wpos := 0;
while wpos<len do begin
CP('psgetf74');
if AStream.Position<>Offset then
AStream.Position:=Offset;
try
wlen:=AStream.Write((buf + wpos)^,len - wpos);
except
on E:Exception do begin
WriteException:=true;
EClass:=ExceptClass(E.ClassType);
ErrMsg:=E.Message;
ErrAddr:=ExceptAddr;
wlen:=0;
end;
end;
CP('psgetf75');
if wlen<=0 then begin
CP('psgetf76');
if ErrMsg='' then
ErrMsg := 'error while writing local stream';
Result := false;
xfer_set_error(xfer);
break;
end;
Inc(wpos,wlen);
Inc(offset,wlen);
end;
if wpos<len then begin
if ErrMsg='' then
ErrMsg := 'error while writing local stream (B)';
CP('psgetf77');
Result := false;
xfer_set_error(xfer);
Result:=false;
break;
end;
if Result then begin
Inc(TotalBytes,len); // TG
CP('psgetf80');
if Assigned(OnProgress) and
((TotalBytes-LastProgressBytes>FProgressAfterBytes) or
(GetTickCount64()-lastprogresstick>=FProgressIntervalMS)) then begin
CP('psgetf81');
if not OnProgress(TotalBytes,false) then begin
CP('psgetf82');
canceled:=true;
Result:=false;
printmessage_callback('Canceling ...'+sLineBreak,0,@Fcontext);
end;
lastprogresstick:=GetTickCount64();
LastProgressBytes:=TotalBytes;
end;
end;
CP('psgetf83');
tgputty_sfree(vbuf,@Fcontext);
end;
if not Result then
break;
CP('psgetf90');
// check if transfer still going
if TotalBytes>PrevTotalBytes then
idlesincetick := 0 // all good
else begin
if idlesincetick = 0 then
idlesincetick := GetTickCount64()
else
if GetTickCount64()-idlesincetick > Fcontext.timeoutticks then begin
CP('psgetf95');
printmessage_callback('Timeout error, no more data received.'+sLineBreak,0,@Fcontext);
Result := false;
xfer_set_error(xfer);
break;
end;
end;
end;
CP('psgetf96');
endtick:=GetTickCount64(); // TG
if endtick-starttick = 0 then // TG
endtick:=starttick+1; // prevent divide by zero ;=)
CP('psgetf97');
if Assigned(OnMessage) then
OnMessage(AnsiString('Downloaded '+IntToStr(TotalBytes)+
' Bytes in '+IntToStr(endtick-starttick)+
' milliseconds, rate = '+FloatToStr((TotalBytes/1024) / (endtick-starttick))+
' MB/sec.'+sLineBreak),
false);
CP('psgetf98');
xfer_cleanup(xfer);
CP('psgetf100');
CloseFile(fh);
if not Result then
if WriteException then
raise EClass.Create(ErrMsg) at ErrAddr
else
if ErrMsg<>'' then
raise TGPuttySFTPException.Create(ErrMsg)
else
raise TGPuttySFTPException.Create(MakePSFTPErrorMsg('DownloadStreamP'));
CP('psgetf103');
end;
procedure TTGPuttySFTP.DumpSettingsFile;
var T:System.Text;
i:Integer;
begin
AssignFile(T,'C:\TEMP\TGPuttyLibSettings.pas');
Rewrite(T);
WriteLn(T,'const');
for i:=0 to FConfCount-1 do begin
Write(T,' cPuttyConf_',FConfNames[i],'=''',FConfNames[i],'''; // ',txtPuttyConfTypes[FConfTypes[i]]);
try
if FConfSubTypes[i]>0 then
WriteLn(T,' [',txtPuttyConfTypes[FConfTypes[i]],']') // default ',tgputty_conf_get_int_int(i,0))
else
try
case FConfTypes[i] of
TYPE_BOOL : WriteLn(T,' default ',tgputty_conf_get_bool(i,@FContext));
TYPE_INT : WriteLn(T,' default ',tgputty_conf_get_int(i,@FContext));
TYPE_STR : WriteLn(T,' default ''',tgputty_conf_get_str(i,@FContext),'''');
else
WriteLn(T);
end;
except
WriteLn(T); // no default value
end;
except
on E:Exception do
WriteLn(T,' Exception: ',E.Message);
end;
end;
System.Close(T);
end;
function TTGPuttySFTP.GetAborted: Boolean;
begin
Result:=Fcontext.aborted;
end;
function TTGPuttySFTP.GetConnectionTimeoutTicks: Integer;
begin
Result:=Fcontext.connectiontimeoutticks;
end;
function TTGPuttySFTP.GetErrorCode: Integer;
begin
Result:=Fcontext.fxp_errtype;
end;
function TTGPuttySFTP.GetErrorMessage: AnsiString;
begin
Result:=Fcontext.fxp_error_message;
end;
function TTGPuttySFTP.GetHomeDir: AnsiString;
begin
Result:=Fcontext.homedir;
end;
function TTGPuttySFTP.GetLibVersion: AnsiString;
var puttyversion:Double;
tgputtylibbuild:Integer;
strpv:AnsiString;
begin
tgputtygetversions(@puttyversion,@tgputtylibbuild);
Str(puttyversion:0:2,strpv);
Result:=AnsiString('tgputtylib build ')+AnsiString(IntToStr(tgputtylibbuild))+AnsiString(' based on PuTTY Release ')+strpv;
end;
function TTGPuttySFTP.GetProxyHost: AnsiString;
begin
Result:=tgputty_conf_get_str(GetPuttyConfIndex(cPuttyConf_proxy_host),@FContext);
end;
function TTGPuttySFTP.GetProxyPassword: AnsiString;
begin
Result:=tgputty_conf_get_str(GetPuttyConfIndex(cPuttyConf_proxy_password),@FContext);
end;
function TTGPuttySFTP.GetProxyPort: Integer;
begin
Result:=tgputty_conf_get_int(GetPuttyConfIndex(cPuttyConf_proxy_port),@FContext);
end;
function TTGPuttySFTP.GetProxyType: TProxyTypes;
begin
Result:=TProxyTypes(tgputty_conf_get_int(GetPuttyConfIndex(cPuttyConf_proxy_type),@FContext));
end;
function TTGPuttySFTP.GetProxyUserName: AnsiString;
begin
Result:=tgputty_conf_get_str(GetPuttyConfIndex(cPuttyConf_proxy_username),@FContext);
end;
function TTGPuttySFTP.GetPuttyConfIndex(const name: string): Integer;
var idx:Integer;
begin
idx:=GPuttyConfigIndex.IndexOf(name);
if idx<0 then
raise TGPuttySFTPException.Create('Putty Conf Name Not Found: '+name);
Result:=NativeUInt(GPuttyConfigIndex.Objects[idx]);
end;
procedure TTGPuttySFTP.GetStat(const AFileName: AnsiString;out Attrs: fxp_attrs);
begin
FLastMessages:='';
Fcontext.fxp_errtype:=cDummyClearedErrorCode; // "clear" error field
if not tgsftp_getstat(PAnsiChar(AFileName),@Attrs,@Fcontext) then
raise TGPuttySFTPException.Create(MakePSFTPErrorMsg('tgsftp_getstat'));
end;
function TTGPuttySFTP.GetTimeoutTicks: Integer;
begin
Result:=Fcontext.timeoutticks;
end;
function TTGPuttySFTP.GetWorkDir: AnsiString;
begin
Result:=Fcontext.pwd;
end;
procedure TTGPuttySFTP.ListDir(const ADirectory: AnsiString);
var res:Integer;
begin
FLastMessages:='';
Fcontext.fxp_errtype:=cDummyClearedErrorCode; // "clear" error field
res:=tgsftp_ls(PAnsiChar(ADirectory),@Fcontext);
if res<>1 then
raise TGPuttySFTPException.Create(MakePSFTPErrorMsg('tgsftp_ls'));
end;
procedure TTGPuttySFTP.MakeDir(const ADirectory: AnsiString);
var res:Integer;
begin
FLastMessages:='';
Fcontext.fxp_errtype:=cDummyClearedErrorCode; // "clear" error field
res:=tgsftp_mkdir(PAnsiChar(ADirectory),@Fcontext);
if res<>1 then // 1 = success
raise TGPuttySFTPException.Create(MakePSFTPErrorMsg('tgsftp_mkdir'));
end;
function TTGPuttySFTP.MakePSFTPErrorMsg(const where: string): string;
begin
if Fcontext.fxp_errtype>=0 then
Result:=where+': Error '+IntToStr(Fcontext.fxp_errtype)+', '+{$ifdef UNICODE}Utf8ToString{$endif}(Fcontext.fxp_error_message)
else
Result:=where+': Unknown Error.'+sLineBreak+{$ifdef UNICODE}Utf8ToString{$endif}(LastMessages);
end;
procedure TTGPuttySFTP.Move(const AFromName, AToName: AnsiString);
var res:Integer;
begin
FLastMessages:='';
Fcontext.fxp_errtype:=cDummyClearedErrorCode; // "clear" error field
res:=tgsftp_mv(PAnsiChar(AFromName),PAnsiChar(AToName),@Fcontext);
if res<>1 then // 1 = success
raise TGPuttySFTPException.Create(MakePSFTPErrorMsg('tgsftp_mv'));
end;
procedure TTGPuttySFTP.MoveEx(const AFromName, AToName: AnsiString; const MoveFlags: Integer);
var res:Integer;
begin
FLastMessages:='';
Fcontext.fxp_errtype:=cDummyClearedErrorCode; // "clear" error field
res:=tgsftp_mvex(PAnsiChar(AFromName),PAnsiChar(AToName),MoveFlags,@Fcontext);
if res<>1 then // 1 = success
raise TGPuttySFTPException.Create(MakePSFTPErrorMsg('tgsftp_mvex'));
end;
function TTGPuttySFTP.OpenFile(const apathname: AnsiString; const anopenflags: Integer; const attrs: Pfxp_attrs): TSFTPFileHandle;
begin
Result:=tgputty_openfile(PAnsiChar(apathname),anopenflags,attrs,@Fcontext);
end;
procedure TTGPuttySFTP.RemoveDir(const ADirectory: AnsiString);
var res:Integer;
begin
FLastMessages:='';
Fcontext.fxp_errtype:=cDummyClearedErrorCode; // "clear" error field
res:=tgsftp_rmdir(PAnsiChar(ADirectory),@Fcontext);
if res<>1 then // 1 = success
raise TGPuttySFTPException.Create(MakePSFTPErrorMsg('tgsftp_rmdir'));
end;
procedure TTGPuttySFTP.SetAborted(const Value: Boolean);
begin
Fcontext.aborted:=Value;
end;
procedure TTGPuttySFTP.SetCheckpoints(const Value: Boolean);
begin
FCheckpoints:=Value;
tgputty_setverbose(ord(FVerbose)+2*ord(FCheckpoints));
end;
procedure TTGPuttySFTP.SetConnectionTimeoutTicks(const Value: Integer);
begin
Fcontext.connectiontimeoutticks:=Value;
end;
procedure TTGPuttySFTP.SetFileSize(const AFileName: AnsiString; const ASize: Int64);
var Attrs:fxp_attrs;
begin
GetStat(AFileName,Attrs);
attrs.flags := SSH_FILEXFER_ATTR_SIZE; // set only this
attrs.size:=ASize;
SetStat(AFileName,Attrs);
end;
procedure TTGPuttySFTP.SetKeyfile(const Value: AnsiString);
begin
tgputty_setkeyfile(PAnsiChar(Value),@Fcontext);
end;
{$if defined(MSWINDOWS) and not defined(FPC) and not defined(HASUTCPARAM)}
function GetBias:Integer;
var Info: TTimeZoneInformation;
begin
Case GetTimeZoneInformation(Info) of
TIME_ZONE_ID_UNKNOWN:
Result:=Info.Bias;
TIME_ZONE_ID_DAYLIGHT:
Result:=Info.Bias+Info.DaylightBias;
TIME_ZONE_ID_STANDARD:
Result:=Info.Bias+Info.StandardBias;
else begin
Result:=0;
Exit;
end;
end;
end;
{$ifend}
procedure TTGPuttySFTP.SetModifiedDate(const AFileName: AnsiString;const ATimestamp: TDateTime; const isUTC:Boolean);
var Attrs:fxp_attrs;
unixtime:Int64;
begin
GetStat(AFileName,Attrs);
attrs.flags := SSH_FILEXFER_ATTR_ACMODTIME; // set only this
{$ifdef FPC}
if isUTC then
unixtime:=DateTimeToUnix(ATimestamp)
else
unixtime:=DateTimeToUnix(LocalTimeToUniversal(ATimestamp));
{$else}
{$ifdef HASUTCPARAM}
unixtime:=DateTimeToUnix(ATimestamp,isUTC);
{$else}
if isUTC then
unixtime:=DateTimeToUnix(ATimestamp)
else
unixtime:=DateTimeToUnix(ATimestamp+GetBias);
{$endif}
{$endif}
if unixtime>=0 then
attrs.mtime:=unixtime
else
attrs.mtime:=0;
SetStat(AFileName,Attrs);
end;
procedure TTGPuttySFTP.SetProxyHost(const Value: AnsiString);
begin
tgputty_conf_set_str(GetPuttyConfIndex(cPuttyConf_proxy_host),PAnsiChar(Value),@FContext);
end;
procedure TTGPuttySFTP.SetProxyPassword(const Value: AnsiString);
begin
tgputty_conf_set_str(GetPuttyConfIndex(cPuttyConf_proxy_password),PAnsiChar(Value),@FContext);
end;
procedure TTGPuttySFTP.SetProxyPort(const Value: Integer);
begin
tgputty_conf_set_int(GetPuttyConfIndex(cPuttyConf_proxy_port),ord(Value),@FContext);
end;
procedure TTGPuttySFTP.SetProxyType(const Value: TProxyTypes);
begin
tgputty_conf_set_int(GetPuttyConfIndex(cPuttyConf_proxy_type),ord(Value),@FContext);
end;
procedure TTGPuttySFTP.SetProxyUserName(const Value: AnsiString);
begin
tgputty_conf_set_str(GetPuttyConfIndex(cPuttyConf_proxy_username),PAnsiChar(Value),@FContext);
end;
procedure TTGPuttySFTP.SetStat(const AFileName: AnsiString;const Attrs: fxp_attrs);
begin
FLastMessages:='';
Fcontext.fxp_errtype:=cDummyClearedErrorCode; // "clear" error field
if not tgsftp_setstat(PAnsiChar(AFileName),@Attrs,@Fcontext) then
raise TGPuttySFTPException.Create(MakePSFTPErrorMsg('tgsftp_setstat'));
end;
procedure TTGPuttySFTP.SetTimeoutTicks(const Value: Integer);
begin
Fcontext.timeoutticks:=Value;
end;
procedure TTGPuttySFTP.SetUnixMode(const AFileName: AnsiString; const AMode: Integer);
var Attrs:fxp_attrs;
begin
GetStat(AFileName,Attrs);
attrs.flags := SSH_FILEXFER_ATTR_PERMISSIONS; // set only this
attrs.permissions:=AMode;
SetStat(AFileName,Attrs);
end;
procedure TTGPuttySFTP.SetVerbose(const Value: Boolean);
begin
FVerbose:=Value;
tgputty_setverbose(ord(FVerbose)+2*ord(FCheckpoints));
end;
procedure TTGPuttySFTP.UploadFile(const ALocalFilename, ARemoteFilename: AnsiString; const anAppend: Boolean);
var res:Integer;