r40808 - in /trunk/libnet-imap-simple-perl: Changes MANIFEST META.yml Simple.pm contrib/preauth-pipe-server.pl debian/changelog stop_server.sh t/40_preauth.t t/ppsc_server.pm

jawnsy-guest at users.alioth.debian.org jawnsy-guest at users.alioth.debian.org
Mon Jul 27 03:03:48 UTC 2009


Author: jawnsy-guest
Date: Mon Jul 27 03:03:41 2009
New Revision: 40808

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=40808
Log:
  + PREAUTH fix and tests
  + Added a contrib/ dovecot pipe server
  + Fixed serious issues with the greeting timeout

Added:
    trunk/libnet-imap-simple-perl/contrib/preauth-pipe-server.pl
    trunk/libnet-imap-simple-perl/t/40_preauth.t
    trunk/libnet-imap-simple-perl/t/ppsc_server.pm
Modified:
    trunk/libnet-imap-simple-perl/Changes
    trunk/libnet-imap-simple-perl/MANIFEST
    trunk/libnet-imap-simple-perl/META.yml
    trunk/libnet-imap-simple-perl/Simple.pm
    trunk/libnet-imap-simple-perl/debian/changelog
    trunk/libnet-imap-simple-perl/stop_server.sh

Modified: trunk/libnet-imap-simple-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-imap-simple-perl/Changes?rev=40808&op=diff
==============================================================================
--- trunk/libnet-imap-simple-perl/Changes (original)
+++ trunk/libnet-imap-simple-perl/Changes Mon Jul 27 03:03:41 2009
@@ -1,3 +1,8 @@
+1.1907: Sun Jul 26 2009
+   - PREAUTH fix and tests
+   - a nifty little contrib/ dovecot pipe server thingy
+   - fixed serious issues with the greeting timeout
+
 1.1905: Mon Jul 20 2009
    - I apparently need Class::Accessor installed for tests.
      Pulling over all deps of the now included net-imap-server

Modified: trunk/libnet-imap-simple-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-imap-simple-perl/MANIFEST?rev=40808&op=diff
==============================================================================
--- trunk/libnet-imap-simple-perl/MANIFEST (original)
+++ trunk/libnet-imap-simple-perl/MANIFEST Mon Jul 27 03:03:41 2009
@@ -13,6 +13,7 @@
 contrib/connectalot.pl
 contrib/hand_test01.pl
 contrib/imap.pl
+contrib/preauth-pipe-server.pl
 contrib/status.pl
 inc/Net/IMAP/Server.pm
 inc/Net/IMAP/Server/Command.pm
@@ -62,6 +63,7 @@
 t/22_copy_multiple.t
 t/22_delete_multiple.t
 t/35_imap_results_in_message_body.t
+t/40_preauth.t
 t/Auth.pm
 t/Connection.pm
 t/Model.pm
@@ -69,5 +71,6 @@
 t/critic.t
 t/pod.t
 t/pod_coverage.t
+t/ppsc_server.pm
 t/test_server.pm
 META.yml                                 Module meta-data (added by MakeMaker)

Modified: trunk/libnet-imap-simple-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-imap-simple-perl/META.yml?rev=40808&op=diff
==============================================================================
--- trunk/libnet-imap-simple-perl/META.yml (original)
+++ trunk/libnet-imap-simple-perl/META.yml Mon Jul 27 03:03:41 2009
@@ -1,6 +1,6 @@
 --- #YAML:1.0
 name:               Net-IMAP-Simple
-version:            1.1905
+version:            1.1907
 abstract:           ~
 author:
     - Paul Miller <jettero at cpan.org>

Modified: trunk/libnet-imap-simple-perl/Simple.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-imap-simple-perl/Simple.pm?rev=40808&op=diff
==============================================================================
--- trunk/libnet-imap-simple-perl/Simple.pm (original)
+++ trunk/libnet-imap-simple-perl/Simple.pm Mon Jul 27 03:03:41 2009
@@ -8,7 +8,7 @@
 use IO::Socket;
 use IO::Select;
 
