# Functions for talking to an FTP server

# ftp_tryload(host, file, srcfile, [&error], [&callback], [user, pass],
# 	      [port], [attempts])
# Download data from a local file to an FTP site
sub ftp_tryload
{
my $tries = $_[8] || 1;
for(my $i=0; $i<$tries; $i++) {
	&ftp_upload(@_);
	return 1 if (!${$_[3]});
	}
return 0;
}

# ftp_encrypted_tryload(host, file, srcfile, [&error], [&callback], [user, pass],
# 	                [port], [attempts])
# Upload data from a local file to an FTP-over-TLS site
sub ftp_encrypted_tryload
{
my $tries = $_[8] || 1;
for(my $i=0; $i<$tries; $i++) {
	&ftp_encrypted_upload(@_);
	return 1 if (!${$_[3]});
	}
return 0;
}

# ftp_password_command(password, [&error])
# Sends an FTP password without exposing it in an error message.
sub ftp_password_command
{
my ($pass, $err) = @_;
my $cmd = "PASS $pass";
my $passerr;
my $rv = &ftp_command($cmd, 2, \$passerr);
if (!defined($rv)) {
	$passerr =~ s/\Q$cmd\E/PASS *****/g;
	if ($err) { $$err = $passerr; return undef; }
	else { &error($passerr); }
	}
return $rv;
}

# ftp_onecommand(host, command, [&error], [user, pass], [port])
# Executes one command on an FTP server, after logging in, and returns its
# exit status.
sub ftp_onecommand
{
my($buf, @n);

$main::download_timed_out = undef;
local $SIG{ALRM} = \&download_timeout;
alarm(60);

# connect to host and login
&open_socket($_[0], $_[5] || 21, "SOCK", $_[2]) || return 0;
alarm(0);
if ($main::download_timed_out) {
	if ($_[2]) { ${$_[2]} = $main::download_timed_out; return 0; }
	else { &error($main::download_timed_out); }
	}
&ftp_command("", 2, $_[2]) || return 0;
if ($_[3]) {
	# Login as supplied user
	my @urv = &ftp_command("USER $_[3]", [ 2, 3 ], $_[2]);
	@urv || return 0;
	if (int($urv[1]/100) == 3) {
		&ftp_password_command($_[4], $_[2]) || return 0;
		}
	}
else {
	# Login as anonymous
	my @urv = &ftp_command("USER anonymous", [ 2, 3 ], $_[2]);
	@urv || return 0;
	if (int($urv[1]/100) == 3) {
		&ftp_password_command("root\@".&get_system_hostname(),
				      $_[2]) || return 0;
		}
	}

# Run the command
my @rv = &ftp_command($_[1], 2, $_[2]);
@rv || return 0;

# finish off..
&ftp_command("QUIT", 2, $_[2]) || return 0;
close(SOCK);

return $rv[1];
}

