r17169 - in /trunk/libmail-gnupg-perl: Changes GnuPG.pm META.yml t/round-trip.t

ntyni at users.alioth.debian.org ntyni at users.alioth.debian.org
Mon Mar 10 19:57:10 UTC 2008


Author: ntyni
Date: Mon Mar 10 19:57:10 2008
New Revision: 17169

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=17169
Log:
svn-upgrade to upstream 0.15

Modified:
    trunk/libmail-gnupg-perl/Changes
    trunk/libmail-gnupg-perl/GnuPG.pm
    trunk/libmail-gnupg-perl/META.yml
    trunk/libmail-gnupg-perl/t/round-trip.t

Modified: trunk/libmail-gnupg-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmail-gnupg-perl/Changes?rev=17169&op=diff
==============================================================================
--- trunk/libmail-gnupg-perl/Changes (original)
+++ trunk/libmail-gnupg-perl/Changes Mon Mar 10 19:57:10 2008
@@ -1,4 +1,13 @@
 Revision history for Perl extension Mail::GnuPG.
+
+0.15 Sat Mar  8 19:51:55 PST 2008
+
+  This is the ntyni release, as he provided most of the fixes:
+
+  - Fix roundtrip test by trusting test keyring.
+  - New test to show blocking issues on large messages.
+  - Switch to a non-blocking (select) based mechanism for interacting
+    with gpg.
 
 0.10 Mon Jul  9 15:12:10 PDT 2007
 

Modified: trunk/libmail-gnupg-perl/GnuPG.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmail-gnupg-perl/GnuPG.pm?rev=17169&op=diff
==============================================================================
--- trunk/libmail-gnupg-perl/GnuPG.pm (original)
+++ trunk/libmail-gnupg-perl/GnuPG.pm Mon Mar 10 19:57:10 2008
@@ -21,7 +21,8 @@
 use strict;
 use warnings;
 
-our $VERSION = '0.10';
+our $VERSION = '0.15';
+my $DEBUG = 0;
 
 use GnuPG::Interface;
 use File::Spec;
@@ -30,6 +31,8 @@
 use MIME::Entity;
 use MIME::Parser;
 use Mail::Address;
+use IO::Select;
+use Errno qw(EPIPE);
 
 =head2 new
 
@@ -160,26 +163,16 @@
   # this sets up the communication
   my $pid = $gnupg->decrypt( handles => $handles );
 
-  # This passes in the passphrase
   die "NO PASSPHRASE" unless defined $passphrase_fh;
-  print $passphrase_fh $self->{passphrase};
-  close $passphrase_fh;
-
-  # this passes in the plaintext
-  print $input $ciphertext;
-
-  # this closes the communication channel,
-  # indicating we are done
-  close $input;
-
-  my @plaintext    = <$output>;   # reading the output
-  my @error_output = <$error>;    # reading the error
-  my @status_info  = <$status_fh>;# read the status info
-
-  # clean up...
-  close $output;
-  close $error;
-  close $status_fh;
+  my $read = _communicate([$output, $error, $status_fh],
+                        [$input, $passphrase_fh],
+                        { $input => $ciphertext,
+                          $passphrase_fh => $self->{passphrase}}
+             );
+
+  my @plaintext    = split(/^/m, $read->{$output});
+  my @error_output = split(/^/m, $read->{$error});
+  my @status_info  = split(/^/m, $read->{$status_fh});
 
   waitpid $pid, 0;
   my $return = $?;
@@ -284,18 +277,10 @@
 	command_args => [ "--batch", "--list-only", "--status-fd", "1" ],
   );
 
-  # this passes in the ciphertext
-  print $input $ciphertext;
-
-  # this closes the communication channel,
-  # indicating we are done
-  close $input;
+  my $read = _communicate([$output], [$input], { $input => $ciphertext });
 
   # reading the output
-  my @result = <$output>;
-
-  # clean up...
-  close $output;
+  my @result = split(/^/m, $read->{$output});
 
   # clean up the finished GnuPG process
   waitpid $pid, 0;
@@ -438,11 +423,9 @@
 					      "$sigfile" ),
 			  );
 
