Commit | Line | Data |
---|---|---|
8c4f17b3 | 1 | #! PERL_COMMAND |
059ec3d9 PH |
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 | ||
8c4f17b3 | 14 | use warnings; |
4d3d955f | 15 | BEGIN { pop @INC if $INC[-1] eq '.' }; |
983da878 HSHR |
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", | |
02721dcd | 21 | "perl(runtime): $]\n"; |
983da878 HSHR |
22 | exit 0; |
23 | } | |
059ec3d9 PH |
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 |