#!/usr/local/bin/perl
# -*-Fundamental-*-

#  Other Issues To Be Thought About:
#    syncs that schedule integrates?
#      - punt if we see any
#

# $Id$
#
# Original Author: Richard Geiger
#
# Copyright (c) 2000 Network Appliance, Inc.
# All rights reserved.
#

#
#  A wrapper for "p4 sync" to implement local cached synced at a WAN-remote
#  Perforce client site.
#
#  General Approach:
#
#    A cache is maintained, using the the depot pathname structure and a
#    revision number; e.g.,
#
#       //depot/dir/file.c#32  is cached to $Cacheroot/depot/dir/file#32
#
#    Upon a sync, three stages are carried out:
#
#       I: a sync -n, to see what revisions the server would give.
#          These are checked to see which, if any are in the cache.
#
#      II: for ones that *are* present in the cache, the files are
#          then copied from the cache to the workspace, and a flush
#          is then performed to inform the server that the workspace
#          now has these revisions.
#
#     III: for ones that are *not* present in the cache, a sync is
#          perforced to fetch the revisions to workspace, and than they
#          are copied into the cache.
#          
#    (For now, things put in the cache stay there forever, but in the future,
#    some mechanism to identify candidate revisions to remove from the cache
#    may be desirable).
#
#  Compatibility Issues:
#
#    When properly configured, csync should work on either Unix
#    or Windows hosts.
#
#    Configurations "known to work":
#       Unix alpha/OSF1
#         (There are likely some OS-dependencies for other Unixes lurking
#         in here, but these should be easy to address when they crop up)
#       NT 4 (drive letter-mapped shares only for now)
#       ...with $Cacheroot on a NetApp filer.
#
#    Presently, there may be issues with respect to the honoring of
#    certain client options, including:
#    
#      honoring [no]modtime
#      honoring [no]clobber
#      honoring [no]crlf
#
#    (I.e, generally these will be effective only for that subset (if
#    any) of files that are actually synced from the server (i.e., not
#    found in the cache). For files in the cache,
#
#      the mod time wil be that of the file in the cache
#      "noclobber" will be ignored
#      the presence of cr's will be determined by the cached content
#
#    In the future, csync could be made to emulate these properly if
#    necesary.
#
#  Configuration Notes:
#
#    Items in the script that are configuration constants you might
#    want to change are tagged with a "#CONFIG" comment in the code.
#    Eventually, we may want to make these switches from the command
#    line and/or environment, but for now they're hardwired.
#
#    Choose a place for the cache that is accessible to all client
#    hosts that need to be able to use csync, and set the $Cacheroot
#    variable(s) that you care about. (Unix and/or Windows, depending
#    on whether you will be using this from Unix and/or Windows).
#
#    Set $P4 to sepcify where the "real" p4 binary is to be found.
#    This could either be an absolute path, or just "p4" if you
#    want to rely on the user's PATH environment variable.
#

use Carp;
$| = 1; select STDERR; $| = 1; select STDOUT;

# This controls the verbosity level. Raising it is good for
# troubleshooting, but note: making it more verbose can actually
# impact performance on Windows hosts, where DOS shells seem to be
# very slow at simply scrolling lots of output! Right now I favor "2"
# as a good production value, which included all of the releveant
# indications from Perforce as to what has actaully been synced.
#
my $V = 2; #CONFIG

#  Platform independent constants:
#
my $S = "\001";
my $Myname = "csync.pl";

if (-f "/vmunix")
  { $Unix = 1; $Win = 0; }
else
  { $Unix = 0; $Win = 1; }

$ENV{"P4CONFIG"} = "P4ENV";

my $P4;
my $Cacheroot;
my $Copy;
my $Redirect;

if ($Unix)
  {
    $P4 = "/u/p4/VERS/bin.osf/p4"; #CONFIG
    $Cacheroot = "/n/ecco/users/rmg/tmp/CACHE"; # CONFIG
    $ENV{'PATH'} = "/bin";
    $Copy = "cp -f -p";
    $Redirect = "2>&1";

  }

if ($Win)
  {
    $P4 = "p4"; #CONFIG
    $Cacheroot = "H:\\tmp\\CACHE"; #CONFIG
    $Copy = "copy";
    $Redirect = "2>&1";
  }

