'LOGGEDIN' => 0x04,
'TWOSOCKS' => 0x08,
);
# subset of FTP commands supported by these server and the respective
# connection states in which they are allowed
'LOGGEDIN' => 0x04,
'TWOSOCKS' => 0x08,
);
# subset of FTP commands supported by these server and the respective
# connection states in which they are allowed
-# 'EPSV' => $_connection_states{LOGGEDIN},
- 'LIST' => $_connection_states{TWOSOCKS},
+# 'EPSV' => $_connection_states{LOGGEDIN},
+ 'LIST' => $_connection_states{TWOSOCKS},
-# 'LPSV' => $_connection_states{LOGGEDIN},
- 'PASS' => $_connection_states{WAIT4PWD},
- 'PASV' => $_connection_states{LOGGEDIN},
- 'PORT' => $_connection_states{LOGGEDIN},
+# 'LPSV' => $_connection_states{LOGGEDIN},
+ 'PASS' => $_connection_states{WAIT4PWD},
+ 'PASV' => $_connection_states{LOGGEDIN},
+ 'PORT' => $_connection_states{LOGGEDIN},
- $_connection_states{TWOSOCKS},
- 'REST' => $_connection_states{TWOSOCKS},
- 'RETR' => $_connection_states{TWOSOCKS},
+ $_connection_states{TWOSOCKS},
+ 'REST' => $_connection_states{TWOSOCKS},
+ 'RETR' => $_connection_states{TWOSOCKS},
'SYST' => $_connection_states{LOGGEDIN},
'TYPE' => $_connection_states{LOGGEDIN} |
$_connection_states{TWOSOCKS},
'SYST' => $_connection_states{LOGGEDIN},
'TYPE' => $_connection_states{LOGGEDIN} |
$_connection_states{TWOSOCKS},
# From ftpexts Internet Draft.
'SIZE' => $_connection_states{LOGGEDIN} |
$_connection_states{TWOSOCKS},
# From ftpexts Internet Draft.
'SIZE' => $_connection_states{LOGGEDIN} |
$_connection_states{TWOSOCKS},
# Parse the first elements of the path until we find the appropriate
# working directory.
my @elems = split /\//, $path;
# Parse the first elements of the path until we find the appropriate
# working directory.
my @elems = split /\//, $path;
print {$conn->{socket}} "150 Opening data connection for file listing.\r\n";
# Open a path back to the client.
print {$conn->{socket}} "150 Opening data connection for file listing.\r\n";
# Open a path back to the client.
# If the path contains a directory name, extract it so that
# we can prefix it to every filename listed.
my $prefix = (($filename || $wildcard) && $path =~ /(.*\/).*/) ? $1 : "";
# If the path contains a directory name, extract it so that
# we can prefix it to every filename listed.
my $prefix = (($filename || $wildcard) && $path =~ /(.*\/).*/) ? $1 : "";
print STDERR "_LIST_command - prefix is: $prefix\n" if $log;
# OK, we're either listing a full directory, listing a single
print STDERR "_LIST_command - prefix is: $prefix\n" if $log;
# OK, we're either listing a full directory, listing a single
print STDERR "switching to LOGGEDIN state\n" if $log;
$conn->{state} = $_connection_states{LOGGEDIN};
print STDERR "switching to LOGGEDIN state\n" if $log;
$conn->{state} = $_connection_states{LOGGEDIN};
if ($conn->{username} eq "anonymous") {
print {$conn->{socket}} "202 Anonymous user access is always granted.\r\n";
} else {
if ($conn->{username} eq "anonymous") {
print {$conn->{socket}} "202 Anonymous user access is always granted.\r\n";
} else {
# Open a listening socket - but don't actually accept on it yet.
"0" =~ /(0)/; # Perl 5.7 / IO::Socket::INET bug workaround.
my $sock = IO::Socket::INET->new (LocalHost => '127.0.0.1',
# Open a listening socket - but don't actually accept on it yet.
"0" =~ /(0)/; # Perl 5.7 / IO::Socket::INET bug workaround.
my $sock = IO::Socket::INET->new (LocalHost => '127.0.0.1',
# We only accept connections from localhost.
print {$conn->{socket}} "227 Entering Passive Mode (127,0,0,1,$p1,$p2)\r\n";
}
# We only accept connections from localhost.
print {$conn->{socket}} "227 Entering Passive Mode (127,0,0,1,$p1,$p2)\r\n";
}
# See RFC 959 Appendix II and draft-ietf-ftpext-mlst-11.txt section 6.2.1.
my $pathname = $conn->{dir};
$pathname =~ s,/+$,, unless $pathname eq "/";
# See RFC 959 Appendix II and draft-ietf-ftpext-mlst-11.txt section 6.2.1.
my $pathname = $conn->{dir};
$pathname =~ s,/+$,, unless $pathname eq "/";
unless ($restart_from =~ /^([1-9][0-9]*|0)$/) {
print {$conn->{socket}} "501 REST command needs a numeric argument.\r\n";
return;
unless ($restart_from =~ /^([1-9][0-9]*|0)$/) {
print {$conn->{socket}} "501 REST command needs a numeric argument.\r\n";
return;
unless (defined $filename && length $filename) {
print {$conn->{socket}} "550 File or directory not found.\r\n";
unless (defined $filename && length $filename) {
print {$conn->{socket}} "550 File or directory not found.\r\n";
}
if ($filename eq "." || $filename eq "..") {
print {$conn->{socket}} "550 RETR command is not supported on directories.\r\n";
}
if ($filename eq "." || $filename eq "..") {
print {$conn->{socket}} "550 RETR command is not supported on directories.\r\n";
my $fullname = $conn->{rootdir} . $dir . $filename;
unless (-f $fullname) {
print {$conn->{socket}} "550 RETR command is only supported on plain files.\r\n";
my $fullname = $conn->{rootdir} . $dir . $filename;
unless (-f $fullname) {
print {$conn->{socket}} "550 RETR command is only supported on plain files.\r\n";
unless (defined $filename && length $filename) {
print {$conn->{socket}} "550 File or directory not found.\r\n";
unless (defined $filename && length $filename) {
print {$conn->{socket}} "550 File or directory not found.\r\n";
}
if ($filename eq "." || $filename eq "..") {
print {$conn->{socket}} "550 SIZE command is not supported on directories.\r\n";
}
if ($filename eq "." || $filename eq "..") {
print {$conn->{socket}} "550 SIZE command is not supported on directories.\r\n";
print {$conn->{socket}} "215 UNIX Type: L8\r\n";
}
sub _TYPE_command
{
my ($conn, $cmd, $type) = @_;
print {$conn->{socket}} "215 UNIX Type: L8\r\n";
}
sub _TYPE_command
{
my ($conn, $cmd, $type) = @_;
print STDERR "switching to WAIT4PWD state\n" if $log;
$conn->{state} = $_connection_states{WAIT4PWD};
print STDERR "switching to WAIT4PWD state\n" if $log;
$conn->{state} = $_connection_states{WAIT4PWD};
if ($conn->{username} eq "anonymous") {
print {$conn->{socket}} "230 Anonymous user access granted.\r\n";
} else {
if ($conn->{username} eq "anonymous") {
print {$conn->{socket}} "230 Anonymous user access granted.\r\n";
} else {
# turn buffering off on $socket
select((select($socket), $|=1)[0]);
# turn buffering off on $socket
select((select($socket), $|=1)[0]);
my ($client_port, $client_ip) = sockaddr_in ($client_addr);
my $client_ipnum = inet_ntoa ($client_ip);
my ($client_port, $client_ip) = sockaddr_in ($client_addr);
my $client_ipnum = inet_ntoa ($client_ip);
'idle_timeout' => 60, # 1 minute timeout
'rootdir' => $self->{_rootDir},
};
'idle_timeout' => 60, # 1 minute timeout
'rootdir' => $self->{_rootDir},
};
# Handle the QUIT command specially.
if ($cmd eq "QUIT") {
print {$conn->{socket}} "221 Goodbye. Service closing connection.\r\n";
# Handle the QUIT command specially.
if ($cmd eq "QUIT") {
print {$conn->{socket}} "221 Goodbye. Service closing connection.\r\n";