[rt-users] Perl-script for using qmail with rt

[Matthias Juchem]

-----BEGIN PGP SIGNED MESSAGE-----

Hi.

Here is an updated version of the qmail2rt.pl script that has been included
in the installation guide as the 'scary qmail hack'.

Please include this version now. Thank you.

Comments are welcome.

Best regards,
 Matthias

p.s.: Sorry if this message got twice to the list...

- ---CUT HERE---CUT HERE---CUT HERE---CUT HERE---CUT HERE---CUT HERE---
#!/usr/bin/perl

use strict;

#############
#
# qmail2rt v0.3
#
# (c) 2002 by Matthias Juchem <matthias at konfido.net>
#
# May be distributed freely, but I do not take responsibility for damage.
#
# Feedback is welcome.
#
#############
# This script is used for piping mails delivered by qmail to rt-mailgate.
#
# Setup:
# a) one virtual domains for rt with one user ($receiver) who receives all 
mail
#    for this domain (e.g. all mail for support.acme.com goes to user rt)
# b) ~$receiver/.qmail-default says:
#      | /var/qmail/bin/preline /home/$receiver/qmail2rt.pl
#      (e.g. "| /var/qmail/bin/preline /home/rt/qmail2rt.pl") 
# c) mail address for queues are built like this:
#     $queue-$action at virtualdomain
#   ( e.g. accounting-correspond at support.acme.com )
#    That means that LOCAL will contain rt-accounting-correspond.
# d) In the file $queuelistfile you can list all valid queues. Furthermore,
#    you can decide whether qmail2rt insists on having this file. But if the
#    file is present, qmail2rt will only accept mail for queus listed in this
#    file.
# e) @names contains some mail aliases. Mails to those addresses will be
#    forwarded to $rtowner. (e.g. if @names contains 'postmaster', mail
#    to postmaster at support.acme.com is forwarded to $rtowner.)
############

# Configuration variables - Change these for your site if necessary.

# mail address of the rt admin
my $rtowner       = 'rtowner at support.acme.com';

# full path to the queue list file
my $queuelistfile = "/home/rt/queuelist";

# set to 1 if $queuelistfile is mandatory, 0 if it optional
my $qlfmandatory  = 1;

# full path to the rt-mailgate programme
my $mailgate      = "/usr/local/lib/rt2/bin/rt-mailgate";

# full path to qmail-inject
my $qmailinject   = "/var/qmail/bin/qmail-inject";

# $receiver is the local user that receives all mail for our rt-subdomain.
my $receiver      = "rt";

# @names contains an array of mail aliases that should go to $rtowner directly
my @names         = ( "root", "postmaster", "mailer-daemon",
                      "rtowner", "owner", "admin", "hostmaster" );

# set to 1 qmail2rt should not send any hard errors, 0 else
my $noharderrors  = 0;

# set to 1 if user and group IDs should be sent with bounces. might be
# a problem wrt to security, but is useful while installing rt
my $sendugids     = 0;

###################################################################
# nothing should be changed below, i guess
###################################################################

my $debug = 0; # internal use
my $qrtversion = "0.3";

sub bounce($$); # forward declaration of bounce(), useful for sending errors
sub hbounce($); # wrapper for bounce() for hard errors
sub sbounce($); # wrapper for bounce() for soft errors
sub debug($);   # used to print debug messages

if(! defined($ENV{"LOCAL"}) ) {
    # qmail sets the LOCAL environment variable to the left-hand part of the
    # final email address that receives the mail
    # if mail is sent to general-correspond at support.domain.com and rt receives
    # all mail for support.domain.com, LOCAL is set to rt-general-correspond
    hbounce("LOCAL not set.");
}

my $local = lc($ENV{"LOCAL"});
$local =~ s/^$receiver-(.*)$/$1/; # strip the rt- at the beginning

debug "local is set to $local now";

# check if the mail went to one of the alias mentioned in @names
foreach my $name (@names) {
    if( $name eq $local ) {
	if( system( $qmailinject, $rtowner) != 0 ) {
	    hbounce("Unable to execute qmail-inject. ($?)");
	}
	exit 0;
    }
}

