diff options
Diffstat (limited to 'lib/JWebmail/Model/Driver/QMailAuthuser')
| -rwxr-xr-x | lib/JWebmail/Model/Driver/QMailAuthuser/Extract.pm | 296 | ||||
| -rw-r--r-- | lib/JWebmail/Model/Driver/QMailAuthuser/schema.json | 83 |
2 files changed, 0 insertions, 379 deletions
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"] - } - } -} |