* Added German translation, provided by Manfred Herrmann.
[BackupPC.git] / bin / BackupPC
1 #!/bin/perl -T
2 #============================================================= -*-perl-*-
3 #
4 # BackupPC: Main program for PC backups.
5 #
6 # DESCRIPTION
7 #
8 #   BackupPC reads the configuration and status information from
9 #   $TopDir/conf.  It then runs and manages all the backup activity.
10 #
11 #   As specified by $Conf{WakeupSchedule}, BackupPC wakes up periodically
12 #   to queue backups on all the PCs.  This is a four step process:
13 #     1) For each host and DHCP address backup requests are queued on the
14 #        background command queue.
15 #     2) For each PC, BackupPC_dump is forked.  Several of these may
16 #        be run in parallel, based on the configuration.
17 #     3) For each complete, good, backup, BackupPC_link is forked.
18 #        Only one of these tasks runs at a time.
19 #     4) In the background BackupPC_trashClean is run to remove any expired
20 #        backups.  Once each night, BackupPC_nightly is run to complete some
21 #        additional administrative tasks (pool cleaning etc).
22 #
23 #   BackupPC also listens for connections on a unix domain socket and
24 #   the tcp port $Conf{ServerPort}, which are used by various
25 #   sub-programs and the CGI script BackupPC_Admin for status reporting
26 #   and user-initiated backup or backup cancel requests.
27 #
28 # AUTHOR
29 #   Craig Barratt  <cbarratt@users.sourceforge.net>
30 #
31 # COPYRIGHT
32 #   Copyright (C) 2001  Craig Barratt
33 #
34 #   This program is free software; you can redistribute it and/or modify
35 #   it under the terms of the GNU General Public License as published by
36 #   the Free Software Foundation; either version 2 of the License, or
37 #   (at your option) any later version.
38 #
39 #   This program is distributed in the hope that it will be useful,
40 #   but WITHOUT ANY WARRANTY; without even the implied warranty of
41 #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
42 #   GNU General Public License for more details.
43 #
44 #   You should have received a copy of the GNU General Public License
45 #   along with this program; if not, write to the Free Software
46 #   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
47 #
48 #========================================================================
49 #
50 # Version 2.0.0beta1, released 30 Mar 2003.
51 #
52 # See http://backuppc.sourceforge.net.
53 #
54 #========================================================================
55
56 use strict;
57 use vars qw(%Status %Info $Hosts);
58 use lib "/usr/local/BackupPC/lib";
59 use BackupPC::Lib;
60 use BackupPC::FileZIO;
61
62 use File::Path;
63 use Data::Dumper;
64 use Getopt::Std;
65 use Socket;
66 use Carp;
67 use Digest::MD5;
68
69 ###########################################################################
70 # Handle command line options
71 ###########################################################################
72 my %opts;
73 if ( !getopts("d", \%opts) || @ARGV != 0 ) {
74     print("usage: $0 [-d]\n");
75     exit(1);
76 }
77
78 ###########################################################################
79 # Initialize major data structures and variables
80 ###########################################################################
81
82 #
83 # Get an instance of BackupPC::Lib and get some shortcuts.
84 #
85 die("BackupPC::Lib->new failed\n") if ( !(my $bpc = BackupPC::Lib->new) );
86 my $TopDir = $bpc->TopDir();
87 my $BinDir = $bpc->BinDir();
88 my %Conf   = $bpc->Conf();
89
90 #
91 # Verify we are running as the correct user
92 #
93 if ( $Conf{BackupPCUserVerify}
94         && $> != (my $uid = (getpwnam($Conf{BackupPCUser}))[2]) ) {
95     die "Wrong user: my userid is $>, instead of $uid ($Conf{BackupPCUser})\n";
96 }
97
98 #
99 # %Status maintain status information about each host.
100 # It is a hash of hashes, whose first index is the host.
101 #
102 %Status     = ();
103
104 #
105 # %Info is a hash giving general information about BackupPC status.
106 #
107 %Info       = ();
108
109 #
110 # Read old status
111 #
112 if ( -f "$TopDir/log/status.pl" && !(my $ret = do "$TopDir/log/status.pl") ) {
113    die "couldn't parse $TopDir/log/status.pl: $@" if $@;
114    die "couldn't do $TopDir/log/status.pl: $!"    unless defined $ret;
115    die "couldn't run $TopDir/log/status.pl";
116 }
117
118 #
119 # %Jobs maintains information about currently running jobs.
120 # It is a hash of hashes, whose first index is the host.
121 #
122 my %Jobs       = ();
123
124 #
125 # There are three command queues:
126 #   - @UserQueue is a queue of user initiated backup requests.
127 #   - @BgQueue is a queue of automatically scheduled backup requests.
128 #   - @CmdQueue is a queue of administrative jobs, including tasks
129 #     like BackupPC_link, BackupPC_trashClean, and BackupPC_nightly
130 # Each queue is an array of hashes.  Each hash stores information
131 # about the command request.
132 #
133 my @UserQueue  = ();
134 my @CmdQueue   = ();
135 my @BgQueue    = ();
136
137 #
138 # To quickly lookup if a given host is on a given queue, we keep
139 # a hash of flags for each queue type.
140 #
141 my(%CmdQueueOn, %UserQueueOn, %BgQueueOn);
142
143 #
144 # One or more clients can connect to the server to get status information
145 # or request/cancel backups etc.  The %Clients hash maintains information
146 # about each of these socket connections.  The hash key is an incrementing
147 # number stored in $ClientConnCnt.  Each entry is a hash that contains
148 # various information about the client connection.
149 #
150 my %Clients    = ();
151 my $ClientConnCnt;
152
153 #
154 # Read file descriptor mask used by select().  Every file descriptor
155 # on which we expect to read (or accept) has the corresponding bit
156 # set.
157 #
158 my $FDread     = '';
159
160 #
161 # Unix seconds when we next wakeup.  A value of zero forces the scheduler
162 # to compute the next wakeup time.
163 #
164 my $NextWakeup = 0;
165
166 #
167 # Name of signal saved by catch_signal
168 #
169 my $SigName = "";
170
171 #
172 # Misc variables
173 #
174 my($RunNightlyWhenIdle, $FirstWakeup, $CmdJob, $ServerInetPort);
175
176 #
177 # Complete the rest of the initialization
178 #
179 Main_Initialize();
180
181 ###########################################################################
182 # Main loop
183 ###########################################################################
184 while ( 1 )
185 {
186     #
187     # Check if we can/should run BackupPC_nightly
188     #
189     Main_TryToRun_nightly();
190
191     #
192     # Check if we can run a new command from @CmdQueue.
193     #
194     Main_TryToRun_CmdQueue();
195
196     #
197     # Check if we can run a new command from @UserQueue or @BgQueue.
198     #
199     Main_TryToRun_Bg_or_User_Queue();
200
201     #
202     # Do a select() to wait for the next interesting thing to happen
203     # (timeout, signal, someone sends a message, child dies etc).
204     #
205     my $fdRead = Main_Select();
206
207     #
208     # Process a signal if we received one.
209     #
210     if ( $SigName ) {
211         Main_Process_Signal();
212         $fdRead = undef;
213     }
214
215     #
216     # Check if a timeout has occurred.
217     #
218     Main_Check_Timeout();
219
220     #
221     # Check for, and process, any messages (output) from our jobs
222     #
223     Main_Check_Job_Messages($fdRead);
224
225     #
226     # Check for, and process, any output from our clients.  Also checks
227     # for new connections to our SERVER_UNIX and SERVER_INET sockets.
228     #
229     Main_Check_Client_Messages($fdRead);
230 }
231
232 ############################################################################
233 # Main_Initialize()
234 #
235 # Main initialization routine.  Called once at statup.
236 ############################################################################
237 sub Main_Initialize
238 {
239     umask($Conf{UmaskMode});
240
241     #
242     # Check for another running process, check that PASSWD is set and
243     # verify executables are configured correctly.
244     #
245     if ( $Info{pid} ne "" && kill(0, $Info{pid}) ) {
246         print(STDERR $bpc->timeStamp,
247                  "Another BackupPC is running (pid $Info{pid}); quitting...\n");
248         exit(1);
249     }
250     foreach my $progName ( qw(SmbClientPath NmbLookupPath PingPath DfPath
251                               SendmailPath SshPath) ) {
252         next if ( $Conf{$progName} eq "" || -x $Conf{$progName} );
253         print(STDERR $bpc->timeStamp,
254                      "\$Conf{$progName} = '$Conf{$progName}' is not a"
255                    . " valid executable program\n");
256         exit(1);
257     }
258
259     if ( $opts{d} ) {
260         #
261         # daemonize by forking
262         #
263         defined(my $pid = fork) or die "Can't fork: $!";
264         exit if $pid;   # parent exits
265     }
266
267     #
268     # Open the LOG file and redirect STDOUT, STDERR etc
269     #
270     LogFileOpen();
271
272     #
273     # Read the hosts file (force a read).
274     #
275     exit(1) if ( !HostsUpdate(1) );
276
277     #
278     # Clean up %ENV for taint checking
279     #
280     delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
281     $ENV{PATH} = $Conf{MyPath};
282
283     #
284     # Initialize server sockets
285     #
286     ServerSocketInit();
287
288     #
289     # Catch various signals
290     #
291     foreach my $sig ( qw(INT BUS SEGV PIPE TERM ALRM HUP) ) {
292         $SIG{$sig} = \&catch_signal;
293     }
294
295     #
296     # Report that we started, and update %Info.
297     #
298     print(LOG $bpc->timeStamp, "BackupPC started, pid $$\n");
299     $Info{ConfigModTime} = $bpc->ConfigMTime();
300     $Info{pid} = $$;
301     $Info{startTime} = time;
302     $Info{Version} = $bpc->{Version};
303
304     #
305     # Update the status left over form the last time BackupPC ran.
306     # Requeue any pending links.
307     #
308     foreach my $host ( sort(keys(%$Hosts)) ) {
309         if ( $Status{$host}{state} eq "Status_backup_in_progress" ) {
310             #
311             # should we restart it?  skip it for now.
312             #
313             $Status{$host}{state} = "Status_idle";
314         } elsif ( $Status{$host}{state} eq "Status_link_pending"
315                 || $Status{$host}{state} eq "Status_link_running" ) {
316             QueueLink($host);
317         } else {
318             $Status{$host}{state} = "Status_idle";
319         }
320         $Status{$host}{activeJob} = 0;
321     }
322
323     #
324     # Write out our initial status and save our PID
325     #
326     StatusWrite();
327     if ( open(PID, ">", "$TopDir/log/BackupPC.pid") ) {
328         print(PID $$);
329         close(PID);
330     }
331
332     #
333     # For unknown reasons there is a very infrequent error about not
334     # being able to coerce GLOBs inside the XS Data::Dumper.  I've
335     # only seen this on a particular platform and perl version.
336     # For now the workaround appears to be use the perl version of
337     # XS Data::Dumper.
338     #
339     $Data::Dumper::Useqq = 1;
340 }
341
342 ############################################################################
343 # Main_TryToRun_nightly()
344 #
345 # Checks to see if we can/should run BackupPC_nightly or
346 # BackupPC_trashClean.  If so we push the appropriate command onto
347 # @CmdQueue.
348 ############################################################################
349 sub Main_TryToRun_nightly
350 {
351     #
352     # Check if we should run BackupPC_nightly or BackupPC_trashClean.
353     # BackupPC_nightly is run when the current job queue is empty.
354     # BackupPC_trashClean is run in the background always.
355     #
356     my $trashCleanRunning = defined($Jobs{$bpc->trashJob}) ? 1 : 0;
357     if ( !$trashCleanRunning && !$CmdQueueOn{$bpc->trashJob} ) {
358         #
359         # This should only happen once at startup, but just in case this
360         # code will re-start BackupPC_trashClean if it quits
361         #
362         unshift(@CmdQueue, {
363                 host    => $bpc->trashJob,
364                 user    => "BackupPC",
365                 reqTime => time,
366                 cmd     => ["$BinDir/BackupPC_trashClean"],
367             });
368         $CmdQueueOn{$bpc->trashJob} = 1;
369     }
370     if ( keys(%Jobs) == $trashCleanRunning && $RunNightlyWhenIdle == 1 ) {
371         push(@CmdQueue, {
372                 host    => $bpc->adminJob,
373                 user    => "BackupPC",
374                 reqTime => time,
375                 cmd     => ["$BinDir/BackupPC_nightly"],
376             });
377         $CmdQueueOn{$bpc->adminJob} = 1;
378         $RunNightlyWhenIdle = 2;
379     }
380 }
381
382 ############################################################################
383 # Main_TryToRun_CmdQueue()
384 #
385 # Decide if we can run a new command from the @CmdQueue.
386 # We only run one of these at a time.  The @CmdQueue is
387 # used to run BackupPC_link (for the corresponding host),
388 # BackupPC_trashClean, and BackupPC_nightly using a fake
389 # host name of $bpc->adminJob.
390 ############################################################################
391 sub Main_TryToRun_CmdQueue
392 {
393     my($req, $host);
394     if ( $CmdJob eq "" && @CmdQueue > 0 && $RunNightlyWhenIdle != 1 ) {
395         local(*FH);
396         $req = pop(@CmdQueue);
397
398         $host = $req->{host};
399         if ( defined($Jobs{$host}) ) {
400             print(LOG $bpc->timeStamp,
401                        "Botch on admin job for $host: already in use!!\n");
402             #
403             # This could happen during normal opertion: a user could
404             # request a backup while a BackupPC_link is queued from
405             # a previous backup.  But it is unlikely.  Just put this
406             # request back on the end of the queue.
407             #
408             unshift(@CmdQueue, $req);
409             return;
410         }
411         $CmdQueueOn{$host} = 0;
412         my $cmd  = $req->{cmd};
413         my $pid = open(FH, "-|");
414         if ( !defined($pid) ) {
415             print(LOG $bpc->timeStamp,
416                        "can't fork for $host, request by $req->{user}\n");
417             close(FH);
418             next;
419         }
420         if ( !$pid ) {
421             setpgrp 0,0;
422             exec(@$cmd);
423             print(LOG $bpc->timeStamp, "can't exec @$cmd for $host\n");
424             exit(0);
425         }
426         $Jobs{$host}{pid}       = $pid;
427         $Jobs{$host}{fh}        = *FH;
428         $Jobs{$host}{fn}        = fileno(FH);
429         vec($FDread, $Jobs{$host}{fn}, 1) = 1;
430         $Jobs{$host}{startTime} = time;
431         $Jobs{$host}{reqTime}   = $req->{reqTime};
432         $cmd                    = join(" ", @$cmd);
433         $Jobs{$host}{cmd}       = $cmd;
434         $Jobs{$host}{type}      = $Status{$host}{type};
435         $Status{$host}{state}   = "Status_link_running";
436         $Status{$host}{activeJob} = 1;
437         $Status{$host}{endTime} = time;
438         $CmdJob = $host if ( $host ne $bpc->trashJob );
439         $cmd =~ s/$BinDir\///g;
440         print(LOG $bpc->timeStamp, "Running $cmd (pid=$pid)\n");
441     }
442 }
443
444 ############################################################################
445 # Main_TryToRun_Bg_or_User_Queue()
446 #
447 # Decide if we can run any new backup requests from @BgQueue
448 # or @UserQueue.  Several of these can be run at the same time
449 # based on %Conf settings.  Jobs from @UserQueue take priority,
450 # and at total of $Conf{MaxBackups} + $Conf{MaxUserBackups}
451 # simultaneous jobs can run from @UserQueue.  After @UserQueue
452 # is exhausted, up to $Conf{MaxBackups} simultaneous jobs can
453 # run from @BgQueue.
454 ############################################################################
455 sub Main_TryToRun_Bg_or_User_Queue
456 {
457     my($req, $host);
458     while ( $RunNightlyWhenIdle == 0 ) {
459         local(*FH);
460         my(@args, @deferUserQueue, @deferBgQueue, $progName, $type);
461         my $nJobs = keys(%Jobs);
462         #
463         # CmdJob and trashClean don't count towards MaxBackups / MaxUserBackups
464         #
465         $nJobs-- if ( $CmdJob ne "" );
466         $nJobs-- if ( defined($Jobs{$bpc->trashJob} ) );
467         if ( $nJobs < $Conf{MaxBackups} + $Conf{MaxUserBackups}
468                         && @UserQueue > 0 ) {
469             $req = pop(@UserQueue);
470             if ( defined($Jobs{$req->{host}}) ) {
471                 push(@deferUserQueue, $req);
472                 next;
473             }
474             push(@args, $req->{doFull} ? "-f" : "-i")
475                             if ( !$req->{restore} );
476             $UserQueueOn{$req->{host}} = 0;
477         } elsif ( $nJobs < $Conf{MaxBackups}
478                         && (@CmdQueue + $nJobs)
479                                 <= $Conf{MaxBackups} + $Conf{MaxPendingCmds}
480                         && @BgQueue > 0 ) {
481             my $du;
482             if ( time - $Info{DUlastValueTime} >= 60 ) {
483                 #
484                 # Update our notion of disk usage no more than
485                 # once every minute
486                 #
487                 $du = $bpc->CheckFileSystemUsage($TopDir);
488                 $Info{DUlastValue}     = $du;
489                 $Info{DUlastValueTime} = time;
490             } else {
491                 #
492                 # if we recently checked it then just use the old value
493                 #
494                 $du = $Info{DUlastValue};
495             }
496             if ( $Info{DUDailyMaxReset} ) {
497                 $Info{DUDailyMaxStartTime} = time;
498                 $Info{DUDailyMaxReset}     = 0;
499                 $Info{DUDailyMax}          = 0;
500             }
501             if ( $du > $Info{DUDailyMax} ) {
502                 $Info{DUDailyMax}     = $du;
503                 $Info{DUDailyMaxTime} = time;
504             }
505             if ( $du > $Conf{DfMaxUsagePct} ) {
506                 my $nSkip = @BgQueue + @deferBgQueue;
507                 print(LOG $bpc->timeStamp,
508                            "Disk too full ($du%%); skipping $nSkip hosts\n");
509                 $Info{DUDailySkipHostCnt} += $nSkip;
510                 @BgQueue = ();
511                 @deferBgQueue = ();
512                 %BgQueueOn = ();
513                 next;
514             }
515             $req = pop(@BgQueue);
516             if ( defined($Jobs{$req->{host}}) ) {
517                 push(@deferBgQueue, $req);
518                 next;
519             }
520             $BgQueueOn{$req->{host}} = 0;
521         } else {
522             while ( @deferBgQueue ) {
523                 push(@BgQueue, pop(@deferBgQueue));
524             }
525             while ( @deferUserQueue ) {
526                 push(@UserQueue, pop(@deferUserQueue));
527             }
528             last;
529         }
530         $host = $req->{host};
531         my $user = $req->{user};
532         if ( $req->{restore} ) {
533             $progName = "BackupPC_restore";
534             $type     = "restore";
535             push(@args, $req->{hostIP}, $req->{host}, $req->{reqFileName});
536         } else {
537             $progName = "BackupPC_dump";
538             $type     = "backup";
539             push(@args, "-d") if ( $req->{dhcp} );
540             push(@args, "-e") if ( $req->{dumpExpire} );
541             push(@args, $host);
542         }
543         my $pid = open(FH, "-|");
544         if ( !defined($pid) ) {
545             print(LOG $bpc->timeStamp,
546                    "can't fork to run $progName for $host, request by $user\n");
547             close(FH);
548             next;
549         }
550         if ( !$pid ) {
551             setpgrp 0,0;
552             exec("$BinDir/$progName", @args);
553             print(LOG $bpc->timeStamp, "can't exec $progName for $host\n");
554             exit(0);
555         }
556         $Jobs{$host}{pid}        = $pid;
557         $Jobs{$host}{fh}         = *FH;
558         $Jobs{$host}{fn}         = fileno(FH);
559         $Jobs{$host}{dhcp}       = $req->{dhcp};
560         vec($FDread, $Jobs{$host}{fn}, 1) = 1;
561         $Jobs{$host}{startTime}  = time;
562         $Jobs{$host}{reqTime}    = $req->{reqTime};
563         $Jobs{$host}{cmd}        = join(" ", $progName, @args);
564         $Jobs{$host}{user}       = $user;
565         $Jobs{$host}{type}       = $type;
566         if ( !$req->{dhcp} ) {
567             $Status{$host}{state}     = "Status_".$type."_starting";
568             $Status{$host}{activeJob} = 1;
569             $Status{$host}{startTime} = time;
570             $Status{$host}{endTime}   = "";
571         }
572     }
573 }
574
575 ############################################################################
576 # Main_Select()
577 #
578 # If necessary, figure out when to next wakeup based on $Conf{WakeupSchedule},
579 # and then do a select() to wait for the next thing to happen
580 # (timeout, signal, someone sends a message, child dies etc).
581 ############################################################################
582 sub Main_Select
583 {
584     if ( $NextWakeup <= 0 ) {
585         #
586         # Figure out when to next wakeup based on $Conf{WakeupSchedule}.
587         #
588         my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)
589                                                 = localtime(time);
590         my($currHours) = $hour + $min / 60 + $sec / 3600;
591         if ( $bpc->ConfigMTime() != $Info{ConfigModTime} ) {
592             my($mesg) = $bpc->ConfigRead()
593                         || "Re-read config file because mtime changed";
594             print(LOG $bpc->timeStamp, "$mesg\n");
595             %Conf = $bpc->Conf();
596             $Info{ConfigModTime} = $bpc->ConfigMTime();
597             umask($Conf{UmaskMode});
598             ServerSocketInit();
599         }
600         my $delta = -1;
601         foreach my $t ( @{$Conf{WakeupSchedule} || [0..23]} ) {
602             next if ( $t < 0 || $t > 24 );
603             my $tomorrow = $t + 24;
604             if ( $delta < 0
605                 || ($tomorrow - $currHours > 0
606                                 && $delta > $tomorrow - $currHours) ) {
607                 $delta = $tomorrow - $currHours;
608                 $FirstWakeup = $t == $Conf{WakeupSchedule}[0];
609             }
610             if ( $delta < 0
611                     || ($t - $currHours > 0 && $delta > $t - $currHours) ) {
612                 $delta = $t - $currHours;
613                 $FirstWakeup = $t == $Conf{WakeupSchedule}[0];
614             }
615         }
616         $NextWakeup = time + $delta * 3600;
617         $Info{nextWakeup} = $NextWakeup;
618         print(LOG $bpc->timeStamp, "Next wakeup is ",
619                   $bpc->timeStamp($NextWakeup, 1), "\n");
620     }
621     #
622     # Call select(), waiting until either a signal, a timeout,
623     # any output from our jobs, or any messages from clients
624     # connected via tcp.
625     # select() is where we (hopefully) spend most of our time blocked...
626     #
627     my $timeout = $NextWakeup - time;
628     $timeout = 1 if ( $timeout <= 0 );
629     my $ein = $FDread;
630     select(my $rout = $FDread, undef, $ein, $timeout);
631
632     return $rout;
633 }
634
635 ############################################################################
636 # Main_Process_Signal()
637 #
638 # Signal handler.
639 ############################################################################
640 sub Main_Process_Signal
641 {
642     #
643     # Process signals
644     #
645     if ( $SigName eq "HUP" ) {
646         my($mesg) = $bpc->ConfigRead()
647                     || "Re-read config file because of a SIG_HUP";
648         print(LOG $bpc->timeStamp, "$mesg\n");
649         $Info{ConfigModTime} = $bpc->ConfigMTime();
650         %Conf = $bpc->Conf();
651         umask($Conf{UmaskMode});
652         ServerSocketInit();
653         HostsUpdate(0);
654         $NextWakeup = 0;
655     } elsif ( $SigName ) {
656         print(LOG $bpc->timeStamp, "Got signal $SigName... cleaning up\n");
657         foreach my $host ( keys(%Jobs) ) {
658             kill(2, $Jobs{$host}{pid});
659         }
660         StatusWrite();
661         unlink("$TopDir/log/BackupPC.pid");
662         exit(1);
663     }
664     $SigName = "";
665 }
666
667 ############################################################################
668 # Main_Check_Timeout()
669 #
670 # Check if a timeout has occured, and if so, queue all the PCs for backups.
671 # Also does log file aging on the first timeout after midnight.
672 ############################################################################
673 sub Main_Check_Timeout
674 {
675     #
676     # Process timeouts
677     #
678     return if ( time < $NextWakeup || $NextWakeup <= 0 );
679     $NextWakeup = 0;
680     if ( $FirstWakeup ) {
681         #
682         # This is the first wakeup after midnight.  Do log file aging
683         # and various house keeping.
684         #
685         $FirstWakeup = 0;
686         printf(LOG "%s24hr disk usage: %d%% max, %d%% recent,"
687                    . " %d skipped hosts\n",
688                    $bpc->timeStamp, $Info{DUDailyMax}, $Info{DUlastValue},
689                    $Info{DUDailySkipHostCnt});
690         $Info{DUDailyMaxReset}        = 1;
691         $Info{DUDailyMaxPrev}         = $Info{DUDailyMax};
692         $Info{DUDailySkipHostCntPrev} = $Info{DUDailySkipHostCnt};
693         $Info{DUDailySkipHostCnt}     = 0;
694         my $lastLog = $Conf{MaxOldLogFiles} - 1;
695         if ( -f "$TopDir/log/LOG.$lastLog" ) {
696             print(LOG $bpc->timeStamp,
697                        "Removing $TopDir/log/LOG.$lastLog\n");
698             unlink("$TopDir/log/LOG.$lastLog");
699         }
700         if ( -f "$TopDir/log/LOG.$lastLog.z" ) {
701             print(LOG $bpc->timeStamp,
702                        "Removing $TopDir/log/LOG.$lastLog.z\n");
703             unlink("$TopDir/log/LOG.$lastLog.z");
704         }
705         print(LOG $bpc->timeStamp, "Aging LOG files, LOG -> LOG.0 -> "
706                    . "LOG.1 -> ... -> LOG.$lastLog\n");
707         close(LOG);
708         for ( my $i = $lastLog - 1 ; $i >= 0 ; $i-- ) {
709             my $j = $i + 1;
710             rename("$TopDir/log/LOG.$i", "$TopDir/log/LOG.$j")
711                             if ( -f "$TopDir/log/LOG.$i" );
712             rename("$TopDir/log/LOG.$i.z", "$TopDir/log/LOG.$j.z")
713                             if ( -f "$TopDir/log/LOG.$i.z" );
714         }
715         #
716         # Compress the log file LOG -> LOG.0.z (if enabled).
717         # Otherwise, just rename LOG -> LOG.0.
718         #
719         BackupPC::FileZIO->compressCopy("$TopDir/log/LOG",
720                                         "$TopDir/log/LOG.0.z",
721                                         "$TopDir/log/LOG.0",
722                                         $Conf{CompressLevel}, 1);
723         LogFileOpen();
724         #
725         # Remember to run nightly script after current jobs are done
726         #
727         $RunNightlyWhenIdle = 1;
728     }
729     #
730     # Write out the current status and then queue all the PCs
731     #
732     HostsUpdate(0);
733     StatusWrite();
734     %BgQueueOn = ()   if ( @BgQueue == 0 );
735     %UserQueueOn = () if ( @UserQueue == 0 );
736     %CmdQueueOn = ()  if ( @CmdQueue == 0 );
737     QueueAllPCs();
738 }
739
740 ############################################################################
741 # Main_Check_Job_Messages($fdRead)
742 #
743 # Check if select() says we have bytes waiting from any of our jobs.
744 # Handle each of the messages when complete (newline terminated).
745 ############################################################################
746 sub Main_Check_Job_Messages
747 {
748     my($fdRead) = @_;
749     foreach my $host ( keys(%Jobs) ) {
750         next if ( !vec($fdRead, $Jobs{$host}{fn}, 1) );
751         my $mesg;
752         #
753         # do a last check to make sure there is something to read so
754         # we are absolutely sure we won't block.
755         #
756         vec(my $readMask, $Jobs{$host}{fn}, 1) = 1;
757         if ( !select($readMask, undef, undef, 0.0) ) {
758             print(LOG $bpc->timeStamp, "Botch in Main_Check_Job_Messages:"
759                         . " nothing to read from $host.  Debug dump:\n");
760             my($dump) = Data::Dumper->new(
761                          [  \%Clients, \%Jobs, \$FDread, \$fdRead],
762                          [qw(*Clients,  *Jobs   *FDread,  *fdRead)]);
763             $dump->Indent(1);
764             print(LOG $dump->Dump);
765             next;
766         }
767         my $nbytes = sysread($Jobs{$host}{fh}, $mesg, 1024);
768         $Jobs{$host}{mesg} .= $mesg if ( $nbytes > 0 );
769         #
770         # Process any complete lines of output from this jobs.
771         # Any output to STDOUT or STDERR from the children is processed here.
772         #
773         while ( $Jobs{$host}{mesg} =~ /(.*?)[\n\r]+(.*)/s ) {
774             $mesg = $1;
775             $Jobs{$host}{mesg} = $2;
776             if ( $Jobs{$host}{dhcp} ) {
777                 if ( $mesg =~ /^DHCP (\S+) (\S+)/ ) {
778                     my $newHost = $bpc->uriUnesc($2);
779                     if ( defined($Jobs{$newHost}) ) {
780                         print(LOG $bpc->timeStamp,
781                                 "Backup on $newHost is already running\n");
782                         kill(2, $Jobs{$host}{pid});
783                         $nbytes = 0;
784                         last;
785                     }
786                     $Jobs{$host}{dhcpHostIP} = $host;
787                     $Status{$newHost}{dhcpHostIP} = $host;
788                     $Jobs{$newHost} = $Jobs{$host};
789                     delete($Jobs{$host});
790                     $host = $newHost;
791                     $Status{$host}{state}      = "Status_backup_starting";
792                     $Status{$host}{activeJob}  = 1;
793                     $Status{$host}{startTime}  = $Jobs{$host}{startTime};
794                     $Status{$host}{endTime}    = "";
795                     $Jobs{$host}{dhcp}         = 0;
796                 } else {
797                     print(LOG $bpc->timeStamp, "dhcp $host: $mesg\n");
798                 }
799             } elsif ( $mesg =~ /^started (.*) dump, share=(.*)/ ) {
800                 $Jobs{$host}{type}      = $1;
801                 $Jobs{$host}{shareName} = $2;
802                 print(LOG $bpc->timeStamp,
803                           "Started $1 backup on $host (pid=$Jobs{$host}{pid}",
804                           $Jobs{$host}{dhcpHostIP}
805                                 ? ", dhcp=$Jobs{$host}{dhcpHostIP}" : "",
806                           ", share=$Jobs{$host}{shareName})\n");
807                 $Status{$host}{state}     = "Status_backup_in_progress";
808                 $Status{$host}{reason}    = "";
809                 $Status{$host}{type}      = $1;
810                 $Status{$host}{startTime} = time;
811                 $Status{$host}{deadCnt}   = 0;
812                 $Status{$host}{aliveCnt}++;
813                 $Status{$host}{dhcpCheckCnt}--
814                                 if ( $Status{$host}{dhcpCheckCnt} > 0 );
815             } elsif ( $mesg =~ /^xferPids (.*)/ ) {
816                 $Jobs{$host}{xferPid} = $1;
817             } elsif ( $mesg =~ /^started_restore/ ) {
818                 $Jobs{$host}{type}    = "restore";
819                 print(LOG $bpc->timeStamp,
820                           "Started restore on $host"
821                           . " (pid=$Jobs{$host}{pid})\n");
822                 $Status{$host}{state}     = "Status_restore_in_progress";
823                 $Status{$host}{reason}    = "";
824                 $Status{$host}{type}      = "restore";
825                 $Status{$host}{startTime} = time;
826                 $Status{$host}{deadCnt}   = 0;
827                 $Status{$host}{aliveCnt}++;
828             } elsif ( $mesg =~ /^(full|incr) backup complete/ ) {
829                 print(LOG $bpc->timeStamp, "Finished $1 backup on $host\n");
830                 $Status{$host}{reason}    = "Reason_backup_done";
831                 delete($Status{$host}{error});
832                 delete($Status{$host}{errorTime});
833                 $Status{$host}{endTime}   = time;
834             } elsif ( $mesg =~ /^restore complete/ ) {
835                 print(LOG $bpc->timeStamp, "Finished restore on $host\n");
836                 $Status{$host}{reason}    = "Reason_restore_done";
837                 delete($Status{$host}{error});
838                 delete($Status{$host}{errorTime});
839                 $Status{$host}{endTime}   = time;
840             } elsif ( $mesg =~ /^nothing to do/ ) {
841                 $Status{$host}{state}     = "Status_idle";
842                 $Status{$host}{reason}    = "Reason_nothing_to_do";
843                 $Status{$host}{startTime} = time;
844                 $Status{$host}{dhcpCheckCnt}--
845                                 if ( $Status{$host}{dhcpCheckCnt} > 0 );
846             } elsif ( $mesg =~ /^no ping response/
847                             || $mesg =~ /^ping too slow/ ) {
848                 $Status{$host}{state}     = "Status_idle";
849                 if ( $Status{$host}{reason} ne "Reason_backup_failed" ) {
850                     $Status{$host}{reason}    = "Reason_no_ping";
851                     $Status{$host}{startTime} = time;
852                 }
853                 $Status{$host}{deadCnt}++;
854                 if ( $Status{$host}{deadCnt} >= $Conf{BlackoutBadPingLimit} ) {
855                     $Status{$host}{aliveCnt} = 0;
856                 }
857             } elsif ( $mesg =~ /^dump failed: (.*)/ ) {
858                 $Status{$host}{state}     = "Status_idle";
859                 $Status{$host}{reason}    = "Reason_backup_failed";
860                 $Status{$host}{error}     = $1;
861                 $Status{$host}{errorTime} = time;
862                 $Status{$host}{endTime}   = time;
863                 print(LOG $bpc->timeStamp, "backup failed on $host ($1)\n");
864             } elsif ( $mesg =~ /^log\s+(.*)/ ) {
865                 print(LOG $bpc->timeStamp, "$1\n");
866             } elsif ( $mesg =~ /^BackupPC_stats = (.*)/ ) {
867                 my @f = split(/,/, $1);
868                 $Info{"$f[0]FileCnt"}       = $f[1];
869                 $Info{"$f[0]DirCnt"}        = $f[2];
870                 $Info{"$f[0]Kb"}            = $f[3];
871                 $Info{"$f[0]Kb2"}           = $f[4];
872                 $Info{"$f[0]KbRm"}          = $f[5];
873                 $Info{"$f[0]FileCntRm"}     = $f[6];
874                 $Info{"$f[0]FileCntRep"}    = $f[7];
875                 $Info{"$f[0]FileRepMax"}    = $f[8];
876                 $Info{"$f[0]FileCntRename"} = $f[9];
877                 $Info{"$f[0]FileLinkMax"}   = $f[10];
878                 $Info{"$f[0]Time"}          = time;
879                 printf(LOG "%s%s nightly clean removed %d files of"
880                            . " size %.2fGB\n",
881                              $bpc->timeStamp, ucfirst($f[0]),
882                              $Info{"$f[0]FileCntRm"},
883                              $Info{"$f[0]KbRm"} / (1000 * 1024));
884                 printf(LOG "%s%s is %.2fGB, %d files (%d repeated, "
885                            . "%d max chain, %d max links), %d directories\n",
886                              $bpc->timeStamp, ucfirst($f[0]),
887                              $Info{"$f[0]Kb"} / (1000 * 1024),
888                              $Info{"$f[0]FileCnt"}, $Info{"$f[0]FileCntRep"},
889                              $Info{"$f[0]FileRepMax"},
890                              $Info{"$f[0]FileLinkMax"}, $Info{"$f[0]DirCnt"});
891             } elsif ( $mesg =~ /^BackupPC_nightly lock_off/ ) {
892                 $RunNightlyWhenIdle = 0;
893             } elsif ( $mesg =~ /^processState\s+(.+)/ ) {
894                 $Jobs{$host}{processState} = $1;
895             } elsif ( $mesg =~ /^link\s+(.+)/ ) {
896                 my($h) = $1;
897                 $Status{$h}{needLink} = 1;
898             } else {
899                 print(LOG $bpc->timeStamp, "$host: $mesg\n");
900             }
901         }
902         #
903         # shut down the client connection if we read EOF
904         #
905         if ( $nbytes <= 0 ) {
906             close($Jobs{$host}{fh});
907             vec($FDread, $Jobs{$host}{fn}, 1) = 0;
908             if ( $CmdJob eq $host ) {
909                 my $cmd = $Jobs{$host}{cmd};
910                 $cmd =~ s/$BinDir\///g;
911                 print(LOG $bpc->timeStamp, "Finished $host ($cmd)\n");
912                 $Status{$host}{state}    = "Status_idle";
913                 $Status{$host}{endTime}  = time;
914                 $CmdJob = "";
915                 $RunNightlyWhenIdle = 0 if ( $cmd eq "BackupPC_nightly"
916                                             && $RunNightlyWhenIdle );
917             } else {
918                 #
919                 # Queue BackupPC_link to complete the backup
920                 # processing for this host.
921                 #
922                 if ( defined($Status{$host})
923                             && ($Status{$host}{reason} eq "Reason_backup_done"
924                                 || $Status{$host}{needLink}) ) {
925                     QueueLink($host);
926                 } elsif ( defined($Status{$host}) ) {
927                     $Status{$host}{state} = "Status_idle";
928                 }
929             }
930             delete($Jobs{$host});
931             $Status{$host}{activeJob} = 0 if ( defined($Status{$host}) );
932         }
933     }
934     #
935     # When we are idle (empty Jobs, CmdQueue, BgQueue, UserQueue) we
936     # do a pass over %Status updating the deadCnt and aliveCnt for
937     # DHCP hosts.  The reason we need to do this later is we can't
938     # be sure whether a DHCP host is alive or dead until we have passed
939     # over all the DHCP pool.
940     #
941     return if ( @CmdQueue || @BgQueue || @UserQueue || keys(%Jobs) > 1 );
942     foreach my $host ( keys(%Status) ) {
943         next if ( $Status{$host}{dhcpCheckCnt} <= 0 );
944         $Status{$host}{deadCnt} += $Status{$host}{dhcpCheckCnt};
945         $Status{$host}{dhcpCheckCnt} = 0;
946         if ( $Status{$host}{deadCnt} >= $Conf{BlackoutBadPingLimit} ) {
947             $Status{$host}{aliveCnt} = 0;
948         }
949     }
950 }
951
952 ############################################################################
953 # Main_Check_Client_Messages($fdRead)
954 #
955 # Check for, and process, any output from our clients.  Also checks
956 # for new connections to our SERVER_UNIX and SERVER_INET sockets.
957 ############################################################################
958 sub Main_Check_Client_Messages
959 {
960     my($fdRead) = @_;
961     foreach my $client ( keys(%Clients) ) {
962         next if ( !vec($fdRead, $Clients{$client}{fn}, 1) );
963         my($mesg, $host);
964         #
965         # do a last check to make sure there is something to read so
966         # we are absolutely sure we won't block.
967         #
968         vec(my $readMask, $Clients{$client}{fn}, 1) = 1;
969         if ( !select($readMask, undef, undef, 0.0) ) {
970             print(LOG $bpc->timeStamp, "Botch in Main_Check_Client_Messages:"
971                         . " nothing to read from $client.  Debug dump:\n");
972             my($dump) = Data::Dumper->new(
973                          [  \%Clients, \%Jobs, \$FDread, \$fdRead],
974                          [qw(*Clients,  *Jobs   *FDread,  *fdRead)]);
975             $dump->Indent(1);
976             print(LOG $dump->Dump);
977             next;
978         }
979         my $nbytes = sysread($Clients{$client}{fh}, $mesg, 1024);
980         $Clients{$client}{mesg} .= $mesg if ( $nbytes > 0 );
981         #
982         # Process any complete lines received from this client.
983         #
984         while ( $Clients{$client}{mesg} =~ /(.*?)[\n\r]+(.*)/s ) {
985             my($reply);
986             my $cmd = $1;
987             $Clients{$client}{mesg} = $2;
988             #
989             # Authenticate the message by checking the MD5 digest
990             #
991             my $md5 = Digest::MD5->new;
992             if ( $cmd !~ /^(.{22}) (.*)/
993                 || ($md5->add($Clients{$client}{seed}
994                             . $Clients{$client}{mesgCnt}
995                             . $Conf{ServerMesgSecret} . $2),
996                      $md5->b64digest ne $1) ) {
997                 print(LOG $bpc->timeStamp, "Corrupted message '$cmd' from"
998                             . " client '$Clients{$client}{clientName}':"
999                             . " shutting down client connection\n");
1000                 $nbytes = 0;
1001                 last;
1002             }
1003             $Clients{$client}{mesgCnt}++;
1004             $cmd = $2;
1005             if ( $cmd =~ /^stop (\S+)\s+(\S+)\s+(\S*)/ ) {
1006                 $host = $1;
1007                 my $user = $2;
1008                 my $backoff = $3;
1009                 $host = $bpc->uriUnesc($host);
1010                 if ( $CmdJob ne $host && defined($Status{$host})
1011                                       && defined($Jobs{$host}) ) {
1012                     print(LOG $bpc->timeStamp,
1013                                "Stopping current backup of $host,"
1014                              . " request by $user (backoff=$backoff)\n");
1015                     kill(2, $Jobs{$host}{pid});
1016                     #
1017                     # Don't close the pipe now; wait until the child
1018                     # really exits later.  Otherwise close() will
1019                     # block until the child has exited.
1020                     #  old code:
1021                     ##vec($FDread, $Jobs{$host}{fn}, 1) = 0;
1022                     ##close($Jobs{$host}{fh});
1023                     ##delete($Jobs{$host});
1024
1025                     $Status{$host}{state}     = "Status_idle";
1026                     $Status{$host}{reason}    = "Reason_backup_canceled_by_user";
1027                     $Status{$host}{activeJob} = 0;
1028                     $Status{$host}{startTime} = time;
1029                     $reply = "ok: backup of $host cancelled";
1030                 } elsif ( $BgQueueOn{$host} || $UserQueueOn{$host} ) {
1031                     print(LOG $bpc->timeStamp,
1032                                "Stopping pending backup of $host,"
1033                              . " request by $user (backoff=$backoff)\n");
1034                     @BgQueue = grep($_->{host} ne $host, @BgQueue);
1035                     @UserQueue = grep($_->{host} ne $host, @UserQueue);
1036                     $BgQueueOn{$host} = $UserQueueOn{$host} = 0;
1037                     $reply = "ok: pending backup of $host cancelled";
1038                 } else {
1039                     print(LOG $bpc->timeStamp,
1040                                "Nothing to do for stop backup of $host,"
1041                              . " request by $user (backoff=$backoff)\n");
1042                     $reply = "ok: no backup was pending or running";
1043                 }
1044                 if ( defined($Status{$host}) && $backoff ne "" ) {
1045                     if ( $backoff > 0 ) {
1046                         $Status{$host}{backoffTime} = time + $backoff * 3600;
1047                     } else {
1048                         delete($Status{$host}{backoffTime});
1049                     }
1050                 }
1051             } elsif ( $cmd =~ /^backup all$/ ) {
1052                 QueueAllPCs();
1053             } elsif ( $cmd =~ /^backup (\S+)\s+(\S+)\s+(\S+)\s+(\S+)/ ) {
1054                 my $hostIP = $1;
1055                 $host      = $2;
1056                 my $user   = $3;
1057                 my $doFull = $4;
1058                 $host      = $bpc->uriUnesc($host);
1059                 $hostIP    = $bpc->uriUnesc($hostIP);
1060                 if ( !defined($Status{$host}) ) {
1061                     print(LOG $bpc->timeStamp,
1062                                "User $user requested backup of unknown host"
1063                              . " $host\n");
1064                     $reply = "error: unknown host $host";
1065                 } elsif ( defined($Jobs{$host})
1066                                 && $Jobs{$host}{type} ne "restore" ) {
1067                     print(LOG $bpc->timeStamp,
1068                                "User $user requested backup of $host,"
1069                              . " but one is currently running\n");
1070                     $reply = "error: backup of $host is already running";
1071                 } else {
1072                     print(LOG $bpc->timeStamp,
1073                                "User $user requested backup of $host"
1074                              . " ($hostIP)\n");
1075                     if ( $BgQueueOn{$hostIP} ) {
1076                         @BgQueue = grep($_->{host} ne $hostIP, @BgQueue);
1077                         $BgQueueOn{$hostIP} = 0;
1078                     }
1079                     if ( $UserQueueOn{$hostIP} ) {
1080                         @UserQueue = grep($_->{host} ne $hostIP, @UserQueue);
1081                         $UserQueueOn{$hostIP} = 0;
1082                     }
1083                     unshift(@UserQueue, {
1084                                 host    => $hostIP,
1085                                 user    => $user,
1086                                 reqTime => time,
1087                                 doFull  => $doFull,
1088                                 dhcp    => $hostIP eq $host ? 0 : 1,
1089                         });
1090                     $UserQueueOn{$hostIP} = 1;
1091                     $reply = "ok: requested backup of $host";
1092                 }
1093             } elsif ( $cmd =~ /^restore (\S+)\s+(\S+)\s+(\S+)\s+(\S+)/ ) {
1094                 my $hostIP = $1;
1095                 $host      = $2;
1096                 my $user   = $3;
1097                 my $reqFileName = $4;
1098                 $host      = $bpc->uriUnesc($host);
1099                 $hostIP    = $bpc->uriUnesc($hostIP);
1100                 if ( !defined($Status{$host}) ) {
1101                     print(LOG $bpc->timeStamp,
1102                                "User $user requested restore to unknown host"
1103                              . " $host");
1104                     $reply = "restore error: unknown host $host";
1105                 } else {
1106                     print(LOG $bpc->timeStamp,
1107                                "User $user requested restore to $host"
1108                              . " ($hostIP)\n");
1109                     unshift(@UserQueue, {
1110                                 host    => $host,
1111                                 hostIP  => $hostIP,
1112                                 reqFileName => $reqFileName,
1113                                 reqTime => time,
1114                                 dhcp    => 0,
1115                                 restore => 1,
1116                         });
1117                     $UserQueueOn{$host} = 1;
1118                     if ( defined($Jobs{$host}) ) {
1119                         $reply = "ok: requested restore of $host, but a"
1120                                . " job is currently running,"
1121                                . " so this request will start later";
1122                     } else {
1123                         $reply = "ok: requested restore of $host";
1124                     }
1125                 }
1126             } elsif ( $cmd =~ /^status\s*(.*)/ ) {
1127                 my($args) = $1;
1128                 my($dump, @values, @names);
1129                 foreach my $type ( split(/\s+/, $args) ) {
1130                     if ( $type =~ /^queues/ ) {
1131                         push(@values,  \@BgQueue, \@UserQueue, \@CmdQueue);
1132                         push(@names, qw(*BgQueue   *UserQueue   *CmdQueue));
1133                     } elsif ( $type =~ /^jobs/ ) {
1134                         push(@values,  \%Jobs);
1135                         push(@names, qw(*Jobs));
1136                     } elsif ( $type =~ /^queueLen/ ) {
1137                         push(@values,  {
1138                                 BgQueue   => scalar(@BgQueue),
1139                                 UserQueue => scalar(@UserQueue),
1140                                 CmdQueue  => scalar(@CmdQueue),
1141                             });
1142                         push(@names, qw(*QueueLen));
1143                     } elsif ( $type =~ /^info/ ) {
1144                         push(@values,  \%Info);
1145                         push(@names, qw(*Info));
1146                     } elsif ( $type =~ /^hosts/ ) {
1147                         push(@values,  \%Status);
1148                         push(@names, qw(*Status));
1149                     } elsif ( $type =~ /^host\((.*)\)/ ) {
1150                         my $h = $bpc->uriUnesc($1);
1151                         if ( defined($Status{$h}) ) {
1152                             push(@values,  {
1153                                     %{$Status{$h}},
1154                                     BgQueueOn => $BgQueueOn{$h},
1155                                     UserQueueOn => $UserQueueOn{$h},
1156                                     CmdQueueOn => $CmdQueueOn{$h},
1157                                 });
1158                             push(@names, qw(*StatusHost));
1159                         } else {
1160                             print(LOG $bpc->timeStamp,
1161                                       "Unknown host $h for status request\n");
1162                         }
1163                     } else {
1164                         print(LOG $bpc->timeStamp,
1165                                   "Unknown status request $type\n");
1166                     }
1167                 }
1168                 $dump = Data::Dumper->new(\@values, \@names);
1169                 $dump->Indent(0);
1170                 $reply = $dump->Dump;
1171             } elsif ( $cmd =~ /^link\s+(.+)/ ) {
1172                 my($host) = $1;
1173                 $host = $bpc->uriUnesc($host);
1174                 QueueLink($host);
1175             } elsif ( $cmd =~ /^log\s+(.*)/ ) {
1176                 print(LOG $bpc->timeStamp, "$1\n");
1177             } elsif ( $cmd =~ /^quit/ || $cmd =~ /^exit/ ) {
1178                 $nbytes = 0;
1179                 last;
1180             } else {
1181                 print(LOG $bpc->timeStamp, "Unknown command $cmd\n");
1182                 $reply = "error: bad command $cmd";
1183             }
1184             #
1185             # send a reply to the client, at a minimum "ok\n".
1186             #
1187             $reply = "ok" if ( $reply eq "" );
1188             $reply .= "\n";
1189             syswrite($Clients{$client}{fh}, $reply, length($reply));
1190         }
1191         #
1192         # Detect possible denial-of-service attack from sending a huge line
1193         # (ie: never terminated).  32K seems to be plenty big enough as
1194         # a limit.
1195         #
1196         if ( length($Clients{$client}{mesg}) > 32 * 1024 ) {
1197             print(LOG $bpc->timeStamp, "Line too long from client"
1198                         . " '$Clients{$client}{clientName}':"
1199                         . " shutting down client connection\n");
1200             $nbytes = 0;
1201         }
1202         #
1203         # Shut down the client connection if we read EOF
1204         #
1205         if ( $nbytes <= 0 ) {
1206             close($Clients{$client}{fh});
1207             vec($FDread, $Clients{$client}{fn}, 1) = 0;
1208             delete($Clients{$client});
1209         }
1210     }
1211     #
1212     # Accept any new connections on each of our listen sockets
1213     #
1214     if ( vec($fdRead, fileno(SERVER_UNIX), 1) ) {
1215         local(*CLIENT);
1216         my $paddr = accept(CLIENT, SERVER_UNIX);
1217         $ClientConnCnt++;
1218         $Clients{$ClientConnCnt}{clientName} = "unix socket";
1219         $Clients{$ClientConnCnt}{mesg} = "";
1220         $Clients{$ClientConnCnt}{fh}   = *CLIENT;
1221         $Clients{$ClientConnCnt}{fn}   = fileno(CLIENT);
1222         vec($FDread, $Clients{$ClientConnCnt}{fn}, 1) = 1;
1223         #
1224         # Generate and send unique seed for MD5 digests to avoid
1225         # replay attacks.  See BackupPC::Lib::ServerMesg().
1226         #
1227         my $seed = time . ",$ClientConnCnt,$$,0\n";
1228         $Clients{$ClientConnCnt}{seed}    = $seed;
1229         $Clients{$ClientConnCnt}{mesgCnt} = 0;
1230         syswrite($Clients{$ClientConnCnt}{fh}, $seed, length($seed));
1231     }
1232     if ( $ServerInetPort > 0 && vec($fdRead, fileno(SERVER_INET), 1) ) {
1233         local(*CLIENT);
1234         my $paddr = accept(CLIENT, SERVER_INET);
1235         my($port,$iaddr) = sockaddr_in($paddr); 
1236         my $name = gethostbyaddr($iaddr, AF_INET);
1237         $ClientConnCnt++;
1238         $Clients{$ClientConnCnt}{mesg} = "";
1239         $Clients{$ClientConnCnt}{fh}   = *CLIENT;
1240         $Clients{$ClientConnCnt}{fn}   = fileno(CLIENT);
1241         $Clients{$ClientConnCnt}{clientName} = "$name:$port";
1242         vec($FDread, $Clients{$ClientConnCnt}{fn}, 1) = 1;
1243         #
1244         # Generate and send unique seed for MD5 digests to avoid
1245         # replay attacks.  See BackupPC::Lib::ServerMesg().
1246         #
1247         my $seed = time . ",$ClientConnCnt,$$,$port\n";
1248         $Clients{$ClientConnCnt}{seed}    = $seed;
1249         $Clients{$ClientConnCnt}{mesgCnt} = 0;
1250         syswrite($Clients{$ClientConnCnt}{fh}, $seed, length($seed));
1251     }
1252 }
1253
1254 ###########################################################################
1255 # Miscellaneous subroutines
1256 ###########################################################################
1257
1258 #
1259 # Write the current status to $TopDir/log/status.pl
1260 #
1261 sub StatusWrite
1262 {
1263     my($dump) = Data::Dumper->new(
1264              [  \%Info, \%Status],
1265              [qw(*Info   *Status)]);
1266     $dump->Indent(1);
1267     if ( open(STATUS, ">", "$TopDir/log/status.pl") ) {
1268         print(STATUS $dump->Dump);
1269         close(STATUS);
1270     }
1271 }
1272
1273 #
1274 # Queue all the hosts for backup.  This means queuing all the fixed
1275 # ip hosts and all the dhcp address ranges.  We also additionally
1276 # queue the dhcp hosts with a -e flag to check for expired dumps.
1277 #
1278 sub QueueAllPCs
1279 {
1280     foreach my $host ( sort(keys(%$Hosts)) ) {
1281         delete($Status{$host}{backoffTime})
1282                 if ( defined($Status{$host}{backoffTime})
1283                   && $Status{$host}{backoffTime} < time );
1284         next if ( defined($Jobs{$host})
1285                 || $BgQueueOn{$host}
1286                 || $UserQueueOn{$host}
1287                 || $CmdQueueOn{$host} ); 
1288         if ( $Hosts->{$host}{dhcp} ) {
1289             $Status{$host}{dhcpCheckCnt}++;
1290             if ( $RunNightlyWhenIdle ) {
1291                 #
1292                 # Once per night queue a check for DHCP hosts that just
1293                 # checks for expired dumps.  We need to do this to handle
1294                 # the case when a DHCP host has not been on the network for
1295                 # a long time, and some of the old dumps need to be expired.
1296                 # Normally expiry checks are done by BackupPC_dump only
1297                 # after the DHCP hosts has been detected on the network.
1298                 #
1299                 unshift(@BgQueue,
1300                     {host => $host, user => "BackupPC", reqTime => time,
1301                      dhcp => 0, dumpExpire => 1});
1302                 $BgQueueOn{$host} = 1;
1303             }
1304         } else {
1305             #
1306             # this is a fixed ip host: queue it
1307             #
1308             unshift(@BgQueue,
1309                 {host => $host, user => "BackupPC", reqTime => time,
1310                  dhcp => $Hosts->{$host}{dhcp}});
1311             $BgQueueOn{$host} = 1;
1312         }
1313     }
1314     foreach my $dhcp ( @{$Conf{DHCPAddressRanges}} ) {
1315         for ( my $i = $dhcp->{first} ; $i <= $dhcp->{last} ; $i++ ) {
1316             my $ipAddr = "$dhcp->{ipAddrBase}.$i";
1317             next if ( defined($Jobs{$ipAddr})
1318                     || $BgQueueOn{$ipAddr}
1319                     || $UserQueueOn{$ipAddr}
1320                     || $CmdQueueOn{$ipAddr} ); 
1321             #
1322             # this is a potential dhcp ip address (we don't know the
1323             # host name yet): queue it
1324             #
1325             unshift(@BgQueue,
1326                 {host => $ipAddr, user => "BackupPC", reqTime => time,
1327                  dhcp => 1});
1328             $BgQueueOn{$ipAddr} = 1;
1329         }
1330     }
1331 }
1332
1333 #
1334 # Queue a BackupPC_link for the given host
1335 #
1336 sub QueueLink
1337 {
1338     my($host) = @_;
1339
1340     return if ( $CmdQueueOn{$host} );
1341     $Status{$host}{state}    = "Status_link_pending";
1342     $Status{$host}{needLink} = 0;
1343     unshift(@CmdQueue, {
1344             host    => $host,
1345             user    => "BackupPC",
1346             reqTime => time,
1347             cmd     => ["$BinDir/BackupPC_link",  $host],
1348         });
1349     $CmdQueueOn{$host} = 1;
1350 }
1351
1352 #
1353 # Read the hosts file, and update Status if any hosts have been
1354 # added or deleted.  We also track the mtime so the only need to
1355 # update the hosts file on changes.
1356 #
1357 # This function is called at startup, SIGHUP, and on each wakeup.
1358 # It returns 1 on success and undef on failure.
1359 #
1360 sub HostsUpdate
1361 {
1362     my($force) = @_;
1363     my $newHosts;
1364     #
1365     # Nothing to do if we already have the current hosts file
1366     #
1367     return 1 if ( !$force && defined($Hosts)
1368                           && $Info{HostsModTime} == $bpc->HostsMTime() );
1369     if ( !defined($newHosts = $bpc->HostInfoRead()) ) {
1370         print(LOG $bpc->timeStamp, "Can't read hosts file!\n");
1371         return;
1372     }
1373     print(LOG $bpc->timeStamp, "Reading hosts file\n");
1374     $Hosts = $newHosts;
1375     $Info{HostsModTime} = $bpc->HostsMTime();
1376     #
1377     # Now update %Status in case any hosts have been added or deleted
1378     #
1379     foreach my $host ( sort(keys(%$Hosts)) ) {
1380         next if ( defined($Status{$host}) );
1381         $Status{$host}{state} = "Status_idle";
1382         print(LOG $bpc->timeStamp, "Added host $host to backup list\n");
1383     }
1384     foreach my $host ( sort(keys(%Status)) ) {
1385         next if ( $host eq $bpc->trashJob
1386                      || $host eq $bpc->adminJob
1387                      || defined($Hosts->{$host})
1388                      || defined($Jobs{$host})
1389                      || $BgQueueOn{$host}
1390                      || $UserQueueOn{$host}
1391                      || $CmdQueueOn{$host} );
1392         print(LOG $bpc->timeStamp, "Deleted host $host from backup list\n");
1393         delete($Status{$host});
1394     }
1395     return 1;
1396 }
1397
1398 #
1399 # Remember the signal name for later processing
1400 #
1401 sub catch_signal
1402 {
1403     if ( $SigName ) {
1404         $SigName = shift;
1405         foreach my $host ( keys(%Jobs) ) {
1406             kill(2, $Jobs{$host}{pid});
1407         }
1408         #
1409         # In case we are inside the exit handler, reopen the log file
1410         #
1411         close(LOG);
1412         LogFileOpen();
1413         print(LOG "Fatal error: unhandled signal $SigName\n");
1414         unlink("$TopDir/log/BackupPC.pid");
1415         confess("Got new signal $SigName... quitting\n");
1416     }
1417     $SigName = shift;
1418 }
1419
1420 #
1421 # Open the log file and point STDOUT and STDERR there too
1422 #
1423 sub LogFileOpen
1424 {
1425     mkpath("$TopDir/log", 0, 0777) if ( !-d "$TopDir/log" );
1426     open(LOG, ">>$TopDir/log/LOG")
1427             || die("Can't create LOG file $TopDir/log/LOG");
1428     close(STDOUT);
1429     close(STDERR);
1430     open(STDOUT, ">&LOG");
1431     open(STDERR, ">&LOG");
1432     select(LOG);    $| = 1;
1433     select(STDERR); $| = 1;
1434     select(STDOUT); $| = 1;
1435 }
1436
1437 #
1438 # Initialize the unix-domain and internet-domain sockets that
1439 # we listen to for client connections (from the CGI script and
1440 # some of the BackupPC sub-programs).
1441 #
1442 sub ServerSocketInit
1443 {
1444     if ( !defined(fileno(SERVER_UNIX)) ) {
1445         #
1446         # one-time only: initialize unix-domain socket
1447         #
1448         if ( !socket(SERVER_UNIX, PF_UNIX, SOCK_STREAM, 0) ) {
1449             print(LOG $bpc->timeStamp, "unix socket() failed: $!\n");
1450             exit(1);
1451         }
1452         my $sockFile = "$TopDir/log/BackupPC.sock";
1453         unlink($sockFile);
1454         if ( !bind(SERVER_UNIX, sockaddr_un($sockFile)) ) {
1455             print(LOG $bpc->timeStamp, "unix bind() failed: $!\n");
1456             exit(1);
1457         }
1458         if ( !listen(SERVER_UNIX, SOMAXCONN) ) {
1459             print(LOG $bpc->timeStamp, "unix listen() failed: $!\n");
1460             exit(1);
1461         }
1462         vec($FDread, fileno(SERVER_UNIX), 1) = 1;
1463     }
1464     return if ( $ServerInetPort == $Conf{ServerPort} );
1465     if ( $ServerInetPort > 0 ) {
1466         vec($FDread, fileno(SERVER_INET), 1) = 0;
1467         close(SERVER_INET);
1468         $ServerInetPort = -1;
1469     }
1470     if ( $Conf{ServerPort} > 0 ) {
1471         #
1472         # Setup a socket to listen on $Conf{ServerPort}
1473         #
1474         my $proto = getprotobyname('tcp');
1475         if ( !socket(SERVER_INET, PF_INET, SOCK_STREAM, $proto) ) {
1476             print(LOG $bpc->timeStamp, "inet socket() failed: $!\n");
1477             exit(1);
1478         }
1479         if ( !setsockopt(SERVER_INET, SOL_SOCKET, SO_REUSEADDR, pack("l",1)) ) {
1480             print(LOG $bpc->timeStamp, "setsockopt() failed: $!\n");
1481             exit(1);
1482         }
1483         if ( !bind(SERVER_INET, sockaddr_in($Conf{ServerPort}, INADDR_ANY)) ) {
1484             print(LOG $bpc->timeStamp, "inet bind() failed: $!\n");
1485             exit(1);
1486         }
1487         if ( !listen(SERVER_INET, SOMAXCONN) ) {
1488             print(LOG $bpc->timeStamp, "inet listen() failed: $!\n");
1489             exit(1);
1490         }
1491         vec($FDread, fileno(SERVER_INET), 1) = 1;
1492         $ServerInetPort = $Conf{ServerPort};
1493     }
1494 }