File Coverage

blib/lib/File/VirusScan/Engine/Daemon/FPROT/V6.pm

Criterion	Covered	Total	%
statement	35	85	41.1
branch	5	36	13.8
condition	5	14	35.7
subroutine	10	12	83.3
pod	2	2	100.0
total	57	149	38.2

package File::VirusScan::Engine::Daemon::FPROT::V6;
use strict;
use warnings;
use Carp;

use File::VirusScan::Engine::Daemon;
use vars qw( @ISA );
@ISA = qw( File::VirusScan::Engine::Daemon );

use IO::Socket::INET;
use Cwd 'abs_path';
use File::VirusScan::Result;

sub new
{
	my ($class, $conf) = @_;

	if(!$conf->{host}) {
		croak "Must supply a 'host' config value for $class";
	}

	my $port;
	if($conf->{host}) {
		if($conf->{host} =~ s/:(\d+)\Z//) {
			$port = $1;
		}
	}
	my $self = {
		host            => $conf->{host}            || 127.0.0.1,
		port            => $conf->{port}            || $port || 10200,
		connect_timeout => $conf->{connect_timeout} || 10,
		read_timeout    => $conf->{read_timeout}    || 60,
		options         => $conf->{options}         || [

			# Instructs the Daemon Scanner which scanlevel to use:
			# 0 => Disable regular scanning (only heuristics).
			# 1 => Skip suspicious data files. Not recommended if filename is unavailable.
			# 2 => (Default) Unknown and/or wrong extensions will be emulated.
			# 3 => Unknown binaries emulated.
			# 4 => For scanning virus collections, no limits for emulation
			'--scanlevel=2',

			# archive depth
			'--archive=2',

			# How aggressive heuristic should be used, 0..4
			# the higher the more  heuristic tests are done which increases
			# both detection rates AND risk of false positives.
			'--heurlevel=2',

			# to flag adware
			'--adware',

			# to flag potentially unwanted applications
			'--applications',
		],
	};

	return bless $self, $class;
}

sub scan
{
	my ($self, $path) = @_;

	if(abs_path($path) ne $path) {
		return File::VirusScan::Result->error("Path $path is not absolute");
	}

	# The F-Prot demon cannot scan directories, but files only
	# hence, we recurse any directories manually
	my @files = eval { $self->list_files($path) };
	if($@) {
		return File::VirusScan::Result->error($@);
	}

	foreach my $file_path (@files) {
		my $result = $self->_scan($file_path);

		if(!$result->is_clean()) {
			return $result;
		}
	}

}

# Scans a single path.
sub _scan
{
	my ($self, $path) = @_;

	my $sock = eval { $self->_get_socket };
	if($@) {
		return File::VirusScan::Result->error($@);
	}

	# Stringify our options
	my $options = join(' ', $self->{options});

	# SCAN options FILE fnam\n	(local daemon)
	# -or- SCAN options STREAM fnam SIZE length\n	(remote daemon)
	#   length bytes of data
	# assume local daemon ==> implement FILE variant only
	#		, supports spaces in fnam
	if(!$sock->print("SCAN $options FILE $path\n")) {
		my $err = $!;
		$sock->close;
		return File::VirusScan::Result->error("Could not write to socket: $err");
	}

	if(!$sock->flush) {
		my $err = $!;
		$sock->close;
		return File::VirusScan::Result->error("Could not flush socket: $err");
	}

	my $s = IO::Select->new($sock);
	if(!$s->can_read($self->{read_timeout})) {
		$sock->close;
		return File::VirusScan::Result->error("Timeout reading from fprot daemon");
	}

	my $resp = $sock->getline;
	if(!$resp) {
		$sock->close;
		return File::VirusScan::Result->error("Did not get response from fprot while scanning $path");
	}

	my ($code, $desc, $name);
	unless (($code, $desc, $name) = $resp =~ /\A(\d+)\s<(.*?)>\s(.*)\Z/) {
		return File::VirusScan::Result->error("Failed to parse response from fprotd: $path");
	}

	# Clean up $desc
	$desc =~ s/\A(?:contains infected objects|infected):\s//i;

	# Our output should contain:
	# 1) A code.  The code is a bitmask of:
	# bit num Meaning
	#  0   1  At least one virus-infected object was found (and remains).
	#  1   2  At least one suspicious (heuristic match) object was found (and remains).
	#  2   4  Interrupted by user. (SIGINT, SIGBREAK).
	#  3   8  Scan restriction caused scan to skip files (maxdepth directories, maxdepth archives, exclusion list, etc).
	#  4  16  Platform error (out of memory, real I/O errors, insufficient file permission etc.).
	#  5  32  Internal engine error (whatever the engine fails at)
	#  6  64  At least one object was not scanned (encrypted file, unsupported/unknown compression method, corrupted or invalid file).
	#  7 128  At least one object was disinfected (clean now) (treat same as virus for File::VirusScan)
	#
	# 2) The description, including virus name
	#
	# 3) The item name, incl. member of archive etc.  We ignore
	# this for now.

	if($code & (1 | 128)) {
		my $virus_name = $desc;
		$virus_name ||= 'unknown-FPROTD-virus';
		return File::VirusScan::Result->virus($virus_name);
	} elsif($code & 2) {
		my $virus_name = $desc;
		$virus_name ||= 'unknown-FPROTD-virus';
		return File::VirusScan::Result->virus($virus_name);
	} elsif($code & 4) {
		return File::VirusScan::Result->error('FPROTD scanning interrupted by user');
	} elsif($code & 16) {
		return File::VirusScan::Result->error('FPROTD platform error');
	} elsif($code & 32) {
		return File::VirusScan::Result->error('FPROTD internal engine error');
	}

	return File::VirusScan::Result->clean();
}

# Returns preconfigured socket, or opens a new connection.
sub _get_socket
{
	my ($self) = @_;

	if(!$self->{sock}) {
		$self->{sock} = IO::Socket::INET->new(
			PeerAddr => $self->{host},
			PeerPort => $self->{port},
			Timeout  => $self->{connect_timeout},
		);
	}

	return $self->{sock};
}

1;
__END__