iam.tj Git - webmin.git/blob - sendmail/autoreply.pl

1 #!/usr/local/bin/perl

2 # autoreply.pl

3 # Simple autoreply script. Command line arguments are :

4 # autoreply-file username alternate-file

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");

13 # If this isn't the sendmail module, try it

14 if (!$config{'sendmail_path'} || !-x $config{'sendmail_path'}) {

15 $moddir =~ s/([^\/]+)$/sendmail/;

16 %config = &read_config_file("$moddir/config");

17 }

19 if (!$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 }

38 # read headers and body

39 $lnum = 0;

40 while(<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 }

57 while(<STDIN>) {

58 $body .= $_;

59 }

60 if ($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 }

65 if ($header{'x-mailing-list'} ||

66 $header{'list-id'} ||

67 $header{'precedence'} =~ /junk|bulk|list/i ||

68 $header{'to'} =~ /Multiple recipients of/i ||

69 $header{'from'} =~ /majordomo/i ||

70 $fromline =~ /majordomo/i) {

71 # Do nothing if post is from a mailing list

72 exit 0;

73 }

74 if ($header{'from'} =~ /postmaster|mailer-daemon/i ||

75 $fromline =~ /postmaster|mailer-daemon|<>/ ) {

76 # Do nothing if post is a bounce

77 exit 0;

78 }

80 # if spamassassin is installed, feed the email to it

81 $spam = &has_command("spamassassin");

82 if ($spam) {

83 $temp = "/tmp/autoreply.spam.$$";

84 unlink($temp);

85 open(SPAM, "| $spam >$temp 2>/dev/null");

86 print SPAM $headers;

87 print SPAM $body;

88 close(SPAM);

89 $isspam = undef;

90 open(SPAMOUT, $temp);

91 while(<SPAMOUT>) {

92 if (/^X-Spam-Status:\s+Yes/i) {

93 $isspam = 1;

94 last;

95 }

96 last if (!/\S/);

97 }

98 close(SPAMOUT);

99 unlink($temp);

100 if ($isspam) {

101 print STDERR "Not autoreplying to spam\n";

102 exit 0;

103 }

104 }

105

106 # work out the correct to address

107 @to = ( &split_addresses($header{'to'}),

108 &split_addresses($header{'cc'}),

109 &split_addresses($header{'bcc'}) );

110 $to = $to[0]->[0];

111 foreach $t (@to) {

112 if ($t->[0] =~ /^([^\@\s]+)/ && $1 eq $ARGV[1] ||

113 $t->[0] eq $ARGV[1]) {

114 $to = $t->[0];

115 }

116 }

117

118 # build list of default reply headers

119 $rheader{'From'} = $to;

120 $rheader{'To'} = $header{'reply-to'} ? $header{'reply-to'}

121 : $header{'from'};

122 $rheader{'Subject'} = "Autoreply to $header{'subject'}";

123 $rheader{'X-Webmin-Autoreply'} = 1;

124 $rheader{'X-Originally-To'} = $header{'to'};

125 chop($host = `hostname`);

126 $rheader{'Message-Id'} = "<".time().".".$$."\@".$host.">";

127

128 # read the autoreply file (or alternate)

129 if (open(AUTO, $ARGV[0]) ||

130 $ARGV[2] && open(AUTO, $ARGV[2])) {

131 while(<AUTO>) {

132 s/\$SUBJECT/$header{'subject'}/g;

133 s/\$FROM/$header{'from'}/g;

134 s/\$TO/$to/g;

135 s/\$DATE/$header{'date'}/g;

136 s/\$BODY/$body/g;

137 if (/^(\S+):\s*(.*)/ && !$doneheaders) {

138 if ($1 eq "No-Autoreply-Regexp") {

139 push(@no_regexp, $2);

140 }

141 elsif ($1 eq "Autoreply-File") {

142 push(@files, $2);

143 }

144 else {

145 $rheader{$1} = $2;

146 $rheaders .= $_;

147 }

148 }

149 else {

150 $rbody .= $_;

151 $doneheaders = 1;

152 }

153 }

154 close(AUTO);

155 }

156 else {

157 $rbody = "Failed to open autoreply file $ARGV[0] : $!";

158 }

159

160 # Open the replies tracking DBM, if one was set

161 if ($rheader{'Reply-Tracking'}) {

162 $track_replies = dbmopen(%replies, $rheader{'Reply-Tracking'}, 0700);

163 }

164 if ($track_replies) {

165 # See if we have replied to this address before

166 $period = $rheader{'Reply-Period'} || 60*60;

167 ($from) = &split_addresses($header{'from'});

168 if ($from) {

169 $lasttime = $replies{$from->[0]};

170 $now = time();

171 if ($now < $lasttime+$period) {

172 # Autoreplied already in this period .. just halt

173 exit(0);

174 }

175 $replies{$from->[0]} = $now;

176 }

177 }

178 delete($rheader{'Reply-Tracking'});

179 delete($rheader{'Reply-Period'});

180

