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 = "ed_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