-  # Now we write to the input of GnuPG
-  # now we read the output
-  my @result = <$error>;
-  close $error;
-  close $input;
+  my $read = _communicate([$error], [$input], {$input => ''});
+
+  my @result = split(/^/m, $read->{$error});
 
   unlink $sigfile, $datafile;
 
@@ -561,9 +544,6 @@
 				   );
   my $pid = $gnupg->detach_sign( handles => $handles );
   die "NO PASSPHRASE" unless defined $passphrase_fh;
-  print $passphrase_fh $self->{passphrase};
-  close $passphrase_fh;
-
 
   # this passes in the plaintext
   my $plaintext;
@@ -576,9 +556,6 @@
   # according to RFC3156 all line endings MUST be CR/LF
   $plaintext =~ s/\x0A/\x0D\x0A/g;
   $plaintext =~ s/\x0D+/\x0D/g;
-
-  # should we store this back into the body?
-  print $input $plaintext;
 
   # DEBUG:
 #  print "SIGNING THIS STRING ----->\n";
@@ -587,19 +564,15 @@
 #  warn($entity->as_string);
 #  print STDERR $plaintext;
 #  print "<----\n";
-  $input->flush();
-  eval { $input->sync() };      # IO::Handle::sync not implemented on
-                                # all systems.
-  close $input;
-
-  my @signature    = <$output>;   # reading the output
-  my @error_output = <$error>;    # reading the error
-  my @status_info  = <$status_fh>;# read the status info
-
-  # clean up...
-  close $output;
-  close $error;
-  close $status_fh;
+  my $read = _communicate([$output, $error, $status_fh],
+                        [$input, $passphrase_fh],
+                        { $input => $plaintext,
+                          $passphrase_fh => $self->{passphrase}}
+             );
+
+  my @signature  = split(/^/m, $read->{$output});
+  my @error_output = split(/^/m, $read->{$error});
+  my @status_info  = split(/^/m, $read->{$status_fh});
 
   waitpid $pid, 0;
   my $return = $?;
@@ -675,15 +648,11 @@
   $plaintext =~ s/\x0A/\x0D\x0A/g;
   $plaintext =~ s/\x0D+/\x0D/g;
 
-  print $input $plaintext;
-  close $input;
-  
-  my @ciphertext = <$output>;
-  my @error_output = <$error>;
-  
-  close $output;
-  close $error;
-
+  my $read = _communicate([$output, $error], [$input], { $input => $plaintext });
+  
+  my @ciphertext = split(/^/m, $read->{$output});
+  my @error_output = split(/^/m, $read->{$error});
+  
   waitpid $pid, 0;
   my $return = $?;
    $return = 0 if $return == -1;
@@ -781,15 +750,11 @@
 	}
   };
 
-  print $input $plaintext;
-  close $input;
-  
-  my @ciphertext = <$output>;
-  my @error_output = <$error>;
-  
-  close $output;
-  close $error;
-
+  my $read = _communicate([$output, $error], [$input], { $input => $plaintext });
+  
+  my @ciphertext = split(/^/m, $read->{$output});
+  my @error_output = split(/^/m, $read->{$error});
+  
   waitpid $pid, 0;
   my $return = $?;
    $return = 0 if $return == -1;
@@ -885,10 +850,6 @@
     }
   };
 
-  die "NO PASSPHRASE" unless defined $passphrase_fh;
-  print $passphrase_fh $self->{passphrase};
-  close $passphrase_fh;
-
  # this passes in the plaintext
   my $plaintext;
   if ($workingentity eq $entity) {
@@ -901,23 +862,22 @@
   # $plaintext =~ s/\n/\x0D\x0A/sg;
   # should we store this back into the body?
 
-  print $input $plaintext;
-
   # DEBUG:
   #print "ENCRYPTING THIS STRING ----->\n";
 #  print $plaintext;
 #  print "<----\n";
 
-  close $input;
-
-  my @ciphertext   = <$output>;   # reading the output
-  my @error_output = <$error>;    # reading the error
-  my @status_info  = <$status_fh>;# read the status info
-
-  # clean up...
-  close $output;
-  close $error;
-  close $status_fh;
+  die "NO PASSPHRASE" unless defined $passphrase_fh;
+  my $read = _communicate([$output, $error, $status_fh],
+                        [$input, $passphrase_fh],
+                        { $input => $plaintext,
+                          $passphrase_fh => $self->{passphrase}}
+             );
+
+  my @plaintext    = split(/^/m, $read->{$output});
+  my @ciphertext = split(/^/m, $read->{$output});
+  my @error_output = split(/^/m, $read->{$error});
+  my @status_info  = split(/^/m, $read->{$status_fh});
 
   waitpid $pid, 0;
   my $return = $?;
@@ -991,6 +951,112 @@
   return 0;
 }
 
