#! /usr/bin/perl -w
#-----------------------------------------------------------------------------
#  Dr.Web (R) Update Script
#  $Revision: 1.156.2.3 $
#-----------------------------------------------------------------------------
# Copyright 2008, Igor Daniloff.
#
# Following source code is the property of Doctor Web, Ltd.
# Use is subject to license terms.
# The reproduction in any form without written permission of
# Doctor Web, Ltd. and proper attribution is strongly prohibited.
#


my $log_cache = [];
my $LogLevel = 5;
my $syslog = 0;
my $mutelog = 0;
my %Levels;
BEGIN {
    %Levels = (
        quiet   => [ 0, 'Q' ],
        error   => [ 1, 'E' ],
        warning => [ 2, 'W' ],
        info    => [ 3, 'I' ],
        verbose => [ 4, 'V' ],
        debug   => [ 5, 'D' ],
    );

#----------------------------------------------------------------------------
# IN (STRING): a level of the logged message
# IN (STRING): the logged message
# OUT: no
sub Log {
    my ( $level, $msg ) = @_;

    return if $mutelog;
    if ( $log_cache ) {
        # delayed logging
        push @{ $log_cache }, sub { &Log( $level, $msg ); };
        return;
    }

    my $ctime = localtime;
    if( !exists $Levels{ $level } ) {
        &Log( 'warning', 'message with unknown loglevel( ' . $level . ' ) - please send bug report to support@drweb.com' );
        $level = 'warning';
    }
    $msg =~ s/\012\015//g;
    return unless $msg;
    if( $LogLevel and $Levels{ $level }[ 0 ] <= $LogLevel ) {
        if ( fileno( LOGHANDLE ) ) {
            print LOGHANDLE "$ctime {$Levels{ $level }[ 1 ]} [$$] $msg\n";
        } elsif ( $syslog ) {
            syslog( [ 'warning', 'err', 'warning', 'notice', 'info', 'debug' ]->[ $Levels{ $level }[ 0 ] ], '%s', $msg );
        } else {
            print "$ctime {$Levels{ $level }[ 1 ]} [$$] $msg\n";
        }
    }
    print "ERROR: Dr.Web (R) Updater: $msg !\n" if 'error' eq $level;
}
    my %event = ( __WARN__ => 'warning', __DIE__ => 'error' );
    foreach my $event ( keys %event ) {
        $SIG{$event} = sub {
                my ( $msg ) = @_;
                foreach my $line ( split /\n+/, $msg ) {
                    chomp $line;
                    next if '' eq $line;
                    &Log( $event{ $event }, $line );
                }
        };
    }
}

use warnings;
use strict;
use Cwd qw/ abs_path /;
use FileHandle;
use Fcntl qw/ :flock F_GETFL F_SETFL O_NONBLOCK O_RDONLY /;
use POSIX qw/ uname /;
use Socket;
use Sys::Syslog;

########
# main #
########
# const
my $DefaultURL = 'http://update.drweb.com/unix';
# variables
# LOGHANDLE - file handle for LogFile
# LOCKFD - file handle for LockFile
# environment
$ENV{PATH} .= ':/usr/local/bin:/sbin:/usr/sbin:/usr/local/sbin';
# signals
$SIG{PIPE} = $SIG{BUS} = $SIG{INT} = $SIG{QUIT} = $SIG{TERM} = \&ExitHandler;
# code
my $Conf = &LoadConfiguration( @ARGV );
&DumpConfiguration( $Conf );
&ParseKey($Conf);
my ( $CoreURLs, $PluginURLs ) = &BuildURLs( $Conf );
my $Crc32 = &Crc32();
&Lock($Conf);
srand;
my %reload;
my $Task;
$SIG{__DIE__} = \&DrDie;
my $hooks = {
	ft	=> { filter_task => \&FlyTrapPreprocessTask }
};
for my $URLs ( $CoreURLs, map { $_ } @{$PluginURLs} ) {
    undef( $Task );
    $Conf->{Paths}{drl} = $Conf->{Self}{drldir} . '/' if $URLs ne $CoreURLs;
    my $plugin_name = '';
    my $urls = $URLs;
    ( $plugin_name, $urls ) = %$URLs if 'HASH' eq ref $URLs;
    $Conf->{ Self }{ hooks } = $hooks->{ $plugin_name } || {};
    next unless @{$urls};
    &Update( $Conf, $urls, \$Task );
    &ViewSummary( $Conf, $Task );
    $reload{ '0.drwebd' } ||= &ReloadDaemon( $Conf, $Task );
    $reload{ '1.maild' } ||= &ReloadMaild( $Conf, $Task );
}
foreach my $daemon ( sort keys %reload ) {
    my $reload_code = $reload{ $daemon };
    &$reload_code() if $reload_code;
}
&Unlock( $Conf );
&CloseLog();
exit 0;

