view release on metacpan or  search on metacpan

examples/procmail/scanvirus.pl  view on Meta::CPAN

		output_dir         => $tmp_dir,
		check_content_type => 1,
		decode_subject     => 1,
		exclude_types      => ["image/gif", "image/jpeg"],
	);
	my $headers = {};
	my $line_from = <STDIN>;
	my ($from) = ($line_from =~ /^From +([^ ]+) +/o);
	eval {
		alarm($timeout);
		open(OUTPUT, ">$tmp_dir/$id.tmp") or exit_script("Can't open '$tmp_dir/$id.tmp': $!");
		$headers = $explode->parse(\*STDIN, \*OUTPUT);
		close(OUTPUT);
		alarm(0);
	};
	my %attachs = ();
	for my $msg (keys(%{$headers})) {
		if(exists($headers->{$msg}->{'content-disposition'}) &&
				exists($headers->{$msg}->{'content-disposition'}->{'filepath'})) {
			my $file = $headers->{$msg}->{'content-disposition'}->{'filepath'};
			$attachs{$file} = 0;
		}
	}
	my $result = scalar(keys(%attachs)) ? &init_scan($tmp_dir, \%attachs, $from, $ENV{LOGNAME}) : 0;
	if($result && $quarantine) {
		unless(-d $quarantine) { mkdir($quarantine, 0755) or exit_script("$!"); }
		&deliver_msg("$tmp_dir/$id.tmp", $line_from, $ENV{LOGNAME}, $quarantine);
	}
	unless($preserve) {
		if(my $res = &clean_dir($tmp_dir)) { &logs("error.log", "$res"); }
	}
	exit($result);
}

#---extract_file----------------------------------------------------------

sub extract_file {
	my $fh = shift;   
	my $size = shift; 
	my $buff = shift; 
	my $file = shift; 

	open(NEWFILE, ">$file") or return("Can't open $file: $!");
	flock(NEWFILE, LOCK_EX);
	binmode(NEWFILE);
	print NEWFILE $buff;
	while(read($fh, $buff, $size)) { print NEWFILE $buff; }
	flock(NEWFILE, LOCK_UN);
	close(NEWFILE);
	return("");
}

#---decode_b64_file---------------------------------------------------------

sub decode_b64_file {
	my $files = shift;
	my $tmp_dir = shift;
	my $file = shift;

	my ($filename) = ($file =~ /\/?([^\/]+)$/);
	my $decoded = join("/", $tmp_dir, "$filename\.eml");
	open(ENCFILE, "<$file") or return("Can't open $file: $!\n");
	open(DECFILE, join("", ">$decoded")) or return("Can't open $decoded: $!\n");
	binmode(DECFILE);
	while(<ENCFILE>) { print DECFILE rfc822_base64($_); }
	close(DECFILE);
	close(ENCFILE);

	$files->{$decoded} = "";

	return("");
}

#---mhtml_exploit---------------------------------------------------------

sub mhtml_exploit {
	my $files = shift; 
	my $tmp_dir = shift;
	my $file = shift;   

	my ($error, $buff, $filename, $size) = ("", "", "", 1024);
	open(FILE, "<$file") or return("Can't open $file: $!");
	binmode(FILE);
	while(read(FILE, $buff, $size)) {
		$buff =~ s{^MIME-Version: 1.0\x0aContent-Location: *File://([^\x0a]+)\x0aContent-Transfer-Encoding: binary\x0a\x0a}{}o or last;
		if($filename = join("/", $tmp_dir, $1)) {
			unless($error = &extract_file(\*FILE, $size, $buff, $filename)) {
				$files->{$filename} = "";
			}
			last;
		}
	}
	close(FILE);
	return($error);
}

#---unzip_file------------------------------------------------------------

sub unzip_file {
	my $files = shift;
	my $program = shift;
	my $tmp_dir = shift;
	my $file = shift;

	my $pid = open(UNZIP, "-|");
	defined($pid) or return("Cannot fork: $!");
	if($pid) {
		while(<UNZIP>) {
			if(my ($f) = (/$pattern/)[1]) {
				$f =~ s/ +$//g;
				$files->{$f} = "";
			}
		}
		close(UNZIP) or return("Unzip error: kid exited $?");
	} else {
		my @args = ("-P", "''", "-d", $tmp_dir, "-j", "-n");
		exec($program, @args, $file) or return("Can't exec program: $!");
	}
	return("");
}

#---init_scan-------------------------------------------------------------
        
sub init_scan {
	my $tmp_dir = shift;
	my $files = shift;
	my $from = shift || "unknown";
	my $user = shift || "unknown";