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

tests/ftpserver.pl

@@ -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($selected =~ /^verifiedserver$/) {
-
-     if($testno =~ /^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
 ################