1 files changed, 144 insertions, 129 deletions

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 <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 '').
+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<JWebmail::Model::Driver::QMailAuthuser>
+L<JWebmail::Model::ReadMails::QMailAuthuser>
 
 =cut