diff options
Diffstat (limited to 'script/qmauth.pl')
| -rwxr-xr-x | script/qmauth.pl | 310 |
1 files changed, 0 insertions, 310 deletions
diff --git a/script/qmauth.pl b/script/qmauth.pl deleted file mode 100755 index 000eaa0..0000000 --- a/script/qmauth.pl +++ /dev/null @@ -1,310 +0,0 @@ -#!/usr/bin/env perl -package JWebmail::QMAuth; - -use v5.18; -use warnings; -use utf8; - -use Carp; -use Encode v2.88 'decode'; -use JSON::PP; -use List::Util 'min'; -use POSIX 'setuid'; - -#use open IO => ':encoding(UTF-8)', ':std'; - -use Mail::Box::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, $su, $user, $mode, @args) = @ARGV; - - delete $ENV{PATH}; - - my $netfehcom_uid = getpwnam($su); - die "won't stay as root" if $netfehcom_uid == 0; - setuid($netfehcom_uid); - if ($!) { - warn 'error setting uid'; - exit(1); - } - - my $folder = Mail::Box::Maildir->new( - folder => "$maildir/$user/", - type => 'maildir', - access => 'rw', - head_type => 'JWebmail::QMAuth::Message::Head::Complete', - ); - - my $reply = do { - 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; - - print(encode_json $reply); - if (ref $reply eq 'HASH' && $reply->{error}) { - exit 3; - } -} - - -sub _sort_mails { - my ($sort) = @_; - - my $reverse = ''; - if ($sort =~ /^!/) { - $reverse = 1; - $sort = substr $sort, 1; - } - - 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; -} - - -sub _ok { - if (!shift) { - carp 'verify failed'; - exit 4; - } -} - - -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, $folder, $start, $end, $sortby) = @_; - - _ok($start =~ /^\d+$/aa); - _ok($end =~ /^\d+$/aa); - _ok(0 <= $start && $start <= $end); - _ok($sortby =~ /^(?:!?\w+|)$/aa); - _ok(!$folder || grep { $_ eq ".$folder" } $f->listSubFolders); - - $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-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) = @_; - - $f = $f->openSubFolder(".$folder") if $folder; - - return { - total_mails => scalar $f->messages('ALL'), - byte_size => $f->size, - unread_mails => 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 { - 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 ($f, $folder, $mid) = @_; - - $f = $folder->openSubFolder(".$folder") if $folder; - - my $msg = $f->find($mid); - return {error => 'no such message', mid => $mid} unless $msg; - return { - head => _get_head_info($msg), - body => _get_body($msg), - } -} - - -sub search { - my ($f, $search_pattern, $folder) = @_; - - $f = $f->openSubFolder(".$folder") if $folder; - - my @msgs = $f->messages(sub { - my ($m) = @_; - - 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 = { - head => _get_head_info($msg), - body => '', - }; - push @msgs2, $msg2; - } - - return \@msgs2; -} - - -sub folders { - my $f = shift; - - return [map { s/^\.//r } $f->listSubFolders(check => 1)]; -} - - -sub move { - my ($f, $mid, $from, $to) = @_; - - $f = $f->openSubFolder(".$from") if $from; - - $f->find($mid)->moveTo($to ? ".$to" : $to); - - return 1; -} - - -main unless 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. - -For the implemented interface see the README file. - -=head1 DEPENDENCIES - -Currently Mail::Box::Manager does all the hard work. - -=head1 SEE ALSO - -L<JWebmail::Model::ReadMails::QMailAuthuser> - -=cut |