sanitizer 1.76-5 / usr / share / perl5 / Anomy / Sanitizer / FProt.pm

#!/usr/bin/perl
#
my $revision = '$Id: FProt.pm,v 1.12 2005/01/04 20:30:13 bre Exp $';
my $version = 'Anomy 0.0.0 : Anomy::Sanitizer::FProt.pm';
#
##  Copyright (c) 2002-2005 FRISK Software International. All rights reserved.
##  This program is free software; you can redistribute it and/or modify
##  it under the terms of the GNU Lesser General Public License as 
##  published by the Free Software Foundation; either version 2.1 of the 
##  License, or (at your option) any later version.
#
##############################################################################
#
# NOTE:  Sanitizer development is for the most part sponsored by
#        FRISK Software International, http://www.f-prot.com/.  Please
#        consider buying their anti-virus products to show your 
#        appreciation.
#
##############################################################################
#
# This module implements a built in scanner which communicates directly 
# with the daemonized version of F-Prot Antivirus for Linux. 
#
# Using the daemonized version of the scanner offers a significant performance 
# increase over the freely available command line version and provides
# more detailed feedback and logs.  Contact sales@f-prot.com for information
# on purchasing the daemonized version of F-Prot Antivirus for Linux.
#
# Usage:
#
#   my @url_list = [ "http://localhost:10200", 
#                    "http://localhost:10201",
#                    "http://localhost:10202",
#                    "http://localhost:10203",
#                    "http://localhost:10204" ];
#   my $scanner_gid = 1234;
#
#   my $fprot = new Anomy::Sanitizer::FProt \@url_list, $scanner_gid;
#   #
#   # Note:  Either of the two parameters may be undefined, in which
#   #        case the module will use it's internal defaults.
#
#   my $san = new Anomy::Sanitizer ...
#   $san->register_scanner("fprot", $fprot->get_sanitizer_callback());
#
##[ Package definition ]######################################################

package Anomy::Sanitizer::FProt;
use strict;

