ftpserver.pl: Added support for POP3 TOP command

diff --git a/tests/ftpserver.pl b/tests/ftpserver.pl
index 0b495c67d7d72d53529144d53b3782de3ab0c7c4..dc1c0815ab34ea986bba30bc4e8c515d89e2dc3d 100755 (executable)
--- a/tests/ftpserver.pl
+++ b/tests/ftpserver.pl
@@ -564,6 +564,7 @@ sub protocolsetup {
             'QUIT' => \&QUIT_pop3,
             'RETR' => \&RETR_pop3,
             'STAT' => \&STAT_pop3,
+            'TOP'  => \&TOP_pop3,
             'UIDL' => \&UIDL_pop3,
         );
         %displaytext = (
@@ -1400,6 +1401,52 @@ sub UIDL_pop3 {
     return 0;
 }
 
+sub TOP_pop3 {
+    my ($args) = @_;
+    my ($msg, $lines) = split(/ /, $args, 2);
+
+    logmsg "TOP_pop3 got $args\n";
+
+    if (($msg eq "") || ($lines eq "")) {
+        sendcontrol "-ERR Protocol error\r\n";
+    }
+    else {
+        my @data;
+
+        if ($lines == "0") {
+            logmsg "retrieve header of mail\n";
+        }
+        else {
+            logmsg "retrieve top $lines lines of mail\n";
+        }
+
+        my $testno = $msg;
+        $testno =~ s/^([^0-9]*)//;
+        my $testpart = "";
+        if ($testno > 10000) {
+            $testpart = $testno % 10000;
+            $testno = int($testno / 10000);
+        }
+
+        loadtest("$srcdir/data/test$testno");
+
+        @data = getpart("reply", "data$testpart");
+
+        sendcontrol "+OK Mail transfer starts\r\n";
+
+        # Send mail content
+        for my $d (@data) {
+            sendcontrol $d;
+        }
+
+        # End with the magic 3-byte end of mail marker, assumes that the
+        # mail body ends with a CRLF!
+        sendcontrol ".\r\n";
+    }
+
+    return 0;
+}
+
 sub QUIT_pop3 {
     sendcontrol "+OK byebye\r\n";