diff options
Diffstat (limited to 'lib/JWebmail/Model/ReadMails/QMailAuthuser.pm')
| -rw-r--r-- | lib/JWebmail/Model/ReadMails/QMailAuthuser.pm | 82 |
1 files changed, 47 insertions, 35 deletions
diff --git a/lib/JWebmail/Model/ReadMails/QMailAuthuser.pm b/lib/JWebmail/Model/ReadMails/QMailAuthuser.pm index 39d8ab6..956c137 100644 --- a/lib/JWebmail/Model/ReadMails/QMailAuthuser.pm +++ b/lib/JWebmail/Model/ReadMails/QMailAuthuser.pm @@ -8,8 +8,8 @@ use File::Basename 'fileparse'; use IPC::Open2; use JSON::PP 'decode_json'; use Params::Check 'check'; -use Scalar::Util 'blessed'; use Role::Tiny::With; +use Scalar::Util 'blessed'; use namespace::clean; with 'JWebmail::Model::ReadMails::Role'; @@ -51,7 +51,10 @@ package JWebmail::Model::ReadMails::QMailAuthuser::Error { my $cls = shift; my $msg = shift; - die $cls->new($msg, @_)->_trace; + my $self = $cls->new($msg, @_); + $self->_trace; + + die $self; } # taken from Mojo::Exception @@ -70,12 +73,12 @@ package JWebmail::Model::ReadMails::QMailAuthuser::Error { my $QMailAuthuserCheck = { - user => {defined => 1, required => 1}, - maildir => {defined => 1, required => 1}, - prog => {defined => 1, required => 1}, - prefix => {defined => 1, default => ''}, - qmail_dir => {defined => 1, default => '/var/qmail/'}, - logfile => {defined => 1, default => '/dev/null'}, + user => {required => 1}, + maildir => {required => 1}, + prog => {required => 1}, + prefix => {default => ''}, + qmail_dir => {default => '/var/qmail/'}, + logfile => {default => '/dev/null'}, }; sub new { @@ -86,8 +89,12 @@ sub new { $self = {%$cls, %$self}; $cls = $pkg; } - $self = check($QMailAuthuserCheck, $self, 1) || die; - return bless $self, $cls; + local $Params::Check::ALLOW_UNKNOWN = 1; + local $Params::Check::ONLY_ALLOW_DEFINED = 1; + local $Params::Check::WARNINGS_FATAL = 1; + my $s = check($QMailAuthuserCheck, $self) + or die __PACKAGE__ . " creation failed!"; + return bless $s, $cls; } @@ -95,8 +102,8 @@ sub verify_user { my $self = shift; my $auth = shift; - eval { $self->build_and_run($auth, 'auth'); 1 } - or do { + return eval { $self->build_and_run($auth, 'auth'); 1 } + || do { my $e = $@; my $rc = eval { $e->data->{return_code} }; if ($rc == 1) { @@ -115,22 +122,21 @@ sub read_headers_for { my %h = @_; my ($folder, $start, $end, $sort) = @h{qw(folder start end sort)}; - return $self->build_and_run($auth, 'list', [$start, $end, $sort, $folder]); + return $self->build_and_run($auth, 'list', [$folder, $start, $end, $sort]); } sub count { my $self = shift; my ($auth, $folder) = @_; - my $resp = $self->build_and_run($auth, 'count', [$folder]); - return ($resp->{size}, $resp->{count}, $resp->{new}); + return $self->build_and_run($auth, 'count', [$folder]); } sub show { my $self = shift; - my ($auth, $mid) = @_; + my ($auth, $folder, $mid) = @_; - return $self->build_and_run($auth, 'read-mail', [$mid]); + return $self->build_and_run($auth, 'read', [$folder, $mid]); } sub search { @@ -144,23 +150,23 @@ sub folders { my $self = shift; my ($auth) = @_; - return $self->build_and_run($auth, 'folders'); + my $res = $self->build_and_run($auth, 'folders'); + unshift @$res, '' if ref $res eq 'ARRAY'; + return $res; } sub move { my $self = shift; - my ($auth, $mid, $folder) = @_; + my ($auth, $mid, $from_f, $to_f) = @_; - my $_resp = $self->build_and_run($auth, 'move', [$mid, $folder]); + my $_resp = $self->build_and_run($auth, 'move', [$mid, $from_f, $to_f]); return 1; } sub build_arg { my $self = shift; - my $user_mail_addr = shift; - my $mode = shift; - my $args = shift || []; + my ($user_mail_addr, $mode, $args) = @_; return $self->{qmail_dir} . "/bin/qmail-authuser true 3<&0" if $mode eq 'auth'; @@ -169,15 +175,14 @@ 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 = shift; - my $exec = shift; + my ($auth, $exec) = @_; my $pid = open2(my $reader, my $writer, $exec) or die 'failed to create subprocess'; @@ -190,18 +195,28 @@ sub execute { binmode $reader, ':encoding(UTF-8)'; my $input = <$reader>; - close $reader # waits for the child to finish + close $reader or die 'closing read pipe failed'; + waitpid $pid, 0; my $rc = $? >> 8; my $resp; if ($rc == 3 || $rc == 0) { eval { $resp = decode_json $input; 1 } - or $resp = {info => "error decoding response", response => $input, cause => $@, return_code => $rc}; + or $resp = { + info => "error decoding response", + response => $input, + cause => $@, + return_code => $rc, + }; } elsif ($rc) { - $resp = {info => "got unsuccessful return code by qmail-authuser", return_code => $rc, response => $input}; + $resp = { + info => "got unsuccessful return code by qmail-authuser", + return_code => $rc, + response => $input, + }; } return ($resp, $rc); @@ -209,15 +224,14 @@ sub execute { sub build_and_run { my $self = shift; - my $auth = shift; - my $mode = shift; - my $args = shift; + my ($auth, $mode, $args) = @_; my $exec = $self->build_arg($auth->{user}, $mode, $args); my ($resp, $rc) = $self->execute($auth, $exec); if ($rc) { - JWebmail::Model::ReadMails::QMailAuthuser::Error->throw("qmail-authuser connection error", $resp); + JWebmail::Model::ReadMails::QMailAuthuser::Error->throw( + "qmail-authuser connection error", $resp); } return $resp; } @@ -291,5 +305,3 @@ Challenge when using cram =head1 SEE ALSO L<JWebmail::Model::ReadMails>, L<JWebmail::Model::Driver::QMailAuthuser::Extract> - -=cut |