my $action=undef;
my $queue=$local;

# determine what to do with the mail
if( $local =~ m/^\w+-correspond$/ ) {
    $action = "correspond";
    $queue =~ s/^(\w+)-correspond$/$1/;
} elsif( $local =~ m/^\w+-comment$/ ) {
    $action = "comment";
    $queue =~ s/^(\w+)-comment$/$1/;
} elsif ( $local =~ m/^\w+$/ ) {
    # correspond is our default action
    $action = "correspond";
} else {
    $queue =~ s/^(\w+)-\w+$/$1/;
}

# check $queuelistfile for $queue
my $found = 0;
if(open QLIST, "<$queuelistfile") {
    foreach my $entry (<QLIST>) {
	chomp $entry;
	if($entry eq $queue) {
	    $found=1;
	    last;
	}
    }
    close QLIST;
} else {
    # if we do not bounce here then rt will complain if the queue is not known
    sbounce("Unable to open queue list file.") if($qlfmandatory);
    $found=1;
}

if($found==1){
    if(defined($action)) {
	if( system( $mailgate, '--queue', $queue, '--action', $action) != 0 ) {
	    hbounce("Unable to execute rt-mailgate. ($?)");
	}
	exit 0;
    } else {
	sbounce("No suitable action found.");
    }
} else {
    sbounce("Queue $queue not known.");
}

############## subroutines 
####################################################

# return an error with the specified error code and error message
sub bounce($$) { # parameters: return code for qmail-send, short bounce 
message
    my $error = shift;
    my $text  = shift;
    
    # REUG stands for: Real Effective User Groups:
    # [REUG: real user, effective user, real groups, effective groups]
    # LAQ: similar ($local, $action and $queue)

    $action="" unless defined($action);
    $queue="" unless defined($queue);
    $local="" unless defined($local);

    my $message = "\nqmail2rt $qrtversion has detected the following ".
	"error:\n\n$text\n\n".
	"Please notify $rtowner if this problem persists. The line(s) ".
	"lines below will help him to fix the problem.\n\n".
	"[LAQ: \'$local\', \'$action\', \'$queue\']\n";
    if($sendugids) {
	$message = $message."[REUG: $<,$>,$(,$)]\n\n";
    } else {
	$message = $message."\n";
    }
    
    print STDERR $message;
    exit $error;
}

# return a hard error with specified error message
sub hbounce($) { # parameter: short bounce message
    if($noharderrors) {
	sbounce(shift);
    } else {
	bounce(100, shift);
    }
}

# return a soft error with specified error message
sub sbounce($) { # parameter: short bounce message
    bounce(111, shift);
}

# function used to print debug messages, prints only if $debug is true
sub debug($) { # parameter: debug message
    return unless $debug;
    my $text = shift;
    
    print STDERR "DEBUG: ", $text,"\n";
}
- ---CUT HERE---CUT HERE---CUT HERE---CUT HERE---CUT HERE---CUT HERE---
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.2.1 (GNU/Linux)

iQEVAwUBPeQPX2PlwoKwhRFhAQFxDgf/ZGn99Lz26FuvE63HMxGKuCrYDKGm5xeY
L1ZvuJqC4QIguWk/ianu4q3kMC1xyZzvevDH5zqBzVvyCTVcxD9PrNd5+j/IwkSA
zUYQUuedpBwyR+0QPcjg0dq1JgHNJGTpEQIctc6tY29EbaCiF7jcPHOYblYEgRLD
WlfzfphSdAMmMKDZ1d2emm6P/OdKZE9dEFaWNszZgmxpaeZ7A9NNBOOISM88Oo09
GtUlNTXvzyO6oHWA7ixKQnKkjG4vyzfK24AmITQKcgBVpTMtGMog8xF9+vd5+D6D
wtE1IPTsi6XlV6pehPj/KYJTR0ipLUpiluHCEhXlEiMbZzdBQFc+UA==
=8K3C
-----END PGP SIGNATURE-----