File Coverage

blib/script/applypatch

Criterion	Covered	Total	%
statement	138	229	60.2
branch	86	206	41.7
condition	13	46	28.2
subroutine	14	18	77.7
pod			n/a
total	251	499	50.3

#!/usr/local/bin/perl -w
# applypatch -- apply a 'makepatch' generated patch kit.
# Author          : Johan Vromans
# Created On      : Sat Nov 14 14:34:28 1998
# Last Modified By: Johan Vromans
# Last Modified On: Fri Oct 26 21:52:01 2012
# Update Count    : 149
# Status          : Released

use strict;
use Getopt::Long 2.00;
use File::Basename;
use File::Spec;
use IO::File;
use Text::ParseWords;

################ Common stuff ################

my $my_package = 'Sciurix';
my $my_name    = "applypatch";
my $my_version = "2.05";
my $data_version = '1.0';

################ Globals ################

## Options and defaults.

my $dir;			# source directory
my $check = 0;			# check only
my $retain = 0;			# retain .orig files
my $patch = 'patch -p0 -N';	# patch command
my $verbose = 0;		# verbose processing
my $force = 0;			# allow continuation after trunc/corruption

# Development options (not shown with -help).
my $trace = 0;			# trace (show process)
my $test = 0;			# test (no actual processing)
my $debug = 0;			# extensive debugging info

## Misc

my $applypatch = 0;		# it's for us
my $timestamp;			# create date/time of patch kit
my @workq = ();			# work queue

## Subroutine prototypes

sub app_options ();
sub app_usage ($);
sub copy_input ();
sub execute_patch ();
sub post_patch ();
sub pre_patch ();
sub verify_files ();

################ Program parameters ################

app_options();
$trace ||= $debug;
$verbose ||= $trace;

################ Presets ################

$patch .= " -s" unless $verbose;
my $tmpfile = IO::File->new_tmpfile;

################ The Process ################

# Validate input and copy to temp file.
copy_input ();

# Change dir if requested.
(defined $dir) && (chdir ($dir) || die ("Cannot change to $dir: $!\n"));

# Verify that we are in the right place.
verify_files ();

# Exit if just checking.
die ("Okay\n") if $test && $check;
exit (0) if $check;

# Pre patch: create directories and files.
pre_patch ();

# Run the patch program.
execute_patch ();

# Post patch: adjust timestamps, remove obsolete files and directories.
post_patch ();

die ("Okay\n") if $test;
exit (0);

################ Subroutines ################

