#! /usr/bin/perl -w
#-----------------------------------------------------------------------------
#  Dr.Web (R) Update Script
#  $Revision: 1.141 $
#-----------------------------------------------------------------------------
# Copyright 2007, 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.
#

use strict;
use FileHandle;
use Fcntl qw(:flock F_GETFL F_SETFL O_NONBLOCK O_RDONLY);
use Socket;
use Sys::Syslog;

########
# main #
########
# const
my %Levels = ( quiet   => [ 0, 'Q' ],
               error   => [ 1, 'E' ],
               warning => [ 2, 'W' ],
               info    => [ 3, 'I' ],
               verbose => [ 4, 'V' ],
               debug   => [ 5, 'D' ],
);
my $DefaultURL = 'http://update.drweb.com/unix';
# variables
# LOGHANDLE - file handle for LogFile
# LOCKFD - file handle for LockFile
my $LogLevel = 5;
my $syslog = 0;
my $log_cache = [];
# 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;
for my $URLs ( $CoreURLs, map { $_ } @{$PluginURLs} ) {
    undef( $Task );
    $Conf->{Paths}{drl} = $Conf->{Self}{drldir} . '/' if $URLs ne $CoreURLs;
    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 ( $ini, $what ) = &ParseCmdLine( @_ );

    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',
            # hidden options
            skipengine    => 'no',
            customdrlfile => '',
            fallbacktodrl => 'no',
            drldir        => '/var/drweb/drl',
        },
        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',
            user          => 'drweb',
            group         => undef,
            userid        => -1,
            groupid       => -1,
        },
        Versions => {
            Updater       => 'Dr.Web (R) Updater ($Revision: 1.141 $)',
        }
    );

    unless ( -f $ini ) {
        &Log( 'debug', 'file ' . $ini . ' will not be read as configuration source because it is not a regular file' );
    } 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{ 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();
    &Log( 'warning', $Config{Versions}{Updater}.' started ...' );

    &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{Self}{customdrlfile} ne '' ?
	$Config{Paths}{drl} = &Dirname($Config{Self}{customdrlfile}) :
	$Config{Paths}{drl} = &Dirname($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 (keys %{ $Conf })
    {
        &Log( 'debug', "Section($sec)" );
        foreach my $key (keys %{ $Conf->{$sec} })
        {
            &Log( 'debug', "  Name($key) Value($Conf->{$sec}{$key})" );
        }
    }
}

#-----------------------------------------------------------------------------
# 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 = [];

    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, using default: $DefaultURL" );
	push @{$STDURLS}, $DefaultURL;
    }

    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 $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}, $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});
		&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( [ 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( ', ', keys %{${$LstTask}->{new}} ) );
		${$LstTask}->{moved}=[];
		&MoveFiles( \%{${$LstTask}->{new}}, ${$LstTask}->{moved} );
		&Log( 'debug', "Following notifications will be added: ".join( ', ', keys %{${$LstTask}->{new_notify}} ) );
		${$LstTask}->{moved_notify}=[];
		&MoveFiles( \%{${$LstTask}->{new_notify}}, ${$LstTask}->{moved_notify} );

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

		&SendNotify( $_, $Conf ) foreach ( 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 ) = @_;

    while (($$DrList=~/([^\n]*)\r?\n/g))
    {
	my $UpdateLine=$1;
        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 '-' );
            $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 '@' );
        }
    }
    &Log( 'debug', "Following files will be deleted: ".join( ', ', keys %{$Task->{remove}} ) );
    &Log( 'debug', "Following files will be updated:" );
    &Log( 'debug', "  file=$_ crc=@{[ sprintf '%X', $Task->{update}{$_} ]}" ) foreach (keys %{$Task->{update}});

    &Log( 'debug', "Following files will be installed/updated:" );
    &Log( 'debug', "  file=$_ crc=@{[ sprintf '%X', $Task->{add}{$_} ]}" ) foreach (keys %{$Task->{add}});

    &Log( 'debug', "Following notifications will be updated: " );
    &Log( 'debug', "  file=$_ crc=@{[ sprintf '%X', $Task->{notify}{$_} ]}" ) foreach (keys %{$Task->{notify}});
}

#-----------------------------------------------------------------------------
# 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 gory 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 ...' );
                };
	    }
            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 ) {
        open LOGHANDLE, ">>$File"
            or &DrDie( 'Dr.Web (R) Updater ($Revision: 1.141 $) error: cannot open logfile '.$File.' for appending - '.$! );
    } else {
        my $program = $0;
        1 while $program =~ s!.+/!!g;
        openlog( $program, 'pid', $Facility );
        $syslog = 1;
    }
}

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

    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";
        }
    }
    if( 'error' eq $level )
    {
        print "ERROR: Dr.Web (R) Updater: $msg !\n";
    }
}

#-----------------------------------------------------------------------------
# IN : no
# OUT: no
sub CloseLog
{
    closelog;
    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 ) {
	&RemoveFiles( [ values %{$Task->{new_notify}},values %{$Task->{new}}], $Conf, 0 );
	&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/.*\/([^\/]*)/$1/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 = "$conf->{Paths}{update}$file";
    IsBase($file)      ? $path=$conf->{Paths}{bases}.$file :
    IsUpdateDrl($file) ? $path=$conf->{Self}{drlfile} :
    IsEngine($file)    ? $path=$conf->{Object}{enginepath} :
    IsVadeRetro($file) ? $path=$conf->{Object}{pathtovaderetro} :
    IsDrl($file)       ? $path=$conf->{Paths}{drl}.$file : ();
    &Log( 'debug', "FullPath($file) return( $path )" );
    return $path;
}

#----------------------------------------------------------------------------
# IN (STRING): filename
# OUT(SCALAR): crc32 of filename
sub Crc32
{
    my $function;
    if (eval { 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
		);
	    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 ) = @_;

    foreach my $file ( keys %{$Files} )
    {
        my $crc;
        my $filename = &Basename($file);
        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 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 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 ");
            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 has been downloaded (CRC32=@{[ sprintf '%X', $crc ]})");
            next;
        }
        &Log( 'error', "cannot get $file with valid CRC32 (lst=@{[ sprintf '%X', $Files->{$file} ]}, actual=@{[ sprintf '%X', $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 ( 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($_.$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 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 engine 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: Dr.Web (R) Updater ($Revision: 1.141 $)'."\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 responce";
	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;
}

}