181 # Check if we are within the requested time range

182 if ($rheader{'Autoreply-Start'} && time() < $rheader{'Autoreply-Start'} ||

183 $rheader{'Autoreply-End'} && time() > $rheader{'Autoreply-End'}) {

184 # Nope .. so do nothing

185 exit 0;

186 }

187 delete($rheader{'Autoreply-Start'});

188 delete($rheader{'Autoreply-End'});

189

190 # Check if there is a deny list, and if so don't send a reply

191 @fromsplit = &split_addresses($header{'from'});

192 if (@fromsplit) {

193 $from = $fromsplit[0]->[0];

194 ($fromuser, $fromdom) = split(/\@/, $from);

195 foreach $n (split(/\s+/, $rheader{'No-Autoreply'})) {

196 if ($n =~ /^(\S+)\@(\S+)$/ && lc($from) eq lc($n) ||

197 $n =~ /^\*\@(\S+)$/ && lc($fromdom) eq lc($1) ||

198 $n =~ /^(\S+)\@\*$/ && lc($fromuser) eq lc($1) ||

199 $n =~ /^\*\@\*(\S+)$/ && lc($fromdom) =~ /$1$/i ||

200 $n =~ /^(\S+)\@\*(\S+)$/ && lc($fromuser) eq lc($1) &&

201 lc($fromdom) =~ /$2$/i) {

202 exit(0);

203 }

204 }

205 delete($rheader{'No-Autoreply'});

206 }

207

208 # Check if message matches one of the deny regexps

209 foreach $re (@no_regexp) {

210 if ($re =~ /\S/ && $rheaders =~ /$re/i) {

211 print STDERR "Skipping due to match on $re\n";

212 exit(1);

213 }

214 }

215

216 # Read attached files

217 foreach $f (@files) {

218 local $/ = undef;

219 if (!open(FILE, $f)) {

220 print STDERR "Failed to open $f : $!\n";

221 exit(1);

222 }

223 $data = <FILE>;

224 close(FILE);

225 $f =~ s/^.*\///;

226 $type = &guess_mime_type($f)."; name=\"$f\"";

227 $disp = "inline; filename=\"$f\"";

228 push(@attach, { 'headers' => [ [ 'Content-Type', $type ],

229 [ 'Content-Disposition', $disp ],

230 [ 'Content-Transfer-Encoding', 'base64' ]

231 ],

232 'data' => $data });

233 }

234

235 # Work out the content type and encoding

236 $type = $rbody =~ /<html[^>]*>|<body[^>]*>/i ? "text/html" : "text/plain";

237 $cs = $rheader{'Charset'};

238 delete($rheader{'Charset'});

239 if ($rbody =~ /[\177-\377]/) {

240 # High-ascii

241 $enc = "quoted-printable";

242 $encrbody = &quoted_encode($rbody);

243 $type .= "; charset=".($cs || "iso-8859-1");

244 }

245 else {

246 $enc = undef;

247 $encrbody = $rbody;

248 $type .= "; charset=$cs" if ($cs);

249 }

250

251 # run sendmail and feed it the reply

252 ($rfrom) = &split_addresses($rheader{'From'});

253 if ($rfrom->[0]) {

254 open(MAIL, "|$config{'sendmail_path'} -t -f$rfrom->[0]");

255 }

256 else {

257 open(MAIL, "|$config{'sendmail_path'} -t -f$to");

258 }

259 foreach $h (keys %rheader) {

260 print MAIL "$h: $rheader{$h}\n";

261 }

262

263 # Create the message body

264 if (!@attach) {

265 # Just text, so no encoding is needed

266 if ($enc) {

267 print MAIL "Content-Transfer-Encoding: $enc\n";

268 }

269 if (!$rheader{'Content-Type'}) {

270 print MAIL "Content-Type: $type\n";

271 }

272 print MAIL "\n";

273 print MAIL $encrbody;

274 }

275 else {

276 # Need to send a multi-part MIME message

277 print MAIL "MIME-Version: 1.0\n";

278 $bound = "bound".time();

279 $ctype = "multipart/mixed";

280 print MAIL "Content-Type: $ctype; boundary=\"$bound\"\n";

281 print MAIL "\n";

282 $bodyattach = { 'headers' => [ [ 'Content-Type', $type ], ],

283 'data' => $encrbody };

284 if ($enc) {

285 push(@{$bodyattach->{'headers'}},

286 [ 'Content-Transfer-Encoding', $enc ]);

287 }

288 splice(@attach, 0, 0, $bodyattach);

289

290 # Send attachments

291 print MAIL "This is a multi-part message in MIME format.","\n";

292 $lnum++;

293 foreach $a (@attach) {

294 print MAIL "\n";

295 print MAIL "--",$bound,"\n";

296 local $enc;

297 foreach $h (@{$a->{'headers'}}) {

298 print MAIL $h->[0],": ",$h->[1],"\n";

299 $enc = $h->[1]

300 if (lc($h->[0]) eq 'content-transfer-encoding');

301 $lnum++;

302 }

303 print MAIL "\n";

304 $lnum++;

305 if (lc($enc) eq 'base64') {

306 local $enc = &encode_base64($a->{'data'});

307 $enc =~ s/\r//g;

308 print MAIL $enc;

309 }

310 else {

311 $a->{'data'} =~ s/\r//g;

312 $a->{'data'} =~ s/\n\.\n/\n\. \n/g;

313 print MAIL $a->{'data'};

314 if ($a->{'data'} !~ /\n$/) {

315 print MAIL "\n";

316 }

317 }

318 }

319 print MAIL "\n";

320 print MAIL "--",$bound,"--","\n";

321 print MAIL "\n";

322 }

