#!/bin/perl -T #============================================================= -*-perl-*- # # BackupPC: Main program for PC backups. # # DESCRIPTION # # BackupPC reads the configuration and status information from # $TopDir/conf. It then runs and manages all the backup activity. # # As specified by $Conf{WakeupSchedule}, BackupPC wakes up periodically # to queue backups on all the PCs. This is a four step process: # 1) For each host and DHCP address backup requests are queued on the # background command queue. # 2) For each PC, BackupPC_dump is forked. Several of these may # be run in parallel, based on the configuration. # 3) For each complete, good, backup, BackupPC_link is forked. # Only one of these tasks runs at a time. # 4) In the background BackupPC_trashClean is run to remove any expired # backups. Once each night, BackupPC_nightly is run to complete some # additional administrative tasks (pool cleaning etc). # # BackupPC also listens for connections on a unix domain socket and # the tcp port $Conf{ServerPort}, which are used by various # sub-programs and the CGI script BackupPC_Admin for status reporting # and user-initiated backup or backup cancel requests. # # AUTHOR # Craig Barratt # # COPYRIGHT # Copyright (C) 2001 Craig Barratt # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # #======================================================================== # # Version 1.6.0_CVS, released 10 Dec 2002. # # See http://backuppc.sourceforge.net. # #======================================================================== use strict; use vars qw(%Status %Info $Hosts); use lib "/usr/local/BackupPC/lib"; use BackupPC::Lib; use BackupPC::FileZIO; use File::Path; use Data::Dumper; use Getopt::Std; use Socket; use Carp; use Digest::MD5; ########################################################################### # Handle command line options ########################################################################### my %opts; getopts("d", \%opts); if ( @ARGV != 0 ) { print("usage: $0 [-d]\n"); exit(1); } ########################################################################### # Initialize major data structures and variables ########################################################################### # # Get an instance of BackupPC::Lib and get some shortcuts. # die("BackupPC::Lib->new failed\n") if ( !(my $bpc = BackupPC::Lib->new) ); my $TopDir = $bpc->TopDir(); my $BinDir = $bpc->BinDir(); my %Conf = $bpc->Conf(); # # Verify we are running as the correct user # if ( $Conf{BackupPCUserVerify} && $> != (my $uid = (getpwnam($Conf{BackupPCUser}))[2]) ) { die "Wrong user: my userid is $>, instead of $uid ($Conf{BackupPCUser})\n"; } # # %Status maintain status information about each host. # It is a hash of hashes, whose first index is the host. # %Status = (); # # %Info is a hash giving general information about BackupPC status. # %Info = (); # # Read old status # if ( -f "$TopDir/log/status.pl" && !(my $ret = do "$TopDir/log/status.pl") ) { die "couldn't parse $TopDir/log/status.pl: $@" if $@; die "couldn't do $TopDir/log/status.pl: $!" unless defined $ret; die "couldn't run $TopDir/log/status.pl"; } # # %Jobs maintains information about currently running jobs. # It is a hash of hashes, whose first index is the host. # my %Jobs = (); # # There are three command queues: # - @UserQueue is a queue of user initiated backup requests. # - @BgQueue is a queue of automatically scheduled backup requests. # - @CmdQueue is a queue of administrative jobs, including tasks # like BackupPC_link, BackupPC_trashClean, and BackupPC_nightly # Each queue is an array of hashes. Each hash stores information # about the command request. # my @UserQueue = (); my @CmdQueue = (); my @BgQueue = (); # # To quickly lookup if a given host is on a given queue, we keep # a hash of flags for each queue type. # my(%CmdQueueOn, %UserQueueOn, %BgQueueOn); # # One or more clients can connect to the server to get status information # or request/cancel backups etc. The %Clients hash maintains information # about each of these socket connections. The hash key is an incrementing # number stored in $ClientConnCnt. Each entry is a hash that contains # various information about the client connection. # my %Clients = (); my $ClientConnCnt; # # Read file descriptor mask used by select(). Every file descriptor # on which we expect to read (or accept) has the corresponding bit # set. # my $FDread = ''; # # Unix seconds when we next wakeup. A value of zero forces the scheduler # to compute the next wakeup time. # my $NextWakeup = 0; # # Name of signal saved by catch_signal # my $SigName = ""; # # Misc variables # my($RunNightlyWhenIdle, $FirstWakeup, $CmdJob, $ServerInetPort); # # Complete the rest of the initialization # Main_Initialize(); ########################################################################### # Main loop ########################################################################### while ( 1 ) { # # Check if we can/should run BackupPC_nightly # Main_TryToRun_nightly(); # # Check if we can run a new command from @CmdQueue. # Main_TryToRun_CmdQueue(); # # Check if we can run a new command from @UserQueue or @BgQueue. # Main_TryToRun_Bg_or_User_Queue(); # # Do a select() to wait for the next interesting thing to happen # (timeout, signal, someone sends a message, child dies etc). # my $fdRead = Main_Select(); # # Process a signal if we received one. # if ( $SigName ) { Main_Process_Signal(); $fdRead = undef; } # # Check if a timeout has occurred. # Main_Check_Timeout(); # # Check for, and process, any messages (output) from our jobs # Main_Check_Job_Messages($fdRead); # # Check for, and process, any output from our clients. Also checks # for new connections to our SERVER_UNIX and SERVER_INET sockets. # Main_Check_Client_Messages($fdRead); } ############################################################################ # Main_Initialize() # # Main initialization routine. Called once at statup. ############################################################################ sub Main_Initialize { umask($Conf{UmaskMode}); # # Check for another running process, check that PASSWD is set and # verify executables are configured correctly. # if ( $Info{pid} ne "" && kill(0, $Info{pid}) ) { print(STDERR $bpc->timeStamp, "Another BackupPC is running (pid $Info{pid}); quitting...\n"); exit(1); } foreach my $progName ( qw(SmbClientPath NmbLookupPath PingPath DfPath SendmailPath) ) { next if ( !defined($Conf{$progName}) || -x $Conf{$progName} ); print(STDERR $bpc->timeStamp, "\$Conf{$progName} = '$Conf{$progName}' is not a" . " valid executable program\n"); exit(1); } if ( $opts{d} ) { # # daemonize by forking # defined(my $pid = fork) or die "Can't fork: $!"; exit if $pid; # parent exits } # # Open the LOG file and redirect STDOUT, STDERR etc # LogFileOpen(); # # Read the hosts file (force a read). # exit(1) if ( !HostsUpdate(1) ); # # Clean up %ENV for taint checking # delete @ENV{qw(IFS CDPATH ENV BASH_ENV)}; $ENV{PATH} = $Conf{MyPath}; # # Initialize server sockets # ServerSocketInit(); # # Catch various signals # foreach my $sig ( qw(INT BUS SEGV PIPE TERM ALRM HUP) ) { $SIG{$sig} = \&catch_signal; } # # Report that we started, and update %Info. # print(LOG $bpc->timeStamp, "BackupPC started, pid $$\n"); $Info{ConfigModTime} = $bpc->ConfigMTime(); $Info{pid} = $$; $Info{startTime} = time; $Info{Version} = $bpc->{Version}; # # Update the status left over form the last time BackupPC ran. # Requeue any pending links. # foreach my $host ( sort(keys(%$Hosts)) ) { if ( $Status{$host}{state} eq "backup in progress" ) { # # should we restart it? skip it for now. # $Status{$host}{state} = "idle"; } elsif ( $Status{$host}{state} eq "link pending" || $Status{$host}{state} eq "link running" ) { QueueLink($host); } else { $Status{$host}{state} = "idle"; } $Status{$host}{activeJob} = 0; } # # Write out our initial status and save our PID # StatusWrite(); if ( open(PID, ">$TopDir/log/BackupPC.pid") ) { print(PID $$); close(PID); } # # For unknown reasons there is a very infrequent error about not # being able to coerce GLOBs inside the XS Data::Dumper. I've # only seen this on a particular platform and perl version. # For now the workaround appears to be use the perl version of # XS Data::Dumper. # $Data::Dumper::Useqq = 1; } ############################################################################ # Main_TryToRun_nightly() # # Checks to see if we can/should run BackupPC_nightly or # BackupPC_trashClean. If so we push the appropriate command onto # @CmdQueue. ############################################################################ sub Main_TryToRun_nightly { # # Check if we should run BackupPC_nightly or BackupPC_trashClean. # BackupPC_nightly is run when the current job queue is empty. # BackupPC_trashClean is run in the background always. # my $trashCleanRunning = defined($Jobs{$bpc->trashJob}) ? 1 : 0; if ( !$trashCleanRunning && !$CmdQueueOn{$bpc->trashJob} ) { # # This should only happen once at startup, but just in case this # code will re-start BackupPC_trashClean if it quits # unshift(@CmdQueue, { host => $bpc->trashJob, user => "BackupPC", reqTime => time, cmd => "$BinDir/BackupPC_trashClean" }); $CmdQueueOn{$bpc->trashJob} = 1; } if ( keys(%Jobs) == $trashCleanRunning && $RunNightlyWhenIdle == 1 ) { push(@CmdQueue, { host => $bpc->adminJob, user => "BackupPC", reqTime => time, cmd => "$BinDir/BackupPC_nightly" }); $CmdQueueOn{$bpc->adminJob} = 1; $RunNightlyWhenIdle = 2; } } ############################################################################ # Main_TryToRun_CmdQueue() # # Decide if we can run a new command from the @CmdQueue. # We only run one of these at a time. The @CmdQueue is # used to run BackupPC_link (for the corresponding host), # BackupPC_trashClean, and BackupPC_nightly using a fake # host name of $bpc->adminJob. ############################################################################ sub Main_TryToRun_CmdQueue { my($req, $host); if ( $CmdJob eq "" && @CmdQueue > 0 && $RunNightlyWhenIdle != 1 ) { local(*FH); $req = pop(@CmdQueue); $host = $req->{host}; if ( defined($Jobs{$host}) ) { print(LOG $bpc->timeStamp, "Botch on admin job for $host: already in use!!\n"); # # This could happen during normal opertion: a user could # request a backup while a BackupPC_link is queued from # a previous backup. But it is unlikely. Just put this # request back on the end of the queue. # unshift(@CmdQueue, $req); return; } $CmdQueueOn{$host} = 0; my $cmd = $req->{cmd}; my $pid = open(FH, "-|"); if ( !defined($pid) ) { print(LOG $bpc->timeStamp, "can't fork for $host, request by $req->{user}\n"); close(FH); next; } if ( !$pid ) { setpgrp 0,0; exec($cmd); print(LOG $bpc->timeStamp, "can't exec $cmd for $host\n"); exit(0); } $Jobs{$host}{pid} = $pid; $Jobs{$host}{fh} = *FH; $Jobs{$host}{fn} = fileno(FH); vec($FDread, $Jobs{$host}{fn}, 1) = 1; $Jobs{$host}{startTime} = time; $Jobs{$host}{reqTime} = $req->{reqTime}; $Jobs{$host}{cmd} = $cmd; $Jobs{$host}{type} = $Status{$host}{type}; $Status{$host}{state} = "link running"; $Status{$host}{activeJob} = 1; $Status{$host}{endTime} = time; $CmdJob = $host if ( $host ne $bpc->trashJob ); $cmd =~ s/$BinDir\///g; print(LOG $bpc->timeStamp, "Running $cmd (pid=$pid)\n"); } } ############################################################################ # Main_TryToRun_Bg_or_User_Queue() # # Decide if we can run any new backup requests from @BgQueue # or @UserQueue. Several of these can be run at the same time # based on %Conf settings. Jobs from @UserQueue take priority, # and at total of $Conf{MaxBackups} + $Conf{MaxUserBackups} # simultaneous jobs can run from @UserQueue. After @UserQueue # is exhausted, up to $Conf{MaxBackups} simultaneous jobs can # run from @BgQueue. ############################################################################ sub Main_TryToRun_Bg_or_User_Queue { my($req, $host); while ( $RunNightlyWhenIdle == 0 ) { local(*FH); my(@args, @deferUserQueue, @deferBgQueue, $progName, $type); my $nJobs = keys(%Jobs); # # CmdJob and trashClean don't count towards MaxBackups / MaxUserBackups # $nJobs-- if ( $CmdJob ne "" ); $nJobs-- if ( defined($Jobs{$bpc->trashJob} ) ); if ( $nJobs < $Conf{MaxBackups} + $Conf{MaxUserBackups} && @UserQueue > 0 ) { $req = pop(@UserQueue); if ( defined($Jobs{$req->{host}}) ) { push(@deferUserQueue, $req); next; } push(@args, $req->{doFull} ? "-f" : "-i") if ( !$req->{restore} ); $UserQueueOn{$req->{host}} = 0; } elsif ( $nJobs < $Conf{MaxBackups} && (@CmdQueue + $nJobs) <= $Conf{MaxBackups} + $Conf{MaxPendingCmds} && @BgQueue > 0 ) { my $du; if ( time - $Info{DUlastValueTime} >= 60 ) { # # Update our notion of disk usage no more than # once every minute # $du = $bpc->CheckFileSystemUsage($TopDir); $Info{DUlastValue} = $du; $Info{DUlastValueTime} = time; } else { # # if we recently checked it then just use the old value # $du = $Info{DUlastValue}; } if ( $Info{DUDailyMaxReset} ) { $Info{DUDailyMaxStartTime} = time; $Info{DUDailyMaxReset} = 0; $Info{DUDailyMax} = 0; } if ( $du > $Info{DUDailyMax} ) { $Info{DUDailyMax} = $du; $Info{DUDailyMaxTime} = time; } if ( $du > $Conf{DfMaxUsagePct} ) { my $nSkip = @BgQueue + @deferBgQueue; print(LOG $bpc->timeStamp, "Disk too full ($du%%); skipping $nSkip hosts\n"); $Info{DUDailySkipHostCnt} += $nSkip; @BgQueue = (); @deferBgQueue = (); %BgQueueOn = (); next; } $req = pop(@BgQueue); if ( defined($Jobs{$req->{host}}) ) { push(@deferBgQueue, $req); next; } $BgQueueOn{$req->{host}} = 0; } else { while ( @deferBgQueue ) { push(@BgQueue, pop(@deferBgQueue)); } while ( @deferUserQueue ) { push(@UserQueue, pop(@deferUserQueue)); } last; } $host = $req->{host}; my $user = $req->{user}; if ( $req->{restore} ) { $progName = "BackupPC_restore"; $type = "restore"; push(@args, $req->{hostIP}, $req->{host}, $req->{reqFileName}); } else { $progName = "BackupPC_dump"; $type = "backup"; push(@args, "-d") if ( $req->{dhcp} ); push(@args, "-e") if ( $req->{dumpExpire} ); push(@args, $host); } my $pid = open(FH, "-|"); if ( !defined($pid) ) { print(LOG $bpc->timeStamp, "can't fork to run $progName for $host, request by $user\n"); close(FH); next; } if ( !$pid ) { setpgrp 0,0; exec("$BinDir/$progName", @args); print(LOG $bpc->timeStamp, "can't exec $progName for $host\n"); exit(0); } $Jobs{$host}{pid} = $pid; $Jobs{$host}{fh} = *FH; $Jobs{$host}{fn} = fileno(FH); $Jobs{$host}{dhcp} = $req->{dhcp}; vec($FDread, $Jobs{$host}{fn}, 1) = 1; $Jobs{$host}{startTime} = time; $Jobs{$host}{reqTime} = $req->{reqTime}; $Jobs{$host}{cmd} = "$progName " . join(" ", @args); $Jobs{$host}{user} = $user; $Jobs{$host}{type} = $type; if ( !$req->{dhcp} ) { $Status{$host}{state} = "$type starting"; $Status{$host}{activeJob} = 1; $Status{$host}{startTime} = time; $Status{$host}{endTime} = ""; } } } ############################################################################ # Main_Select() # # If necessary, figure out when to next wakeup based on $Conf{WakeupSchedule}, # and then do a select() to wait for the next thing to happen # (timeout, signal, someone sends a message, child dies etc). ############################################################################ sub Main_Select { if ( $NextWakeup <= 0 ) { # # Figure out when to next wakeup based on $Conf{WakeupSchedule}. # my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); my($currHours) = $hour + $min / 60 + $sec / 3600; if ( $bpc->ConfigMTime() != $Info{ConfigModTime} ) { my($mesg) = $bpc->ConfigRead() || "Re-read config file because mtime changed"; print(LOG $bpc->timeStamp, "$mesg\n"); %Conf = $bpc->Conf(); $Info{ConfigModTime} = $bpc->ConfigMTime(); umask($Conf{UmaskMode}); ServerSocketInit(); } my $delta = -1; foreach my $t ( @{$Conf{WakeupSchedule} || [0..23]} ) { next if ( $t < 0 || $t > 24 ); my $tomorrow = $t + 24; if ( $delta < 0 || ($tomorrow - $currHours > 0 && $delta > $tomorrow - $currHours) ) { $delta = $tomorrow - $currHours; $FirstWakeup = $t == $Conf{WakeupSchedule}[0]; } if ( $delta < 0 || ($t - $currHours > 0 && $delta > $t - $currHours) ) { $delta = $t - $currHours; $FirstWakeup = $t == $Conf{WakeupSchedule}[0]; } } $NextWakeup = time + $delta * 3600; $Info{nextWakeup} = $NextWakeup; print(LOG $bpc->timeStamp, "Next wakeup is ", $bpc->timeStamp($NextWakeup, 1), "\n"); } # # Call select(), waiting until either a signal, a timeout, # any output from our jobs, or any messages from clients # connected via tcp. # select() is where we (hopefully) spend most of our time blocked... # my $timeout = $NextWakeup - time; $timeout = 1 if ( $timeout <= 0 ); my $ein = $FDread; select(my $rout = $FDread, undef, $ein, $timeout); return $rout; } ############################################################################ # Main_Process_Signal() # # Signal handler. ############################################################################ sub Main_Process_Signal { # # Process signals # if ( $SigName eq "HUP" ) { my($mesg) = $bpc->ConfigRead() || "Re-read config file because of a SIG_HUP"; print(LOG $bpc->timeStamp, "$mesg\n"); $Info{ConfigModTime} = $bpc->ConfigMTime(); %Conf = $bpc->Conf(); umask($Conf{UmaskMode}); ServerSocketInit(); HostsUpdate(0); $NextWakeup = 0; } elsif ( $SigName ) { print(LOG $bpc->timeStamp, "Got signal $SigName... cleaning up\n"); foreach my $host ( keys(%Jobs) ) { kill(2, $Jobs{$host}{pid}); } StatusWrite(); unlink("$TopDir/log/BackupPC.pid"); exit(1); } $SigName = ""; } ############################################################################ # Main_Check_Timeout() # # Check if a timeout has occured, and if so, queue all the PCs for backups. # Also does log file aging on the first timeout after midnight. ############################################################################ sub Main_Check_Timeout { # # Process timeouts # return if ( time < $NextWakeup || $NextWakeup <= 0 ); $NextWakeup = 0; if ( $FirstWakeup ) { # # This is the first wakeup after midnight. Do log file aging # and various house keeping. # $FirstWakeup = 0; printf(LOG "%s24hr disk usage: %d%% max, %d%% recent," . " %d skipped hosts\n", $bpc->timeStamp, $Info{DUDailyMax}, $Info{DUlastValue}, $Info{DUDailySkipHostCnt}); $Info{DUDailyMaxReset} = 1; $Info{DUDailyMaxPrev} = $Info{DUDailyMax}; $Info{DUDailySkipHostCntPrev} = $Info{DUDailySkipHostCnt}; $Info{DUDailySkipHostCnt} = 0; my $lastLog = $Conf{MaxOldLogFiles} - 1; if ( -f "$TopDir/log/LOG.$lastLog" ) { print(LOG $bpc->timeStamp, "Removing $TopDir/log/LOG.$lastLog\n"); unlink("$TopDir/log/LOG.$lastLog"); } if ( -f "$TopDir/log/LOG.$lastLog.z" ) { print(LOG $bpc->timeStamp, "Removing $TopDir/log/LOG.$lastLog.z\n"); unlink("$TopDir/log/LOG.$lastLog.z"); } print(LOG $bpc->timeStamp, "Aging LOG files, LOG -> LOG.0 -> " . "LOG.1 -> ... -> LOG.$lastLog\n"); close(LOG); for ( my $i = $lastLog - 1 ; $i >= 0 ; $i-- ) { my $j = $i + 1; rename("$TopDir/log/LOG.$i", "$TopDir/log/LOG.$j") if ( -f "$TopDir/log/LOG.$i" ); rename("$TopDir/log/LOG.$i.z", "$TopDir/log/LOG.$j.z") if ( -f "$TopDir/log/LOG.$i.z" ); } # # Compress the log file LOG -> LOG.0.z (if enabled). # Otherwise, just rename LOG -> LOG.0. # BackupPC::FileZIO->compressCopy("$TopDir/log/LOG", "$TopDir/log/LOG.0.z", "$TopDir/log/LOG.0", $Conf{CompressLevel}, 1); LogFileOpen(); # # Remember to run nightly script after current jobs are done # $RunNightlyWhenIdle = 1; } # # Write out the current status and then queue all the PCs # HostsUpdate(0); StatusWrite(); %BgQueueOn = () if ( @BgQueue == 0 ); %UserQueueOn = () if ( @UserQueue == 0 ); %CmdQueueOn = () if ( @CmdQueue == 0 ); QueueAllPCs(); } ############################################################################ # Main_Check_Job_Messages($fdRead) # # Check if select() says we have bytes waiting from any of our jobs. # Handle each of the messages when complete (newline terminated). ############################################################################ sub Main_Check_Job_Messages { my($fdRead) = @_; foreach my $host ( keys(%Jobs) ) { next if ( !vec($fdRead, $Jobs{$host}{fn}, 1) ); my $mesg; # # do a last check to make sure there is something to read so # we are absolutely sure we won't block. # vec(my $readMask, $Jobs{$host}{fn}, 1) = 1; if ( !select($readMask, undef, undef, 0.0) ) { print(LOG $bpc->timeStamp, "Botch in Main_Check_Job_Messages:" . " nothing to read from $host. Debug dump:\n"); my($dump) = Data::Dumper->new( [ \%Clients, \%Jobs, \$FDread, \$fdRead], [qw(*Clients, *Jobs *FDread, *fdRead)]); $dump->Indent(1); print(LOG $dump->Dump); next; } my $nbytes = sysread($Jobs{$host}{fh}, $mesg, 1024); $Jobs{$host}{mesg} .= $mesg if ( $nbytes > 0 ); # # Process any complete lines of output from this jobs. # Any output to STDOUT or STDERR from the children is processed here. # while ( $Jobs{$host}{mesg} =~ /(.*?)[\n\r]+(.*)/s ) { $mesg = $1; $Jobs{$host}{mesg} = $2; if ( $Jobs{$host}{dhcp} ) { if ( $mesg =~ /^DHCP (\S+) (\S+)/ ) { my $newHost = $2; if ( defined($Jobs{$newHost}) ) { print(LOG $bpc->timeStamp, "Backup on $newHost is already running\n"); kill(2, $Jobs{$host}{pid}); $nbytes = 0; last; } $Jobs{$host}{dhcpHostIP} = $host; $Status{$newHost}{dhcpHostIP} = $host; $Jobs{$newHost} = $Jobs{$host}; delete($Jobs{$host}); $host = $newHost; $Status{$host}{state} = "backup starting"; $Status{$host}{activeJob} = 1; $Status{$host}{startTime} = $Jobs{$host}{startTime}; $Status{$host}{endTime} = ""; $Jobs{$host}{dhcp} = 0; } else { print(LOG $bpc->timeStamp, "dhcp $host: $mesg\n"); } } elsif ( $mesg =~ /^started (.*) dump, pid=(-?\d+), tarPid=(-?\d+), share=(.*)/ ) { $Jobs{$host}{type} = $1; $Jobs{$host}{xferPid} = $2; $Jobs{$host}{tarPid} = $3; $Jobs{$host}{shareName} = $4; print(LOG $bpc->timeStamp, "Started $1 backup on $host" . " (pid=$Jobs{$host}{pid}, xferPid=$2", $Jobs{$host}{tarPid} > 0 ? ", tarPid=$Jobs{$host}{tarPid}" : "", $Jobs{$host}{dhcpHostIP} ? ", dhcp=$Jobs{$host}{dhcpHostIP}" : "", ", share=$Jobs{$host}{shareName})\n"); $Status{$host}{state} = "backup in progress"; $Status{$host}{reason} = ""; $Status{$host}{type} = $1; $Status{$host}{startTime} = time; $Status{$host}{deadCnt} = 0; $Status{$host}{aliveCnt}++; $Status{$host}{dhcpCheckCnt}-- if ( $Status{$host}{dhcpCheckCnt} > 0 ); } elsif ( $mesg =~ /^started_restore (\S+) (\S+)/ ) { $Jobs{$host}{type} = "restore"; $Jobs{$host}{xferPid} = $1; $Jobs{$host}{tarPid} = $2; print(LOG $bpc->timeStamp, "Started restore on $host" . " (pid=$Jobs{$host}{pid}, xferPid=$2", $Jobs{$host}{tarPid} > 0 ? ", tarPid=$Jobs{$host}{tarPid}" : "", ")\n"); $Status{$host}{state} = "restore in progress"; $Status{$host}{reason} = ""; $Status{$host}{type} = "restore"; $Status{$host}{startTime} = time; $Status{$host}{deadCnt} = 0; $Status{$host}{aliveCnt}++; } elsif ( $mesg =~ /^(full|incr) backup complete/ ) { print(LOG $bpc->timeStamp, "Finished $1 backup on $host\n"); $Status{$host}{reason} = "backup done"; delete($Status{$host}{error}); delete($Status{$host}{errorTime}); $Status{$host}{endTime} = time; } elsif ( $mesg =~ /^restore complete/ ) { print(LOG $bpc->timeStamp, "Finished restore on $host\n"); $Status{$host}{reason} = "restore done"; delete($Status{$host}{error}); delete($Status{$host}{errorTime}); $Status{$host}{endTime} = time; } elsif ( $mesg =~ /^nothing to do/ ) { $Status{$host}{state} = "idle"; $Status{$host}{reason} = "nothing to do"; $Status{$host}{startTime} = time; $Status{$host}{dhcpCheckCnt}-- if ( $Status{$host}{dhcpCheckCnt} > 0 ); } elsif ( $mesg =~ /^no ping response/ || $mesg =~ /^ping too slow/ ) { $Status{$host}{state} = "idle"; if ( $Status{$host}{reason} ne "backup failed" ) { $Status{$host}{reason} = "no ping"; $Status{$host}{startTime} = time; } $Status{$host}{deadCnt}++; if ( $Status{$host}{deadCnt} >= $Conf{BlackoutBadPingLimit} ) { $Status{$host}{aliveCnt} = 0; } } elsif ( $mesg =~ /^dump failed: (.*)/ ) { $Status{$host}{state} = "idle"; $Status{$host}{reason} = "backup failed"; $Status{$host}{error} = $1; $Status{$host}{errorTime} = time; $Status{$host}{endTime} = time; print(LOG $bpc->timeStamp, "backup failed on $host ($1)\n"); } elsif ( $mesg =~ /^log\s+(.*)/ ) { print(LOG $bpc->timeStamp, "$1\n"); } elsif ( $mesg =~ /^BackupPC_stats = (.*)/ ) { my @f = split(/,/, $1); $Info{"$f[0]FileCnt"} = $f[1]; $Info{"$f[0]DirCnt"} = $f[2]; $Info{"$f[0]Kb"} = $f[3]; $Info{"$f[0]Kb2"} = $f[4]; $Info{"$f[0]KbRm"} = $f[5]; $Info{"$f[0]FileCntRm"} = $f[6]; $Info{"$f[0]FileCntRep"} = $f[7]; $Info{"$f[0]FileRepMax"} = $f[8]; $Info{"$f[0]FileCntRename"} = $f[9]; $Info{"$f[0]Time"} = time; printf(LOG "%s%s nightly clean removed %d files of" . " size %.2fGB\n", $bpc->timeStamp, ucfirst($f[0]), $Info{"$f[0]FileCntRm"}, $Info{"$f[0]KbRm"} / (1000 * 1024)); printf(LOG "%s%s is %.2fGB, %d files (%d repeated, " . "%d max chain), %d directories\n", $bpc->timeStamp, ucfirst($f[0]), $Info{"$f[0]Kb"} / (1000 * 1024), $Info{"$f[0]FileCnt"}, $Info{"$f[0]FileCntRep"}, $Info{"$f[0]FileRepMax"}, $Info{"$f[0]DirCnt"}); } elsif ( $mesg =~ /^BackupPC_nightly lock_off/ ) { $RunNightlyWhenIdle = 0; } elsif ( $mesg =~ /^processState\s+(.+)/ ) { $Jobs{$host}{processState} = $1; } elsif ( $mesg =~ /^link\s+(.+)/ ) { my($h) = $1; $Status{$h}{needLink} = 1; } else { print(LOG $bpc->timeStamp, "$host: $mesg\n"); } } # # shut down the client connection if we read EOF # if ( $nbytes <= 0 ) { close($Jobs{$host}{fh}); vec($FDread, $Jobs{$host}{fn}, 1) = 0; if ( $CmdJob eq $host ) { my $cmd = $Jobs{$host}{cmd}; $cmd =~ s/$BinDir\///g; print(LOG $bpc->timeStamp, "Finished $host ($cmd)\n"); $Status{$host}{state} = "idle"; $Status{$host}{endTime} = time; $CmdJob = ""; $RunNightlyWhenIdle = 0 if ( $cmd eq "BackupPC_nightly" && $RunNightlyWhenIdle ); } else { # # Queue BackupPC_link to complete the backup # processing for this host. # if ( defined($Status{$host}) && ($Status{$host}{reason} eq "backup done" || $Status{$host}{needLink}) ) { QueueLink($host); } elsif ( defined($Status{$host}) ) { $Status{$host}{state} = "idle"; } } delete($Jobs{$host}); $Status{$host}{activeJob} = 0 if ( defined($Status{$host}) ); } } # # When we are idle (empty Jobs, CmdQueue, BgQueue, UserQueue) we # do a pass over %Status updating the deadCnt and aliveCnt for # DHCP hosts. The reason we need to do this later is we can't # be sure whether a DHCP host is alive or dead until we have passed # over all the DHCP pool. # return if ( @CmdQueue || @BgQueue || @UserQueue || keys(%Jobs) > 1 ); foreach my $host ( keys(%Status) ) { next if ( $Status{$host}{dhcpCheckCnt} <= 0 ); $Status{$host}{deadCnt} += $Status{$host}{dhcpCheckCnt}; $Status{$host}{dhcpCheckCnt} = 0; if ( $Status{$host}{deadCnt} >= $Conf{BlackoutBadPingLimit} ) { $Status{$host}{aliveCnt} = 0; } } } ############################################################################ # Main_Check_Client_Messages($fdRead) # # Check for, and process, any output from our clients. Also checks # for new connections to our SERVER_UNIX and SERVER_INET sockets. ############################################################################ sub Main_Check_Client_Messages { my($fdRead) = @_; foreach my $client ( keys(%Clients) ) { next if ( !vec($fdRead, $Clients{$client}{fn}, 1) ); my($mesg, $host); # # do a last check to make sure there is something to read so # we are absolutely sure we won't block. # vec(my $readMask, $Clients{$client}{fn}, 1) = 1; if ( !select($readMask, undef, undef, 0.0) ) { print(LOG $bpc->timeStamp, "Botch in Main_Check_Client_Messages:" . " nothing to read from $client. Debug dump:\n"); my($dump) = Data::Dumper->new( [ \%Clients, \%Jobs, \$FDread, \$fdRead], [qw(*Clients, *Jobs *FDread, *fdRead)]); $dump->Indent(1); print(LOG $dump->Dump); next; } my $nbytes = sysread($Clients{$client}{fh}, $mesg, 1024); $Clients{$client}{mesg} .= $mesg if ( $nbytes > 0 ); # # Process any complete lines received from this client. # while ( $Clients{$client}{mesg} =~ /(.*?)[\n\r]+(.*)/s ) { my($reply); my $cmd = $1; $Clients{$client}{mesg} = $2; # # Authenticate the message by checking the MD5 digest # my $md5 = Digest::MD5->new; if ( $cmd !~ /^(.{22}) (.*)/ || ($md5->add($Clients{$client}{seed} . $Clients{$client}{mesgCnt} . $Conf{ServerMesgSecret} . $2), $md5->b64digest ne $1) ) { print(LOG $bpc->timeStamp, "Corrupted message '$cmd' from" . " client '$Clients{$client}{clientName}':" . " shutting down client connection\n"); $nbytes = 0; last; } $Clients{$client}{mesgCnt}++; $cmd = $2; if ( $cmd =~ /^stop (\S+)\s+(\S+)\s+(\S*)/ ) { $host = $1; my $user = $2; my $backoff = $3; if ( $CmdJob ne $host && defined($Status{$host}) && defined($Jobs{$host}) ) { print(LOG $bpc->timeStamp, "Stopping current backup of $host," . " request by $user (backoff=$backoff)\n"); kill(2, $Jobs{$host}{pid}); vec($FDread, $Jobs{$host}{fn}, 1) = 0; close($Jobs{$host}{fh}); delete($Jobs{$host}); $Status{$host}{state} = "idle"; $Status{$host}{reason} = "backup canceled by $user"; $Status{$host}{activeJob} = 0; $Status{$host}{startTime} = time; $reply = "ok: backup of $host cancelled"; } elsif ( $BgQueueOn{$host} || $UserQueueOn{$host} ) { print(LOG $bpc->timeStamp, "Stopping pending backup of $host," . " request by $user (backoff=$backoff)\n"); @BgQueue = grep($_->{host} ne $host, @BgQueue); @UserQueue = grep($_->{host} ne $host, @UserQueue); $BgQueueOn{$host} = $UserQueueOn{$host} = 0; $reply = "ok: pending backup of $host cancelled"; } else { print(LOG $bpc->timeStamp, "Nothing to do for stop backup of $host," . " request by $user (backoff=$backoff)\n"); $reply = "ok: no backup was pending or running"; } if ( defined($Status{$host}) && $backoff ne "" ) { if ( $backoff > 0 ) { $Status{$host}{backoffTime} = time + $backoff * 3600; } else { delete($Status{$host}{backoffTime}); } } } elsif ( $cmd =~ /^backup all$/ ) { QueueAllPCs(); } elsif ( $cmd =~ /^backup (\S+)\s+(\S+)\s+(\S+)\s+(\S+)/ ) { my $hostIP = $1; $host = $2; my $user = $3; my $doFull = $4; if ( !defined($Status{$host}) ) { print(LOG $bpc->timeStamp, "User $user requested backup of unknown host" . " $host\n"); $reply = "error: unknown host $host"; } elsif ( defined($Jobs{$host}) && $Jobs{$host}{type} ne "restore" ) { print(LOG $bpc->timeStamp, "User $user requested backup of $host," . " but one is currently running\n"); $reply = "error: backup of $host is already running"; } else { print(LOG $bpc->timeStamp, "User $user requested backup of $host" . " ($hostIP)\n"); if ( $BgQueueOn{$hostIP} ) { @BgQueue = grep($_->{host} ne $hostIP, @BgQueue); $BgQueueOn{$hostIP} = 0; } if ( $UserQueueOn{$hostIP} ) { @UserQueue = grep($_->{host} ne $hostIP, @UserQueue); $UserQueueOn{$hostIP} = 0; } unshift(@UserQueue, { host => $hostIP, user => $user, reqTime => time, doFull => $doFull, dhcp => $hostIP eq $host ? 0 : 1, }); $UserQueueOn{$hostIP} = 1; $reply = "ok: requested backup of $host"; } } elsif ( $cmd =~ /^restore (\S+)\s+(\S+)\s+(\S+)\s+(\S+)/ ) { my $hostIP = $1; $host = $2; my $user = $3; my $reqFileName = $4; if ( !defined($Status{$host}) ) { print(LOG $bpc->timeStamp, "User $user requested restore to unknown host" . " $host"); $reply = "restore error: unknown host $host"; } else { print(LOG $bpc->timeStamp, "User $user requested restore to $host" . " ($hostIP)\n"); unshift(@UserQueue, { host => $host, hostIP => $hostIP, reqFileName => $reqFileName, reqTime => time, dhcp => 0, restore => 1, }); $UserQueueOn{$host} = 1; if ( defined($Jobs{$host}) ) { $reply = "ok: requested restore of $host, but a" . " job is currently running," . " so this request will start later"; } else { $reply = "ok: requested restore of $host"; } } } elsif ( $cmd =~ /^status\s*(.*)/ ) { my($args) = $1; my($dump, @values, @names); foreach my $type ( split(/\s+/, $args) ) { if ( $type =~ /^queues/ ) { push(@values, \@BgQueue, \@UserQueue, \@CmdQueue); push(@names, qw(*BgQueue *UserQueue *CmdQueue)); } elsif ( $type =~ /^jobs/ ) { push(@values, \%Jobs); push(@names, qw(*Jobs)); } elsif ( $type =~ /^queueLen/ ) { push(@values, { BgQueue => scalar(@BgQueue), UserQueue => scalar(@UserQueue), CmdQueue => scalar(@CmdQueue), }); push(@names, qw(*QueueLen)); } elsif ( $type =~ /^info/ ) { push(@values, \%Info); push(@names, qw(*Info)); } elsif ( $type =~ /^hosts/ ) { push(@values, \%Status); push(@names, qw(*Status)); } elsif ( $type =~ /^host\((.*)\)/ && defined($Status{$1}) ) { push(@values, { %{$Status{$1}}, BgQueueOn => $BgQueueOn{$1}, UserQueueOn => $UserQueueOn{$1}, CmdQueueOn => $CmdQueueOn{$1}, }); push(@names, qw(*StatusHost)); } else { print(LOG $bpc->timeStamp, "Unknown status request $type\n"); } } $dump = Data::Dumper->new(\@values, \@names); $dump->Indent(0); $reply = $dump->Dump; } elsif ( $cmd =~ /^link\s+(.+)/ ) { my($host) = $1; QueueLink($host); } elsif ( $cmd =~ /^log\s+(.*)/ ) { print(LOG $bpc->timeStamp, "$1\n"); } elsif ( $cmd =~ /^quit/ || $cmd =~ /^exit/ ) { $nbytes = 0; last; } else { print(LOG $bpc->timeStamp, "Unknown command $cmd\n"); $reply = "error: bad command $cmd"; } # # send a reply to the client, at a minimum "ok\n". # $reply = "ok" if ( $reply eq "" ); $reply .= "\n"; syswrite($Clients{$client}{fh}, $reply, length($reply)); } # # Detect possible denial-of-service attack from sending a huge line # (ie: never terminated). 32K seems to be plenty big enough as # a limit. # if ( length($Clients{$client}{mesg}) > 32 * 1024 ) { print(LOG $bpc->timeStamp, "Line too long from client" . " '$Clients{$client}{clientName}':" . " shutting down client connection\n"); $nbytes = 0; } # # Shut down the client connection if we read EOF # if ( $nbytes <= 0 ) { close($Clients{$client}{fh}); vec($FDread, $Clients{$client}{fn}, 1) = 0; delete($Clients{$client}); } } # # Accept any new connections on each of our listen sockets # if ( vec($fdRead, fileno(SERVER_UNIX), 1) ) { local(*CLIENT); my $paddr = accept(CLIENT, SERVER_UNIX); $ClientConnCnt++; $Clients{$ClientConnCnt}{clientName} = "unix socket"; $Clients{$ClientConnCnt}{mesg} = ""; $Clients{$ClientConnCnt}{fh} = *CLIENT; $Clients{$ClientConnCnt}{fn} = fileno(CLIENT); vec($FDread, $Clients{$ClientConnCnt}{fn}, 1) = 1; # # Generate and send unique seed for MD5 digests to avoid # replay attacks. See BackupPC::Lib::ServerMesg(). # my $seed = time . ",$ClientConnCnt,$$,0\n"; $Clients{$ClientConnCnt}{seed} = $seed; $Clients{$ClientConnCnt}{mesgCnt} = 0; syswrite($Clients{$ClientConnCnt}{fh}, $seed, length($seed)); } if ( $ServerInetPort > 0 && vec($fdRead, fileno(SERVER_INET), 1) ) { local(*CLIENT); my $paddr = accept(CLIENT, SERVER_INET); my($port,$iaddr) = sockaddr_in($paddr); my $name = gethostbyaddr($iaddr, AF_INET); $ClientConnCnt++; $Clients{$ClientConnCnt}{mesg} = ""; $Clients{$ClientConnCnt}{fh} = *CLIENT; $Clients{$ClientConnCnt}{fn} = fileno(CLIENT); $Clients{$ClientConnCnt}{clientName} = "$name:$port"; vec($FDread, $Clients{$ClientConnCnt}{fn}, 1) = 1; # # Generate and send unique seed for MD5 digests to avoid # replay attacks. See BackupPC::Lib::ServerMesg(). # my $seed = time . ",$ClientConnCnt,$$,$port\n"; $Clients{$ClientConnCnt}{seed} = $seed; $Clients{$ClientConnCnt}{mesgCnt} = 0; syswrite($Clients{$ClientConnCnt}{fh}, $seed, length($seed)); } } ########################################################################### # Miscellaneous subroutines ########################################################################### # # Write the current status to $TopDir/log/status.pl # sub StatusWrite { my($dump) = Data::Dumper->new( [ \%Info, \%Status], [qw(*Info *Status)]); $dump->Indent(1); if ( open(STATUS, ">$TopDir/log/status.pl") ) { print(STATUS $dump->Dump); close(STATUS); } } # # Queue all the hosts for backup. This means queuing all the fixed # ip hosts and all the dhcp address ranges. We also additionally # queue the dhcp hosts with a -e flag to check for expired dumps. # sub QueueAllPCs { foreach my $host ( sort(keys(%$Hosts)) ) { delete($Status{$host}{backoffTime}) if ( defined($Status{$host}{backoffTime}) && $Status{$host}{backoffTime} < time ); next if ( defined($Jobs{$host}) || $BgQueueOn{$host} || $UserQueueOn{$host} || $CmdQueueOn{$host} ); if ( $Hosts->{$host}{dhcp} ) { $Status{$host}{dhcpCheckCnt}++; if ( $RunNightlyWhenIdle ) { # # Once per night queue a check for DHCP hosts that just # checks for expired dumps. We need to do this to handle # the case when a DHCP host has not been on the network for # a long time, and some of the old dumps need to be expired. # Normally expiry checks are done by BackupPC_dump only # after the DHCP hosts has been detected on the network. # unshift(@BgQueue, {host => $host, user => "BackupPC", reqTime => time, dhcp => 0, dumpExpire => 1}); $BgQueueOn{$host} = 1; } } else { # # this is a fixed ip host: queue it # unshift(@BgQueue, {host => $host, user => "BackupPC", reqTime => time, dhcp => $Hosts->{$host}{dhcp}}); $BgQueueOn{$host} = 1; } } foreach my $dhcp ( @{$Conf{DHCPAddressRanges}} ) { for ( my $i = $dhcp->{first} ; $i <= $dhcp->{last} ; $i++ ) { my $ipAddr = "$dhcp->{ipAddrBase}.$i"; next if ( defined($Jobs{$ipAddr}) || $BgQueueOn{$ipAddr} || $UserQueueOn{$ipAddr} || $CmdQueueOn{$ipAddr} ); # # this is a potential dhcp ip address (we don't know the # host name yet): queue it # unshift(@BgQueue, {host => $ipAddr, user => "BackupPC", reqTime => time, dhcp => 1}); $BgQueueOn{$ipAddr} = 1; } } } # # Queue a BackupPC_link for the given host # sub QueueLink { my($host) = @_; return if ( $CmdQueueOn{$host} ); $Status{$host}{state} = "link pending"; $Status{$host}{needLink} = 0; unshift(@CmdQueue, { host => $host, user => "BackupPC", reqTime => time, cmd => "$BinDir/BackupPC_link $host" }); $CmdQueueOn{$host} = 1; } # # Read the hosts file, and update Status if any hosts have been # added or deleted. We also track the mtime so the only need to # update the hosts file on changes. # # This function is called at startup, SIGHUP, and on each wakeup. # It returns 1 on success and undef on failure. # sub HostsUpdate { my($force) = @_; my $newHosts; # # Nothing to do if we already have the current hosts file # return 1 if ( !$force && defined($Hosts) && $Info{HostsModTime} == $bpc->HostsMTime() ); if ( !defined($newHosts = $bpc->HostInfoRead()) ) { print(LOG $bpc->timeStamp, "Can't read hosts file!\n"); return; } print(LOG $bpc->timeStamp, "Reading hosts file\n"); $Hosts = $newHosts; $Info{HostsModTime} = $bpc->HostsMTime(); # # Now update %Status in case any hosts have been added or deleted # foreach my $host ( sort(keys(%$Hosts)) ) { next if ( defined($Status{$host}) ); $Status{$host}{state} = "idle"; print(LOG $bpc->timeStamp, "Added host $host to backup list\n"); } foreach my $host ( sort(keys(%Status)) ) { next if ( $host eq $bpc->trashJob || $host eq $bpc->adminJob || defined($Hosts->{$host}) || defined($Jobs{$host}) || $BgQueueOn{$host} || $UserQueueOn{$host} || $CmdQueueOn{$host} ); print(LOG $bpc->timeStamp, "Deleted host $host from backup list\n"); delete($Status{$host}); } return 1; } # # Remember the signal name for later processing # sub catch_signal { if ( $SigName ) { $SigName = shift; foreach my $host ( keys(%Jobs) ) { kill(2, $Jobs{$host}{pid}); } # # In case we are inside the exit handler, reopen the log file # close(LOG); LogFileOpen(); print(LOG "Fatal error: unhandled signal $SigName\n"); unlink("$TopDir/log/BackupPC.pid"); confess("Got new signal $SigName... quitting\n"); } $SigName = shift; } # # Open the log file and point STDOUT and STDERR there too # sub LogFileOpen { mkpath("$TopDir/log", 0, 0777) if ( !-d "$TopDir/log" ); open(LOG, ">>$TopDir/log/LOG") || die("Can't create LOG file $TopDir/log/LOG"); close(STDOUT); close(STDERR); open(STDOUT, ">&LOG"); open(STDERR, ">&LOG"); select(LOG); $| = 1; select(STDERR); $| = 1; select(STDOUT); $| = 1; } # # Initialize the unix-domain and internet-domain sockets that # we listen to for client connections (from the CGI script and # some of the BackupPC sub-programs). # sub ServerSocketInit { if ( !defined(fileno(SERVER_UNIX)) ) { # # one-time only: initialize unix-domain socket # if ( !socket(SERVER_UNIX, PF_UNIX, SOCK_STREAM, 0) ) { print(LOG $bpc->timeStamp, "unix socket() failed: $!\n"); exit(1); } my $sockFile = "$TopDir/log/BackupPC.sock"; unlink($sockFile); if ( !bind(SERVER_UNIX, sockaddr_un($sockFile)) ) { print(LOG $bpc->timeStamp, "unix bind() failed: $!\n"); exit(1); } if ( !listen(SERVER_UNIX, SOMAXCONN) ) { print(LOG $bpc->timeStamp, "unix listen() failed: $!\n"); exit(1); } vec($FDread, fileno(SERVER_UNIX), 1) = 1; } return if ( $ServerInetPort == $Conf{ServerPort} ); if ( $ServerInetPort > 0 ) { vec($FDread, fileno(SERVER_INET), 1) = 0; close(SERVER_INET); $ServerInetPort = -1; } if ( $Conf{ServerPort} > 0 ) { # # Setup a socket to listen on $Conf{ServerPort} # my $proto = getprotobyname('tcp'); if ( !socket(SERVER_INET, PF_INET, SOCK_STREAM, $proto) ) { print(LOG $bpc->timeStamp, "inet socket() failed: $!\n"); exit(1); } if ( !setsockopt(SERVER_INET, SOL_SOCKET, SO_REUSEADDR, pack("l",1)) ) { print(LOG $bpc->timeStamp, "setsockopt() failed: $!\n"); exit(1); } if ( !bind(SERVER_INET, sockaddr_in($Conf{ServerPort}, INADDR_ANY)) ) { print(LOG $bpc->timeStamp, "inet bind() failed: $!\n"); exit(1); } if ( !listen(SERVER_INET, SOMAXCONN) ) { print(LOG $bpc->timeStamp, "inet listen() failed: $!\n"); exit(1); } vec($FDread, fileno(SERVER_INET), 1) = 1; $ServerInetPort = $Conf{ServerPort}; } }