summaryrefslogtreecommitdiff
path: root/lib/JWebmail
diff options
context:
space:
mode:
Diffstat (limited to 'lib/JWebmail')
-rw-r--r--lib/JWebmail/Config.pm.in4
-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
-rw-r--r--lib/JWebmail/Model/WriteMails.pm28
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);
}
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-24 02:26:18 +0000