fai-client 4.0.8~deb7u1 / usr / sbin / fcopy

#! /usr/bin/perl

#*********************************************************************
#
# fcopy -- copy files using FAI classes and preserve directory structure
#
# This script is part of FAI (Fully Automatic Installation)
# Copyright (C) 2000-2012 Thomas Lange, lange@informatik.uni-koeln.de
# Universitaet zu Koeln
# Copyright (C) 2001-2005 Henning Glawe, glaweh@physik.fu-berlin.de
# Freie Univeritaet Berlin
#
#*********************************************************************
# 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.
#
# A copy of the GNU General Public License is available as
# '/usr/share/common-licences/GPL' in the Debian GNU/Linux distribution
# or on the World Wide Web at http://www.gnu.org/copyleft/gpl.html.  You
# can also obtain it by writing to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
#*********************************************************************

use strict;
use File::Copy;
use File::Compare;
use File::Find;
use File::Path;
use File::Basename;
use File::Spec;
use File::Temp qw/tempfile/;
use Getopt::Std;

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Global variables
my $debug;
my $error = 0;
my $verbose;
my $target;
my $source;
my $logfile;
my @classes;
my $dryrun;

my @opt_modes;
my @rlist;
my $modeset;
my $nobackup;
my $backupdir;
my @ignoredirs = qw'CVS .svn .arch-ids {arch} .git';

