overhauled testing

12 files changed, 197 insertions, 58 deletions

diff --git a/lib/JWebmail/Controller/Webmail.pm b/lib/JWebmail/Controller/Webmail.pm
index 5f8d986..f0f2efa 100644
--- a/lib/JWebmail/Controller/Webmail.pm
+++ b/lib/JWebmail/Controller/Webmail.pm
@@ -4,9 +4,7 @@ use Mojo::Base 'Mojolicious::Controller';
 
 use Mojolicious::Types;
 
-use constant {
-    S_USER => 'user', # Key for user name in active session
-};
+use constant S_USER => 'user'; # Key for user name in active session
 
 
 # no action has been taken, display login page
@@ -208,19 +206,20 @@ sub writemail { }
 sub sendmail {
     my $self = shift;
 
-    my %mail;
     my $v = $self->validation;
     $v->csrf_protect;
 
-    $mail{to}          = $v->required('to', 'not_empty')->check('mail_line')->every_param;
-    $mail{message}     = $v->required('body', 'not_empty')->param;
-    $mail{subject}     = $v->required('subject', 'not_empty')->param;
-    $mail{cc}          = $v->optional('cc', 'not_empty')->check('mail_line')->every_param;
-    $mail{bcc}         = $v->optional('bcc', 'not_empty')->check('mail_line')->every_param;
-    $mail{reply}       = $v->optional('back_to', 'not_empty')->check('mail_line')->param;
-    $mail{attach}      = $v->optional('attach', 'non_empty_ul')->upload->param;
+    my %mail = (
+        to      => scalar $v->required('to', 'not_empty')->check('mail_line')->every_param,
+        message => scalar $v->required('body', 'not_empty')->param,
+        subject => scalar $v->required('subject', 'not_empty')->param,
+        cc      => scalar $v->optional('cc', 'not_empty')->check('mail_line')->every_param,
+        bcc     => scalar $v->optional('bcc', 'not_empty')->check('mail_line')->every_param,
+        reply   => scalar $v->optional('back_to', 'not_empty')->check('mail_line')->param,
+        attach  => scalar $v->optional('attach', 'non_empty_ul')->upload->param,
+        from    => scalar $self->session(S_USER),
+    );
     $mail{attach_type} = Mojolicious::Types->new->file_type($mail{attach}->filename) if $mail{attach};
-    $mail{from}        = $self->session(S_USER);
 
     if ($v->has_error) {
         $self->log->debug("mail send failed. Error in @{ $v->failed }");
@@ -234,7 +233,7 @@ sub sendmail {
     my $error = $self->send_mail(\%mail);
 
     if ($error) {
-        $v->error('send'=> ['internal_error']); # make validation fail so that values are restored
+        $v->error(send => ['internal_error']); # make validation fail so that values are restored
 
         $self->render(action => 'writemail',
             warning => $self->l('error_send'),
diff --git a/lib/JWebmail/Model/Driver/Mock.pm b/lib/JWebmail/Model/Driver/MockJSON.pm
index b2da1be..99df346 100644
--- a/lib/JWebmail/Model/Driver/Mock.pm
+++ b/lib/JWebmail/Model/Driver/MockJSON.pm
@@ -1,4 +1,4 @@
-package JWebmail::Model::Driver::Mock;
+package JWebmail::Model::Driver::MockJSON;
 
 use Mojo::Base -base;
 
@@ -8,7 +8,7 @@ use Mojo::JSON qw(decode_json);
 
 
 use constant {
-    VALID_USER => 'me@example.de',
+    VALID_USER => 'me@mockjson.com',
     VALID_PW   => 'vwxyz',
 };
 
diff --git a/lib/JWebmail/Model/Driver/MockMaildir.pm b/lib/JWebmail/Model/Driver/MockMaildir.pm
new file mode 100644
index 0000000..e8956ed
--- /dev/null
+++ b/lib/JWebmail/Model/Driver/MockMaildir.pm
@@ -0,0 +1,57 @@
+package JWebmail::Model::Driver::MockMaildir;
+
+use Mojo::Base -base;
+
+use Mojo::JSON 'decode_json';
+
+
+has user    => sub { $ENV{USER} };
+has maildir => 't/';
+has extractor => 'perl';
+
+
+our %EXTRACTORS = (
+    perl => 'perl lib/JWebmail/Model/Driver/QMailAuthuser/Extract.pm',
+    rust => 'extract/target/debug/jwebmail-extract',
+);
+
+use constant {
+    VALID_USER => 'me@mockmaildir.com',
+    VALID_PW   => '12345',
+};
+
+sub communicate {
+    my $self = shift;
+    my %args = @_;
+
+    if ($args{mode} eq 'auth') {
+        return ("", 0) if $args{user} eq VALID_USER && $args{password} eq VALID_PW;
+        return ("", 1);
+    }
+
+    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 $pid = open(my $reader, '-|', $exec)
+        or die 'failed to create subprocess';
+
+    my $input = <$reader>;
+
+    waitpid($pid, 0);
+    my $rc = $? >> 8;
+
+    my $resp;
+    if ($rc == 3 || $rc == 0) {
+        eval { $resp = decode_json $input; };
+        if (my $err = $@) { $resp = {error => "decoding error '$err'"}; $rc ||= 1; };
+    }
+    elsif ($rc) {
+        $resp = {error => "qmail-authuser returned code: $rc"};
+    }
+
+    return ($resp, $rc);
+}
+
+
+1
+
diff --git a/lib/JWebmail/Model/Driver/QMailAuthuser.pm b/lib/JWebmail/Model/Driver/QMailAuthuser.pm
index 65e90f1..a310024 100644
--- a/lib/JWebmail/Model/Driver/QMailAuthuser.pm
+++ b/lib/JWebmail/Model/Driver/QMailAuthuser.pm
@@ -4,20 +4,18 @@ use Mojo::Base -base;
 
 use IPC::Open2;
 use File::Basename 'fileparse';
-use JSON::PP;
+use JSON::PP 'decode_json';
 
 
 has 'user';
 has 'maildir';
-has 'include';
+has 'prefix'  => '';
 has qmail_dir => '/var/qmail/';
 has prog      => [fileparse(__FILE__)]->[1] . '/QMailAuthuser/Extract.pm';
 has logfile   => '/dev/null';
 
 
 sub communicate {
-    use autodie;
-
     my $self = shift;
     my %args = @_;
 
@@ -32,9 +30,7 @@ sub communicate {
             my ($user_name) = $args{user} =~ /(\w*)@/;
 
             $self->qmail_dir.'/bin/qmail-authuser'
-            . ' perl '
-            . join('', map { ' -I ' . $_ } @{ $self->include })
-            . ' -- '
+            . $self->prefix . ' '
             . join(' ', map { $_ =~ s/(['\\])/\\$1/g; "'$_'" } ($self->prog, $self->maildir, $self->user, $user_name, $args{mode}, @{$args{args}}))
             . ' 3<&0'
             . ' 2>>'.$self->logfile;
@@ -123,11 +119,11 @@ Depends on the mode
 
 =item user
 
-User name
+E-Mail address of the user
 
 =item password
 
-User password
+Corresponding e-mail user password
 
 =item challenge
 
@@ -139,4 +135,4 @@ Challenge when using cram
 
 L<JWebmail::Model::ReadMails>, L<JWebmail::Model::Driver::QMailAuthuser::Extract>
 
-=cut
\ No newline at end of file
+=cut
diff --git a/lib/JWebmail/Model/Driver/QMailAuthuser/Extract.pm b/lib/JWebmail/Model/Driver/QMailAuthuser/Extract.pm
index 30ac4e9..5c31d58 100755
--- a/lib/JWebmail/Model/Driver/QMailAuthuser/Extract.pm
+++ b/lib/JWebmail/Model/Driver/QMailAuthuser/Extract.pm
@@ -1,3 +1,4 @@
+#!/usr/bin/env perl
 package JWebmail::Model::Driver::QMailAuthuser::Extract;
 
 use v5.18;
@@ -8,16 +9,15 @@ use utf8;
 use POSIX ();
 use JSON::PP;
 use Carp;
-use Encode v2.88 qw(decode);
+use List::Util 'min';
+use Encode v2.88 'decode';
 
 use open IO => ':encoding(UTF-8)', ':std';
 no warnings 'experimental::smartmatch';
 
 use Mail::Box::Manager;
 
-use constant {
-    ROOT_MAILDIR => '.',
-};
+use constant ROOT_MAILDIR => '.';
 
 
 sub main {
@@ -109,19 +109,18 @@ sub list {
     my $sref = _sort_mails($sortby);
     my @msgs = $f->messages;
     @msgs = sort { &$sref } @msgs;
-    @msgs = @msgs[$start..$end];
+    @msgs = @msgs[$start..min($#msgs, $end)];
 
     my @msgs2;
 
     for my $msg (@msgs) {
         my $msg2 = {
-            #subject => scalar decode_mimewords($msg->subject),
             subject => decode('MIME-Header', $msg->subject),
             from => _addresses($msg->from),
             to => _addresses($msg->to),
             cc => _addresses($msg->cc),
             bcc => _addresses($msg->bcc),
-            date => _iso8601_utc($msg->timestamp),
+            date_received => _iso8601_utc($msg->timestamp),
             size => $msg->size,
             content_type => ''. $msg->contentType,
             mid => $msg->messageId,
@@ -175,7 +174,7 @@ sub read_mail {
         to => _addresses($msg->to),
         cc => _addresses($msg->cc),
         bcc => _addresses($msg->bcc),
-        date => _iso8601_utc($msg->timestamp),
+        date_received => _iso8601_utc($msg->timestamp),
         size => $msg->size,
         content_type => ''. $msg->contentType,
         body => do {
@@ -191,9 +190,7 @@ sub read_mail {
 
 
 sub search {
-    my $f = shift;
-    my $search_pattern = shift;
-    my $folder = shift;
+    my ($f, $search_pattern, $folder) = @_;
     $folder = ".$folder";
 
     $f = $f->openSubFolder($folder) if $folder ne ROOT_MAILDIR;
@@ -214,7 +211,7 @@ sub search {
             to => _addresses($msg->to),
             cc => _addresses($msg->cc),
             bcc => _addresses($msg->bcc),
-            date => _iso8601_utc($msg->timestamp),
+            date_received => _iso8601_utc($msg->timestamp),
             size => $msg->size,
             content_type => ''. $msg->contentType,
             mid => $msg->messageId,
@@ -229,7 +226,7 @@ sub search {
 sub folders {
     my $f = shift;
 
-    return [grep { $_ =~ m/^\./ && $_ =~ s/\.// && 1  } $f->listSubFolders];
+    return [grep { $_ =~ m/^\./ && $_ =~ s/\.// } $f->listSubFolders];
 }
 
 
@@ -290,4 +287,4 @@ Currently Mail::Box::Manager does all the hard work.
 
 L<JWebmail::Model::Driver::QMailAuthuser>
 
-=cut
\ No newline at end of file
+=cut
diff --git a/lib/JWebmail/Model/Driver/QMailAuthuser/schema.json b/lib/JWebmail/Model/Driver/QMailAuthuser/schema.json
new file mode 100644
index 0000000..5d5247a
--- /dev/null
+++ b/lib/JWebmail/Model/Driver/QMailAuthuser/schema.json
@@ -0,0 +1,79 @@
+{
+  "$schema": "http://json-schema.org/schema#",
+  "definitions": {
+    "count": {
+      "type": "object",
+      "properties": {
+        "new": {"type": "integer", "minimum": 0},
+        "size": {"type": "integer", "minimum": 0},
+        "count": {"type": "integer", "minimum": 0},
+        "unread": {"type": "integer", "minimum": 0}
+      },
+      "required": ["count"],
+      "additionalProperties": false
+    },
+    "folders": {
+      "type": "array",
+      "items": {
+        "type": "string"
+      }
+    },
+    "mail_addrs": {
+      "type": "array",
+      "items": {
+        "type": "object",
+        "properties": {
+          "name": {"type": "string"},
+          "address": {"type": "string"}
+        },
+        "required": ["address"]
+      },
+      "minItems": 1
+    },
+    "mail_head": {
+      "type": "object",
+      "properties": {
+        "new": {"type": "boolean"},
+        "mid": {"type": "string"},
+        "content_type": {"type": "string"},
+        "size": {"type": "integer", "minimum": 0},
+        "date_send": {"type": "string"},
+        "date_received": {"type": "string"},
+        "cc": {"$ref": "#/definitions/mail_addrs"},
+        "bcc": {"$ref": "#/definitions/mail_addrs"},
+        "to": {"$ref": "#/definitions/mail_addrs"},
+        "from": {"$ref": "#/definitions/mail_addrs"},
+        "subject": {"type": "string"}
+      },
+      "required": ["mid"]
+    },
+    "list": {
+      "type": "array",
+      "items": {
+        "$ref": "#/definitions/mail_head"
+      }
+    },
+    "mail": {
+      "$ref": "#/definitions/mail_head",
+      "properties": {
+        "body": {
+          "anyOf": [
+            {"type": "string"},
+            {
+              "type": "array",
+              "minItems": 1,
+              "items": {
+                "type": "object",
+                "properties": {
+                  "val": {"type": "string"},
+                  "type": {"type": "string"}
+                }
+              }
+            }
+          ]
+        }
+      },
+      "required": ["body"]
+    }
+  }
+}
diff --git a/lib/JWebmail/Model/ReadMails.pm b/lib/JWebmail/Model/ReadMails.pm
index 0f2e1cc..ddca7ce 100644
--- a/lib/JWebmail/Model/ReadMails.pm
+++ b/lib/JWebmail/Model/ReadMails.pm
@@ -38,7 +38,7 @@ sub read_headers_for {
         password => $auth->password,
         challenge => $auth->challenge,
         mode => 'list',
-        args => [$start || '0', $end || '0', $sort || 'date', $folder || ''],
+        args => [$start // 0, $end // 0, $sort // 'date', $folder // ''],
     );
     die "connection error: $resp->{error}" if $rc;
     return $resp;
@@ -176,6 +176,9 @@ Checks user name and password.
 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
+
 =head2 count
 
 Returns size of the mail box folder in bytes the number of mails.
@@ -224,4 +227,4 @@ Optinal challange for when you use cram authentication.
 
 L<JWebmail::Model::Driver::QMailAuthuser>, L<JWebmail::Model::Driver::Mock>, L<JWebmail>
 
-=cut
\ No newline at end of file
+=cut
diff --git a/lib/JWebmail/Model/WriteMails.pm b/lib/JWebmail/Model/WriteMails.pm
index 1807a72..aa2f1d4 100644
--- a/lib/JWebmail/Model/WriteMails.pm
+++ b/lib/JWebmail/Model/WriteMails.pm
@@ -24,8 +24,7 @@ sub _build_mail {
         },
         body_str => $mail->{message},
     );
-    my $attach;
-    $attach = Email::MIME->create(
+    my $attach = Email::MIME->create(
         attributes => {
             content_type => $mail->{attach_type},
             encoding     => 'base64',
@@ -40,7 +39,7 @@ sub _build_mail {
             Subject    => $mail->{subject},
             'X-Mailer' => 'JWebmail',
         ],
-        parts => [$text_part, $attach || () ],
+        parts => [ $text_part, $attach // () ],
     );
     $email->header_str_set(CC => @{$mail->{cc}}) if $mail->{cc};
     $email->header_str_set('Reply-To' => $mail->{reply}) if $mail->{reply};
diff --git a/lib/JWebmail/Plugin/Helper.pm b/lib/JWebmail/Plugin/Helper.pm
index f24bdba..c454b9f 100644
--- a/lib/JWebmail/Plugin/Helper.pm
+++ b/lib/JWebmail/Plugin/Helper.pm
@@ -2,7 +2,7 @@ package JWebmail::Plugin::Helper;
 
 use Mojo::Base 'Mojolicious::Plugin';
 
-use List::Util qw(min max);
+use List::Util qw(all min max);
 use Mojo::Util qw(encode decode b64_encode b64_decode xml_escape);
 use POSIX qw(floor round log ceil);
 
@@ -45,8 +45,7 @@ sub filter_empty_upload {
 ### template formatting functions
 
 sub print_sizes10 {
-    my $var = shift;
-    if ($var == 0) { return '0 Byte'; }
+    my $var = shift || return '0 Byte';
 
     my $i = floor(((log($var)/log(10))+1e-5) / 3);
     my $expo = $i * 3;
@@ -64,8 +63,7 @@ sub print_sizes10 {
 
 
 sub print_sizes2 {
-    my $var = shift;
-    if ($var == 0) { return '0 Byte'; }
+    my $var = shift || return '0 Byte';
 
     my $i = floor(((log($var)/log(2))+1e-5) / 10);
     my $expo = $i * 10;
@@ -85,7 +83,10 @@ sub print_sizes2 {
 sub d { qr/([[:digit:]]{$_[0]})/ }
 
 sub parse_iso_date {
-    my @d = shift =~ m/@{[d(4).'-'.d(2).'-'.d(2).'T'.d(2).':'.d(2).':'.d(2).'Z']}/;
+    my @d = shift =~ m/@{[d(4).'-'.d(2).'-'.d(2).'T'.d(2).':'.d(2).':'.d(2)]}/;
+    if (!all { defined $_ } @d) {
+        # TODO
+    }
     return {
         year  => $d[0],
         month => $d[1],
@@ -124,8 +125,9 @@ our %MIME_Render_Subs = (
 sub mime_render {
     my ($c, $enc, $cont) = @_;
 
-    my $renderer = $MIME_Render_Subs{$enc};
-    return '' unless defined $renderer;
+    ($enc) = $enc =~ m"^(\w+/\w+);?";
+
+    my $renderer = $MIME_Render_Subs{$enc} // return '';
     return $renderer->($c, $cont);
 };
 
@@ -288,6 +290,7 @@ sub paginate {
 
 sub register {
     my ($self, $app, $conf) = @_;
+    $conf //= {};
 
     if (ref $conf->{import} eq 'ARRAY' and my @import = @{ $conf->{import} }) {
         no warnings 'experimental::smartmatch';
diff --git a/lib/JWebmail/Plugin/I18N.pm b/lib/JWebmail/Plugin/I18N.pm
index 32ac917..6d58932 100644
--- a/lib/JWebmail/Plugin/I18N.pm
+++ b/lib/JWebmail/Plugin/I18N.pm
@@ -14,6 +14,7 @@ has '_language_loaded' => sub { {} };
 
 sub register {
     my ($self, $app, $conf) = @_;
+    $conf //= {};
 
     my $i18n_log = $app->log->context('[' . __PACKAGE__ . ']');
 
diff --git a/lib/JWebmail/Plugin/I18N2.pm b/lib/JWebmail/Plugin/I18N2.pm
index 4217c70..5084c97 100644
--- a/lib/JWebmail/Plugin/I18N2.pm
+++ b/lib/JWebmail/Plugin/I18N2.pm
@@ -40,6 +40,7 @@ has '_language_loaded' => sub { {} };
 
 sub register {
     my ($self, $app, $conf) = @_;
+    $conf //= {};
 
     my $i18n_log = $app->log->context('[' . __PACKAGE__ . ']');
 
diff --git a/lib/JWebmail/Plugin/ServerSideSessionData.pm b/lib/JWebmail/Plugin/ServerSideSessionData.pm
index 274594f..d416c00 100644
--- a/lib/JWebmail/Plugin/ServerSideSessionData.pm
+++ b/lib/JWebmail/Plugin/ServerSideSessionData.pm
@@ -9,10 +9,12 @@ use Fcntl ':DEFAULT', ':seek';
 use Time::HiRes 'sleep';
 
 
-use constant S_KEY => 's3d.key';
-use constant CLEANUP_FILE_NAME => 'cleanup';
-use constant LOCK_ITER => 5;
-use constant ADVANCE_ON_FAILURE => 10; # seconds to retry to acquire the lock
+use constant {
+    S_KEY              => 's3d.key',
+    CLEANUP_FILE_NAME  => 'cleanup',
+    LOCK_ITER          => 5,
+    ADVANCE_ON_FAILURE => 10, # seconds to retry to acquire the lock
+};
 
 has 'session_directory';
 has 'expiration';
@@ -21,7 +23,7 @@ has 'cleanup_interval';
 has 'next_cleanup' => 0;
 
 
-# read und potentially update file return bool
+# read and potentially update file return bool
 # needs atomic lock file
 # the file contains a single timestamp
 sub _rw_cleanup_file {
@@ -33,7 +35,7 @@ sub _rw_cleanup_file {
 
     my ($lock, $ctr, $rmlock);
     until (sysopen($lock, $lock_name, O_WRONLY | O_CREAT | O_EXCL)) {
-        die "unexpected error '$!'" unless $! eq 'File exists';
+        die "unexpected error '$!'" unless $! eq 'File exists'; # TODO: rework err check
         if ($ctr > LOCK_ITER) {
             open($lock, '<', $lock_name) or die "unexpected error '$!'";
             my $pid = <$lock>;
@@ -125,6 +127,7 @@ sub s3d {
         $data->{$key} = $val;
 
         $file->spurt(encode_json $data, "\n");
+        return;
     }
     else { # get
         return defined $key ? $data->{$key} : $data;
@@ -134,6 +137,7 @@ sub s3d {
 
 sub register {
     my ($self, $app, $conf) = @_;
+    $conf //= {};
 
     $self->session_directory(Mojo::File->new($conf->{directory} || "/tmp/" . $app->moniker));
     $self->expiration($conf->{expiration} || $app->sessions->default_expiration);