File::Scan isn't the best means of looking for virii but I thought it would be interesting.
And it was mentioned earlier in how to use file::scan.

#!/usr/bin/perl
use strict;
use warnings;
use File::Find;
use File::Scan;
my $scandir = "c:\\"; # couldn't get it to work with 'c:/'
my $results = "c:\\virusscan.txt";
open(VS, ">", $results);
my $filescan = File::Scan->new(extension => 'bad', move => 'infected')
+;
find({ wanted => \&doscan, follow_skip => 2 }, $scandir);

sub doscan {
  return if /^[.]+/;
  my $file = $File::Find::name;
  $file =~ s#\\##;
  print "$file\n";
  return if (-d $file);
  $filescan->scan($file);
  if (my $e = $filescan->error()) { print "$file $e\n"; }
  if (my $c = $filescan->skipped()) {
    my @skip = (
    "file not skipped",
    "file is not vulnerable",
    "file has zero size",
    "the size of file is small",
    "the text file size is greater that the 'max_txt_size' argument",
    "the binary file size is greater that the 'max_bin_size' argument"
+,
    );
    print VS "$file $skip[$c]\n" if ($c); # only print if the file was
+ skipped
  }
  if ($filescan->suspicious) { print VS "$file suspicious file\n"; }
}

[download]

Update: Thanks to jdporter for pointing out using "c:\\" instead of "c:".
Added readmore tag, fixed some typos and formatting.

2nd Update: LTjake pointed out that I had an error in the return codes of File::Scan's skipped() method. I checked and found out that the HTML documentation built by the ActiveState distribution was saying one thing but the embedded pod was saying something else. I have updated the script to use the correct return codes for that method.

Replies are listed 'Best First'.
Re: Perl Virus Scanner
by submersible_toaster (Chaplain) on Nov 20, 2002 at 07:22 UTC
    Maybe not the best means , but nonetheless usefull. Reading this made me hmmm and errr about scanning emails. In a large enterprise, the cost of an email scanner is negligable and usually easily justified. Smaller businesses are not always so blessed, I wonder if MIME::Tools or similar could be combined with File::Scan as an email-scanner.


    submersible_toaster
    --bashing buttons
[reply]
      Smaller businesses are not always so blessed, I wonder if MIME::Tools or similar could be combined with File::Scan as an email-scanner.

      See the popfile project for an excellent base set of code.

      BTW a really simple regex that kills 99% of email viri is 

      m!<iframe src=3Dcid:(\w+) height=3D0 width=3D0>.*Content-ID: <\1>!s

      [download]

      Dingus

      Enter any 47-digit prime number to continue.
[reply]
[d/l]
        dingus++ for interesting albeit broken link to http://popfile.sourceforge.net
        but I'm bucking for 'nother Linux deployment to replace an unhappy IMAP/POP server. Which means starting over....ah..
        i cant believe its a syntax error
[reply]

      You might want to look at the examples included with the latest version of File::Scan. They have included a procmail virus scanner script that uses MIME::Parser.

[reply]
Re: (nrd) Perl Virus Scanner
by newrisedesigns (Curate) on Nov 20, 2002 at 15:30 UTC

    Mr. Muskrat++

    I have one usability concern; running it on my home machine generated a 1.6MB text file, filled mostly with "file is not vulnerable" or "file has no size." Such a large amount of data to filter through makes scanning difficult.

    For now, I'm just going to comment-out the line that prints the "nice" error messages. Perhaps a bell, or a Tk window signaling a potential virus would be a nice complement to the log file.

    John J Reiser
    newrisedesigns.com

[reply]

      This is a quick and dirty virus scanner. A proof of concept so to speak.

      I am mulling over the idea of expanding the idea... Have it create one text file per warning or error type and letting the user decide which ones get created. It will need to use one of the GetOpts modules for reading in command line parameters that override defaults.

      Any comments or suggestions for this project are greatly appreciated.

[reply]

Back to Cool Uses for Perl