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
|