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