sub copy_input () {

    my $lines = 0;		# checksum: #lines
    my $bytes = 0;		# checksum: #bytes
    my $sum = 0;		# checksum: system V sum
    my $all_lines = 0;		# overall checksum: #lines
    my $all_bytes = 0;		# overall checksum: #bytes
    my $all_sum = 0;		# overall checksum: system V sum
    my $patchdata = 0;		# saw patch data
    my $pos = 0;		# start of patch data
    my $endkit = 0;		# saw end of kit
    my $fail = 0;		# failed
    my $patch_checksum_okay = 0;# checksum for the patch was okay

    print STDERR ("Validate input.\n") if $verbose;

    @ARGV = "-" if !@ARGV;
    for my $file (@ARGV) {
      my $argv = new IO::File;
      open($argv, $file) or die "Can't open $file: $!";
      binmode($argv);
      while ( <$argv> ) {
	chomp;
	if ( /^#### Patch data follows ####/ ) {
	    print STDERR (": $_\n") if $trace;
	    $patchdata |= 1;	# bit 0 means: start seen
	    $pos = $tmpfile->getpos;
	    $lines = $bytes = $sum = 0;
	}
	elsif ( /^#### End of Patch data ####/ ) {
	    print STDERR (": $_\n") if $trace;
	    $patchdata |= 2;	# bit 1 means: end seen
	}
	elsif ( /^#### ApplyPatch data follows ####/ ) {
	    print STDERR (": $_\n") if $trace;
	    $applypatch |= 1;
	}
	elsif ( /^#### End of ApplyPatch data ####/ ) {
	    print STDERR (": $_\n") if $trace;
	    $applypatch |= 2;
	}
	elsif ( /^#### End of Patch kit (\[created: ([^\]]+)\] )?####/ ) {
	    print STDERR (": $_\n") if $trace;
	    $endkit = 1;
	    if ( defined $timestamp && defined $2 && $2 ne $timestamp ) {
		warn ("Timestamp mismatch ",
		      "in \"#### End of Patch kit\" line.\n",
		      "  expecting \"$timestamp\", got \"$2\".\n");
		$fail = 1;
	    }
	}
	elsif ( /^#### Patch checksum: (\d+) (\d+) (\d+) ####/ ) {
	    # Checksum for patch data only.
	    # This _MUST_ preceed the overall checksum.
	    print STDERR (": $_\n") if $trace;
	    $patch_checksum_okay = 1;
	    if ( $1 != $lines ) {
		warn ("Linecount error: expecting $1, got $lines.\n");
		$fail = 1;
		$patch_checksum_okay = 0;
	    }
	    if ( $2 != $bytes ) {
		warn ("Bytecount error: expecting $2, got $bytes.\n");
		$fail = 1;
		$patch_checksum_okay = 0;
	    }
	    if ( $3 != $sum ) {
		warn ("Checksum error: expecting $3, got $sum.\n");
		$fail = 1;
		$patch_checksum_okay = 0;
	    }
	}
	elsif ( /^#### Checksum: (\d+) (\d+) (\d+) ####/ ) {
	    print STDERR (": $_\n") if $trace;
	    if ( $patch_checksum_okay ) {
		warn ("Warning: Overall linecount mismatch: ".
		      "expecting $1, got $all_lines.\n")
		  unless $1 == $all_lines || !$verbose;
		warn ("Warning: Overall bytecount mismatch: ".
		      "expecting $2, got $all_bytes.\n")
		  unless $2 == $all_bytes || !$verbose;
		warn ("Warning: Overall checksum mismatch: ".
		      "expecting $3, got $all_sum.\n")
		  unless $3 == $all_sum || !$verbose;
	    }
	    else {
		if ( $1 != $all_lines ) {
		    warn ("Overall linecount error: ".
			  "expecting $1, got $all_lines.\n");
		    $fail = 1;
		}
		if ( $2 != $all_bytes ) {
		    warn ("Overall bytecount error: ".
			  "expecting $2, got $all_bytes.\n");
		    $fail = 1;
		}
		if ( $3 != $all_sum ) {
		    warn ("Overall checksum error: ".
			  "expecting $3, got $all_sum.\n");
		    $fail = 1;
		}
	    }
	}
	elsif ( $applypatch == 1 ) {
	    if ( /^# Data version\s*:\s*(\d+\.\d+)$/ ) {
		print STDERR (": $_\n") if $trace;
		if ( $1 > $data_version ) {
		    warn ("This program is not capable of handling ",
			  "this input data.\n",
			  "Please upgrade to a newer version.\n");
		    $fail = 1;
		}
	    }
	    elsif ( /^# Date generated\s*:\s+(.*)$/ ) {
		$timestamp = $1;
	    }
	    elsif ( /^# (\S) (.*)$/ ) {
		push (@workq, [ $1, shellwords ($2) ]);
	    }
	}
      }
      continue {
	# Calculate checksum.
	$lines++;
	$all_lines++;
	$_ .= "\n";
	$bytes += length ($_);
	$all_bytes += length ($_);
	# System V 'sum' checksum
	$sum = ($sum + unpack ("%16C*", $_)) % 65535;
	$all_sum = ($all_sum + unpack ("%16C*", $_)) % 65535;

	# Copy the line to the temp file.
	print $tmpfile ($_);
      }
      close($argv);
    }

    # If we saw an ApplyPatch data section, it must be reliable.
    if ( $applypatch == 1 ) {
	warn ("ApplyPatch data section not properly terminated.\n");
	$fail = 1;
    }
    elsif ( $applypatch == 2 ) {
	warn ("ApplyPatch data section not reliable.\n");
	$fail = 1;
    }

    if ( $applypatch ) {
	# If we saw a Patch data section, it must be reliable.
	if ( $patchdata == 0 ) {
	    warn ("Patch data section not delimited.\n");
	    $fail = 1;
	}
	elsif ( $patchdata == 1 ) {
	    warn ("Patch data section not properly terminated.\n");
	    $fail = 1;
	}
	elsif ( $patchdata == 2 ) {
	    warn ("Patch data section not reliable.\n");
	    $fail = 1;
	}

	if ($endkit == 0 ) {
	    warn ("Missing \"#### End of Patch kit\" line.\n");
	    $fail = 1;
	}
    }

    if ( $fail ) {
	if ( $force ) {
	    warn ("WARNING: Verification of patch kit failed, ",
		  "continuing anyway.\n");
	}
	else {
	    die ("Verification of patch kit failed, aborting.\n",
		 "Use \"--force\" to override this.\n");
	}
    }

    print STDERR ($applypatch == 3 ? "Apply" : "",
		  "Patch kit apparently okay.\n") if $verbose;

    # Reset file to start of patch data.
    $tmpfile->setpos ($pos);
}

