diff options
Diffstat (limited to 'script/extract.pl')
-rwxr-xr-x | script/extract.pl | 310 |
1 files changed, 310 insertions, 0 deletions
diff --git a/script/extract.pl b/script/extract.pl new file mode 100755 index 0000000..000eaa0 --- /dev/null +++ b/script/extract.pl @@ -0,0 +1,310 @@ +#!/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 |