From a97f1a5eb6649e93bfd6584ed590e37c1290755f Mon Sep 17 00:00:00 2001 From: "Jannis M. Hoffmann" Date: Mon, 25 Apr 2022 16:52:57 +0200 Subject: Refactored ReadMails into a role --- lib/JWebmail/Model/ReadMails/MockJSON.pm | 119 ++++++++++++ lib/JWebmail/Model/ReadMails/MockMaildir.pm | 57 ++++++ lib/JWebmail/Model/ReadMails/QMailAuthuser.pm | 267 ++++++++++++++++++++++++++ lib/JWebmail/Model/ReadMails/Role.pm | 129 +++++++++++++ lib/JWebmail/Model/ReadMails/schema.json | 83 ++++++++ 5 files changed, 655 insertions(+) create mode 100644 lib/JWebmail/Model/ReadMails/MockJSON.pm create mode 100644 lib/JWebmail/Model/ReadMails/MockMaildir.pm create mode 100644 lib/JWebmail/Model/ReadMails/QMailAuthuser.pm create mode 100644 lib/JWebmail/Model/ReadMails/Role.pm create mode 100644 lib/JWebmail/Model/ReadMails/schema.json (limited to 'lib/JWebmail/Model/ReadMails') diff --git a/lib/JWebmail/Model/ReadMails/MockJSON.pm b/lib/JWebmail/Model/ReadMails/MockJSON.pm new file mode 100644 index 0000000..bb105d1 --- /dev/null +++ b/lib/JWebmail/Model/ReadMails/MockJSON.pm @@ -0,0 +1,119 @@ +package JWebmail::Model::ReadMails::MockJSON; + +use v5.24; +use warnings; +use utf8; + +use List::Util 'sum'; + +use Role::Tiny::With; + +use Mojo::JSON qw(decode_json); + +use constant { + VALID_USER => 'mockjson@example.com', + VALID_PW => 'vwxyz', +}; + +use namespace::clean; + +with 'JWebmail::Model::ReadMails::Role'; + + +sub new { bless {} } + +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 verify_user { + my $self = shift; + my $auth = shift; + + return $auth->{user} eq VALID_USER && $auth->{password} eq VALID_PW; +} + +sub read_headers_for { + my $self = shift; + my $auth = shift; + my %args = @_; + + my ($start, $end, $sort, $folder) = @args{qw(start end sort folder)}; + + unless ($sort) { + return [@{ $self->list_reply }[$start..$end]]; + } + if ($folder eq 'test') { + return []; + } + my $s = sub { + my $sort_by = $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 }[$start..$end]]; +} + +sub count { + my $self = shift; + my $auth = shift; + my $_folder = shift; + + return ( + sum(map {$_->{size}} @{ $self->list_reply }), # size + scalar(@{ $self->list_reply }), # count + 0, # new + ); +} + +sub show { + my $self = shift; + my $auth = shift; + my $mid = shift; + + my $mail = $self->read_reply->{$mid}; + if ($mail) { + return $mail; + } + else { + die 'unkown mail-id'; + } +} + +sub folders { ['', qw(cur test devel debug)] } + +sub search { ... } +sub move { ... } + + +1 + +__END__ + +=head1 NAME + +Mock - Simple file based mock for the L module. + +=cut diff --git a/lib/JWebmail/Model/ReadMails/MockMaildir.pm b/lib/JWebmail/Model/ReadMails/MockMaildir.pm new file mode 100644 index 0000000..31e9618 --- /dev/null +++ b/lib/JWebmail/Model/ReadMails/MockMaildir.pm @@ -0,0 +1,57 @@ +package JWebmail::Model::ReadMails::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/ReadMails/QMailAuthuser.pm b/lib/JWebmail/Model/ReadMails/QMailAuthuser.pm new file mode 100644 index 0000000..8387217 --- /dev/null +++ b/lib/JWebmail/Model/ReadMails/QMailAuthuser.pm @@ -0,0 +1,267 @@ +package JWebmail::Model::ReadMails::QMailAuthuser; + +use v5.22; +use warnings; +use utf8; + +use IPC::Open2; +use File::Basename 'fileparse'; +use JSON::PP 'decode_json'; +use Params::Check 'check'; +use Scalar::Util 'blessed'; +use Role::Tiny::With; +use namespace::clean; + +with 'JWebmail::Model::ReadMails::Role'; + + +my $QMailAuthuserCheck = { + user => {defined => 1, required => 1}, + maildir => {defined => 1, required => 1}, + prefix => {defined => 1, default => ''}, + qmail_dir => {defined => 1, default => '/var/qmail/'}, + logfile => {defined => 1, default => '/dev/null'}, + prog => {defined => 1, default => ([fileparse(__FILE__)]->[1] . '/QMailAuthuser/Extract.pm')}, +}; + +sub new { + my $cls = shift; + my $self = @_ == 1 ? $_[0] : {@_}; + + if (my $pkg = blessed $cls) { + $self = {%$cls, %$self}; + $cls = $pkg; + } + $self = check($QMailAuthuserCheck, $self, 1) || die; + return bless $self, $cls; +} + +sub verify_user { + my $self = shift; + my $auth = shift; + + return !scalar $self->communicate( + user => $auth->{user}, + password => $auth->{password}, + challenge => $auth->{challenge}, + mode => 'auth', + ) +} + +sub read_headers_for { + my $self = shift; + my $auth = shift; + + my %h = @_; + my ($folder, $start, $end, $sort) = @h{qw(folder start end sort)}; + + my ($resp, $rc) = $self->communicate( + user => $auth->{user}, + password => $auth->{password}, + challenge => $auth->{challenge}, + mode => 'list', + args => [$start // 0, $end // 0, $sort // 'date', $folder // ''], + ); + die "connection error: $resp->{error}" if $rc; + return $resp; +} + +sub count { + my $self = shift; + + my ($auth, $folder) = @_; + + my ($resp, $rc) = $self->communicate( + user => $auth->{user}, + password => $auth->{password}, + challenge => $auth->{challenge}, + mode => 'count', + args => [$folder], + ); + die "connection error: $resp->{error}" if $rc; + return ($resp->{size}, $resp->{count}, $resp->{new}); +} + +sub show { + my $self = shift; + + my ($auth, $mid) = @_; + + my ($resp, $rc) = $self->communicate( + user => $auth->{user}, + password => $auth->{password}, + challenge => $auth->{challenge}, + mode => 'read-mail', + args => [$mid], + ); + die "connection error: $resp->{error}, $resp->{mid}" if $rc; + return $resp; +} + +sub search { + my $self = shift; + + my ($auth, $pattern, $folder) = @_; + + my ($resp, $rc) = $self->communicate( + user => $auth->{user}, + password => $auth->{password}, + challenge => $auth->{challenge}, + mode => 'search', + args => [$pattern, $folder], + ); + die "connection error: $resp->{error}" if $rc; + return $resp; +} + +sub folders { + my $self = shift; + + my ($auth) = @_; + + my ($resp, $rc) = $self->communicate( + user => $auth->{user}, + password => $auth->{password}, + challenge => $auth->{challenge}, + mode => 'folders', + ); + die "connection error: $resp->{error}" if $rc; + return $resp; +} + +sub move { + my $self = shift; + + my ($auth, $mid, $folder) = @_; + + my ($resp, $rc) = $self->communicate( + user => $auth->{user}, + password => $auth->{password}, + challenge => $auth->{challenge}, + mode => 'move', + args => [$mid, $folder], + ); + die "connection error: $resp->{error}" if $rc; + return 1; +} + +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 + + ... + +=head1 DESCRIPTION + +This ReadMails driver starts and communicates with L 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. + +=head2 prog + +The path to the extractor programm. +Default is the location of L 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, L + +=cut diff --git a/lib/JWebmail/Model/ReadMails/Role.pm b/lib/JWebmail/Model/ReadMails/Role.pm new file mode 100644 index 0000000..3c6d7ee --- /dev/null +++ b/lib/JWebmail/Model/ReadMails/Role.pm @@ -0,0 +1,129 @@ +package JWebmail::Model::ReadMails::Role; + +use Params::Check 'check'; + +use Mojo::Base -role; # load after imports + + +sub Auth { + shift; + state $AuthCheck = { + user => {required => 1, defined => 1}, + password => {required => 1, defined => 1}, + challenge => {defined => 1}, + }; + my $self = @_ == 1 ? {$_[0]} : {@_}; + + return check($AuthCheck, $self, 1) || die; +} + +requires( + # name:type parmeter of type + # *key key => value + # key=value default argument of value + # ^ throws exception + # ^type throws exception of type + # Read operations + 'verify_user', # auth:Auth -> :truthy + 'read_headers_for', # auth:Auth, *folder='', *start=0, *end=24, *sort='date' -> ^ :hashref + 'count', # auth:Auth, folder -> ^ size:int count:int new:int + 'show', # auth:Auth, mid -> ^ :hashref + 'search', # auth:Auth, pattern, folder -> ^ :hashref + 'folders', # auth:Auth -> ^ :arrayref + # Write operations + 'move', # auth:Auth, mid, folder -> ^ 1 +); + +around read_headers_for => sub { + my $orig = shift; + my $self = shift; + my $auth = shift; + my $args = {@_}; + + state $ArgsCheck = { + start => {default => 0}, + end => {default => 24}, + sort => {default => 'date'}, + folder => {default => ''}, + }; + + $orig->($self, $auth, %{ check($ArgsCheck, $args, 1) }) +}; + + +1 + +__END__ + +=encoding utf-8 + +=head1 NAME + +ReadMails::Role - Interface to a repository of mails + +=head1 SYNOPSIS + + my $m = Some::Implementation->with_role('JWebmail::Model::ReadMails::Role'); + $m->search($auth, qr/Hot singles in your area/, ''); + +=head1 DESCRIPTION + +The communication is assumed to be stateless. + +=head1 INTERFACE + +=head2 verify_user + +Checks user name and password. + +=head2 read_headers_for + +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. + +=head2 show + +Returns a sepecific mail as a perl hash. + +=head2 search + +Searches for a message with the given pattern. + +=head2 folders + +List all mailbox sub folders. + +=head2 move + +Move mails between folders. + +=head2 Auth + +A sub that returns a hashref of bundled authentication data. + +=head3 Attributes + +=head4 user + +The user name. + +=head4 password + +The users password in plaintext or as hmac if cram is used. + +=head4 challenge + +Optinal challange for when you use cram authentication. + +=head1 SEE ALSO + +L, L, L + +=cut diff --git a/lib/JWebmail/Model/ReadMails/schema.json b/lib/JWebmail/Model/ReadMails/schema.json new file mode 100644 index 0000000..b63a5eb --- /dev/null +++ b/lib/JWebmail/Model/ReadMails/schema.json @@ -0,0 +1,83 @@ +{ + "$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"] + } + } +} -- cgit v1.2.3