imap: Updated ftpserver.pl to be more compliant, added new commands
Enriched IMAP capabilities of ftpserver.pl in order to be able to add tests for the new IMAP features. * Added support for APPEND - Saves uploaded data to log/upload.$testno * Added support for LIST - Returns the contents of <reply/> section in the current test, like e.g FETCH. * Added support for STORE - Returns hardcoded updated flags * Changed handling of SELECT - Returns much more information in the usual set of untagged responses; uses hardcoded data from an example in the IMAP RFC * Changed handling of FETCH - Fixed response format
This commit is contained in:
parent
b7f39156d4
commit
acfce19de1
@ -579,13 +579,15 @@ sub protocolsetup {
|
||||
}
|
||||
elsif($proto eq 'imap') {
|
||||
%commandfunc = (
|
||||
'APPEND' => \&APPEND_imap,
|
||||
'CAPABILITY' => \&CAPABILITY_imap,
|
||||
'FETCH' => \&FETCH_imap,
|
||||
'LIST' => \&LIST_imap,
|
||||
'SELECT' => \&SELECT_imap,
|
||||
'STORE' => \&STORE_imap
|
||||
);
|
||||
%displaytext = (
|
||||
'LOGIN' => ' OK We are happy you popped in!',
|
||||
'SELECT' => ' OK selection done',
|
||||
'LOGOUT' => ' OK thanks for the fish',
|
||||
);
|
||||
@welcome = (
|
||||
@ -783,26 +785,33 @@ sub CAPABILITY_imap {
|
||||
|
||||
sub SELECT_imap {
|
||||
my ($testno) = @_;
|
||||
my @data;
|
||||
my $size;
|
||||
|
||||
logmsg "SELECT_imap got test $testno\n";
|
||||
|
||||
# Example from RFC 3501, 6.3.1. SELECT Command
|
||||
sendcontrol "* 172 EXISTS\r\n";
|
||||
sendcontrol "* 1 RECENT\r\n";
|
||||
sendcontrol "* OK [UNSEEN 12] Message 12 is first unseen\r\n";
|
||||
sendcontrol "* OK [UIDVALIDITY 3857529045] UIDs valid\r\n";
|
||||
sendcontrol "* OK [UIDNEXT 4392] Predicted next UID\r\n";
|
||||
sendcontrol "* FLAGS (\\Answered \\Flagged \\Deleted \\Seen \\Draft)\r\n";
|
||||
sendcontrol "* OK [PERMANENTFLAGS (\\Deleted \\Seen \\*)] Limited\r\n";
|
||||
sendcontrol "$cmdid OK [READ-WRITE] SELECT completed\r\n";
|
||||
|
||||
$selected = $testno;
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub FETCH_imap {
|
||||
my ($testno) = @_;
|
||||
my ($args) = @_;
|
||||
my ($uid, $how) = split(/ /, $args, 2);
|
||||
my @data;
|
||||
my $size;
|
||||
|
||||
logmsg "FETCH_imap got test $testno\n";
|
||||
logmsg "FETCH_imap got $args\n";
|
||||
|
||||
$testno = $selected;
|
||||
|
||||
if($testno =~ /^verifiedserver$/) {
|
||||
if($selected =~ /^verifiedserver$/) {
|
||||
# this is the secret command that verifies that this actually is
|
||||
# the curl test server
|
||||
my $response = "WE ROOLZ: $$\r\n";
|
||||
@ -815,6 +824,7 @@ sub FETCH_imap {
|
||||
else {
|
||||
logmsg "retrieve a mail\n";
|
||||
|
||||
my $testno = $selected;
|
||||
$testno =~ s/^([^0-9]*)//;
|
||||
my $testpart = "";
|
||||
if ($testno > 10000) {
|
||||
@ -832,17 +842,128 @@ sub FETCH_imap {
|
||||
$size += length($_);
|
||||
}
|
||||
|
||||
sendcontrol "* FETCH starts {$size}\r\n";
|
||||
sendcontrol "* $uid FETCH ($how {$size}\r\n";
|
||||
|
||||
for my $d (@data) {
|
||||
sendcontrol $d;
|
||||
}
|
||||
|
||||
sendcontrol ")\r\n";
|
||||
sendcontrol "$cmdid OK FETCH completed\r\n";
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub APPEND_imap {
|
||||
my ($args) = @_;
|
||||
|
||||
logmsg "APPEND_imap got $args\r\n";
|
||||
|
||||
$args =~ /^([^ ]+) [^{]*\{(\d+)\}$/;
|
||||
my ($folder, $size) = ($1, $2);
|
||||
|
||||
sendcontrol "+ Ready for literal data\r\n";
|
||||
|
||||
my $testno = $folder;
|
||||
my $filename = "log/upload.$testno";
|
||||
|
||||
logmsg "Store test number $testno in $filename\n";
|
||||
|
||||
open(FILE, ">$filename") ||
|
||||
return 0; # failed to open output
|
||||
|
||||
my $received = 0;
|
||||
my $line;
|
||||
while(5 == (sysread \*SFREAD, $line, 5)) {
|
||||
if($line eq "DATA\n") {
|
||||
sysread \*SFREAD, $line, 5;
|
||||
|
||||
my $chunksize = 0;
|
||||
if($line =~ /^([0-9a-fA-F]{4})\n/) {
|
||||
$chunksize = hex($1);
|
||||
}
|
||||
|
||||
read_mainsockf(\$line, $chunksize);
|
||||
|
||||
my $left = $size - $received;
|
||||
my $datasize = ($left > $chunksize) ? $chunksize : $left;
|
||||
|
||||
if($datasize > 0) {
|
||||
logmsg "> Appending $datasize bytes to file\n";
|
||||
print FILE substr($line, 0, $datasize) if(!$nosave);
|
||||
$line = substr($line, $datasize);
|
||||
|
||||
$received += $datasize;
|
||||
if($received == $size) {
|
||||
logmsg "Received all data, waiting for final CRLF.\n";
|
||||
}
|
||||
}
|
||||
|
||||
if($received == $size && $line eq "\r\n") {
|
||||
last;
|
||||
}
|
||||
}
|
||||
elsif($line eq "DISC\n") {
|
||||
logmsg "Unexpected disconnect!\n";
|
||||
last;
|
||||
}
|
||||
else {
|
||||
logmsg "No support for: $line";
|
||||
last;
|
||||
}
|
||||
}
|
||||
|
||||
if($nosave) {
|
||||
print FILE "$size bytes would've been stored here\n";
|
||||
}
|
||||
close(FILE);
|
||||
|
||||
logmsg "received $size bytes upload\n";
|
||||
|
||||
sendcontrol "$cmdid OK APPEND completed\r\n";
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub STORE_imap {
|
||||
my ($args) = @_;
|
||||
my ($uid, $what) = split(/ /, $args, 2);
|
||||
|
||||
logmsg "STORE_imap got $args\n";
|
||||
|
||||
sendcontrol "* $uid FETCH (FLAGS (\\Seen \\Deleted))\r\n";
|
||||
sendcontrol "$cmdid OK STORE completed\r\n";
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub LIST_imap {
|
||||
my ($args) = @_;
|
||||
my ($reference, $mailbox) = split(/ /, $args, 2);
|
||||
|
||||
logmsg "LIST_imap got $args\n";
|
||||
|
||||
my $testno = $reference;
|
||||
$testno =~ s/^([^0-9]*)//;
|
||||
my $testpart = "";
|
||||
if ($testno > 10000) {
|
||||
$testpart = $testno % 10000;
|
||||
$testno = int($testno / 10000);
|
||||
}
|
||||
|
||||
loadtest("$srcdir/data/test$testno");
|
||||
|
||||
my @data = getpart("reply", "data$testpart");
|
||||
|
||||
for my $d (@data) {
|
||||
sendcontrol $d;
|
||||
}
|
||||
|
||||
sendcontrol "$cmdid OK LIST Completed\r\n";
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
################
|
||||
################ POP3 commands
|
||||
################
|
||||
|
Loading…
x
Reference in New Issue
Block a user