#!/usr/bin/env perl

# A post-commit hook script for automatically uploading changed files.
# Author: Duane Griffin (d.griffin@psenterprise.com)

# Copyright (c) 2005 Duane Griffin and Process Systems Enterprise Ltd
# This file is distributed under the same license as Subversion.
# See http://subversion.tigris.org/project_license.html for details.

######################################################################
# Usage and limitations.

# To use it set the upload:host property on a directory containing files and/or 
# directories that you wish to upload. You may list as many hosts as you like,
# one per line. If you wish files to be uploaded to a certain path on the
# destination machine(s) you should set the upload:path property accordingly.
# For example, if the directory has upload:host set to 'kowhai' and upload:path
# set to '/etc/', and the file 'sysconfig/syslog' underneath it is changed, it
# will be uploaded to kowhai:/etc/sysconfig/syslog.

# It is recommended that this script be executed asynchronously by the commit
# hook, and that output (if any) should be mailed to the committer. For
# example, if your post-commit hook is a bash script on Linux you might want
# to run this script from it as follows:

# OUT=`mktemp /tmp/upload-XXXXXXXX` && \
# ./commit-upload.pl $repos $rev > $OUT 2>&1 && \
# if [ -s $OUT ] ; then \
#   echo mail -s "Auto-upload warnings/errors" svn-admin@example.com < $OUT ; \
# fi && \
# rm -f $OUT &

# Changes are uploaded using the command line scp client, although this is
# straight-forward to modify (search for the UPLOAD_CMD variable).

# PLEASE NOTE: For scp to work, the user committing the change must have SSH
# setup to allow the upload to take place without asking for a password, or
# requiring any other interaction.

######################################################################
# TODO.

# * Use SVN Perl bindings instead of invoking cmd-line svnlook
# * Extend to allow multiple upload mechanisms, in particular:
#   - Arbitrary command string
#   - rsync (via SVN-powered File::RsyncP::FileIO implementation)
# * Batch uploads togther for efficiency where possible
# * Handle sym-links
# * PODify all these comments

# Turn on warnings the best way depending on the Perl version.
BEGIN {
  if ( $] >= 5.006_000)
    { require warnings; import warnings; }
  else
    { $^W = 1; }
}

use strict;
use Date::Parse;
use File::Temp qw/ tempdir tempfile /;
use Fcntl ':mode';

######################################################################
# Constants.

my $PROP_PREFIX = "upload";
my $PROP_HOST   = "$PROP_PREFIX:host";
my $PROP_PATH   = "$PROP_PREFIX:path";
my $PROP_EXE    = "svn:executable";
my $PROP_PERMS  = "file:permissions";

my $SVNLOOK = "/usr/bin/svnlook";

# If you wish to use a different upload mechanism modify this command. 
# The $host, $local and $remote variables will be replaced with the host,
# source and destination filenames respectively.
my $UPLOAD_CMD = 'scp -B -q -p $local $host:$remote';

######################################################################
# Configuration section.
# 
# Since the path to svnlook depends upon the local installation
# preferences, check that the required program exists to insure that
# the administrator has set up the script properly.
{
  my $ok = 1;
  foreach my $program ($SVNLOOK) {
    if (-e $program) {
      unless (-x $program) {
        warn "$0: required program `$program' is not executable, ", "edit $0.\n";
        $ok = 0;
      }
    } else {
      warn "$0: required program `$program' does not exist, edit $0.\n";
      $ok = 0;
    }
  }
  exit 1 unless $ok;
}

# Process cmd-line args
my $verbose = 0;
my $dry_run = 0;
while (@ARGV > 2) {
  my $arg = shift;
  if ($arg eq "-v") {
    $verbose = 1;
  } elsif ($arg eq "-n") {
    $dry_run = 1;
  } else {
    &usage;
  }
}

&usage unless @ARGV == 2;

my $repos = shift;
my $rev   = shift;

######################################################################
# Upload changed files based on upload:* properties in path

# Find directories containing changes
my %uploads = get_upload_dirs($repos, $rev);

exit unless %uploads;

# Create temporary directory for staging uploads in
# NOTE: We use a directory not just files in the tmp directory so we can set 
#       arbitrary file permissions without worrying about other users.
my $tmp_dir = tempdir(CLEANUP => 0) 
  or die "Could not create temporary staging directory: $!\n";

# Check for changes that require uploading
open(PATHS , "$SVNLOOK changed $repos --revision=$rev|") 
  or die "Cannot execute svnlook to check changed paths: $!\n";
while (<PATHS>) {
  chomp;
  next unless m/^(.).{2} (.+)$/;

  my ($change, $path) = ($1, $2);
  if ($path =~ m/^(.*\/)([^\/]+)$/) {
    my $dir      = $1;
    my $filename = $2;
    my $upload   = $uploads{$dir};
    next unless $upload;

    if ($change eq 'D') {
      my $hosts = join(", ", @{$$upload{hosts}});
      warn "NYI: Delete file $filename on $hosts\n";
    } else {
      upload_file($repos, $rev, $path, $filename, $upload);
    }
  } else {
    warn "Unexpected format on line $. checking changed paths: $_\n";
  }
}
close PATHS or die "Error executing svnlook to check changed paths: $!\n";

sub usage {
  die "usage: $0 [-v] [-n] REPOS TXN-NAME\n";
}

