#!/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 = "($cachepath);
my $q_client = "($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 = "($client);
my $q_tmp = "($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);