added test pam to replace MockMaildir ReadMail implementation

5 files changed, 20 insertions, 231 deletions

diff --git a/lib/JWebmail/Config.pm.in b/lib/JWebmail/Config.pm.in
index e91f933..a899024 100644
--- a/lib/JWebmail/Config.pm.in
+++ b/lib/JWebmail/Config.pm.in
@@ -5,12 +5,10 @@ use warnings;
 use utf8;
 
 use Exporter 'import';
-our @EXPORT_OK = qw(MAILDIR_READER MAILDIR_EXTRACTOR SENDMAIL LOGIN_SCHEME);
+our @EXPORT_OK = qw(MAILDIR_EXTRACTOR LOGIN_SCHEME);
 
 use constant {
-    MAILDIR_READER    => '@JWM_READ_MODEL@',
     MAILDIR_EXTRACTOR => '@MAILDIR_EXTRACTOR_BIN@',
-    SENDMAIL          => '@SENDMAIL@',
     LOGIN_SCHEME      => fc '@LOGIN_SCHEME@',
 };
 
diff --git a/lib/JWebmail/Model/ReadMails/MockJSON.pm b/lib/JWebmail/Model/ReadMails/MockJSON.pm
deleted file mode 100644
index 70daf8f..0000000
--- a/lib/JWebmail/Model/ReadMails/MockJSON.pm
+++ /dev/null
@@ -1,137 +0,0 @@
-package JWebmail::Model::ReadMails::MockJSON;
-
-use v5.24;
-use warnings;
-use utf8;
-use autodie;
-
-use List::Util 'sum';
-use JSON::PP 'decode_json';
-
-use JWebmail::Config 'LOGIN_SCHEME';
-
-if (LOGIN_SCHEME eq fc 'cram_md5') {
-    require Digest::HMAC_MD5;
-    Digest::HMAC_MD5->import('hmac_md5_hex');
-}
-
-use Role::Tiny::With;
-
-use namespace::clean;
-
-use constant {
-    VALID_USER => 'mockjson@example.org',
-    VALID_PW   => '12345',
-};
-
-with 'JWebmail::Model::ReadMails::Role';
-
-
-sub new { bless {%$_[1]}, shift }
-
-sub _read_json_file {
-    my ($self, $file_name) = @_;
-
-    open my $body_file, '<', $self->{mailbox_path} . '/' . $file_name;
-    local $/;
-    my $body = <$body_file>;
-    close $body_file;
-
-    return decode_json($body);
-}
-
-sub list_reply {
-    my $self = shift;
-    state $init = _read_json_file($self, 'msgs.json');
-}
-
-sub read_reply {
-    my $self = shift;
-    state $init = {
-        'SC-ORD-MAIL54526c63b751646618a793be3f8329cca@sc-ord-mail5' => _read_json_file($self, 'msg2.json'),
-        'example' => _read_json_file($self, 'msg.json'),
-    };
-}
-
-
-sub verify_user {
-    my $self = shift;
-    my $auth = shift;
-
-    if ($auth->{challenge}) {
-        my $res = hmac_md5_hex($auth->{challenge}, VALID_PW);
-        return $auth->{user} eq VALID_USER && $auth->{password} eq $res;
-    }
-    return $auth->{user} eq VALID_USER && $auth->{password} eq VALID_PW;
-}
-
-sub read_headers_for {
-    my $self = shift;
-    my $auth = shift;
-    my %args = @_;
-
-    my ($start, $end, $sort, $folder) = @args{qw(start end sort folder)};
-
-    unless ($sort) {
-        return [@{ $self->list_reply }[$start..$end]];
-    }
-    if ($folder eq 'test') {
-        return [];
-    }
-    my $s = sub {
-        my $sort_by = $sort;
-        my $rev = $sort_by !~ m/^!/ ? 1 : -1;
-        $sort_by =~ s/^!//;
-        return (($a->{$sort_by}||$a->{head}{$sort_by}) cmp ($b->{$sort_by}||$b->{head}{$sort_by})) * $rev;
-    };
-    return [sort { &$s } @{ $self->list_reply }[$start..$end]];
-}
-
-sub count {
-    my $self = shift;
-    my $auth = shift;
-    my $_folder = shift;
-
-    return (
-        sum(map {$_->{size}} @{ $self->list_reply }), # size
-        scalar(@{ $self->list_reply }), # count
-        0, # new
-    );
-}
-
-sub show {
-    my $self = shift;
-    my $auth = shift;
-    my $mid = shift;
-
-    my $mail = $self->read_reply->{$mid};
-    if ($mail) {
-        return $mail;
-    }
-    else {
-        die 'unknown mail-id';
-    }
-}
-
-sub folders { ['', qw(cur test devel debug)] }
-
-sub raw {
-    my $self = shift;
-    my ($auth, $folder, $mid, $path) = @_;
-
-    ...
-}
-
-sub search { ... }
-sub move { ... }
-
-
-1
-
-__END__
-
-=head1 NAME
-
-Mock - Simple file based mock for the L<JWebmail::Model::ReadMails> module.
-
-=cut
diff --git a/lib/JWebmail/Model/ReadMails/MockMaildir.pm b/lib/JWebmail/Model/ReadMails/MockMaildir.pm
deleted file mode 100644
index f9d530f..0000000
--- a/lib/JWebmail/Model/ReadMails/MockMaildir.pm
+++ /dev/null
@@ -1,59 +0,0 @@
-package JWebmail::Model::ReadMails::MockMaildir;
-
-use Mojo::Base 'JWebmail::Model::ReadMails::QMailAuthuser';
-
-use Mojo::JSON 'decode_json';
-
-use JWebmail::Config 'LOGIN_SCHEME';
-
-if (LOGIN_SCHEME eq fc 'cram_md5') {
-    require Digest::HMAC_MD5;
-    Digest::HMAC_MD5->import('hmac_md5_hex');
-}
-
-use constant {
-    VALID_USER => 'mockmaildir@example.org',
-    VALID_PW   => '12345',
-};
-
-
-sub new {
-    my $cls = shift;
-    my %args = @_ == 1 ? %$_[0] : @_;
-
-    my $self = bless {%args}, ref $cls || $cls;
-
-    return $self->next::method();
-}
-
-
-sub verify_user {
-    my $self = shift;
-    my $auth = shift;
-
-    my $passwd = $auth->{password}->show_password;
-
-    if ($auth->{challenge}) {
-        return $auth->{user} eq VALID_USER &&
-            $passwd eq hmac_md5_hex($auth->{challenge}, VALID_PW);
-    }
-    else {
-        return $auth->{user} eq VALID_USER && $passwd eq VALID_PW;
-    }
-}
-
-sub start_qmauth {
-    my $self = shift;
-    my ($auth, $mode, $args) = @_;
-
-    my $mail_user = 'maildir';
-    my @exec = ($self->{prog}, $self->{mailbox_path}, $self->{virtual_user}, $mail_user, $mode, @$args);
-
-    my $pid = open(my $reader, '-|', @exec)
-        or die "failed to create subprocess: $!";
-
-    return $pid, $reader;
-}
-
-
-1
diff --git a/lib/JWebmail/Model/ReadMails/QMailAuthuser.pm b/lib/JWebmail/Model/ReadMails/QMailAuthuser.pm
index b2015aa..5190e26 100644
--- a/lib/JWebmail/Model/ReadMails/QMailAuthuser.pm
+++ b/lib/JWebmail/Model/ReadMails/QMailAuthuser.pm
@@ -4,6 +4,8 @@ use v5.24;
 use warnings;
 use utf8;
 
