r40806 - in /branches/upstream/libnet-imap-simple-perl/current: Changes MANIFEST META.yml Simple.pm contrib/preauth-pipe-server.pl 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:01:00 UTC 2009
Author: jawnsy-guest
Date: Mon Jul 27 03:00:49 2009
New Revision: 40806
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=40806
Log:
[svn-upgrade] Integrating new upstream version, libnet-imap-simple-perl (1.1907)
Added:
branches/upstream/libnet-imap-simple-perl/current/contrib/preauth-pipe-server.pl (with props)
branches/upstream/libnet-imap-simple-perl/current/t/40_preauth.t
branches/upstream/libnet-imap-simple-perl/current/t/ppsc_server.pm
Modified:
branches/upstream/libnet-imap-simple-perl/current/Changes
branches/upstream/libnet-imap-simple-perl/current/MANIFEST
branches/upstream/libnet-imap-simple-perl/current/META.yml
branches/upstream/libnet-imap-simple-perl/current/Simple.pm
branches/upstream/libnet-imap-simple-perl/current/stop_server.sh
Modified: branches/upstream/libnet-imap-simple-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-imap-simple-perl/current/Changes?rev=40806&op=diff
==============================================================================
--- branches/upstream/libnet-imap-simple-perl/current/Changes (original)
+++ branches/upstream/libnet-imap-simple-perl/current/Changes Mon Jul 27 03:00:49 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: branches/upstream/libnet-imap-simple-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-imap-simple-perl/current/MANIFEST?rev=40806&op=diff
==============================================================================
--- branches/upstream/libnet-imap-simple-perl/current/MANIFEST (original)
+++ branches/upstream/libnet-imap-simple-perl/current/MANIFEST Mon Jul 27 03:00:49 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: branches/upstream/libnet-imap-simple-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-imap-simple-perl/current/META.yml?rev=40806&op=diff
==============================================================================
--- branches/upstream/libnet-imap-simple-perl/current/META.yml (original)
+++ branches/upstream/libnet-imap-simple-perl/current/META.yml Mon Jul 27 03:00:49 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: branches/upstream/libnet-imap-simple-perl/current/Simple.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-imap-simple-perl/current/Simple.pm?rev=40806&op=diff
==============================================================================
--- branches/upstream/libnet-imap-simple-perl/current/Simple.pm (original)
+++ branches/upstream/libnet-imap-simple-perl/current/Simple.pm Mon Jul 27 03:00:49 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: branches/upstream/libnet-imap-simple-perl/current/contrib/preauth-pipe-server.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-imap-simple-perl/current/contrib/preauth-pipe-server.pl?rev=40806&op=file
==============================================================================
--- branches/upstream/libnet-imap-simple-perl/current/contrib/preauth-pipe-server.pl (added)
+++ branches/upstream/libnet-imap-simple-perl/current/contrib/preauth-pipe-server.pl Mon Jul 27 03:00:49 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");
Propchange: branches/upstream/libnet-imap-simple-perl/current/contrib/preauth-pipe-server.pl
------------------------------------------------------------------------------
svn:executable = *
Modified: branches/upstream/libnet-imap-simple-perl/current/stop_server.sh
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-imap-simple-perl/current/stop_server.sh?rev=40806&op=diff
==============================================================================
--- branches/upstream/libnet-imap-simple-perl/current/stop_server.sh (original)
+++ branches/upstream/libnet-imap-simple-perl/current/stop_server.sh Mon Jul 27 03:00:49 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: branches/upstream/libnet-imap-simple-perl/current/t/40_preauth.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-imap-simple-perl/current/t/40_preauth.t?rev=40806&op=file
==============================================================================
--- branches/upstream/libnet-imap-simple-perl/current/t/40_preauth.t (added)
+++ branches/upstream/libnet-imap-simple-perl/current/t/40_preauth.t Mon Jul 27 03:00:49 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: branches/upstream/libnet-imap-simple-perl/current/t/ppsc_server.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-imap-simple-perl/current/t/ppsc_server.pm?rev=40806&op=file
==============================================================================
--- branches/upstream/libnet-imap-simple-perl/current/t/ppsc_server.pm (added)
+++ branches/upstream/libnet-imap-simple-perl/current/t/ppsc_server.pm Mon Jul 27 03:00:49 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