Specified the interface for qmauth

Changes to configuration
Added qmauth version written in Python
Slight changes to pagination

1 files changed, 34 insertions, 12 deletions

diff --git a/lib/JWebmail/Model/ReadMails/MockMaildir.pm b/lib/JWebmail/Model/ReadMails/MockMaildir.pm
index 2df4fa9..9b1bb29 100644
--- a/lib/JWebmail/Model/ReadMails/MockMaildir.pm
+++ b/lib/JWebmail/Model/ReadMails/MockMaildir.pm
@@ -1,38 +1,59 @@
 package JWebmail::Model::ReadMails::MockMaildir;
 
-use Mojo::Base JWebmail::Model::ReadMails::QMailAuthuser;
+use Mojo::Base 'JWebmail::Model::ReadMails::QMailAuthuser';
 
 use Mojo::JSON 'decode_json';
 
+use Digest::HMAC_MD5 'hmac_md5_hex';
+
+
 use constant {
-    VALID_USER => 'me@mockmaildir.com',
+    VALID_USER => 'mockmaildir@example.org',
     VALID_PW   => '12345',
 };
 
-
 has user      => sub { $ENV{USER} };
 has maildir   => 't/';
 has extractor => 'perl';
 
-
 our %EXTRACTORS = (
-    perl => 'perl script/qmauth.pl',
-    rust => 'extract/target/debug/jwebmail-extract',
+    perl   => 'perl script/qmauth.pl',
+    python => 'python script/qmauth.py',
+    rust   => 'extract/target/debug/jwebmail-extract',
 );
 
 
+sub new {
+    my $cls = shift;
+    my %args = @_ == 1 ? %$_[0] : @_;
+
+    my $self = bless {%args}, ref $cls || $cls;
+    $self->user;
+    $self->maildir;
+
+    $self->next::method(prog => $EXTRACTORS{$self->extractor});
+    return $self;
+}
+
+
 sub verify_user {
     my $self = shift;
     my $auth = shift;
 
-    return $auth->{user} eq VALID_USER && $auth->{password} eq VALID_PW;
+    my $passwd = $auth->{password}->show_password;
+
+    if ($auth->{challenge}) {
+        return $auth->{user} eq VALID_USER &&
+            $passwd eq hmac_md5_hex($auth->{challenge}, VALID_PW);
+    }
+    else {
+        return $auth->{user} eq VALID_USER && $passwd eq VALID_PW;
+    }
 }
 
 sub build_and_run {
     my $self = shift;
-    my $auth = shift;
-    my $mode = shift;
-    my $args = shift;
+    my ($auth, $mode, $args) = @_;
 
     my $mail_user = 'maildir';
     my $exec = $EXTRACTORS{$self->extractor} . ' ' . join(' ', map { my $x = s/(['\\])/\\$1/gr; "'$x'" } ($self->maildir, $self->user, $mail_user, $mode, @$args));
@@ -51,10 +72,11 @@ sub build_and_run {
         if (my $err = $@) { $resp = {error => "decoding error '$err'"}; $rc ||= 1; };
     }
     elsif ($rc) {
-        $resp = {error => "qmail-authuser returned code: $rc"};
+        $resp = {error => "qmauth returned code: $rc"};
     }
 
-    die "error $resp" if $rc;
+    local $" = ', ';
+    die "error @{[%$resp]}" if $rc;
     return $resp;
 }