view release on metacpan or  search on metacpan

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

			if(/^[A-Za-z0-9\+\=\/]{76}\x0d?\x0a[A-Za-z0-9\+\=\/]{76}\x0d?\x0a/o) {
				my $error = &decode_b64_file(\%hash, $tmp_dir, $file);
				&logs("error.log", $error) if($error);
				return("Base64 encoded file");
			}
			return("");
		}
	);
	my $status = 0;
	FILE: for my $file (keys(%{$files})) {
		my $virus = $fs->scan($file);
		if(scalar(keys(%hash))) {
			$status = &init_scan($tmp_dir, \%hash, $from, $user);
			$files = {%{$files}, %hash};
			%hash = ();
			$status and return($status);
		}
		if(my $e = $fs->error) {
			$preserve = 1;
			&logs("error.log", "$e\n");
			next FILE;
		}
		unless($status) {
			my ($shortfn) = ($file =~ /([^\/]+)$/o);
			if($virus) {
				$status = 1;
				delete($files->{$file});
				my $string = join("", "\"$shortfn\" (", $virus, ")");
				&logs("virus.log", "[$string] From: $from\n");
				&virus_mail($string, $from, $to, $user);
			} else {
				&suspicious_mail($shortfn, $from, $to) if($suspicious eq "yes");
			}
		}
	}
	return($status);
}

#---deliver_msg-----------------------------------------------------------

sub deliver_msg {
	my $msg = shift;
	my $line_from = shift;
	my $user = shift;
	my $maildir = shift;

	my $mailbox = "$maildir/$user";
	open(MSG, "<$msg") or &close_app("$!");
	open(MAILBOX, ">>$mailbox") or &close_app("$!");
	flock(MAILBOX, LOCK_EX);
	seek(MAILBOX, 0, SEEK_END);
	print MAILBOX $line_from;
	while(<MSG>) { print MAILBOX $_; }
	print MAILBOX "\n"; 
	flock(MAILBOX, LOCK_UN);
	close(MAILBOX);
	close(MSG);

	chmod(0600, $mailbox);
	my ($uid, $gid) = (getpwnam($user))[2,3];
	chown($uid, $gid, $mailbox) if($uid && $gid);

	return();
}

#---clean_dir-------------------------------------------------------------

sub clean_dir {
	my $dir = shift;

	my @files = ();
	opendir(DIRECTORY, $dir) or return("Can't opendir $dir: $!");
	while(defined(my $file = readdir(DIRECTORY))) {
		next if($file =~ /^\.\.?$/);
		push(@files, "$dir/$file");
	}
	closedir(DIRECTORY);
	for my $file (@files) {
		if($file =~ /^(.+)$/s) { unlink($1) or return("Could not delete $1: $!"); }
	}
	rmdir($dir) or return("Couldn't remove dir $dir: $!");
	return();
}

#---set_addr--------------------------------------------------------------

sub set_addr {
	my $user = shift || "unknown";
	my $email = shift || "unknown";

	my $name = &getusername($user);
	return("$name <$email>");
}

#---getusername-----------------------------------------------------------

sub getusername {
	my $user = shift || return("unknown");

	my ($name) = split(/,/, (getpwnam($user))[6]);
	return($name || "unknown");
}

#---suspicious_mail-------------------------------------------------------

sub suspicious_mail {
	my $file = shift;
	my $from = shift;
	my $to = shift;
 
	my $data = <<DATATXT;
Suspicious file alert: $file

The e-mail from $from has a suspicious file attachement.

Please take a look at the suspicious file.

Thank You.

$copyrg