summaryrefslogtreecommitdiff
path: root/lib/JWebmail/Model/ReadMails
diff options
context:
space:
mode:
Diffstat (limited to 'lib/JWebmail/Model/ReadMails')
-rw-r--r--lib/JWebmail/Model/ReadMails/MockJSON.pm137
-rw-r--r--lib/JWebmail/Model/ReadMails/MockMaildir.pm59
-rw-r--r--lib/JWebmail/Model/ReadMails/QMailAuthuser.pm23
3 files changed, 10 insertions, 209 deletions
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,