Discussion :

[Roland Chastain]

Bonjour tout le monde.

J'essaie sans succès d'envoyer des fichiers sur mon site personnel en utilisant la fonction FtpPutFile.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
uses
  ftpsend;
 
{ function FtpPutFile(const IP, Port, FileName, LocalFile, User, Pass: string): boolean; }
 
begin
  WriteLn(FtpPutFile(
    'ftp.msegui.net',
    '21',
    '/www/1.txt',
    //'public_html/1.txt',
    '1.txt',
    'USERNAME',
    'PASSWORD'
  ));
end.

Grâce au programme suivant que j'ai trouvé sur le forum Lazarus anglophone, j'ai pu récupérer un message d'erreur :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
// onstatus1.pas
 
{ https://forum.lazarus.freepascal.org/index.php/topic,60237.msg450362.html#msg450362 }
 
uses
  FTPSend, blcksock;
 
type
  TFTPSend1 = class(TFTPSend)
  public
    procedure ParseRemote(Value: string); override;
    class procedure OnMyStatus(Sender: TObject; Response: boolean; const Value: string);
  end;
 
  class procedure TFTPSend1.OnMyStatus(Sender: TObject; Response: boolean; const Value: string);
  begin
    Writeln(Value);
  end;
 
  procedure TFTPSend1.ParseRemote(Value: string);
  begin
    inherited;
    Writeln('--> PASV reports data channel: ' + FDataIP + ' on ' + FDataPort);
    Writeln('--> Server is on ' + Self.Sock.GetRemoteSinIP);
 
    // Check here if FDataIP the same as IP of control channel
    // if not, we probably have a internal ip
 
    if (FDataIP <> Self.Sock.GetRemoteSinIP) then
    begin
      Writeln('--> So PASV is probably reporting an internal IP');
      Writeln('--> Redirecting to server IP: ' + Self.Sock.GetRemoteSinIP);
      FDataIP := Self.Sock.GetRemoteSinIP; // we keep FDataPort the same
    end;
 
  end;
 
var
  FTPSend1: TFTPSend;
 
begin
  FTPSend1 := TFTPSend1.Create;
  FTPSend1.TargetHost := 'ftp.msegui.net';
  FTPSend1.TargetPort := '21';
  FTPSend1.Username := 'USERNAME';
  FTPSend1.Password := 'PASSWORD';
  FTPSend1.OnStatus := @TFTPSend1.OnMyStatus;
 
  if FTPSend1.Login then
    Writeln('Succès connexion')
  else
    Writeln('Échec connexion : <<' + FTPSend1.Sock.GetErrorDescEx + '>>');
  {
  FTPSend1.List('/', True); // reading of data channel not implemented here
  }
end.

Code X :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
$ ./onstatus1
220---------- Welcome to Pure-FTPd [privsep] [TLS] ----------
220-You are user number 1 of 50 allowed.
220-Local time is now 09:12. Server port: 21.
220-This is a private system - No anonymous login
220-IPv6 connections are also welcome on this server.
220 You will be disconnected after 15 minutes of inactivity.
USER pmwevymq
421-Sorry, cleartext sessions and weak ciphers are not accepted on this server.
421 Please reconnect using TLS security mechanisms.
Échec connexion : <<>>

Du coup j'ai essayé à tout hasard d'utiliser la classe TFtpSend avec les options FullSSL et AutoTLS, toujours sans succès:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
{ http://forum.lazarus.freepascal.org/index.php/topic,33745.msg219139.html#msg219139 }
 
uses
  ftpsend{, ssl_openssl3};
 
begin
  with TFTPSend.Create do
  try
    TargetHost := 'ftp.msegui.net';
    TargetPort := cFtpProtocol;
    UserName := 'USERNAME';
    Password := 'PASSWORD';
   {FullSSL := true;
    AutoTLS := true;}
    if not Login then
    begin
      WriteLn('Échec connexion');
      Exit;
    end;
    if ChangeWorkingDir('/www/roland/temp') then
    begin
      WriteLn(GetCurrentDir);
      ChangeToRootDir;
      WriteLn(GetCurrentDir);
    end;
    Logout;
  finally
    Free;
  end;
end.

Pour information, la commande suivante fonctionne :

Code Bash :

Sélectionner tout - Visualiser dans une fenêtre à part

curl -p -v --ssl --insecure "ftp://msegui.net/public_html/roland/temp/" --user "USERNAME:PASSWORD" -T "./1.txt"

[Artemus24]

Salut Roland Chastain.

Pour information, la commande suivante fonctionne :

Ce qui signifie que le compte FTP est valide et que le serveur accepte bien les connexions FTPS.

A priori, la négociation TLS n'a pas été effectuée.
Il faut que le support SSL/TLS soit compilé et chargé.

Code Pascal :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
uses
	ftpsend,
	ssl_openssl;

Peux-tu préciser :
la version de Synapse,
la version de Free Pascal/Lazarus,
le système d'exploitation,
et indiquer ce que renvoie "ResultCode" et "ResultString" lorsque "AutoTLS := True" est activé ?
Cela permettra de localiser exactement l'étape qui échoue.

[Roland Chastain]

@Artemus24

Merci. En préparant ma réponse et en suivant tes indications j'ai obtenu quelque chose qui fonctionne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
// changetorootdir1.pas
 
{ http://forum.lazarus.freepascal.org/index.php/topic,33745.msg219139.html#msg219139 }
 
uses
  ftpsend, ssl_openssl;
 
begin
  with TFTPSend.Create do
  try
    TargetHost := 'ftp.msegui.net';
    TargetPort := cFtpProtocol;
    UserName := 'USERNAME';
    Password := 'PASSWORD';
    //FullSSL := true;
    AutoTLS := true;
    if not Login then
    begin
      WriteLn('Échec connexion');
      WriteLn('ResultCode : ', ResultCode);
      WriteLn('ResultString : "', ResultString, '"');
      Exit;
    end;
    if ChangeWorkingDir('/www/roland/temp') then
    begin
      WriteLn(GetCurrentDir);
      ChangeToRootDir;
      WriteLn(GetCurrentDir);
    end;
    Logout;
  finally
    Free;
  end;
end.

Code X :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
$ ./changetorootdir1
/public_html/roland/temp
/

Apparemment il fallait l'option AutoTLS sans l'option FullSSL, et l'unité ssl_openssl.

Mon OS, c'est Linux, ma version de FPC c'est 3.2.2, et la version de Synapse c'est le dernier état du dépôt Github.

Reste à trouver comment envoyer un fichier avec la classe TFTPSend, mais en fouillant dans les exemples je devrais pouvoir y arriver.

Merci pour le tuyau concernant ResultCode et ResultString.

[Roland Chastain]

Maintenant c'est la méthode StoreFile qui échoue.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
// upload.pas
 
uses
  Classes, SysUtils, FTPSend, ssl_openssl3, LoginDetails;
 
const
  CDir = '/home/roland/Documents/site';
 
var
  LFTPSend: TFTPSend;
  LFile, LDir: string;
 
begin
  LFile := '/home/roland/Documents/site/www/roland/temp/1.txt';
  WriteLn('[DEBUG] FileExists ', FileExists(LFile));
 
  LDir := ExtractFileDir(LFile);
  Delete(LDir, 1, Length(CDir));
  WriteLn('[DEBUG] LDir ', LDir);
 
  LFTPSend := TFTPSend.Create;
  try
    LFTPSend.TargetHost := 'ftp.msegui.net';
    LFTPSend.TargetPort := '21';
    LFTPSend.UserName := LoginDetails.CUserName;
    LFTPSend.Password := LoginDetails.CPassword;
    LFTPSend.AutoTLS := TRUE;
    if LFTPSend.Login then
    begin
      if LFTPSend.ChangeWorkingDir({'/www'}LDir) then
      begin
        WriteLn('[DEBUG] Current directory: ', LFTPSend.GetCurrentDir);
        LFTPSend.DirectFile := TRUE;
        LFTPSend.DirectFileName := ExtractFileName(LFile);
        if not LFTPSend.StoreFile(LFile, FALSE) then
        begin
          WriteLn('[ERROR] Cannot upload file "', LFile, '"');
          WriteLn('[ERROR] ResultCode ', LFTPSend.ResultCode);
          WriteLn('[ERROR] ResultString "', LFTPSend.ResultString, '"');
        end;
      end else
        WriteLn('[ERROR] Cannot change directory to "', LDir, '"');
 
      WriteLn('[DEBUG] Logout ', LFTPSend.Logout);
    end else
      WriteLn('[ERROR] Cannot login');
  finally
    LFTPSend.Free;
  end;
end.

Code X :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
$ ./upload
[DEBUG] FileExists TRUE
[DEBUG] LDir /www/roland/temp
[DEBUG] Current directory: /public_html/roland/temp
[ERROR] Cannot upload file "/home/roland/Documents/site/www/roland/temp/1.txt"
[ERROR] ResultCode 257
[ERROR] ResultString "257 "/public_html/roland/temp" is your current location"
[DEBUG] Logout TRUE

[Roland Chastain]

Trouvé !

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
        LFTPSend.DirectFileName := {ExtractFileName(LFile)}LFile;
        if not LFTPSend.StoreFile({LFile}ExtractFileName(LFile), FALSE) then