sub verify_files () {

    my $fail = 0;

    print STDERR ("Verify source directory.\n") if $verbose;

    foreach ( @workq ) {
	my ($op, $fn, @args) = @$_;

	if ( $op eq 'c' ) {
	    if ( -f $fn || -d _ ) {
		warn ("Verify error: file $fn must be created, ",
		      "but already exists.\n");
		$fail = 1;
	    }
	}
	elsif ( $op eq 'C' ) {
	    if ( -f $fn || -d _ ) {
		warn ("Verify error: directory $fn must be created, ",
		      "but already exists.\n");
		$fail = 1;
	    }
	}
	elsif ( $op eq 'r' || $op eq 'p' || $op eq 'v' ) {
	    my $sz = -s $fn;
	    if ( defined $sz ) {
		if ( $sz != $args[0] ) {
		    warn ("Verify error: size of $fn should be $args[0], but is ",
			  "$sz.\n");
		    $fail = 1;
		}
	    }
	    else {
		warn ("Verify error: file $fn is missing.\n");
		$fail = 1;
	    }
	}
	elsif ( $op eq 'R' ) {
	    unless ( -d $fn ) {
		warn ("Verify error: directory $fn must be removed, ",
		      "but does not exist.\n");
		$fail = 1;
	    }
	}
    }

    if ( $fail ) {
	if ( $force ) {
	    warn ("WARNING: This does not look like expected source ",
		  "directory, continuing anyway.\n");
	}
	else {
	    warn ("Apparently this is not the expected source directory, ",
		  "aborting.\n");
	    die ("Use \"--force\" to override this.\n");
	}
    }

    print STDERR ("Source directory apparently okay.\n") if $verbose;
}

sub pre_patch () {

    foreach ( @workq ) {
	my ($op, $fn, $size, $mtime, $mode) = @$_;

	if ( $op eq 'C' ) {
	    $mode = oct($mode) & 0777;
	    $mode = 0777 unless $mode; # sanity
	    printf STDERR ("+ mkpath $fn 0%o\n", $mode) if $trace;
	    mkdir ($fn, $mode)
	      || die ("Cannot create directory $fn: $!\n");
	}
    }

    foreach ( @workq ) {
	my ($op, $fn, $size, $mtime, $mode) = @$_;

	if ( $op eq 'c' ) {
	    #$mode = oct($mode) & 0777;
	    #$mode = 0666 unless $mode; # sanity
	    print STDERR ("+ create $fn\n") if $trace;
	    open (F, '>'.$fn)
	      || die ("Cannot create $fn: $!\n");
	    close (F);
	    #printf STDERR ("+ chmod 0%o $fn\n", $mode) if $trace;
	    #chmod ($mode, $fn)
	    #  || warn sprintf ("WARNING: Cannot chmod 0%o $fn: $!\n", $mode);
	}
    }

}


sub _open_patch () {

	my $p = new IO::File;
	$p->open("|$patch") || die ("Cannot open pipe to \"$patch\": $!\n");
	binmode($p);

	return $p
}


sub execute_patch () {

	my $p;

    print STDERR ("+ $patch\n") if $trace;
    if ( $applypatch ) {
	my $lines = 0;
	while ( <$tmpfile> ) {
	    chomp;
	    print STDERR ("++ ", $_, "\n") if $debug;
	    next if $_ eq "#### Patch data follows ####";
	    last if $_ eq "#### End of Patch data ####";
	    $p = _open_patch() unless $p;
	    print $p ($_, "\n");
	    $lines++;
	}
	print STDERR ("+ $lines lines sent to \"$patch\"\n") if $trace;
    }
    else {
	    while ( <$tmpfile> ) {
		    $p = _open_patch() unless $p;
		    print $p ($_)
	    }
    }
	defined $p and
	  $p->close || die ("Possible problems with \"$patch\", status = $?.\n");
}