###############
# subroutines #
###############
#-----------------------------------------------------------------------------
sub LoadConfiguration
{
    my %Config = (
        Self => {
            # loadable from ini
            section       => 'daemon',
            programpath   => '/usr/local/drweb/drwebd',
            loglevel      => 'debug',
            syslogfacility=> 'daemon',
            logfilename   => '/var/drweb/log/updater.log',
            lockfile      => '',
            locked        => 'no',
            drlfile       => '/var/drweb/bases/update.drl',
            signedreader  => '/usr/local/drweb/read_signed',
            proxyserver   => '',
            proxylogin    => '',
            proxypassword => '',
            timeout       => '60',
            tries	  => '1',
            cronsummary   => 'no',
            drldir        => '/var/drweb/drl',
            updatepluginsonly => undef,
            # hidden options
            skipengine    => 'no',
            customdrlfile => '',
            fallbacktodrl => 'no',
            updateself    => 'no',
        },
        Object => {
            # loadable from ini
            virusbase     => '/var/drweb/bases',
            updatepath    => '/var/drweb/updates',
            enginepath    => '/usr/local/drweb/lib/drweb32.dll',
            key           => '/usr/local/drweb/drweb32.key',
            temppath      => '/var/drweb/spool',
            mailcommand   => '/bin/cat',
            # [Daemon] section only
            pidfile       => '/var/drweb/run/drwebd.pid',
            pathtovaderetro => '/var/drweb/lib/libvaderetro.so',
            maildpidfile  => '/var/drweb/run/drweb-maild.pid',
            agentconfpath => '/usr/local/etc/drweb/agent.conf',
            ftsetupcfgpath=> '/usr/local/etc/flytrap/setup.cfg',
            user          => 'drweb',
            group         => undef,
            userid        => -1,
            groupid       => -1,
        },
        Versions => {
            Updater       => 'Dr.Web (R) Updater ($Revision: 1.156.2.3 $)',
        }
    );
    &Log( 'warning', $Config{ Versions }{ Updater }.' started ...' );

    $Config{ Paths }{ self } = $0;
    for ( $Config{ Paths }{ self } ) {
        last if m!^/! and not m!/\.{1,2}/!;
        $_ = abs_path $_;
    }
    &Log( 'debug', $Config{ Versions }{ Updater } . ' script path is ' . $Config{ Paths }{ self } );

    my ( $ini, $what ) = &ParseCmdLine( @_ );
    unless ( -f $ini ) {
        &Log( 'debug', 'file ' . $ini . ' will not be read as configuration source because it is not a regular file' );
        $Config{ Self }{ updatepluginsonly } = 'yes';
    } else {
        my $fd = new FileHandle;
        open( $fd, "<$ini" )
            or &DrDie( "cannot open configuration file $ini ($!)" );

        &ParseSection( $fd, 'updater', ';#', \%{ $Config{ Self } }, \&ParseLineStd );

        $Config{ Self }{ section }  = lc( $what || $Config{ Self }{ section } );
        $Config{ Self }{ loglevel } = lc( $Config{ Self }{ loglevel } );

        seek( $fd, 0, 0 ); # rewind

        &ParseSection( $fd, $Config{ Self }{ section }, ';#', \%{ $Config{ Object } }, \&ParseLineStd )
            or &DrDie( "failed to load parameters - section [$Config{ Self }{ section }] not found in $ini" );

        close( $fd );
    }
    $Config{ Self }{ updatepluginsonly } ||= 'no';
    &Log( 'warning', $Config{ Versions }{ Updater } . ' self auto-updating is enabled!' ) if 'yes' eq lc( $Config{ Self }{ updateself } );

    $Config{ Object }{ user } = eval{ no warnings; getpwnam( $Config{ Object }{ user } ) };
    $Config{ Object }{ group } = eval{ no warnings; getgrnam( $Config{ Object }{ group } ) };
    $Config{ Object }{ user } = $Config{ Object }{ userid } unless defined $Config{ Object }{ user };
    $Config{ Object }{ group } = $Config{ Object }{ groupid } unless defined $Config{ Object }{ group };
    $Config{ Object }{ userid } = $Config{ Object }{ user };
    $Config{ Object }{ groupid } = $Config{ Object }{ group };
    $Config{ Object }{ user } = eval{ no warnings; return 'unchanged' if -1 == $Config{ Object }{ userid }; getpwuid( $Config{ Object }{ userid } ) };
    $Config{ Object }{ group } = eval{ no warnings; return 'unchanged' if -1 == $Config{ Object }{ groupid }; getgrgid( $Config{ Object }{ groupid } ) };
    $Config{ Object }{ user } = '#' . $Config{ Object }{ userid } unless defined $Config{ Object }{ user };
    $Config{ Object }{ group } = '#' . $Config{ Object }{ groupid } unless defined $Config{ Object }{ group };

    &OpenLog( $Config{ Self }{ loglevel }, $Config{ Self }{ syslogfacility }, $Config{ Self }{ logfilename } );
    &ReplayLog();

    $Config{ Versions }{ UserAgent } = '$Revision: 1.156.2.3 $';
    $Config{ Versions }{ UserAgent } =~ s!^\$R@{[]}evision:\s+(\S+?)\s*\$$!DrWebUnixUpdater-$1 (HTTP/1.1-compliant; $^O: _distname_ !;
    my @os_info;
OS:
    for ( lc $^O ) {
        /linux/ && do {
            my %info;
            foreach my $line ( split /\n+/, `lsb_release -a 2>/dev/null` ) {
                my ( $key, $value ) = split( /:/, $line, 2 );
                $value =~ s/^\s+//;
                $value =~ s/\s+$//;
                $info{ lc $key } = $value;
            }
            foreach my $key ( qw/ description release codename / ) {
                push @os_info, $info{ $key } if exists $info{ $key };
            }
            last OS if @os_info;
            &Log( 'info', 'You appear to use some linux distro, but there is no lsb_release command accessible in your system. Either your PATH environment variable is screwed up (due to security considerations, or whatever), or your linux distribution does not fully support Linux Standard Base (proposed by Free Standards Group). It is probably okay. Falling back to another way of discovering the name of your linux distro.' );
            my %dist_info = (
                'Debian GNU/Linux'  => '/etc/debian_version'
                , 'Slackware Linux' => '/etc/slackware-version'
                , 'RedHat Linux'    => '/etc/redhat-release'
                , 'Mandrake Linux'  => '/etc/mandrake-release'
                , 'Gentoo Linux'    => '/etc/gentoo-release'
                , 'ASPLinux'        => '/etc/asplinux-release'
                , 'Alt Linux'       => '/etc/altlinux-release'
                , 'PLD Linux'       => '/etc/pld-release'
                , 'SuSE Linux'      => '/etc/SuSE-release'
                , 'Arch Linux'      => '/etc/arch-release'
                , 'Conectiva Linux' => '/etc/conectiva-release'
            );
LINUX_DISTRO:
            foreach my $linux ( sort keys %dist_info ) {
                my $file = $dist_info{ $linux };
                stat( $file );
                next unless -e _;
                &Log( 'info', 'You appear to use ' . $linux . ' (the file \'' . $file . '\' exists, which is typical for ' . $linux . '). Trying to discover the exact version and hardware architecture of your linux system.' );
                unless ( -r _ ) {
                    &Log( 'warning', 'You have the file \'' . $file . '\' which probably confirms your using of ' . $linux . ', but the file spoken of cannot be read. You might make it readable for everyone with "chmod 644 \'' . $file . '\'" command.' );
                    push @os_info, $linux;
                    last;
                }
                my $fd = new FileHandle;
                open( $fd, '<' . $file ) or do { &Log( 'error', 'Unable to open file ' . $file . ': ' . $! ); last LINUX_DISTRO; };
                my $line = <$fd>;
                close( $fd ) or do { &Log( 'error', 'Unable to close file ' . $file . ': ' . $! ); last LINUX_DISTRO; };
                $line =~ s/^\s+//;
                $line =~ s/\s+$//;
                push @os_info, $linux if $linux =~ m/version$/i;
                push @os_info, $line;
                last OS;
            }
            &Log( 'warning', 'Unable to reliably determine the exact version and hardware architecture of your linux distro. Please contact our support team via support@drweb.com e-mail address and provide us with the output of "uname -a" command invoked at this host. Please specify your linux distro name as well, along with the way to distinguish it from other linux distros (if you know it). We appreciate your cooperation, thank you!' );
            last OS;
        };
        /bsd$/ && do {
            ## Highly experimental
            my @sysctl2uname = (
                [ 'kern.ostype'       => 0 ]
                , [ 'kern.osrelease'  => 2 ]
                , [ 'hw.machine_arch' => 4 ]
            );
            foreach my $sysctl ( @sysctl2uname ) {
                my $mib = lc( $sysctl->[ 0 ] );
                foreach my $line ( split /\n+/, `sysctl $mib 2>/dev/null` ) {
                    my ( $key, $value ) = map { s/^\s+//; s/\s+$//; $_ } split( /:/, $line, 2 );
                    unless ( ( '' eq $value ) or ( $mib ne lc( $key ) ) ) {
                        push @os_info, $value;
                    } else {
                        &Log( 'warning', 'The command "sysctl ' . $mib . ' 2>/dev/null" was expected to return non-empty value for ' . $mib . '. Please contact our support team via support@drweb.com e-mail address and provide us with any feedback regarding your operating system, its version and hardware architecture. We appreciate your cooperation, thank you!' );
                        $value = ( &uname() )[ $sysctl->[ 1 ] ] || '';
                        $value =~ s/^\s+//;
                        $value =~ s/\s+$//;
                        if ( '' eq $value ) {
                            &DrDie( 'Unable to get the value of ' . $mib . ' neither from "syscall ' . $mib . ' 2>/dev/null" nor from uname() system call. Please contact our support team via support@drweb.com e-mail address and provide us with any feedback regarding your operating system, its version and hardware architecture. We appreciate your cooperation, thank you!' );
                        } else {
                            &Log( 'info', 'The value of ' . $mib . ' is taken from uname() system call.' );
                            push @os_info, $value;
                        }
                    }
                }
            }
            last OS;
        };
        /^solaris$/ && do {
            if ( -r '/etc/release' ) {
                my $fd = new FileHandle;
                open( $fd, '</etc/release' ) or do { &Log( 'error', 'Unable to open file /etc/release: ' . $! ); last OS; };
                my $line = <$fd>;
                close( $fd ) or do { &Log( 'error', 'Unable to close file /etc/release: ' . $! ); last OS; };
                $line =~ s/^\s+//;
                $line =~ s/\s+$//;
                push @os_info, $line;
            } else {
                &Log( 'warning', 'Your solaris distro appears not to have /etc/release file (which is a common way to keep solaris distribution version). It might be okay - anyway, please contact our support team via support@drweb.com e-mail address and provide us with any feedback regarding your operating system, its version and hardware architecture, along with the way to distinguish your particular solaris distribution from others. We appreciate your cooperation, thank you!' );
            }
            last OS;
        };
DEFAULT:
        {
            &Log( 'error', 'Unable to determine the exact operating system distro name, version and hardware architecture you are using. Please contact our support team via support@drweb.com e-mail address. Put the string \'$^O = ' . $^O . '\' in your request, and please provide us with the output of "uname -a" command invoked at this host. Specify your distro name, version and hardware architecture as well, along with the way to distinguish it from other operating systems (if you know it). We appreciate your cooperation, thank you!' );
        }
    }
    @os_info = ( &uname() )[ 0, 2, 3, 4 ] unless @os_info;
    &DrDie( 'Unable to get your operating system information (its name, version and hardware architecture) with all conventional means. Please contact our support team via support@drweb.com e-mail address and provide us with any feedback regarding this information. We appreciate your cooperation, thank you!' ) unless @os_info;
    $Config{ Versions }{ UserAgent } .= join( "\t" => map { s/^\s+//; s/\s+$//; s/\s+/ /; $_ } @os_info ) . ')';

    &DrDie( 'key file is not defined'     ) unless $Config{ Object }{ key };
    &DrDie( 'engine path is not defined'  ) unless $Config{ Object }{ enginepath };
    &DrDie( 'bases path is not defined'   ) unless $Config{ Object }{ virusbase };
    &DrDie( 'update path is not defined!' ) unless $Config{ Object }{ updatepath };
    
    $Config{ Paths }{ bases } =
        -d $Config{ Object }{ virusbase } ?
            &Dirname( $Config{ Object }{ virusbase } . '/' )
        :
            &Dirname( $Config{ Object }{ virusbase } )
    ;
    $Config{ Paths }{ update } = &Dirname( $Config{ Object }{ updatepath } . '/' );
    $Config{ Paths }{ drl } = &Dirname( $Config{ Self }{ customdrlfile } or $Config{ Self }{ drlfile } );

    &Log( 'verbose', "Path to bases   : $Config{ Paths }{ bases }" );
    &Log( 'verbose', "Path to URL list: $Config{ Paths }{ drl }" );

    return \%Config;
}

#-----------------------------------------------------------------------------
# IN (REF_HASH): configuration of updater
# OUT: no
sub DumpConfiguration
{
    my $Conf = shift;
    &Log( 'debug', 'following configuration has been loaded:' );
    foreach my $sec ( sort keys %{ $Conf } )
    {
        &Log( 'debug', "Section($sec)" );
        foreach my $key ( sort keys %{ $Conf->{$sec} } ) {
            if ( defined( $Conf->{$sec}{$key} ) ) {
                &Log( 'debug', "  Name($key) Value($Conf->{$sec}{$key})" );
            } else {
                &Log( 'debug', "  Name($key) Value(undef)" );
            }
        }
    }
}

#-----------------------------------------------------------------------------
# IN (REF_HASH): configuration of updater
# OUT(ARRAY) : reference to array of core URLs, reference to array of URLs of plugins
sub BuildURLs
{
    my $Conf = shift;
    my $CUSTOMURLS = [];
    my $STDURLS = [];
    my $COREURLS = [];
    my $PLUGINURLS = [];

    unless( 'yes' eq lc $Conf->{ Self }{ updatepluginsonly } ) {
        push @{$COREURLS}, $CUSTOMURLS
            if &ReadDrl( $CUSTOMURLS, $Conf->{Self}{signedreader}, $Conf->{Self}{customdrlfile}, 'custom' );
        &ReadDrl( $STDURLS, $Conf->{Self}{signedreader}, $Conf->{Self}{drlfile},  'Dr.Web' );
        if( 0 == scalar @{$STDURLS} ) {
            &Log( 'warning', "no valid URL has been read, guessing binary version of $Conf->{Self}{section}" );
            my $verURLpart = '';
            my $sys = new FileHandle;
            if ( open $sys, "$Conf->{Self}{programpath} |" ) {
                if ( <$sys> =~ / v(\d+)\.(\d+)/ ) {
                    &Log( 'debug', "$Conf->{Self}{programpath}: version $1.$2 guessed" );
                    $verURLpart = "/$1$2";
                } else {
                    &Log( 'error', "$Conf->{Self}{programpath}: obfuscated version" );
                }
            } else {
              &Log( 'error', "can't fork $Conf->{Self}{programpath}, no version guessed" );
            }
            &Log( 'warning', "using default: $DefaultURL$verURLpart" );
            push @{$STDURLS}, $DefaultURL.$verURLpart;
        }
        push @{$COREURLS}, $STDURLS;
        @{$CUSTOMURLS} ?
            &Log( 'info', 'custom update servers: ' . join( ', ', @{$CUSTOMURLS} ) ) :
            &Log( 'info', 'no custom update servers' );
        &Log( 'info', 'main update servers: ' . join( ', ', @{$STDURLS} ) );
    }

    unless ( -d $Conf->{Self}{drldir} ) {
        &Log( 'info', 'drldir not found: "' . $Conf->{Self}{drldir} .
            '", assuming there are no plugins to update' );
        return ( $COREURLS, $PLUGINURLS );
    } else {
        my %drl;
        foreach my $drl ( sort glob quotemeta( $Conf->{Self}{drldir} ) . '/*.drl' ) {
            $drl =~ m/.+\/(.+?)\.(custom\.)?drl$/;
            $drl{ $1 }[ !defined $2 ] = $drl;
        }
        foreach my $drl ( sort keys %drl ) {
            my $plugin_urls = [];
            foreach my $i ( 0 .. 1 ) {
                &Log( 'info', 'no ' . [ 'custom', 'main' ]->[ $i ] . ' URLs for plugin ' . $drl ), next unless defined $drl{ $drl }[ $i ];
                my $url_list = [];
                if ( &ReadDrl( $url_list, $Conf->{Self}{signedreader}, $drl{ $drl }[ $i ], ( ( !$i and 'custom ' ) or '' ) . 'plugin ' . $drl ) ) {
                    &Log( 'info', 'no ' . [ 'custom', 'main' ]->[ $i ] . ' URLs for plugin ' . $drl ), next unless defined( $url_list ) and @{$url_list};
                    push @{$plugin_urls}, $url_list;
                    &Log( 'info', 'plugin ' . $drl . ' ' . [ 'custom', 'main' ]->[ $i ] . ' URLs are: ' . join( ', ', @{$url_list} ) );
                }
            }
            push @{$PLUGINURLS}, { $drl => $plugin_urls } if ( @{$plugin_urls} );
        }
        unless ( @{$PLUGINURLS} ) {
             &Log( 'info', 'no plugins\' URLs found' );
        }
    }

    return ( $COREURLS, $PLUGINURLS );
}

#-----------------------------------------------------------------------------
# IN (REF_HASH): configuration of updater
# IN (REF_ARRAY): list of updates servers
# IN (REF_SCALAR): update task
# OUT(HASH) :    update task
sub Update
{
    my ( $Config, $URLSARRAY, $LstTask ) = @_;

    my $URL = '';
    my $lines = 0;
    my $DrLst;
    my $StartTime = localtime;

    foreach my $URLS ( @{$URLSARRAY} ) {
        my $count;
        while( ($count = scalar @{$URLS}) > 0 )
        {
            $DrLst = '';
	    ${$LstTask} = {};
            my $key = int rand $count;
	    ${$LstTask}->{process}{URL} = $URL = $URLS->[$key];
            &Log( 'info', "Attempting to fetch $URL/drweb32.lst ..." );
            my $pipe = new FileHandle;
	    if ( not &GetHttpFile($Config,${$LstTask}->{process},"drweb32.lst",\$DrLst))
            {
		&Log( 'warning', "failed to download $URL/drweb32.lst ($!)" );
            }
            if( not $DrLst )
	    {
            	&Log( 'warning', "cannot fetch $URL/drweb32.lst" );
            	$URLS->[$key] = $URLS->[0];
            	shift @{$URLS};
	    } else {
          	&Log( 'verbose', length($DrLst)." bytes received from $URL/drweb32.lst." );
	    	&Log( 'debug', "using ${$LstTask}->{process}{URL} for downloading updates ..." );
		&ParseLst($Config,\$DrLst,${$LstTask});
                my $hooks = $Config->{ Self }{ hooks };
                my $filter_task = sub {};
                $filter_task = $hooks->{ filter_task } if exists $hooks->{ filter_task };
                $filter_task->( $Config, ${$LstTask} );
		&Log( 'verbose', 'downloading notifications ...' );
		if ( not &DownloadFiles( \%{${$LstTask}->{notify}}, \%{${$LstTask}->{new_notify}}, 0, ${$LstTask}->{process}, $Conf ) )
		{
			&Log( 'error', "failed to download notifications from $URL" );
			$URLS->[$key] = $URLS->[0];
			shift @{$URLS};
			next;
		}
		&Log( 'verbose', 'downloading updated files ...' );
		if ( not &DownloadFiles( \%{${$LstTask}->{update}}, \%{${$LstTask}->{new}}, 1, ${$LstTask}->{process}, $Conf ) )
		{
			&Log( 'error', "failed to download updated files from $URL" );
			$URLS->[$key] = $URLS->[0];
			shift @{$URLS};
			next;
		}
		&Log( 'verbose', 'downloading new/updated files ...' );
		if ( not &DownloadFiles( \%{${$LstTask}->{add}}, \%{${$LstTask}->{new}}, 0, ${$LstTask}->{process}, $Conf ) )
		{
			&Log( 'error', "failed to download new/updated files from $URL" );
			$URLS->[$key] = $URLS->[0];
			shift @{$URLS};
			next;
		}
		&CloseSocket($Config,${$LstTask}->{process}) if ${$LstTask}->{process}{socket};
		${$LstTask}->{process}{StartTime} = $StartTime;
		${$LstTask}->{process}{EndTime} = localtime;

		&Log( 'verbose', 'deleting old files ...' );
		${$LstTask}->{deleted}=[];
		&RemoveFiles( [ sort keys %{${$LstTask}->{remove}}], $Conf, 1, ${$LstTask}->{deleted} );
		&Log( 'verbose', 'moving downloaded files from temporary to working directory ...' );
		&Log( 'debug', "Following files will be added: ".join( ', ', sort keys %{${$LstTask}->{new}} ) );
		${$LstTask}->{moved}=[];
		&MoveFiles( \%{${$LstTask}->{new}}, ${$LstTask}->{moved} );
		&Log( 'debug', "Following notifications will be added: ".join( ', ', sort keys %{${$LstTask}->{new_notify}} ) );
		${$LstTask}->{moved_notify}=[];
		&MoveFiles( \%{${$LstTask}->{new_notify}}, ${$LstTask}->{moved_notify} );

		&Log( 'verbose', 'sending notifications ...' );

		&SendNotify( $_, $Conf ) foreach ( sort keys %{${$LstTask}->{new_notify}} );
		last;
	    }
	}
	last unless ( lc($Conf->{Self}{fallbacktodrl}) eq 'yes' and not $DrLst );
    }
    &DrDie( 'cannot fetch drweb32.lst from known updates servers.' ) unless $DrLst;
    return 1;
}

#-----------------------------------------------------------------------------
# IN (REF_HASH): configuration of updater
# IN (REF_ARRAY) : drweb32.lst lines 
# IN (REF_HASH)  : update task
sub ParseLst {
    my ( $Config, $DrList, $Task ) = @_;
    &Log( 'debug', "ParseLst has been called ..." );

    foreach my $UpdateLine ( split /\r?\n/, $$DrList ) {
        my ( $op, undef, $platform, $filename, $crc, $api ) =
	    ( $UpdateLine =~ /^([\-\+\=\@])(<(\w[\w\*\.\-\/]*)>)?(\w[\w\*\.\-\/]*)[, \t]*([a-fA-F\d]*)[, \t]*(\d+\.\d+)?/o )
		or next;          # skip malformed lines
        $api = '' unless $api;
	$platform = '' unless $platform;
        chomp( $filename, $crc, $api );
        &Log( 'debug', 'UpdateLine: ' . $UpdateLine );
        &Log( 'debug', 'UpdateTask: operation = ' . $op . ', file = ' . $filename . ', CRC = ' . $crc . ', API = ' . $api . ', platform = ' . $platform );
	if ( $platform and $platform ne lc $^O ) {
	    &Log( 'verbose', 'wrong platform, skipping insertion to tasklist...' );
	    next;
	}
	if ( $Config->{ Self }{ skipengine } eq 'yes' and IsEngine( $filename ) )
	{
	    &Log( 'verbose', $filename . ' is engine, skipping insertion to tasklist...' );
	    next;
	}
        if ( $op ne '' and $filename ne '' )
        {
            # remove all previous entries of a file
	    delete $Task->{ $_ }{ $filename } foreach ( keys %{ $Task } );
            $Task->{ remove }{ $filename } = hex( $crc || '' ) || '', next
                if( $op eq '-' );
            local $SIG{__WARN__} = sub { &DrDie( join( "\n" => ( 'Bogus CRC32 for ' . $filename . ': "' . ( defined( $crc )? $crc : 'undef' ) . '"', 'Perl diagnostics is:', @_ ) ) ) };
            $Task->{ update }{ $filename } = hex( $crc ), next
                if( $op eq '=' );
            $Task->{ add    }{ $filename } = hex( $crc ), next
                if( $op eq '+' );
            $Task->{ notify }{ $filename } = hex( $crc ), next
                if( $op eq '@' );
        }
    }
    my $comparator = sub {
        my $a_class = ( $a =~ m/[*?]/ ) || 0;
        my $b_class = ( $b =~ m/[*?]/ ) || 0;
        return
            ( ( $b_class <=> $a_class ) or ( $a cmp $b ) );
    };
    &Log( 'debug', 'Following files will be deleted: ' . join( ', ' => sort $comparator keys %{ $Task->{ remove } } ) );

    my $max_filename_length = 0;
    foreach my $filename ( keys( %{ $Task->{ update } } ), keys( %{ $Task->{ add } } ), keys( %{ $Task->{ notify } } ) ) {
        $max_filename_length = length( $filename ) if length( $filename ) > $max_filename_length;
    }
    my $format = '  file = %' . $max_filename_length . 's, CRC = %8X';

    &Log( 'debug', 'Following files will be updated:' );
    &Log( 'debug', sprintf( $format => $_, $Task->{ update }{ $_ } ) ) foreach ( sort $comparator keys %{ $Task->{ update } } );

    &Log( 'debug', 'Following files will be installed/updated:' );
    &Log( 'debug', sprintf( $format => $_, $Task->{ add    }{ $_ } ) ) foreach ( sort $comparator keys %{ $Task->{ add    } } );

    &Log( 'debug', 'Following notifications will be updated:' );
    &Log( 'debug', sprintf( $format => $_, $Task->{ notify }{ $_ } ) ) foreach ( sort $comparator keys %{ $Task->{ notify } } );
}

#-----------------------------------------------------------------------------
# IN (REF_HASH): configuration of updater
# IN (REF_HASH)  : update task
sub FlyTrapPreprocessTask {
    my ( $Config, $LstTask ) = @_;
    &Log( 'debug', 'preprocessing update task for FlyTrap(R)...' );
    my $fd = new FileHandle;
    open( $fd, "<$Config->{ Object }{ ftsetupcfgpath }" )
        or &DrDie( "cannot open FlyTrap(R) configuration file $Config->{ Object }{ ftsetupcfgpath } ($!)" );
    my $filepath_to_last;
    my $line;
    while ( defined( $line = <$fd> ) ) {
        chomp $line;
        $line =~ s/^\s+//;
        $line =~ s/\s+$//;
        my ( $key, $value ) = split /\s*=\s*/, $line, 2;
        for ( $key ) {
            /^update$/i && do {
                $value =
                    -d $value ?
                        &Dirname( $value . '/' )
                    :
                        &Dirname( $value )
                ;
                $Config->{ Paths }{ flytrap } = $value;
                last;
            };
            /^dime_copy$/i && do {
                $value =
                    -d $value ?
                        &Dirname( $value . '/' )
                    :
                        &Dirname( $value )
                ;
                $filepath_to_last = $value . 'last';
                last;
            };
        }
    }
    close( $fd );
    &DrDie( 'Path to FlyTrap(R) updates not found!' ) unless exists $Config->{ Paths }{ flytrap };
    &DrDie( 'Path to FlyTrap(R) \'last\' update status file not found!' ) unless defined $filepath_to_last;
    &DrDie( 'FlyTrap(R) \'last\' update status file does not exist or is not readable!' ) unless -f $filepath_to_last and -r $filepath_to_last;
    &Log( 'verbose', "Path to FlyTrap(R) updates : $Config->{ Paths }{ flytrap }" );
    &Log( 'verbose', "Path to FlyTrap(R) 'last' update status file : $filepath_to_last" );
    $fd = new FileHandle;
    open( $fd, "<$filepath_to_last" )
        or &DrDie( "cannot open FlyTrap(R) 'last' update status file $filepath_to_last ($!)" );
    $line = <$fd>;
    chomp $line;
    my @last = ( $line =~ m/^\d{4}END\s+\d{2}\.\d{2}\.\d{6}:\d{2}:\d{2}[0]{9}(\d{3})0(\d{3})0(\d{3})/ );
    close( $fd );
    &Log( 'debug', 'Last updates in FlyTrap(R) database: ' . join( ', ' => map { 'class ' . $_ . ' - ' . $last[ $_ - 1 ] } ( 1 .. @last ) ) . '.' );
    my $updates = [ [], [], [] ];
    foreach my $filename ( sort keys %{ $LstTask->{ add } } ) {
        next unless IsFlyTrapUpdate( $filename );
        my ( $update_class, $update_number ) = ( $filename =~ m/\bu\d{4}-([123])(\d{3})$/ );
        $update_class--;
        &Log( 'debug', $filename . ' is eliminated from task list (installed already)' ), delete( $LstTask->{ add }{ $filename } ), next
            unless $update_number > $last[ $update_class ];
        push @{ $updates->[ $update_class ] }, $update_number;
    }
    my $update_class = 1;
    foreach ( @$updates ) {
        next unless @$_;
        @$_ = sort @$_;
        next if ( @$_ == ( $_->[ -1 ] - $_->[ 0 ] + 1 ) ) and ( $_->[ 0 ] == ( $last[ $update_class - 1 ] + 1 ) );
        &Log( 'warning', 'FlyTrap(R) updates with class ' . $update_class . ' are not eligible at the moment (update numbers ' . join( ', ' => @$_ ) . ' are not consecutive)' );
        foreach my $filename ( sort keys %{ $LstTask->{ add } } ) {
            next unless $filename =~ m/\bu\d{4}-$update_class\d{3}$/;
            &Log( 'warning', $filename . ' is eliminated from task list (to avoid installation errors)' ), delete( $LstTask->{ add }{ $filename } );
        }
    } continue {
        $update_class++;
    }
    &Log( 'debug', 'update task for FlyTrap(R) has been preprocessed' );
}

#-----------------------------------------------------------------------------
# IN (HASH)  : updater configuration
# IN (HASH)  : update task
# OUT: no
sub ViewSummary
{
    my ($Conf, $Task) = @_;

    &Log( 'debug', "ViewSummary() has been called ..." );
    if( lc($Conf->{Self}{cronsummary}) eq 'yes' and $Task )
    {
        my $n_new = exists $Task->{moved} ? scalar @{$Task->{moved}} : 0;
        my $n_rm  = exists $Task->{deleted} ? scalar @{$Task->{deleted}} : 0;
        my $n_not = exists $Task->{moved_notify} ? scalar @{$Task->{moved_notify}} : 0;
        &Log( 'verbose', "summary => updated: $n_new, removed: $n_rm files and $n_not messages" );
        if( $n_new != 0 or $n_rm != 0 or $n_not != 0 )
        {
            print "Dr.Web (R) update details:\n";
            print "Update server: ".$Task->{process}{URL}."\n";
            print "Update has begun at ".$Task->{process}{StartTime}."\n";
            print "Update has finished at ".$Task->{process}{EndTime}."\n";
            print "\n";
            print "Following files has been updated:\n\t".join("\n\t", @{$Task->{moved}} )."\n"
                if $n_new ne '0';
            print "Following files has been removed:\n\t".join("\n\t", @{$Task->{deleted}} )."\n"
                if $n_rm ne '0';
            print "Following notifications has been sent:\n\t".join("\n\t", @{$Task->{moved_notify}} )."\n"
                if $n_not ne '0';
            print "\n";
        }
    }
}

#-----------------------------------------------------------------------------
# IN (HASH)  : updater configuration
# IN (HASH)  : update task
# OUT: (REF_CODE) : reference to anonymous subroutine performing daemon reload
sub ReloadDaemon
{
    my ($Conf, $Task) = @_;

    my $pidFile = $Conf->{Object}{pidfile};
    &Log( 'debug', "ReloadDaemon($pidFile) has been called ..." );
    
    return undef if $Conf->{Self}{section} ne 'daemon';
    
    foreach (@{$Task->{moved}},@{$Task->{deleted}}) {
	if (&IsBase($_) or $_ eq $Conf->{Object}{enginepath} or $_ eq $Conf->{Object}{pathtovaderetro} ) {
	    if( -e $pidFile )
	    {
	        open( FH, "$pidFile" )
		    or &DrDie("cannot open $pidFile ($!) for reloading daemon");
		my $pid = <FH> || '';
		close( FH );
		chomp( $pid );
                return sub {
                    kill 'HUP', $pid
		        or &DrDie("cannot send HUP signal to daemon (pid=$pid, error=$!)");
		    &Log( 'warning', 'signal HUP has been sent to Dr.Web (R) daemon ...' );
                } if ( $pid );
	    }
            else
	    {
		&Log( 'warning', "daemon pidfile $pidFile does not exist or unaccessible" );
	    }
	    last;
	}
    }
    return undef;
}

#-----------------------------------------------------------------------------
# IN (HASH)  : updater configuration
# IN (HASH)  : update task
# OUT: (REF_CODE) : reference to anonymous subroutine performing daemon reload
sub ReloadMaild
{
    my ($Conf, $Task) = @_;

    my $maildPidFile = $Conf->{Object}{maildpidfile};
    &Log( 'debug', "ReloadMaild($maildPidFile) has been called ..." );
    
    return undef if ( $Conf->{Self}{section} ne 'daemon' or ! -f $maildPidFile );
    
    foreach (@{$Task->{moved}},@{$Task->{deleted}}) {
	if ( $_ eq $Conf->{Object}{pathtovaderetro} ) {
	    if( -e $maildPidFile )
	    {
	        open( FH, "$maildPidFile" )
		    or &DrDie("cannot open $maildPidFile ($!) for reloading drweb-maild");
		my $pid = <FH>;
		close( FH );
		chomp( $pid );
                return sub {
                    kill 'HUP', $pid
		        or &DrDie("cannot send HUP signal to drweb-maild (pid=$pid, error=$!)");
		    &Log( 'warning', 'signal HUP has been sent to drweb-maild ...' );
                };
	    }
            else
	    {
		&Log( 'error', "drweb-maild pidfile $maildPidFile does not exist or unaccessible" );
	    }
	    last;
	}
    }
    return undef;
}

### Parsers ###################################################################
# IN (STRING)      : line for parsing
# IN (REF_HASH)    : hash for parsed values
# OUT: no
#------------------------------------------------------------------------------
sub ParseLineStd
{
    my( $line, $ref_hash ) = @_;

    my( $name, $value ) = split /=/, $line, 2;
    $name =~ s/[\t ]*$//g;
    $name = lc($name);
    return unless exists $ref_hash->{$name};

    if( defined $value and $value ne '' )
    {
        ( $value ) = split /\,/, $value, 2;
        $value =~ s/^[\"\t ]*//g;
        $value =~ s/[\"]*$//g;
    }
    else
    {
        $value = '';
    }
    $ref_hash->{$name}=$value;
    &Log( 'debug', "ParseStdLine return(name=<$name> value=<$value>)" );
}

#-----------------------------------------------------------------------------
# IN (REF_HANDLE)  : file-stream for parsing
# IN (STRING)      : name of section
# IN (STRING)      : set of comment chars
# IN (REF_HASH)    : hash for parsed values
# IN (REF_FUNCTION): line parsing function
# OUT(BOOL)        : was the section found ?
sub ParseSection
{
    my ( $ref_handle, $section, $comments, $ref_hash, $ParseLine ) = @_;
    my $is_my_section = 0;
    my $found = 0;

    &Log( 'debug', "ParseSection($section,$comments) has been called ..." );
    local $_;
    while( <$ref_handle> )
    {
        # Perl Cookbook
        chomp;
        if ( s/\\$// ) {
            $_ .= <$ref_handle>;
            redo unless eof $ref_handle;
        }
        s/[$comments].*//;
        s/^\s+//;
        s/\s+$//;
        next unless length;

        $is_my_section = ( lc( $1 ) eq $section ), next if /^\[[ \t]*(.+?)[ \t]*\]$/;
        next unless $is_my_section;
        $found = 1;

        $ParseLine->($_, $ref_hash);
    }
    &Log( 'debug', "ParseSection($section,$comments) return( $found )" );
    return $found;
}

### LOG ######################################################################
#-----------------------------------------------------------------------------
# IN (STRING): log level
# IN (STRING): filename of log
# OUT: no
sub OpenLog
{
    my ($Level, $Facility, $File) = @_;
    $LogLevel = $Levels{$Level}[0];
    return unless $LogLevel;
    unless( 'syslog' eq $File ) {
        unless ( open LOGHANDLE, ">>$File" ) {
          my $program = $0;
          1 while $program =~ s!.+/!!g;
          openlog( $program, 'pid', $Facility );
          syslog( 1, '%s', 'Dr.Web (R) Updater ($Revision: 1.156.2.3 $) error: cannot open logfile '.$File.' for appending - '.$! );
          closelog;
          $mutelog = 1;
        }
    } else {
        my $program = $0;
        1 while $program =~ s!.+/!!g;
        openlog( $program, 'pid', $Facility );
        $syslog = 1;
    }
}

#-----------------------------------------------------------------------------
# IN : no
# OUT: no
sub CloseLog {
    return if $mutelog;
    closelog if $syslog;
    return unless $LogLevel;
    close LOGHANDLE;
    $log_cache = [] unless 'main::DrDie' eq ( ( caller( 1 ) )[ 3 ] or '' );
}

#-----------------------------------------------------------------------------
# IN (STRING): error message
# OUT: no
sub DrDie {
    my $error = shift;
    &Log( 'error', $error );
    if ( $Task and $Conf ) {
        my $temppath = $Conf->{Object}{temppath};
	unlink <$temppath/*>;
	&ViewSummary($Conf,$Task);
    }
    &Unlock();
    &CloseLog();
    print "See Dr.Web (R) Updater log file for details.\n" unless $log_cache;
    exit 1;
}

### Key utils ################################################################
#-----------------------------------------------------------------------------
# IN (STRING): filename of key
# OUT(ARRAY) : pair (generator version, user number)
sub ReadKeyFile
{
    my $file = shift;

    &Log( 'debug', "ReadKeyFile($file) has been called ..." );

    my $fd = new FileHandle;
    open( $fd, "$file" )
        or &DrDie("cannot open the key file $file ($!) for reading");

    my %KeyParam = (
                    gv     => '',
                    number => '',
    );

    &ParseSection( $fd, 'user', ';', \%KeyParam ,\&ParseLineStd )
        or &DrDie("cannot find [User] section in key $file - invalid key");

    close $fd;

    &Log( 'debug', "ReadKeyFile($file) return( $KeyParam{gv}, $KeyParam{number} )" );

    return ( $KeyParam{gv}, $KeyParam{number} );
}

#----------------------------------------------------------------------------
# IN (STRING): filename of key
# OUT(ARRAY) : pair (md5 of key, user number)
sub ParseKey
{
    my ($Conf,$keyFile) = ($_[0],$_[0]->{Object}{key});
    unless ( -f $keyFile ) {
        my $fd = new FileHandle;
        my $file = $Conf->{Object}{agentconfpath};
        open( $fd, $file )
          or &DrDie( "trying to obtain drweb key file path from drweb-agent configuration file as a last resort. Cannot open drweb-agent configuration file $file for reading: $!" );
        my %LicenseFile = ( licensefile => '' );
        &ParseSection( $fd, 'standalonemode', '#;', \%LicenseFile, \&ParseLineStd )
          or &DrDie( "cannot find [StandaloneMode] section in drweb-agent configuration file $file" );
        close $fd;
        $keyFile = $LicenseFile{licensefile} or &DrDie( 'key file not found' );
    }

    &Log( 'debug', "ParseKey($keyFile) has been called ..." );


    $Conf->{Self}{md5sum} = &FindMD5;
    ( $Conf->{Self}{genver}, $Conf->{Self}{key_num} ) = &ReadKeyFile($keyFile);

    $Conf->{Self}{key_md5} = `$Conf->{Self}{md5sum} $keyFile`;
    chomp $Conf->{Self}{key_md5};
    $Conf->{Self}{key_md5} =~ s/\-//go;
    $Conf->{Self}{key_md5} =~ s/(.*)([0-9a-fA-F]{32})(.*)/$2/o;
    &DrDie( "cannot get md5 sum of $keyFile" ) if $Conf->{Self}{key_md5} eq '';

    &Log( 'debug', "ParseKey($keyFile) return(  $Conf->{Self}{key_md5}, $Conf->{Self}{key_num} )" );
    return ( $Conf->{Self}{key_md5}, $Conf->{Self}{key_num} );
}


### Utils ###################################################################
#----------------------------------------------------------------------------
# IN : no
# OUT(STRING): path to md5
sub FindMD5
{
    my $md5sum = &Which("md5sum");
    if( not $md5sum )
    {
	$md5sum = &Which("md5");
	&DrDie( 'The md5sum or md5 utilities are not found in ('.$ENV{PATH}.')' ) unless $md5sum;
	&Log( 'verbose', 'md5 found in: '.$md5sum );
    } else {
	&Log( 'verbose', 'md5sum found in: '.$md5sum );
    }
    &Log( 'debug', "FindMD5: return ($md5sum)" );
    return $md5sum;
}

#-----------------------------------------------------------------------------
# IN (STRING)  : path to file
# OUT(STRING)  : filename
sub Basename {
    my $path = shift;
    $path =~ s!.+/!!o;
    return $path;
}

#-----------------------------------------------------------------------------
# IN (STRING)  : path
# OUT(STRING)  : dirname
sub Dirname {
    my $path = shift;
    -d $path or $path =~ s!/[^/]*$!!;
    $path =~ s!/*$!/!;
    return $path;
}

#-----------------------------------------------------------------------------
# IN (STRING)  : filename
# IN (REF_HASH): updater configuration
# OUT(STRING)  : path to file
sub FullPath {
    my ( $file, $conf ) = @_;
    &Log( 'debug', 'FullPath( ' . $file . ' ) has been called...' );
    my $path = 
      &IsFlyTrapUpdate( $file ) ? ( $conf->{ Paths  }{ flytrap } . $file ) :
      &IsBase(          $file ) ? ( $conf->{ Paths  }{ bases   } . $file ) :
      &IsUpdateDrl(     $file ) ?   $conf->{ Self   }{ drlfile }         :
      &IsEngine(        $file ) ?   $conf->{ Object }{ enginepath }      :
      &IsVadeRetro(     $file ) ?   $conf->{ Object }{ pathtovaderetro } :
      &IsDrl(           $file ) ? ( $conf->{ Paths  }{ drl } . $file )   :
      ( &IsUpdater(     $file ) &&
        ( 'yes' eq lc( $conf->{ Self }{ updateself } ) ) )
                            ? $conf->{ Paths }{ self }      :
                            ( $conf->{ Paths }{ update } . $file )   ;
    &Log( 'debug', 'FullPath( ' . $file . ' ) return( ' . $path . ' )' );
    return $path;
}

#----------------------------------------------------------------------------
# IN (STRING): filename
# OUT(SCALAR): crc32 of filename
sub Crc32
{
    my $function;
    if (eval { local $SIG{__DIE__}; require Compress::Zlib })
    {
	require Compress::Zlib;

    	$function = sub
	{
            my $file = shift;

	    my ($c,$s);
	    if( !sysopen( F, $file,O_RDONLY ) )
	    {
		&Log( 'error', "cannot open $file ($!) for calculating CRC32" );
		return 0x0;
    	    }

	    while( sysread F, $s, 10240 )
	    {
		$c = &Compress::Zlib::crc32($s,$c);
   	    }
    	    close( F );
	    &Log( 'debug', "CRC32( $file ) return( @{[ sprintf '%X', $c ]} )" );
	    return sprintf '%u', $c;
    	}
    }
    else
    {
	$function = sub
	{
	    my $file = shift;
	    &Log( 'debug', "CRC32($file) has been called ..." );
	    if( !sysopen( F, $file,O_RDONLY ) )
	    {
		&Log( 'error', "cannot open $file ($!) for calculating CRC32" );
		return 0x0;
	    }
	    my $n = 0;
	    my $c = 0xffffffff;
	    my @crc32table =
		(
		0x00000000, 0x77073096, 0xee0e612c, 0x990951ba, 0x076dc419,
		0x706af48f, 0xe963a535, 0x9e6495a3, 0x0edb8832, 0x79dcb8a4,
		0xe0d5e91e, 0x97d2d988, 0x09b64c2b, 0x7eb17cbd, 0xe7b82d07,
		0x90bf1d91, 0x1db71064, 0x6ab020f2, 0xf3b97148, 0x84be41de,
		0x1adad47d, 0x6ddde4eb, 0xf4d4b551, 0x83d385c7, 0x136c9856,
		0x646ba8c0, 0xfd62f97a, 0x8a65c9ec, 0x14015c4f, 0x63066cd9,
		0xfa0f3d63, 0x8d080df5, 0x3b6e20c8, 0x4c69105e, 0xd56041e4,
		0xa2677172, 0x3c03e4d1, 0x4b04d447, 0xd20d85fd, 0xa50ab56b,
		0x35b5a8fa, 0x42b2986c, 0xdbbbc9d6, 0xacbcf940, 0x32d86ce3,
		0x45df5c75, 0xdcd60dcf, 0xabd13d59, 0x26d930ac, 0x51de003a,
		0xc8d75180, 0xbfd06116, 0x21b4f4b5, 0x56b3c423, 0xcfba9599,
		0xb8bda50f, 0x2802b89e, 0x5f058808, 0xc60cd9b2, 0xb10be924,
		0x2f6f7c87, 0x58684c11, 0xc1611dab, 0xb6662d3d, 0x76dc4190,
		0x01db7106, 0x98d220bc, 0xefd5102a, 0x71b18589, 0x06b6b51f,
		0x9fbfe4a5, 0xe8b8d433, 0x7807c9a2, 0x0f00f934, 0x9609a88e,
		0xe10e9818, 0x7f6a0dbb, 0x086d3d2d, 0x91646c97, 0xe6635c01,
		0x6b6b51f4, 0x1c6c6162, 0x856530d8, 0xf262004e, 0x6c0695ed,
		0x1b01a57b, 0x8208f4c1, 0xf50fc457, 0x65b0d9c6, 0x12b7e950,
		0x8bbeb8ea, 0xfcb9887c, 0x62dd1ddf, 0x15da2d49, 0x8cd37cf3,
		0xfbd44c65, 0x4db26158, 0x3ab551ce, 0xa3bc0074, 0xd4bb30e2,
		0x4adfa541, 0x3dd895d7, 0xa4d1c46d, 0xd3d6f4fb, 0x4369e96a,
		0x346ed9fc, 0xad678846, 0xda60b8d0, 0x44042d73, 0x33031de5,
		0xaa0a4c5f, 0xdd0d7cc9, 0x5005713c, 0x270241aa, 0xbe0b1010,
		0xc90c2086, 0x5768b525, 0x206f85b3, 0xb966d409, 0xce61e49f,
		0x5edef90e, 0x29d9c998, 0xb0d09822, 0xc7d7a8b4, 0x59b33d17,
		0x2eb40d81, 0xb7bd5c3b, 0xc0ba6cad, 0xedb88320, 0x9abfb3b6,
		0x03b6e20c, 0x74b1d29a, 0xead54739, 0x9dd277af, 0x04db2615,
		0x73dc1683, 0xe3630b12, 0x94643b84, 0x0d6d6a3e, 0x7a6a5aa8,
		0xe40ecf0b, 0x9309ff9d, 0x0a00ae27, 0x7d079eb1, 0xf00f9344,
		0x8708a3d2, 0x1e01f268, 0x6906c2fe, 0xf762575d, 0x806567cb,
		0x196c3671, 0x6e6b06e7, 0xfed41b76, 0x89d32be0, 0x10da7a5a,
		0x67dd4acc, 0xf9b9df6f, 0x8ebeeff9, 0x17b7be43, 0x60b08ed5,
		0xd6d6a3e8, 0xa1d1937e, 0x38d8c2c4, 0x4fdff252, 0xd1bb67f1,
		0xa6bc5767, 0x3fb506dd, 0x48b2364b, 0xd80d2bda, 0xaf0a1b4c,
		0x36034af6, 0x41047a60, 0xdf60efc3, 0xa867df55, 0x316e8eef,
		0x4669be79, 0xcb61b38c, 0xbc66831a, 0x256fd2a0, 0x5268e236,
		0xcc0c7795, 0xbb0b4703, 0x220216b9, 0x5505262f, 0xc5ba3bbe,
		0xb2bd0b28, 0x2bb45a92, 0x5cb36a04, 0xc2d7ffa7, 0xb5d0cf31,
		0x2cd99e8b, 0x5bdeae1d, 0x9b64c2b0, 0xec63f226, 0x756aa39c,
		0x026d930a, 0x9c0906a9, 0xeb0e363f, 0x72076785, 0x05005713,
		0x95bf4a82, 0xe2b87a14, 0x7bb12bae, 0x0cb61b38, 0x92d28e9b,
		0xe5d5be0d, 0x7cdcefb7, 0x0bdbdf21, 0x86d3d2d4, 0xf1d4e242,
		0x68ddb3f8, 0x1fda836e, 0x81be16cd, 0xf6b9265b, 0x6fb077e1,
		0x18b74777, 0x88085ae6, 0xff0f6a70, 0x66063bca, 0x11010b5c,
		0x8f659eff, 0xf862ae69, 0x616bffd3, 0x166ccf45, 0xa00ae278,
		0xd70dd2ee, 0x4e048354, 0x3903b3c2, 0xa7672661, 0xd06016f7,
		0x4969474d, 0x3e6e77db, 0xaed16a4a, 0xd9d65adc, 0x40df0b66,
		0x37d83bf0, 0xa9bcae53, 0xdebb9ec5, 0x47b2cf7f, 0x30b5ffe9,
		0xbdbdf21c, 0xcabac28a, 0x53b39330, 0x24b4a3a6, 0xbad03605,
		0xcdd70693, 0x54de5729, 0x23d967bf, 0xb3667a2e, 0xc4614ab8,
		0x5d681b02, 0x2a6f2b94, 0xb40bbe37, 0xc30c8ea1, 0x5a05df1b,
		0x2d02ef8d
		);
            {
                no locale;
                use bytes;
                my $s;
                while ($n=sysread F, $s,10240) {
                    $c = $crc32table[ ( $c ^ ord( substr( $s, -$n--, 1 ) ) ) & 0xFF ] ^ ( $c >> 8 ) while $n;
                }
                $c = $c ^ 0xffffffff;
            }
            close( F );
            &Log( 'debug', "CRC32( $file ) return( @{[ sprintf '%X', $c ]} )" );
            return sprintf '%u', $c;
	}
    }
    return $function;
}

#----------------------------------------------------------------------------
# IN (ARRAY) : array for readed urls
# IN (STRING): filename of reader signed files
# IN (STRING): filename of URL list
# IN (STRING): name of URL list
# OUT(SCALAR): 1 - success, 0 - fail
sub ReadDrl
{
    my( $URLS, $SignedReader, $DRL, $comment ) = @_;

    if( $DRL eq '' )
    {
        &Log( 'verbose', "$comment URL list isn't defined" );
        return 0;
    }
    if( not -r $DRL )
    {
        &Log( 'warning', "$DRL: no such file or no permissions for reading $comment URL list" );
        return 0;
    }

    &Log( 'info', "try using $comment URL list ($DRL)" );
    @{$URLS} = (), return 0 unless &ReadSigned( $SignedReader, 'drl', $DRL, $URLS );

    if( 0 == scalar @{$URLS} )
    {
        &Log( 'warning', "no valid URL has been readed from $comment URL list ($DRL)" );
        return 0;
    }
    return 1;
}

#----------------------------------------------------------------------------
# IN (STRING): a signs mode
# IN (STRING): a filename of a signed file
# IN (ARRAY) : a reference on an array for a signed content
# OUT(SCALAR): 1 - success, 0 - fail
sub ReadSigned
{
    my ( $SignedReader, $mode, $file, $content ) = @_;

    &Log( 'verbose', "exec($SignedReader $mode $file) ..." );
    if( !open FH, "$SignedReader $mode $file 2>&1 |" )
    {
        &Log( 'error', "error during executing: $SignedReader $mode $file ($!)" );
        return 0;
    }
    while ( <FH> )
    {
        s/\r?\n$//; # remove \r\n, \n
        push @{$content}, $_;
    }
    if( !close FH  )
    {
        &Log( 'error', $! ? "exec($SignedReader $mode $file) closes pipe with status: $!"
                          : "exec($SignedReader $mode $file) exits with error #".($?>>8) );
        return 0;
    }
    return 1;
}

#----------------------------------------------------------------------------
# IN (HASH)  : Files for downloading
# IN (HASH)  : Downloaded files
# IN (SCALAR): update only ?
# IN (STRING): URL of update server
# IN (HASH)  : updater configuration
# OUT(SCALAR): 1 - success, 0 - fail
sub DownloadFiles
{
    my( $Files, $Downloaded, $UpdateOnly, $Process, $Config ) = @_;

    my ( $max_filename_length, $max_basename_length ) = ( ( 0 ) x 2 );
    foreach my $filename ( keys %{ $Files } ) {
        my $basename = &Basename( $filename );
        $max_filename_length = length( $filename ) if length( $filename ) > $max_filename_length;
        $max_basename_length = length( $basename ) if length( $basename ) > $max_basename_length;
    }
    my $filename_format = '%' . $max_filename_length . 's';
    my $basename_format = '%' . $max_basename_length . 's';
    foreach my $file ( sort keys %{ $Files } ) {
        my $file_pretty_print = sprintf( $filename_format, $file );
        my $crc;
        my $filename = &Basename($file);
        my $filename_pretty_print = sprintf( $basename_format, $filename );
        my $full = &FullPath( $filename, $Conf );
        if (
            1 == $UpdateOnly
            and
                (
                    !(
                        IsVadeRetro( $file )
                        or -e $full
                    )
                    or
                    (
                        IsVadeRetro( $file )
                        and ! -e $full . '.cache'
                    )
                )
            )
        {
            &Log( 'info', $full . ' for updating by ' . $file_pretty_print . 'doesn\'t exist, downloading skipped' );
            next;
        }
        if( ( IsVadeRetro( $file ) and -e $full . '.cache' and $Files->{$file} ne '' and $Files->{$file} eq &{$Crc32}( $full . '.cache' ) ) or ( -e $full and $Files->{$file} ne '' and $Files->{$file} eq &{$Crc32}($full) ) )
        {
            &Log( 'info', $filename_pretty_print . ' with such CRC32 already exists, downloading skipped' );
            next;
        }
	if( not $Downloaded->{$full} = &MkTemp( "$Conf->{Object}{temppath}/$filename.XXXXXXXX" ))
        {
            &Log( 'error', "cannot create a temporary file in $Conf->{Object}{temppath}");
            return 0;
        }
        &Log( 'debug', "$Process->{URL}/$file will be downloaded to $Downloaded->{$full} ..." );
        if( not &GetHttpFile($Config,$Process,$file,$Downloaded->{$full} ) )
        {
            &Log( 'error', 'cannot download ' . $file_pretty_print );
            unlink $Downloaded->{$full}
                or &Log( 'warning', "cannot delete temporary file $Downloaded->{$full} ($!)" );
	    delete $Downloaded->{$full};
            return 0;
        }
        $crc = &{$Crc32}( $Downloaded->{$full} );
        if( $Files->{$file} eq '' or $Files->{$file} == $crc )
        {
            &Log( 'info', $file_pretty_print . ' has been downloaded (CRC32=' . sprintf( '%8X', $crc ) . ')' );
            next;
        }
        &Log( 'error', 'cannot get ' . $file_pretty_print . ' with valid CRC32 (lst=' .
            sprintf( '%8X', $Files->{ $file } ) . ', actual=' .
            sprintf( '%8X', $crc              ) .                            ')'
        );
        unlink $Downloaded->{$full}
            or &Log( 'warning', "cannot delete temporary file $Downloaded->{$full} ($!)" );
	delete $Downloaded->{$full};
	return 0;
    }
    return 1;
}

#----------------------------------------------------------------------------
# IN (HASH): Files for moving
# IN (REF_ARRAY): Output array
# OUT: no
sub MoveFiles
{
    my ($Files,$moved) = @_;

    foreach my $file ( sort keys %{$Files} )
    {
        my $CopyDir=&Dirname($file);
        if( not -e $Files->{$file} )
        {
            &Log( 'error', "downloaded file $Files->{$file} does not exist" );
            delete $Files->{$file};
            next;
        }
	if( not defined $CopyDir or not -d $CopyDir )
        {
            &Log( 'error', "path $CopyDir does not exist. Cannot move $Files->{$file}" );
            next;
        }

        if ( ( stat $Files->{$file} )[0] != ( stat $CopyDir )[0] )
        {
            &Log( 'verbose', "copy $Files->{$file} to $file" );
            my ($error,$oldtempfile) = (0,$Files->{$file});
            if ( not open FH_FROM, "<$Files->{$file}" )
            {
                &Log( 'error', "cannot open temporary file $Files->{$file} ($!)" );
                delete $Files->{$file};
                next;
            }
            elsif ( not unlink $Files->{$file})
            {
                &Log( 'warning', "cannot unlink temporary file $Files->{$file} ($!)" );
                $error=1;
            }
            elsif ( not $Files->{$file} = &MkTemp( $file.".XXXXXXXX" ) )
            {
                &Log( 'error', "cannot create a temporary file in $CopyDir");
                $error=1;
            }
            elsif ( not open FH_TO, ">$Files->{$file}")
            {
                &Log( 'error', "cannot open temporary file $Files->{$file} ($!)" );
                $error=1;
            }
            else
            {
                my ($readed,$written,$tw,$buf);
                while ($readed=sysread FH_FROM, $buf, 10240) {
                    for ( $written=0,$tw=0 ; $written < $readed and defined $tw; $written += $tw )
                    {
                        $tw = syswrite(FH_TO, $buf, $readed - $written, $written )
                    }
                    last unless defined $tw;
                }
                if ( not defined $readed )
                {
                    &Log( 'warning', "cannot read temporary file $oldtempfile ($!)" );
                    $error=1;
                }
                elsif ( not defined $tw )
                {
                    &Log( 'warning', "cannot write temporary file $Files->{$file} ($!)" );
                    $error=1;
                }
                close FH_TO;
            }
            close FH_FROM;
            if ($error) {
                delete $Files->{$file};
                next;
            }
        }
        else
        {
            &Log( 'verbose', "move $Files->{$file} to $file" );
        }
        if ( not rename $Files->{$file}, $file )
        {

            &Log( 'error', "cannot move $Files->{$file} to $file: $!" );
            delete $Files->{$file};
            next;
        } else {
            my $now = time;
            utime $now, $now, $file or
            &Log( 'warning', "cannot touch $file" );
            if ( 0 == $> ) {
                &Log( 'verbose', 'Changing permissions on ' . $file . '. User ' .  $Conf->{ Object }{ user } . ', group ' . $Conf->{ Object }{ group } );
                chown( $Conf->{ Object }{ userid }, $Conf->{ Object }{ groupid }, $file ) or &Log( 'error', 'Unable to change permissions on ' . $file . ': ' . $! );
            }
	    push @{$moved}, $file if $moved;
        }
    }
}

#----------------------------------------------------------------------------
# IN (HASH): files for moving
# IN (HASH): updater configuration
# IN (SCALAR): do expansion
# OUT: no
sub RemoveFiles
{
    my $full;
    my ($list, $Conf, $expand, $deleted ) = @_;
    foreach my $file ( @{$list} )
    {
        if( $expand and $file =~ /\*/ )
        {
            my %Paths = reverse %{$Conf->{Paths}};
            my @files = map { glob( quotemeta( $_ ) . $file ) } keys %Paths;
            if ( not @files )
            {
                &Log( 'debug', "entry $file is a mask, no files selected");
                next;
            }
            &Log( 'debug', "entry $file is a mask, selected files: ".join(', ', @files) );
            &RemoveFiles(\@files, $Conf, 0, $deleted);
        }
        else
        {
            $full = $expand ? FullPath( $file, $Conf ) : $file;
            &Log( 'verbose', "file $file doesn't exist, it's deletion skipped" ), next unless -e $full;
            unlink $full or &Log( 'error', "cannot delete $full ($!)" ), next;
            push @{$deleted}, $full if $deleted;
        }
    }
}

#----------------------------------------------------------------------------
# IN (STRING): filename of message
# IN (HASH)  : updater configuration
# OUT: no
sub SendNotify
{
    my( $file, $Conf ) = @_;

    my $cmd = $Conf->{Object}{mailcommand};
    return if( $cmd eq '' );
    &Log( 'info', "sending information file($file) to $Conf->{Object}{mailcommand} ..." );
    $cmd =~ s/%S/"An information bulletin ($file) from Doctor Web Ltd."/g;

    my @Msg;
    return unless &ReadSigned( $Conf->{Self}{signedreader}, 'msg', $file, \@Msg );

    if( !open FH, "|$cmd" )
    {
        &Log( 'error', "error during executing: $cmd ($!)" );
        return 0;
    }
    print FH join( "\r\n", @Msg );
    print FH "\r\n";
    if( !close FH  )
    {
        &Log( 'error', $! ? "exec($cmd) closes pipe with status: $!"
                          : "exec($cmd) exits with error #".($?>>8) );
    }
}

#----------------------------------------------------------------------------
# IN (ARRAY): command line options
# OUT(ARRAY): configuaration filename and section name
sub ParseCmdLine
{
    my $ini = '/usr/local/etc/drweb/drweb32.ini';
    my $what= '';
    foreach my $opt (@_)
    {
        $ini = $1, next if $opt =~ /--ini=(.*)/;
        $what= $1, next if $opt =~ /--what=(.*)/;
        &DrDie( 'ambiguous command-line switch: ' . $opt );
    }
    return ( $ini, $what );
}

#----------------------------------------------------------------------------
# IN (STRING): filename of lock
# OUT: no
sub Lock
{
    my $Conf = shift;
    return unless $Conf->{Self}{lockfile};
    open( LOCKFD, ">>$Conf->{Self}{lockfile}" )
	or &DrDie( "cannot open lockfile $Conf->{Self}{lockfile} for locking ($!)" );
    flock( LOCKFD, LOCK_EX | LOCK_NB )
        or &DrDie( "cannot obtain lockfile $Conf->{Self}{lockfile}, stop to prevent multiply instances ($!)" );
    $Conf->{Self}{locked} = 'yes';
}

#----------------------------------------------------------------------------
# IN: no
# OUT: no
sub Unlock
{
    if( $Conf and $Conf->{Self}{locked} eq 'yes' )
    {
        flock( LOCKFD, LOCK_UN );
        close LOCKFD;
        $Conf->{Self}{locked} = 'no';
	unlink $Conf->{Self}{lockfile};
    }
}

#----------------------------------------------------------------------------
# IN: signal recived
# OUT: no
sub ExitHandler
{
    my $recvsig = $_[0];
    &DrDie("Quitting on signal $recvsig");
}

#----------------------------------------------------------------------------
# IN (STRING)  : filename
# IN (REF_HASH): 1 if the given filename corresponds to updater itself, or 0
#   otherwise
sub IsUpdater {
    return 1 if $_[0] =~ /update\.pl$/io;
    return 0;
}

#----------------------------------------------------------------------------
# IN (STRING)  : filename
# IN (REF_HASH): 1 if the given filename corresponds to FlyTrap(R) update, 0
#   otherwise
sub IsFlyTrapUpdate {
    return 1 if $_[0] =~ /\bu\d{4}-[123]\d{3}$/io;
    return 0;
}

#----------------------------------------------------------------------------
# IN (STRING)  : filename
# IN (REF_HASH): 1 if base or 0
sub IsBase
{
    return 1 if $_[0] =~ /\.vdb$/io;
    return 0;
}

#----------------------------------------------------------------------------
# IN (STRING)  : filename
# IN (REF_HASH): 1 if engine or 0
sub IsEngine
{
    return 1 if $_[0] =~ /drweb32\.dll$/o;
    return 0;
}

#----------------------------------------------------------------------------
# IN (STRING)  : filename
# IN (REF_HASH): 1 if antispam shared object or 0
sub IsVadeRetro
{
    return 1 if $_[0] =~ /libvaderetro[\w\d]*\.so$/o;
    return 0;
}

#----------------------------------------------------------------------------
# IN (STRING)  : filename
# IN (REF_HASH): 1 if update.drl or 0
sub IsUpdateDrl
{
    return 1 if $_[0] =~ /update\.drl$/o;
    return 0;
}

#----------------------------------------------------------------------------
# IN (STRING)  : filename
# IN (REF_HASH): 1 if drl file or 0
sub IsDrl
{
    return 1 if $_[0] =~ /\.drl$/o;
    return 0;
}

#----------------------------------------------------------------------------
# IN (STRING): filename for searching
# OUT: full path of the executables or undef
sub Which
{
    my $filename = shift;
    foreach my $directory (split (':',$ENV{PATH}))
    {
       $directory .= '/' if ( not $directory =~ /\/$/ );
       my $fullpath=$directory.$filename;
       return $fullpath if ( -f $fullpath and -x $fullpath );
    }
    return undef;
}

#----------------------------------------------------------------------------
# IN (STRING): template for temporary filename
# OUT: temporary file name or undef on error
sub MkTemp
{
    my ($path,$suffix) = $_[0] =~ /(.+[^X])(X+)$/ or return undef;

    my $tempdir = &Dirname($path);
    return undef if ( not -d $tempdir or not -x $tempdir or not -w $tempdir);

    my $MAXRETRIES =  1000;

    my @chars=('a'..'z','A'..'Z',0..9);
    my $maxrand=$#chars + 1;

    my $sufflen=length($suffix);
    for ( my $i=0; $i < $MAXRETRIES; $i++ )
    {
        my $testname=$path;
        for ( my $j=0; $j < $sufflen; $j++ )
        {
            $testname .= $chars[ int ( rand $maxrand )];
        }
        next if (-e $testname or not open FH, '>'.$testname);
        close FH;
        if( not chmod 0644, $testname )
        {
            &Log( 'error', "cannot set permission on $testname");
            unlink $testname
                or &Log( 'warning', "cannot delete temporary file $testname" );
            return undef;
        }
        &schedule_unlink( $testname );
        return $testname;
    }
    return undef;
}

#----------------------------------------------------------------------------
# IN (REF_HASH): configuration of updater
# IN (REF_HASH): update process status hash
# OUT: 1 on success or 0
sub GetHttpFile
{
    my ($Conf,$Process,$get_file,$file_to) = @_;
    my ($auth,$save_to_buffer)=(0,ref $file_to eq "SCALAR");
    &Log( 'debug', "GetHttpFile has been called ..." );
    for ( my $i=1; $i <= $Conf->{Self}{tries}; $i++ )
    {
    	if (not $Process->{socket})
	{
	    if ( not &ConnectSocket($Conf,$Process) )
	    {
		&Log( 'error', delete $Process->{error});
		return 0;
	    }
	}
	$Process->{timeout_exceed} = time() + $Conf->{Self}{timeout};
	&Log( 'debug', "Attempting to fetch http://$Process->{host}$Process->{dir}$get_file");
        my $fdset = '';
        vec($fdset, fileno  $Process->{socket}, 1) = 1;
	my ($readed,$written,$tw,$buf);

	$buf=&MakeRequest($Conf,$Process,$get_file);
	$readed=length($buf);
        for ( $written=0,$tw=0 ; $written < $readed and defined $tw; $written += $tw )
	{
	    $tw = syswrite $Process->{socket}, $buf, $readed - $written, $written;
	}
	if (not defined $tw )
	{
	    &Log( 'warning', "cannot send request ($!)" );
	    &CloseSocket($Conf,$Process);
	    next;
	}
	else
	{
	    &Log( 'info', "request with $readed bytes length was sent to $Process->{host}" );
	}
	if (not $save_to_buffer )
	{
	    if (not open FH, ">$file_to")
            {
		&Log('error',"cannot open $file_to ($!) for writing");
		return 0;
	    }
	}
	my ($header,$size,$timeout);
	my $offset = 0;
	while (1)
	{
	    if (($timeout=$Process->{timeout_exceed} - time()) < 1 )
	    {
		last;
	    }
           select $fdset,undef,undef,$timeout;
            $readed=sysread $Process->{socket}, $buf, 2048,$offset;
            last if ( not defined $readed or $readed == 0 );
            if (not defined $header)
            {
                $header={end => 0};
                if ( $buf and $buf=~/^HTTP\/(\d)\.(\d)\s+(\d+)\s+([^\r]*)\r?\n/g )
                {
                    ($header->{proto_major},$header->{proto_minor},
                     $header->{retval}, $header->{retval_string}) = ( $1,$2,$3,$4 );
		    &Log( 'info', "$Process->{host} return $header->{retval} $header->{retval_string}" );
                }
                else
                {
                        print "parsing error $buf\n";
                        return 0;
                }
            }
            if ($header->{end} == 0)
            {
                while ( $buf=~/(.*)\n/g )
                {
                    my $str=$1;
                    if ( $str=~/^\s*$/ )
                    {
                        $header->{end} = 1;
                        if ($header->{retval} == 407 )
                        {
                            if (delete $Process->{auth_req})
                            {
                                &Log( 'error',"Authorization failed" );
                                &CloseSocket($Conf,$Process);
                                return 0;
                            }
                            elsif (not $Conf->{Self}{proxylogin} or not $Conf->{Self}{proxypassword})
                            {
                                &Log( 'error', "Authentication required" );
                                &CloseSocket($Conf,$Process);
                                return 0;
                            }
                            elsif (not &Authenticate($Conf,$Process,$header,$get_file))
                            {
                                &Log( 'error', delete $Process->{error} );
                                &CloseSocket($Conf,$Process);
                                return 0;
                            }
                        }
                        $buf=substr($buf,pos($buf));
                        $readed=length($buf);
                        $size=$header->{'content-length'};
                        last;
                    }
                    $header->{lc $1} = $2 if($str=~/^(\S+)\:\s+([^\r]*)\s*\r?$/);
                }
            }
            if ($header->{end} == 1)
            {
                if ($header->{retval} == 200 and $size > 0 )
                {
                    if (not $save_to_buffer )
                    {
                        for ( $written=0,$tw=0 ; $written < $readed and defined $tw; $written += $tw )
                        {
                            $tw = syswrite( FH, $buf, $readed - $written, $written )
                        }
                        last unless defined $tw;
                    }
                    else
                    {
                        $$file_to.=$buf;
                    }
                    $size-=$readed;
                    last unless ($size > 0);
                }
                elsif ( $header->{retval} == 407 )
                {
                    last;
                }
            }
        }
        if ( $timeout < 1 )
        {
            &Log('error', "timeout getting file $get_file");
            &CloseSocket($Conf,$Process);
            next;
        }
        if ( not defined $readed )
        {
            &Log('error', "cannot read file $get_file");
            &CloseSocket($Conf,$Process);
            next;
        }
        elsif ( $readed == 0 )
        {
            &Log('error', "remote host $Process->{remote_host} closed connection ($!)");
            &CloseSocket($Conf,$Process);
            next;
        }
        elsif ( not defined $tw )
        {
            &Log('error', "cannot write to file $file_to");
            &CloseSocket($Conf,$Process);
            return 0;
        }
        if ( $header->{retval} == 407 )
        {
            &CloseSocket($Conf,$Process,$header);
            redo;
        }
        &CloseSocket($Conf,$Process,$header);
        return 1;
    }
    return 0;
}

#----------------------------------------------------------------------------
# IN (REF_HASH): configuration of updater
# IN (REF_HASH): update process status hash
# OUT: temporary file name or undef on error
sub ConnectSocket
{
    my ($Conf,$Process) = @_;
    &Log( 'debug', "ConnectSocket has been called ..." );
    my $hostinfo=$_[0];
    my ($protocol,$port,$flags,$ipaddr);
    $protocol = getprotobyname('tcp');
    if (not $protocol)
    {
        $Process->{error} = "cannot find protocol TCP";
        return 0;
    }
    
    if ($Process->{URL}=~/^(http:\/\/)?([^\/\s]+)(.*)$/ )
    {
	($Process->{host},$Process->{dir})=($2,$3);
	$Process->{dir}.='/' unless $Process->{dir} =~ /\/$/;
    }
    else
    {
	$Process->{error} = "cannot parse url";
        return 0;
    }

    $Process->{socket} = new FileHandle;
    if (not socket($Process->{socket}, &PF_INET(), &SOCK_STREAM(), $protocol))
    {
	$Process->{error} = "cannot create socket, $!";
        return 0;
    }

    if ( $Conf->{Self}{proxyserver} ) {
        if ( $Conf->{Self}{proxyserver} =~ /^(http:\/\/)?(\S+?)(:(\d+))?\/*$/ )
	{
            $port = $4 ? $4 : 3128;
	    $Process->{remote_host} = $2;
        }
	else
	{
	    $Process->{error} = "cannot parse proxy address";
	    return 0;
        }
    }
    else
    {
        $port = 80;
	$Process->{remote_host} = $Process->{host};
    }
    if (not $ipaddr = gethostbyname($Process->{remote_host}))
    {
        $Process->{error} = "Cannot resolve $Process->{remote_host} to IP address";
        return 0;
    }
    my $sin = sockaddr_in($port, $ipaddr);
    &Log( 'debug', "Attempting to connect to $Process->{remote_host} ..." );
    if (not connect($Process->{socket}, $sin))
    {
        $Process->{error} = "Unable to connect to $Process->{remote_host}: $!";
        return 0;
    }
    if (not $flags = fcntl($Process->{socket}, F_GETFL, 0) or not fcntl($Process->{socket}, F_SETFL, $flags | O_NONBLOCK))
    {
	$Process->{error} = "Unable to set socket to non-blocking mode: $!";
	&CloseSocket($Conf,$Process);
	return 0;
    }
    &Log( 'debug', "Connect to $Process->{remote_host} successfull." );
    return 1;
}

#----------------------------------------------------------------------------
# IN (REF_HASH): configuration of updater
# IN (REF_HASH): update process status hash
# IN (REF_HASH): header fields
# OUT(SCALAR) : 1 on success or 0
sub CloseSocket {
    my ( $Conf, $Process, $header ) = @_;
    &Log( 'debug', 'CloseSocket has been called...' );
    return 0
        if ( $header and not ( ( $header->{ connection } and lc $header->{ connection } eq 'close' )
          or ( $Conf->{ Self }{ proxyserver } and $header->{ 'proxy-connection' }
          and lc $header->{ 'proxy-connection' } eq 'close' ) ) );
    shutdown( delete( $Process->{ socket } ), 2 );
    &Log( 'debug', 'CloseSocket done...' );
}

#----------------------------------------------------------------------------
# IN (REF_HASH): configuration of updater
# IN (REF_HASH): update process status hash
# IN (SCALAR) : file to get
# OUT(SCALAR) : request string
sub MakeRequest
{
    my ($Conf,$Process,$file) = @_;
    &Log( 'debug', "MakeRequest has been called ..." );
    my $request = 'GET ';
    $request.= 'http://'.$Process->{host} if $Conf->{Self}{proxyserver};
    $request.= $Process->{dir}.sprintf("%s?m=$Conf->{Self}{key_md5} HTTP/1.1\r\n",$file).
				'User-Agent: ' . $Conf->{ Versions }{ UserAgent } . "\r\n".
                                'X-DrWeb-Validate: '.$Conf->{Self}{key_md5}."\r\n".
                                'X-DrWeb-KeyNumber: '.$Conf->{Self}{key_num}."\r\n".
				"Accept: */*\r\n".
				"Host: $Process->{host}\r\n".
				"Connection: Keep-Alive\r\n";
    $request.= "Proxy-Connection: Keep-Alive\r\n" if $Conf->{Self}{proxyserver};
    $request.= delete $Process->{auth_req} if $Process->{auth_req};
    $request.= "\r\n";
    return $request;
}

#----------------------------------------------------------------------------
# IN (REF_HASH): configuration of updater
# IN (REF_HASH): update process status hash
# IN (REF_HASH): header fields
# IN (SCALAR) : requested file
# OUT(SCALAR) : 1 on success or 0
sub Authenticate
{
    my ($Conf,$Process,$header,$file) = @_;
    &Log( 'debug', "Authenticate has been called ..." );
    my ($method,$realm); 

    if (not $header->{'proxy-authenticate'})
    {
        $Process->{error} = "bad authentication request";
        return 0;
    }
    elsif (($method,$realm) = ($header->{'proxy-authenticate'} =~ /^(basic|digest)\s+(.*)$/i))
    {
	return &Basic($Conf,$Process,$realm) if (lc $method eq 'basic');
	return &Digest($Conf,$Process,$realm,$file) if (lc $method eq 'digest');
    }
    else
    {
	$Process->{error} = "unknown authentication method";
        return 0;
    }

}

#----------------------------------------------------------------------------
# IN (REF_HASH): configuration of updater
# IN (REF_HASH): update process status hash
# IN (SCALAR) : realm string
# OUT(SCALAR) : 1 on success or 0
sub Basic
{
    my ($Conf,$Process,$realm_string) = @_;
    $Process->{auth_req}="Proxy-Authorization: Basic ".&EncodeBase64("$Conf->{Self}{proxylogin}:$Conf->{Self}{proxypassword}")."\r\n";
    return 1;
}

#----------------------------------------------------------------------------
# IN (REF_HASH): configuration of updater
# IN (REF_HASH): update process status hash
# IN (SCALAR) : realm string
# IN (SCALAR) : requested file
# OUT(SCALAR) : 1 on success or 0
sub Digest
{
    my ($Conf,$Process,$realm_string,$file) = @_;
    my $nc = sprintf "%08X", ++$Process->{nonce};
    my $cnonce;
    my @chars=('a'..'z','A'..'Z',0..9);
    my $maxrand=$#chars + 1;
    for ( my $j=0; $j < 16; $j++ )
    {
	$cnonce .= $chars[ int ( rand $maxrand )];
    }

    my $uri = $Process->{dir};

    my ($HA1,$HA2,$md5,%realm,$response);
    while( $realm_string =~ /(^|,|\s+)(\w+)=\"([^\"]*)\"/g )
    {
	$realm{$2} = $3;
    }
    if (not $realm{realm} or not $realm{nonce} )
    {
	$Process->{error} = "cannot parse digest in response";
	return 0;
    }
    $HA1=`echo -n "$Conf->{Self}{proxylogin}:$realm{realm}:$Conf->{Self}{proxypassword}" | $Conf->{Self}{md5sum}`;
    if ($HA1=~/\s*([0-9a-fA-F]{32})\s+.*/)
    {
	$HA1=$1;
    }
    else
    {
	$Process->{error} = "cannot calcultate md5 sum for Digest auth";
	return 0;
    }
    $HA2=`echo -n "GET:$Process->{dir}$file" | $Conf->{Self}{md5sum}`;
    if ($HA2=~/\s*([0-9a-fA-F]{32})\s+.*/)
    {
	$HA2=$1;
    }
    else
    {
	$Process->{error} = "cannot calcultate md5 sum for Digest auth";
	return 0;
    }
    
    $md5=$HA1.":".$realm{nonce}.":";

    if ( $realm{qop} )
    {
	$md5.=$nc.":".$cnonce.":".$realm{qop}.":";
    }
    $md5.=$HA2;

    $md5=`echo -n "$md5" | $Conf->{Self}{md5sum}`;
    if ($md5=~/\s*([0-9a-fA-F]{32})\s+.*/)
    {
	$md5=$1;
    }
    else
    {
	$Process->{error} = "cannot calcultate md5 sum for Digest auth";
	return 0;
    }

   $response = "username=\"$Conf->{Self}{proxylogin}\", realm=\"$realm{realm}\", nonce=\"$realm{nonce}\", uri=\"";
   $response.= "$Process->{dir}$file\", algorithm=\"MD5\", ";
   $response.= "qop=\"$realm{qop}\", cnonce=\"$cnonce\", nc=$nc, " if ( $realm{qop} );
   $response.= "response=\"$md5\"";
   $response.= ", opaque=\"$realm{opaque}" if ($realm{opaque});
   $Process->{auth_req}="Proxy-Authorization: Digest $response\r\n";
   return 1;
}

#----------------------------------------------------------------------------
# IN (SCALAR) : string to encode
# OUT(SCALAR) : encoded string
sub EncodeBase64
{
    my $res .= substr(pack('u', $_[0]),1,-1);
    $res =~ tr|` -_|AA-Za-z0-9+/|;
    my $padding = (3 - length($_[0]) % 3) % 3;
    $res =~ s/.{$padding}$/'=' x $padding/e if $padding;
    return $res;
}

#-----------------------------------------------------------------------------
# IN: no
# OUT: no
sub ReplayLog {
    return unless ( $log_cache and 'ARRAY' eq ref $log_cache and @{$log_cache} );
    #replay log
    my @log_cache = @{$log_cache};
    undef( $log_cache );
    my $log_entry;
    foreach $log_entry ( @log_cache ) {
        &{$log_entry}();
    }
}

{
    my %files_to_cleanup;
    END {
        cleanup_files();
        eval { &ReplayLog(); };
    }

#----------------------------------------------------------------------------
# IN: no
# OUT: no
sub cleanup_files {
    my @files = ( exists $files_to_cleanup{ $$ } ?
        @{ $files_to_cleanup{ $$ } } : () );
    foreach my $file ( @files ) {
        next unless -f $file;
        unlink $file or &Log( 'warning', 'Error unlinking temporary file ' . $file );
    }
    @{ $files_to_cleanup{ $$ } } = ();
}

#----------------------------------------------------------------------------
# IN (STRING) : filename to be unlinked
# OUT: no
sub schedule_unlink {
    my $file = shift;
    push @{ $files_to_cleanup{ $$ } }, $file;
}

}
