Commit acfce19d authored by Jiri Hruska's avatar Jiri Hruska Committed by Steve Holme
Browse files

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
parent b7f39156

tests/ftpserver.pl

+130 −9
Original line number Diff line number Diff line
@@ -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";



     $testno = $selected;

     logmsg "FETCH_imap got $args\n";



     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

################