summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/JWebmail.pm8
-rw-r--r--lib/JWebmail/Controller/Webmail.pm101
-rw-r--r--lib/JWebmail/Model/ReadMails/MockMaildir.pm39
-rw-r--r--lib/JWebmail/Model/ReadMails/QMailAuthuser.pm199
4 files changed, 188 insertions, 159 deletions
diff --git a/lib/JWebmail.pm b/lib/JWebmail.pm
index 82c94c1..8def434 100644
--- a/lib/JWebmail.pm
+++ b/lib/JWebmail.pm
@@ -92,13 +92,13 @@ And use a server in reverse proxy configuration.
=head1 CONFIGURATION
-Use the jwebmail.conf file.
+Use the I<jwebmail.conf> file or for a specific I<$mode> the I<jwebmail.$mode.conf>.
=head1 AUTHORS
-Copyright (C) 2020 Jannis M. Hoffmann L<jannis@fehcom.de>
+Copyright (C) 2020-2022 Jannis M. Hoffmann L<jannis@fehcom.de>
-=head1 BASED ON
+=head1 BASED ON IDEAS
Copyright (C) 2001 Olivier Müller L<om@omnis.ch> (GPLv2+ project: oMail Webmail)
@@ -108,7 +108,7 @@ See the CREDITS file for project contributors.
=head1 LICENSE
-This module is licensed under the terms of the GPLv3 or any later version at your option.
+This module is licensed under the terms of the GPLv3.
Please take a look at the provided LICENSE file shipped with this module.
=cut
diff --git a/lib/JWebmail/Controller/Webmail.pm b/lib/JWebmail/Controller/Webmail.pm
index 6e3ff8b..6754ac7 100644
--- a/lib/JWebmail/Controller/Webmail.pm
+++ b/lib/JWebmail/Controller/Webmail.pm
@@ -62,8 +62,7 @@ sub login {
my $passwd = $v->required('password')->size(4, 50)->like(qr/^.+$/)->param; # no new-lines
if ($v->has_error) {
- $self->res->code(400);
- return $self->render(action => 'noaction');
+ return $self->render(action => 'noaction', status => 400);
}
my $auth = $self->users->Auth(user => $user, password => $passwd);
@@ -77,8 +76,9 @@ sub login {
$self->redirect_to('displayheaders');
}
else {
- $self->res->code(401);
- $self->render(action => 'noaction',
+ $self->render(
+ status => 401,
+ action => 'noaction',
warning => $self->l('login') . ' ' . $self->l('failed') . '!',
);
}
@@ -123,8 +123,8 @@ sub displayheaders {
my $folders = _time { $self->users->folders($auth) } $self, 'user folders';
unless ( $self->stash('folder') ~~ $folders ) {
- $self->res->code(404);
$self->render(template => 'error',
+ status => 404,
error => $self->l('no_folder'),
links => [map { $self->url_for(folder => $_) } @$folders],
);
@@ -136,8 +136,7 @@ sub displayheaders {
my $search = $v->optional('search')->param;
if ($v->has_error) {
- $self->res->code(400);
- $self->render(template => 'error', error => "errors in @{ $v->failed }");
+ $self->render(template => 'error', error => "errors in @{ $v->failed }", status => 400);
return;
}
@@ -195,9 +194,42 @@ sub readmail {
die $@;
}
- $self->render(action => 'readmail',
- msg => $mail,
+ $self->render(msg => $mail);
+}
+
+
+sub raw {
+ my $self = shift;
+
+ my $mid = $self->stash('id');
+
+ my $auth = $self->users->Auth(
+ user => $self->session(S_USER),
+ password => $self->session_passwd,
+ challenge => $self->app->secrets->[0],
);
+
+ my $mail = $self->users->show($auth, $mid);
+
+ my $v = $self->validation;
+ $v->optional('body')->like(qr/\w+/);
+ return if $v->has_error;
+
+ if (my $type = $self->param('body')) {
+ if ($mail->{head}{content_type} =~ '^multipart/') {
+ my ($content) = grep {$_->{head}{content_type} =~ $type} @{ $mail->{body} };
+ $self->render(text => $content->{body});
+ }
+ elsif ($mail->{head}{content_type} =~ $type) {
+ $self->render(text => $mail->{body}) ;
+ }
+ else {
+ $self->reply->not_found;
+ }
+ }
+ else {
+ $self->render(json => $mail);
+ }
}
@@ -238,6 +270,7 @@ sub sendmail {
$self->render(action => 'writemail',
warning => $self->l('error_send'),
+ status => 400,
);
return;
}
@@ -279,44 +312,6 @@ sub move {
}
-sub raw {
- my $self = shift;
-
- my $mid = $self->stash('id');
-
- my $auth = $self->users->Auth(
- user => $self->session(S_USER),
- password => $self->session_passwd,
- challenge => $self->app->secrets->[0],
- );
-
- my $mail = $self->users->show($auth, $mid);
-
- my $v = $self->validation;
- $v->optional('body')->like(qr/\w+/);
- if ($v->has_error) {
- return;
- }
-
- if (my $type = $self->param('body')) {
- if ($mail->{head}{content_type} =~ '^multipart/') {
- my ($content) = grep {$_->{head}{content_type} =~ $type} @{ $mail->{body} };
- $self->render(text => $content->{body});
- }
- elsif ($mail->{head}{content_type} =~ $type) {
- $self->render(text => $mail->{body}) ;
- }
- else {
- $self->res->code(404);
- }
- }
- else {
- $self->res->headers->content_type('text/plain');
- $self->render(text => $self->dumper($mail));
- }
-}
-
-
1
__END__
@@ -329,15 +324,15 @@ Webmail - All functions comprising the webmail application.
=head1 SYNOPSIS
- my $r = $app->routes;
- $r->get('/about')->to('Webmail#about');
- $r->post('/login')->to('Webmail#login');
+ my $r = $app->routes;
+ $r->get('/about')->to('Webmail#about');
+ $r->post('/login')->to('Webmail#login');
=head1 DESCRIPTION
The controller of JWebmail.
-=head1 METHODS
+=head1 ROUTES
=head2 noaction
@@ -345,9 +340,9 @@ The login page. This should be the root.
=head2 auth
- my $a = $r->under('/')->to('Webmail#auth');
+ my $a = $r->under('/')->to('Webmail#auth');
- An intermediate route that makes sure a user has a valid session.
+ An intermediate route that makes sure a user has a valid session.
=head2 login
diff --git a/lib/JWebmail/Model/ReadMails/MockMaildir.pm b/lib/JWebmail/Model/ReadMails/MockMaildir.pm
index 31e9618..d1746ec 100644
--- a/lib/JWebmail/Model/ReadMails/MockMaildir.pm
+++ b/lib/JWebmail/Model/ReadMails/MockMaildir.pm
@@ -1,36 +1,41 @@
package JWebmail::Model::ReadMails::MockMaildir;
-use Mojo::Base -base;
+use Mojo::Base JWebmail::Model::ReadMails::QMailAuthuser;
use Mojo::JSON 'decode_json';
+use constant {
+ VALID_USER => 'me@mockmaildir.com',
+ VALID_PW => '12345',
+};
-has user => sub { $ENV{USER} };
-has maildir => 't/';
+
+has user => sub { $ENV{USER} };
+has maildir => 't/';
has extractor => 'perl';
our %EXTRACTORS = (
- perl => 'perl lib/JWebmail/Model/Driver/QMailAuthuser/Extract.pm',
+ perl => 'perl script/qmauth.pl',
rust => 'extract/target/debug/jwebmail-extract',
);
-use constant {
- VALID_USER => 'me@mockmaildir.com',
- VALID_PW => '12345',
-};
-sub communicate {
+sub verify_user {
my $self = shift;
- my %args = @_;
+ my $auth = shift;
- if ($args{mode} eq 'auth') {
- return ("", 0) if $args{user} eq VALID_USER && $args{password} eq VALID_PW;
- return ("", 1);
- }
+ return $auth->{user} eq VALID_USER && $auth->{password} eq VALID_PW;
+}
+
+sub build_and_run {
+ my $self = shift;
+ my $auth = shift;
+ my $mode = shift;
+ my $args = shift;
my $mail_user = 'maildir';
- my $exec = $EXTRACTORS{$self->extractor} . ' ' . join(' ', map { $_ =~ s/(['\\])/\\$1/g; "'$_'" } ($self->maildir, $self->user, $mail_user, $args{mode}, @{$args{args}}));
+ my $exec = $EXTRACTORS{$self->extractor} . ' ' . join(' ', map { $_ =~ s/(['\\])/\\$1/g; "'$_'" } ($self->maildir, $self->user, $mail_user, $mode, @$args));
my $pid = open(my $reader, '-|', $exec)
or die 'failed to create subprocess';
@@ -49,9 +54,9 @@ sub communicate {
$resp = {error => "qmail-authuser returned code: $rc"};
}
- return ($resp, $rc);
+ die "error $resp" if $rc;
+ return $resp;
}
1
-
diff --git a/lib/JWebmail/Model/ReadMails/QMailAuthuser.pm b/lib/JWebmail/Model/ReadMails/QMailAuthuser.pm
index 8387217..09b8b9d 100644
--- a/lib/JWebmail/Model/ReadMails/QMailAuthuser.pm
+++ b/lib/JWebmail/Model/ReadMails/QMailAuthuser.pm
@@ -4,8 +4,8 @@ use v5.22;
use warnings;
use utf8;
-use IPC::Open2;
use File::Basename 'fileparse';
+use IPC::Open2;
use JSON::PP 'decode_json';
use Params::Check 'check';
use Scalar::Util 'blessed';
@@ -15,13 +15,67 @@ use namespace::clean;
with 'JWebmail::Model::ReadMails::Role';
+package JWebmail::Model::ReadMails::QMailAuthuser::Error {
+
+ use Data::Dumper 'Dumper';
+
+ use overload
+ '""' => \&to_string,
+ bool => sub {1};
+
+ sub new {
+ my $cls = shift;
+ my $msg = shift;
+ my $self = {message => $msg};
+
+ $self->{data} = $_[0] if @_ == 1;
+ $self->{data} = [@_] if @_ > 1;
+
+ return bless $self;
+ }
+
+ sub to_string {
+ my $self = shift;
+ my $verbose = shift;
+
+ if ($verbose && defined $self->{data}) {
+ my $errstr = Data::Dumper->new([$self->{data}])->Terse(1)->Indent(0)->Quotekeys(0)->Dump;
+ return "$self->{message}: $errstr";
+ }
+ else {
+ return $self->{message};
+ }
+ }
+
+ sub throw {
+ my $cls = shift;
+ my $msg = shift;
+
+ die $cls->new($msg, @_)->_trace;
+ }
+
+ # taken from Mojo::Exception
+ sub _trace {
+ my ($self, $start) = (shift, shift // 1);
+ my @frames;
+ while (my @trace = caller($start++)) { push @frames, \@trace }
+ $self->{frames} = \@frames;
+ }
+
+ sub message { shift->{message} }
+ sub data { shift->{data} }
+ sub frames { shift->{frames} }
+
+}
+
+
my $QMailAuthuserCheck = {
user => {defined => 1, required => 1},
maildir => {defined => 1, required => 1},
+ prog => {defined => 1, required => 1},
prefix => {defined => 1, default => ''},
qmail_dir => {defined => 1, default => '/var/qmail/'},
logfile => {defined => 1, default => '/dev/null'},
- prog => {defined => 1, default => ([fileparse(__FILE__)]->[1] . '/QMailAuthuser/Extract.pm')},
};
sub new {
@@ -36,16 +90,22 @@ sub new {
return bless $self, $cls;
}
+
sub verify_user {
my $self = shift;
my $auth = shift;
- return !scalar $self->communicate(
- user => $auth->{user},
- password => $auth->{password},
- challenge => $auth->{challenge},
- mode => 'auth',
- )
+ eval { $self->build_and_run($auth, 'auth'); 1 }
+ or do {
+ my $e = $@;
+ my $rc = eval { $e->data->{return_code} };
+ if ($rc == 1) {
+ return '';
+ }
+ else {
+ die $e;
+ }
+ };
}
sub read_headers_for {
@@ -55,122 +115,75 @@ sub read_headers_for {
my %h = @_;
my ($folder, $start, $end, $sort) = @h{qw(folder start end sort)};
- my ($resp, $rc) = $self->communicate(
- user => $auth->{user},
- password => $auth->{password},
- challenge => $auth->{challenge},
- mode => 'list',
- args => [$start // 0, $end // 0, $sort // 'date', $folder // ''],
- );
- die "connection error: $resp->{error}" if $rc;
- return $resp;
+ return $self->build_and_run($auth, 'list', [$start, $end, $sort, $folder]);
}
sub count {
my $self = shift;
-
my ($auth, $folder) = @_;
- my ($resp, $rc) = $self->communicate(
- user => $auth->{user},
- password => $auth->{password},
- challenge => $auth->{challenge},
- mode => 'count',
- args => [$folder],
- );
- die "connection error: $resp->{error}" if $rc;
+ my $resp = $self->build_and_run($auth, 'count', [$folder]);
return ($resp->{size}, $resp->{count}, $resp->{new});
}
sub show {
my $self = shift;
-
my ($auth, $mid) = @_;
- my ($resp, $rc) = $self->communicate(
- user => $auth->{user},
- password => $auth->{password},
- challenge => $auth->{challenge},
- mode => 'read-mail',
- args => [$mid],
- );
- die "connection error: $resp->{error}, $resp->{mid}" if $rc;
- return $resp;
+ return $self->build_and_run($auth, 'read-mail', [$mid]);
}
sub search {
my $self = shift;
-
my ($auth, $pattern, $folder) = @_;
- my ($resp, $rc) = $self->communicate(
- user => $auth->{user},
- password => $auth->{password},
- challenge => $auth->{challenge},
- mode => 'search',
- args => [$pattern, $folder],
- );
- die "connection error: $resp->{error}" if $rc;
- return $resp;
+ return $self->build_and_run($auth, 'search', [$pattern, $folder]);
}
sub folders {
my $self = shift;
-
my ($auth) = @_;
- my ($resp, $rc) = $self->communicate(
- user => $auth->{user},
- password => $auth->{password},
- challenge => $auth->{challenge},
- mode => 'folders',
- );
- die "connection error: $resp->{error}" if $rc;
- return $resp;
+ return $self->build_and_run($auth, 'folders');
}
sub move {
my $self = shift;
-
my ($auth, $mid, $folder) = @_;
- my ($resp, $rc) = $self->communicate(
- user => $auth->{user},
- password => $auth->{password},
- challenge => $auth->{challenge},
- mode => 'move',
- args => [$mid, $folder],
- );
- die "connection error: $resp->{error}" if $rc;
+ my $_resp = $self->build_and_run($auth, 'move', [$mid, $folder]);
return 1;
}
-sub communicate {
+
+sub build_arg {
my $self = shift;
- my %args = @_;
+ my $user_mail_addr = shift;
+ my $mode = shift;
+ my $args = shift || [];
- $args{challenge} //= '';
- $args{args} //= [];
+ return $self->{qmail_dir} . "/bin/qmail-authuser true 3<&0"
+ if $mode eq 'auth';
- my $exec = do {
- if ($args{mode} eq 'auth') {
- $self->{qmail_dir} . "/bin/qmail-authuser true 3<&0";
- }
- else {
- my ($user_name) = $args{user} =~ /(\w*)@/;
+ my ($user_name) = $user_mail_addr =~ /(\w*)@/;
- $self->{qmail_dir}.'/bin/qmail-authuser'
- . $self->{prefix} . ' '
- . join(' ', map { s/(['\\])/\\$1/g; "'$_'" } ($self->{prog}, $self->{maildir}, $self->{user}, $user_name, $args{mode}, @{$args{args}}))
- . ' 3<&0'
- . ' 2>>'.$self->{logfile};
- }
- };
+ return $self->{qmail_dir}.'/bin/qmail-authuser'
+ . $self->{prefix} . ' '
+ . join(' ', map { s/(['\\])/\\$1/g; "'$_'" } ($self->{prog}, $self->{maildir}, $self->{user}, $user_name, $mode, @$args))
+ . ' 3<&0'
+ . ' 2>>'.$self->{logfile};
+}
+
+sub execute {
+ my $_self = shift;
+ my $auth = shift;
+ my $exec = shift;
my $pid = open2(my $reader, my $writer, $exec)
or die 'failed to create subprocess';
- $writer->print("$args{user}\0$args{password}\0$args{challenge}\0")
+ my $challenge = $auth->{challenge} || '';
+ $writer->print("$auth->{user}\0$auth->{password}\0$challenge\0")
or die 'pipe wite failed';
close $writer
or die 'closing write pipe failed';
@@ -185,16 +198,32 @@ sub communicate {
my $resp;
if ($rc == 3 || $rc == 0) {
- eval { $resp = decode_json $input; };
- if ($@) { $resp = {error => 'decoding error'} };
+ eval { $resp = decode_json $input; 1 }
+ or $resp = {info => "error decoding response", response => $input, cause => $@, return_code => $rc};
}
elsif ($rc) {
- $resp = {error => "qmail-authuser returned code: $rc"};
+ $resp = {info => "got unsuccessful return code by qmail-authuser", return_code => $rc, response => $input};
}
return ($resp, $rc);
}
+sub build_and_run {
+ my $self = shift;
+ my $auth = shift;
+ my $mode = shift;
+ my $args = shift;
+
+ my $exec = $self->build_arg($auth->{user}, $mode, $args);
+ my ($resp, $rc) = $self->execute($auth, $exec);
+
+ if ($rc) {
+ JWebmail::Model::ReadMails::QMailAuthuser::Error->throw("qmail-authuser connection error", $resp);
+ }
+ return $resp;
+}
+
+
1
__END__