-our $VERSION = "1.1905";
+our $VERSION = "1.1907";
 
 BEGIN {
     # I'd really rather the pause/cpan indexers miss this "package"
@@ -97,23 +97,31 @@
 
     my $select = $self->{sel} = IO::Select->new($sock);
 
+    $self->_debug( caller, __LINE__, 'new', "looking for greeting" ) if $self->{debug};
+
     my $greeting_ok = 0;
-    while( $select->can_read(1) ) {
+    if( $select->can_read($self->{timeout}) ) {
         if( my $line = $sock->getline ) {
             # Cool, we got a line, check to see if it's a
             # greeting.
 
-            $greeting_ok = 1 if $line =~ m/^\*\s+OK/i;
+            $self->_debug( caller, __LINE__, 'new', "got a greeting: $line" ) if $self->{debug};
+            $greeting_ok = 1 if $line =~ m/^\*\s+(?:OK|PREAUTH)/i;
 
             # Also, check to see if we failed before we sent any
             # commands.
             return if $line =~ /^\*\s+(?:NO|BAD)(?:\s+(.+))?/i;
 
         } else {
+            $self->_debug( caller, __LINE__, 'new', "server hung up during connect" ) if $self->{debug};
+
             # The server hung up on us, otherwise we'd get a line
             # after can_read.
             return;
         }
+
+    } else {
+        $self->_debug( caller, __LINE__, 'new', "no greeting found before timeout" ) if $self->{debug};
     }
 
     return unless $greeting_ok;

Added: trunk/libnet-imap-simple-perl/contrib/preauth-pipe-server.pl
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-imap-simple-perl/contrib/preauth-pipe-server.pl?rev=40808&op=file
==============================================================================
--- trunk/libnet-imap-simple-perl/contrib/preauth-pipe-server.pl (added)
+++ trunk/libnet-imap-simple-perl/contrib/preauth-pipe-server.pl Mon Jul 27 03:03:41 2009
@@ -1,0 +1,55 @@
+#!/usr/bin/perl
+
+use strict;
+use Net::Server;
+use base 'Net::Server::PreFork';
+use IPC::Open3;
+use IO::Select;
+
+my $port = shift;
+my @cmd  = @ARGV;
+
+die "port cmd cmd cmd cmd cmd cmd cmd" unless $port and @cmd;
+
+sub process_request {
+    my $this = shift;
+    my ($wtr, $rdr, $err);
+    my $pid = open3($wtr, $rdr, $err, @cmd);
+
+     $rdr->blocking(0);
+    STDIN->blocking(0);
+
+    my $select = IO::Select->new($rdr, \*STDIN);
+    TOP: while(1) {
+        if( my @handles = $select->can_read(1) ) {
+            for(@handles) {
+                my $at_least_one = 0;
+
+                while( my $line = $_->getline ) {
+                    if( $_ == $rdr ) {
+                        print STDOUT $line;
+                        $this->log(1, "[IMAP] $line");
+
+                    } else {
+                        print $wtr $line;
+                        $this->log(1, "[CLNT] $line");
+                    }
+
+                    $at_least_one ++;
+                }
+
+                last TOP unless $at_least_one;
+            }
+        }
+    }
+
+    $this->log(1, "[KILL] $pid must die");
+
+    kill -1, $pid;
+    kill -2, $pid;
+    waitpid $pid, 0;
+
+    return;
+}
+
+main->run(port=>$port, log_file=>"ppsc.log");

Modified: trunk/libnet-imap-simple-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-imap-simple-perl/debian/changelog?rev=40808&op=diff
==============================================================================
--- trunk/libnet-imap-simple-perl/debian/changelog (original)
+++ trunk/libnet-imap-simple-perl/debian/changelog Mon Jul 27 03:03:41 2009
@@ -1,4 +1,4 @@
-libnet-imap-simple-perl (1.1905-1) UNRELEASED; urgency=low
+libnet-imap-simple-perl (1.1907-1) UNRELEASED; urgency=low
 
   TODO: this has Net::IMAP::Server in Configure_Requires. This means
   we need to have that package done before this one can be tested.
@@ -7,8 +7,11 @@
 
   * New upstream release
     + Now bundles Net::IMAP::Server for use in tests
+    + PREAUTH fix and tests
+    + Added a contrib/ dovecot pipe server
+    + Fixed serious issues with the greeting timeout
 
- -- Jonathan Yu <frequency at cpan.org>  Mon, 20 Jul 2009 19:30:04 -0400
+ -- Jonathan Yu <frequency at cpan.org>  Sun, 26 Jul 2009 19:02:02 -0400
 
 libnet-imap-simple-perl (1.1900-1) unstable; urgency=low
 

Modified: trunk/libnet-imap-simple-perl/stop_server.sh
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-imap-simple-perl/stop_server.sh?rev=40808&op=diff
==============================================================================
--- trunk/libnet-imap-simple-perl/stop_server.sh (original)
+++ trunk/libnet-imap-simple-perl/stop_server.sh Mon Jul 27 03:03:41 2009
@@ -1,4 +1,7 @@
 #!/bin/bash
 
-fuser -k -n tcp 7000
+for port in 7000 8000 9000; do
+    fuser -k -n tcp $port
+done
+
 rm -vf imap_server.pid

Added: trunk/libnet-imap-simple-perl/t/40_preauth.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-imap-simple-perl/t/40_preauth.t?rev=40808&op=file
==============================================================================
--- trunk/libnet-imap-simple-perl/t/40_preauth.t (added)
+++ trunk/libnet-imap-simple-perl/t/40_preauth.t Mon Jul 27 03:03:41 2009
@@ -1,0 +1,42 @@
+use strict;
+use warnings;
+no warnings;
+
+use Test;
+use Net::IMAP::Simple;
+
+plan tests => our $tests = 1;
+
+sub fixeol($) { $_[0] =~ s/[\x0d\x0a]+/\n/g }
+
+my $time = localtime;
+my $msg = <<"HERE";
+From: me
+To: you
+Subject: NiSim Test - $time
+
+$time
+NiSim Test
+
+HERE
+
+sub run_tests {
+    open INFC, ">>", "informal-imap-client-dump.log" or die $!;
+
+    my $imap = Net::IMAP::Simple->new('localhost:9000', debug=>\*INFC)
+        or die "\nconnect failed: $Net::IMAP::Simple::errstr\n";
+
+    my $nm = $imap->select('INBOX')
+        or die " failure selecting INBOX: " . $imap->errstr . "\n";
+
+    $imap->put( INBOX => $msg ); my $gmsg =
+    $imap->get( $nm + 1 );
+
+    fixeol($msg);
+    fixeol($gmsg);
+
+    ok( $gmsg, $msg );
+}   
+
+do "t/ppsc_server.pm" or die "error starting imap server: $!$@";
+

Added: trunk/libnet-imap-simple-perl/t/ppsc_server.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-imap-simple-perl/t/ppsc_server.pm?rev=40808&op=file
==============================================================================
--- trunk/libnet-imap-simple-perl/t/ppsc_server.pm (added)
+++ trunk/libnet-imap-simple-perl/t/ppsc_server.pm Mon Jul 27 03:03:41 2009
@@ -1,0 +1,78 @@
+our $tests;
+
+use strict;
+use IO::Socket::INET;
+no warnings;
+
+# NOTE: To use this test, you have to enter a PREAUTH server command into your
+# ~/.ppsc_test file and make sure you have File::Slurp installed.
+#
+# Example command:
+#
+# echo ssh -C blarghost exec dovecot --exec-mail imap > ~/.ppsc_test
+#
+
+my $tests = 1;
+my $cmd;
+if( my $t = "$ENV{HOME}/.ppsc_test" ) {
+    eval q { # string eval :P
+        use File::Slurp qw(slurp);
+        $cmd = slurp("$ENV{HOME}/.ppsc_test");
+        chomp $cmd;
+    };
+}
+
+unless( $cmd ) {
+    warn "not set up for PREAUTH tests, skipping all meaningful tests\n";
+    skip(1,1,1) for 1 .. $tests;
+    exit 0;
+}
+
+$SIG{CHLD} = $SIG{PIPE} = sub {};
+
+sub kill_imap_server {
+    my $pid = shift;
+
+    #warn " killing: $pid";
+    for(15,2,9,13,11) {
+        kill $_, $pid;
+        sleep 1;
+    }
+}
+
+if( my $pid = fork ) {
+    my $imapfh;
+
+    my $retries = 10;
+
+    my $line; {
+        sleep 1 while (--$retries)>0 and not $imapfh = IO::Socket::INET->new('localhost:9000');
+
+        if( not $imapfh ) {
+            warn "unable to start pipe-server, skipping all meaningful tests\n";
+            skip(1,1,1) for 1 .. $tests;
+            exit 0;
+        } 
+
+        $line = <$imapfh>;
+        redo unless $line =~ m/PREAUTH/;
+    };
+
+    if( __PACKAGE__->can('run_tests') ) {
+        run_tests()
+
+    } else {
+        warn "\nserver started in standalone testing mode...\n";
+        warn "if this isn't what you wanted, provide a run_tests() function.\n";
+        exit 0;
+    }
+
+    kill_imap_server($pid);
+
+    exit(0); # doesn't help, see below
+
+} else {
+    exec "contrib/preauth-pipe-server.pl", 9000, $cmd;
+}
+
+1;




More information about the Pkg-perl-cvs-commits mailing list