overhauled testing

5 files changed, 155 insertions, 26 deletions

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"]
+    }
+  }
+}