File Coverage

blib/lib/File/VirusScan/Engine/Daemon/FPROT/V6.pm
Criterion Covered Total %
statement 32 86 37.2
branch 4 36 11.1
condition 5 17 29.4
subroutine 9 12 75.0
pod 2 2 100.0
total 52 153 33.9


line stmt bran cond sub pod time code
1             package File::VirusScan::Engine::Daemon::FPROT::V6;
2 1     1   100957 use strict;
  1         8  
  1         25  
3 1     1   5 use warnings;
  1         1  
  1         25  
4 1     1   4 use Carp;
  1         1  
  1         45  
5              
6 1     1   365 use File::VirusScan::Engine::Daemon;
  1         2  
  1         8  
7 1     1   40 use vars qw( @ISA );
  1         2  
  1         39  
8             @ISA = qw( File::VirusScan::Engine::Daemon );
9              
10 1     1   439 use IO::Socket::INET;
  1         10621  
  1         4  
11 1     1   446 use Cwd 'abs_path';
  1         2  
  1         38  
12 1     1   387 use File::VirusScan::Result;
  1         2  
  1         748  
13              
14             sub new
15             {
16 6     6 1 13659 my ($class, $conf) = @_;
17              
18 6 100       18 if(!$conf->{host}) {
19 1         14 croak "Must supply a 'host' config value for $class";
20             }
21              
22 5         7 my $port;
23 5 50       11 if($conf->{host}) {
24 5 50       15 if($conf->{host} =~ s/:(\d+)\Z//) {
25 0         0 $port = $1;
26             }
27             }
28             my $self = {
29             host => $conf->{host} || 127.0.0.1,
30             port => $conf->{port} || $port || 10200,
31             connect_timeout => $conf->{connect_timeout} || 10,
32             read_timeout => $conf->{read_timeout} || 60,
33             options => $conf->{options} || [
34              
35             # Instructs the Daemon Scanner which scanlevel to use:
36             # 0 => Disable regular scanning (only heuristics).
37             # 1 => Skip suspicious data files. Not recommended if filename is unavailable.
38             # 2 => (Default) Unknown and/or wrong extensions will be emulated.
39             # 3 => Unknown binaries emulated.
40             # 4 => For scanning virus collections, no limits for emulation
41 5   50     57 '--scanlevel=2',
      50        
      50        
      50        
      50        
42              
43             # archive depth
44             '--archive=2',
45              
46             # How aggressive heuristic should be used, 0..4
47             # the higher the more heuristic tests are done which increases
48             # both detection rates AND risk of false positives.
49             '--heurlevel=2',
50              
51             # to flag adware
52             '--adware',
53              
54             # to flag potentially unwanted applications
55             '--applications',
56             ],
57             };
58              
59 5         24 return bless $self, $class;
60             }
61              
62             sub scan
63             {
64 0     0 1   my ($self, $path) = @_;
65              
66 0           my $abs = abs_path($path);
67 0 0 0       if ($abs && $abs ne $path) {
68 0           $path = $abs;
69             }
70              
71             # The F-Prot demon cannot scan directories, but files only
72             # hence, we recurse any directories manually
73 0           my @files = eval { $self->list_files($path) };
  0            
74 0 0         if($@) {
75 0           return File::VirusScan::Result->error($@);
76             }
77              
78 0           foreach my $file_path (@files) {
79 0           my $result = $self->_scan($file_path);
80              
81 0 0         if(!$result->is_clean()) {
82 0           return $result;
83             }
84             }
85              
86             }
87              
88             # Scans a single path.
89             sub _scan
90             {
91 0     0     my ($self, $path) = @_;
92              
93 0           my $sock = eval { $self->_get_socket };
  0            
94 0 0         if($@) {
95 0           return File::VirusScan::Result->error($@);
96             }
97              
98             # Stringify our options
99 0           my $options = join(' ', $self->{options});
100              
101             # SCAN options FILE fnam\n (local daemon)
102             # -or- SCAN options STREAM fnam SIZE length\n (remote daemon)
103             # length bytes of data
104             # assume local daemon ==> implement FILE variant only
105             # , supports spaces in fnam
106 0 0         if(!$sock->print("SCAN $options FILE $path\n")) {
107 0           my $err = $!;
108 0           $sock->close;
109 0           return File::VirusScan::Result->error("Could not write to socket: $err");
110             }
111              
112 0 0         if(!$sock->flush) {
113 0           my $err = $!;
114 0           $sock->close;
115 0           return File::VirusScan::Result->error("Could not flush socket: $err");
116             }
117              
118 0           my $s = IO::Select->new($sock);
119 0 0         if(!$s->can_read($self->{read_timeout})) {
120 0           $sock->close;
121 0           return File::VirusScan::Result->error("Timeout reading from fprot daemon");
122             }
123              
124 0           my $resp = $sock->getline;
125 0 0         if(!$resp) {
126 0           $sock->close;
127 0           return File::VirusScan::Result->error("Did not get response from fprot while scanning $path");
128             }
129              
130 0           my ($code, $desc, $name);
131 0 0         unless (($code, $desc, $name) = $resp =~ /\A(\d+)\s<(.*?)>\s(.*)\Z/) {
132 0           return File::VirusScan::Result->error("Failed to parse response from fprotd: $path");
133             }
134              
135             # Clean up $desc
136 0           $desc =~ s/\A(?:contains infected objects|infected):\s//i;
137              
138             # Our output should contain:
139             # 1) A code. The code is a bitmask of:
140             # bit num Meaning
141             # 0 1 At least one virus-infected object was found (and remains).
142             # 1 2 At least one suspicious (heuristic match) object was found (and remains).
143             # 2 4 Interrupted by user. (SIGINT, SIGBREAK).
144             # 3 8 Scan restriction caused scan to skip files (maxdepth directories, maxdepth archives, exclusion list, etc).
145             # 4 16 Platform error (out of memory, real I/O errors, insufficient file permission etc.).
146             # 5 32 Internal engine error (whatever the engine fails at)
147             # 6 64 At least one object was not scanned (encrypted file, unsupported/unknown compression method, corrupted or invalid file).
148             # 7 128 At least one object was disinfected (clean now) (treat same as virus for File::VirusScan)
149             #
150             # 2) The description, including virus name
151             #
152             # 3) The item name, incl. member of archive etc. We ignore
153             # this for now.
154              
155 0 0         if($code & (1 | 128)) {
    0          
    0          
    0          
    0          
156 0           my $virus_name = $desc;
157 0   0       $virus_name ||= 'unknown-FPROTD-virus';
158 0           return File::VirusScan::Result->virus($virus_name);
159             } elsif($code & 2) {
160 0           my $virus_name = $desc;
161 0   0       $virus_name ||= 'unknown-FPROTD-virus';
162 0           return File::VirusScan::Result->virus($virus_name);
163             } elsif($code & 4) {
164 0           return File::VirusScan::Result->error('FPROTD scanning interrupted by user');
165             } elsif($code & 16) {
166 0           return File::VirusScan::Result->error('FPROTD platform error');
167             } elsif($code & 32) {
168 0           return File::VirusScan::Result->error('FPROTD internal engine error');
169             }
170              
171 0           return File::VirusScan::Result->clean();
172             }
173              
174             # Returns preconfigured socket, or opens a new connection.
175             sub _get_socket
176             {
177 0     0     my ($self) = @_;
178              
179 0 0         if(!$self->{sock}) {
180             $self->{sock} = IO::Socket::INET->new(
181             PeerAddr => $self->{host},
182             PeerPort => $self->{port},
183             Timeout => $self->{connect_timeout},
184 0           );
185             }
186              
187 0           return $self->{sock};
188             }
189              
190             1;
191             __END__