Refactored ReadMails into a role

9 files changed, 516 insertions, 769 deletions

diff --git a/lib/JWebmail/Model/Driver/MockJSON.pm b/lib/JWebmail/Model/Driver/MockJSON.pm
deleted file mode 100644
index 258246d..0000000
--- a/lib/JWebmail/Model/Driver/MockJSON.pm
+++ /dev/null
@@ -1,104 +0,0 @@
-package JWebmail::Model::Driver::MockJSON;
-
-use Mojo::Base -base;
-
-use List::Util 'sum';
-
-use Mojo::JSON qw(decode_json);
-
-
-use constant {
-    VALID_USER => 'mockjson@example.com',
-    VALID_PW   => 'vwxyz',
-};
-
-use constant {
-    LIST_START  => 0,
-    LIST_END    => 1,
-    LIST_SORT   => 2,
-    LIST_FOLDER => 3,
-};
-
-sub _read_json_file {
-    my ($file_name) = @_;
-
-    use constant PREFIX => 't/private/';
-
-    open(my $body_file, '<', PREFIX . $file_name);
-    local $/;
-    my $body = <$body_file>;
-    close $body_file;
-
-    return decode_json($body);
-}
-
-
-sub list_reply {
-    state $init = _read_json_file('msgs.json');
-}
-sub read_reply {
-    state $init = {
-        'SC-ORD-MAIL54526c63b751646618a793be3f8329cca@sc-ord-mail5' => _read_json_file('msg2.json'),
-        'example' => _read_json_file('msg.json'),
-    };
-}
-
-
-sub communicate {
-    no warnings 'experimental::smartmatch';
-
-    my $self = shift;
-
-    my %args = @_;
-
-    given ($args{mode}) {
-        when ('auth') {
-            return (undef, 0) if $args{user} eq VALID_USER && $args{password} eq VALID_PW;
-            return (undef, 2);
-        }
-        when ('list') {
-            return ([@{ $self->list_reply }[$args{args}->[LIST_START]..$args{args}->[LIST_END]]], 0) if !$args{args}->[LIST_SORT];
-            return ([], 0) if $args{args}->[LIST_FOLDER] eq 'test';
-            my $s = sub {
-                my $sort_by = $args{args}->[LIST_SORT];
-                my $rev = $sort_by !~ m/^![[:lower:]]+/ ? 1 : -1;
-                $sort_by =~ s/^!//;
-                return (($a->{$sort_by}||$a->{head}{$sort_by}) cmp ($b->{$sort_by}||$b->{head}{$sort_by})) * $rev;
-            };
-            return ([sort { &$s } @{ $self->list_reply }[$args{args}->[LIST_START]..$args{args}->[LIST_END]]], 0);
-        }
-        when ('count') {
-            return ({
-                count => scalar(@{ $self->list_reply }),
-                size  => sum(map {$_->{size}} @{ $self->list_reply }),
-                new   => 0,
-            }, 0);
-        }
-        when ('read-mail') {
-            my $mid = $args{args}->[0];
-            my $mail = $self->read_reply->{$mid};
-            return ($mail, 0) if $mail;
-            return ({error => 'unkown mail-id'}, 3);
-        }
-        when ('folders') {
-            return ([qw(cur test devel debug)], 0);
-        }
-        when ('move') {
-            local $, = ' ';
-            say "@{ $args{args} }";
-            return (undef, 0);
-        }
-        default { return ({error => 'unkown mode'}, 3); }
-    }
-}
-
-
-1
-
-__END__
-
-=head1 NAME
-
-Mock - Simple file based mock for the L<JWebmail::Model::ReadMails> module.
-
-=cut
diff --git a/lib/JWebmail/Model/Driver/QMailAuthuser.pm b/lib/JWebmail/Model/Driver/QMailAuthuser.pm
deleted file mode 100644
index a310024..0000000
--- a/lib/JWebmail/Model/Driver/QMailAuthuser.pm
+++ /dev/null
@@ -1,138 +0,0 @@
-package JWebmail::Model::Driver::QMailAuthuser;
-
-use Mojo::Base -base;
-
-use IPC::Open2;
-use File::Basename 'fileparse';
-use JSON::PP 'decode_json';
-
-
-has 'user';
-has 'maildir';
-has 'prefix'  => '';
-has qmail_dir => '/var/qmail/';
-has prog      => [fileparse(__FILE__)]->[1] . '/QMailAuthuser/Extract.pm';
-has logfile   => '/dev/null';
-
-
-sub communicate {
-    my $self = shift;
-    my %args = @_;
-
-    $args{challenge} //= '';
-    $args{args} //= [];
-
-    my $exec = do {
-        if ($args{mode} eq 'auth') {
-            $self->qmail_dir . "/bin/qmail-authuser true 3<&0";
-        }
-        else {
-            my ($user_name) = $args{user} =~ /(\w*)@/;
-
-            $self->qmail_dir.'/bin/qmail-authuser'
-            . $self->prefix . ' '
-            . join(' ', map { $_ =~ s/(['\\])/\\$1/g; "'$_'" } ($self->prog, $self->maildir, $self->user, $user_name, $args{mode}, @{$args{args}}))
-            . ' 3<&0'
-            . ' 2>>'.$self->logfile;
-        }
-    };
-
-    my $pid = open2(my $reader, my $writer, $exec)
-        or die 'failed to create subprocess';
-
-    $writer->print("$args{user}\0$args{password}\0$args{challenge}\0")
-        or die 'pipe wite failed';
-    close $writer
-        or die 'closing write pipe failed';
-
-    binmode $reader, ':utf8';
-    my $input = <$reader>;
-    close $reader
-        or die 'closing read pipe failed';
-
-    waitpid($pid, 0);
-    my $rc = $? >> 8;
-
-    my $resp;
-    if ($rc == 3 || $rc == 0) {
-        eval { $resp = decode_json $input; };
-        if ($@) { $resp = {error => 'decoding error'} };
-    }
-    elsif ($rc) {
-        $resp = {error => "qmail-authuser returned code: $rc"};
-    }
-
-    return ($resp, $rc);
-}
-
-
-1
-
-__END__
-
-=encoding utf-8
-
-=head1 NAME
-
-QMailAuthuser
-
-=head1 SYNOPSIS
-
-  my $m = JWebmail::Model::ReadMails->new(driver => JWebmail::Model::Driver::QMailAuthuser->new(...));
-
-=head1 DESCRIPTION
-
-This ReadMails driver starts and communicates with L<JWebmail::Model::Driver::QMailAuthuser::Extract> over qmail-authuser.
-The Extract programm runs with elevated priviliges to be able to read and modify mailboxes.
-
-=head1 ATTRIBUTES
-
-=head2 qmail_dir
-
-The parent directory of the bin directory where all qmail executables live.
-Default C</var/qmail/>.
-
-=head2 prog
-
-The path to the extractor programm.
-Default is the location of L<JWebmail::Model::Driver::QMailAuthuser::Extract> package.
-
-=head2 logfile
-
-A path to a log file that the extractor logs to.
-Default '/dev/null' but highly recommended to set a real one.
-Keep in mind that a different user need to be able to write to it.
-
-=head1 METHODS
-
-=head2 communicate
-
-Arguments:
-
-=over 6
-
-=item mode
-
-=item args
-
-Depends on the mode
-
-=item user
-
-E-Mail address of the user
-
-=item password
-
-Corresponding e-mail user password
-
-=item challenge
-
-Challenge when using cram
-
-=back
-
-=head1 SEE ALSO
-
-L<JWebmail::Model::ReadMails>, L<JWebmail::Model::Driver::QMailAuthuser::Extract>
-
-=cut
diff --git a/lib/JWebmail/Model/Driver/QMailAuthuser/Extract.pm b/lib/JWebmail/Model/Driver/QMailAuthuser/Extract.pm
deleted file mode 100755
index a59e265..0000000
--- a/lib/JWebmail/Model/Driver/QMailAuthuser/Extract.pm
+++ /dev/null
@@ -1,296 +0,0 @@
-#!/usr/bin/env perl
-package JWebmail::Model::Driver::QMailAuthuser::Extract;
-
-use v5.18;
-use strict;
-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 <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 '').
-
-=head1 DEPENDENCIES
-
-Currently Mail::Box::Manager does all the hard work.
-
-=head1 SEE ALSO
-
-L<JWebmail::Model::Driver::QMailAuthuser>
-
-=cut
diff --git a/lib/JWebmail/Model/ReadMails.pm b/lib/JWebmail/Model/ReadMails.pm
deleted file mode 100644
index e541de1..0000000
--- a/lib/JWebmail/Model/ReadMails.pm
+++ /dev/null
@@ -1,230 +0,0 @@
-package JWebmail::Model::ReadMails;
-
-use Mojo::Base -base;
-
-use Class::Struct AuthReadMails => {
-    user => '$',
-    password => '$',
-    challenge => '$',
-};
-
-
-has 'driver';
-
-
-sub verify_user {
-
-    my $self = shift;
-
-    my ($user, $password) = @_;
-
-    return !scalar $self->driver->communicate(
-        user => $user,
-        password => $password,
-        mode => 'auth',
-    )
-}
-
-
-sub read_headers_for {
-
-    my $self = shift;
-
-    my %h = @_;
-    my ($auth, $folder, $start, $end, $sort) = @h{qw(auth folder start end sort)};
-
-    my ($resp, $rc) = $self->driver->communicate(
-        user => $auth->user,
-        password => $auth->password,
-        challenge => $auth->challenge,
-        mode => 'list',
-        args => [$start // 0, $end // 0, $sort // 'date', $folder // ''],
-    );
-    die "connection error: $resp->{error}" if $rc;
-    return $resp;
-}
-
-
-sub count {
-
-    my $self = shift;
-
-    my ($auth, $folder) = @_;
-
-    my ($resp, $rc) = $self->driver->communicate(
-        user      => $auth->user,
-        password  => $auth->password,
-        challenge => $auth->challenge,
-        mode      => 'count',
-        args      => [$folder],
-    );
-    die "connection error: $resp->{error}" if $rc;
-    return ($resp->{size}, $resp->{count}, $resp->{new});
-}
-
-
-sub show {
-    my $self = shift;
-
-    my ($auth, $mid) = @_;
-
-    my ($resp, $rc) = $self->driver->communicate(
-        user => $auth->user,
-        password => $auth->password,
-        challenge => $auth->challenge,
-        mode => 'read-mail',
-        args => [$mid],
-    );
-    die "connection error: $resp->{error}, $resp->{mid}" if $rc;
-    return $resp;
-}
-
-
-sub search {
-    my $self = shift;
-
-    my ($auth, $pattern, $folder) = @_;
-
-    my ($resp, $rc) = $self->driver->communicate(
-        user => $auth->user,
-        password => $auth->password,
-        challenge => $auth->challenge,
-        mode => 'search',
-        args => [$pattern, $folder],
-    );
-    die "connection error: $resp->{error}" if $rc;
-    return $resp;
-}
-
-
-sub folders {
-    my $self = shift;
-
-    my ($auth) = @_;
-
-    my ($resp, $rc) = $self->driver->communicate(
-        user => $auth->user,
-        password => $auth->password,
-        challenge => $auth->challenge,
-        mode => 'folders',
-    );
-    die "connection error: $resp->{error}" if $rc;
-    return $resp;
-}
-
-
-sub move {
-    my $self = shift;
-
-    my ($auth, $mid, $folder) = @_;
-
-    my ($resp, $rc) = $self->driver->communicate(
-        user => $auth->user,
-        password => $auth->password,
-        challenge => $auth->challenge,
-        mode => 'move',
-        args => [$mid, $folder],
-    );
-    die "connection error: $resp->{error}" if $rc;
-    return 1;
-}
-
-
-1
-
-__END__
-
-=encoding utf-8
-
-=head1 NAME
-
-ReadMails - Read received mails
-
-=head1 SYNOPSIS
-
-  my $m = JWebmail::Model::ReadMails->new(driver => ...);
-  $m->search($auth, qr/Hot singles in your area/, '');
-
-=head1 DESCRIPTION
-
-This module is a facade for the actions of its driver.
-All actions are delegated to it.
-
-The first parameter is authentication info as AuthReadMails
-whith the rest varying.
-
-The communication is stateless.
-
-=head1 ATTRIBUTES
-
-=head2 driver
-
-The driver does the actual work of reading the mailbox.
-
-=head1 METHODS
-
-=head2 new
-
-Instantiate a new object. The 'driver' option is required.
-
-=head2 verify_user
-
-Checks user name and password.
-
-=head2 read_headers_for
-
-Provides bundeled information on a subset of mails of a mailbox.
-Can be sorted and of varying size.
-
-Arguments:
-  start..end   inclusive 0 based range
-
-=head2 count
-
-Returns size of the mail box folder in bytes the number of mails.
-
-=head2 show
-
-Returns a sepecific mail as a perl hash.
-
-=head2 search
-
-Searches for a message with the given pattern.
-
-=head2 folders
-
-List all mailbox sub folders.
-
-=head2 move
-
-Move mails between folders.
-
-=head1 CLASSES
-
-=head2 AuthReadMails
-
-A struct that bundles auth data.
-
-=head3 Attributes
-
-=head4 user
-
-The user name.
-
-=head4 password
-
-The users password in plaintext or as hmac if cram is used.
-
-=head4 challenge
-
-Optinal challange for when you use cram authentication.
-
-=head3 Methods
-
-=head4 new
-
-=head1 SEE ALSO
-
-L<JWebmail::Model::Driver::QMailAuthuser>, L<JWebmail::Model::Driver::Mock>, L<JWebmail>
-
-=cut
diff --git a/lib/JWebmail/Model/ReadMails/MockJSON.pm b/lib/JWebmail/Model/ReadMails/MockJSON.pm
new file mode 100644
index 0000000..bb105d1
--- /dev/null
+++ b/lib/JWebmail/Model/ReadMails/MockJSON.pm
@@ -0,0 +1,119 @@
+package JWebmail::Model::ReadMails::MockJSON;
+
+use v5.24;
+use warnings;
+use utf8;
+
+use List::Util 'sum';
+
+use Role::Tiny::With;
+
+use Mojo::JSON qw(decode_json);
+
+use constant {
+    VALID_USER => 'mockjson@example.com',
+    VALID_PW   => 'vwxyz',
+};
+
+use namespace::clean;
+
+with 'JWebmail::Model::ReadMails::Role';
+
+
+sub new { bless {} }
+
+sub _read_json_file {
+    my ($file_name) = @_;
+
+    use constant PREFIX => 't/private/';
+
+    open(my $body_file, '<', PREFIX . $file_name);
+    local $/;
+    my $body = <$body_file>;
+    close $body_file;
+
+    return decode_json($body);
+}
+
+sub list_reply {
+    state $init = _read_json_file('msgs.json');
+}
+
+sub read_reply {
+    state $init = {
+        'SC-ORD-MAIL54526c63b751646618a793be3f8329cca@sc-ord-mail5' => _read_json_file('msg2.json'),
+        'example' => _read_json_file('msg.json'),
+    };
+}
+
+
+sub verify_user {
+    my $self = shift;
+    my $auth = shift;
+
+    return $auth->{user} eq VALID_USER && $auth->{password} eq VALID_PW;
+}
+
+sub read_headers_for {
+    my $self = shift;
+    my $auth = shift;
+    my %args = @_;
+
+    my ($start, $end, $sort, $folder) = @args{qw(start end sort folder)};
+
+    unless ($sort) {
+        return [@{ $self->list_reply }[$start..$end]];
+    }
+    if ($folder eq 'test') {
+        return [];
+    }
+    my $s = sub {
+        my $sort_by = $sort;
+        my $rev = $sort_by !~ m/^![[:lower:]]+/ ? 1 : -1;
+        $sort_by =~ s/^!//;
+        return (($a->{$sort_by}||$a->{head}{$sort_by}) cmp ($b->{$sort_by}||$b->{head}{$sort_by})) * $rev;
+    };
+    return [sort { &$s } @{ $self->list_reply }[$start..$end]];
+}
+
+sub count {
+    my $self = shift;
+    my $auth = shift;
+    my $_folder = shift;
+
+    return (
+        sum(map {$_->{size}} @{ $self->list_reply }), # size
+        scalar(@{ $self->list_reply }), # count
+        0, # new
+    );
+}
+
+sub show {
+    my $self = shift;
+    my $auth = shift;
+    my $mid = shift;
+
+    my $mail = $self->read_reply->{$mid};
+    if ($mail) {
+        return $mail;
+    }
+    else {
+        die 'unkown mail-id';
+    }
+}
+
+sub folders { ['', qw(cur test devel debug)] }
+
+sub search { ... }
+sub move { ... }
+
+
+1
+
+__END__
+
+=head1 NAME
+
+Mock - Simple file based mock for the L<JWebmail::Model::ReadMails> module.
+
+=cut
diff --git a/lib/JWebmail/Model/Driver/MockMaildir.pm b/lib/JWebmail/Model/ReadMails/MockMaildir.pm
index e8956ed..31e9618 100644
--- a/lib/JWebmail/Model/Driver/MockMaildir.pm
+++ b/lib/JWebmail/Model/ReadMails/MockMaildir.pm
@@ -1,4 +1,4 @@
-package JWebmail::Model::Driver::MockMaildir;
+package JWebmail::Model::ReadMails::MockMaildir;
 
 use Mojo::Base -base;
 
diff --git a/lib/JWebmail/Model/ReadMails/QMailAuthuser.pm b/lib/JWebmail/Model/ReadMails/QMailAuthuser.pm
new file mode 100644
index 0000000..8387217
--- /dev/null
+++ b/lib/JWebmail/Model/ReadMails/QMailAuthuser.pm
@@ -0,0 +1,267 @@
+package JWebmail::Model::ReadMails::QMailAuthuser;
+
+use v5.22;
+use warnings;
+use utf8;
+
+use IPC::Open2;
+use File::Basename 'fileparse';
+use JSON::PP 'decode_json';
+use Params::Check 'check';
+use Scalar::Util 'blessed';
+use Role::Tiny::With;
+use namespace::clean;
+
+with 'JWebmail::Model::ReadMails::Role';
+
+
+my $QMailAuthuserCheck = {
+    user      => {defined => 1, required => 1},
+    maildir   => {defined => 1, required => 1},
+    prefix    => {defined => 1, default => ''},
+    qmail_dir => {defined => 1, default => '/var/qmail/'},
+    logfile   => {defined => 1, default => '/dev/null'},
+    prog      => {defined => 1, default => ([fileparse(__FILE__)]->[1] . '/QMailAuthuser/Extract.pm')},
+};
+
+sub new {
+    my $cls = shift;
+    my $self = @_ == 1 ? $_[0] : {@_};
+
+    if (my $pkg = blessed $cls) {
+        $self = {%$cls, %$self};
+        $cls = $pkg;
+    }
+    $self = check($QMailAuthuserCheck, $self, 1) || die;
+    return bless $self, $cls;
+}
+
+sub verify_user {
+    my $self = shift;
+    my $auth = shift;
+
+    return !scalar $self->communicate(
+        user => $auth->{user},
+        password => $auth->{password},
+        challenge => $auth->{challenge},
+        mode => 'auth',
+    )
+}
+
+sub read_headers_for {
+    my $self = shift;
+    my $auth = shift;
+
+    my %h = @_;
+    my ($folder, $start, $end, $sort) = @h{qw(folder start end sort)};
+
+    my ($resp, $rc) = $self->communicate(
+        user => $auth->{user},
+        password => $auth->{password},
+        challenge => $auth->{challenge},
+        mode => 'list',
+        args => [$start // 0, $end // 0, $sort // 'date', $folder // ''],
+    );
+    die "connection error: $resp->{error}" if $rc;
+    return $resp;
+}
+
+sub count {
+    my $self = shift;
+
+    my ($auth, $folder) = @_;
+
+    my ($resp, $rc) = $self->communicate(
+        user      => $auth->{user},
+        password  => $auth->{password},
+        challenge => $auth->{challenge},
+        mode      => 'count',
+        args      => [$folder],
+    );
+    die "connection error: $resp->{error}" if $rc;
+    return ($resp->{size}, $resp->{count}, $resp->{new});
+}
+
+sub show {
+    my $self = shift;
+
+    my ($auth, $mid) = @_;
+
+    my ($resp, $rc) = $self->communicate(
+        user => $auth->{user},
+        password => $auth->{password},
+        challenge => $auth->{challenge},
+        mode => 'read-mail',
+        args => [$mid],
+    );
+    die "connection error: $resp->{error}, $resp->{mid}" if $rc;
+    return $resp;
+}
+
+sub search {
+    my $self = shift;
+
+    my ($auth, $pattern, $folder) = @_;
+
+    my ($resp, $rc) = $self->communicate(
+        user => $auth->{user},
+        password => $auth->{password},
+        challenge => $auth->{challenge},
+        mode => 'search',
+        args => [$pattern, $folder],
+    );
+    die "connection error: $resp->{error}" if $rc;
+    return $resp;
+}
+
+sub folders {
+    my $self = shift;
+
+    my ($auth) = @_;
+
+    my ($resp, $rc) = $self->communicate(
+        user => $auth->{user},
+        password => $auth->{password},
+        challenge => $auth->{challenge},
+        mode => 'folders',
+    );
+    die "connection error: $resp->{error}" if $rc;
+    return $resp;
+}
+
+sub move {
+    my $self = shift;
+
+    my ($auth, $mid, $folder) = @_;
+
+    my ($resp, $rc) = $self->communicate(
+        user => $auth->{user},
+        password => $auth->{password},
+        challenge => $auth->{challenge},
+        mode => 'move',
+        args => [$mid, $folder],
+    );
+    die "connection error: $resp->{error}" if $rc;
+    return 1;
+}
+
+sub communicate {
+    my $self = shift;
+    my %args = @_;
+
+    $args{challenge} //= '';
+    $args{args} //= [];
+
+    my $exec = do {
+        if ($args{mode} eq 'auth') {
+            $self->{qmail_dir} . "/bin/qmail-authuser true 3<&0";
+        }
+        else {
+            my ($user_name) = $args{user} =~ /(\w*)@/;
+
+            $self->{qmail_dir}.'/bin/qmail-authuser'
+            . $self->{prefix} . ' '
+            . join(' ', map { s/(['\\])/\\$1/g; "'$_'" } ($self->{prog}, $self->{maildir}, $self->{user}, $user_name, $args{mode}, @{$args{args}}))
+            . ' 3<&0'
+            . ' 2>>'.$self->{logfile};
+        }
+    };
+
+    my $pid = open2(my $reader, my $writer, $exec)
+        or die 'failed to create subprocess';
+
+    $writer->print("$args{user}\0$args{password}\0$args{challenge}\0")
+        or die 'pipe wite failed';
+    close $writer
+        or die 'closing write pipe failed';
+
+    binmode $reader, ':utf8';
+    my $input = <$reader>;
+    close $reader
+        or die 'closing read pipe failed';
+
+    waitpid($pid, 0);
+    my $rc = $? >> 8;
+
+    my $resp;
+    if ($rc == 3 || $rc == 0) {
+        eval { $resp = decode_json $input; };
+        if ($@) { $resp = {error => 'decoding error'} };
+    }
+    elsif ($rc) {
+        $resp = {error => "qmail-authuser returned code: $rc"};
+    }
+
+    return ($resp, $rc);
+}
+
+1
+
+__END__
+
+=encoding utf-8
+
+=head1 NAME
+
+QMailAuthuser
+
+=head1 SYNOPSIS
+
+    ...
+
+=head1 DESCRIPTION
+
+This ReadMails driver starts and communicates with L<JWebmail::Model::Driver::QMailAuthuser::Extract> over qmail-authuser.
+The Extract programm runs with elevated priviliges to be able to read and modify mailboxes.
+
+=head1 ATTRIBUTES
+
+=head2 qmail_dir
+
+The parent directory of the bin directory where all qmail executables live.
+Default C</var/qmail/>.
+
+=head2 prog
+
+The path to the extractor programm.
+Default is the location of L<JWebmail::Model::Driver::QMailAuthuser::Extract> package.
+
+=head2 logfile
+
+A path to a log file that the extractor logs to.
+Default '/dev/null' but highly recommended to set a real one.
+Keep in mind that a different user need to be able to write to it.
+
+=head1 METHODS
+
+=head2 communicate
+
+Arguments:
+
+=over 6
+
+=item mode
+
+=item args
+
+Depends on the mode
+
+=item user
+
+E-Mail address of the user
+
+=item password
+
+Corresponding e-mail user password
+
+=item challenge
+
+Challenge when using cram
+
+=back
+
+=head1 SEE ALSO
+
+L<JWebmail::Model::ReadMails>, L<JWebmail::Model::Driver::QMailAuthuser::Extract>
+
+=cut
diff --git a/lib/JWebmail/Model/ReadMails/Role.pm b/lib/JWebmail/Model/ReadMails/Role.pm
new file mode 100644
index 0000000..3c6d7ee
--- /dev/null
+++ b/lib/JWebmail/Model/ReadMails/Role.pm
@@ -0,0 +1,129 @@
+package JWebmail::Model::ReadMails::Role;
+
+use Params::Check 'check';
+
+use Mojo::Base -role; # load after imports
+
+
+sub Auth {
+    shift;
+    state $AuthCheck = {
+        user => {required => 1, defined => 1},
+        password => {required => 1, defined => 1},
+        challenge => {defined => 1},
+    };
+    my $self = @_ == 1 ? {$_[0]} : {@_};
+
+    return check($AuthCheck, $self, 1) || die;
+}
+
+requires(
+    # name:type  parmeter of type
+    # *key       key => value
+    # key=value  default argument of value
+    # ^          throws exception
+    # ^type      throws exception of type
+    # Read operations
+    'verify_user',      # auth:Auth -> :truthy
+    'read_headers_for', # auth:Auth, *folder='', *start=0, *end=24, *sort='date' -> ^ :hashref
+    'count',            # auth:Auth, folder -> ^ size:int count:int new:int
+    'show',             # auth:Auth, mid -> ^ :hashref
+    'search',           # auth:Auth, pattern, folder -> ^ :hashref
+    'folders',          # auth:Auth -> ^ :arrayref
+    # Write operations
+    'move',             # auth:Auth, mid, folder -> ^ 1
+);
+
+around read_headers_for => sub {
+    my $orig = shift;
+    my $self = shift;
+    my $auth = shift;
+    my $args = {@_};
+
+    state $ArgsCheck = {
+        start =>  {default => 0},
+        end =>    {default => 24},
+        sort =>   {default => 'date'},
+        folder => {default => ''},
+    };
+
+    $orig->($self, $auth, %{ check($ArgsCheck, $args, 1) })
+};
+
+
+1
+
+__END__
+
+=encoding utf-8
+
+=head1 NAME
+
+ReadMails::Role - Interface to a repository of mails
+
+=head1 SYNOPSIS
+
+    my $m = Some::Implementation->with_role('JWebmail::Model::ReadMails::Role');
+    $m->search($auth, qr/Hot singles in your area/, '');
+
+=head1 DESCRIPTION
+
+The communication is assumed to be stateless.
+
+=head1 INTERFACE
+
+=head2 verify_user
+
+Checks user name and password.
+
+=head2 read_headers_for
+
+Provides bundeled information on a subset of mails of a mailbox.
+Can be sorted and of varying size.
+
+Arguments:
+    start..end   inclusive 0 based range
+
+=head2 count
+
+Returns size of the mail box folder in bytes the number of mails.
+
+=head2 show
+
+Returns a sepecific mail as a perl hash.
+
+=head2 search
+
+Searches for a message with the given pattern.
+
+=head2 folders
+
+List all mailbox sub folders.
+
+=head2 move
+
+Move mails between folders.
+
+=head2 Auth
+
+A sub that returns a hashref of bundled authentication data.
+
+=head3 Attributes
+
+=head4 user
+
+The user name.
+
+=head4 password
+
+The users password in plaintext or as hmac if cram is used.
+
+=head4 challenge
+
+Optinal challange for when you use cram authentication.
+
+=head1 SEE ALSO
+
+L<JWebmail::Model::ReadMails::QMailAuthuser>, L<JWebmail::Model::ReadMails::Mock>, L<JWebmail>
+
+=cut
diff --git a/lib/JWebmail/Model/Driver/QMailAuthuser/schema.json b/lib/JWebmail/Model/ReadMails/schema.json
index b63a5eb..b63a5eb 100644
--- a/lib/JWebmail/Model/Driver/QMailAuthuser/schema.json
+++ b/lib/JWebmail/Model/ReadMails/schema.json