| Subject: | [PATCH] Support RFC 4217 "AUTH TLS" encryption if IO::Socket::SSL is present |
This patch makes Net::FTPServer support "AUTH TLS" and switch to an
encrypted session.
In theory it also supports CCC (switching back from TLS) with
IO::Socket::SSL version 1.09 (needs the stop_SSL function) but I haven't
tested that.
This patch is running in production on the FastMail.FM FTP server and
once I removed explicit SSL version requirements it seems to be working
fine for all our customers.
| Subject: | ssl.diff |
Index: Net/FTPServer.pm
===================================================================
--- Net.orig/FTPServer.pm 2007-09-12 22:43:28.000000000 -0400
+++ Net/FTPServer.pm 2007-09-21 00:07:57.000000000 -0400
@@ -54,6 +54,7 @@
* Directory aliases and CDPATH support.
* Extensible command set.
* Generate archives on the fly.
+ * SSL/TLS security
=head1 INSTALLING AND RUNNING THE SERVER
@@ -862,6 +863,30 @@
Example: C<enable syslog: 0>
+=item enable ssl
+
+Enable ssl/tls encryption. Requires IO::Socket::SSL to be
+installed. Turning this on will cause AUTH TLS to be
+advertised via FEAT.
+
+This SSL mode is compatible with RFC4217 clients, where it
+is often called "Explicit FTPS". You will need to give an
+SSL certificate and key pair.
+
+Default: 0
+
+Example: C<enable ssl: 1>
+
+=item ssl cert file
+=item ssl key file
+
+Paths to the key and certificate files for SSL.
+
+There is no default.
+
+Example: C<ssl cert file: /etc/ssl/server.crt>
+Example: C<ssl key file: /etc/ssl/server.key>
+
=item ident timeout
Timeout for ident authentication lookups.
@@ -2178,6 +2203,7 @@
eval "use BSD::Resource;";
eval "use Digest::MD5;";
eval "use File::Sync;";
+eval "use IO::Socket::SSL";
# Global variables and constants.
use vars qw(@_default_commands
@@ -2209,6 +2235,8 @@
"CLNT",
# Experimental IP-less virtual hosting.
"HOST",
+ # RFC4217 TLS AUTH (subset of RFC 2228)
+ "AUTH", "PBSZ", "PROT", "CCC",
);
@_default_site_commands
@@ -2315,6 +2343,15 @@
$self->post_configuration_hook;
+ # include TLS features if SSL support available
+ if ($self->config("enable ssl"))
+ {
+ $self->{features}{AUTH} = 'TLS';
+ $self->{features}{PBSZ} = undef;
+ $self->{features}{PROT} = undef;
+ $self->{features}{CCC} = undef;
+ }
+
# Initialize Max Clients Settings
$self->{_max_clients} =
$self->config ("max clients") || 255;
@@ -2853,7 +2890,9 @@
{
%no_authentication_commands =
("USER" => 1, "PASS" => 1, "LANG" => 1, "FEAT" => 1,
- "HELP" => 1, "QUIT" => 1, "HOST" => 1);
+ "HELP" => 1, "QUIT" => 1, "HOST" => 1,
+ "AUTH" => 1, "PBSZ" => 1, "PROT" => 1, "CCC" => 1,
+ );
}
# Start reading commands from the client.
@@ -2870,7 +2909,7 @@
# XXX This does not comply properly with RFC 2640 section 3.1 -
# We should translate <CR><NUL> to <CR> and treat ONLY <CR><LF>
# as a line ending character.
- last unless defined ($_ = <STDIN>);
+ last unless defined ($_ = $self->{_sock}->getline());
$self->_check_signals;
@@ -3592,6 +3631,7 @@
# Duplicate the socket so it looks like we were called
# from inetd.
+ $self->{_sock} = $sock;
dup2 ($sock->fileno, 0);
dup2 ($sock->fileno, 1);
@@ -3958,15 +3998,15 @@
if (@_ == 1) # Single-line response.
{
- print $code, " ", $_[0], "\r\n";
+ $self->{_sock}->print($code, " ", $_[0], "\r\n");
}
else # Multi-line response.
{
for (my $i = 0; $i < @_-1; ++$i)
{
- print $code, "-", $_[$i], "\r\n";
+ $self->{_sock}->print($code, "-", $_[$i], "\r\n");
}
- print $code, " ", $_[@_-1], "\r\n";
+ $self->{_sock}->print($code, " ", $_[@_-1], "\r\n");
}
$self->log ("info", "reply: $code") if $self->{debug};
@@ -4387,6 +4427,140 @@
$self->reply (200, "HOST set to $self->{sitename}.");
}
+sub _AUTH_command
+ {
+ my $self = shift;
+ my $cmd = shift;
+ my $rest = shift;
+
+ my $ucr = uc($rest);
+
+ # If the user issues this command when logged in, generate an error.
+ # We have to do this basically because of chroot and setuid stuff we
+ # can't ``relogin'' as a different user.
+ if ($self->{authenticated})
+ {
+ $self->reply (503, "You are already logged in.");
+ return;
+ }
+
+ if ($self->{user})
+ {
+ $self->reply (503, "You have already sent a USER command, too late to switch now.");
+ return;
+ }
+
+ if ($ucr ne 'TLS' and $ucr ne 'SSL')
+ {
+ $self->reply (504, "Mechanism not known here.");
+ }
+
+ if (not $self->config("enable ssl"))
+ {
+ $self->reply (534, "SSL is not enabled on this server.");
+ }
+
+ if (not exists $INC{"IO/Socket/SSL.pm"})
+ {
+ $self->reply (431, "IO::Socket::SSL is not installed, unable to encrypt.");
+ }
+
+ # Accept the TLS session.
+ $self->reply (234, "AUTH=$ucr");
+ my $cert = $self->config("ssl cert file") || $self->config("ssl certificate file");
+ my $key = $self->config("ssl key file");
+ if (IO::Socket::SSL->start_SSL($self->{_sock},
+ SSL_server => 1,
+ SSL_cert_file => $cert,
+ SSL_key_file => $key,
+ ))
+ {
+ $self->{tls_control} = 1;
+ $self->{tls_type} = $ucr;
+ }
+ else
+ {
+ # failed, what can we do?
+ die "Failed to start TLS " . IO::Socket::SSL::errstr();
+ }
+ }
+
+sub _PBSZ_command
+ {
+ my $self = shift;
+ my $cmd = shift;
+ my $rest = shift;
+
+ if (!$self->{tls_control})
+ {
+ $self->reply (503, "Control connection is not protected");
+ return;
+ }
+
+ if ($rest != 0)
+ {
+ $self->reply (501, "Size must be 0 for TLS");
+ return;
+ }
+
+ $self->{pbsz_provided} = 1;
+ $self->reply (200, "PBSZ=0");
+ }
+
+sub _PROT_command
+ {
+ my $self = shift;
+ my $cmd = shift;
+ my $rest = shift;
+
+ my $ucr = uc($rest);
+
+ if (!$self->{tls_control})
+ {
+ $self->reply (503, "Control connection is not protected");
+ return;
+ }
+
+ if (!$self->{pbsz_provided})
+ {
+ $self->reply (503, "Pointless block size command has not been issued");
+ return;
+ }
+
+ if ($ucr ne 'C' and $ucr ne 'P')
+ {
+ $self->reply (536, "TLS only supports P and C");
+ return;
+ }
+
+ $self->{tls_data} = ($ucr eq 'P');
+ $self->reply (200, "PROT=$ucr");
+ }
+
+sub _CCC_command
+ {
+ my $self = shift;
+ my $cmd = shift;
+ my $rest = shift;
+
+ if (!$self->{tls_control})
+ {
+ $self->reply (503, "Control connection is not protected");
+ return;
+ }
+
+ if ($self->{_sock}->can('stop_SSL'))
+ {
+ $self->reply (200, "CCC");
+ $self->{_sock}->stop_SSL();
+ $self->{tls_control} = 0;
+ }
+ else
+ {
+ $self->reply(534, "Unable to shut down TLS on this connection");
+ }
+ }
+
sub _USER_command
{
my $self = shift;
@@ -6554,21 +6728,21 @@
# wu-ftpd by putting the server code in each line).
#
# See RFC 2389 section 3.2.
- print "211-Extensions supported:\r\n";
+ $self->{_sock}->print("211-Extensions supported:\r\n");
foreach (sort keys %{$self->{features}})
{
unless ($self->{features}{$_})
{
- print " $_\r\n";
+ $self->{_sock}->print(" $_\r\n");
}
else
{
- print " $_ ", $self->{features}{$_}, "\r\n";
+ $self->{_sock}->print(" $_ ", $self->{features}{$_}, "\r\n");
}
}
- print "211 END\r\n";
+ $self->{_sock}->print("211 END\r\n");
}
sub _OPTS_command
@@ -6772,9 +6946,9 @@
my $info = $self->_mlst_format ($filename, $fileh, $dirh);
# Can't use $self->reply since it produces the wrong format.
- print "250-Listing of $filename:\r\n";
- print " ", $info, "\r\n";
- print "250 End of listing.\r\n";
+ $self->{_sock}->print("250-Listing of $filename:\r\n");
+ $self->{_sock}->print(" ", $info, "\r\n");
+ $self->{_sock}->print("250 End of listing.\r\n");
}
sub _MLSD_command
@@ -7463,6 +7637,26 @@
or warn "setsockopt: SO_RCVBUF: $!";
}
+ # Data connections are PROTected, enable SSL
+ if ($self->{tls_data})
+ {
+ my $cert = $self->config("ssl cert file") || $self->config("ssl certificate file");
+ my $key = $self->config("ssl key file");
+ if (IO::Socket::SSL->start_SSL($sock,
+ SSL_server => 1,
+ SSL_cert_file => $cert,
+ SSL_key_file => $key,
+ ))
+ {
+ # yay, all good
+ }
+ else
+ {
+ # failed, what can we do?
+ die "Failed to start TLS connection"; # woot
+ }
+ }
+
return $sock;
}
@@ -8286,10 +8480,12 @@
RFC 765,
RFC 959,
RFC 1579,
+RFC 2228,
RFC 2389,
RFC 2428,
RFC 2577,
RFC 2640,
+RFC 4217,
Extensions to FTP Internet Draft draft-ietf-ftpext-mlst-NN.txt.
=cut