summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/JWebmail.pm37
-rw-r--r--lib/JWebmail/Config.pm.in25
-rw-r--r--lib/JWebmail/Controller/Webmail.pm17
-rw-r--r--lib/JWebmail/Model/ReadMails/MockJSON.pm16
-rw-r--r--lib/JWebmail/Model/ReadMails/MockMaildir.pm23
-rw-r--r--lib/JWebmail/Model/ReadMails/QMailAuthuser.pm23
-rw-r--r--lib/JWebmail/Model/WriteMails.pm6
-rw-r--r--lib/JWebmail/Plugin/I18N2/Maketext.pm19
8 files changed, 83 insertions, 83 deletions
diff --git a/lib/JWebmail.pm b/lib/JWebmail.pm
index e2c291c..993ad59 100644
--- a/lib/JWebmail.pm
+++ b/lib/JWebmail.pm
@@ -8,6 +8,7 @@ use JWebmail::Controller::Webmail;
use JWebmail::Model::ReadMails::Role;
use JWebmail::Model::ReadMails::QMailAuthuser;
use JWebmail::Model::WriteMails;
+use JWebmail::Config qw'LOGIN_SCHEME MAILDIR_READER';
sub validateConf {
@@ -15,11 +16,16 @@ sub validateConf {
my $conf = $self->config;
- exists $conf->{session}{secure} or die;
- grep(sub { $_ eq $conf->{session}{secure} }, qw(none cram s3d)) > 0 or die;
+ exists $conf->{admin_mail} or die;
+ $conf->{admin_mail} =~ /@/ or die;
- exists $conf->{defaults}{scriptadmin} or die;
- $conf->{defaults}{scriptadmin} =~ /@/ or die;
+ exists $conf->{i18n}{default_language} or die;
+ $conf->{i18n}{default_language} =~ /^[\w_]+$/a or die;
+
+ exists $conf->{model}{read}{virtual_user} or die;
+ getpwnam $conf->{model}{read}{virtual_user} or die;
+ exists $conf->{model}{read}{mailbox_path} or die;
+ -d $conf->{model}{read}{mailbox_path} or die;
return 1;
}
@@ -36,11 +42,7 @@ sub startup {
$self->plugin('TOMLConfig');
$self->validateConf;
- if (my $logpath = $self->config('logpath')) {
- $self->log->path($logpath . '/' . $self->mode . '.log');
- }
-
- if (fc $self->config->{session}{secure} eq fc 's3d') {
+ if (fc LOGIN_SCHEME eq fc 's3d') {
$self->plugin('ServerSideSessionData');
}
$self->plugin('Paginate');
@@ -51,23 +53,14 @@ sub startup {
# initialize models
my $read_mails = do {
- if ($self->mode eq 'development') {
- my $cls = $self->config->{model}{read}{devel}{driver};
- eval { load $cls; 1 } || die "Issue for module $cls with: $@";
- $cls->new(($self->config->{model}{read}{devel} // {})->%*)
- }
- else {
- JWebmail::Model::ReadMails::QMailAuthuser->new(
- ($self->config->{model}{read}{prod} // {})->%*
- )
- }
+ my $cls = MAILDIR_READER;
+ eval { load $cls; 1 } || die "Issue for module $cls with: $@";
+ $cls->new(($self->config->{model}{read} // {})->%*)
};
die "given class @{[ ref $read_mails ]} does not ReadMails"
unless $read_mails->DOES('JWebmail::Model::ReadMails::Role');
$self->helper(users => sub { $read_mails });
$self->helper(send_mail => sub { my ($c, $mail) = @_; JWebmail::Model::WriteMails::sendmail($mail) });
- $JWebmail::Model::WriteMails::Block_Writes = 1
- if $self->mode eq 'development' && $self->config->{model}{write}{devel}{block_writes};
$self->validator->add_check(mail_line => \&_mail_line);
$self->validator->add_filter(non_empty_ul => \&_filter_empty_upload);
@@ -149,7 +142,7 @@ JWebmail - Provides a web based e-mail client meant to be used with s/qmail.
hypnotoad script/jwebmail
-And use a server in reverse proxy configuration.
+And use a server in reverse proxy configuration.
=head1 DESCRIPTION
diff --git a/lib/JWebmail/Config.pm.in b/lib/JWebmail/Config.pm.in
new file mode 100644
index 0000000..e91f933
--- /dev/null
+++ b/lib/JWebmail/Config.pm.in
@@ -0,0 +1,25 @@
+package JWebmail::Config;
+
+use v5.24;
+use warnings;
+use utf8;
+
+use Exporter 'import';
+our @EXPORT_OK = qw(MAILDIR_READER MAILDIR_EXTRACTOR SENDMAIL LOGIN_SCHEME);
+
+use constant {
+ MAILDIR_READER => '@JWM_READ_MODEL@',
+ MAILDIR_EXTRACTOR => '@MAILDIR_EXTRACTOR_BIN@',
+ SENDMAIL => '@SENDMAIL@',
+ LOGIN_SCHEME => fc '@LOGIN_SCHEME@',
+};
+
+1
+
+__END__
+
+=encoding utf-8
+
+=head1 NAME
+
+JWebmail::Config - Fixed configuration parameters
diff --git a/lib/JWebmail/Controller/Webmail.pm b/lib/JWebmail/Controller/Webmail.pm
index e06a8f7..94df668 100644
--- a/lib/JWebmail/Controller/Webmail.pm
+++ b/lib/JWebmail/Controller/Webmail.pm
@@ -8,6 +8,7 @@ use List::Util qw(any first);
use Mojo::Util qw(encode decode b64_encode b64_decode);
use Mojolicious::Types;
+use JWebmail::Config 'LOGIN_SCHEME';
use JWebmail::View::Webmail;
use JWebmail::View::RenderMail;
@@ -72,7 +73,7 @@ sub _time :prototype(&$$) {
sub login {
my $self = shift;
- my $uses_cram = $self->config->{session}{secure} eq 'cram';
+ my $uses_cram = LOGIN_SCHEME eq fc 'cram_md5';
my $v = $self->validation;
@@ -338,12 +339,12 @@ sub _rand_data {
sub _session_passwd {
my ($self, $passwd, $challenge) = @_;
- my $secAlg = $self->config->{session}{secure};
+ my $secAlg = LOGIN_SCHEME;
$self->_warn_crypt;
if (defined $passwd) { # set
- if ($secAlg eq 'cram') {
+ if ($secAlg eq fc 'cram_md5') {
$self->session(S_PASSWD() => $passwd, challenge => $challenge);
}
elsif ($secAlg eq 's3d') {
@@ -352,7 +353,7 @@ sub _session_passwd {
delete $self->session->{S_OTP_S3D_PW()};
return;
}
- die "'$passwd' contains invalid character \\n" if $passwd =~ /\n/;
+ die "'$passwd' contains invalid character \\n" if $passwd =~ /\n/;
if (length $passwd < 20) {
$passwd .= "\n" . ' ' x (20 - length($passwd) - 1);
}
@@ -366,7 +367,7 @@ sub _session_passwd {
}
}
else { # get
- if ($secAlg eq 'cram') {
+ if ($secAlg eq fc 'cram_md5') {
wantarray or carp "you forgot the challenge";
return ($self->session(S_PASSWD), $self->session('challenge'));
}
@@ -472,18 +473,18 @@ Currently the following modes are supported:
=over 6
-=item none
+=item none
The password is plainly stored in session cookie.
The cookie is stored on the client side and send with every request.
-=item cram
+=item cram
A nonce is send to the client and the cram_md5 is generated there via js
and crypto-js.
This is vulnurable to replay attacks as the nonce is not invalidated ever.
-=item s3d
+=item s3d
The password is stored on the server. Additionally the password is encrypted
by an one-time-pad that is stored in the users cookie.
diff --git a/lib/JWebmail/Model/ReadMails/MockJSON.pm b/lib/JWebmail/Model/ReadMails/MockJSON.pm
index 64d6873..9ad5f09 100644
--- a/lib/JWebmail/Model/ReadMails/MockJSON.pm
+++ b/lib/JWebmail/Model/ReadMails/MockJSON.pm
@@ -21,14 +21,12 @@ use constant {
with 'JWebmail::Model::ReadMails::Role';
-sub new { bless {}, shift }
+sub new { bless {%$_[1]}, shift }
sub _read_json_file {
- my ($file_name) = @_;
+ my ($self, $file_name) = @_;
- use constant PREFIX => 't/testdata/json/';
-
- open my $body_file, '<', PREFIX . $file_name;
+ open my $body_file, '<', $self->{mailbox_path} . '/' . $file_name;
local $/;
my $body = <$body_file>;
close $body_file;
@@ -37,13 +35,15 @@ sub _read_json_file {
}
sub list_reply {
- state $init = _read_json_file('msgs.json');
+ 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('msg2.json'),
- 'example' => _read_json_file('msg.json'),
+ 'SC-ORD-MAIL54526c63b751646618a793be3f8329cca@sc-ord-mail5' => _read_json_file($self, 'msg2.json'),
+ 'example' => _read_json_file($self, 'msg.json'),
};
}
diff --git a/lib/JWebmail/Model/ReadMails/MockMaildir.pm b/lib/JWebmail/Model/ReadMails/MockMaildir.pm
index fc9cc4a..f9d530f 100644
--- a/lib/JWebmail/Model/ReadMails/MockMaildir.pm
+++ b/lib/JWebmail/Model/ReadMails/MockMaildir.pm
@@ -4,35 +4,26 @@ use Mojo::Base 'JWebmail::Model::ReadMails::QMailAuthuser';
use Mojo::JSON 'decode_json';
-use Digest::HMAC_MD5 'hmac_md5_hex';
+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',
};
-has user => sub { $ENV{USER} };
-has maildir => 't/testdata/';
-has extractor => 'python';
-
-our %EXTRACTORS = (
- perl => 'script/qmauth.pl',
- python => 'script/qmauth.py',
- rust => 'bin/jwebmail-extract',
-);
-
sub new {
my $cls = shift;
my %args = @_ == 1 ? %$_[0] : @_;
my $self = bless {%args}, ref $cls || $cls;
- $self->user;
- $self->maildir;
- $self->next::method(prog => $EXTRACTORS{$self->extractor});
- return $self;
+ return $self->next::method();
}
@@ -56,7 +47,7 @@ sub start_qmauth {
my ($auth, $mode, $args) = @_;
my $mail_user = 'maildir';
- my @exec = ($EXTRACTORS{$self->extractor}, $self->maildir, $self->user, $mail_user, $mode, @$args);
+ 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: $!";
diff --git a/lib/JWebmail/Model/ReadMails/QMailAuthuser.pm b/lib/JWebmail/Model/ReadMails/QMailAuthuser.pm
index 19f8b12..b2015aa 100644
--- a/lib/JWebmail/Model/ReadMails/QMailAuthuser.pm
+++ b/lib/JWebmail/Model/ReadMails/QMailAuthuser.pm
@@ -1,10 +1,9 @@
package JWebmail::Model::ReadMails::QMailAuthuser;
-use v5.22;
+use v5.24;
use warnings;
use utf8;
-use File::Basename 'fileparse';
use IPC::Open2;
use JSON::PP 'decode_json';
use Params::Check 'check';
@@ -12,6 +11,8 @@ use Role::Tiny::With;
use Scalar::Util 'blessed';
use namespace::clean;
+use JWebmail::Config 'MAILDIR_EXTRACTOR';
+
with 'JWebmail::Model::ReadMails::Role';
@@ -73,12 +74,9 @@ package JWebmail::Model::ReadMails::QMailAuthuser::Error {
my $QMailAuthuserCheck = {
- user => {required => 1},
- maildir => {required => 1},
- prog => {required => 1},
- prefix => {default => ''},
- qmail_dir => {default => '/var/qmail/'},
- logfile => {default => '/dev/null'},
+ virtual_user => {required => 1},
+ mailbox_path => {required => 1},
+ qmail_dir => {default => '/var/qmail/'},
};
sub new {
@@ -94,6 +92,7 @@ sub new {
local $Params::Check::WARNINGS_FATAL = 1;
my $s = check($QMailAuthuserCheck, $self)
or die __PACKAGE__ . " creation failed!";
+ $s->{prog} = MAILDIR_EXTRACTOR;
return bless $s, $cls;
}
@@ -180,11 +179,9 @@ sub build_arg {
my ($user_name) = $user_mail_addr =~ /(\w*)@/;
- 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))
- . ' 3<&0'
- . ' 2>>'.$self->{logfile};
+ return $self->{qmail_dir}.'/bin/qmail-authuser '
+ . join(' ', map { my $x = s/(['\\])/\\$1/gr; "'$x'" } ($self->{prog}, $self->{mailbox_path}, $self->{virtual_user}, $user_name, $mode, @$args))
+ . ' 3<&0';
}
sub start_qmauth {
diff --git a/lib/JWebmail/Model/WriteMails.pm b/lib/JWebmail/Model/WriteMails.pm
index 05c4cd1..751192a 100644
--- a/lib/JWebmail/Model/WriteMails.pm
+++ b/lib/JWebmail/Model/WriteMails.pm
@@ -1,9 +1,11 @@
package JWebmail::Model::WriteMails;
-use v5.18;
+use v5.24;
use warnings;
use utf8;
+use JWebmail::Config 'SENDMAIL';
+
use Exporter 'import';
our @EXPORT_OK = qw(sendmail);
@@ -51,7 +53,7 @@ sub _build_mail {
sub _send {
my ($mime, @recipients) = @_;
- open(my $m, '|-', 'sendmail', '-i', @recipients)
+ open(my $m, '|-', SENDMAIL, '-i', @recipients)
or die 'Connecting to sendmail failed. Is it in your PATH?';
$m->print($mime->as_string());
close($m);
diff --git a/lib/JWebmail/Plugin/I18N2/Maketext.pm b/lib/JWebmail/Plugin/I18N2/Maketext.pm
index ef3b08d..1046a99 100644
--- a/lib/JWebmail/Plugin/I18N2/Maketext.pm
+++ b/lib/JWebmail/Plugin/I18N2/Maketext.pm
@@ -1,12 +1,12 @@
package JWebmail::Plugin::I18N2::Maketext;
-use v5.22;
+use v5.24;
use warnings;
use utf8;
use JWebmail::I18N;
-use File::Basename 'fileparse';
+use Mojo::File qw(path curfile);
use Role::Tiny::With;
with 'JWebmail::Plugin::I18N2::Role';
@@ -16,19 +16,10 @@ sub new {
my $class = shift;
my $conf = @_ == 1 ? shift : {@_};
- my $lexica = $conf->{directory};
+ my $lexica = curfile->dirname->child('..', '..', 'I18N');
- my @languages = keys %{$conf->{languages} // {}};
-
- unless (@languages) {
- use autodie;
-
- opendir(my $dh, $lexica);
- my @res = grep { /\.pm$/ && -f "$lexica/$_" } readdir $dh;
- closedir($dh);
- @languages = map { scalar fileparse $_, '.pm' } @res;
- @languages = map { my ($l, $c) = split '_', $_, 2; $c ? "$l-\U$c" : $l } @languages;
- }
+ my $res = $lexica->list()->map('basename', '.pm');
+ my @languages = map { my ($l, $c) = split '_', $_, 2; $c ? "$l-\U$c" : $l } @$res;
if (my $dl = $conf->{default_language}) { push @languages, $dl; };
my $self = {};