+# interleave reads and writes
+# input parameters: 
+#  $rhandles - array ref with a list of file handles for reading
+#  $whandles - array ref with a list of file handles for writing
+#  $wbuf_of  - hash ref indexed by the stringified handles
+#              containing the data to write
+# return value:
+#  $rbuf_of  - hash ref indexed by the stringified handles
+#              containing the data that has been read
+#
+# read and write errors due to EPIPE (gpg exit) are skipped silently on the
+# assumption that gpg will explain the problem on the error handle
+#
+# other errors cause a non-fatal warning, processing continues on the rest
+# of the file handles
+#
+# NOTE: all the handles get closed inside this function
+
+sub _communicate {
+    my $blocksize = 2048;
+    my ($rhandles, $whandles, $wbuf_of) = @_;
+    my $rbuf_of = {};
+
+    # the current write offsets, again indexed by the stringified handle
+    my $woffset_of;
+
+    my $reader = IO::Select->new;
+    for (@$rhandles) {
+        $reader->add($_);
+        $rbuf_of->{$_} = '';
+    }
+
+    my $writer = IO::Select->new;
+    for (@$whandles) {
+        die("no data supplied for handle " . fileno($_)) if !exists $wbuf_of->{$_};
+        if ($wbuf_of->{$_}) {
+            $writer->add($_);
+        } else { # nothing to write
+            close $_;
+        }
+    }
+
+    # we'll handle EPIPE explicitly below
+    local $SIG{PIPE} = 'IGNORE';
+
+    while ($reader->handles || $writer->handles) {
+        my @ready = IO::Select->select($reader, $writer, undef, undef);
+        if (!@ready) {
+            die("error doing select: $!");
+        }
+        my ($rready, $wready, $eready) = @ready;
+        if (@$eready) {
+            die("select returned an unexpected exception handle, this shouldn't happen");
+        }
+        for my $rhandle (@$rready) {
+            my $n = fileno($rhandle);
+            my $count = sysread($rhandle, $rbuf_of->{$rhandle},
+                                $blocksize, length($rbuf_of->{$rhandle}));
+            warn("read $count bytes from handle $n") if $DEBUG;
+            if (!defined $count) { # read error
+                if ($!{EPIPE}) {
+                    warn("read failure (gpg exited?) from handle $n: $!")
+                        if $DEBUG;
+                } else {
+                    warn("read failure from handle $n: $!");
+                }
+                $reader->remove($rhandle);
+                close $rhandle;
+                next;
+            }
+            if ($count == 0) { # EOF
+                warn("read done from handle $n") if $DEBUG;
+                $reader->remove($rhandle);
+                close $rhandle;
+                next;
+            }
+        }
+        for my $whandle (@$wready) {
+            my $n = fileno($whandle);
+            $woffset_of->{$whandle} = 0 if !exists $woffset_of->{$whandle};
+            my $count = syswrite($whandle, $wbuf_of->{$whandle},
+                                 $blocksize, $woffset_of->{$whandle});
+            if (!defined $count) {
+                if ($!{EPIPE}) { # write error
+                    warn("write failure (gpg exited?) from handle $n: $!")
+                        if $DEBUG;
+                } else {
+                    warn("write failure from handle $n: $!");
+                }
+                $writer->remove($whandle);
+                close $whandle;
+                next;
+            }
+            warn("wrote $count bytes to handle $n") if $DEBUG;
+            $woffset_of->{$whandle} += $count;
+            if ($woffset_of->{$whandle} >= length($wbuf_of->{$whandle})) {
+                warn("write done to handle $n") if $DEBUG;
+                $writer->remove($whandle);
+                close $whandle;
+                next;
+            }
+        }
+    }
+    return $rbuf_of;
+}
+
 # FIXME: there's no reason why is_signed and is_encrypted couldn't be
 # static (class) methods, so maybe we should support that.
 