+use JWebmail::Config 'MAILDIR_EXTRACTOR';
+
 use IPC::Open2;
 use JSON::PP 'decode_json';
 use Params::Check 'check';
@@ -11,7 +13,6 @@ use Role::Tiny::With;
 use Scalar::Util 'blessed';
 use namespace::clean;
 
-use JWebmail::Config 'MAILDIR_EXTRACTOR';
 
 with 'JWebmail::Model::ReadMails::Role';
 
@@ -74,9 +75,9 @@ package JWebmail::Model::ReadMails::QMailAuthuser::Error {
 
 
 my $QMailAuthuserCheck = {
-    virtual_user => {required => 1},
-    mailbox_path => {required => 1},
-    qmail_dir    => {default => '/var/qmail/'},
+    virtual_user  => {required => 1},
+    mailbox_path  => {required => 1},
+    authenticator => {required => 1},
 };
 
 sub new {
@@ -174,12 +175,12 @@ sub build_arg {
     my $self = shift;
     my ($user_mail_addr, $mode, $args) = @_;
 
-    return $self->{qmail_dir} . "/bin/qmail-authuser true 3<&0"
+    return $self->{authenticator} . ' true 3<&0'
         if $mode eq 'auth';
 
     my ($user_name) = $user_mail_addr =~ /(\w*)@/;
 
-    return $self->{qmail_dir}.'/bin/qmail-authuser '
+    return $self->{authenticator} . ' '
     . join(' ', map { my $x = s/(['\\])/\\$1/gr; "'$x'" } ($self->{prog}, $self->{mailbox_path}, $self->{virtual_user}, $user_name, $mode, @$args))
     . ' 3<&0';
 }
@@ -210,11 +211,6 @@ sub read_qmauth {
 
     my $rs;
     if (eof $reader) {
-        # for regular open
-        close $reader
-            or warn "closing read pipe failed: $!";
-        $rs = $?;
-
         # for IPC::Open2
         if (waitpid($pid, 0) == $pid) {
             $rs = $?;
@@ -244,18 +240,19 @@ sub read_qmauth {
         };
     }
     elsif ($rs == 3 << 8 || $rs == 0) {
+        $rc = $rs >> 8;
         eval { $resp = decode_json $input if $input; 1 }
             or do {
                 $resp = {
                     info => "error decoding response",
                     response => $input,
                     cause => $@,
-                    return_code => $rs >> 8,
+                    return_code => $rc,
                 };
-                $rc = 3;
             };
     }
     else {
+        $rc = $rs >> 8;
         $resp = {
             info        => "got unsuccessful return code by qmail-authuser",
             return_code => $rc,
diff --git a/lib/JWebmail/Model/WriteMails.pm b/lib/JWebmail/Model/WriteMails.pm
index 751192a..330f709 100644
--- a/lib/JWebmail/Model/WriteMails.pm
+++ b/lib/JWebmail/Model/WriteMails.pm
@@ -1,21 +1,15 @@
 package JWebmail::Model::WriteMails;
 
-use v5.24;
-use warnings;
-use utf8;
-
-use JWebmail::Config 'SENDMAIL';
-
-use Exporter 'import';
-our @EXPORT_OK = qw(sendmail);
-
 use Email::MIME;
+use namespace::clean;
 
+use Mojo::Base -base;
 
-our $Block_Writes = 0;
+has 'sendmail_bin';
 
 
 sub _build_mail {
+    my $self = shift;
     my $mail = shift;
 
     my $text_part = Email::MIME->create(
@@ -51,9 +45,9 @@ sub _build_mail {
 
 
 sub _send {
-    my ($mime, @recipients) = @_;
+    my ($self, $mime, @recipients) = @_;
 
-    open(my $m, '|-', SENDMAIL, '-i', @recipients)
+    open(my $m, '|-', $self->sendmail_bin, '-i', @recipients)
         or die 'Connecting to sendmail failed. Is it in your PATH?';
     $m->print($mime->as_string());
     close($m);
@@ -62,21 +56,17 @@ sub _send {
 
 
 sub sendmail {
+    my $self = shift;
     my $mail = shift;
 
-    my $mime = _build_mail($mail);
+    my $mime = $self->_build_mail($mail);
 
     my @recipients;
     push @recipients, @{ $mail->{to} } if $mail->{to};
     push @recipients, @{ $mail->{cc} } if $mail->{cc};
     push @recipients, @{ $mail->{bcc} } if $mail->{bcc};
 
-    if ($Block_Writes) {
-        say $mime;
-        return 1;
-    }
-
-    return _send($mime, @recipients);
+    return $self->_send($mime, @recipients);
 }