summaryrefslogtreecommitdiff
path: root/lib/JWebmail/Model
diff options
context:
space:
mode:
Diffstat (limited to 'lib/JWebmail/Model')
-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.pm57
-rw-r--r--lib/JWebmail/Model/Driver/QMailAuthuser.pm16
-rwxr-xr-xlib/JWebmail/Model/Driver/QMailAuthuser/Extract.pm25
-rw-r--r--lib/JWebmail/Model/Driver/QMailAuthuser/schema.json79
-rw-r--r--lib/JWebmail/Model/ReadMails.pm7
-rw-r--r--lib/JWebmail/Model/WriteMails.pm5
7 files changed, 162 insertions, 31 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"]
+ }
+ }
+}
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};
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-24 17:20:44 +0000