"Fossies" - the Fresh Open Source Software Archive

Member "BackupPC-4.4.0/bin/BackupPC_archiveStart" (20 Jun 2020, 3899 Bytes) of package /linux/privat/BackupPC-4.4.0.tar.gz:

As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. See also the latest Fossies "Diffs" side-by-side code changes report for "BackupPC_archiveStart": 4.3.2_vs_4.4.0.

    1 #!/usr/bin/perl
    2 #============================================================= -*-perl-*-
    3 #
    4 # BackupPC_archiveStart: start an archive request from the
    5 # command line.
    6 #
    7 # DESCRIPTION
    8 #
    9 #   Usage: BackupPC_archiveStart archiveHost userName hosts...
   10 #
   11 #   Initiates an archive request on archive host archiveHost
   12 #   for the listed hosts.  The latest backup for each host is
   13 #   archived.  The userName is name of the requesting user,
   14 #   which appears in the log files.
   15 #
   16 # AUTHOR
   17 #   Craig Barratt  <cbarratt@users.sourceforge.net>
   18 #
   19 # COPYRIGHT
   20 #   Copyright (C) 2007-2020  Craig Barratt
   21 #
   22 #   This program is free software: you can redistribute it and/or modify
   23 #   it under the terms of the GNU General Public License as published by
   24 #   the Free Software Foundation, either version 3 of the License, or
   25 #   (at your option) any later version.
   26 #
   27 #   This program is distributed in the hope that it will be useful,
   28 #   but WITHOUT ANY WARRANTY; without even the implied warranty of
   29 #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   30 #   GNU General Public License for more details.
   31 #
   32 #   You should have received a copy of the GNU General Public License
   33 #   along with this program.  If not, see <http://www.gnu.org/licenses/>.
   34 #
   35 #========================================================================
   36 #
   37 # Version 4.4.0, released 20 Jun 2020.
   38 #
   39 # See http://backuppc.sourceforge.net.
   40 #
   41 #========================================================================
   42 
   43 use strict;
   44 no utf8;
   45 use lib "__INSTALLDIR__/lib";
   46 use Getopt::Std;
   47 use BackupPC::Lib;
   48 
   49 die("BackupPC::Lib->new failed\n") if ( !(my $bpc = BackupPC::Lib->new) );
   50 
   51 my %opts;
   52 
   53 # no options currently
   54 if ( !getopts("", \%opts) || @ARGV < 3 ) {
   55     print STDERR <<EOF;
   56 usage: $0 archiveHost userName hosts...
   57 EOF
   58     exit(1);
   59 }
   60 
   61 my $Hosts       = $bpc->HostInfoRead();
   62 my $ArchiveHost = $ARGV[0];
   63 my $UserName    = $ARGV[1];
   64 my $TopDir      = $bpc->{Conf}{TopDir};
   65 
   66 if ( !defined($Hosts->{$ArchiveHost}) ) {
   67     print(STDERR "$0: archive host $ArchiveHost doesn't exist... quitting\n");
   68     exit(1);
   69 }
   70 $bpc->ConfigRead($ArchiveHost);
   71 
   72 my(@HostList, @BackupList);
   73 for ( my $i = 2 ; $i < @ARGV ; $i++ ) {
   74     my $host = $ARGV[$i];
   75     if ( !defined($Hosts->{$host}) ) {
   76         print(STDERR "$0: host $host doesn't exist... quitting\n");
   77         exit(1);
   78     }
   79     my @backups = $bpc->BackupInfoRead($host);
   80     if ( !@backups ) {
   81         print(STDERR "$0: host $host doesn't have any backups... quitting\n");
   82         exit(1);
   83     }
   84     push(@HostList,   $host);
   85     push(@BackupList, $backups[$#backups]{num});
   86 }
   87 
   88 my $ReqFileName;
   89 for ( my $i = 0 ; ; $i++ ) {
   90     $ReqFileName = "archiveReq.$$.$i";
   91     last if ( !-f "$TopDir/pc/$ArchiveHost/$ReqFileName" );
   92 }
   93 my %ArchiveReq = (
   94     archiveloc  => $bpc->{Conf}{ArchiveDest},
   95     archtype    => 0,
   96     compression => $bpc->{Conf}{ArchiveComp} eq 'none' ? $bpc->{Conf}{CatPath}
   97     : ($bpc->{Conf}{ArchiveComp} eq 'gzip' ? $bpc->{Conf}{GzipPath} : $bpc->{Conf}{Bzip2Path}),
   98     compext => $bpc->{Conf}{ArchiveComp} eq 'none' ? ''
   99     : ($bpc->{Conf}{ArchiveComp} eq 'gzip' ? '.gz' : '.bz2'),
  100     parfile    => $bpc->{Conf}{ArchivePar},
  101     splitsize  => '0000000',
  102     host       => $ArchiveHost,
  103     HostList   => \@HostList,
  104     BackupList => \@BackupList,
  105     user       => $UserName,
  106     reqTime    => time,
  107 );
  108 my $archive = Data::Dumper->new([\%ArchiveReq], [qw(*ArchiveReq)]);
  109 $archive->Indent(1);
  110 if ( !open(REQ, ">", "$TopDir/pc/$ArchiveHost/$ReqFileName") ) {
  111     print(STDERR "$0: can't open/write request file $TopDir/pc/$ArchiveHost/$ReqFileName... quitting\n");
  112     exit(1);
  113 }
  114 binmode(REQ);
  115 print REQ $archive->Dump;
  116 close(REQ);
  117 $bpc->ServerConnect($bpc->{Conf}{ServerHost}, $bpc->{Conf}{ServerPort});
  118 my $reply = $bpc->ServerMesg("archive $UserName $ArchiveHost $ReqFileName");
  119 $bpc->ServerDisconnect();
  120 print("Sent archive request, reply: $reply\n");
  121 exit(0);