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 --- script/qmauth.pl | 295 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 295 insertions(+) create mode 100755 script/qmauth.pl (limited to 'script/qmauth.pl') diff --git a/script/qmauth.pl b/script/qmauth.pl new file mode 100755 index 0000000..5bc7bb5 --- /dev/null +++ b/script/qmauth.pl @@ -0,0 +1,295 @@ +#!/usr/bin/env perl +package JWebmail::QMAuth; + +use v5.18; +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 + +=head2 Modes + + list + count + read-mail + search + folders + move + +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 + +=cut -- cgit v1.2.3