summaryrefslogtreecommitdiff
path: root/lib/JWebmail/Model/Driver
diff options
context:
space:
mode:
Diffstat (limited to 'lib/JWebmail/Model/Driver')
-rw-r--r--lib/JWebmail/Model/Driver/MockJSON.pm104
-rw-r--r--lib/JWebmail/Model/Driver/MockMaildir.pm57
-rw-r--r--lib/JWebmail/Model/Driver/QMailAuthuser.pm138
-rwxr-xr-xlib/JWebmail/Model/Driver/QMailAuthuser/Extract.pm296
-rw-r--r--lib/JWebmail/Model/Driver/QMailAuthuser/schema.json83
5 files changed, 0 insertions, 678 deletions
diff --git a/lib/JWebmail/Model/Driver/MockJSON.pm b/lib/JWebmail/Model/Driver/MockJSON.pm
deleted file mode 100644
index 258246d..0000000
--- a/lib/JWebmail/Model/Driver/MockJSON.pm
+++ /dev/null
@@ -1,104 +0,0 @@
-package JWebmail::Model::Driver::MockJSON;
-
-use Mojo::Base -base;
-
-use List::Util 'sum';
-
-use Mojo::JSON qw(decode_json);
-
-
-use constant {
- VALID_USER => 'mockjson@example.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}||$a->{head}{$sort_by}) cmp ($b->{$sort_by}||$b->{head}{$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<JWebmail::Model::ReadMails> module.
-
-=cut
diff --git a/lib/JWebmail/Model/Driver/MockMaildir.pm b/lib/JWebmail/Model/Driver/MockMaildir.pm
deleted file mode 100644
index e8956ed..0000000
--- a/lib/JWebmail/Model/Driver/MockMaildir.pm
+++ /dev/null
@@ -1,57 +0,0 @@
-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
deleted file mode 100644
index a310024..0000000
--- a/lib/JWebmail/Model/Driver/QMailAuthuser.pm
+++ /dev/null
@@ -1,138 +0,0 @@
-package JWebmail::Model::Driver::QMailAuthuser;
-
-use Mojo::Base -base;
-
-use IPC::Open2;
-use File::Basename 'fileparse';
-use JSON::PP 'decode_json';
-
-
-has 'user';
-has 'maildir';
-has 'prefix' => '';
-has qmail_dir => '/var/qmail/';
-has prog => [fileparse(__FILE__)]->[1] . '/QMailAuthuser/Extract.pm';
-has logfile => '/dev/null';
-
-
-sub communicate {
- my $self = shift;
- my %args = @_;
-
- $args{challenge} //= '';
- $args{args} //= [];
-
- my $exec = do {
- if ($args{mode} eq 'auth') {
- $self->qmail_dir . "/bin/qmail-authuser true 3<&0";
- }
- else {
- my ($user_name) = $args{user} =~ /(\w*)@/;
-
- $self->qmail_dir.'/bin/qmail-authuser'
- . $self->prefix . ' '
- . join(' ', map { $_ =~ s/(['\\])/\\$1/g; "'$_'" } ($self->prog, $self->maildir, $self->user, $user_name, $args{mode}, @{$args{args}}))
- . ' 3<&0'
- . ' 2>>'.$self->logfile;
- }
- };
-
- my $pid = open2(my $reader, my $writer, $exec)
- or die 'failed to create subprocess';
-
- $writer->print("$args{user}\0$args{password}\0$args{challenge}\0")
- or die 'pipe wite failed';
- close $writer
- or die 'closing write pipe failed';
-
- binmode $reader, ':utf8';
- my $input = <$reader>;
- close $reader
- or die 'closing read pipe failed';
-
- waitpid($pid, 0);
- my $rc = $? >> 8;
-
- my $resp;
- if ($rc == 3 || $rc == 0) {
- eval { $resp = decode_json $input; };
- if ($@) { $resp = {error => 'decoding error'} };
- }
- elsif ($rc) {
- $resp = {error => "qmail-authuser returned code: $rc"};
- }
-
- return ($resp, $rc);
-}
-
-
-1
-
-__END__
-
-=encoding utf-8
-
-=head1 NAME
-
-QMailAuthuser
-
-=head1 SYNOPSIS
-
- my $m = JWebmail::Model::ReadMails->new(driver => JWebmail::Model::Driver::QMailAuthuser->new(...));
-
-=head1 DESCRIPTION
-
-This ReadMails driver starts and communicates with L<JWebmail::Model::Driver::QMailAuthuser::Extract> over qmail-authuser.
-The Extract programm runs with elevated priviliges to be able to read and modify mailboxes.
-
-=head1 ATTRIBUTES
-
-=head2 qmail_dir
-
-The parent directory of the bin directory where all qmail executables live.
-Default C</var/qmail/>.
-
-=head2 prog
-
-The path to the extractor programm.
-Default is the location of L<JWebmail::Model::Driver::QMailAuthuser::Extract> package.
-
-=head2 logfile
-
-A path to a log file that the extractor logs to.
-Default '/dev/null' but highly recommended to set a real one.
-Keep in mind that a different user need to be able to write to it.
-
-=head1 METHODS
-
-=head2 communicate
-
-Arguments:
-
-=over 6
-
-=item mode
-
-=item args
-
-Depends on the mode
-
-=item user
-
-E-Mail address of the user
-
-=item password
-
-Corresponding e-mail user password
-
-=item challenge
-
-Challenge when using cram
-
-=back
-
-=head1 SEE ALSO
-
-L<JWebmail::Model::ReadMails>, L<JWebmail::Model::Driver::QMailAuthuser::Extract>
-
-=cut
diff --git a/lib/JWebmail/Model/Driver/QMailAuthuser/Extract.pm b/lib/JWebmail/Model/Driver/QMailAuthuser/Extract.pm
deleted file mode 100755
index a59e265..0000000
--- a/lib/JWebmail/Model/Driver/QMailAuthuser/Extract.pm
+++ /dev/null
@@ -1,296 +0,0 @@
-#!/usr/bin/env perl
-package JWebmail::Model::Driver::QMailAuthuser::Extract;
-
-use v5.18;
-use strict;
-use warnings;
-use utf8;
-
-use POSIX ();
-use JSON::PP;
-use Carp;
-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 => '.';
-
-
-sub main {
- my ($maildir) = shift(@ARGV) =~ m/(.*)/;
- my ($su) = shift(@ARGV) =~ m/(.*)/;
- my ($user) = shift(@ARGV) =~ m/([[:alpha:]]+)/;
- my $mode = shift @ARGV; _ok($mode =~ m/([[:alpha:]-]{1,20})/);
- my @args = @ARGV;
-
- delete $ENV{PATH};
-
- my $netfehcom_uid = getpwnam($su);
- #$> = $netfehcom_uid;
- die "won't stay as root" if $netfehcom_uid == 0;
- POSIX::setuid($netfehcom_uid);
- if ($!) {
- warn 'error setting uid';
- exit(1);
- }
-
- my $folder = Mail::Box::Manager->new->open(
- folder => "$maildir/$user/",
- type => 'maildir',
- access => 'rw',
- );
-
- my $reply = do {
- given ($mode) {
- when('list') { list($folder, @args) }
- when('read-mail') { read_mail($folder, @args) }
- when('count') { count_messages($folder, @args) }
- when('search') { search($folder, @args) }
- when('folders') { folders($folder, @args) }
- when('move') { move($folder, @args) }
- default { {error => 'unkown mode', mode => $mode} }
- }
- };
- $folder->close;
-
- print(encode_json $reply);
- if (ref $reply eq 'HASH' && $reply->{error}) {
- exit 3;
- }
-}
-
-
-sub _sort_mails {
- my $sort = shift // '';
- my $reverse = 1;
-
- if ($sort =~ m/^!/) {
- $reverse = -1;
- $sort = substr $sort, 1;
- }
-
- given ($sort) {
- when ('date') { return sub { ($a->timestamp <=> $b->timestamp) * $reverse } }
- when ('sender') { return sub { ($a->from->[0] cmp $b->from->[0]) * $reverse } }
- when ('subject') { return sub { ($a->subject cmp $b->subject) * $reverse } }
- when ('size') { return sub { ($a->size <=> $b->size) * $reverse } }
- when ('') { return sub { ($a->timestamp <=> $b->timestamp) * $reverse } }
- default { warn "unkown sort-verb '$sort'"; return sub { ($a->timestamp <=> $b->timestamp) * $reverse } }
- }
-}
-
-
-sub _ok {
- if (!shift) {
- carp 'verify failed';
- exit 4;
- }
-}
-
-
-sub list {
- my ($f, $start, $end, $sortby, $folder) = @_;
- $folder = ".$folder";
-
- _ok($start =~ m/^\d+$/);
- _ok($end =~ m/^\d+$/);
- _ok(0 <= $start && $start <= $end);
- _ok($sortby =~ m/^(!?\w+|\w*)$/n);
- _ok($folder ~~ [$f->listSubFolders, ROOT_MAILDIR]);
-
- $f = $f->openSubFolder($folder) if $folder ne ROOT_MAILDIR;
-
- return [] if $start == $end;
-
- my $sref = _sort_mails($sortby);
- my @msgs = $f->messages;
- @msgs = sort { &$sref } @msgs;
- @msgs = @msgs[$start..min($#msgs, $end)];
-
- my @msgs2;
-
- for my $msg (@msgs) {
- my $msg2 = {
- mid => $msg->messageId,
- size => $msg->size,
- new => $msg->label('seen'),
- head => {
- 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),
- content_type => ''.$msg->contentType,
- },
- };
- push @msgs2, $msg2;
- }
-
- return \@msgs2;
-}
-
-
-sub count_messages {
- my ($f, $folder) = @_;
- $folder = ".$folder";
-
- _ok($folder ~~ [$f->listSubFolders, ROOT_MAILDIR]);
-
- $f = $f->openSubFolder($folder) if $folder ne ROOT_MAILDIR;
-
- return {
- count => scalar($f->messages('ALL')),
- size => $f->size,
- new => scalar $f->messages('!seen'),
- }
-}
-
-
-sub _iso8601_utc {
- my @date_time = gmtime(shift);
- $date_time[5] += 1900;
- $date_time[4]++;
- return sprintf('%6$04d-%5$02d-%4$02dT%3$02d:%2$02d:%1$02dZ', @date_time);
-}
-
-sub _unquote { my $x = shift; [$x =~ m/"(.*?)"(?<!\\)/]->[0] || $x }
-
-sub _addresses {
- [map { {address => $_->address, name => _unquote(decode('MIME-Header', $_->phrase))} } @_]
-}
-
-
-sub read_mail {
- my ($folder, $mid) = @_;
-
- my $msg = $folder->find($mid);
- return {error => 'no such message', mid => $mid} unless $msg;
- return {
- size => $msg->size,
- head => {
- 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),
- content_type => ''. $msg->contentType,
- },
- body => do {
- if ($msg->isMultipart) {
- [map {{type => ''. $_->contentType, val => '' . $_->decoded}} $msg->body->parts]
- }
- else {
- '' . $msg->body->decoded
- }
- },
- }
-}
-
-
-sub search {
- my ($f, $search_pattern, $folder) = @_;
- $folder = ".$folder";
-
- $f = $f->openSubFolder($folder) if $folder ne ROOT_MAILDIR;
-
- my @msgs = $f->messages(sub {
- my $m = shift;
-
- return scalar(grep { $_->decoded =~ /$search_pattern/ || (decode('MIME-Header', $_->subject)) =~ /$search_pattern/ } $m->body->parts)
- if $m->isMultipart;
- $m->body->decoded =~ /$search_pattern/ || (decode('MIME-Header', $m->subject)) =~ /$search_pattern/;
- });
-
- my @msgs2;
- for my $msg (@msgs) {
- my $msg2 = {
- size => $msg->size,
- mid => $msg->messageId,
- head => {
- 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),
- content_type => ''. $msg->contentType,
- },
- };
- push @msgs2, $msg2;
- }
-
- return \@msgs2;
-}
-
-
-sub folders {
- my $f = shift;
-
- return [grep { $_ =~ m/^\./ && $_ =~ s/\.// } $f->listSubFolders];
-}
-
-
-sub move {
- my ($f, $mid, $dst) = @_;
- $dst = ".$dst";
-
- _ok($dst ~~ [$f->listSubFolders, ROOT_MAILDIR]);
-
- $f->moveMessage($dst, $dst->find($mid));
-}
-
-
-main() if !caller;
-
-1
-
-__END__
-
-=encoding utf-8
-
-=head1 NAME
-
-JWebmail::Model::Driver::QMailAuthuser::Extract - Maildir reader
-
-=head1 SYNOPSIS
-
-Extract delivers information about emails.
-Runs with elevated priviliges.
-
-=head1 DESCRIPTION
-
-This programm is started by qmail-authuser with elevated priviliges after
-a succsessful login.
-Input directives are provided as command line arguments.
-Output is delivered via STDOUT and log information via STDERR.
-
-=head1 ARGUMENTS
-
- prog <maildir> <system-user> <mail-user> <mode> <args...>
-
-=head2 Modes
-
- list <start> <end> <sort-by> <folder>
- count <folder>
- read-mail <mid>
- search <pattern> <folder>
- folders
- move <mid> <dst-folder>
-
-All arguments must be supplied for a given mode even if empty (as '').
-
-=head1 DEPENDENCIES
-
-Currently Mail::Box::Manager does all the hard work.
-
-=head1 SEE ALSO
-
-L<JWebmail::Model::Driver::QMailAuthuser>
-
-=cut
diff --git a/lib/JWebmail/Model/Driver/QMailAuthuser/schema.json b/lib/JWebmail/Model/Driver/QMailAuthuser/schema.json
deleted file mode 100644
index b63a5eb..0000000
--- a/lib/JWebmail/Model/Driver/QMailAuthuser/schema.json
+++ /dev/null
@@ -1,83 +0,0 @@
-{
- "$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": {
- "content_type": {"type": "string"},
- "date": {"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": ["date", "from"]
- },
- "head_list": {
- "type": "array",
- "items": {
- "$ref": "#/definitions/mail_head"
- }
- },
- "mail_body": {
- "anyOf": [
- {"type": "string"},
- {
- "type": "array",
- "minItems": 1,
- "items": {
- "type": "object",
- "properties": {
- "head": {"$ref": "#/definitions/mail_head"},
- "body": {"$ref": "#/definitions/mail_body"}
- }
- }
- },
- {
- "ref": "#/definitions/mail"
- }
- ]
- },
- "mail": {
- "type": "object",
- "properties": {
- "new": {"type": "boolean"},
- "mid": {"type": "string"},
- "size": {"type": "integer", "minimum": 0},
- "head": {"$ref": "#/definitions/mail_head"},
- "body": {"$ref": "#/definitions/mail_body"}
- },
- "required": ["mid"]
- }
- }
-}
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-24 16:39:20 +0000