From 2388747fbf954de990862a6c01713d50823e8725 Mon Sep 17 00:00:00 2001 From: "Jannis M. Hoffmann" Date: Tue, 24 Aug 2021 11:10:39 +0200 Subject: overhauled testing --- lib/JWebmail/Model/Driver/Mock.pm | 104 --------------------- lib/JWebmail/Model/Driver/MockJSON.pm | 104 +++++++++++++++++++++ lib/JWebmail/Model/Driver/MockMaildir.pm | 57 +++++++++++ lib/JWebmail/Model/Driver/QMailAuthuser.pm | 16 ++-- lib/JWebmail/Model/Driver/QMailAuthuser/Extract.pm | 25 +++-- .../Model/Driver/QMailAuthuser/schema.json | 79 ++++++++++++++++ lib/JWebmail/Model/ReadMails.pm | 7 +- lib/JWebmail/Model/WriteMails.pm | 5 +- 8 files changed, 264 insertions(+), 133 deletions(-) delete mode 100644 lib/JWebmail/Model/Driver/Mock.pm create mode 100644 lib/JWebmail/Model/Driver/MockJSON.pm create mode 100644 lib/JWebmail/Model/Driver/MockMaildir.pm create mode 100644 lib/JWebmail/Model/Driver/QMailAuthuser/schema.json (limited to 'lib/JWebmail/Model') diff --git a/lib/JWebmail/Model/Driver/Mock.pm b/lib/JWebmail/Model/Driver/Mock.pm deleted file mode 100644 index b2da1be..0000000 --- a/lib/JWebmail/Model/Driver/Mock.pm +++ /dev/null @@ -1,104 +0,0 @@ -package JWebmail::Model::Driver::Mock; - -use Mojo::Base -base; - -use List::Util 'sum'; - -use Mojo::JSON qw(decode_json); - - -use constant { - VALID_USER => 'me@example.de', - VALID_PW => 'vwxyz', -}; - -use constant { - LIST_START => 0, - LIST_END => 1, - LIST_SORT => 2, - LIST_FOLDER => 3, -}; - -sub _read_json_file { - my ($file_name) = @_; - - use constant PREFIX => 't/private/'; - - open(my $body_file, '<', PREFIX . $file_name); - local $/; - my $body = <$body_file>; - close $body_file; - - return decode_json($body); -} - - -sub list_reply { - state $init = _read_json_file('msgs.json'); -} -sub read_reply { - state $init = { - 'SC-ORD-MAIL54526c63b751646618a793be3f8329cca@sc-ord-mail5' => _read_json_file('msg2.json'), - 'example' => _read_json_file('msg.json'), - }; -} - - -sub communicate { - no warnings 'experimental::smartmatch'; - - my $self = shift; - - my %args = @_; - - given ($args{mode}) { - when ('auth') { - return (undef, 0) if $args{user} eq VALID_USER && $args{password} eq VALID_PW; - return (undef, 2); - } - when ('list') { - return ([@{ $self->list_reply }[$args{args}->[LIST_START]..$args{args}->[LIST_END]]], 0) if !$args{args}->[LIST_SORT]; - return ([], 0) if $args{args}->[LIST_FOLDER] eq 'test'; - my $s = sub { - my $sort_by = $args{args}->[LIST_SORT]; - my $rev = $sort_by !~ m/^![[:lower:]]+/ ? 1 : -1; - $sort_by =~ s/!//; - return ($a->{$sort_by} cmp $b->{$sort_by}) * $rev; - }; - return ([sort { &$s } @{ $self->list_reply }[$args{args}->[LIST_START]..$args{args}->[LIST_END]]], 0); - } - when ('count') { - return ({ - count => scalar(@{ $self->list_reply }), - size => sum(map {$_->{size}} @{ $self->list_reply }), - new => 0, - }, 0); - } - when ('read-mail') { - my $mid = $args{args}->[0]; - my $mail = $self->read_reply->{$mid}; - return ($mail, 0) if $mail; - return ({error => 'unkown mail-id'}, 3); - } - when ('folders') { - return ([qw(cur test devel debug)], 0); - } - when ('move') { - local $, = ' '; - say "@{ $args{args} }"; - return (undef, 0); - } - default { return ({error => 'unkown mode'}, 3); } - } -} - - -1 - -__END__ - -=head1 NAME - -Mock - Simple file based mock for the L module. - -=cut diff --git a/lib/JWebmail/Model/Driver/MockJSON.pm b/lib/JWebmail/Model/Driver/MockJSON.pm new file mode 100644 index 0000000..99df346 --- /dev/null +++ b/lib/JWebmail/Model/Driver/MockJSON.pm @@ -0,0 +1,104 @@ +package JWebmail::Model::Driver::MockJSON; + +use Mojo::Base -base; + +use List::Util 'sum'; + +use Mojo::JSON qw(decode_json); + + +use constant { + VALID_USER => 'me@mockjson.com', + VALID_PW => 'vwxyz', +}; + +use constant { + LIST_START => 0, + LIST_END => 1, + LIST_SORT => 2, + LIST_FOLDER => 3, +}; + +sub _read_json_file { + my ($file_name) = @_; + + use constant PREFIX => 't/private/'; + + open(my $body_file, '<', PREFIX . $file_name); + local $/; + my $body = <$body_file>; + close $body_file; + + return decode_json($body); +} + + +sub list_reply { + state $init = _read_json_file('msgs.json'); +} +sub read_reply { + state $init = { + 'SC-ORD-MAIL54526c63b751646618a793be3f8329cca@sc-ord-mail5' => _read_json_file('msg2.json'), + 'example' => _read_json_file('msg.json'), + }; +} + + +sub communicate { + no warnings 'experimental::smartmatch'; + + my $self = shift; + + my %args = @_; + + given ($args{mode}) { + when ('auth') { + return (undef, 0) if $args{user} eq VALID_USER && $args{password} eq VALID_PW; + return (undef, 2); + } + when ('list') { + return ([@{ $self->list_reply }[$args{args}->[LIST_START]..$args{args}->[LIST_END]]], 0) if !$args{args}->[LIST_SORT]; + return ([], 0) if $args{args}->[LIST_FOLDER] eq 'test'; + my $s = sub { + my $sort_by = $args{args}->[LIST_SORT]; + my $rev = $sort_by !~ m/^![[:lower:]]+/ ? 1 : -1; + $sort_by =~ s/!//; + return ($a->{$sort_by} cmp $b->{$sort_by}) * $rev; + }; + return ([sort { &$s } @{ $self->list_reply }[$args{args}->[LIST_START]..$args{args}->[LIST_END]]], 0); + } + when ('count') { + return ({ + count => scalar(@{ $self->list_reply }), + size => sum(map {$_->{size}} @{ $self->list_reply }), + new => 0, + }, 0); + } + when ('read-mail') { + my $mid = $args{args}->[0]; + my $mail = $self->read_reply->{$mid}; + return ($mail, 0) if $mail; + return ({error => 'unkown mail-id'}, 3); + } + when ('folders') { + return ([qw(cur test devel debug)], 0); + } + when ('move') { + local $, = ' '; + say "@{ $args{args} }"; + return (undef, 0); + } + default { return ({error => 'unkown mode'}, 3); } + } +} + + +1 + +__END__ + +=head1 NAME + +Mock - Simple file based mock for the L module. + +=cut 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, L -=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 -=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, L, L -=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}; -- cgit v1.2.3