# Find all directories containing changes
sub get_upload_dirs {
  my ($repos, $rev) = @_;

  my %uploads = ();
  open(DIRS, "$SVNLOOK dirs-changed $repos --revision=$rev|") 
    or die "Cannot execute svnlook to check changed directories: $!\n";
  while (<DIRS>) {
    my $dir = $_;
    chomp($dir);

    # Check whether the directories are configured for uploading
    next if $uploads{$dir};
    my $props = get_upload_props($repos, $rev, $dir);
    next unless $props;

    $uploads{$$props{local_path}} = $props;
  }
  close DIRS or die "Error executing svnlook to check changed directories: $!\n";
  return %uploads;
}

# Look for upload details on segments of a path, working back towards root
sub get_upload_props {
  my ($repos, $rev, $lpath) = @_;

  my ($host, $base_path, $dest_path);
  my @paths = split(/\//, $lpath);
  for (my $index = $#paths; $index >= 0; --$index) {
    $base_path = join("/", @paths[0..$index]);
    $dest_path = join("/", @paths[($index + 1)..$#paths]);

    # Host is a required property for uploading, others are optional
    $host = `$SVNLOOK propget $repos --revision=$rev $PROP_HOST $base_path 2> /dev/null`;
    last unless $?;
  }
  return unless $host;

  # Hosts to upload to are specified one per line
  my @hosts = split(/\n/, $host);

  # Destination path to upload to (optional)
  my $rpath = `$SVNLOOK propget $repos --revision=$rev $PROP_PATH $base_path 2> /dev/null`;
  chomp($rpath);

  my %props = (
    local_path  => $lpath, 
    base_path   => $base_path, 
    dest_path   => $dest_path, 
    hosts       => \@hosts, 
    remote_path => $rpath
  );
  return \%props;
}

# Upload a changed file to one or more destinations
sub upload_file {
  my ($repos, $rev, $path, $filename, $upload) = @_;

  # Use dir in SVN as default path if none is given
  my $dest = $$upload{remote_path};
  $dest = $$upload{dest_path} unless $dest;
  $dest =~ s/^([^\/].*)$/\/$1/;
  $dest =~ s/^(.*[^\/])$/$1\//;

  # Host(s) to upload to
  my @hosts = @{$$upload{hosts}};

  # Create temporary staging file
  my ($fh, $tmp_name) = tempfile( DIR => $tmp_dir );
  close $fh;
  if (system("$SVNLOOK cat $repos --revision=$rev $path > $tmp_name") != 0) {
    warn "Unable to create temporary file $tmp_name from $path: $!\n";
    next;
  }

  # Set file meta-data as best we can
  # NOTE: Ignore chown errors (maybe only attempt it if we know we are root?)
  my ($mode, $user, $group, $mtime) = get_meta_data($repos, $rev, $path);
  chmod($mode, $tmp_name) == 1 or warn "Unable to set mode for $path";
  chown $user, $group, $tmp_name if ($user != -1 || $group != -1);
  if ($mtime) {
    utime $mtime, $mtime, $tmp_name or warn "Unable to set timestamps for $path";
  }

  for my $host (@hosts) {

    # Construct actual command to use to upload this file
    # TODO: There must be a better way to do this!
    my $cmd = $UPLOAD_CMD;
    $cmd =~ s/\$host/$host/g;
    $cmd =~ s/\$local/$tmp_name/g;
    $cmd =~ s/\$remote/${dest}${filename}/g;

    # Upload the file, printing any output to STDERR
    print "Uploading $path to ${host}:${dest}${filename} using:\n  $cmd\n" if $verbose;
    if (!$dry_run) {
      if (open(SEND, "$cmd 2>&1 |")) {
        while (<SEND>) {
          warn $_;
        }
        close SEND or warn "Error uploading $path to ${host}:${dest}${filename}: $!\n";
      } else {
        warn "Upload '$cmd' failed: $!\n";
      }
    }
  }
#  unlink $tmp_name or warn "Could not delete temporary file $tmp_name: $!\n";
}

# Returns file permissions, owner, group and modification time
sub get_meta_data {
  my ($repos, $rev, $path) = @_;
  my ($mode, $user, $group) = get_asvn_perms($repos, $rev, $path);
  if (!defined $mode) {
    $mode = get_default_perms($repos, $rev, $path);
  }
  my $mtime = get_mtime($repos, $rev, $path);
  return ($mode, $user, $group, $mtime);
}

# Returns file permissions, user and group info from asvn properties, if set
sub get_asvn_perms {
  my ($repos, $rev, $path) = @_;

  my ($mode, $user, $group) = (undef, -1, -1);
  my $perms = `$SVNLOOK propget $repos --revision=$rev $PROP_PERMS $path 2> /dev/null`;
  if ($perms =~ m/mode=([0-9]+)/s) {
    $mode = oct($1);
  }
  if ($perms =~ m/user=(\w+)\(([0-9]+)\)/s) {
    $user = $2;
  }
  if ($perms =~ m/group=(\w+)\(([0-9]+)\)/s) {
    $group = $2;
  }

  return ($mode, $user, $group);
}

# Gets the default file permissions, taking svn:executable property into account
sub get_default_perms {
  my ($repos, $rev, $path) = @_;

  my $mode = S_IRUSR|S_IWUSR|S_IRGRP|S_IROTH;
  if (open(EXE, "$SVNLOOK proplist $repos --revision=$rev $path 2>/dev/null |")) {
    while (<EXE>) {
      if (/$PROP_EXE/) {
        $mode |= S_IXUSR|S_IXGRP|S_IXOTH;
        last;
      }
    }
    close EXE;
  } else {
    warn "Error checking for svn:executable on $path: $!\n";
  }
  return $mode;
}

# Returns the file modification time based on the commit time
sub get_mtime {
  my ($repos, $rev, $path) = @_;
  my $tstamp = `$SVNLOOK date $repos --revision $rev`;
  chomp($tstamp);
  return str2time($tstamp);
}