#!/usr/bin/perl -w
# See copyright, etc in below POD section.
########################################################################

use Pod::Usage;
use IO::File;
use strict;
use vars qw ($Debug);

our $VERSION = "2.001";

# Names of servers the user can login to - IE not a NAS appliance like netapp
# Consider using RSVN_SERVERS_REGEXP instead of changing this setting
our $Servers_Regexp_Default = '.*';

#======================================================================
# Parse args that are intended for this script

our $Opt_ReallyRunIt = 1;
our $Opt_ForceWhere;  # can be 'local' or 'remote' or undef

autoflush STDOUT 1;
autoflush STDERR 1;

our @SvnARGV;

while ($ARGV[0]) {
    if ($ARGV[0] eq '--debug') {
        $Debug = 1;
    } elsif ($ARGV[0] eq '--test') {
	$Debug = 1;
        $Opt_ReallyRunIt = 0;
    } elsif ($ARGV[0] eq '--help') {
	print "rsvn Version $VERSION\n";
	pod2usage(-verbose=>2, -exitval => 2);
	exit (1);
    } elsif ($ARGV[0] eq '--local') {
        $Opt_ForceWhere = 'local';
    } elsif ($ARGV[0] eq '--remote') {
        $Opt_ForceWhere = 'remote';
    } elsif ($ARGV[0] eq '--version') {
	print "rsvn Version $VERSION\n";
	push @SvnARGV, $ARGV[0];
	# Fallthru to normal svn
    } else {
        last; # pass all other args to svn
    }
    shift;  # look at next arg
}

push @SvnARGV, @ARGV;
$SvnARGV[0] or die "rsvn: %Error: No command provided; type 'rsvn --help' or 'rsvn help' for more information.\n";

#----------------------------------------------------------------------

# $cmd is the default command to execute.
# If I decide to run it remotely, I will replace $cmd with the ssh command.
my $args = requote_arglist (@SvnARGV);
my $cmd = "svn $args";

my $svncmd = find_svn_command (@SvnARGV);
if (($Opt_ForceWhere||"") ne 'local' && (supported_command ($svncmd) || ($Opt_ForceWhere||"") eq 'remote')) {
    # Find the file server that hosts this disk.
    my ($nfs_server, $server_mount_pt, $local_mount_pt) = find_file_server (@SvnARGV);
    my ($pwd_nfs_server) = find_file_server ('.');
    if ($pwd_nfs_server ne $nfs_server) {
	warn "%Warning: To run remote svn commands, your working directory must be\n";
	warn "%Warning: on the same file server as the svn tree.\n";
	warn "%Warning: Working directory on '$pwd_nfs_server'\n";
	warn "%Warning:          Svn tree on '$nfs_server'\n";
	warn "%Warning: rsvn will run the command locally.\n";
    } elsif (can_login_to($nfs_server)) {
	my $path = `/bin/pwd`;
	chomp $path;
	$path = translate_path ($path, $local_mount_pt, $server_mount_pt);
	warn "ssh to $nfs_server, cd to $path, and do it there\n" if $Debug;
	my $ssh = $ENV{RSVN_SSH} || $ENV{DIRPROJECT_SSH} || "ssh -A -o StrictHostKeyChecking=no";
	$cmd = qq{$ssh $nfs_server "cd $path && svn $args"};
    }
}
print STDERR "Execute command: $cmd\n" if $Debug;
my $status = 256;
$status = system($cmd) if $Opt_ReallyRunIt;
print STDERR "Status = $status\n" if $Debug;

# If we executed remotely a checkout, it may have made a directory, but NFS
# hasn't caught up yet.  Flush the dir cache to avoid the 30 sec wait.
{ opendir(DIR,"."); closedir(DIR); }

exit ($status >> 8);

###############################################################################3

sub find_file_server {
    # Run df command to determine if this directory is on a local disk or NFS server.
    # If it's an NFS server, parse the df line and return some stuff.
    my $testdir = ".";
    # What directory should I test? Find the first argument that refers to a
    # directory.  If there is no such argument, use /bin/pwd.
    foreach (@_) {
	my $done = 0;
	while (!$done) {
	    print STDERR "testing for existing directory: $_\n" if $Debug;
	    if (-d $_) {
		$testdir = $_;  # success
		    last;
	    }
	    # remove a filename or directory name from the end, and try again
	    # Maybe that will result in a directory name, maybe not.
	    $done++ unless s/\/[^\/]*$//;
	}
    }
    print STDERR "Testing directory $testdir\n" if $Debug;

    my $df_cmd = "cd $testdir && /bin/df -P .";
    print STDERR "Run $df_cmd\n" if $Debug;
    open (DF, "$df_cmd |") || die "run df command in a pipe";
    my ($nfs_server, $server_mount_pt, $local_mount_pt);
    while (<DF>) {
        next if /^Filesystem/;
	if (/^(\S+):(\S+)[^\/]*(\S+)$/) {
	    ($nfs_server, $server_mount_pt, $local_mount_pt) = ($1,$2,$3);
	} elsif (/:/) {
	    die "df line had colon, suggesting an nfs server, but it didnt' match the nfs server regexp";
	}
    }
    close DF;
    $nfs_server = 'local' if !defined $nfs_server;
    print STDERR "Dir $testdir: server=$nfs_server mount=$server_mount_pt local=$local_mount_pt\n" if $Debug;
    return ($nfs_server, $server_mount_pt, $local_mount_pt);
}

