use ExtUtils::MakeMaker;
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
# Last Modification: Wed May  4 12:45:56 WEST 2005

use strict;

my $debug = 0;
my $bufflen = 1024;
my $min_txt_size = 0;
my $signs = "files/signatures.txt";
my $susp = "files/suspicious.txt";

my @html_scripting = ("HTMLVBS", "HTMLJS");
my $script_lang = {
	'in'  => {
		"HTMLVBS" => "< *script[^>]+language *=[\"' ]*vbscript[\"']*[^>]*\>",
		"HTMLJS"  => "< *script[^>]*(language *=[\"' ]*javascript[\"']*)*[^>]*>",
	},
	'out' => {
		"BAT"     => "Batch",
		"JS"      => "JavaScript",
		"VBS"     => "VBScript",
		"TEST"    => "Test",
	},
	'mix' => {
		"MIXVBS"  => "HTMLVBS/VBS",
	},
};

my $app_signatures = {
	'4d5a'             => { sign     => '\x4d\x5a',
				subtypes => [
					{ type => '4d5a000000',
					  sign => '\x4d\x5a\x00\x00\x00', },
					{ type => '4d5a000001',
					  sign => '\x4d\x5a\x00\x00\x01', },
					{ type => '4d5a000002',
					  sign => '\x4d\x5a\x00\x00\x02', },
					{ type => '4d5a420002',
					  sign => '\x4d\x5a\x42\x00\x02', },
					{ type => '4d5a500002',
					  sign => '\x4d\x5a\x50\x00\x02', },
					{ type => '4d5a900003',
					  sign => '\x4d\x5a\x90\x00\x03', },
					{ type => '4d5a930001',
					  sign => '\x4d\x5a\x93\x00\x01', }, ],
				},
	'4d534654'         => { sign     => '\x4d\x53\x46\x54', },
	'49545346'         => { sign     => '\x49\x54\x53\x46', },
	'd0cf11e0a1b11ae1' => { sign     => '\xd0\xcf\x11\xe0\xa1\xb1\x1a\xe1', },
	'474554'           => { sign     => '\x47\x45\x54', },
	'e9'               => { sign     => '\xe9', },
	'7f454c46'         => { sign     => '\x7f\x45\x4c\x46', }
};

my %conversion = ();
my $firstbytes = 32;
my $hash = &load_signatures($signs);
my $linesusp = load_suspicious($susp);
my $code = &get_code($hash);
&make_module($code);

my @ppd;
if ($] >= 5.00503) {
	@ppd = (
		'AUTHOR'   => 'Henrique Dias <hdias@aesbuc.pt>',
		'ABSTRACT' => 'Extension for Scanning files for Viruses',
	);
}

WriteMakefile(
	'NAME'         => 'File::Scan',
	'DISTNAME'     => 'File-Scan',
	'VERSION_FROM' => 'Scan.pm', # finds $VERSION
	'PREREQ_PM'    => {}, # e.g., Module::Name => 1.1
	'dist'         => { 'COMPRESS' => 'gzip -9f', 'SUFFIX' => 'gz', },
	@ppd,
);