323 close(MAIL);

324

325 # split_addresses(string)

326 # Splits a comma-separated list of addresses into [ email, real-name, original ]

327 # triplets

328 sub split_addresses

329 {

330 local (@rv, $str = $_[0]);

331 while(1) {

332 if ($str =~ /^[\s,]*(([^<>\s]+)\s+$([^\($]+)\))(.*)$/) {

333 # An address like foo@bar.com (Fooey Bar)

334 push(@rv, [ $2, $3, $1 ]);

335 $str = $4;

336 }

337 elsif ($str =~ /^[\s,]*("([^"]+)"\s*<([^\s<>,]+)>)(.*)$/ ||

338 $str =~ /^[\s,]*(([^<>\@]+)\s+<([^\s<>,]+)>)(.*)$/ ||

339 $str =~ /^[\s,]*(([^<>\@]+)<([^\s<>,]+)>)(.*)$/ ||

340 $str =~ /^[\s,]*(([^<>\[\]]+)\s+\[mailto:([^\s\[\]]+)\])(.*)$/||

341 $str =~ /^[\s,]*(()<([^<>,]+)>)(.*)/ ||

342 $str =~ /^[\s,]*(()([^\s<>,]+))(.*)/) {

343 # Addresses like "Fooey Bar" <foo@bar.com>

344 # Fooey Bar <foo@bar.com>

345 # Fooey Bar<foo@bar.com>

346 # Fooey Bar [mailto:foo@bar.com]

347 # <foo@bar.com>

348 # <group name>

349 # foo@bar.com

350 push(@rv, [ $3, $2 eq "," ? "" : $2, $1 ]);

351 $str = $4;

352 }

353 else {

354 last;

355 }

356 }

357 return @rv;

358 }

359

360 # encode_base64(string)

361 # Encodes a string into base64 format

362 sub encode_base64

363 {

364 local $res;

365 pos($_[0]) = 0; # ensure start at the beginning

366 while ($_[0] =~ /(.{1,57})/gs) {

367 $res .= substr(pack('u57', $1), 1)."\n";

368 chop($res);

369 }

370 $res =~ tr|\` -_|AA-Za-z0-9+/|;

371 local $padding = (3 - length($_[0]) % 3) % 3;

372 $res =~ s/.{$padding}$/'=' x $padding/e if ($padding);

373 return $res;

374 }

375

376 # guess_mime_type(filename)

377 sub guess_mime_type

378 {

379 local ($file) = @_;

380 return $file =~ /\.gif/i ? "image/gif" :

381 $file =~ /\.(jpeg|jpg)/i ? "image/jpeg" :

382 $file =~ /\.txt/i ? "text/plain" :

383 $file =~ /\.(htm|html)/i ? "text/html" :

384 $file =~ /\.doc/i ? "application/msword" :

385 $file =~ /\.xls/i ? "application/vnd.ms-excel" :

386 $file =~ /\.ppt/i ? "application/vnd.ms-powerpoint" :

387 $file =~ /\.(mpg|mpeg)/i ? "video/mpeg" :

388 $file =~ /\.avi/i ? "video/x-msvideo" :

389 $file =~ /\.(mp2|mp3)/i ? "audio/mpeg" :

390 $file =~ /\.wav/i ? "audio/x-wav" :

391 "application/octet-stream";

392 }

393

394 sub read_config_file

395 {

396 local %config;

397 if (open(CONF, $_[0])) {

398 while(<CONF>) {

399 if (/^(\S+)=(.*)/) {

400 $config{$1} = $2;

401 }

402 }

403 close(CONF);

404 }

405 return %config;

406 }

407

408 # quoted_encode(text)

409 # Encodes text to quoted-printable format

410 sub quoted_encode

411 {

412 local $t = $_[0];

413 $t =~ s/([=\177-\377])/sprintf("=%2.2X",ord($1))/ge;

414 return $t;

415 }

416

417 sub has_command

418 {

419 local ($cmd) = @_;

420 if ($cmd =~ /^\//) {

421 return -x $cmd ? $cmd : undef;

422 }

423 else {

424 foreach my $d (split(":", $ENV{'PATH'}), "/usr/bin", "/usr/local/bin") {

425 return "$d/$cmd" if (-x "$d/$cmd");

426 }

427 return undef;

428 }

429 }