From 2abf462ca10c4ac8c4f815e608cad31851e966e3 Mon Sep 17 00:00:00 2001 From: "Jannis M. Hoffmann" Date: Sun, 26 Feb 2023 21:36:27 +0100 Subject: Specified the interface for qmauth Changes to configuration Added qmauth version written in Python Slight changes to pagination --- script/qmauth.pl | 273 +++++++++++++++++++++++++++++-------------------------- 1 file changed, 144 insertions(+), 129 deletions(-) (limited to 'script/qmauth.pl') diff --git a/script/qmauth.pl b/script/qmauth.pl index 3ecadef..000eaa0 100755 --- a/script/qmauth.pl +++ b/script/qmauth.pl @@ -5,54 +5,59 @@ use v5.18; use warnings; use utf8; -use POSIX (); -use JSON::PP; use Carp; -use List::Util 'min'; use Encode v2.88 'decode'; +use JSON::PP; +use List::Util 'min'; +use POSIX 'setuid'; #use open IO => ':encoding(UTF-8)', ':std'; -no warnings 'experimental::smartmatch'; -use Mail::Box::Manager; +use Mail::Box::Maildir; -use constant ROOT_MAILDIR => '.'; + +package JWebmail::QMAuth::Message::Head::Complete { + use parent 'Mail::Message::Head::Complete'; + + use File::Basename; + + sub createMessageId { + my $self = shift; + + my ($mid) = scalar(fileparse($self->message->filename)) =~ /(.+):/; + return $mid || $self->SUPER::createMessageId; + } +} 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; + my ($maildir, $su, $user, $mode, @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); + 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 $folder = Mail::Box::Maildir->new( + folder => "$maildir/$user/", + type => 'maildir', + access => 'rw', + head_type => 'JWebmail::QMAuth::Message::Head::Complete', ); 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} } - } + if ($mode eq 'list') { list($folder, @args) } + elsif ($mode eq 'read') { read_mail($folder, @args) } + elsif ($mode eq 'count') { count_messages($folder, @args) } + elsif ($mode eq 'search') { search($folder, @args) } + elsif ($mode eq 'folders') { folders($folder, @args) } + elsif ($mode eq 'move') { move($folder, @args) } + else { {error => 'unknown mode', mode => $mode} } }; $folder->close; @@ -64,22 +69,26 @@ sub main { sub _sort_mails { - my $sort = shift // ''; - my $reverse = 1; + my ($sort) = @_; - if ($sort =~ m/^!/) { - $reverse = -1; + my $reverse = ''; + if ($sort =~ /^!/) { + $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 } } - } + my $sortsub = do { + if ($sort eq 'date') { sub { $a->timestamp <=> $b->timestamp } } + elsif ($sort eq 'sender') { sub { $a->from->[0] cmp $b->from->[0] } } + elsif ($sort eq 'subject') { sub { $a->subject cmp $b->subject } } + elsif ($sort eq 'size') { sub { $a->size <=> $b->size } } + elsif ($sort eq '') { sub { $a->timestamp <=> $b->timestamp } } + else { + warn "unknown sort-verb '$sort'"; + sub { $a->timestamp <=> $b->timestamp } + } + }; + return $reverse ? sub { $sortsub->() * -1 } : $sortsub; } @@ -91,61 +100,79 @@ sub _ok { } +sub _get_mime_head_info { + my ($msg) = @_; + + return { + content_maintype => $msg->body->mimeType->mediaType, + content_subtype => $msg->body->mimeType->subType, + content_disposition => ''.$msg->body->disposition, + filename => $msg->body->dispositionFilename, + }; +} + + +sub _get_head_info { + my ($msg) = @_; + + return { + date => _iso8601_utc($msg->timestamp), + + from => _addresses($msg->from), + sender => _addresses($msg->sender), + + to => _addresses($msg->to), + cc => _addresses($msg->cc), + bcc => _addresses($msg->bcc), + + subject => decode('MIME-Header', $msg->subject), + comments => $msg->get('comments'), + keywords => $msg->get('keywords'), + + mime => _get_mime_head_info($msg), + }; +} + + sub list { - my ($f, $start, $end, $sortby, $folder) = @_; - $folder = ".$folder"; + my ($f, $folder, $start, $end, $sortby) = @_; - _ok($start =~ m/^\d+$/); - _ok($end =~ m/^\d+$/); + _ok($start =~ /^\d+$/aa); + _ok($end =~ /^\d+$/aa); _ok(0 <= $start && $start <= $end); - _ok($sortby =~ m/^(!?\w+|\w*)$/n); - _ok($folder ~~ [$f->listSubFolders, ROOT_MAILDIR]); + _ok($sortby =~ /^(?:!?\w+|)$/aa); + _ok(!$folder || grep { $_ eq ".$folder" } $f->listSubFolders); - $f = $f->openSubFolder($folder) if $folder ne ROOT_MAILDIR; + $f = $f->openSubFolder(".$folder") if $folder; 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; + @msgs = @msgs[$start..min($#msgs, $end-1)]; + + return [map { + { + byte_size => $_->size, + unread => !$_->label('seen'), + date_received => $_->guessTimestamp, + message_handle => $_->messageId, + head => _get_head_info($_), + } + } @msgs]; } sub count_messages { my ($f, $folder) = @_; - $folder = ".$folder"; - - _ok($folder ~~ [$f->listSubFolders, ROOT_MAILDIR]); - $f = $f->openSubFolder($folder) if $folder ne ROOT_MAILDIR; + $f = $f->openSubFolder(".$folder") if $folder; return { - count => scalar($f->messages('ALL')), - size => $f->size, - new => scalar $f->messages('!seen'), + total_mails => scalar $f->messages('ALL'), + byte_size => $f->size, + unread_mails => scalar $f->messages('!seen'), } } @@ -160,46 +187,55 @@ sub _iso8601_utc { sub _unquote { my $x = shift; [$x =~ m/"(.*?)"(?[0] || $x } sub _addresses { + return undef unless @_; [map { {address => $_->address, name => _unquote(decode('MIME-Header', $_->phrase))} } @_] } +sub _get_body { + my ($msg) = @_; + + if ($msg->isNested) { + my $nested = $msg->body->nested; + return { + head => _get_head_info($nested), + body => _get_body($nested), + }; + } + elsif ($msg->isMultipart) { + return { + preamble => ''.$msg->body->preamble, + parts => [map { { head => _get_mime_head_info($_), body => _get_body($_) } } $msg->parts], + epilogue => $msg->body->epilogue, + } + } + else { + return ''.$msg->decoded; + } +} + + sub read_mail { - my ($folder, $mid) = @_; + my ($f, $folder, $mid) = @_; + + $f = $folder->openSubFolder(".$folder") if $folder; - my $msg = $folder->find($mid); + my $msg = $f->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 - } - }, + head => _get_head_info($msg), + body => _get_body($msg), } } sub search { my ($f, $search_pattern, $folder) = @_; - $folder = ".$folder"; - $f = $f->openSubFolder($folder) if $folder ne ROOT_MAILDIR; + $f = $f->openSubFolder(".$folder") if $folder; my @msgs = $f->messages(sub { - my $m = shift; + my ($m) = @_; return scalar(grep { $_->decoded =~ /$search_pattern/ || (decode('MIME-Header', $_->subject)) =~ /$search_pattern/ } $m->body->parts) if $m->isMultipart; @@ -209,17 +245,8 @@ sub search { 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, - }, + head => _get_head_info($msg), + body => '', }; push @msgs2, $msg2; } @@ -231,17 +258,18 @@ sub search { sub folders { my $f = shift; - return [grep { $_ =~ m/^\./ && $_ =~ s/\.// } $f->listSubFolders]; + return [map { s/^\.//r } $f->listSubFolders(check => 1)]; } sub move { - my ($f, $mid, $dst) = @_; - $dst = ".$dst"; + my ($f, $mid, $from, $to) = @_; - _ok($dst ~~ [$f->listSubFolders, ROOT_MAILDIR]); + $f = $f->openSubFolder(".$from") if $from; - $f->moveMessage($dst, $dst->find($mid)); + $f->find($mid)->moveTo($to ? ".$to" : $to); + + return 1; } @@ -269,20 +297,7 @@ 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 ''). +For the implemented interface see the README file. =head1 DEPENDENCIES @@ -290,6 +305,6 @@ Currently Mail::Box::Manager does all the hard work. =head1 SEE ALSO -L +L =cut -- cgit v1.2.3