1#!/usr/local/bin/perl -w
2###########################################################################
3#
4# ScanVirus for use with Procmail
5#
6# Copyright (c) 2003 Henrique Dias <hdias@aesbuc.pt>. All rights reserved.
7# This program is free software; you can redistribute it and/or modify
8# it under the same terms as Perl itself.
9# Last Change: Sat Nov 15 18:36:03 WET 2003
10#
11###########################################################################
12
13use strict;
14use locale;
15use MIME::Explode qw(rfc822_base64);
16use Digest::MD5 qw(md5_hex);
17use File::Scan;
18use Net::SMTP;
19use Fcntl qw(:flock);
20use vars qw($VERSION);
21
22$VERSION = '0.06';
23if($ENV{HOME} =~ /^(.+)$/) { $ENV{HOME} = $1; }
24if($ENV{LOGNAME} =~ /^(.+)$/) { $ENV{LOGNAME} = $1; }
25
26#---begin_config----------------------------------------------------------
27
28my $path          = $ENV{'HOME'};
29my $scandir       = "$path/.scanvirus";
30my $logsdir       = "$scandir/logs";
31my $quarantine    = "$scandir/quarantine";
32my $smtp_hosts    = ["smtp1.myorgnization.com", "smtp2.myorgnization.com"];
33my $hostname      = "myhostname.myorgnization.com";
34my $subject       = ["Returned mail: Virus alert!", "Returned mail: Suspicious file alert!"];
35my $unzip         = "/usr/bin/unzip";
36my $notify_sender = "yes",
37my $suspicious    = "no";
38my $timeout       = 180;
39my $copyrg        = "(c) 2003 Henrique Dias - ScanVirus for Mail";
40
41#---end_config------------------------------------------------------------
42
43use constant SEEK_END => 2;
44my $preserve = 0;
45
46my $pattern = '^[\t ]+(inflating|extracting): (.+)[\n\r]';
47
48unless(@ARGV) {
49	print STDERR "Empty args\n";
50	exit(0);
51}
52
53$SIG{ALRM} = sub { &logs("error.log", "Timeout"); };
54
55&main();
56
57#---main------------------------------------------------------------------
58
59sub main {
60	unless(-d $scandir) { mkdir($scandir, 0700) or exit_script("$!"); }
61	my $id = (my $tmp_dir = "");
62	do {
63		$id = &generate_id();
64		$tmp_dir = join("/", $scandir, $id);
65	} until(!(-e $tmp_dir));
66	mkdir($tmp_dir, 0700) or exit_script("$!");
67
68	my $explode = MIME::Explode->new(
69		output_dir         => $tmp_dir,
70		check_content_type => 1,
71		decode_subject     => 1,
72		exclude_types      => ["image/gif", "image/jpeg"],
73	);
74	my $headers = {};
75	my $line_from = <STDIN>;
76	my ($from) = ($line_from =~ /^From +([^ ]+) +/o);
77	eval {
78		alarm($timeout);
79		open(OUTPUT, ">$tmp_dir/$id.tmp") or exit_script("Can't open '$tmp_dir/$id.tmp': $!");
80		$headers = $explode->parse(\*STDIN, \*OUTPUT);
81		close(OUTPUT);
82		alarm(0);
83	};
84	my %attachs = ();
85	for my $msg (keys(%{$headers})) {
86		if(exists($headers->{$msg}->{'content-disposition'}) &&
87				exists($headers->{$msg}->{'content-disposition'}->{'filepath'})) {
88			my $file = $headers->{$msg}->{'content-disposition'}->{'filepath'};
89			$attachs{$file} = 0;
90		}
91	}
92	my $result = scalar(keys(%attachs)) ? &init_scan($tmp_dir, \%attachs, $from, $ENV{LOGNAME}) : 0;
93	if($result && $quarantine) {
94		unless(-d $quarantine) { mkdir($quarantine, 0755) or exit_script("$!"); }
95		&deliver_msg("$tmp_dir/$id.tmp", $line_from, $ENV{LOGNAME}, $quarantine);
96	}
97	unless($preserve) {
98		if(my $res = &clean_dir($tmp_dir)) { &logs("error.log", "$res"); }
99	}
100	exit($result);
101}
102
103#---extract_file----------------------------------------------------------
104
105sub extract_file {
106	my $fh = shift;
107	my $size = shift;
108	my $buff = shift;
109	my $file = shift;
110
111	open(NEWFILE, ">$file") or return("Can't open $file: $!");
112	flock(NEWFILE, LOCK_EX);
113	binmode(NEWFILE);
114	print NEWFILE $buff;
115	while(read($fh, $buff, $size)) { print NEWFILE $buff; }
116	flock(NEWFILE, LOCK_UN);
117	close(NEWFILE);
118	return("");
119}
120
121#---decode_b64_file---------------------------------------------------------
122
123sub decode_b64_file {
124	my $files = shift;
125	my $tmp_dir = shift;
126	my $file = shift;
127
128	my ($filename) = ($file =~ /\/?([^\/]+)$/);
129	my $decoded = join("/", $tmp_dir, "$filename\.eml");
130	open(ENCFILE, "<$file") or return("Can't open $file: $!\n");
131	open(DECFILE, join("", ">$decoded")) or return("Can't open $decoded: $!\n");
132	binmode(DECFILE);
133	while(<ENCFILE>) { print DECFILE rfc822_base64($_); }
134	close(DECFILE);
135	close(ENCFILE);
136
137	$files->{$decoded} = "";
138
139	return("");
140}
141
142#---mhtml_exploit---------------------------------------------------------
143
144sub mhtml_exploit {
145	my $files = shift;
146	my $tmp_dir = shift;
147	my $file = shift;
148
149	my ($error, $buff, $filename, $size) = ("", "", "", 1024);
150	open(FILE, "<$file") or return("Can't open $file: $!");
151	binmode(FILE);
152	while(read(FILE, $buff, $size)) {
153		$buff =~ s{^MIME-Version: 1.0\x0aContent-Location: *File://([^\x0a]+)\x0aContent-Transfer-Encoding: binary\x0a\x0a}{}o or last;
154		if($filename = join("/", $tmp_dir, $1)) {
155			unless($error = &extract_file(\*FILE, $size, $buff, $filename)) {
156				$files->{$filename} = "";
157			}
158			last;
159		}
160	}
161	close(FILE);
162	return($error);
163}
164
165#---unzip_file------------------------------------------------------------
166
167sub unzip_file {
168	my $files = shift;
169	my $program = shift;
170	my $tmp_dir = shift;
171	my $file = shift;
172
173	my $pid = open(UNZIP, "-|");
174	defined($pid) or return("Cannot fork: $!");
175	if($pid) {
176		while(<UNZIP>) {
177			if(my ($f) = (/$pattern/)[1]) {
178				$f =~ s/ +$//g;
179				$files->{$f} = "";
180			}
181		}
182		close(UNZIP) or return("Unzip error: kid exited $?");
183	} else {
184		my @args = ("-P", "''", "-d", $tmp_dir, "-j", "-n");
185		exec($program, @args, $file) or return("Can't exec program: $!");
186	}
187	return("");
188}
189
190#---init_scan-------------------------------------------------------------
191
192sub init_scan {
193	my $tmp_dir = shift;
194	my $files = shift;
195	my $from = shift || "unknown";
196	my $user = shift || "unknown";
197
198	my $to = join("\@", $user, $hostname);
199	my %param = (max_txt_size => 2048);
200	my $fs = File::Scan->new(%param);
201	my %hash = ();
202	$fs->set_callback(
203		sub {
204			my $file = shift;
205			local $_ = shift;
206			if(-e $unzip) {
207				if(/^\x50\x4b\x03\x04/o) {
208					my $error = &unzip_file(\%hash, $unzip, $tmp_dir, $file);
209					&logs("error.log", $error) if($error);
210					return("Zip Archive");
211				}
212			}
213			if(/^\x4d\x49\x4d\x45\x2d\x56\x65\x72\x73\x69\x6f\x6e\x3a\x20\x31\x2e\x30\x0a/o) {
214				my $error = &mhtml_exploit(\%hash, $tmp_dir, $file);
215				&logs("error.log", $error) if($error);
216				return("MHTML exploit");
217			}
218			if(/^[A-Za-z0-9\+\=\/]{76}\x0d?\x0a[A-Za-z0-9\+\=\/]{76}\x0d?\x0a/o) {
219				my $error = &decode_b64_file(\%hash, $tmp_dir, $file);
220				&logs("error.log", $error) if($error);
221				return("Base64 encoded file");
222			}
223			return("");
224		}
225	);
226	my $status = 0;
227	FILE: for my $file (keys(%{$files})) {
228		my $virus = $fs->scan($file);
229		if(scalar(keys(%hash))) {
230			$status = &init_scan($tmp_dir, \%hash, $from, $user);
231			$files = {%{$files}, %hash};
232			%hash = ();
233			$status and return($status);
234		}
235		if(my $e = $fs->error) {
236			$preserve = 1;
237			&logs("error.log", "$e\n");
238			next FILE;
239		}
240		unless($status) {
241			my ($shortfn) = ($file =~ /([^\/]+)$/o);
242			if($virus) {
243				$status = 1;
244				delete($files->{$file});
245				my $string = join("", "\"$shortfn\" (", $virus, ")");
246				&logs("virus.log", "[$string] From: $from\n");
247				&virus_mail($string, $from, $to, $user);
248			} else {
249				&suspicious_mail($shortfn, $from, $to) if($suspicious eq "yes");
250			}
251		}
252	}
253	return($status);
254}
255
256#---deliver_msg-----------------------------------------------------------
257
258sub deliver_msg {
259	my $msg = shift;
260	my $line_from = shift;
261	my $user = shift;
262	my $maildir = shift;
263
264	my $mailbox = "$maildir/$user";
265	open(MSG, "<$msg") or &close_app("$!");
266	open(MAILBOX, ">>$mailbox") or &close_app("$!");
267	flock(MAILBOX, LOCK_EX);
268	seek(MAILBOX, 0, SEEK_END);
269	print MAILBOX $line_from;
270	while(<MSG>) { print MAILBOX $_; }
271	print MAILBOX "\n";
272	flock(MAILBOX, LOCK_UN);
273	close(MAILBOX);
274	close(MSG);
275
276	chmod(0600, $mailbox);
277	my ($uid, $gid) = (getpwnam($user))[2,3];
278	chown($uid, $gid, $mailbox) if($uid && $gid);
279
280	return();
281}
282
283#---clean_dir-------------------------------------------------------------
284
285sub clean_dir {
286	my $dir = shift;
287
288	my @files = ();
289	opendir(DIRECTORY, $dir) or return("Can't opendir $dir: $!");
290	while(defined(my $file = readdir(DIRECTORY))) {
291		next if($file =~ /^\.\.?$/);
292		push(@files, "$dir/$file");
293	}
294	closedir(DIRECTORY);
295	for my $file (@files) {
296		if($file =~ /^(.+)$/s) { unlink($1) or return("Could not delete $1: $!"); }
297	}
298	rmdir($dir) or return("Couldn't remove dir $dir: $!");
299	return();
300}
301
302#---set_addr--------------------------------------------------------------
303
304sub set_addr {
305	my $user = shift || "unknown";
306	my $email = shift || "unknown";
307
308	my $name = &getusername($user);
309	return("$name <$email>");
310}
311
312#---getusername-----------------------------------------------------------
313
314sub getusername {
315	my $user = shift || return("unknown");
316
317	my ($name) = split(/,/, (getpwnam($user))[6]);
318	return($name || "unknown");
319}
320
321#---suspicious_mail-------------------------------------------------------
322
323sub suspicious_mail {
324	my $file = shift;
325	my $from = shift;
326	my $to = shift;
327
328	my $data = <<DATATXT;
329Suspicious file alert: $file
330
331The e-mail from $from has a suspicious file attachement.
332
333Please take a look at the suspicious file.
334
335Thank You.
336
337$copyrg
338
339DATATXT
340	&send_mail(
341		from    => $to,
342		to      => $to,
343		subject => $subject->[1],
344		data    => $data );
345	return();
346}
347
348#---virus_mail------------------------------------------------------------
349
350sub virus_mail {
351	my $string = shift;
352	my $from = shift;
353	my $to = shift;
354	my $user = shift;
355
356	my $full_email = &set_addr($user, $to);
357
358	my $data = <<DATATXT;
359Virus alert: $string
360
361You have send a e-mail to $full_email with a infected file.
362Your email was not sent to its destiny.
363
364This infected file cannot be cleaned. You should delete the file and
365replace it with a clean copy.
366
367Please try to clean the infected file. If clean fails, delete the file and
368replace it with an uninfected copy and try to send the email again.
369
370Thank You.
371
372$copyrg
373
374DATATXT
375	my %param = (
376		from    => $to,
377		subject => $subject->[0],
378		data    => $data );
379
380	if($notify_sender eq "yes") {
381		$param{'to'} = $from;
382		$param{'bcc'} = $to;
383	} else {
384		$param{'to'} = $to;
385	}
386	&send_mail(%param);
387	return();
388}
389
390#---send_mail-------------------------------------------------------------
391
392sub send_mail {
393	my $param = {
394		from    => "",
395		to      => "",
396		bcc     => "",
397		subject => "",
398		data    => "",
399		@_
400	};
401	HOST: for my $host (@{$smtp_hosts}) {
402		my $smtp = Net::SMTP->new($host);
403		unless(defined($smtp)) {
404			&logs("error.log", "Send mail failed for \"$host\"\n");
405			next HOST;
406		}
407		$smtp->mail($param->{from});
408		$smtp->to($param->{to});
409		$smtp->bcc(split(/ *\, */, $param->{bcc})) if($param->{bcc});
410		$smtp->data();
411		$smtp->datasend(join("", "From: ", $param->{from}, "\n")) if($param->{from});
412		$smtp->datasend(join("", "To: ", $param->{to}, "\n"));
413		$smtp->datasend(join("", "Bcc: ", $param->{bcc}, "\n")) if($param->{bcc});
414		$smtp->datasend(join("", "Subject: ", $param->{subject}, "\n")) if($param->{subject});
415		$smtp->datasend("\n");
416		$smtp->datasend($param->{data}) if($param->{data});
417		$smtp->dataend();
418		$smtp->quit;
419		return();
420	}
421	return();
422}
423
424#---exit_script-----------------------------------------------------------
425
426sub exit_script {
427	my $string = shift;
428
429	&logs("error.log", $string);
430	exit(0);
431}
432
433#---generate_id-----------------------------------------------------------
434
435sub generate_id {
436	return(substr(md5_hex(time(). {}. rand(). $$. 'blah'), 0, 16));
437}
438
439#---string_date-----------------------------------------------------------
440
441sub string_date {
442	my ($sec,$min,$hour,$mday,$mon,$year) = localtime();
443
444	return sprintf("%04d/%02d/%02d %02d:%02d:%02d",
445		$year + 1900, $mon + 1, $mday, $hour, $min, $sec);
446}
447
448#---logs------------------------------------------------------------------
449
450sub logs {
451	my $logfile = shift;
452	my $string = shift;
453
454	unless(-d $logsdir) { mkdir($logsdir, 0755) or exit(0); }
455	my $today = &string_date();
456	$string .= "\n" unless($string =~ /\n+$/);
457	open(LOG, ">>$logsdir/$logfile") or exit(0);
458	print LOG "$today $string";
459	close(LOG);
460
461	return();
462}
463
464#---end-------------------------------------------------------------------
465