On Wed, 31 May 2000, Peter Samuel wrote: > > I too have a simple Pierl qmail-queue wrapper. Let me tidy it up and > I'll post it to the list. It currently does nothing, but can be used > to do whatever wrapping you feel is appropriate (provided you can > write the code to do it). I have attached qmail-queue-wrapper.pl. It is a generic qmail-queue wrapper. It currently does nothing to a message except add an extra header of the form Received: (qmail-queue-wrapper 24590 invoked from network); 31 May 2000 07:16:44 -0000 It then simply hands the message over to the real qmail-queue. If you know perl, you can modify it to do whatever you want - just don't come crying to me if it doesn't work after you've modified it. To install: install perl if you haven't got it on your system choose a non production system to test this on choose a quiet time save the perl file in /var/qmail/bin/qmail-queue-wrapper.pl stop qmail-smtpd stop qmail-qmqpd stop qmail cd /var/qmail/bin vi qmail-queue-wrapper.pl change the first line #!/pkgs/bin/perl -w to reflect where your perl binary really lives chown root qmail-queue-wrapper.pl chgrp qmail qmail-queue-wrapper.pl chmod 755 /tmp/qmail-queue-wrapper.pl # The wrapper program should NOT be setuid!!! mv qmail-queue qmail-queue.orig; mv qmail-queue-wrapper.pl qmail-queue start qmail start qmail-qmqpd start qmail-smtpd There is a small chance that mail injected into the queue via qmail-inject (and it's friends sendmail and datemail) will attempt to call qmail-queue between the "mv" commands above. That's why you should choose a quiet time. Regards Peter ---------- Peter Samuel [EMAIL PROTECTED] Technical Consultant or at present: eServ. Pty Ltd [EMAIL PROTECTED] Phone: +61 2 9206 3410 Fax: +61 2 9281 1301 "If you kill all your unhappy customers, you'll only have happy ones left"
#!/pkgs/bin/perl -w # # $Id: qmail-queue-wrapper.pl,v 1.1 2000/05/31 07:20:37 psamuel Exp $ # # qmail-queue wrapper program. # # This program should be used when you wish to manipulate a mail # message BEFORE it is placed in the queue. Possible uses include: # # - header rewriting # - Firstname.Lastname replacements # - virus scanning # - anything else you can think of # # There are at least 2 ways of using this program: # # 1) Replace the original qmail-queue with this program: # # mv /var/qmail/bin/qmail-queue /var/qmail/bin/qmail-queue.orig # cp qmail-queue-wrapper /var/qmail/bin/qmail-queue # # Change the value of $qmailqueue below, to reflect the new name of # the original qmail-queue program. For example # # my $qmailqueue = "/var/qmail/bin/qmail-queue.orig"; # # 2) Recompile qmail with Bruce Guenter's QMAILQUEUE patch. (See # http://www.qmail.org/qmailqueue-patch). Then any program that # needs to use this program can be called with the environment # variable QMAILQUEUE set to /var/qmail/bin/qmail-queue-wrapper # # How does it work? The interface to the real qmail-queue is simple: # # - the body of the message is read from file descriptor 0 # - the envelope details are read from file descriptor 1. # # qmail-queue-wrapper also adheres to the same interface. After doing # whatever manipulations are necessary, it calls the real qmail-queue # and provides the message body on file descriptor 0 and the envelope # details on file descriptor 1. # # Exit codes conform to those mentioned in the qmail-queue(8) manual page. # ########################################################################### require 5; use strict; my $child; my $debug = 0; my $envelope; my %errors; my @months; my $new_received_header; my $qmailqueue = "/var/qmail/bin/qmail-queue.orig"; my @recipients; my $sender; ########################################################################### &initialise(); if ($child = fork()) { # Parent my $timeout = 86400; # See qmail-queue.c, line 20 alarm($timeout); &fatal(82) unless close MESSAGE_READER; &fatal(82) unless close ENVELOPE_READER; &process_message(); &process_envelope(); # Wait for the child to terminate waitpid($child, 0); # Return with the exit status of the child exit($? % 255); } elsif (defined $child) { # Child &fatal(82) unless close MESSAGE_WRITER; &fatal(82) unless close ENVELOPE_WRITER; &fatal(82) unless defined open(STDIN, "<&MESSAGE_READER"); &fatal(82) unless defined open(STDOUT, "<&ENVELOPE_READER"); if ($debug) { &debug_message("$$: Reading message from STDIN\n\n"); while (<STDIN>) { &debug_message("$$: $_"); } &fatal(82) unless close MESSAGE_READER; &debug_message("\n$$: ####################\n\n"); &debug_message("$$: Reading envelope from STDOUT\n"); while (<ENVELOPE_READER>) { s/\0/ /g; &debug_message("$$: $_\n"); } &fatal(82) unless close ENVELOPE_READER; exit(0); } else { unless (exec $qmailqueue) { # We shouldn't be here unless the exec failed &fatal(82); } } } else { # Unable to fork &fatal(82); } ########################################################################### sub initialise { &prepare_months(); &prepare_error_messages(); &ignore_signals(); &catch_signals(); &generate_new_received_header(); &setup_pipes(); } sub prepare_months { @months = ( "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec", ); } sub prepare_error_messages { # These are the exit codes and their meanings, as defined by the # real qmail-queue manual page. Many are not used by either the # real qmail-queue or this wrapper program. %errors = ( 11 => "Address too long", 31 => "Mail server permanently refuses to send " . "the message to any recipients", # Not used by qmail-queue, but can be used by # programs offering the same interface 51 => "Out of memory", 52 => "Timeout", 53 => "Write error; e.g., disk full", 54 => "Unable to read the message or envelope", 55 => "Unable to read a configuration file", # Not used by qmail-queue 56 => "Problem making a network connection from this host", # Not used by qmail-queue 61 => "Problem with the qmail home directory", 62 => "Problem with the queue directory", 63 => "Problem with queue/pid", 64 => "Problem with queue/mess", 65 => "Problem with queue/intd", 66 => "Problem with queue/todo", 71 => "Mail server temporarily refuses to send " . "the message to any recipients", # Not used by qmail-queue 72 => "Connection to mail server timed out", # Not used by qmail-queue 73 => "Connection to mail server rejected", # Not used by qmail-queue 74 => "Connection to mail server succeeded, but " . "communication failed", # Not used by qmail-queue 81 => "Internal bug; e.g., segmentation fault", 82 => "System resource problem", # Undefined in qmail-queue. Specific to this # wrapper program. 91 => "Envelope format error", ); } sub ignore_signals { # The real qmail-queue ignores a bunch of signals, so we will too. # Ensure all signals are not being blocked. foreach (keys %SIG) { $SIG{$_} = 'DEFAULT'; } # Ignore those signals that the real qmail-queue ignores. $SIG{'PIPE'} = 'IGNORE'; $SIG{'VTALRM'} = 'IGNORE'; $SIG{'PROF'} = 'IGNORE'; $SIG{'QUIT'} = 'IGNORE'; $SIG{'INT'} = 'IGNORE'; $SIG{'HUP'} = 'IGNORE'; $SIG{'XCPU'} = 'IGNORE' if (defined $SIG{'XCPU'}); $SIG{'XFSZ'} = 'IGNORE' if (defined $SIG{'XFSZ'}); } sub catch_signals { # The real qmail-queue catches a few signals, so we will too. $SIG{'ALRM'} = \&timeout; $SIG{'ILL'} = \&internal_bug; $SIG{'ABRT'} = \&internal_bug; $SIG{'FPE'} = \&internal_bug; $SIG{'BUS'} = \&internal_bug; $SIG{'SEGV'} = \&internal_bug; $SIG{'SYS'} = \&internal_bug if (defined $SIG{'SYS'}); $SIG{'EMT'} = \&internal_bug if (defined $SIG{'EMT'}); } sub timeout { &fatal(52); } sub internal_bug { &fatal(81); } sub generate_new_received_header { # Generate a Received: header of the form: # Received: (qmail 28672 invoked by alias); 16 Feb 2000 03:49:51 -0000 my @user = getpwuid($<); my @date = gmtime(); my $user; if ($user[0] eq "alias") { $user = "by alias"; } elsif ($user[0] eq "qmaild") { $user = "from network"; } elsif ($user[0] eq "qmails") { $user = "for bounce"; } elsif (scalar @user == 0) { # This should never happen - ie the real user id should # always have a password entry. $user = "by uid $<"; } else { $user = "by uid $user[2]"; } $date[5] += 1900; my $date = "$date[3] $months[$date[4]] $date[5]"; my $time = sprintf("%02d:%02d:%02d", $date[2], $date[1], $date[0]); $new_received_header = "Received: (qmail-queue-wrapper $$ invoked $user); $date $time -0000"; } sub setup_pipes { &fatal(82) unless pipe(MESSAGE_READER, MESSAGE_WRITER); &fatal(82) unless pipe(ENVELOPE_READER, ENVELOPE_WRITER); select(MESSAGE_WRITER); $| = 1; select(ENVELOPE_WRITER); $| = 1; } sub debug_message { my ($message) = @_; print STDERR "$message"; } sub fatal { my ($errno) = @_; &debug_message("$errors{$errno}\n") if $debug; exit($errno); } sub process_message { # If you plan on doing serious massaging of the message body, such # as virus scanning or MIME conversions, you should probably write # the message to a temporary file here. Once you have finished your # massaging you can read from the file. You could slurp the message # into memory but that may be a resource problem for you. Caveat # emptor! print MESSAGE_WRITER "$new_received_header\n"; while (<STDIN>) { print MESSAGE_WRITER; } &fatal(82) unless close MESSAGE_WRITER; } sub process_envelope { &read_envelope(); # If you don't want to do any rigourous checking of the envelope, # simply comment out the &check_envelope() statement. The real # qmail-queue will perform the same checks anyway. &check_envelope(); &close_envelope(); print ENVELOPE_WRITER "$envelope"; &fatal(82) unless close ENVELOPE_WRITER; } sub read_envelope { # Read the message envelope from file descriptor 1. At startup this is # already assigned to the Perl filehandle STDOUT. # Duplicate file descriptor 1 for reading &fatal(54) unless defined open(DUP_STDOUT, "<&STDOUT"); # Extract the envelope details. The stripping of the leading 'F' # and 'T' characters will be performed later. $envelope = <DUP_STDOUT>; } sub check_envelope { # There MUST be some envelope details. &fatal(54) unless defined $envelope; # The envelope details MUST be terminated by two NULLS. &fatal(54) if ($envelope !~ /\0\0$/); ($sender, @recipients) = split(/\0/, $envelope); # If there are no recipients, we should exit here. However, the # real qmail-queue will quite happily accept messages with no # recipients, so we will too. # The sender address MUST begin with an 'F' and the recipient # address(es) MUST begin with a 'T'. &fatal(91) if ($sender !~ /^F/); foreach (@recipients) { &fatal(91) if ($_ !~ /^T/); } # None of the addresses may be greater than $address_length # characters. (Remember that each address has an extra leading # character at this stage, so it's just a "greater than" test, # rather than a "greater than or equal to" test). my $address_length = 1003; # See qmail-queue.c, line 21 foreach ($sender, @recipients) { &fatal(11) if (length($_) > $address_length); } # The sender AND recipient address(es) should contain a username, # an @ sign and a fully qualified domain name. However, the real # qmail-queue does not enforce this, so we won't either. } sub close_envelope { # Close duplicated STDOUT &fatal(54) unless close DUP_STDOUT; }