From bfa733907ee02712c6fe499417c22fdf18566fe8 Mon Sep 17 00:00:00 2001 From: Ilia Ross Date: Sun, 20 Sep 2026 21:33:54 +0200 Subject: [PATCH] Fix explicit FTPS backup negotiation https://github.com/webmin/webmin/issues/2849#issuecomment-5751772604 --- fsdump/ftp.pl | 11 ++- fsdump/t/ftp-tls.t | 185 +++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 192 insertions(+), 4 deletions(-) create mode 100644 fsdump/t/ftp-tls.t diff --git a/fsdump/ftp.pl b/fsdump/ftp.pl index 969b7e569..2cbcaa84a 100755 --- a/fsdump/ftp.pl +++ b/fsdump/ftp.pl @@ -49,10 +49,6 @@ while(1) { $ssl_enabled = 0; if (&ftp_command("AUTH TLS", 2, \$err)) { &start_tls(\*SOCK, "control"); - &ftp_command("PBSZ 0", 2, \$err) || - &error_exit("FTP TLS setup failed : $err"); - &ftp_command("PROT P", 2, \$err) || - &error_exit("FTP TLS setup failed : $err"); $ssl_enabled = 1; } @@ -63,6 +59,13 @@ while(1) { &ftp_command("PASS $pass", 2, \$err) || &error_exit("FTP login failed : $err"); } + if ($ssl_enabled) { + # Some servers accept data-channel protection only after login + &ftp_command("PBSZ 0", 2, \$err) || + &error_exit("FTP TLS setup failed : $err"); + &ftp_command("PROT P", 2, \$err) || + &error_exit("FTP TLS setup failed : $err"); + } &ftp_command("TYPE I", 2, \$err) || &error_exit("FTP file type failed : $err"); diff --git a/fsdump/t/ftp-tls.t b/fsdump/t/ftp-tls.t new file mode 100644 index 000000000..3b7a43f87 --- /dev/null +++ b/fsdump/t/ftp-tls.t @@ -0,0 +1,185 @@ +#!/usr/bin/perl +# Regression test for explicit FTP TLS servers that require login before +# accepting PBSZ and PROT. + +use strict; +use warnings; +use Test::More; +use File::Copy qw(copy); +use File::Spec; +use File::Temp qw(tempdir); +use FindBin; +use IO::Socket::INET; +use IPC::Open3; +use Symbol qw(gensym); + +BEGIN { + eval { + require IO::Socket::SSL; + require IO::Socket::SSL::Utils; + IO::Socket::SSL::Utils->import( + qw(CERT_create CERT_free KEY_free + PEM_cert2file PEM_key2file)); + 1; + } or plan skip_all => 'IO::Socket::SSL test modules are unavailable'; +} + +my $tmp = tempdir(CLEANUP => 1); +my $client_script = File::Spec->catfile($tmp, 'ftp.pl'); +copy(File::Spec->catfile($FindBin::Bin, '..', 'ftp.pl'), $client_script) or + die "copy ftp.pl: $!"; + +# Supply only the socket and FTP response helpers needed by ftp.pl. +my $stub = File::Spec->catfile($tmp, 'fsdump-lib.pl'); +open(my $STUB, '>', $stub) or die "open $stub: $!"; +print $STUB <<'PERL'; +use IO::Socket::INET; + +sub open_socket +{ +my ($host, $port, $name, $err) = @_; +my $socket = IO::Socket::INET->new( + PeerAddr => $host, + PeerPort => $ENV{'FSDUMP_TEST_FTP_PORT'}, + Proto => 'tcp'); +if (!$socket) { + $$err = $!; + return undef; + } +no strict 'refs'; +*{'main::'.$name} = $socket; +return $host; +} + +sub ftp_command +{ +my ($command, $expected, $err, $name) = @_; +$name ||= 'SOCK'; +no strict 'refs'; +my $handle = \*{'main::'.$name}; +print $handle "$command\r\n" if ($command ne ''); +my $line = <$handle>; +if (!defined($line) || $line !~ /^(\d{3})[ -](.*?)(?:\r?\n)?$/) { + $$err = 'Failed to read FTP reply'; + return undef; + } +my ($code, $reply) = ($1, $2); +my @expected = ref($expected) ? @$expected : ($expected); +if (!grep { int($code / 100) == $_ } @expected) { + $$err = "$command failed : $reply"; + return undef; + } +return wantarray ? ($reply, $code) : $reply; +} + +1; +PERL +close($STUB) or die "close $stub: $!"; + +# Create a temporary self-signed certificate for both TLS channels. +my ($cert, $key) = CERT_create( + subject => { commonName => '127.0.0.1' }, + purpose => 'server'); +my $cert_file = File::Spec->catfile($tmp, 'cert.pem'); +my $key_file = File::Spec->catfile($tmp, 'key.pem'); +PEM_cert2file($cert, $cert_file); +PEM_key2file($key, $key_file); +CERT_free($cert); +KEY_free($key); + +my $listener = IO::Socket::INET->new( + LocalAddr => '127.0.0.1', + LocalPort => 0, + Proto => 'tcp', + Listen => 1, + ReuseAddr => 1) or die "listen: $!"; +my $port = $listener->sockport(); +my $log_file = File::Spec->catfile($tmp, 'server.log'); +my $server_pid = fork(); +defined($server_pid) or die "fork: $!"; +if (!$server_pid) { + eval { + local $SIG{'ALRM'} = sub { die "server timeout\n" }; + alarm(15); + my $socket = $listener->accept() or die "accept: $!"; + $socket->autoflush(1); + my @commands; + print $socket "220 test server\r\n"; + my $line = <$socket>; + $line =~ s/\r?\n$//; + push(@commands, $line); + $line eq 'AUTH TLS' or die "expected AUTH TLS, got $line\n"; + print $socket "234 start TLS\r\n"; + $socket = IO::Socket::SSL->start_SSL( + $socket, + SSL_server => 1, + SSL_cert_file => $cert_file, + SSL_key_file => $key_file) or + die "server TLS: ".IO::Socket::SSL::errstr()."\n"; + $socket->autoflush(1); + + # Rejecting PBSZ here models servers that require authentication + # first; the client must send USER and PASS before protection setup. + foreach my $step ( + [ qr/^USER /, "331 password required\r\n" ], + [ qr/^PASS /, "230 logged in\r\n" ], + [ qr/^PBSZ 0$/, "200 buffer size set\r\n" ], + [ qr/^PROT P$/, "200 private data channel\r\n" ], + [ qr/^TYPE I$/, "200 binary mode\r\n" ], + [ qr/^QUIT$/, "221 goodbye\r\n" ]) { + $line = <$socket>; + defined($line) or die "connection closed early\n"; + $line =~ s/\r?\n$//; + push(@commands, $line); + $line =~ $step->[0] or + die "unexpected command $line\n"; + print $socket $step->[1]; + } + open(my $LOG, '>', $log_file) or die "open log: $!"; + print $LOG join("\n", @commands), "\n"; + close($LOG) or die "close log: $!"; + alarm(0); + 1; + } or do { + my $error = $@ || 'unknown server error'; + open(my $LOG, '>', $log_file) or exit(2); + print $LOG "ERROR: $error"; + close($LOG); + exit(1); + }; + exit(0); + } +close($listener); + +local $ENV{'DUMP_PASSWORD'} = 'test-password'; +local $ENV{'FSDUMP_TEST_FTP_PORT'} = $port; +my $stderr = gensym(); +my $old_cwd = File::Spec->rel2abs('.'); +chdir($tmp) or die "chdir $tmp: $!"; +my $client_pid = open3(my $input, my $output, $stderr, $^X, + $client_script, '127.0.0.1', 'unused', 'test-user', 'touch'); +print $input "O/backup.tar\n64\nC\n"; +close($input); +my $client_output = do { local $/; <$output> }; +my $client_error = do { local $/; <$stderr> }; +waitpid($client_pid, 0); +my $client_status = $?; +chdir($old_cwd) or die "chdir $old_cwd: $!"; + +waitpid($server_pid, 0); +my $server_status = $?; +open(my $LOG, '<', $log_file) or die "open $log_file: $!"; +my $server_log = do { local $/; <$LOG> }; +close($LOG); + +is($client_status, 0, 'FTP helper completes the protected control session') or + diag($client_error); +is($server_status, 0, 'mock FTPS server accepts the command sequence') or + diag($server_log); +is($server_log, + "AUTH TLS\nUSER test-user\nPASS test-password\nPBSZ 0\n". + "PROT P\nTYPE I\nQUIT\n", + 'login precedes data-channel protection setup'); +is($client_output, "A0\nA0\n", 'rmt protocol receives open and close success'); + +done_testing();