# ftp_listdir(host, dir, [&error], [user, pass], [port], [longmode])
# Returns a reference to a list of filenames in a directory, or if longmode
# is set returns full file details in stat format (with the 13th index being
# the filename)
sub ftp_listdir
{
my($buf, @n);

$main::download_timed_out = undef;
local $SIG{ALRM} = \&download_timeout;
alarm(60);

# connect to host and login
&open_socket($_[0], $_[5] || 21, "SOCK", $_[2]) || return 0;
alarm(0);
if ($main::download_timed_out) {
	if ($_[2]) { ${$_[2]} = $main::download_timed_out; return 0; }
	else { &error($main::download_timed_out); }
	}
&ftp_command("", 2, $_[2]) || return 0;
if ($_[3]) {
	# Login as supplied user
	my @urv = &ftp_command("USER $_[3]", [ 2, 3 ], $_[2]);
	@urv || return 0;
	if (int($urv[1]/100) == 3) {
		&ftp_password_command($_[4], $_[2]) || return 0;
		}
	}
else {
	# Login as anonymous
	my @urv = &ftp_command("USER anonymous", [ 2, 3 ], $_[2]);
	@urv || return 0;
	if (int($urv[1]/100) == 3) {
		&ftp_password_command("root\@".&get_system_hostname(),
				      $_[2]) || return 0;
		}
	}

# are we using IPv6?
my $v6 = !&to_ipaddress($_[0]) &&
	 &to_ip6address($_[0]);

if ($v6) {
	# request the listing over a EPSV port
	my $epsv = &ftp_command("EPSV", 2, $_[3]);
	defined($epsv) || return 0;
	$epsv =~ /\|(\d+)\|/ || return 0;
	my $epsvport = $1;
	&open_socket($_[0], $epsvport, CON, $_[3]) || return 0;
	}
else {
	# request the listing over a PASV connection
	my $pasv = &ftp_command("PASV", 2, $_[2]);
	defined($pasv) || return 0;
	$pasv =~ /\(([0-9,]+)\)/ || return 0;
	@n = split(/,/ , $1);
	&open_socket("$n[0].$n[1].$n[2].$n[3]", $n[4]*256 + $n[5], "CON", $_[2]) || return 0;
	}

my @list;
local $_;
if ($_[6]) {
	# Ask for full listing
	&ftp_command("LIST $_[1]/", 1, $_[2]) || return 0;
	while(<CON>) {
		s/\r|\n//g;
		my @st = &parse_lsl_line($_);
		push(@list, \@st) if (scalar(@st));
		}
	close(CON);
	}
else {
	# Just filenames
	&ftp_command("NLST $_[1]/", 1, $_[2]) || return 0;
	while(<CON>) {
		s/\r|\n//g;
		push(@list, $_);
		}
	close(CON);
	}

# finish off..
&ftp_command("", 2, $_[3]) || return 0;
&ftp_command("QUIT", 2, $_[3]) || return 0;
close(SOCK);

return \@list;
}

