view release on metacpan or  search on metacpan

examples/scan.pl  view on Meta::CPAN

        exit(0);
}

#---display_msg-------------------------------------------------------------

sub display_msg {
	my $file = shift;
	my $virus = shift;

	$objects++;
	my $string = "No viruses were found";
	if($virus) {
		$infected++;
		$string = "Infection: $virus";
	}
	print "$file $string\n" if(!$QUIET || $virus);
	return();
}

#---check_path--------------------------------------------------------------

sub check_path {
	my $argv = shift;

	my @args = ();
	push(@args, "max_txt_size", $MAXTXTSIZE) if($MAXTXTSIZE);
	push(@args, "max_bin_size", $MAXBINSIZE) if($MAXBINSIZE);

	my $fs = File::Scan->new(
		extension => $EXTENSION,
		copy      => $CP_DIR,
		mkdir     => oct($MK_DIR),
		move      => $MV_DIR,
		delete    => $DELETE,
		@args);
	$fs->set_callback(
		sub {
			my $file = shift;
			local $_ = shift;
			if($UNZIP_PROG) {
				if(/^\x50\x4b\x03\x04/o) {
					# Extract compressed files in a ZIP archive
					my $files = &unzip_file($UNZIP_PROG, $TMP_DIR, $file);
					for my $f (@{$files}) {
						&check($fs, $f);
						unlink($f);
					}
					return("ZIP archive");
				}
			}
			if(/^MIME-Version: 1\.0\x0a/o) {
				# MHTML exploit
				if(my $insidefile = &mhtml_exploit($file)) {
					&check($fs, $insidefile);
					unlink($insidefile);
				}
				return("MHTML exploit");
			}
			if(/^[A-Za-z0-9\+\=\/]{76}\x0d?\x0a[A-Za-z0-9\+\=\/]{76}\x0d?\x0a/o) {
				# Base64 encoded file
				if(my $decodedfile = &decode_b64_file($TMP_DIR, $file)) {
					&check($fs, $decodedfile);
					unlink($decodedfile);
				}
				return("Base64 encoded file");
			}
			return("");
		}
	);
	for my $p (@{$argv}) {
		if(-d $p) {
			($p eq "/") or $p =~ s{\/+$}{}g;
			&dir_handle($fs, $p);
		} elsif(-e $p) {
			&check($fs, $p);
		} else {
			print "No such file or directory: $p\n";
			exit(0);
		}
	}
	return();
}

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

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

	my $total = length($buff);
	open(NEWFILE, ">$file") or die("Can't open $file: $!\n");
	binmode(NEWFILE);
	print NEWFILE $buff;
	while(read($fh, $buff, $size)) {
		print NEWFILE $buff;
		if($MAXBINSIZE) {
			$total += $size;
			last if($total > $MAXBINSIZE*1024);
		}
	}
	close(NEWFILE);
	return();
}

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

sub decode_b64_file {
	my $tmp = shift;
	my $file = shift;

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

	return($decoded);
}

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

sub mhtml_exploit {
	my $file = shift;

	my ($buff, $filename) = ("", "");
	my $size = 1024;
	open(FILE, "<$file") or die("Can't open $file: $!\n");
	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)) {
			&extract_file(\*FILE, $size, $buff, $filename);
			last;
		}
	}
	close(FILE);
	return($filename);
}

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

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

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

#---dir_handle--------------------------------------------------------------

sub dir_handle {
	my $fs = shift;
	my $dir_path = shift;

	unless(-r $dir_path) {
		print "Permission denied at $dir_path\n";
		return();
	}
	opendir(DIRHANDLE, $dir_path) or die("can't opendir $dir_path: $!");
	for my $item (readdir(DIRHANDLE)) {
		($item =~ /^\.+$/o) and next;