diff options
Diffstat (limited to 'lib/JWebmail/Model/Driver')
-rw-r--r-- | lib/JWebmail/Model/Driver/MockJSON.pm (renamed from lib/JWebmail/Model/Driver/Mock.pm) | 4 | ||||
-rw-r--r-- | lib/JWebmail/Model/Driver/MockMaildir.pm | 57 | ||||
-rw-r--r-- | lib/JWebmail/Model/Driver/QMailAuthuser.pm | 16 | ||||
-rwxr-xr-x | lib/JWebmail/Model/Driver/QMailAuthuser/Extract.pm | 25 | ||||
-rw-r--r-- | lib/JWebmail/Model/Driver/QMailAuthuser/schema.json | 79 |
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"] + } + } +} |