# getopts:
our ($opt_s, $opt_t, $opt_r, $opt_m, $opt_M, $opt_v, $opt_d, $opt_D, $opt_i);
our ($opt_B, $opt_c, $opt_C, $opt_h, $opt_F, $opt_l, $opt_L, $opt_P, $opt_b);
our ($opt_I, $opt_U, $opt_n, $opt_H);

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub copy_one {

  # copy file $prefix/$source/$class to $target/$source
  my ($prefix,$source,$target) = @_;

  my ($class,$sourcefile,$destfile,$sourcelink);
  my ($tmpfh,$tmpfile);
  my ($ps,$tpath,$bpath,$backupfile);
  my $preserve = 0; # if 1, the destination remains unchanged
  my $preinst  = 0; # remember if a tmpfile was used, needed later for unlink
  my $logcomment = "";

  # 'normalize' source filenames: very important for updating !
  $source =~ s/^(\.\/|\/)*//;

  $ps = "$prefix/$source";
  $ps =~ s#//#/#;
  $tpath = "$target/" . dirname $source;
  $destfile = "$target/$source";
  $backupfile = $backupdir ? "$backupdir/$source" : "$destfile.pre_fcopy";
  $bpath = dirname $backupfile;

  warn "copy_one: source: $source: ps: $ps tpath: $tpath\n" if $debug;

  # $prefix/$source must be a directory
  if (-f $ps) { ewarn("$ps is a file, but must be a directory containing templates.");return };
  unless (-d $ps) { ewarn("Nonexisting directory $ps. No files copied.");return }

  # use the last class for which a file exists
  foreach (@classes) { $class = $_,last if -f "$ps/$_" || ($opt_H && -l "$ps/$_"); }

  # if no class matches, remove destination or move it to the backup file
  unless (defined $class) {
    ewarn("no matching file for any class for $source defined.");
    # do not copy
    if ($opt_d and -f $destfile) {
      print LOGFILE "$source\tNONE\t# removed (no matching class)\n" if $logfile;
      if ($nobackup) {
        _unlink($destfile) || ewarn("Could not remove file $destfile");
      } else {
        _mkpath($bpath,$debug,0755) unless -d $bpath;
        _move($destfile,$backupfile) if -d $bpath;;
      }
    }
    return;
  }

  # a class matches
  warn "using class: $class\n" if $debug;
  $tmpfile = $sourcefile = "$ps/$class";

  # read symlink
  if ($opt_H and -l $sourcefile) {
    $sourcelink = readlink($sourcefile);
    if (!defined($sourcelink)) {
      ewarn("reading symlink $sourcefile failed. $!") ;
      return;
    }
  }

  # execute preinst script
  if ( -x "$ps/preinst" ) {
    $preinst = 1;        # a tmpfile is used because of preinst script
    ($tmpfh,$tmpfile)=tempfile("fcopy.XXXXXX",DIR=>File::Spec->tmpdir());
    warn "preinst script found, copying $sourcefile to $tmpfile" if $debug;
    ewarn("copying $sourcefile for preinst processing failed !") unless
      _copy($sourcefile,$tmpfh);
    if (runscript("preinst",$ps,$tmpfile,$class)) {
      ewarn("preinst for $sourcefile failed; not proceeding");
      _unlink($tmpfile);
      return 0;
    }
  }

  # compare symlinks or real files
  if (defined($sourcelink)) {
    # it doesn't harm if the readlink failes
    if ((-l $destfile) and (readlink($destfile) eq $sourcelink)) {
      $logcomment="preserved symlink";
      $preserve = 1;
    } else {
      $logcomment="new symlink";
    }
  } else {
    if ( compare($tmpfile,$destfile)) {
      $logcomment="new file";
    } else {
      $logcomment="preserved file";
      $preserve = 1;
    }
  }

  #if a package is being purged, our information about its config files is
  #wrong, so first check if they exist. if not, don't preserve, but copy
  if ($preserve && ! -e $destfile) {
    $logcomment="magically disappeared (maybe purged or dangling symlink)";
    $preserve=0;
  }

  print LOGFILE "$source\t$class\t# $logcomment\n" if $logfile;
  # the destination remains unchanged
  if ($preserve) {
    warn "preserving $source \n";
    _unlink($tmpfile) if $preinst;
    set_mode($ps,$destfile,$class); # set mode even no file was copied
    return;
  }

  # if destination is a symlink and -l is given, complain about it
  if ($opt_l && -l $destfile) {
    ewarn("Destination $destfile is a symlink");
    _unlink($tmpfile) if $preinst;
    return;
  }

  # create subdirectories if they do not exist
  _mkpath($tpath,$debug,0755) unless -d $tpath;

  # save existing file, add suffix .pre_fcopy
  # what should I do if $destfile is a symlink?
  $nobackup or (-f $destfile and
    (-d $bpath or _mkpath($bpath,$debug,0755)) and _move($destfile,$backupfile));

  # handle symlink
  if (defined($sourcelink)) {
    # remove destination if either a regular file or a symlink
    # complain if existst but neither of these
    if (-f $destfile or -l $destfile) {
      if (!_unlink($destfile)) {
        ewarn("removing destfile $destfile for symlink $sourcefile failed. $!") ;
        return;
      }
    } elsif (-e $destfile) {
      ewarn("destination $destfile for symlink $sourcefile is neither a regular file nor a symlink $!") ;
      return;
    }
    if (_symlink($sourcelink, $destfile)) {
      print "fcopy: symlinked $sourcefile -> $sourcelink to $destfile\n" ;
      runscript("postinst",$ps,$destfile,$class);
    } else {
      ewarn("copy symlink $sourcefile -> $sourcelink to $destfile failed. $!") ;
    }
  } else {
    # handle ordinary file
    if (_copy($tmpfile,$destfile)) {
      print "fcopy: copied $sourcefile to $destfile\n" ;
      set_mode($ps,$destfile,$class);
      runscript("postinst",$ps,$destfile,$class);
    } else {
      ewarn("copy $sourcefile to $destfile failed. $!") ;
    }
  }
  _unlink($tmpfile) if $preinst;
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub _mkpath {

  return 1 if $dryrun; # do not execute if -n or FCOPY_DRYRUN was given
  mkpath(@_);
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub _unlink {

  return 1 if $dryrun; # do not execute if -n or FCOPY_DRYRUN was given
  unlink(@_);
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub _move {

  return 1 if $dryrun; # do not execute if -n or FCOPY_DRYRUN was given
  move(@_);
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub _copy {

  return 1 if $dryrun; # do not execute if -n or FCOPY_DRYRUN was given
  copy(@_);
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub _symlink {

  return 1 if $dryrun; # do not execute if -n or FCOPY_DRYRUN was given
  my($from,$to) = @_;
  symlink($from,$to); # make perl -wc happy
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub runscript {

  # returns 0 on success, 1 if the script failed

  my ($scriptname,$sourcefile,$destfile,$class) = @_;
  return 1 unless -x "$sourcefile/$scriptname";
  warn "executing $sourcefile/$scriptname $class $destfile\n" if $debug;
  return 0 if $dryrun; # do not execute if -n or FCOPY_DRYRUN was given
  system "$sourcefile/$scriptname $class $destfile";
  my $rc = $?>>8;
  if ($rc) {
    warn "ERROR: $scriptname returned code $rc\n";
    $error = 1;
    return 1;
  }
  return 0;
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub name2num {

  # convert names to numeric uid, gid
  my ($user, $group) = @_;
  my ($uid, $gid);

  if ( !defined( $ENV{ROOTCMD} ) || $ENV{ROOTCMD} =~ /^\s*$/ ) {
    $uid = ($user  =~ /^\d+$/) ? $user  : getpwnam $user;
    $gid = ($group =~ /^\d+$/) ? $group : getgrnam $group;
  } else {
    $uid = ($user  =~ /^\d+$/) ? $user  : `$ENV{ROOTCMD} perl -e '\$uid = getpwnam "$user"; print \$uid'`;
    $gid = ($group =~ /^\d+$/) ? $group : `$ENV{ROOTCMD} perl -e '\$gid = getgrnam "$group"; print \$gid'`;
  }
  warn "name2num $user = $uid ; $group = $gid\n" if $debug;
  return ($uid,$gid);
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub set_mode {

  # set target file's owner, group, mode and time
  # use owner,group,mode from -m or from the file file-modes or
  # use the values from the source file
  my ($sourcefile,$destfile,$class) = @_;
  my ($uid,$gid,$owner,$group,$mode);
  my ($stime,@defmodes);

  # get mtime,uid,gid,mode from source file or from -m
  if ($modeset) { # use -m values
    @defmodes = @opt_modes;
    $stime = (stat("$sourcefile/$class"))[9];
  } else {
    # get mtime,uid,gid,mode from source file
    ($stime,@defmodes) = (stat("$sourcefile/$class"))[9,4,5,2];
  }

  # get mtime,uid,gid,mode from destination file
  my ($dtime,@ddefmodes) = (stat("$destfile"))[9,4,5,2];
  # compare time,uid,gid and mode of source file and target file
  # if different: change the values
  return if ($stime == $dtime && (($ddefmodes[0] == $defmodes[0]) &&
      ($ddefmodes[1] == $defmodes[1]) && ($ddefmodes[2] == $defmodes[2])));

  if ($modeset) { # use -m values
    ($owner,$group,$mode) = @opt_modes;
  } elsif (-f "$sourcefile/file-modes"){
    ($owner,$group,$mode) = read_file_mode("$sourcefile/file-modes",$class);
  } else { # use values from source file
    ($owner,$group,$mode) = @defmodes;
  }

  ($uid,$gid) = name2num($owner,$group);
  warn "chown/chmod u:$uid g:$gid m:$mode $destfile\n" if $debug;
  return if $dryrun; # do not execute if -n or FCOPY_DRYRUN was given
  chown ($uid,$gid,     $destfile) || ewarn("chown $owner $group $destfile failed. $!");
  chmod ($mode,         $destfile) || ewarn("chmod $mode $destfile failed. $!");
  utime ($stime,$stime, $destfile) || ewarn("utime for $destfile failed. $!");
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub check_mopt {

  # save and check -m options
  $modeset = 1;
  my $n = @opt_modes = split(/,/,$opt_m);
  ($n != 3) &&
    die "fcopy: wrong number of options for -m. Exact 3 comma separated items needed.\n";
   unless ($opt_modes[2] =~/^[0-7]+$/) {
     die "fcopy: file mode should be an octal number. Value is: $opt_modes[2]\n";
   }
  $opt_modes[2] = oct($opt_modes[2]);
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub read_file_mode {

  my ($modefile,$class) = @_;
  my ($owner,$group,$mode,$fclass,@defaults);

  warn "reading $modefile\n" if $verbose;
  open (MODEFILE,"<$modefile") || die "fcopy: can't open $modefile\n";
  while (<MODEFILE>) {
    next if /^\s*$/;     # skip empty lines
    next if /^#/;        # skip comment lines
    ($owner,$group,$mode,$fclass) = split;
    $mode = oct($mode);
    # class found
    return ($owner,$group,$mode) if ($fclass eq $class);
    # when no class is specified use data for all classes
    $fclass or @defaults = ($owner,$group,$mode);
  }
  close MODEFILE;
  return @defaults if @defaults;
  ewarn("no modes found for $class in $modefile");
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub read_classes {

  # read class names from a file
  my $file = shift;
  my @classes;

  open(CLASS,$file) || die "fcopy: can't open class file $file. $!\n";
  while (<CLASS>) {
    next if /^#/;
    push @classes, split;
  }
  close CLASS;
  return @classes;
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub ewarn {

  # print warnings and set error to 1
  $error = 1;
  warn "fcopy: @_\n";
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub read_files {

  # read list of files
  # lines starting with # are comments
  my $file = shift;
  my @list;

  open(LIST,"<$file") || die "fcopy: Can't open file $file\n";
  while (<LIST>) {
    next if /^#/;
    chomp;
    push @list, $_;
  }
  return @list;
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub usage {

  print << "EOF";
fcopy, copy files using classes.

   Copyright (C) 2001-2012 by Thomas Lange

Usage: fcopy [OPTION] ... SOURCE ...

   -B                   Remove backup file.
   -c class[,class]     Define classes.
   -C file              Read classes from file.
   -d                   Remove target file if no class applies.
   -D                   Create debug output.
   -F file              Read list of sources from file.
   -h                   Show summary of options.
   -H                   If source is a symlink, make dest a symlink too.
   -i                   Exit with 0 when no class applies.
   -I dir[,dir]         Override default list of ignored subdirectories
   -l                   Do not copy if destination is a symbolic link.
   -L file              Log destination and used class to file
   -m user,group,mode   Set user, group and mode for copied files.
   -M                   Same as -m root,root,0644
   -n                   Print the commands, but do not execute them.
   -r                   Copy recursivly but skip ignored directories.
   -s source_dir        Look for source files relative to source_dir.
   -t target_dir        Copy files relativ to target_dir.
   -b backup_dir        Where to save backups of overwritten files
   -v                   Create verbose output.

EOF
  exit 0;
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# main program

$|=1;
getopts('Ms:t:rm:vidDc:C:hF:lL:P:Bb:I:UnH') || usage;
$opt_h && usage;
$opt_P and die "Option -P is not supported any more. You may want to use -F\n";
$dryrun = $ENV{FCOPY_DRYRUN} || $opt_n || 0; # is true if in dry-run mode
$dryrun and warn "Dry-run only! Nothing is really executed.\n";
$opt_M and $opt_m = "root,root,0644";  # set default modes
$opt_m && check_mopt();
$nobackup = $opt_B || $ENV{FCOPY_NOBACKUP} || 0;
$verbose = $opt_v || $ENV{verbose} || 0;
$debug   = $opt_D || $ENV{debug}   || 0;
$source  = $opt_s || $ENV{FAI} && "$ENV{FAI}/files" || `pwd`;
chomp $source; # since pwd contains a newline
$target  = $opt_t || $ENV{FAI_ROOT} || $ENV{target};
$target eq "/" or $ENV{'ROOTCMD'}="chroot $target";
$logfile = $opt_L || $ENV{LOGDIR} && "$ENV{LOGDIR}/fcopy.log" || 0;
$logfile and (open(LOGFILE,">> $logfile") || die "can't open logfile: $!");
$backupdir = $opt_b || $ENV{FAI_BACKUPDIR};

if ($opt_U && -f "/var/run/fai/fai_softupdate_is_running" ) {
  print "Skipping this fcopy command during softupdate." if $verbose;
  exit 0;
}

#for postinst scripts
$ENV{'FAI_ROOT'} = $ENV{'target'} = $target;

# last class has highest priority
$ENV{classes} and @classes = split /\s+/,$ENV{classes};
$opt_c and @classes = split /,/,$opt_c;
$opt_C and @classes = read_classes($opt_C);
warn join ' ','Classes:',@classes,"\n" if $debug;
@classes = reverse @classes;
$opt_F and @ARGV = read_files($opt_F);
$ENV{'FCOPY_IGNOREDIRS'} and @ignoredirs = split /\s+/,$ENV{'FCOPY_IGNOREDIRS'};
$opt_I and @ignoredirs = split /,/,$opt_I;

die "fcopy: source undefined\n" unless $source;
die "fcopy: target undefined\n" unless $target;

if ($opt_r) {
  foreach (@ARGV) { $_="$source/$_"; } # add prefix to list of directories
  my %has_subdirs;
  my %ignoredirs;
  map $ignoredirs{$_}=1,@ignoredirs;
  File::Find::find({
    wanted => sub { $has_subdirs{$File::Find::dir} |= -d},
    preprocess => sub { grep ! (-d and exists($ignoredirs{$_})),@_}}, @ARGV);

  foreach (keys %has_subdirs) {
    unless ($has_subdirs{$_}) {
      # remove prefix from all files found
      s#^\Q$source/##;
      push @rlist,$_;
    }
  }
  warn "List of all files found by File::Find::find: @rlist" if $debug;
  @ARGV = @rlist;
}

foreach (@ARGV) { copy_one($source,$_,$target); }
$opt_i && exit 0; # ignore any warning
exit $error;