1#!/usr/local/bin/perl
2# autoreply.pl
3# Simple autoreply script. Command line arguments are :
4# autoreply-file username alternate-file
5
6# Read sendmail module config
7$ENV{'PATH'} = "/bin:/usr/bin:/sbin:/usr/sbin";
8$p = -l $0 ? readlink($0) : $0;
9$p =~ /^(.*)\/[^\/]+$/;
10$moddir = $1;
11%config = &read_config_file("$moddir/config");
12
13# If this isn't the sendmail module, try it
14if (!$config{'sendmail_path'} || !-x $config{'sendmail_path'}) {
15	$moddir =~ s/([^\/]+)$/sendmail/;
16	%config = &read_config_file("$moddir/config");
17	}
18
19if (!$config{'sendmail_path'} || !-x $config{'sendmail_path'}) {
20	# Make some guesses about sendmail
21	if (-x "/usr/sbin/sendmail") {
22		%config = ( 'sendmail_path' => '/usr/sbin/sendmail' );
23		}
24	elsif (-x "/usr/local/sbin/sendmail") {
25		%config = ( 'sendmail_path' => '/usr/local/sbin/sendmail' );
26		}
27	elsif (-x "/opt/csw/lib/sendmail") {
28		%config = ( 'sendmail_path' => '/opt/csw/lib/sendmail' );
29		}
30	elsif (-x "/usr/lib/sendmail") {
31		%config = ( 'sendmail_path' => '/usr/lib/sendmail' );
32		}
33	else {
34		die "Failed to find sendmail or config file";
35		}
36	}
37
38# read headers and body
39$lnum = 0;
40while(<STDIN>) {
41	$headers .= $_;
42	s/\r|\n//g;
43	if (/^From\s+(\S+)/ && $lnum == 0) {
44		# Magic From line
45		$fromline = $1;
46		}
47	elsif (/^(\S+):\s+(.*)/) {
48		$header{lc($1)} = $2;
49		$lastheader = lc($1);
50		}
51	elsif (/^\s+(.*)/ && $lastheader) {
52		$header{$lastheader} .= $_;
53		}
54	elsif (!$_) { last; }
55	$lnum++;
56	}
57while(<STDIN>) {
58	$body .= $_;
59	}
60if ($header{'x-webmin-autoreply'} ||
61    $header{'auto-submitted'} && lc($header{'auto-submitted'}) ne 'no') {
62	print STDERR "Cancelling autoreply to an autoreply\n";
63	exit 0;
64	}
65if ($header{'x-spam-flag'} =~ /^Yes/i || $header{'x-spam-status'} =~ /^Yes/i) {
66        print STDERR "Cancelling autoreply to message already marked as spam\n";
67        exit 0;
68        }
69if ($header{'x-mailing-list'} ||
70    $header{'list-id'} ||
71    $header{'precedence'} =~ /junk|bulk|list/i ||
72    $header{'to'} =~ /Multiple recipients of/i ||
73    $header{'from'} =~ /majordomo/i ||
74    $fromline =~ /majordomo/i) {
75	# Do nothing if post is from a mailing list
76	print STDERR "Cancelling autoreply to message from mailing list\n";
77	exit 0;
78	}
79if ($header{'from'} =~ /postmaster|mailer-daemon/i ||
80    $fromline =~ /postmaster|mailer-daemon|<>/ ) {
81	# Do nothing if post is a bounce
82	print STDERR "Cancelling autoreply to bounce message\n";
83	exit 0;
84	}
85
86# work out the correct to address
87@to = ( &split_addresses($header{'to'}),
88	&split_addresses($header{'cc'}),
89	&split_addresses($header{'bcc'}) );
90$to = $to[0]->[0];
91foreach $t (@to) {
92	if ($t->[0] =~ /^([^\@\s]+)/ && $1 eq $ARGV[1] ||
93	    $t->[0] eq $ARGV[1]) {
94		$to = $t->[0];
95		}
96	}
97
98# build list of default reply headers
99$rheader{'From'} = $to;
100$rheader{'To'} = $header{'reply-to'} ? $header{'reply-to'}
101				     : $header{'from'};
102$rheader{'Subject'} = "Autoreply to $header{'subject'}";
103$rheader{'X-Webmin-Autoreply'} = 1;
104$rheader{'X-Originally-To'} = $header{'to'};
105chop($host = `hostname`);
106$rheader{'Message-Id'} = "<".time().".".$$."\@".$host.">";
107$rheader{'Auto-Submitted'} = 'auto-replied';
108
109# read the autoreply file (or alternate)
110if (open(AUTO, "<".$ARGV[0]) ||
111    $ARGV[2] && open(AUTO, "<".$ARGV[2])) {
112	while(<AUTO>) {
113		s/\$SUBJECT/$header{'subject'}/g;
114		s/\$FROM/$header{'from'}/g;
115		s/\$TO/$to/g;
116		s/\$DATE/$header{'date'}/g;
117		s/\$BODY/$body/g;
118		if (/^(\S+):\s*(.*)/ && !$doneheaders) {
119			if ($1 eq "No-Autoreply-Regexp") {
120				push(@no_regexp, $2);
121				}
122			elsif ($1 eq "Must-Autoreply-Regexp") {
123				push(@must_regexp, $2);
124				}
125			elsif ($1 eq "Autoreply-File") {
126				push(@files, $2);
127				}
128			else {
129				$rheader{$1} = $2;
130				$rheaders .= $_;
131				}
132			}
133		else {
134			$rbody .= $_;
135			$doneheaders = 1;
136			}
137		}
138	close(AUTO);
139	}
140else {
141	$rbody = "Failed to open autoreply file $ARGV[0] : $!";
142	}
143
144if ($header{'x-original-to'} && $rheader{'No-Forward-Reply'}) {
145	# Don't autoreply to a forwarded email
146	($ot) = &split_addresses($header{'x-original-to'});
147	if ($ot->[0] =~ /^([^\@\s]+)/ && $1 ne $ARGV[1] &&
148	    $ot->[0] ne $ARGV[1]) {
149		print STDERR "Cancelling autoreply to forwarded message\n";
150		exit 0;
151		}
152	}
153
154# Open the replies tracking DBM, if one was set
155my $rtfile = $rheader{'Reply-Tracking'};
156if ($rtfile) {
157	$track_replies = dbmopen(%replies, $rtfile, 0700);
158	eval { $replies{"test\@example.com"} = 1; };
159	if ($@) {
160		# DBM is corrupt! Clear it
161		dbmclose(%replies);
162		unlink($rtfile.".dir");
163		unlink($rtfile.".pag");
164		unlink($rtfile.".db");
165		$track_replies = dbmopen(%replies, $rtfile, 0700);
166		}
167	}
168if ($track_replies) {
169	# See if we have replied to this address before
170	$period = $rheader{'Reply-Period'} || 60*60;
171	($from) = &split_addresses($header{'from'});
172	if ($from) {
173		$lasttime = $replies{$from->[0]};
174		$now = time();
175		if ($now < $lasttime+$period) {
176			# Autoreplied already in this period .. just halt
177			print STDERR "Already autoreplied at $lasttime which ",
178				     "is less than $period ago\n";
179			exit 0;
180			}
181		$replies{$from->[0]} = $now;
182		}
183	}
184delete($rheader{'Reply-Tracking'});
185delete($rheader{'Reply-Period'});
186
187# Check if we are within the requested time range
188if ($rheader{'Autoreply-Start'} && time() < $rheader{'Autoreply-Start'} ||
189    $rheader{'Autoreply-End'} && time() > $rheader{'Autoreply-End'}) {
190	# Nope .. so do nothing
191	print STDERR "Outside of autoreply window of ",
192		     "$rheader{'Autoreply-Start'}-$rheader{'Autoreply-End'}\n";
193	exit 0;
194	}
195delete($rheader{'Autoreply-Start'});
196delete($rheader{'Autoreply-End'});
197
198# Check if there is a deny list, and if so don't send a reply
199@fromsplit = &split_addresses($header{'from'});
200if (@fromsplit) {
201	$from = $fromsplit[0]->[0];
202	($fromuser, $fromdom) = split(/\@/, $from);
203	foreach $n (split(/\s+/, $rheader{'No-Autoreply'})) {
204		if ($n =~ /^(\S+)\@(\S+)$/ && lc($from) eq lc($n) ||
205		    $n =~ /^\*\@(\S+)$/ && lc($fromdom) eq lc($1) ||
206		    $n =~ /^(\S+)\@\*$/ && lc($fromuser) eq lc($1) ||
207		    $n =~ /^\*\@\*(\S+)$/ && lc($fromdom) =~ /$1$/i ||
208		    $n =~ /^(\S+)\@\*(\S+)$/ && lc($fromuser) eq lc($1) &&
209						lc($fromdom) =~ /$2$/i) {
210			exit(0);
211			}
212		}
213	delete($rheader{'No-Autoreply'});
214	}
215
216# Check if message matches one of the deny regexps, or doesn't match a
217# required regexp
218foreach $re (@no_regexp) {
219	if ($re =~ /\S/ && $headers =~ /$re/i) {
220		print STDERR "Skipping due to match on $re\n";
221		exit(0);
222		}
223	}
224if (@must_regexp) {
225	my $found = 0;
226	foreach $re (@must_regexp) {
227		if ($headers =~ /$re/i) {
228			$found++;
229			}
230		}
231	if (!$found) {
232		print STDERR "Skipping due to no match on ",
233			     join(" ", @must_regexp),"\n";
234		exit(0);
235		}
236	}
237
238# if spamassassin is installed, feed the email to it
239$spam = &has_command("spamassassin");
240if ($spam) {
241	$temp = "/tmp/autoreply.spam.$$";
242	unlink($temp);
243	open(SPAM, "| $spam >$temp 2>/dev/null");
244	print SPAM $headers;
245	print SPAM $body;
246	close(SPAM);
247	$isspam = undef;
248	open(SPAMOUT, "<".$temp);
249	while(<SPAMOUT>) {
250		if (/^X-Spam-Status:\s+Yes/i) {
251			$isspam = 1;
252			last;
253			}
254		last if (!/\S/);
255		}
256	close(SPAMOUT);
257	unlink($temp);
258	if ($isspam) {
259		print STDERR "Not autoreplying to spam\n";
260		exit 0;
261		}
262	}
263
264# Read attached files
265foreach $f (@files) {
266	local $/ = undef;
267	if (!open(FILE, "<".$f)) {
268		print STDERR "Failed to open $f : $!\n";
269		exit(1);
270		}
271	$data = <FILE>;
272	close(FILE);
273	$f =~ s/^.*\///;
274	$type = &guess_mime_type($f)."; name=\"$f\"";
275	$disp = "inline; filename=\"$f\"";
276	push(@attach, { 'headers' => [ [ 'Content-Type', $type ],
277				       [ 'Content-Disposition', $disp ],
278				       [ 'Content-Transfer-Encoding', 'base64' ]
279				     ],
280			'data' => $data });
281	}
282
283# Work out the content type and encoding
284$type = $rbody =~ /<html[^>]*>|<body[^>]*>/i ? "text/html" : "text/plain";
285$cs = $rheader{'Charset'};
286delete($rheader{'Charset'});
287if ($rbody =~ /[\177-\377]/) {
288	# High-ascii
289	$enc = "quoted-printable";
290	$encrbody = &quoted_encode($rbody);
291	$type .= "; charset=".($cs || "UTF-8");
292	}
293else {
294	$enc = undef;
295	$encrbody = $rbody;
296	$type .= "; charset=$cs" if ($cs);
297	}
298
299# run sendmail and feed it the reply
300($rfrom) = &split_addresses($rheader{'From'});
301if ($rfrom->[0]) {
302	open(MAIL, "|$config{'sendmail_path'} -t -f".quotemeta($rfrom->[0]));
303	}
304else {
305	open(MAIL, "|$config{'sendmail_path'} -t -f".quotemeta($to));
306	}
307foreach $h (keys %rheader) {
308	print MAIL "$h: $rheader{$h}\n";
309	}
310
311# Create the message body
312if (!@attach) {
313	# Just text, so no encoding is needed
314	if ($enc) {
315		print MAIL "Content-Transfer-Encoding: $enc\n";
316		}
317	if (!$rheader{'Content-Type'}) {
318		print MAIL "Content-Type: $type\n";
319		}
320	print MAIL "\n";
321	print MAIL $encrbody;
322	}
323else {
324	# Need to send a multi-part MIME message
325	print MAIL "MIME-Version: 1.0\n";
326	$bound = "bound".time();
327	$ctype = "multipart/mixed";
328	print MAIL "Content-Type: $ctype; boundary=\"$bound\"\n";
329	print MAIL "\n";
330	$bodyattach = { 'headers' => [ [ 'Content-Type', $type ], ],
331			'data' => $encrbody };
332	if ($enc) {
333		push(@{$bodyattach->{'headers'}},
334		     [ 'Content-Transfer-Encoding', $enc ]);
335		}
336	splice(@attach, 0, 0, $bodyattach);
337
338	# Send attachments
339	print MAIL "This is a multi-part message in MIME format.","\n";
340	$lnum++;
341	foreach $a (@attach) {
342		print MAIL "\n";
343		print MAIL "--",$bound,"\n";
344		local $enc;
345		foreach $h (@{$a->{'headers'}}) {
346			print MAIL $h->[0],": ",$h->[1],"\n";
347			$enc = $h->[1]
348				if (lc($h->[0]) eq 'content-transfer-encoding');
349			$lnum++;
350			}
351		print MAIL "\n";
352		$lnum++;
353		if (lc($enc) eq 'base64') {
354			local $enc = &encode_base64($a->{'data'});
355			$enc =~ s/\r//g;
356			print MAIL $enc;
357			}
358		else {
359			$a->{'data'} =~ s/\r//g;
360			$a->{'data'} =~ s/\n\.\n/\n\. \n/g;
361			print MAIL $a->{'data'};
362			if ($a->{'data'} !~ /\n$/) {
363				print MAIL "\n";
364				}
365			}
366		}
367	print MAIL "\n";
368	print MAIL "--",$bound,"--","\n";
369	print MAIL "\n";
370	}
371close(MAIL);
372
373# split_addresses(string)
374# Splits a comma-separated list of addresses into [ email, real-name, original ]
375# triplets
376sub split_addresses
377{
378local (@rv, $str = $_[0]);
379while(1) {
380	if ($str =~ /^[\s,]*(([^<>\(\)"\s]+)\s+\(([^\(\)]+)\))(.*)$/) {
381		# An address like  foo@bar.com (Fooey Bar)
382		push(@rv, [ $2, $3, $1 ]);
383		$str = $4;
384		}
385	elsif ($str =~ /^[\s,]*("([^"]+)"\s*<([^\s<>,]+)>)(.*)$/ ||
386	       $str =~ /^[\s,]*(([^<>\@]+)\s+<([^\s<>,]+)>)(.*)$/ ||
387	       $str =~ /^[\s,]*(([^<>\@]+)<([^\s<>,]+)>)(.*)$/ ||
388	       $str =~ /^[\s,]*(([^<>\[\]]+)\s+\[mailto:([^\s\[\]]+)\])(.*)$/||
389	       $str =~ /^[\s,]*(()<([^<>,]+)>)(.*)/ ||
390	       $str =~ /^[\s,]*(()([^\s<>,]+))(.*)/) {
391		# Addresses like  "Fooey Bar" <foo@bar.com>
392		#                 Fooey Bar <foo@bar.com>
393		#                 Fooey Bar<foo@bar.com>
394		#		  Fooey Bar [mailto:foo@bar.com]
395		#		  <foo@bar.com>
396		#		  <group name>
397		#		  foo@bar.com
398		push(@rv, [ $3, $2 eq "," ? "" : $2, $1 ]);
399		$str = $4;
400		}
401	else {
402		last;
403		}
404	}
405return @rv;
406}
407
408# encode_base64(string)
409# Encodes a string into base64 format
410sub encode_base64
411{
412    local $res;
413    pos($_[0]) = 0;                          # ensure start at the beginning
414    while ($_[0] =~ /(.{1,57})/gs) {
415        $res .= substr(pack('u57', $1), 1)."\n";
416        chop($res);
417    }
418    $res =~ tr|\` -_|AA-Za-z0-9+/|;
419    local $padding = (3 - length($_[0]) % 3) % 3;
420    $res =~ s/.{$padding}$/'=' x $padding/e if ($padding);
421    return $res;
422}
423
424# guess_mime_type(filename)
425sub guess_mime_type
426{
427local ($file) = @_;
428return $file =~ /\.gif/i ? "image/gif" :
429       $file =~ /\.(jpeg|jpg)/i ? "image/jpeg" :
430       $file =~ /\.txt/i ? "text/plain" :
431       $file =~ /\.(htm|html)/i ? "text/html" :
432       $file =~ /\.doc/i ? "application/msword" :
433       $file =~ /\.xls/i ? "application/vnd.ms-excel" :
434       $file =~ /\.ppt/i ? "application/vnd.ms-powerpoint" :
435       $file =~ /\.(mpg|mpeg)/i ? "video/mpeg" :
436       $file =~ /\.avi/i ? "video/x-msvideo" :
437       $file =~ /\.(mp2|mp3)/i ? "audio/mpeg" :
438       $file =~ /\.wav/i ? "audio/x-wav" :
439			   "application/octet-stream";
440}
441
442sub read_config_file
443{
444local %config;
445if (open(CONF, "<".$_[0])) {
446	while(<CONF>) {
447		if (/^(\S+)=(.*)/) {
448			$config{$1} = $2;
449			}
450		}
451	close(CONF);
452	}
453return %config;
454}
455
456# quoted_encode(text)
457# Encodes text to quoted-printable format
458sub quoted_encode
459{
460local $t = $_[0];
461$t =~ s/([=\177-\377])/sprintf("=%2.2X",ord($1))/ge;
462return $t;
463}
464
465sub has_command
466{
467local ($cmd) = @_;
468if ($cmd =~ /^\//) {
469	return -x $cmd ? $cmd : undef;
470	}
471else {
472	foreach my $d (split(":", $ENV{'PATH'}), "/usr/bin", "/usr/local/bin") {
473		return "$d/$cmd" if (-x "$d/$cmd");
474		}
475	return undef;
476	}
477}
478