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:
Jiri Hruska 2013-03-05 18:03:48 +01:00 committed by Steve Holme
parent b7f39156d4
commit acfce19de1

View File

@ -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
################