summaryrefslogtreecommitdiff
path: root/lib/JWebmail/Model/Driver/QMailAuthuser.pm
blob: a310024f1e7ae263a1d9211d6794d34701c6a85f (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
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