sub set_utime ($$;$) {
    my ($fn, $mtime, $mode) = @_;
    $mode = (stat ($fn))[2] unless defined $mode;
    chmod (0777, $fn)
      || warn ("WARNING: Cannot utime/chmod a+rwx $fn: $!\n");
    print STDERR ("+ utime $fn $mtime (".localtime($mtime).")\n") if $trace;
    # Set times. Ignore errors for directories since some systems
    # (like MSWin32) do not allow directories to be stamped.
    utime ($mtime, $mtime, $fn)
      || -d $fn || warn ("WARNING: utime($mtime,$fn): $!\n");
    printf STDERR ("+ chmod 0%o $fn\n", $mode) if $trace;
    chmod ($mode, $fn)
      || warn sprintf ("WARNING: Cannot utime/chmod 0%o $fn: $!\n", $mode);
}

sub do_unlink ($) {
    my ($fn) = @_;
    my $mode = (stat($fn))[2];
    chmod (0777, $fn)
      || warn ("WARNING: Cannot unlink/chmod a+rwx $fn: $!\n");
    print STDERR ("+ unlink $fn\n") if $verbose;
    return if unlink ($fn);
    warn ("WARNING: Cannot remove $fn: $!\n");
    chmod ($mode, $fn)
      || warn sprintf ("WARNING: Cannot unlink/chmod 0%o $fn: $!\n", $mode);
}

sub do_rmdir ($) {
    my ($fn) = @_;
    my $mode = (stat($fn))[2];
    chmod (0777, $fn)
      || warn ("WARNING: Cannot rmdir/chmod a+rwx $fn: $!\n");
    print STDERR ("+ rmdir $fn\n") if $verbose;
    return if rmdir ($fn);
    warn ("WARNING: Cannot rmdir $fn: $!\n");
    chmod ($mode, $fn)
      || warn sprintf ("WARNING: Cannot rmdir/chmod 0%o $fn: $!\n", $mode);
}

sub post_patch () {

    my $suffix = $ENV{SIMPLE_BACKUP_SUFFIX} || ".orig";

    foreach ( @workq ) {
	my ($op, $fn, $size, $mtime, $mode) = @$_;

	if ( $op eq 'c' || $op eq 'C' || $op eq 'p' ) {
	    if ( defined $mode ) {
		$mode = oct($mode) & 0777;
		$mode = 0666 unless $mode; # sanity
	    }
	    set_utime ($fn, $mtime, $mode);
	    next if $retain;
	    $fn .= $suffix;
	    if ( -f $fn ) {
		do_unlink ($fn);
	    }
	}
	elsif ( $op eq 'r' ) {
	    print STDERR ("+ unlink $fn\n") if $trace;
	    # Be forgiving, maybe patch already removed the file.
	    if ( -e $fn ) {
		do_unlink ($fn);
	    }
	    else {
		warn ("Apparently, $fn has been removed already.\n");
	    }
	}
	elsif ( $op eq 'R' ) {
	    print STDERR ("+ rmdir $fn\n") if $trace;
	    # Maybe some future version of patch will take care of directories.
	    if ( -e $fn ) {
		do_rmdir ($fn);
	    }
	    else {
		warn ("Apparently, $fn has been removed already.\n");
	    }
	}
    }

}

################ Options and Help ################

sub app_options () {
    my $help = 0;		# handled locally

    # Process options, if any.
    # Make sure defaults are set before returning!
    return unless @ARGV > 0;
    my @opts = ('check'		=> \$check,
		'dir|d=s'	=> \$dir,
		'retain'	=> \$retain,
		'force'		=> \$force,
		'verbose'	=> \$verbose,
		'quiet'		=> sub { $verbose = 0; },
		'patch=s'	=> \$patch,
		'test'		=> \$test,
		'trace'		=> \$trace,
		'debug'		=> \$debug,
		'help'		=> \$help);

    (!GetOptions (@opts) || $help) && app_usage (2);

}

sub app_usage ($) {
    my ($exit) = @_;
    print STDERR <
Usage: $0 [options] patch-kit

    -help		this message
    -dir XXX		change to this directory before executing
    -check              check, but does not execute
    -retain		retain .orig file after patching
    -force              continue after verification failures
    -patch XXX		the patch command, default "$patch"
    -quiet		no information
    -verbose		verbose information
EndOfUsage
    exit $exit if defined $exit && $exit != 0;
}

1;

__END__