sub dirname
{
  my ($dir) = @_;
 
  if ($Unix)
    {
      $dir =~ s%^$%.%; $dir = "$dir/";
      if ($dir =~ m%^/[^/]*//*$%) { return "/"; }
      if ($dir =~ m%^.*[^/]//*[^/][^/]*//*$%)
        { $dir =~ s%^(.*[^/])//*[^/][^/]*//*$%$1%; { return $dir; } }
      return ".";
    }

  if ($Win)
    {
      my $drv;
      if ($dir =~ /^([a-zA-Z]):(.*)$/) { $drv = $1; $dir = $2; }

      if ($dir !~ /\\/) { $dir = "."; }
      $dir =~ s/\\[^\\]+$//;      
      if ($drv) { $dir = "$drv:$dir"; }
      return $dir;
    }

  die "unknown platform";
}


if (! -d $Cacheroot) { die "no $Cacheroot\n"; }

my $hostname = `hostname`; chomp $hostname;
$hostname =~ s/\..*$//;

my $tmp_flush = "$Myname.flush.$hostname.$$";
my $tmp_sync =  "$Myname.sync.$hostname.$$";

my $args = join(" ", @ARGV);

sub quit
{
  my ($sts) = @_;
  unlink $tmp_flush;
  unlink $tmp_sync;
  if ($sts) { print STDERR "$Myname: there were problems.\n"; }
  exit $sts;
}
  

sub fail
{
  my ($msg) = @_;
  print STDERR "$msg\n";
  &quit(1);
}


sub mkd
{
  my($dir, $mode) = @_;

  ($V >= 5) && printf "$Myname> mkdir %s %04o\n", $dir, $mode;
  mkdir($dir, $mode) || &fail("can't mkdir \"$dir\": $!");
}


sub insdir
{
  my($dir, $insmode) = @_;

  if (! -e $dir)
    { &insdir(&dirname($dir)); &mkd($dir, 0755); return; }

  # So, it already exists, is it a dir?
  #  
  if (! -d $dir)
    { &fail("existing \"$dir\" is not a directory"); }

  if (! $insmode) { return; } 

  # Last thing to insure is the mode...
  #
  my(@stat) = stat($dir) || &fail("can't stat \"$dir\": $!");

  if (($stat[2] & 0777) == 0755) { return; }
    { chmod 0755, $dir || &fail("can't chmod \"$dir\": $!"); }
}


sub quot
{
  my ($p) = @_;

  if ($p =~ /"/)
    {
      # My brief experiments indicate that "s are verboten in windows
      # filenames... so punt.
      #
      if ($Win)
        { die "Windows and '\"' in filename: <$p>...!?"; }
      $p =~ s/\"/\\"/g;
    }
  $p = "\"$p\"";
  return $p;
}


#  First, see what we'd get from the server We'll consider this list
#  to be definitive, since we don't want to run "sync" twice, lest we
#  get different notions of the change level we're at, should somebody
#  else be subbmitting a change at the "same" time.
#
($V >= 1) && print "###   I: sync -n\n";

my $cmd = "$P4 -s sync -n $args $Redirect";
($V >= 4) && print "$Myname> $cmd\n";
if (! open(SYNC, "$cmd |"))
  { print STDERR "$Myname: open \"$cmd |\": $!\n"; &quit(1); }

my @sync;

# info: //depot/user/p4/bin/p4#208 - is opened and not being changed
# info1: //depot/user/p4/bin/p4 - must resolve #197,#208 before submitting

$nerr = 0;
while (<SYNC>)
  {
    if (/^exit: /) { last; }
    my $l = $_; $l =~ s/^[a-z0-9]+: //;
    chomp;
    if (/^info: (\/\/.*)#(\d+) - (updating|refreshing|added as|deleted as) (.*)$/)
      { push(@sync, "$1$S$2$S$3$S$4"); ($V >= 4) && print $l; }
    else
      {
        print $l;
        if (/^error: / && $l !~ /file\(s\) up-to-date./i) { $nerr += 1; }
      }
  }
close SYNC;

if ($nerr > 0) { &quit(1); }

if ($#sync == -1)
  {
    # nothing to do!
    &quit(0);
  }

# OK, now let's divide the list into the set of revisions 
# we already have in the cache, and those we do not.
#

if (! open(SYNC, ">$tmp_sync"))
  { print STDERR "$Myname: open \">$tmp_sync\": $!\n"; &quit(1); }

my @cached;
my @uncached;

foreach my $file (@sync)
  {
    my ($depot, $rev, $type, $client) = split(/$S/, $file);
    if ($type eq "deleted as" || -f "$Cacheroot/$depot#$rev")
      { push(@cached, $file); }
    else
      {
        push(@uncached, $file);
        print SYNC "$depot#$rev\n";
      }
  }

close SYNC;

#  OK, so now we copy in the cached ones we have:
#
($V >= 1) && print "###  II: copy & flush\n";

if ($#cached == -1) { goto skip_copy; }

if (! open(FLUSH, ">$tmp_flush"))
  { print STDERR "$Myname: open \">$tmp_flush\": $!\n"; &quit(1); }

$nerr = 0;
foreach my $file (@cached)
  {
    my ($depot, $rev, $type, $client) = split(/$S/, $file);
    my $sts;

    if ($type eq "deleted as")
      {
        $rev = "none";

        if ($Win) { $client =~ s/\//\\/g; }
        $cmd = "unlink $client"; # for the benefit of the error message
        ($V >= 4) && print "$Myname> unlink $client\n";
        $sts = ((unlink ($client)) != 1);
      }
    else
      {
        my $dp = $depot; $dp =~ s/\/\///;
        $cachepath = "$Cacheroot/$dp#$rev";
        if ($Win)
          { $cachepath =~ s/\//\\/g; $client =~ s/\//\\/g; }
        &insdir(&dirname($client), 0777);
        if ($Win && ! -w $client)
          {
            ($V >= 4) && print "$Myname> unlink $client\n";
            unlink $client;
            # No error check here, since, if it fails, the copy will.
          }
        my $q_cachepath = &quot($cachepath);
	my $q_client = &quot($client);
        $cmd = "$Copy $q_cachepath $q_client $Redirect";
        ($V >= 4) && print "$Myname> $cmd\n";
        $sts = system $cmd;
        if ($sts == 0 && $Win)
          {
            @s = stat($client);
            my $mode = $s[2] & 0777555;
            ($V >= 4) && printf "$Myname> chmod %o $clientmp\n", $mode;
            $cmd = "chmod mode, $client"; # for the benefit of the error message
            $sts = ((chmod $mode, $client) != 1);
          }
      }

    if ($sts)
      { print STDERR "$Myname: \"$cmd\" failed: $!\n"; $nerr++; }
    else
      { print FLUSH "$depot#$rev\n"; }
  }
close FLUSH;

if ($nerr > 0) { &quit(1); }

$cmd = "$P4 -s -x $tmp_flush flush $Redirect";

($V >= 4) && print "$Myname> $cmd\n";
if (!open(FLUSH, "$cmd |"))
  { print STDERR "$Myname: open \"$cmd |\": $!\n"; &quit(1); }

$nerr = 0;
while (<FLUSH>)
  {
    if (! /^exit: /) { my $l = $_; $l =~ s/^[a-z0-9]+: //; ($V >= 2) && print $l; }
    if (/^error: (.*)$/) { $nerr++; }
  }
close FLUSH;
unlink $tmp_flush;
if ($nerr > 0) { &quit(1); }

# OK, now sync in the ones we don't have in the cache, and copy
# them into the cache:
#
skip_copy:
($V >= 1) && print "### III: sync & copy\n";

if ($#uncached == -1) { goto skip_flush; }

$cmd = "$P4 -s -x $tmp_sync sync $Redirect";
($V >= 4) && print "$Myname> $cmd\n";
if (!open(SYNC, "$cmd |"))
  { print STDERR "$Myname: open \"$cmd |\": $!\n"; &quit(1); }

$nerr = 0;
while (<SYNC>)
  {
    if (! /^exit: /) { my $l = $_; $l =~ s/^[a-z0-9]+: //; ($V >= 2) && print $l; }
    chomp;
    if (/^error: (.*)$/) { $nerr++; }
  }
close SYNC;
unlink $tmp_sync;
if ($nerr > 0) { &quit(1); }

$nerr = 0;
foreach my $file (@uncached)
  {
    my ($depot, $rev, $type, $client) = split(/$S/, $file);
    my $sts;
    my $dp = $depot; $dp =~ s/\/\///;
    $cachepath = "$Cacheroot/$dp#$rev";
    my $tmp = "$cachepath.$hostname.$$"; 

    if ($Win)
      {
        $client =~ s/\//\\/g;
        $tmp =~ s/\//\\/g;
        $cachepath =~ s/\//\\/g;
      }

    &insdir(&dirname($cachepath), 0777);

    if ($Win && ! -w $client)
      {
        ($V >= 4) && print "$Myname> unlink $cachepath\n";
        unlink $cachepath;
        # No error check here, since, if it fails, the copy will.
      }
    my $q_client = &quot($client);
    my $q_tmp = &quot($tmp);
    $cmd = "$Copy $q_client $q_tmp";
    ($V >= 4) && print "$Myname> $cmd\n";
    if ($sts = system($cmd))
      { print STDERR "$Myname: \"$cmd\" failed: $!\n"; $nerr++; }
    if ($sts == 0 && $Win)
      {
        @s = stat($tmp);
        my $mode = $s[2] & 0777555;
        ($V >= 4) && printf "$Myname> chmod %o $tmp\n", $mode;
        $sts = ((chmod $mode, $tmp) != 1);
        if ($sts)
          { print STDERR "$Myname: \"chmod $mode, $tmp\" failed: $!\n"; $nerr++; }
      }
    if ($sts == 0)
      {
        ($V >= 4) && print "$Myname> rename $tmp, $cachepath\n";
        if (! rename $tmp, $cachepath)
          { print STDERR "$Myname: \"rename $tmp, $cachepath\" failed: $!\n"; $nerr++; }
      }
  }

if ($nerr > 0) { &quit(1); }

skip_flush:
&quit(0);