Specified the interface for qmauth

Changes to configuration
Added qmauth version written in Python
Slight changes to pagination

6 files changed, 139 insertions, 94 deletions

diff --git a/lib/JWebmail/Controller/Webmail.pm b/lib/JWebmail/Controller/Webmail.pm
index b094a43..2f71021 100644
--- a/lib/JWebmail/Controller/Webmail.pm
+++ b/lib/JWebmail/Controller/Webmail.pm
@@ -7,7 +7,7 @@ use List::Util 'first';
 use Mojolicious::Types;
 
 use constant {
-    S_USER => 'user', # Key for user name in active session
+    S_USER  => 'user', # Key for user name in active session
     ST_AUTH => 'auth',
 };
 
@@ -134,7 +134,7 @@ sub displayheaders {
 
     my $folders = _time { $self->users->folders($auth) } $self, 'user folders';
 
-    unless ( $self->stash('folder') ~~ $folders ) {
+    unless ( !$self->stash('folder') || $self->stash('folder') ~~ $folders ) {
         $self->render(template => 'error',
             status => 404,
             error => $self->l('no_folder'),
@@ -153,9 +153,9 @@ sub displayheaders {
         return;
     }
 
-    my ($total_byte_size, $cnt, $new) = _time { $self->users->count($auth, $self->stash('folder')) } $self, 'user count';
+    my $count = _time { $self->users->count($auth, $self->stash('folder')) } $self, 'user count';
 
-    my ($start, $end) = $self->paginate($cnt);
+    my ($start, $end) = $self->paginate($count->{total_mails});
 
     $self->timing->begin('user_headers');
     my $headers = do {
@@ -178,10 +178,10 @@ sub displayheaders {
     $self->app->log->debug(sprintf("Reading user headers took %fs", $elapsed));
 
     $self->stash(
-        msgs         => $headers,
-        mail_folders => $folders,
-        total_size   => $total_byte_size,
-        total_new_mails => $new,
+        msgs            => $headers,
+        mail_folders    => $folders,
+        total_size      => $count->{byte_size},
+        total_new_mails => $count->{unread_mails},
     );
 }
 
@@ -194,7 +194,7 @@ sub readmail {
     my $auth = $self->stash(ST_AUTH);
 
     my $mail;
-    my $ok = eval { $mail = $self->users->show($auth, $mid); 1 };
+    my $ok = eval { $mail = $self->users->show($auth, '', $mid); 1 };
     if (!$ok) {
         my $err = $@;
         if ($err =~ m/unkown mail-id|no such message/) {
@@ -210,11 +210,11 @@ sub readmail {
     return if $v->has_error;
 
     if ($type) {
-        if ($mail->{head}{content_type} =~ '^multipart/') {
-            my $content = first {$_->{head}{content_type} =~ $type} @{ $mail->{body} };
+        if ($mail->{head}{mime}{content_maintype} eq 'multipart') {
+            my $content = first {$_->{head}{mime}{content_subtype} eq $type} @{ $mail->{body} };
             $self->render(text => $content->{body});
         }
-        elsif ($mail->{head}{content_type} =~ $type) {
+        elsif ($mail->{head}{mime}{content_subtype} eq $type) {
             $self->render(text => $mail->{body}) ;
         }
         else {
@@ -297,7 +297,7 @@ sub move {
     no warnings 'experimental::smartmatch';
     die "$folder not valid" unless $folder ~~ $folders;
 
-    $self->users->move($auth, $_, $folder) for @$mm;
+    $self->users->move($auth, $_, '', $folder) for @$mm;
 
     $self->flash(message => $self->l('succ_move'));
     $self->res->code(303);
diff --git a/lib/JWebmail/Model/ReadMails/MockJSON.pm b/lib/JWebmail/Model/ReadMails/MockJSON.pm
index b90a630..6b3b6d2 100644
--- a/lib/JWebmail/Model/ReadMails/MockJSON.pm
+++ b/lib/JWebmail/Model/ReadMails/MockJSON.pm
@@ -14,8 +14,8 @@ use Role::Tiny::With;
 use namespace::clean;
 
 use constant {
-    VALID_USER => 'mockjson@example.com',
-    VALID_PW   => 'vwxyz',
+    VALID_USER => 'mockjson@example.org',
+    VALID_PW   => '12345',
 };
 
 with 'JWebmail::Model::ReadMails::Role';
diff --git a/lib/JWebmail/Model/ReadMails/MockMaildir.pm b/lib/JWebmail/Model/ReadMails/MockMaildir.pm
index 2df4fa9..9b1bb29 100644
--- a/lib/JWebmail/Model/ReadMails/MockMaildir.pm
+++ b/lib/JWebmail/Model/ReadMails/MockMaildir.pm
@@ -1,38 +1,59 @@
 package JWebmail::Model::ReadMails::MockMaildir;
 
-use Mojo::Base JWebmail::Model::ReadMails::QMailAuthuser;
+use Mojo::Base 'JWebmail::Model::ReadMails::QMailAuthuser';
 
 use Mojo::JSON 'decode_json';
 
+use Digest::HMAC_MD5 'hmac_md5_hex';
+
+
 use constant {
-    VALID_USER => 'me@mockmaildir.com',
+    VALID_USER => 'mockmaildir@example.org',
     VALID_PW   => '12345',
 };
 
-
 has user      => sub { $ENV{USER} };
 has maildir   => 't/';
 has extractor => 'perl';
 
-
 our %EXTRACTORS = (
-    perl => 'perl script/qmauth.pl',
-    rust => 'extract/target/debug/jwebmail-extract',
+    perl   => 'perl script/qmauth.pl',
+    python => 'python script/qmauth.py',
+    rust   => 'extract/target/debug/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;
+}
+
+
 sub verify_user {
     my $self = shift;
     my $auth = shift;
 
-    return $auth->{user} eq VALID_USER && $auth->{password} eq VALID_PW;
+    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 build_and_run {
     my $self = shift;
-    my $auth = shift;
-    my $mode = shift;
-    my $args = shift;
+    my ($auth, $mode, $args) = @_;
 
     my $mail_user = 'maildir';
     my $exec = $EXTRACTORS{$self->extractor} . ' ' . join(' ', map { my $x = s/(['\\])/\\$1/gr; "'$x'" } ($self->maildir, $self->user, $mail_user, $mode, @$args));
@@ -51,10 +72,11 @@ sub build_and_run {
         if (my $err = $@) { $resp = {error => "decoding error '$err'"}; $rc ||= 1; };
     }
     elsif ($rc) {
-        $resp = {error => "qmail-authuser returned code: $rc"};
+        $resp = {error => "qmauth returned code: $rc"};
     }
 
-    die "error $resp" if $rc;
+    local $" = ', ';
+    die "error @{[%$resp]}" if $rc;
     return $resp;
 }
 
diff --git a/lib/JWebmail/Model/ReadMails/QMailAuthuser.pm b/lib/JWebmail/Model/ReadMails/QMailAuthuser.pm
index 39d8ab6..956c137 100644
--- a/lib/JWebmail/Model/ReadMails/QMailAuthuser.pm
+++ b/lib/JWebmail/Model/ReadMails/QMailAuthuser.pm
@@ -8,8 +8,8 @@ use File::Basename 'fileparse';
 use IPC::Open2;
 use JSON::PP 'decode_json';
 use Params::Check 'check';
-use Scalar::Util 'blessed';
 use Role::Tiny::With;
+use Scalar::Util 'blessed';
 use namespace::clean;
 
 with 'JWebmail::Model::ReadMails::Role';
@@ -51,7 +51,10 @@ package JWebmail::Model::ReadMails::QMailAuthuser::Error {
         my $cls = shift;
         my $msg = shift;
 
-        die $cls->new($msg, @_)->_trace;
+        my $self = $cls->new($msg, @_);
+        $self->_trace;
+
+        die $self;
     }
 
     # taken from Mojo::Exception
@@ -70,12 +73,12 @@ package JWebmail::Model::ReadMails::QMailAuthuser::Error {
 
 
 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'},
+    user      => {required => 1},
+    maildir   => {required => 1},
+    prog      => {required => 1},
+    prefix    => {default => ''},
+    qmail_dir => {default => '/var/qmail/'},
+    logfile   => {default => '/dev/null'},
 };
 
 sub new {
@@ -86,8 +89,12 @@ sub new {
         $self = {%$cls, %$self};
         $cls = $pkg;
     }
-    $self = check($QMailAuthuserCheck, $self, 1) || die;
-    return bless $self, $cls;
+    local $Params::Check::ALLOW_UNKNOWN = 1;
+    local $Params::Check::ONLY_ALLOW_DEFINED = 1;
+    local $Params::Check::WARNINGS_FATAL = 1;
+    my $s = check($QMailAuthuserCheck, $self)
+        or die __PACKAGE__ . " creation failed!";
+    return bless $s, $cls;
 }
 
 
@@ -95,8 +102,8 @@ sub verify_user {
     my $self = shift;
     my $auth = shift;
 
-    eval { $self->build_and_run($auth, 'auth'); 1 }
-        or do {
+    return eval { $self->build_and_run($auth, 'auth'); 1 }
+        || do {
             my $e = $@;
             my $rc = eval { $e->data->{return_code} };
             if ($rc == 1) {
@@ -115,22 +122,21 @@ sub read_headers_for {
     my %h = @_;
     my ($folder, $start, $end, $sort) = @h{qw(folder start end sort)};
 
-    return $self->build_and_run($auth, 'list', [$start, $end, $sort, $folder]);
+    return $self->build_and_run($auth, 'list', [$folder, $start, $end, $sort]);
 }
 
 sub count {
     my $self = shift;
     my ($auth, $folder) = @_;
 
-    my $resp = $self->build_and_run($auth, 'count', [$folder]);
-    return ($resp->{size}, $resp->{count}, $resp->{new});
+    return $self->build_and_run($auth, 'count', [$folder]);
 }
 
 sub show {
     my $self = shift;
-    my ($auth, $mid) = @_;
+    my ($auth, $folder, $mid) = @_;
 
-    return $self->build_and_run($auth, 'read-mail', [$mid]);
+    return $self->build_and_run($auth, 'read', [$folder, $mid]);
 }
 
 sub search {
@@ -144,23 +150,23 @@ sub folders {
     my $self = shift;
     my ($auth) = @_;
 
-    return $self->build_and_run($auth, 'folders');
+    my $res = $self->build_and_run($auth, 'folders');
+    unshift @$res, '' if ref $res eq 'ARRAY';
+    return $res;
 }
 
 sub move {
     my $self = shift;
-    my ($auth, $mid, $folder) = @_;
+    my ($auth, $mid, $from_f, $to_f) = @_;
 
-    my $_resp = $self->build_and_run($auth, 'move', [$mid, $folder]);
+    my $_resp = $self->build_and_run($auth, 'move', [$mid, $from_f, $to_f]);
     return 1;
 }
 
 
 sub build_arg {
     my $self = shift;
-    my $user_mail_addr = shift;
-    my $mode = shift;
-    my $args = shift || [];
+    my ($user_mail_addr, $mode, $args) = @_;
 
     return $self->{qmail_dir} . "/bin/qmail-authuser true 3<&0"
         if $mode eq 'auth';
@@ -169,15 +175,14 @@ sub build_arg {
 
     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))
+    . join(' ', map { my $x = s/(['\\])/\\$1/gr; "'$x'" } ($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 ($auth, $exec) = @_;
 
     my $pid = open2(my $reader, my $writer, $exec)
         or die 'failed to create subprocess';
@@ -190,18 +195,28 @@ sub execute {
 
     binmode $reader, ':encoding(UTF-8)';
     my $input = <$reader>;
-    close $reader # waits for the child to finish
+    close $reader
         or die 'closing read pipe failed';
 
+    waitpid $pid, 0;
     my $rc = $? >> 8;
 
     my $resp;
     if ($rc == 3 || $rc == 0) {
         eval { $resp = decode_json $input; 1 }
-            or $resp = {info => "error decoding response", response => $input, cause => $@, return_code => $rc};
+            or $resp = {
+                info => "error decoding response",
+                response => $input,
+                cause => $@,
+                return_code => $rc,
+            };
     }
     elsif ($rc) {
-        $resp = {info => "got unsuccessful return code by qmail-authuser", return_code => $rc, response => $input};
+        $resp = {
+            info        => "got unsuccessful return code by qmail-authuser",
+            return_code => $rc,
+            response    => $input,
+        };
     }
 
     return ($resp, $rc);
@@ -209,15 +224,14 @@ sub execute {
 
 sub build_and_run {
     my $self = shift;
-    my $auth = shift;
-    my $mode = shift;
-    my $args = shift;
+    my ($auth, $mode, $args) = @_;
 
     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);
+        JWebmail::Model::ReadMails::QMailAuthuser::Error->throw(
+            "qmail-authuser connection error", $resp);
     }
     return $resp;
 }
@@ -291,5 +305,3 @@ Challenge when using cram
 =head1 SEE ALSO
 
 L<JWebmail::Model::ReadMails>, L<JWebmail::Model::Driver::QMailAuthuser::Extract>
-
-=cut
diff --git a/lib/JWebmail/Model/ReadMails/Role.pm b/lib/JWebmail/Model/ReadMails/Role.pm
index 1f4390b..d6fa1e5 100644
--- a/lib/JWebmail/Model/ReadMails/Role.pm
+++ b/lib/JWebmail/Model/ReadMails/Role.pm
@@ -1,6 +1,6 @@
 package JWebmail::Model::ReadMails::Role;
 
-use Params::Check 'check';
+use Params::Check qw(check last_error);
 
 use Mojo::Base -role; # load after imports
 
@@ -18,13 +18,15 @@ package JWebmail::Model::ReadMails::Role::Shadow {
 sub Auth {
     shift;
     state $AuthCheck = {
-        user =>      {defined => 1, required => 1},
-        password =>  {defined => 1, required => 1},
+        user      => {required => 1, defined => 1},
+        password  => {required => 1, defined => 1},
         challenge => {},
     };
     my $self = @_ == 1 ? $_[0] : {@_};
 
-    my $res = check($AuthCheck, $self, 0) || die Params::Check::last_error;
+    local $Params::Check::WARNINGS_FATAL = 1;
+    my $res = check($AuthCheck, $self, 0)
+        or die 'Auth creation failed! ' . last_error;
     $res->{password} = JWebmail::Model::ReadMails::Role::Shadow->new($res->{password});
     return $res;
 }
@@ -36,14 +38,14 @@ my @methods = (
     # ^          throws exception
     # ^type      throws exception of type
     # Read operations
-    'verify_user',      # auth:Auth -> :truthy
-    'read_headers_for', # auth:Auth, *folder='', *start=0, *end=24, *sort='date' -> ^ :hashref
     'count',            # auth:Auth, folder -> ^ size:int count:int new:int
-    'show',             # auth:Auth, mid -> ^ :hashref
-    'search',           # auth:Auth, pattern, folder -> ^ :hashref
     'folders',          # auth:Auth -> ^ :arrayref
+    'verify_user',      # auth:Auth -> :truthy
     # Write operations
     'move',             # auth:Auth, mid, folder -> ^ 1
+    'read_headers_for', # auth:Auth, *folder='', *start=0, *end=24, *sort='date' -> ^ :hashref
+    'search',           # auth:Auth, pattern, folder -> ^ :hashref
+    'show',             # auth:Auth, mid -> ^ :hashref
 );
 
 requires(@methods);
@@ -66,13 +68,14 @@ around read_headers_for => sub {
     my $args = {@_};
 
     state $ArgsCheck = {
-        start =>  {default => 0},
-        end =>    {default => 24},
-        sort =>   {default => 'date'},
+        start  => {required => 1},
+        end    => {required => 1},
+        sort   => {default => ''},
         folder => {default => ''},
     };
 
-    $orig->($self, $auth, %{ check($ArgsCheck, $args, 1) })
+    local $Params::Check::ONLY_ALLOW_DEFINED = 1;
+    $orig->($self, $auth, %{ check($ArgsCheck, $args, 0) or die last_error  })
 };
 
 
@@ -107,7 +110,7 @@ Provides bundeled information on a subset of mails of a mailbox.
 Can be sorted and of varying size.
 
 Arguments:
-    start..end   inclusive 0 based range
+    start..end   half open 0 based range
 
 =head2 count
 
@@ -150,5 +153,3 @@ Optinal challange for when you use cram authentication.
 =head1 SEE ALSO
 
 L<JWebmail::Model::ReadMails::QMailAuthuser>, L<JWebmail::Model::ReadMails::Mock>, L<JWebmail>
-
-=cut
diff --git a/lib/JWebmail/Plugin/Helper.pm b/lib/JWebmail/Plugin/Helper.pm
index ad5c8ad..c00ef0e 100644
--- a/lib/JWebmail/Plugin/Helper.pm
+++ b/lib/JWebmail/Plugin/Helper.pm
@@ -9,7 +9,6 @@ use POSIX qw(floor round log ceil);
 use Mojo::Util qw(encode decode b64_encode b64_decode xml_escape);
 
 use constant TRUE_RANDOM => eval { require Crypt::URandom; Crypt::URandom->import('urandom'); 1 };
-use constant HMAC_MD5 => eval { require Digest::HMAC_MD5; Digest::HMAC_MD5->import('hmac_md5'); 1 };
 
 
 ### filter and checks for mojo validator
@@ -160,8 +159,6 @@ sub session_passwd {
     my ($c, $passwd, $challenge) = @_;
     my $secAlg = $c->config->{session}{secure};
 
-    die "you need to install Digest::HMAC_MD5 for cram to work"
-        if !HMAC_MD5 && $secAlg eq 'cram';
     warn_crypt($c);
 
     if (defined $passwd) { # set
@@ -234,11 +231,9 @@ sub _paginate {
     my %args = @_;
 
     my $first_item  = $args{first_item};
-    my $page_size   = $args{page_size} || 1;
+    my $page_size   = $args{page_size};
     my $total_items = $args{total_items};
 
-    my $first_item1 = $total_items ? $first_item+1 : 0;
-
     my $current_page = ceil($first_item/$page_size);
     my $total_pages  = ceil($total_items/$page_size);
 
@@ -246,23 +241,29 @@ sub _paginate {
         my $page_ = shift;
         return [0, 0] unless $total_items;
         $page_ = _clamp(0, $page_, $total_pages-1);
-        [_clamp(1, $page_*$page_size + 1, $total_items), _clamp(1, ($page_+1)*$page_size, $total_items)]
+        [_clamp(0, $page_*$page_size, $total_items-1), _clamp(0, ($page_+1)*$page_size, $total_items)]
     };
 
-    return (
-        first_item  => $first_item1,
-        last_item   => _clamp($first_item1, $first_item + $page_size, $total_items),
+    my %ret = (
         total_items => $total_items,
         page_size   => $page_size,
 
         total_pages  => $total_pages,
-        current_page => $current_page + 1,
+        current_page => $current_page,
 
         first_page => $page->(0),
         prev_page  => $page->($current_page-1),
+        this_page  => $page->($current_page),
         next_page  => $page->($current_page+1),
         last_page  => $page->($total_pages-1),
     );
+
+    if ($total_items) {
+        $ret{first_item} = $first_item;
+        $ret{last_item} = _clamp($first_item, $first_item+$page_size-1, $total_items-1);
+    }
+
+    return %ret;
 }
 
 sub paginate {
@@ -274,9 +275,13 @@ sub paginate {
     my $psize = $v->optional('page_size')->num(1, undef)->param // 50;
 
     $start = _clamp(0, $start, max($count-1, 0));
-    my $end = _clamp($start, $start+$psize-1, max($count-1, 0));
+    my $end = _clamp($start, $start+$psize, max($count, 0));
 
-    $c->stash(_paginate(first_item => $start, page_size => $psize, total_items => $count));
+    $c->stash(_paginate(
+        first_item  => int($start/$psize)*$psize,
+        page_size   => $psize,
+        total_items => $count,
+    ));
 
     return $start, $end;
 }
@@ -435,16 +440,21 @@ Currently the following modes are supported:
 
 =item none 
 
-password is plainly stored in session cookie
+The password is plainly stored in session cookie.
+The cookie is stored on the client side and send with every request.
 
 =item cram 
 
-challenge response authentication mechanism uses the C<< $app->secret->[0] >> as nonce.
-This is optional if Digest::HMAC_MD5 is installed.
+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 
 
-data is stored on the server. Additionally the password is encrypted by an one-time-pad that is stored in the user cookie.
+The password is stored on the server. Additionally the password is encrypted
+by an one-time-pad that is stored in the users cookie.
+This is vulnurable to replay attacks during an active session.
+On log-in it is transfered plainly.
 
 =back