#!perl -w =head1 NAME queue/maildir =head1 DESCRIPTION This plugin delivers mails to a maildir spool. =head1 CONFIG It takes one required parameter, the location of the maildir. A second optional parameter delivers the mail into a sub directory named by the recipient of the mail B<for each recipient>. Some substituions take place. Before replacing the parts descibed below, any character of the recipient address, which is not one of C<-A-Za-z0-9+_.,@=> is set to a C<_>. If a third parameter is given, it will be used as octal (!) permisson of the newly created files and directories, any execute bits will be stripped for files: Use C<770> to create group writable directories and files with mode C<0660>. =head2 Maildir spool directory substitutions =over 4 =item %l Replaced by the local part of the address (i.e. the username) =item %d Replaced by the domain part of the address (i.e. the domain name) =item %u Replaced by the full address. =cut # =item %% # # Replaced by a single percent sign (%) # # =cut =back Examples: if the plugin is loaded with the parameters queue/maildir /var/spool/qpdeliver %d/%l and the recipient is C<user@example.com> the mails will be written to the C<new> sub directory of C</var/spool/qpdeliver/example.com/user/>. With queue/maildir /var/spool/qpdeliver %u and a recipient of C<user@example.org> the mail goes to C</var/spool/qpdeliver/user@example.org>. =head1 NOTES Names of the substitution parameters and the replaced charachters are the same L<spamd(8)> supports, for more info see the C<--virtual-config-dir> option of L<spamd(8)>. When called with more than one parameter, this plugin is probably not usable with qpsmtpd-async. With the the second parameter being C<%d> it will still deliver one message for each recipient: With the two recpients C<user@example.org> and C<user2@example.org> you get two messages in the C<example.org/> directory. =cut use File::Path qw(mkpath); use Sys::Hostname qw(hostname); use Time::HiRes qw(gettimeofday); sub register { my ($self, $qp, @args) = @_; if (@args > 0) { ($self->{_maildir}) = ($args[0] =~ m!([-/\w\.]+)!); } if (@args > 1) { ($self->{_subdirs}) = ($args[1] =~ m#^(.*\%[ldu].*)$#); unless ($self->{_subdirs}) { $self->log(LOGWARN, "WARNING: sub directory does not contain a " ."substitution parameter"); return 0; } } if (@args > 2) { ($self->{_perms}) = ($args[2] =~ /^([0-7]{3})$/); unless ($self->{_perms}) { # 000 is unfortunately true ;-) $self->log(LOGWARN, "WARNING: mode is not an octal number"); return 0; } $self->{_perms} = oct($self->{_perms}); } $self->{_perms} = 0700 unless $self->{_perms}; unless ($self->{_maildir}) { $self->log(LOGWARN, "WARNING: maildir directory not specified"); return 0; } unless ($self->{_subdirs}) { # mkpath is influenced by umask... my $old_umask = umask 000; map { my $d = $self->{_maildir} . "/$_"; -e $d or mkpath $d, 0, $self->{_perms} } qw(cur tmp new); umask $old_umask; } my $hostname = (hostname =~ m/([\w\._\-]+)/)[0]; $self->{_hostname} = $hostname; } my $maildir_counter = 0; sub hook_queue { my ($self, $transaction) = @_; my ($rc, @msg); my $old_umask = umask($self->{_perms} ^ 0777); if ($self->{_subdirs}) { foreach my $addr ($transaction->recipients) { ($rc, @msg) = $self->deliver_user($transaction, $addr); unless($rc == OK) { umask $old_umask; return ($rc, @msg); } } umask $old_umask; return (OK, @msg); # last @msg is the same like any other before... } $transaction->header->add('Delivered-To', $_->address, 0) for $transaction->recipients; ($rc, @msg) = $self->write_file($transaction, $self->{_maildir}); umask $old_umask; return ($rc, @msg); } sub write_file { my ($self, $transaction, $maildir, $addr) = @_; my ($time, $microseconds) = gettimeofday; $time = ($time =~ m/(\d+)/)[0]; $microseconds =~ s/\D//g; my $unique = "P$$" . "M$microseconds" . "Q" . $maildir_counter++; my $file = join ".", $time, $unique, $self->{_hostname}; open (MF, ">$maildir/tmp/$file") or $self->log(LOGWARN, "could not open $maildir/tmp/$file: $!"), return(DECLINED, "queue error (open)"); print MF "Return-Path: ", $transaction->sender->format , "\n"; print MF "Delivered-To: ",$addr->address,"\n" if $addr; # else it had been added before... $transaction->header->print(\*MF); $transaction->body_resetpos; while (my $line = $transaction->body_getline) { print MF $line; } close MF or $self->log(LOGWARN, "could not close $maildir/tmp/$file: $!") and return(DECLINED, "queue error (close)"); link "$maildir/tmp/$file", "$maildir/new/$file" or $self->log(LOGWARN, "could not link $maildir/tmp/$file to $maildir/new/$file: $!") and return(DECLINED, "queue error (link)"); unlink "$maildir/tmp/$file"; my $msg_id = $transaction->header->get('Message-Id') || ''; $msg_id =~ s/[\r\n].*//s; return (OK, "Queued! $msg_id"); } sub deliver_user { my ($self, $transaction, $addr) = @_; my $user = $addr->user; $user =~ tr/-A-Za-z0-9+_.,@=/_/c; my $host = $addr->host; $host =~ tr/-A-Za-z0-9+_.,@=/_/c; my $rcpt = $user.'@'.$host; my $subdir = $self->{_subdirs}; $subdir =~ s/\%l/$user/g; $subdir =~ s/\%d/$host/g; $subdir =~ s/\%u/$rcpt/g; # $subdir =~ s/\%%/%/g; my $maildir = $self->{_maildir}."/$subdir"; my $old_umask = umask 000; map { my $d = $maildir . "/$_"; -e $d or mkpath $d, 0, $self->{_perms} } qw(cur tmp new); umask $old_umask; return $self->write_file($transaction, $maildir, $addr); }