diff options
Diffstat (limited to 'lib')
-rw-r--r-- | lib/JWebmail.pm | 37 | ||||
-rw-r--r-- | lib/JWebmail/Config.pm.in | 25 | ||||
-rw-r--r-- | lib/JWebmail/Controller/Webmail.pm | 17 | ||||
-rw-r--r-- | lib/JWebmail/Model/ReadMails/MockJSON.pm | 16 | ||||
-rw-r--r-- | lib/JWebmail/Model/ReadMails/MockMaildir.pm | 23 | ||||
-rw-r--r-- | lib/JWebmail/Model/ReadMails/QMailAuthuser.pm | 23 | ||||
-rw-r--r-- | lib/JWebmail/Model/WriteMails.pm | 6 | ||||
-rw-r--r-- | lib/JWebmail/Plugin/I18N2/Maketext.pm | 19 |
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 = {}; |