# parse_lsl_line(text)
# Given a line from ls -l output, parse it into a stat() format array. Not all
# fields are set, as not all are available. Returns an empty array if the line
# doesn't look like ls -l output.
sub parse_lsl_line
{
my @w = split(/\s+/, $_[0]);
my @now = localtime(time());
my @st;
return ( ) if ($w[0] !~ /^[rwxdlsSt\-]{10}(\+|@|\.)?$/);
$st[3] = $w[1];			# Links
$st[4] = $w[2];			# UID
$st[5] = $w[3];			# GID
$st[7] = $w[4];			# Size
if ($w[7] =~ /^(\d+):(\d+)$/) {
	# Time is month day hour:minute
	my @tm = ( 0, $2, $1, $w[6], &month_to_number($w[5]), $now[5] );
	return ( ) if ($tm[4] eq '' || $tm[3] < 1 || $tm[3] > 31);
	my $ut = timelocal(@tm);
	if ($ut > time()+(24*60*60)) {
		# Must have been last year!
		$tm[5]--;
		$ut = timelocal(@tm);
		}
	$st[8] = $st[9] = $st[10] = $ut;
	$st[13] = join(" ", @w[8..$#w]);
	}
elsif ($w[5] =~ /^(\d{4})\-(\d+)\-(\d+)$/) {
	# Time is year-month-day hour:minute
	my @tm = ( 0, 0, 0, $3, $2-1, $1 );
	if ($w[6] =~ /^(\d+):(\d+)$/) {
		$tm[1] = $2;
		$tm[2] = $1;
		$st[8] = $st[9] = $st[10] = timelocal(@tm);
		}
	else {
		return ( );
		}
	$st[13] = join(" ", @w[7..$#w]);
	}
elsif ($w[7] =~ /^\d+$/ && $w[7] > 1000 && $w[7] < 10000) {
	# Time is month day year
	my @tm = ( 0, 0, 0, $w[6],
		      &month_to_number($w[5]), $w[7] );
	return ( ) if ($tm[4] eq '' || $tm[3] < 1 || $tm[3] > 31);
	$st[8] = $st[9] = $st[10] = timelocal(@tm);
	$st[13] = join(" ", @w[8..$#w]);
	}
else {
	# Unknown format??
	return ( );
	}
$st[2] = 0;			# Permissions
$w[0] =~ s/(\+|@|\.)$//;	# Remove trailing + or @ or .
my @p = reverse(split(//, $w[0]));
for(my $i=0; $i<9; $i++) {
	if ($p[$i] ne '-') {
		$st[2] += (1<<$i);
		}
	if ($i == 0 && lc($p[$i]) eq "t") {
		$st[2] += 01000;
		}
	if ($i == 3 && lc($p[$i]) eq "s") {
		$st[2] += 02000;
		}
	if ($i == 6 && lc($p[$i]) eq "s") {
		$st[2] += 04000;
		}
	}
if ($p[9] eq "d") {
	$st[2] += 040000;
	}
if ($st[13] =~ s/\s+->\s+(.*)$//) {
	# Symlink target
	$st[14] = $1;
	}
return @st;
}

# make_unix_perms(number)
# Converts a permissions number into an ls -l format string
sub make_unix_perms
{
my ($mode) = @_;
my @perms = qw(--- --x -w- -wx r-- r-x rw- rwx);
my @ftype = qw(. p c ? d ? b ? - ? l ? s ? ? ?);
$ftype[0] = '';
my $setids = ($mode & 07000)>>9;
my @permstrs = @perms[($mode&0700)>>6, ($mode&0070)>>3, $mode&0007];
my $ftype = $ftype[($mode & 0170000)>>12];

if ($setids) {
  if ($setids & 01) {         # Sticky bit
    $permstrs[2] =~ s/([-x])$/$1 eq 'x' ? 't' : 'T'/e;
    }
  if ($setids & 04) {         # Setuid bit
    $permstrs[0] =~ s/([-x])$/$1 eq 'x' ? 's' : 'S'/e;
    }
  if ($setids & 02) {         # Setgid bit
    $permstrs[1] =~ s/([-x])$/$1 eq 'x' ? 's' : 'S'/e;
    }
  }
return join('', $ftype, @permstrs);
}

# ftp_deletefile(host, file, &error, [user, pass], [port])
# Delete some file or directory from an FTP server. This is done recursively
# if needed. Returns the size of any deleted sub-directories.
sub ftp_deletefile
{
my ($host, $file, $err, $user, $pass, $port) = @_;
my $sz = 0;

# Check if we can chdir to it
my $cwderr;
my $isdir = &ftp_onecommand($host, "CWD $file", \$cwderr,
			       $user, $pass, $port);
if ($isdir) {
	# Yes .. so delete recursively first
	my $files = &ftp_listdir($host, $file, $err, $user, $pass, $port, 1);
	$files = [ grep { $_->[13] ne "." && $_->[13] ne ".." } @$files ];
	if (!$err || !$$err) {
		foreach my $f (@$files) {
			$sz += $f->[7];
			$sz += &ftp_deletefile($host, "$file/$f->[13]", $err,
					       $user, $pass, $port);
			last if ($err && $$err);
			}
		&ftp_onecommand($host, "RMD $file", $err, $user, $pass, $port);
		}
	}
else {
	# Just delete the file
	&ftp_onecommand($host, "DELE $file", $err, $user, $pass, $port);
	}
return $sz;
}

# ftp_encrypted_url(host, file, [port])
# Builds an FTP URL for curl.
sub ftp_encrypted_url
{
my ($host, $file, $port) = @_;
my $url = "ftp://";
$url .= &check_ip6address($host) ? "[".$host."]" : $host;
$url .= ":".$port if ($port);
if (!defined($file) || $file eq "" || $file eq "/") {
	$url .= "/";
	}
else {
	$url .= "/".$file;
	}
return $url;
}

# ftp_encrypted_curl_command([user], [pass])
# Builds a curl command and stdin source. Credentials are passed via curl config
# on stdin so they do not appear in the process list.
sub ftp_encrypted_curl_command
{
my ($user, $pass) = @_;
my $cmd = "curl --ssl-reqd -k -sS";
my $stdin = "/dev/null";
if (defined($user) && $user ne "") {
	$cmd .= " --config -";
	$pass = "" if (!defined($pass));
	my $config = "user = ".&ftp_encrypted_curl_config_quote(
		$user.":".$pass)."\n";
	$stdin = \$config;
	}
return ($cmd, $stdin);
}

# ftp_encrypted_curl_config_quote(value)
# Quotes a value for curl --config.
sub ftp_encrypted_curl_config_quote
{
my ($value) = @_;
$value =~ s/\\/\\\\/g;
$value =~ s/"/\\"/g;
$value =~ s/\r/\\r/g;
$value =~ s/\n/\\n/g;
$value =~ s/\t/\\t/g;
return "\"".$value."\"";
}

# ftp_encrypted_curl_quote_succeeded_before_data_error(error-file, command)
# Returns 1 if the quoted command succeeded before a later data-channel error
sub ftp_encrypted_curl_quote_succeeded_before_data_error
{
my ($stderr, $command) = @_;
my $err = ref($stderr) ? $$stderr :
	  $stderr && -r $stderr ? &read_file_contents($stderr) : "";
return 0 if ($err !~ /\S/);
return 0 if ($err !~ /NSS:\s+client certificate not found \(nickname not specified\)/ &&
	     $err !~ /NSS error -5938 \(PR_END_OF_FILE_ERROR\)/ &&
	     $err !~ /session reuse required/i &&
	     $err !~ /TLS session .*not resum/i);
my $quoted = quotemeta($command);
my $seen;
foreach my $line (split(/\r?\n/, $err)) {
	if ($line =~ /^>\s+$quoted\s*$/) {
		$seen = 1;
		}
	elsif ($seen && $line =~ /^<\s+(\d\d\d)\b/) {
		return int($1 / 100) == 2;
		}
	}
return 0;
}

# ftp_encrypted_execute_curl(command, stdin, stdout, stderr)
# Runs a curl command while logging the sanitized command line.
sub ftp_encrypted_execute_curl
{
my ($cmd, $stdin, $stdout, $stderr) = @_;
if (defined(&execute_command_logged)) {
	return &execute_command_logged($cmd, $stdin, $stdout, $stderr);
	}
&additional_log('exec', undef, $cmd) if (!&is_readonly_mode());
return &execute_command($cmd, $stdin, $stdout, $stderr);
}

# ftp_encrypted_upload(..)
# Takes the same parameters as ftp_upload, but requires FTP over TLS.
sub ftp_encrypted_upload
{
my ($host, $file, $srcfile, $error, $cbfunc, $user, $pass, $port) = @_;
if (!&has_command("curl")) {
	my $msg = "The curl command is needed for encrypted FTP uploads";
	if ($error) { $$error = $msg; return 0; }
	else { &error($msg); }
	}
my ($cmd, $stdin) = &ftp_encrypted_curl_command($user, $pass);
$cmd .= " -T ".quotemeta($srcfile);
$cmd .= " ".quotemeta(&ftp_encrypted_url($host, $file, $port));
my $errtemp = &transname();
my $ex = &ftp_encrypted_execute_curl($cmd, $stdin, "/dev/null", $errtemp);
if ($ex || !-r $srcfile) {
	$$error = &html_escape(&read_file_contents($errtemp)) ||
		  "Unknown curl error with $cmd" if ($error);
	&unlink_file($errtemp);
	return 0;
	}
&unlink_file($errtemp);
return 1;
}

# ftp_encrypted_onecommand(host, command, [&error], [user, pass], [port])
# Executes one command on an FTP-over-TLS server using curl
sub ftp_encrypted_onecommand
{
my ($host, $command, $error, $user, $pass, $port) = @_;
if (!&has_command("curl")) {
	my $msg = "The curl command is needed for encrypted FTP commands";
	if ($error) { $$error = $msg; return 0; }
	else { &error($msg); }
	}
my ($cmd, $stdin) = &ftp_encrypted_curl_command($user, $pass);
$cmd .= " -v";
$cmd .= " -Q ".quotemeta($command);
$cmd .= " ".quotemeta(&ftp_encrypted_url($host, "/", $port));
my $err;
my $ex = &ftp_encrypted_execute_curl($cmd, $stdin, "/dev/null", \$err);
if ($ex) {
	if (&ftp_encrypted_curl_quote_succeeded_before_data_error(
		\$err, $command)) {
		# The -Q command already ran, so only curl's implicit listing
		# failed, and we don't care about that
		return 200;
		}
	my $errmsg = $err || "";
	$errmsg =~ s/^> USER .*/> USER ****/mg;
	$errmsg =~ s/^> PASS .*/> PASS ****/mg;
	$$error = &html_escape($errmsg) ||
		  "Unknown curl error with $cmd" if ($error);
	return 0;
	}
return 200;
}

# ftp_encrypted_listdir(host, dir, [&error], [user, pass], [port], [longmode])
# Returns a reference to a list of filenames in a directory on an FTP-over-TLS
# server, or full file details in stat format when longmode is set.
sub ftp_encrypted_listdir
{
my ($host, $dir, $error, $user, $pass, $port, $longmode) = @_;
if (!&has_command("curl")) {
	my $msg = "The curl command is needed for encrypted FTP directory listings";
	if ($error) { $$error = $msg; return 0; }
	else { &error($msg); }
	}
my ($cmd, $stdin) = &ftp_encrypted_curl_command($user, $pass);
$cmd .= " --list-only" if (!$longmode);
my $listdir = $dir eq "/" ? "/" : $dir."/";
$cmd .= " ".quotemeta(&ftp_encrypted_url($host, $listdir, $port));
my $errtemp = &transname();
my $out;
my $ex = &ftp_encrypted_execute_curl($cmd, $stdin, \$out, $errtemp);
if ($ex) {
	$$error = &html_escape(&read_file_contents($errtemp)) ||
		  "Unknown curl error with $cmd" if ($error);
	&unlink_file($errtemp);
	return 0;
	}
&unlink_file($errtemp);
my @list;
foreach my $l (split(/\r?\n/, $out)) {
	$l =~ s/\r|\n//g;
	next if ($l eq "");
	if ($longmode) {
		my @st = &parse_lsl_line($l);
		if (scalar(@st)) {
			$st[13] =~ s/^.*\///;
			push(@list, \@st);
			}
		}
	else {
		$l =~ s/^.*\///;
		push(@list, $l);
		}
	}
return \@list;
}

# ftp_encrypted_deletefile(host, file, &error, [user, pass], [port])
# Delete some file or directory from an FTP-over-TLS server. This is done
# recursively if needed.
sub ftp_encrypted_deletefile
{
my ($host, $file, $err, $user, $pass, $port) = @_;
my $sz = 0;
my $cwderr;
my $isdir = &ftp_encrypted_onecommand($host, "CWD $file", \$cwderr,
				      $user, $pass, $port);
if ($isdir) {
	# Yes .. so delete recursively first
	my $files = &ftp_encrypted_listdir($host, $file, $err, $user, $pass,
					   $port, 1);
	$files = [ grep { $_->[13] ne "." && $_->[13] ne ".." } @$files ]
		if ($files);
	if (!$err || !$$err) {
		foreach my $f (@$files) {
			$sz += $f->[7];
			$sz += &ftp_encrypted_deletefile(
				$host, "$file/$f->[13]", $err,
				$user, $pass, $port);
			last if ($err && $$err);
			}
		&ftp_encrypted_onecommand($host, "RMD $file", $err,
					  $user, $pass, $port);
		}
	}
else {
	# Just delete the file
	&ftp_encrypted_onecommand($host, "DELE $file", $err,
				  $user, $pass, $port);
	}
return $sz;
}

# ftp_encrypted_download(..)
# Takes the same parameters as ftp_download, but requires an encrypted
# connection.
sub ftp_encrypted_download
{
my ($host, $file, $dest, $error, $cbfunc, $user, $pass, $port, $nocache) = @_;
if (!&has_command("curl")) {
	my $msg = "The curl command is needed for encrypted FTP downloads";
	if ($error) { $$error = $msg; return }
	else { &error($msg); }
	}
my ($cmd, $stdin) = &ftp_encrypted_curl_command($user, $pass);
if (!ref($dest)) {
	$cmd .= " -o ".quotemeta($dest);
	}
my $url = &ftp_encrypted_url($host, $file, $port);
$cmd .= " ".quotemeta($url);
my $errtemp = &transname();
my $ex;
if (ref($dest)) {
	# Save to scalar reference
	$ex = &ftp_encrypted_execute_curl($cmd, $stdin, $dest, $errtemp);
	}
else {
	# Save to a file
	$ex = &ftp_encrypted_execute_curl($cmd, $stdin, "/dev/null",
					  $errtemp);
	}
# Handle any error
if ($ex || (!ref($dest) && !-s $dest)) {
	my $errmsg = &html_escape(&read_file_contents($errtemp)) ||
		     "Unknown curl error with $cmd";
	&unlink_file($errtemp);
	if ($error) { $$error = $errmsg; return 0; }
	else { &error($errmsg); }
	}
&unlink_file($errtemp);
return 1;
}

1;