sub load_suspicious {
	my $file = shift;

	my @all = ();
	my $pattern = '(?<![\\{\\\\])([\\da-f]{2})(?!\\})';
	open(FILE, "<$file") or die("Can't open $file: $!");
	while(<FILE>) {
		next if(/^#/);
		chomp();
		my ($txt, $hex) = split(/::/);
		$hex =~ s/$pattern/\\x$1/og;
		push(@all, "\/$hex\/s");
	}
	close(FILE);
	return(join(" ||\n\t\t\t\t\t\t", @all));
}

sub load_signatures {
	my $file = shift;

	my $pattern = '(?<![\\{\\\\])([\\da-f]{2})(?!\\})';
	my %script = ();
	@script{keys(%{$script_lang->{'in'}})} = ();
	@script{keys(%{$script_lang->{'out'}})} = ();

	my $hash = {};
	open(FILE, "<$file") or die("Can't open $file: $!");
	while(<FILE>) {
		next if(/^#/);
		chomp;
		my @elem = split(/::/);
		scalar(@elem) == 5 or die("Wrong signature: $_");
		$elem[2] =~ s/\@/\\\@/g;
		$elem[3] =~ s/ +//g;
		$elem[3] =~ s/eq/\=\=/ig;
		$elem[3] =~ s/ne/\!\=/ig;
		$elem[3] =~ s/lt/\</ig;
		$elem[3] =~ s/le/\<\=/ig;
		$elem[3] =~ s/gt/\>/ig;
		$elem[3] =~ s/ge/\>\=/ig;
		$elem[3] =~ s/([\=\!\<\>][\=]?\d+)/\$total$1/g;
		$elem[3] =~ s/or/ \|\| /ig;
		$elem[3] =~ s/and/ \&\& /ig;
		if(exists($script{$elem[1]})) {
			my (@tmp) = ($elem[4] =~ /$pattern/og);
			my $len = int(length(join("", @tmp))/2);
			$min_txt_size = $len if($len < $min_txt_size || !$min_txt_size);
		}
		$elem[4] =~ s/$pattern/\\x$1/og;
		$hash->{$elem[1]}->{$elem[3]}->{$elem[2]} = $elem[4];
	}
	close(FILE);
	return($hash);
}

sub make_module {
	my $code = shift;

	open(BASEFILE, "<files/Scan.base") or die("Can't open files/Scan.base: $!");
	open(PMFILE, ">Scan.pm") or die("Can't open Scan.pm: $!");
	while(<BASEFILE>) {
		s/\$min_txt_size/$min_txt_size/;
		print PMFILE $_;
		if(/^__DATA__/) {
			print PMFILE $code;
		}
	}
	close(PMFILE);
	close(BASEFILE);
}

sub get_code {
	my $patterns = shift;

	my $today = &string_date();
	my $code = <<ENDOFCODE1;
# generated in: $today

sub get_app_sign {
	\$_ = pop;
ENDOFCODE1
	my $c = 0;
	for my $key (keys(%{$app_signatures})) {
		$c++;
		$conversion{$key} = $c;
		my $n = length($key)/2;
		$firstbytes = $n if($n > $firstbytes);
		my $sign = $app_signatures->{$key}->{sign};
		if(exists($app_signatures->{$key}->{subtypes})) {
			$code .= "\t/\^$sign/o and \$_[0] = $c;\n";
			my $sc = 0;
			for my $a (@{$app_signatures->{$key}->{subtypes}}) {
				$sc++;
				my $t = $a->{type};
				my $s = $a->{sign};
				$conversion{$t} = $sc;
				$code .= "\t/\^$s/o and return(\$_[1] = $sc);\n";
				my $n = length($t)/2;
				$firstbytes = $n if($n > $firstbytes);
			}
		} else {
			$code .= "\t/\^$sign/o and return(\$_[0] = $c);\n";
		}
	}
	$code .= <<ENDOFCODE2;
	return(0);
}

sub exception {
	\$_ = shift;
	return(/^%PDF-/o ? 1 : 0);
}

sub scan_text {
	my \$self = shift;
	my \$file = shift;

	my (\$buff, \$save, \$virus, \$script) = ("", "", "", "");
	my \$skip = 0;
	my \$size = $bufflen;
ENDOFCODE2

	$code .= ($] < 5.006) ? "\tsysopen(FILE, \$file, 0)" : "\topen(FILE, \"<\", \$file)";
	$code .= " or return(&_set_error(\"Can't open \$file: \$!\"));\n";

	$code .= <<ENDOFCODE3;
	LINE: while(read(FILE, \$buff, \$size)) {
		unless(\$save) {
			last LINE if(\$skip = &exception(\$buff));
			if(exists(\$self->{'callback'})) {
				if(my \$ret = \$self->{'callback'}->(\$file, \$buff) || "") {
					&ret_callback(\$ret);
					\$ret and last LINE;
				}
			}
		}
		study;
		\$_ = (\$save .= \$buff);
		unless(\$script) {
			TEST: {
				local \$_ = lc(\$save);
ENDOFCODE3
	for my $sl (@html_scripting) {
		$code .= "\t\t\t\t/" . $script_lang->{'in'}->{$sl} . "/os and \$script = \"$sl\", last TEST;\n";
	}
	$code .= "\t\t\t}\n\t\t}\n\t\tif(\$script) {\n";
	for my $sl (keys(%{$script_lang->{'in'}})) {
		if(scalar(keys(%{$patterns->{$sl}->{'0'}}))) {
			$code .= "\t\t\tif(\$script eq \"$sl\") {\n";
			while(my($key, $value) = each(%{$patterns->{$sl}->{'0'}})) {
				$code .= "\t\t\t\t/$value/s and \$virus = \"$key\", last LINE;\n";
			}
			$code .= "\t\t\t}\n";
		}
	}
	$code .= <<ENDOFCODE4;
			local \$_ = lc(\$save);
			/<\\/script[^>]*>/s and \$script = "";
		} else {
ENDOFCODE4
	for my $sl (keys(%{$script_lang->{'out'}})) {
		while(my($key, $value) = each(%{$patterns->{$sl}->{'0'}})) {
			$code .= "\t\t\t/$value/s and \$virus = \"$key\", last LINE;\n";
		}
	}
	$code .= "\t\t}\n";
	if(scalar(keys(%{$script_lang->{'mix'}}))) {
		$code .= "\t\tunless(\$script eq \"HTMLJS\") {\n";
		for my $sl (keys(%{$script_lang->{'mix'}})) {
			while(my($key, $value) = each(%{$patterns->{$sl}->{'0'}})) {
				$code .= "\t\t\t/$value/s and \$virus = \"$key\", last LINE;\n";
			}
		}
		$code .= "\t\t}\n";
	}
	$code .= <<ENDOFCODE5;
		\$save = substr(\$buff, (length(\$buff)/2));
	}
	close(FILE);
	&_set_skip(\$skip) if(\$skip);
	return(\$virus);
}

sub scan_binary {
	my \$self = shift;
	my \$file = shift;

	my (\$skip, \$suspicious, \$type, \$subtype, \$total) = (0, 0, 0, 0, 0);
	my (\$virus, \$buff, \$save) = ("", "", "");
	my \$size = $bufflen;
ENDOFCODE5

	$code .= ($] < 5.006) ? "\tsysopen(FILE, \$file, 0)" : "\topen(FILE, \"<\", \$file)";
	$code .= " or return(&_set_error(\"Can't open \$file: \$!\"));\n";

	$code .= <<ENDOFCODE6;
	binmode(FILE);
	LINE: while(read(FILE, \$buff, \$size)) {
		\$total += length(\$buff);
ENDOFCODE6
	$code .= "\t\tprint STDERR \"\$total\\n\";\n" if($debug);

	$code .= <<ENDOFCODE7;
		unless(\$save) {
			my \$begin = substr(\$buff, 0, $firstbytes, "");
			unless(length(\$begin) >= $firstbytes) { \$skip = 3; last LINE; }
			if(exists(\$self->{'callback'})) {
				if(my \$ret = \$self->{'callback'}->(\$file, \$begin) || "") {
					&ret_callback(\$ret);
					\$ret and last LINE;
				}
			}
			&get_app_sign(\$type, \$subtype, \$begin);
			unless(\$type) { \$skip = 1; last LINE; }
		}
		study;
		\$_ = (\$save .= \$buff);
		unless(\$suspicious) {
			local \$_ = lc(\$save);
			\$suspicious = 1 if($linesusp);
		}
ENDOFCODE7
	my $lcode = "";
	for my $key (keys(%{$app_signatures})) {
		my $c = $conversion{$key};
		$lcode .= ($lcode) ? "\t\t} els" : "\t\t";
		$lcode .= "if(\$type == $c) {\n";
		if(exists($app_signatures->{$key}->{subtypes})) {
			my $stcode = "";
			for my $a (@{$app_signatures->{$key}->{subtypes}}) {
				my $st = $a->{type};
				my $c = $conversion{$st};
				$stcode .= ($stcode) ? "\t\t\t} els" : "\t\t\t";
				$stcode .= "if(\$subtype == $c) {\n";
				$stcode .= &subgene($patterns->{$st}, "\t\t\t\t");
			}
			$lcode .= "$stcode\t\t\t\}\n" if($stcode);
		}
		$lcode .= &subgene($patterns->{$key}, "\t\t\t");
	}
	$code .= $lcode;
	$code .= <<ENDOFCODE8;
		}
		\$save = substr(\$buff, (length(\$buff)/2));
	}
	close(FILE);
	&_set_skip(\$skip) if(\$skip);
	\$suspicious = 0 if(\$virus);
	&_set_suspicious(\$suspicious) if(\$suspicious);
	return(\$virus);
}
ENDOFCODE8
	return($code);
}

sub subgene {
	my $pat = shift;
	my $tab = shift;

	my $code = "";
	for my $limit (keys(%{$pat})) {
		my $tabs = $tab;
		if($limit) {
			$code .= $tabs . "if($limit) \{\n";
			$tabs .= "\t";
		}
		while(my($key, $value) = each(%{$pat->{$limit}})) {
			$code .= $tabs . "/$value/s and \$virus = \"$key\", last LINE;\n";
		}
		$code .= "$tab\}\n" if($limit);
	}
	return($code);
}

sub string_date {
	my ($sec,$min,$hour,$mday,$mon,$year) = localtime();
	return sprintf("%04d/%02d/%02d %02d:%02d:%02d",
		$year + 1900, $mon + 1, $mday, $hour, $min, $sec);
}