| 1 | #! PERL_COMMAND |
| 2 | |
| 3 | # This is a Perl script to demonstrate the possibilities of on-the-fly |
| 4 | # delivery filtering in Exim. It is presented with a message on its standard |
| 5 | # input, and must copy it to the standard output, transforming it as it |
| 6 | # pleases, but of course it must keep to the syntax of RFC 822 for the headers. |
| 7 | |
| 8 | # The filter is run before any SMTP-specific processing, such as turning |
| 9 | # \n into \r\n and escaping lines beginning with a dot. |
| 10 | # |
| 11 | # Philip Hazel, May 1997 |
| 12 | ############################################################################# |
| 13 | |
| 14 | use warnings; |
| 15 | BEGIN { pop @INC if $INC[-1] eq '.' }; |
| 16 | use File::Basename; |
| 17 | |
| 18 | if ($ARGV[0] eq '--version') { |
| 19 | print basename($0) . ": $0\n", |
| 20 | "build: EXIM_RELEASE_VERSIONEXIM_VARIANT_VERSION\n", |
| 21 | "perl(runtime): $]\n"; |
| 22 | exit 0; |
| 23 | } |
| 24 | |
| 25 | # If the filter is called with any arguments, insert them into the message |
| 26 | # as X-Arg headers, just to verify what they are. |
| 27 | |
| 28 | for ($ac = 0; $ac < @ARGV; $ac++) |
| 29 | { |
| 30 | printf("X-Arg%d: %s\n", $ac, $ARGV[$ac]); |
| 31 | } |
| 32 | |
| 33 | # Now read the header portion of the message; this is easy to do in Perl |
| 34 | |
| 35 | $/ = ""; # set paragraph mode |
| 36 | chomp($headers = <STDIN>); # read a paragraph, remove trailing newlines |
| 37 | $/ = "\n"; # unset paragraph mode |
| 38 | |
| 39 | # Splitting up a sequence of unique headers is easy to do in Perl, but a |
| 40 | # message may contain duplicate headers of various kinds. It is better |
| 41 | # to extract the headers one wants from the whole paragraph, do any appropriate |
| 42 | # munging, and then put them back (unless removing them altogether). Messing |
| 43 | # with "Received:" headers is not in any case to be encouraged. |
| 44 | |
| 45 | # As a demonstration, we extract the "From:" header, add a textual comment |
| 46 | # to it, and put it back. |
| 47 | |
| 48 | ($pre, $from, $post) = |
| 49 | $headers =~ /^(|(?:.|\n)+\n) (?# Stuff preceding the From header, |
| 50 | which is either null, or any number |
| 51 | of characters, including \n, ending |
| 52 | with \n.) |
| 53 | From:[\s\t]* (?# Header name, with optional space or tab.) |
| 54 | ((?:.|\n)*?) (?# Header body, which contains any chars, |
| 55 | including \n, but we want to make it as |
| 56 | short as possible so as not to include |
| 57 | following headers by mistake.) |
| 58 | (|\n\S(?:.|\n)*)$ (?# Header terminates at end or at \n followed |
| 59 | by a non-whitespace character and |
| 60 | remaining headers.) |
| 61 | /ix; # case independent, regular expression, |
| 62 | # use extended features (ignore whitespace) |
| 63 | |
| 64 | # Only do something if there was a From: header, of course. It has been |
| 65 | # extracted without the final \n, which is on the front of the $post |
| 66 | # variable. |
| 67 | |
| 68 | if ($pre) |
| 69 | { |
| 70 | $headers = $pre . "From: $from (this is an added comment)" . $post; |
| 71 | } |
| 72 | |
| 73 | # Add a new header to the end of the headers; remember that the final |
| 74 | # \n isn't there. |
| 75 | |
| 76 | $headers .= "\nX-Comment: Message munged"; |
| 77 | |
| 78 | # Write out the processed headers, plus a blank line to separate them from |
| 79 | # the body. |
| 80 | |
| 81 | printf(STDOUT "%s\n\n", $headers); |
| 82 | |
| 83 | # As a demonstration of munging the body of a message, reverse all the |
| 84 | # characters in each line. |
| 85 | |
| 86 | while (<STDIN>) |
| 87 | { |
| 88 | chomp; |
| 89 | $_ = reverse($_); |
| 90 | printf(STDOUT "%s\n", $_); |
| 91 | } |
| 92 | |
| 93 | # End |