#! /usr/bin/perl

# $Id: fcopy 4167 2006-11-26 14:59:12Z lange $
#*********************************************************************
#
# fcopy -- copy files using FAI classes and preserve directory structure
#
# This script is part of FAI (Fully Automatic Installation)
# Copyright (C) 2000-2006 Thomas Lange, lange@informatik.uni-koeln.de
# Universitaet zu Koeln
#
#*********************************************************************
# 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.,
# 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
#*********************************************************************

my $version = "Version 2.2.10, 26-november-2006";

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;

use vars qw/*name/;

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# 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 %changed;
my %lastclass;
my $modeset;
my $nobackup;
my $opt_update;
my $backupdir;
my @ignoredirs = qw'CVS .svn .arch-ids {arch}';

# 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);

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

  # copy file $prefix/$source/$class to $target/$source
  my ($prefix,$source,$target) = @_;
  my ($class,$sourcefile,$destfile);
  # 'normalize' source filenames: very important for updating !
  $source =~ s/^(\.\/|\/)*//;

  my $ps = "$prefix/$source";
  $ps =~ s#//#/#;
  my $tpath = "$target/" . dirname $source;
  my $preserve = 0;
  my $logcomment = "";
  my ($tmpfh,$tmpfile);

  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/$_"; }
  $destfile = "$target/$source";

  my $backupfile = $backupdir ? "$backupdir/$source" : "$destfile.pre_fcopy";
  my $bpath = dirname $backupfile;

  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;
  }
  warn "using class: $class\n" if $debug;
  $tmpfile = $sourcefile = "$ps/$class";

  # do nothing if source and destination files are equal
  if ($opt_update and not -x "$ps/preinst") {
    # compare logically
    if ($lastclass{$source}) {
      # $source has already been copied last time

      if ($lastclass{$source} ne $class) {
        $logcomment = "\t# changed class" if $logfile;
      } else {
        if ($changed{"$source/$class"} or
            $changed{"$source/postinst"} or
            $changed{"$source/file-modes"}) {
          $logcomment = "\t# changed file" if $logfile;
        } else {
          $logcomment = "\t# preserved (logical)" if $logfile;
          $preserve = 1;
        }
      }
    } else {
      $logcomment = "\t# new (logical)" if $logfile;
    }
  } else {
    # compare literally
    if ( -x "$ps/preinst" ) {
      warn "preinst script found, switching to literal change detection" if
        ($opt_P and $debug);
      ($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);
      runscript("preinst",$ps,$tmpfile,$class);
    };

    if ( compare($tmpfile,$destfile)) {
      $logcomment="\t# new (literal)";
    } else {
      $logcomment="\t# preserved (literal)" if $logfile;
      $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="\t# magically disappeared (maybe purged)";
    $preserve=0;
  }

  print LOGFILE "$source\t$class$logcomment\n" if $logfile;
  if ($preserve) {
    warn "preserving $source \n";
    _unlink($tmpfile) unless ($tmpfile eq $sourcefile);
    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) unless ($tmpfile eq $sourcefile);
    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));
  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) unless ($tmpfile eq $sourcefile);
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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 runscript {

  my ($scriptname,$sourcefile,$destfile,$class) = @_;
  return unless -x "$sourcefile/$scriptname";
  warn "executing $sourcefile/$scriptname $class $destfile\n" if $debug;
  return if $dryrun; # do not execute if -n or FCOPY_DRYRUN was given
  system "$sourcefile/$scriptname $class $destfile";
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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 "name2id $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);
  # get mtime,uid,gid,mode from source file
  my ($stime,@defmodes) = (stat("$sourcefile/$class"))[9,4,5,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>) {
    # skip empty lines
    next if /^\s*$/;
    ($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_status {
  my $n = my @status_files=split(/,/,$opt_update);
  ($n != 2) && die "fcopy: need both log and changes file\n";

  open(LASTLOG,$status_files[0]);
  while (<LASTLOG>) {
    s/\#.*//g;
    chomp;
    my ($source,$class) = split(/\s/,$_,2);
    $class=~s/\s*//g;
    $lastclass{$source} = $class;
  }
  close(LASTLOG);

  $_=$source; /([^\/]+)$/;
  my $source_base = $1;
  open(CHANGES,$status_files[1]);
  while (<CHANGES>) {
    s/\#.*//g;
    chomp;
    m#$source_base/(\S+)$# and $changed{$1} = 1;
  }
  close(CHANGES);
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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. $version

   Copyright (C) 2001-2006 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.
   -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.
   -P log,changes       Copy if class or source for class has changed since
                        previous run
   -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.

Report bugs to <lange\@informatik.uni-koeln.de>.
EOF
  exit 0;
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# main program

$|=1;
getopts('Ms:t:rm:vidDc:C:hF:lL:P:Bb:I:Un') || usage;
$opt_h && usage;
$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;
}

if ($ENV{FCOPY_LASTLOG} and $ENV{FCOPY_UPDATELOG}) {
	$opt_update = "$ENV{FCOPY_LASTLOG},$ENV{FCOPY_UPDATELOG}";
}
$opt_P and $opt_update=$opt_P;
$opt_update and read_status();

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

# last class has highest priority
$ENV{classes} and @classes = reverse 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;
$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;