Modified: trunk/libmail-gnupg-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmail-gnupg-perl/META.yml?rev=17169&op=diff
==============================================================================
--- trunk/libmail-gnupg-perl/META.yml (original)
+++ trunk/libmail-gnupg-perl/META.yml Mon Mar 10 19:57:10 2008
@@ -1,9 +1,11 @@
 --- #YAML:1.0
 name:                Mail-GnuPG
-version:             0.10
+version:             0.15
 abstract:            Process email with GPG.
 license:             ~
-generated_by:        ExtUtils::MakeMaker version 6.31
+author:              
+    - Robert Spier <rspier at cpan.org>
+generated_by:        ExtUtils::MakeMaker version 6.44
 distribution_type:   module
 requires:     
     File::Spec:                    0
@@ -15,7 +17,5 @@
     MIME::Parser:                  0
     Test::More:                    0
 meta-spec:
-    url:     http://module-build.sourceforge.net/META-spec-v1.2.html
-    version: 1.2
-author:
-    - Robert Spier <rspier at cpan.org>
+    url:     http://module-build.sourceforge.net/META-spec-v1.3.html
+    version: 1.3

Modified: trunk/libmail-gnupg-perl/t/round-trip.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmail-gnupg-perl/t/round-trip.t?rev=17169&op=diff
==============================================================================
--- trunk/libmail-gnupg-perl/t/round-trip.t (original)
+++ trunk/libmail-gnupg-perl/t/round-trip.t Mon Mar 10 19:57:10 2008
@@ -17,12 +17,12 @@
 
 my $tmpdir = tempdir( "mgtXXXXX", CLEANUP => 1);
 
-unless ( 0 == system("gpg --homedir $tmpdir --import t/test-key.pgp 2>&1 >/dev/null")) {
+unless ( 0 == system("gpg --homedir $tmpdir --trusted-key 0x49539D60EFEA4EAD --import t/test-key.pgp 2>&1 >/dev/null")) {
   plan skip_all => "unable to import testing keys";
   goto end;
 }
 
-plan tests => 13;
+plan tests => 20;
 
 
 my $mg = new Mail::GnuPG( key => '49539D60EFEA4EAD',
@@ -31,12 +31,14 @@
 
 isa_ok($mg,"Mail::GnuPG");
 
+my $line = "x\n";
+my $string = $line x 100000;
+
 my $copy;
 my $me =  MIME::Entity->build(From    => 'me at myhost.com',
 			      To      => 'you at yourhost.com',
 			      Subject => "Hello, nurse!",
-			      Data    => ["Line 1","Line 2"]);
-
+			      Data    => [$string]);
 # Test MIME Signing Round Trip
 
 $copy = $me->dup;
@@ -67,30 +69,18 @@
 }
 # Test MIME Encryption Round Trip
 
-# hmm.. the encryption functions don't seem to be working right.
-# something about ...
-# gpg: 9FE08E94: There is no indication that this key really belongs to the owner
-# gpg: [stdin]: encryption failed: unusable public key
+$copy = $me->dup;
 
+is( 0, $mg->ascii_encrypt( $copy, $KEY ));
+is( 0, $mg->is_signed($copy) );
+is( 1, $mg->is_encrypted($copy) );
 
-# $copy = $me->dup;
+($verify,$key,$who) = $mg->decrypt($copy);
 
-# is( 0, $mg->ascii_encrypt( $copy, $KEY ));
-# warn @{$mg->{last_message}},"\n";
-# warn @{$mg->{plaintext}},"\n";
-# warn "hihi\n";
-# exit;
-# is( 0, $mg->is_signed($copy) );
-# is( 1, $mg->is_encrypted($copy) );
+is( 0, $verify );
+is( undef, $key );
+is( undef, $who );
 
-# my ($verify,$key,$who) = $mg->decrypt($copy);
-
-# is( 0, $verify );
-# is( undef, $key );
-# is( undef, $who );
-
-# is_deeply($mg->{decrypted},$me);
-
-
+is_deeply($mg->{decrypted}->body,$me->body);
 
 end:




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