1 files changed, 59 insertions, 17 deletions

diff --git a/lib/JWebmail/Model/ReadMails/QMailAuthuser.pm b/lib/JWebmail/Model/ReadMails/QMailAuthuser.pm
index a61cf01..e16e2f2 100644
--- a/lib/JWebmail/Model/ReadMails/QMailAuthuser.pm
+++ b/lib/JWebmail/Model/ReadMails/QMailAuthuser.pm
@@ -36,7 +36,7 @@ package JWebmail::Model::ReadMails::QMailAuthuser::Error {
 
     sub to_string {
         my $self = shift;
-        my $verbose = shift;
+        my $verbose = 1; #shift;
 
         if ($verbose && defined $self->{data}) {
             my $errstr = Data::Dumper->new([$self->{data}])->Terse(1)->Indent(0)->Quotekeys(0)->Dump;
@@ -139,6 +139,13 @@ sub show {
     return $self->build_and_run($auth, 'read', [$folder, $mid]);
 }
 
+sub raw {
+    my $self = shift;
+    my ($auth, $folder, $mid, $path) = @_;
+
+    return $self->build_and_run($auth, 'raw', [$folder, $mid, $path//'']);
+}
+
 sub search {
     my $self = shift;
     my ($auth, $pattern, $folder) = @_;
@@ -175,34 +182,69 @@ sub build_arg {
 
     return $self->{qmail_dir}.'/bin/qmail-authuser'
     . $self->{prefix} . ' '
-    . join(' ', map { my $x = s/(['\\])/\\$1/gr; "'$x'" } ($self->{prog}, $self->{maildir}, $self->{user}, $user_name, $mode, @{$args || []}))
+    . join(' ', map { my $x = s/(['\\])/\\$1/gr; "'$x'" } ($self->{prog}, $self->{maildir}, $self->{user}, $user_name, $mode, @$args))
     . ' 3<&0'
     . ' 2>>'.$self->{logfile};
 }
 
-sub execute {
-    my $_self = shift;
-    my ($auth, $exec) = @_;
+sub start_qmauth {
+    my $self = shift;
+    my ($auth, $mode, $args) = @_;
+
+    my $exec = $self->build_arg($auth->{user}, $mode, $args);
 
     my $pid = open2(my $reader, my $writer, $exec)
-        or die 'failed to create subprocess';
+        or die "failed to create subprocess: $!";
 
     my $challenge = $auth->{challenge} || '';
     $writer->print("$auth->{user}\0$auth->{password}\0$challenge\0")
-        or die 'pipe wite failed';
+        or die "pipe wite failed: $!";
     close $writer
-        or die 'closing write pipe failed';
+        or die "closing write pipe failed: $!";
+
+    return $pid, $reader;
+}
+
+sub read_qmauth {
+    my $_self = shift;
+    my ($pid, $reader) = @_;
 
-    #binmode $reader, ':encoding(UTF-8)';
     my $input = <$reader>;
-    close $reader
-        or die 'closing read pipe failed';
 
-    waitpid $pid, 0;
-    my $rc = $? >> 8;
+    my $rc;
+    if (eof $reader) {
+        # for regular open
+        close $reader
+            or warn "closing read pipe failed: $!";
+        $rc = $? >> 8;
+
+        # for IPC::Open2
+        if (waitpid($pid, 0) == $pid) {
+            $rc = $? >> 8;
+        }
+    }
 
     my $resp;
-    if ($rc == 3 || $rc == 0) {
+    if (!defined $rc) {
+        my ($r, $e);
+        eval { $r = decode_json $input; 1 }
+            or do {
+                $rc = 6;
+                $e = "$@";
+            };
+        $reader->read(my $buf, 4 * 1024**2);
+        if (!eof $reader) {
+            die 'mailpart too large (>4MB)'
+        }
+        close $reader;
+        $resp = {
+            head => $r,
+            body => $buf,
+            rc => $rc,
+            e => $e,
+        };
+    }
+    elsif ($rc == 3 || $rc == 0) {
         eval { $resp = decode_json $input if $input; 1 }
             or do {
                 $resp = {
@@ -214,7 +256,7 @@ sub execute {
                 $rc = 3;
             };
     }
-    elsif ($rc) {
+    else {
         $resp = {
             info        => "got unsuccessful return code by qmail-authuser",
             return_code => $rc,
@@ -229,8 +271,8 @@ sub build_and_run {
     my $self = shift;
     my ($auth, $mode, $args) = @_;
 
-    my $exec = $self->build_arg($auth->{user}, $mode, $args);
-    my ($resp, $rc) = $self->execute($auth, $exec);
+    my @exec = $self->start_qmauth($auth, $mode, $args||[]);
+    my ($resp, $rc) = $self->read_qmauth(@exec);
 
     if ($rc) {
         JWebmail::Model::ReadMails::QMailAuthuser::Error->throw(