BEGIN {
    use Exporter ();
    use vars     qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

    $VERSION     = do { my @r = (q$Revision: 1.12 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
    @ISA         = qw(Exporter);
    @EXPORT      = qw( );
    @EXPORT_OK   = qw( );
}
use vars @EXPORT_OK;
my $serial = 0;

##[ Package implementation ]##################################################

use Anomy::Sanitizer;
use Anomy::Log;
use IO::Socket::INET;

# Constructor.
#
sub new
{
    my ($proto, $urls, $scan_gid) = @_;
    my $class = ref($proto) || $proto;

    unless ($urls)
    {
        $urls = [ 'http://localhost:10200', 
                  'http://localhost:10201', 
                  'http://localhost:10202', 
                  'http://localhost:10203', 
                  'http://localhost:10204' ];
    }

    no strict;
    my $self = 
    {
        urls => $urls,
        perms => 0660,
        scan_gid => $scan_gid,
        results => undef,
	job => undef,
    };
    bless($self,$class);
    
    return $self;
}

sub get_results
{
     my $self = shift;
     return $self->{results};
}

sub set_job_id
{
     $_[0]->{job} = $_[1];
}

sub explain_results
{
    my $self = shift;
    
    my @inf = ( );
    foreach my $l (split(/\012/, $self->{results} || ""))
    {
        push @inf, $2 if ($l =~ /<(name|message)[^>]*>\s*(.*?)<\/\1>/is); 
    }
    my $name = join(', ', @inf);
	$name = '(heuristic detection)' 
	  if (($name !~ /^[a-z\d\s\@\.\:\{\}\(\)\[\]\/\\\&\+\*\%\$\"\'\#\!,_=-]+$/is) ||
	      ($name =~ /^\s*$/));

    my $stat = $self->{scan_stat};
    my $msg = undef;
    my $attr = { };
    if (0 == $stat)
    {
        $msg = "File is clean.";
    }
    elsif (1 == $stat)
    {
        $attr = { "name" => $name };
        $msg = "Disinfected file, removed %name%";
    }
    elsif (2 == $stat)
    {
        $attr = { "name" => $name };
        $msg = "Detected unremovable infection: %name%";
    }
    elsif (3 == $stat)
    {
        $msg = "File is of unknown type.";
    }
    elsif (4 == $stat)
    {
        $msg = "File is suspicious.";
    }
    elsif (0 < $stat)
    {
        $attr = { "code" => $stat };
        $msg = "Unrecognized status! (%code%)";
    }
    elsif (0 > $stat)
    {
        $attr = { "code" => $stat };
        $msg = "Error (%code%) scanning file!";
    }
    
    return ($msg, $attr);
}

sub get_sanitizer_callback
{
    my $self = shift;
    return sub {
        my $san = shift;
        my $plog = shift;
        $san->set_var("fprot_result", "");

        my $stat = $self->do_scan($san, $plog, @_);
        my ($msg, $attr) = $self->explain_results();
        if ($msg)
        {
            $san->set_var("fprot_result", $msg);
            $plog->entry("fprot_result", SLOG_INFO, 
                         $attr, "F-Prot: ".$msg);
        }

        return $stat;
    };
}

sub do_scan
{
    my ($self, $san, $plog, $fh, $md5x2, $filename, @args) = @_;

    return ($self->{scan_stat} = -4) unless ($filename);

    # Make file readable AND writable by the scanner.
    if ($self->{scan_gid})
    {
        chown(-1, $self->{scan_gid}, $filename);
        chmod($self->{perms}, $filename);
    }
    
    # Prevent duplicate leading slashes.
    $filename =~ s/^\/+//;

    # FIXME: Should prepend current directory if above doesn't really
    #        do anything.

    my $tries = $self->{results} = 0;
    while (!$self->{results})
    {
        my $url = shift @{ $self->{urls} };

        my $request = $url.'/'. urlencode($filename);
	push @args, "-id=".$self->{job} if ($self->{job});
        $request   .= '?'. urlencode(join("\n", @args)) if (@args);

        if ($self->{results} = get($request))
        {
            unshift @{ $self->{urls} }, $url;
        }
        else
        {
            push @{ $self->{urls} }, $url;
            sleep(5)  if (($tries++) > @{ $self->{urls} });
            
            return ($self->{scan_stat} = -1) 
              if (($tries/2) > @{ $self->{urls} });
        }
    }

    my $summary = "unknown-error";
    $summary = lc($1) if ($self->{results} =~ /<summary[^>]*>(.*?)<\/summary>/i);

    return ($self->{scan_stat} =  0) if ($summary eq "clean");
    return ($self->{scan_stat} =  1) if ($summary eq "disinfected");
    return ($self->{scan_stat} =  2) if ($summary eq "infected");
    return ($self->{scan_stat} =  3) if ($summary eq "unknown"); 
    return ($self->{scan_stat} =  4) if ($summary eq "suspicious");
    # FIXME: Does sharing a code with "suspicious" make sense?
    return ($self->{scan_stat} =  4) if ($summary eq "not scanned");
    return ($self->{scan_stat} = -2) if ($summary eq "error");
    return ($self->{scan_stat} = -3);
}

sub urlencode
{
    my $text = shift;
    $text =~ s/([^A-Za-z0-9\/_-])/ $_=sprintf("%%%2.2X", ord($1))/ge;
    return $text;
}

sub get
{
    my $url = shift;
    if ($url =~ /^http:\/+([^\/\s]+)(.*)/i)
    {
        my ($host, $path) = ($1, $2);
        my $port = 80;
        $port = $1 if ($host =~ s/:(\d+)$//);
        $path = "/" unless ($path);

#        print STDERR "Connecting to $host on port $port, requesting $path\n";

        # Connect to server
        my $socket = new IO::Socket::INET (
            PeerAddr => $host,
            PeerPort => $port,
            Proto => "tcp",
        ); 
        return undef unless ($socket);

        # Send HTTP request
        $socket->autoflush(1);
        $socket->print("GET $path HTTP/1.1\r\n");
        $socket->print("Host: $host\r\n");
        $socket->print("Connection: close\r\n");
        $socket->print("\r\n");

        # Parse the reply header
        my $status = 900;
        while (my $l = <$socket>)
        {
            last if ($l =~ /^[\r\n]*$/);
            if ($l =~ /^HTTP.1\.[01]\s+(\d\d\d)\s+(.*)$/)
            {
                my ($code, $text) = ($1, $2);
                $status = $code;
            }
        }

        # Get the data...
        my $data = join('', <$socket>);
        $socket->close(); 

        # Return.
        return undef unless ($status eq 200);
        return $data;
    } 
    else
    {
        die "Failed to parse URL: $url\n";
    } 
}
1;

# vi:ts=4