summaryrefslogtreecommitdiff
path: root/lib/JWebmail/Model/ReadMails
diff options
context:
space:
mode:
authorJannis M. Hoffmann <jannis.hoffmann@rwth-aachen.de>2022-04-26 01:06:11 +0200
committerJannis M. Hoffmann <jannis.hoffmann@rwth-aachen.de>2022-04-26 01:06:11 +0200
commitaffff46cea8dad31bb850ec27ba2a57f123e681b (patch)
tree8eca6f4b2c21ca0ea08f33c5ee104070fecee9db /lib/JWebmail/Model/ReadMails
parenteae7431ea9ee9d87634b3938b5cf8b64ebdbfb5a (diff)
adjusted QMailAuthuser to ReadMails Role
Diffstat (limited to 'lib/JWebmail/Model/ReadMails')
-rw-r--r--lib/JWebmail/Model/ReadMails/MockMaildir.pm39
-rw-r--r--lib/JWebmail/Model/ReadMails/QMailAuthuser.pm199
2 files changed, 136 insertions, 102 deletions
diff --git a/lib/JWebmail/Model/ReadMails/MockMaildir.pm b/lib/JWebmail/Model/ReadMails/MockMaildir.pm
index 31e9618..d1746ec 100644
--- a/lib/JWebmail/Model/ReadMails/MockMaildir.pm
+++ b/lib/JWebmail/Model/ReadMails/MockMaildir.pm
@@ -1,36 +1,41 @@
package JWebmail::Model::ReadMails::MockMaildir;
-use Mojo::Base -base;
+use Mojo::Base JWebmail::Model::ReadMails::QMailAuthuser;
use Mojo::JSON 'decode_json';
+use constant {
+ VALID_USER => 'me@mockmaildir.com',
+ VALID_PW => '12345',
+};
-has user => sub { $ENV{USER} };
-has maildir => 't/';
+
+has user => sub { $ENV{USER} };
+has maildir => 't/';
has extractor => 'perl';
our %EXTRACTORS = (
- perl => 'perl lib/JWebmail/Model/Driver/QMailAuthuser/Extract.pm',
+ perl => 'perl script/qmauth.pl',
rust => 'extract/target/debug/jwebmail-extract',
);
-use constant {
- VALID_USER => 'me@mockmaildir.com',
- VALID_PW => '12345',
-};
-sub communicate {
+sub verify_user {
my $self = shift;
- my %args = @_;
+ my $auth = shift;
- if ($args{mode} eq 'auth') {
- return ("", 0) if $args{user} eq VALID_USER && $args{password} eq VALID_PW;
- return ("", 1);
- }
+ return $auth->{user} eq VALID_USER && $auth->{password} eq VALID_PW;
+}
+
+sub build_and_run {
+ my $self = shift;
+ my $auth = shift;
+ my $mode = shift;
+ my $args = shift;
my $mail_user = 'maildir';
- my $exec = $EXTRACTORS{$self->extractor} . ' ' . join(' ', map { $_ =~ s/(['\\])/\\$1/g; "'$_'" } ($self->maildir, $self->user, $mail_user, $args{mode}, @{$args{args}}));
+ my $exec = $EXTRACTORS{$self->extractor} . ' ' . join(' ', map { $_ =~ s/(['\\])/\\$1/g; "'$_'" } ($self->maildir, $self->user, $mail_user, $mode, @$args));
my $pid = open(my $reader, '-|', $exec)
or die 'failed to create subprocess';
@@ -49,9 +54,9 @@ sub communicate {
$resp = {error => "qmail-authuser returned code: $rc"};
}
- return ($resp, $rc);
+ die "error $resp" if $rc;
+ return $resp;
}
1
-
diff --git a/lib/JWebmail/Model/ReadMails/QMailAuthuser.pm b/lib/JWebmail/Model/ReadMails/QMailAuthuser.pm
index 8387217..09b8b9d 100644
--- a/lib/JWebmail/Model/ReadMails/QMailAuthuser.pm
+++ b/lib/JWebmail/Model/ReadMails/QMailAuthuser.pm
@@ -4,8 +4,8 @@ use v5.22;
use warnings;
use utf8;
-use IPC::Open2;
use File::Basename 'fileparse';
+use IPC::Open2;
use JSON::PP 'decode_json';
use Params::Check 'check';
use Scalar::Util 'blessed';
@@ -15,13 +15,67 @@ use namespace::clean;
with 'JWebmail::Model::ReadMails::Role';
+package JWebmail::Model::ReadMails::QMailAuthuser::Error {
+
+ use Data::Dumper 'Dumper';
+
+ use overload
+ '""' => \&to_string,
+ bool => sub {1};
+
+ sub new {
+ my $cls = shift;
+ my $msg = shift;
+ my $self = {message => $msg};
+
+ $self->{data} = $_[0] if @_ == 1;
+ $self->{data} = [@_] if @_ > 1;
+
+ return bless $self;
+ }
+
+ sub to_string {
+ my $self = shift;
+ my $verbose = shift;
+
+ if ($verbose && defined $self->{data}) {
+ my $errstr = Data::Dumper->new([$self->{data}])->Terse(1)->Indent(0)->Quotekeys(0)->Dump;
+ return "$self->{message}: $errstr";
+ }
+ else {
+ return $self->{message};
+ }
+ }
+
+ sub throw {
+ my $cls = shift;
+ my $msg = shift;
+
+ die $cls->new($msg, @_)->_trace;
+ }
+
+ # taken from Mojo::Exception
+ sub _trace {
+ my ($self, $start) = (shift, shift // 1);
+ my @frames;
+ while (my @trace = caller($start++)) { push @frames, \@trace }
+ $self->{frames} = \@frames;
+ }
+
+ sub message { shift->{message} }
+ sub data { shift->{data} }
+ sub frames { shift->{frames} }
+
+}
+
+
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'},
- prog => {defined => 1, default => ([fileparse(__FILE__)]->[1] . '/QMailAuthuser/Extract.pm')},
};
sub new {
@@ -36,16 +90,22 @@ sub new {
return bless $self, $cls;
}
+
sub verify_user {
my $self = shift;
my $auth = shift;
- return !scalar $self->communicate(
- user => $auth->{user},
- password => $auth->{password},
- challenge => $auth->{challenge},
- mode => 'auth',
- )
+ eval { $self->build_and_run($auth, 'auth'); 1 }
+ or do {
+ my $e = $@;
+ my $rc = eval { $e->data->{return_code} };
+ if ($rc == 1) {
+ return '';
+ }
+ else {
+ die $e;
+ }
+ };
}
sub read_headers_for {
@@ -55,122 +115,75 @@ sub read_headers_for {
my %h = @_;
my ($folder, $start, $end, $sort) = @h{qw(folder start end sort)};
- my ($resp, $rc) = $self->communicate(
- user => $auth->{user},
- password => $auth->{password},
- challenge => $auth->{challenge},
- mode => 'list',
- args => [$start // 0, $end // 0, $sort // 'date', $folder // ''],
- );
- die "connection error: $resp->{error}" if $rc;
- return $resp;
+ return $self->build_and_run($auth, 'list', [$start, $end, $sort, $folder]);
}
sub count {
my $self = shift;
-
my ($auth, $folder) = @_;
- my ($resp, $rc) = $self->communicate(
- user => $auth->{user},
- password => $auth->{password},
- challenge => $auth->{challenge},
- mode => 'count',
- args => [$folder],
- );
- die "connection error: $resp->{error}" if $rc;
+ my $resp = $self->build_and_run($auth, 'count', [$folder]);
return ($resp->{size}, $resp->{count}, $resp->{new});
}
sub show {
my $self = shift;
-
my ($auth, $mid) = @_;
- my ($resp, $rc) = $self->communicate(
- user => $auth->{user},
- password => $auth->{password},
- challenge => $auth->{challenge},
- mode => 'read-mail',
- args => [$mid],
- );
- die "connection error: $resp->{error}, $resp->{mid}" if $rc;
- return $resp;
+ return $self->build_and_run($auth, 'read-mail', [$mid]);
}
sub search {
my $self = shift;
-
my ($auth, $pattern, $folder) = @_;
- my ($resp, $rc) = $self->communicate(
- user => $auth->{user},
- password => $auth->{password},
- challenge => $auth->{challenge},
- mode => 'search',
- args => [$pattern, $folder],
- );
- die "connection error: $resp->{error}" if $rc;
- return $resp;
+ return $self->build_and_run($auth, 'search', [$pattern, $folder]);
}
sub folders {
my $self = shift;
-
my ($auth) = @_;
- my ($resp, $rc) = $self->communicate(
- user => $auth->{user},
- password => $auth->{password},
- challenge => $auth->{challenge},
- mode => 'folders',
- );
- die "connection error: $resp->{error}" if $rc;
- return $resp;
+ return $self->build_and_run($auth, 'folders');
}
sub move {
my $self = shift;
-
my ($auth, $mid, $folder) = @_;
- my ($resp, $rc) = $self->communicate(
- user => $auth->{user},
- password => $auth->{password},
- challenge => $auth->{challenge},
- mode => 'move',
- args => [$mid, $folder],
- );
- die "connection error: $resp->{error}" if $rc;
+ my $_resp = $self->build_and_run($auth, 'move', [$mid, $folder]);
return 1;
}
-sub communicate {
+
+sub build_arg {
my $self = shift;
- my %args = @_;
+ my $user_mail_addr = shift;
+ my $mode = shift;
+ my $args = shift || [];
- $args{challenge} //= '';
- $args{args} //= [];
+ return $self->{qmail_dir} . "/bin/qmail-authuser true 3<&0"
+ if $mode eq 'auth';
- my $exec = do {
- if ($args{mode} eq 'auth') {
- $self->{qmail_dir} . "/bin/qmail-authuser true 3<&0";
- }
- else {
- my ($user_name) = $args{user} =~ /(\w*)@/;
+ my ($user_name) = $user_mail_addr =~ /(\w*)@/;
- $self->{qmail_dir}.'/bin/qmail-authuser'
- . $self->{prefix} . ' '
- . join(' ', map { s/(['\\])/\\$1/g; "'$_'" } ($self->{prog}, $self->{maildir}, $self->{user}, $user_name, $args{mode}, @{$args{args}}))
- . ' 3<&0'
- . ' 2>>'.$self->{logfile};
- }
- };
+ return $self->{qmail_dir}.'/bin/qmail-authuser'
+ . $self->{prefix} . ' '
+ . join(' ', map { s/(['\\])/\\$1/g; "'$_'" } ($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 $pid = open2(my $reader, my $writer, $exec)
or die 'failed to create subprocess';
- $writer->print("$args{user}\0$args{password}\0$args{challenge}\0")
+ my $challenge = $auth->{challenge} || '';
+ $writer->print("$auth->{user}\0$auth->{password}\0$challenge\0")
or die 'pipe wite failed';
close $writer
or die 'closing write pipe failed';
@@ -185,16 +198,32 @@ sub communicate {
my $resp;
if ($rc == 3 || $rc == 0) {
- eval { $resp = decode_json $input; };
- if ($@) { $resp = {error => 'decoding error'} };
+ eval { $resp = decode_json $input; 1 }
+ or $resp = {info => "error decoding response", response => $input, cause => $@, return_code => $rc};
}
elsif ($rc) {
- $resp = {error => "qmail-authuser returned code: $rc"};
+ $resp = {info => "got unsuccessful return code by qmail-authuser", return_code => $rc, response => $input};
}
return ($resp, $rc);
}
+sub build_and_run {
+ my $self = shift;
+ my $auth = shift;
+ my $mode = shift;
+ my $args = shift;
+
+ 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);
+ }
+ return $resp;
+}
+
+
1
__END__