sub can_login_to {
    my $server = shift;
    # The caller passes in name of a file server.
    # Returns 1 if we should be able to SSH to it, otherwise 0.
    my $regexp = $ENV{RSVN_SERVERS_REGEXP} || $Servers_Regexp_Default;
    $regexp = '^('.$regexp.')$'; # Anchor it
    my $re = eval { qr/$regexp/ };
    if (!$re || $@) {
	die "%Error: Bad regular expression in RSVN_SERVERS_REGEXP: '$regexp'\n";
    }
    return 0 if !defined $server;
    return 1 if $server =~ qr/$regexp/;
    return 0; # if not recognized, be conservative and assume you can't.
}

sub translate_path {
    my ($path, $local_mount_pt, $server_mount_pt) = @_;
    # Given the local path, convert it to the path on the file server.
    # The mount point is replaced with the file server's path.
    print STDERR "path=$path\n" if $Debug;
    print STDERR "local=$local_mount_pt\n" if $Debug;
    print STDERR "server=$server_mount_pt\n" if $Debug;
    if ($path =~ s/^$local_mount_pt/$server_mount_pt/) {
	print STDERR "translated path=$path\n" if $Debug;
	return $path;
    } else {
        die "%Error: translate_path failed. path=$path. local=$local_mount_pt. server=$server_mount_pt.";
    }
}


sub _sh_double_quote {
    my $cmd = shift;
    # Double quote the command for the shell.
    # We can't single quote as \' isn't escaped in sh.
    # copied verbatim from Wilson
    $cmd =~ s%\\%\\\\%g;
    $cmd =~ s%\$%\\\$%g;
    $cmd =~ s%`%\\`%g; #`
    $cmd =~ s%"%\\"%g; #"
    return '"'.$cmd.'"';
}

sub requote_arglist {
    my $args = "";
    # call _sh_double_quote on each argument and paste them back together
    foreach (@_) {
        $args .= _sh_double_quote($_) . " ";
    }
    return $args;
}

sub find_svn_command {
    # return first argument that doesn't start with '-'
    foreach (@SvnARGV) {
	return $_ unless $_ =~ /^-/;
	return "--version" if $_ eq '--version';  # Special case
    }
}

sub supported_command {
    my $cmd = shift;
    # Decide whether we dare to run this svn command remotely, or not.
    # If the command is listed, it can be run remotely.
    # This is a list of svn commands that we will attempt to run remotely.
    # Generally I want to avoid any command that is going to open an
    # editor, e.g. commit.
    our @SupportedRemoteCommands = qw{
	add
	checkout co
	cleanup
	diff
	merge
	resolved
	revert
	status stat st
	switch sw
	update up
	--version
    };
    foreach (@SupportedRemoteCommands) {
	return 1 if $cmd eq $_;
    }
    return 0;
}

#######################################################################
__END__

=pod

=head1 NAME

rsvn - remote svn - run subversion commands on the file server if possible

=head1 SYNOPSIS

  rsvn ANY_SVN_COMMAND
  rsvn update
  rsvn --test

=head1 DESCRIPTION

When possible, run the svn command on the file server where it does not
have to wait for NFS.  Otherwise run svn as usual.  Some SVN commands will
always run locally, either for "safety" or because there is no benefit of
running on the file server (svn log).

The commands that will be sent to the file server by default are these (and
their abbreviations):

    add checkout cleanup diff merge resolved
    revert status switch update

Why is commit not run remotely?  Because it will either start an editor, which
won't always work through noninteractive SSH, or you might use -m "FOO BAR" and
the shell's quoting gets all screwed up.  It would be good to figure out how to
solve these problems, and add "commit" to the list.

=head1 ARGUMENTS

=over 4

=item --debug

Print debug messages.

=item --help

Displays this message and program version and exits.

=item --local

Force a command to be run locally, even if normally it could be run on the
file server.

=item --remote

Attempt to run the command on the file server, even if normally it would
not be.

=item --test

Print debug messages and DON'T actually execute the svn command.

=item --version

Displays program version and remote svn version.

=back

=head1 ENVIRONMENT

=over 4

=item DIRPROJECT_SSH

The command to use in place of "ssh" to login to remote systems.  Used only
if RSVN_SSH not set.

=item RSVN_SSH

The command to use in place of "ssh" to login to remote systems.

=item RSVN_SERVERS_REGEXP

Perl regular expression containing servers that can be rsvn'ed into,
defaults to '.*'.  Generally any file server which supports "ssh" and has
NFS mounts matching the localhost can be specified here.  Network Attached
Storage (NAS) boxes such as Network Appliance servers must be excluded (by
not including them in the regexp).

=back

=head1 DISTRIBUTION

Copyright 2006-2010 by Bryce Denney and Wilson Snyder.  This package is
free software; you can redistribute it and/or modify it under the terms of
either the GNU Lesser General Public License or the Perl Artistic License.

=head1 AUTHORS

Bryce Denney <bryce.denney@sicortex.com>,
Wilson Snyder <wsnyder@wsnyder.org>

=head1 SEE ALSO

C<svn>

=cut

######################################################################
