git-cvsserver.perl [plain text]
use 5.008;
use strict;
use warnings;
use bytes;
use Fcntl;
use File::Temp qw/tempdir tempfile/;
use File::Path qw/rmtree/;
use File::Basename;
use Getopt::Long qw(:config require_order no_ignore_case);
my $VERSION = '@@GIT_VERSION@@';
my $log = GITCVS::log->new();
my $cfg;
my $DATE_LIST = {
Jan => "01",
Feb => "02",
Mar => "03",
Apr => "04",
May => "05",
Jun => "06",
Jul => "07",
Aug => "08",
Sep => "09",
Oct => "10",
Nov => "11",
Dec => "12",
};
$| = 1;
my $methods = {
'Root' => \&req_Root,
'Valid-responses' => \&req_Validresponses,
'valid-requests' => \&req_validrequests,
'Directory' => \&req_Directory,
'Sticky' => \&req_Sticky,
'Entry' => \&req_Entry,
'Modified' => \&req_Modified,
'Unchanged' => \&req_Unchanged,
'Questionable' => \&req_Questionable,
'Argument' => \&req_Argument,
'Argumentx' => \&req_Argument,
'expand-modules' => \&req_expandmodules,
'add' => \&req_add,
'remove' => \&req_remove,
'co' => \&req_co,
'update' => \&req_update,
'ci' => \&req_ci,
'diff' => \&req_diff,
'log' => \&req_log,
'rlog' => \&req_log,
'tag' => \&req_CATCHALL,
'status' => \&req_status,
'admin' => \&req_CATCHALL,
'history' => \&req_CATCHALL,
'watchers' => \&req_EMPTY,
'editors' => \&req_EMPTY,
'noop' => \&req_EMPTY,
'annotate' => \&req_annotate,
'Global_option' => \&req_Globaloption,
};
my $state = { prependdir => '' };
my $work =
{
state => undef, workDir => undef,
index => undef,
emptyDir => undef,
tmpDir => undef
};
$log->info("--------------- STARTING -----------------");
my $usage =
"usage: git cvsserver [options] [pserver|server] [<directory> ...]\n".
" --base-path <path> : Prepend to requested CVSROOT\n".
" Can be read from GIT_CVSSERVER_BASE_PATH\n".
" --strict-paths : Don't allow recursing into subdirectories\n".
" --export-all : Don't check for gitcvs.enabled in config\n".
" --version, -V : Print version information and exit\n".
" -h, -H : Print usage information and exit\n".
"\n".
"<directory> ... is a list of allowed directories. If no directories\n".
"are given, all are allowed. This is an additional restriction, gitcvs\n".
"access still needs to be enabled by the gitcvs.enabled config option.\n".
"Alternately, one directory may be specified in GIT_CVSSERVER_ROOT.\n";
my @opts = ( 'h|H', 'version|V',
'base-path=s', 'strict-paths', 'export-all' );
GetOptions( $state, @opts )
or die $usage;
if ($state->{version}) {
print "git-cvsserver version $VERSION\n";
exit;
}
if ($state->{help}) {
print $usage;
exit;
}
my $TEMP_DIR = tempdir( CLEANUP => 1 );
$log->debug("Temporary directory is '$TEMP_DIR'");
$state->{method} = 'ext';
if (@ARGV) {
if ($ARGV[0] eq 'pserver') {
$state->{method} = 'pserver';
shift @ARGV;
} elsif ($ARGV[0] eq 'server') {
shift @ARGV;
}
}
$state->{allowed_roots} = [ @ARGV ];
if ($state->{'export-all'} && !@{$state->{allowed_roots}}) {
die "--export-all can only be used together with an explicit whitelist\n";
}
if (exists $ENV{GIT_CVSSERVER_BASE_PATH}) {
if ($state->{'base-path'}) {
die "Cannot specify base path both ways.\n";
}
my $base_path = $ENV{GIT_CVSSERVER_BASE_PATH};
$state->{'base-path'} = $base_path;
$log->debug("Picked up base path '$base_path' from environment.\n");
}
if (exists $ENV{GIT_CVSSERVER_ROOT}) {
if (@{$state->{allowed_roots}}) {
die "Cannot specify roots both ways: @ARGV\n";
}
my $allowed_root = $ENV{GIT_CVSSERVER_ROOT};
$state->{allowed_roots} = [ $allowed_root ];
$log->debug("Picked up allowed root '$allowed_root' from environment.\n");
}
if ($state->{method} eq 'pserver') {
my $line = <STDIN>; chomp $line;
unless( $line =~ /^BEGIN (AUTH|VERIFICATION) REQUEST$/) {
die "E Do not understand $line - expecting BEGIN AUTH REQUEST\n";
}
my $request = $1;
$line = <STDIN>; chomp $line;
unless (req_Root('root', $line)) { print "E Invalid root $line \n";
exit 1;
}
$line = <STDIN>; chomp $line;
my $user = $line;
$line = <STDIN>; chomp $line;
my $password = $line;
if ($user eq 'anonymous') {
if (length($password) > 1 ) {
print "E Don't supply a password for the `anonymous' user\n";
print "I HATE YOU\n";
exit 1;
}
} else {
if (not exists $cfg->{gitcvs}->{authdb}) {
print "E the repo config file needs a [gitcvs] section with an 'authdb' parameter set to the filename of the authentication database\n";
print "I HATE YOU\n";
exit 1;
}
my $authdb = $cfg->{gitcvs}->{authdb};
unless (-e $authdb) {
print "E The authentication database specified in [gitcvs.authdb] does not exist\n";
print "I HATE YOU\n";
exit 1;
}
my $auth_ok;
open my $passwd, "<", $authdb or die $!;
while (<$passwd>) {
if (m{^\Q$user\E:(.*)}) {
if (crypt($user, descramble($password)) eq $1) {
$auth_ok = 1;
}
};
}
close $passwd;
unless ($auth_ok) {
print "I HATE YOU\n";
exit 1;
}
}
$state->{user} = $user;
$line = <STDIN>; chomp $line;
unless ($line eq "END $request REQUEST") {
die "E Do not understand $line -- expecting END $request REQUEST\n";
}
print "I LOVE YOU\n";
exit if $request eq 'VERIFICATION'; }
while (<STDIN>)
{
chomp;
if ( /^([\w-]+)(?:\s+(.*))?$/ and defined($methods->{$1}) )
{
&{$methods->{$1}}($1,$2);
} else {
$log->fatal("Don't understand command $_\n");
die("Unknown command $_");
}
}
$log->debug("Processing time : user=" . (times)[0] . " system=" . (times)[1]);
$log->info("--------------- FINISH -----------------");
chdir '/';
exit 0;
sub req_CATCHALL
{
my ( $cmd, $data ) = @_;
$log->warn("Unhandled command : req_$cmd : $data");
}
sub req_EMPTY
{
print "ok\n";
}
sub req_Root
{
my ( $cmd, $data ) = @_;
$log->debug("req_Root : $data");
unless ($data =~ m print "error 1 Root must be an absolute pathname\n";
return 0;
}
my $cvsroot = $state->{'base-path'} || '';
$cvsroot =~ s $cvsroot .= $data;
if ($state->{CVSROOT}
&& ($state->{CVSROOT} ne $cvsroot)) {
print "error 1 Conflicting roots specified\n";
return 0;
}
$state->{CVSROOT} = $cvsroot;
$ENV{GIT_DIR} = $state->{CVSROOT} . "/";
if (@{$state->{allowed_roots}}) {
my $allowed = 0;
foreach my $dir (@{$state->{allowed_roots}}) {
next unless $dir =~ m $dir =~ s if ($state->{'strict-paths'}) {
if ($ENV{GIT_DIR} =~ m $allowed = 1;
last;
}
} elsif ($ENV{GIT_DIR} =~ m $allowed = 1;
last;
}
}
unless ($allowed) {
print "E $ENV{GIT_DIR} does not seem to be a valid GIT repository\n";
print "E \n";
print "error 1 $ENV{GIT_DIR} is not a valid repository\n";
return 0;
}
}
unless (-d $ENV{GIT_DIR} && -e $ENV{GIT_DIR}.'HEAD') {
print "E $ENV{GIT_DIR} does not seem to be a valid GIT repository\n";
print "E \n";
print "error 1 $ENV{GIT_DIR} is not a valid repository\n";
return 0;
}
my @gitvars = `git config -l`;
if ($?) {
print "E problems executing git-config on the server -- this is not a git repository or the PATH is not set correctly.\n";
print "E \n";
print "error 1 - problem executing git-config\n";
return 0;
}
foreach my $line ( @gitvars )
{
next unless ( $line =~ /^(gitcvs)\.(?:(ext|pserver)\.)?([\w-]+)=(.*)$/ );
unless ($2) {
$cfg->{$1}{$3} = $4;
} else {
$cfg->{$1}{$2}{$3} = $4;
}
}
my $enabled = ($cfg->{gitcvs}{$state->{method}}{enabled}
|| $cfg->{gitcvs}{enabled});
unless ($state->{'export-all'} ||
($enabled && $enabled =~ /^\s*(1|true|yes)\s*$/i)) {
print "E GITCVS emulation needs to be enabled on this repo\n";
print "E the repo config file needs a [gitcvs] section added, and the parameter 'enabled' set to 1\n";
print "E \n";
print "error 1 GITCVS emulation disabled\n";
return 0;
}
my $logfile = $cfg->{gitcvs}{$state->{method}}{logfile} || $cfg->{gitcvs}{logfile};
if ( $logfile )
{
$log->setfile($logfile);
} else {
$log->nofile();
}
return 1;
}
sub req_Globaloption
{
my ( $cmd, $data ) = @_;
$log->debug("req_Globaloption : $data");
$state->{globaloptions}{$data} = 1;
}
sub req_Validresponses
{
my ( $cmd, $data ) = @_;
$log->debug("req_Validresponses : $data");
}
sub req_validrequests
{
my ( $cmd, $data ) = @_;
$log->debug("req_validrequests");
$log->debug("SEND : Valid-requests " . join(" ",sort keys %$methods));
$log->debug("SEND : ok");
print "Valid-requests " . join(" ",sort keys %$methods) . "\n";
print "ok\n";
}
sub req_Directory
{
my ( $cmd, $data ) = @_;
my $repository = <STDIN>;
chomp $repository;
$state->{localdir} = $data;
$state->{repository} = $repository;
$state->{path} = $repository;
$state->{path} =~ s/^\Q$state->{CVSROOT}\E\///;
$state->{module} = $1 if ($state->{path} =~ s/^(.*?)(\/|$)//);
$state->{path} .= "/" if ( $state->{path} =~ /\S/ );
$state->{directory} = $state->{localdir};
$state->{directory} = "" if ( $state->{directory} eq "." );
$state->{directory} .= "/" if ( $state->{directory} =~ /\S/ );
if ( (not defined($state->{prependdir}) or $state->{prependdir} eq '') and $state->{localdir} eq "." and $state->{path} =~ /\S/ )
{
$log->info("Setting prepend to '$state->{path}'");
$state->{prependdir} = $state->{path};
my %entries;
foreach my $entry ( keys %{$state->{entries}} )
{
$entries{$state->{prependdir} . $entry} = $state->{entries}{$entry};
}
$state->{entries}=\%entries;
my %dirMap;
foreach my $dir ( keys %{$state->{dirMap}} )
{
$dirMap{$state->{prependdir} . $dir} = $state->{dirMap}{$dir};
}
$state->{dirMap}=\%dirMap;
}
if ( defined ( $state->{prependdir} ) )
{
$log->debug("Prepending '$state->{prependdir}' to state|directory");
$state->{directory} = $state->{prependdir} . $state->{directory}
}
if ( ! defined($state->{dirMap}{$state->{directory}}) )
{
$state->{dirMap}{$state->{directory}} =
{
'names' => {}
};
}
$log->debug("req_Directory : localdir=$data repository=$repository path=$state->{path} directory=$state->{directory} module=$state->{module}");
}
sub req_Sticky
{
my ( $cmd, $tagspec ) = @_;
my ( $stickyInfo );
if($tagspec eq "")
{
}
elsif($tagspec=~/^T([^ ]+)\s*$/)
{
$stickyInfo = { 'tag' => $1 };
}
elsif($tagspec=~/^D([0-9.]+)\s*$/)
{
$stickyInfo= { 'date' => $1 };
}
else
{
die "Unknown tag_or_date format\n";
}
$state->{dirMap}{$state->{directory}}{stickyInfo}=$stickyInfo;
$log->debug("req_Sticky : tagspec=$tagspec repository=$state->{repository}"
. " path=$state->{path} directory=$state->{directory}"
. " module=$state->{module}");
}
sub req_Entry
{
my ( $cmd, $data ) = @_;
my @data = split(/\//, $data, -1);
$state->{entries}{$state->{directory}.$data[1]} = {
revision => $data[2],
conflict => $data[3],
options => $data[4],
tag_or_date => $data[5],
};
$state->{dirMap}{$state->{directory}}{names}{$data[1]} = 'F';
$log->info("Received entry line '$data' => '" . $state->{directory} . $data[1] . "'");
}
sub req_Questionable
{
my ( $cmd, $data ) = @_;
$log->debug("req_Questionable : $data");
$state->{entries}{$state->{directory}.$data}{questionable} = 1;
}
sub req_add
{
my ( $cmd, $data ) = @_;
argsplit("add");
my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
$updater->update();
my $addcount = 0;
foreach my $filename ( @{$state->{args}} )
{
$filename = filecleanup($filename);
my $stickyInfo = resolveStickyInfo($filename);
my $meta = $updater->getmeta($filename,$stickyInfo);
my $wrev = revparse($filename);
if ($wrev && $meta && ($wrev=~/^-/))
{
$log->info("added file $filename was previously removed, send $meta->{revision}");
print "MT +updated\n";
print "MT text U \n";
print "MT fname $filename\n";
print "MT newline\n";
print "MT -updated\n";
unless ( $state->{globaloptions}{-n} )
{
my ( $filepart, $dirpart ) = filenamesplit($filename,1);
print "Created $dirpart\n";
print $state->{CVSROOT} . "/$state->{module}/$filename\n";
my $kopts = kopts_from_path($filename,"sha1",$meta->{filehash});
my $entryLine = "/$filepart/$meta->{revision}//$kopts/";
$entryLine .= getStickyTagOrDate($stickyInfo);
$log->debug($entryLine);
print "$entryLine\n";
$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");
print "u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";
transmitfile($meta->{filehash});
}
next;
}
unless ( defined ( $state->{entries}{$filename}{modified_filename} ) )
{
print "E cvs add: nothing known about `$filename'\n";
next;
}
if ( defined ( $state->{entries}{$filename}{revision} ) )
{
print "E cvs add: `$filename' has already been entered\n";
next;
}
my ( $filepart, $dirpart ) = filenamesplit($filename, 1);
print "E cvs add: scheduling file `$filename' for addition\n";
print "Checked-in $dirpart\n";
print "$filename\n";
my $kopts = kopts_from_path($filename,"file",
$state->{entries}{$filename}{modified_filename});
print "/$filepart/0//$kopts/" .
getStickyTagOrDate($stickyInfo) . "\n";
my $requestedKopts = $state->{opt}{k};
if(defined($requestedKopts))
{
$requestedKopts = "-k$requestedKopts";
}
else
{
$requestedKopts = "";
}
if( $kopts ne $requestedKopts )
{
$log->warn("Ignoring requested -k='$requestedKopts'"
. " for '$filename'; detected -k='$kopts' instead");
}
$addcount++;
}
if ( $addcount == 1 )
{
print "E cvs add: use `cvs commit' to add this file permanently\n";
}
elsif ( $addcount > 1 )
{
print "E cvs add: use `cvs commit' to add these files permanently\n";
}
print "ok\n";
}
sub req_remove
{
my ( $cmd, $data ) = @_;
argsplit("remove");
my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
$updater->update();
my $rmcount = 0;
foreach my $filename ( @{$state->{args}} )
{
$filename = filecleanup($filename);
if ( defined ( $state->{entries}{$filename}{unchanged} ) or defined ( $state->{entries}{$filename}{modified_filename} ) )
{
print "E cvs remove: file `$filename' still in working directory\n";
next;
}
my $stickyInfo = resolveStickyInfo($filename);
my $meta = $updater->getmeta($filename,$stickyInfo);
my $wrev = revparse($filename);
unless ( defined ( $wrev ) )
{
print "E cvs remove: nothing known about `$filename'\n";
next;
}
if ( defined($wrev) and ($wrev=~/^-/) )
{
print "E cvs remove: file `$filename' already scheduled for removal\n";
next;
}
unless ( $wrev eq $meta->{revision} )
{
print "E cvs remove: Up to date check failed for `$filename'\n";
next;
}
my ( $filepart, $dirpart ) = filenamesplit($filename, 1);
print "E cvs remove: scheduling `$filename' for removal\n";
print "Checked-in $dirpart\n";
print "$filename\n";
my $kopts = kopts_from_path($filename,"sha1",$meta->{filehash});
print "/$filepart/-$wrev//$kopts/" . getStickyTagOrDate($stickyInfo) . "\n";
$rmcount++;
}
if ( $rmcount == 1 )
{
print "E cvs remove: use `cvs commit' to remove this file permanently\n";
}
elsif ( $rmcount > 1 )
{
print "E cvs remove: use `cvs commit' to remove these files permanently\n";
}
print "ok\n";
}
sub req_Modified
{
my ( $cmd, $data ) = @_;
my $mode = <STDIN>;
defined $mode
or (print "E end of file reading mode for $data\n"), return;
chomp $mode;
my $size = <STDIN>;
defined $size
or (print "E end of file reading size of $data\n"), return;
chomp $size;
my $blocksize = 8192;
my $bytesleft = $size;
my $tmp;
my ( $fh, $filename ) = tempfile( DIR => $TEMP_DIR );
while ( $bytesleft )
{
$blocksize = $bytesleft if ( $bytesleft < $blocksize );
read STDIN, $tmp, $blocksize;
print $fh $tmp;
$bytesleft -= $blocksize;
}
close $fh
or (print "E failed to write temporary, $filename: $!\n"), return;
if ( $mode =~ /u=(\w+)/ )
{
$mode = $1;
} else {
$mode = "rw";
}
$state->{entries}{$state->{directory}.$data}{modified_filename} = $filename;
$state->{entries}{$state->{directory}.$data}{modified_mode} = $mode;
$state->{entries}{$state->{directory}.$data}{modified_hash} = `git hash-object $filename`;
$state->{entries}{$state->{directory}.$data}{modified_hash} =~ s/\s.*$//s;
}
sub req_Unchanged
{
my ( $cmd, $data ) = @_;
$state->{entries}{$state->{directory}.$data}{unchanged} = 1;
}
sub req_Argument
{
my ( $cmd, $data ) = @_;
$log->debug("$cmd : $data");
if ( $cmd eq 'Argumentx') {
${$state->{arguments}}[$ } else {
push @{$state->{arguments}}, $data;
}
}
sub req_expandmodules
{
my ( $cmd, $data ) = @_;
argsplit();
$log->debug("req_expandmodules : " . ( defined($data) ? $data : "[NULL]" ) );
unless ( ref $state->{arguments} eq "ARRAY" )
{
print "ok\n";
return;
}
foreach my $module ( @{$state->{arguments}} )
{
$log->debug("SEND : Module-expansion $module");
print "Module-expansion $module\n";
}
print "ok\n";
statecleanup();
}
sub req_co
{
my ( $cmd, $data ) = @_;
argsplit("co");
if (exists $state->{opt}{c}) {
my $showref = `git show-ref --heads`;
for my $line (split '\n', $showref) {
if ( $line =~ m% refs/heads/(.*)$% ) {
print "M $1\t$1\n";
}
}
print "ok\n";
return 1;
}
my $stickyInfo = { 'tag' => $state->{opt}{r},
'date' => $state->{opt}{D} };
my $module = $state->{args}[0];
$state->{module} = $module;
my $checkout_path = $module;
$checkout_path = $state->{opt}{d} if ( exists ( $state->{opt}{d} ) );
$log->debug("req_co : " . ( defined($data) ? $data : "[NULL]" ) );
$log->info("Checking out module '$module' ($state->{CVSROOT}) to '$checkout_path'");
$ENV{GIT_DIR} = $state->{CVSROOT} . "/";
my $updater = GITCVS::updater->new($state->{CVSROOT}, $module, $log);
$updater->update();
my $headHash;
if( defined($stickyInfo) && defined($stickyInfo->{tag}) )
{
$headHash = $updater->lookupCommitRef($stickyInfo->{tag});
if( !defined($headHash) )
{
print "error 1 no such tag `$stickyInfo->{tag}'\n";
cleanupWorkTree();
exit;
}
}
$checkout_path =~ s|/$||;
my %seendirs = ();
my $lastdir ='';
prepDirForOutput(
".",
$state->{CVSROOT} . "/$module",
$checkout_path,
\%seendirs,
'checkout',
$state->{dirArgs} );
foreach my $git ( @{$updater->getAnyHead($headHash)} )
{
next if ( $git->{filehash} eq "deleted" );
my $fullName = $git->{name};
( $git->{name}, $git->{dir} ) = filenamesplit($git->{name});
unless (exists($seendirs{$git->{dir}})) {
prepDirForOutput($git->{dir}, $state->{CVSROOT} . "/$module/",
$checkout_path, \%seendirs, 'checkout',
$state->{dirArgs} );
$lastdir = $git->{dir};
$seendirs{$git->{dir}} = 1;
}
print "Mod-time $git->{modified}\n";
if ( defined ( $git->{dir} ) and $git->{dir} ne "./" )
{
print "M U $checkout_path/$git->{dir}$git->{name}\n";
} else {
print "M U $checkout_path/$git->{name}\n";
}
print "Created $checkout_path/" . ( defined ( $git->{dir} ) and $git->{dir} ne "./" ? $git->{dir} . "/" : "" ) . "\n";
print $state->{CVSROOT} . "/$module/" . ( defined ( $git->{dir} ) and $git->{dir} ne "./" ? $git->{dir} . "/" : "" ) . "$git->{name}\n";
my $kopts = kopts_from_path($fullName,"sha1",$git->{filehash});
print "/$git->{name}/$git->{revision}//$kopts/" .
getStickyTagOrDate($stickyInfo) . "\n";
print "u=$git->{mode},g=$git->{mode},o=$git->{mode}\n";
transmitfile($git->{filehash});
}
print "ok\n";
statecleanup();
}
sub prepDirForOutput
{
my ($dir, $repodir, $remotedir, $seendirs, $request, $dirArgs) = @_;
my $parent = dirname($dir);
$dir =~ s|/+$||;
$repodir =~ s|/+$||;
$remotedir =~ s|/+$||;
$parent =~ s|/+$||;
if ($parent eq '.' || $parent eq './')
{
$parent = '';
}
if( length($parent) &&
!exists($seendirs->{$parent}) &&
( $request eq "checkout" ||
exists($dirArgs->{$parent}) ) )
{
prepDirForOutput($parent, $repodir, $remotedir,
$seendirs, $request, $dirArgs);
}
if ($dir eq '.' || $dir eq './')
{
$dir = '';
}
if(exists($seendirs->{$dir}))
{
return;
}
$log->debug("announcedir $dir, $repodir, $remotedir" );
my($thisRemoteDir,$thisRepoDir);
if ($dir ne "")
{
$thisRepoDir="$repodir/$dir";
if($remotedir eq ".")
{
$thisRemoteDir=$dir;
}
else
{
$thisRemoteDir="$remotedir/$dir";
}
}
else
{
$thisRepoDir=$repodir;
$thisRemoteDir=$remotedir;
}
unless ( $state->{globaloptions}{-Q} || $state->{globaloptions}{-q} )
{
print "E cvs $request: Updating $thisRemoteDir\n";
}
my ($opt_r)=$state->{opt}{r};
my $stickyInfo;
if(exists($state->{opt}{A}))
{
}
elsif( defined($opt_r) && $opt_r ne "" )
{
$stickyInfo={ 'tag' => (defined($opt_r)?$opt_r:undef) };
}
else
{
$stickyInfo=getDirStickyInfo($state->{prependdir} . $dir);
}
my $stickyResponse;
if(defined($stickyInfo))
{
$stickyResponse = "Set-sticky $thisRemoteDir/\n" .
"$thisRepoDir/\n" .
getStickyTagOrDate($stickyInfo) . "\n";
}
else
{
$stickyResponse = "Clear-sticky $thisRemoteDir/\n" .
"$thisRepoDir/\n";
}
unless ( $state->{globaloptions}{-n} )
{
print $stickyResponse;
print "Clear-static-directory $thisRemoteDir/\n";
print "$thisRepoDir/\n";
print $stickyResponse; print "Template $thisRemoteDir/\n";
print "$thisRepoDir/\n";
print "0\n";
}
$seendirs->{$dir} = 1;
}
sub req_update
{
my ( $cmd, $data ) = @_;
$log->debug("req_update : " . ( defined($data) ? $data : "[NULL]" ));
argsplit("update");
if ($state->{module} eq '') {
my $showref = `git show-ref --heads`;
print "E cvs update: Updating .\n";
for my $line (split '\n', $showref) {
if ( $line =~ m% refs/heads/(.*)$% ) {
print "E cvs update: New directory `$1'\n";
}
}
print "ok\n";
return 1;
}
my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
$updater->update();
argsfromdir($updater);
my($repoDir);
$repoDir=$state->{CVSROOT} . "/$state->{module}/$state->{prependdir}";
my %seendirs = ();
foreach my $argsFilename ( @{$state->{args}} )
{
my $filename;
$filename = filecleanup($argsFilename);
$log->debug("Processing file $filename");
if ( exists ( $state->{opt}{C} ) )
{
delete $state->{entries}{$filename}{modified_hash};
delete $state->{entries}{$filename}{modified_filename};
$state->{entries}{$filename}{unchanged} = 1;
}
my $stickyInfo = resolveStickyInfo($filename,
$state->{opt}{r},
$state->{opt}{D},
exists($state->{opt}{A}));
my $meta = $updater->getmeta($filename, $stickyInfo);
if ( exists ( $state->{opt}{p} ) ) {
if ( defined ( $meta->{revision} ) ) {
$log->info("Printing '$filename' revision " . $meta->{revision});
transmitfile($meta->{filehash}, { print => 1 });
}
next;
}
prepDirForOutput(
dirname($argsFilename),
$repoDir,
".",
\%seendirs,
"update",
$state->{dirArgs} );
my $wrev = revparse($filename);
if ( ! defined $meta )
{
$meta = {
name => $filename,
revision => '0',
filehash => 'added'
};
if($wrev ne "0")
{
$meta->{filehash}='deleted';
}
}
my $oldmeta = $meta;
my $oldWrev=$wrev;
if(defined($oldWrev))
{
$oldWrev=~s/^-//;
if($oldWrev ne $meta->{revision})
{
$oldmeta = $updater->getmeta($filename, $oldWrev);
}
}
next if ( defined ( $wrev )
and defined($meta->{revision})
and $wrev eq $meta->{revision}
and $state->{entries}{$filename}{unchanged}
and not exists ( $state->{opt}{C} ) );
if ( defined ( $wrev )
and defined($meta->{revision})
and $wrev eq $meta->{revision}
and $wrev ne "0"
and defined($state->{entries}{$filename}{modified_hash})
and not exists ( $state->{opt}{C} ) )
{
$log->info("Tell the client the file is modified");
print "MT text M \n";
print "MT fname $filename\n";
print "MT newline\n";
next;
}
if ( $meta->{filehash} eq "deleted" && $wrev ne "0" )
{
my ( $filepart, $dirpart ) = filenamesplit($filename,1);
$log->info("Removing '$filename' from working copy (no longer in the repo)");
print "E cvs update: `$filename' is no longer in the repository\n";
unless ( $state->{globaloptions}{-n} ) {
print "Removed $dirpart\n";
print "$filepart\n";
}
}
elsif ( not defined ( $state->{entries}{$filename}{modified_hash} )
or $state->{entries}{$filename}{modified_hash} eq $oldmeta->{filehash}
or $meta->{filehash} eq 'added' )
{
if ( defined($wrev) && ($wrev=~/^-/) )
{
$log->info("Tell the client the file is scheduled for removal");
print "MT text R \n";
print "MT fname $filename\n";
print "MT newline\n";
next;
}
elsif ( (!defined($wrev) || $wrev eq '0') &&
(!defined($meta->{revision}) || $meta->{revision} eq '0') )
{
$log->info("Tell the client the file is scheduled for addition");
print "MT text A \n";
print "MT fname $filename\n";
print "MT newline\n";
next;
}
else {
$log->info("UpdatingX3 '$filename' to ".$meta->{revision});
print "MT +updated\n";
print "MT text U \n";
print "MT fname $filename\n";
print "MT newline\n";
print "MT -updated\n";
}
my ( $filepart, $dirpart ) = filenamesplit($filename,1);
unless ( $state->{globaloptions}{-n} )
{
if ( defined ( $wrev ) )
{
print "Update-existing $dirpart\n";
$log->debug("Updating existing file 'Update-existing $dirpart'");
} else {
$log->debug("Creating new file 'Created $dirpart'");
print "Created $dirpart\n";
}
print $state->{CVSROOT} . "/$state->{module}/$filename\n";
my $kopts = kopts_from_path($filename,"sha1",$meta->{filehash});
my $entriesLine = "/$filepart/$meta->{revision}//$kopts/";
$entriesLine .= getStickyTagOrDate($stickyInfo);
$log->debug($entriesLine);
print "$entriesLine\n";
$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");
print "u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";
transmitfile($meta->{filehash});
}
} else {
my ( $filepart, $dirpart ) = filenamesplit($meta->{name},1);
my $mergeDir = setupTmpDir();
my $file_local = $filepart . ".mine";
my $mergedFile = "$mergeDir/$file_local";
system("ln","-s",$state->{entries}{$filename}{modified_filename}, $file_local);
my $file_old = $filepart . "." . $oldmeta->{revision};
transmitfile($oldmeta->{filehash}, { targetfile => $file_old });
my $file_new = $filepart . "." . $meta->{revision};
transmitfile($meta->{filehash}, { targetfile => $file_new });
$log->info("Merging $file_local, $file_old, $file_new");
print "M Merging differences between $oldmeta->{revision} and $meta->{revision} into $filename\n";
$log->debug("Temporary directory for merge is $mergeDir");
my $return = system("git", "merge-file", $file_local, $file_old, $file_new);
$return >>= 8;
cleanupTmpDir();
if ( $return == 0 )
{
$log->info("Merged successfully");
print "M M $filename\n";
$log->debug("Merged $dirpart");
unless ( $state->{globaloptions}{-n} )
{
print "Merged $dirpart\n";
$log->debug($state->{CVSROOT} . "/$state->{module}/$filename");
print $state->{CVSROOT} . "/$state->{module}/$filename\n";
my $kopts = kopts_from_path("$dirpart/$filepart",
"file",$mergedFile);
$log->debug("/$filepart/$meta->{revision}//$kopts/");
my $entriesLine="/$filepart/$meta->{revision}//$kopts/";
$entriesLine .= getStickyTagOrDate($stickyInfo);
print "$entriesLine\n";
}
}
elsif ( $return == 1 )
{
$log->info("Merged with conflicts");
print "E cvs update: conflicts found in $filename\n";
print "M C $filename\n";
unless ( $state->{globaloptions}{-n} )
{
print "Merged $dirpart\n";
print $state->{CVSROOT} . "/$state->{module}/$filename\n";
my $kopts = kopts_from_path("$dirpart/$filepart",
"file",$mergedFile);
my $entriesLine = "/$filepart/$meta->{revision}/+/$kopts/";
$entriesLine .= getStickyTagOrDate($stickyInfo);
print "$entriesLine\n";
}
}
else
{
$log->warn("Merge failed");
next;
}
unless ( $state->{globaloptions}{-n} )
{
$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");
print "u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";
my $data = `cat $mergedFile`;
$log->debug("File size : " . length($data));
print length($data) . "\n";
print $data;
}
}
}
unless ( $state->{globaloptions}{n} )
{
my $dir;
foreach $dir (keys(%{$state->{dirMap}}))
{
if( ! $seendirs{$dir} &&
exists($state->{dirArgs}{$dir}) )
{
my($oldTag);
$oldTag=$state->{dirMap}{$dir}{tagspec};
unless( ( exists($state->{opt}{A}) &&
defined($oldTag) ) ||
( defined($state->{opt}{r}) &&
( !defined($oldTag) ||
$state->{opt}{r} ne $oldTag ) ) )
{
next;
}
prepDirForOutput(
$dir,
$repoDir,
".",
\%seendirs,
'update',
$state->{dirArgs} );
}
}
}
print "ok\n";
}
sub req_ci
{
my ( $cmd, $data ) = @_;
argsplit("ci");
$log->info("req_ci : " . ( defined($data) ? $data : "[NULL]" ));
if ( $state->{method} eq 'pserver' and $state->{user} eq 'anonymous' )
{
print "error 1 anonymous user cannot commit via pserver\n";
cleanupWorkTree();
exit;
}
if ( -e $state->{CVSROOT} . "/index" )
{
$log->warn("file 'index' already exists in the git repository");
print "error 1 Index already exists in git repo\n";
cleanupWorkTree();
exit;
}
my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
$updater->update();
my @committedfiles = ();
my %oldmeta;
my $stickyInfo;
my $branchRef;
my $parenthash;
foreach my $filename ( @{$state->{args}} )
{
my $committedfile = $filename;
$filename = filecleanup($filename);
next unless ( exists $state->{entries}{$filename}{modified_filename} or not $state->{entries}{$filename}{unchanged} );
my $fileStickyInfo = resolveStickyInfo($filename);
if( !defined($branchRef) )
{
$stickyInfo = $fileStickyInfo;
if( defined($stickyInfo) &&
( defined($stickyInfo->{date}) ||
!defined($stickyInfo->{tag}) ) )
{
print "error 1 cannot commit with sticky date for file `$filename'\n";
cleanupWorkTree();
exit;
}
$branchRef = "refs/heads/$state->{module}";
if ( defined($stickyInfo) && defined($stickyInfo->{tag}) )
{
$branchRef = "refs/heads/$stickyInfo->{tag}";
}
$parenthash = `git show-ref -s $branchRef`;
chomp $parenthash;
if ($parenthash !~ /^[0-9a-f]{40}$/)
{
if ( defined($stickyInfo) && defined($stickyInfo->{tag}) )
{
print "error 1 sticky tag `$stickyInfo->{tag}' for file `$filename' is not a branch\n";
}
else
{
print "error 1 pserver cannot find the current HEAD of module";
}
cleanupWorkTree();
exit;
}
setupWorkTree($parenthash);
$log->info("Lockless commit start, basing commit on '$work->{workDir}', index file is '$work->{index}'");
$log->info("Created index '$work->{index}' for head $state->{module} - exit status $?");
}
elsif( !refHashEqual($stickyInfo,$fileStickyInfo) )
{
print "error 1 Committing different files to different"
. " branches is not currently supported\n";
cleanupWorkTree();
exit;
}
my $meta = $updater->getmeta($filename,$stickyInfo);
$oldmeta{$filename} = $meta;
my $wrev = revparse($filename);
my ( $filepart, $dirpart ) = filenamesplit($filename);
if ($wrev) {
system('git', 'checkout-index', '-f', '-u', $filename);
unless ($? == 0) {
die "Error running git-checkout-index -f -u $filename : $!";
}
}
my $addflag = 0;
my $rmflag = 0;
$rmflag = 1 if ( defined($wrev) and ($wrev=~/^-/) );
$addflag = 1 unless ( -e $filename );
unless ( $addflag or $wrev eq $meta->{revision} or
( $rmflag and $wrev eq "-$meta->{revision}" ) )
{
print "error 1 Up to date check failed for $filename\n";
cleanupWorkTree();
exit;
}
push @committedfiles, $committedfile;
$log->info("Committing $filename");
system("mkdir","-p",$dirpart) unless ( -d $dirpart );
unless ( $rmflag )
{
$log->debug("rename $state->{entries}{$filename}{modified_filename} $filename");
rename $state->{entries}{$filename}{modified_filename},$filename;
my $invmode = "";
foreach ( qw (r w x) ) { $invmode .= $_ unless ( $state->{entries}{$filename}{modified_mode} =~ /$_/ ); }
$log->debug("chmod u+" . $state->{entries}{$filename}{modified_mode} . "-" . $invmode . " $filename");
system("chmod","u+" . $state->{entries}{$filename}{modified_mode} . "-" . $invmode, $filename);
}
if ( $rmflag )
{
$log->info("Removing file '$filename'");
unlink($filename);
system("git", "update-index", "--remove", $filename);
}
elsif ( $addflag )
{
$log->info("Adding file '$filename'");
system("git", "update-index", "--add", $filename);
} else {
$log->info("UpdatingX2 file '$filename'");
system("git", "update-index", $filename);
}
}
unless ( scalar(@committedfiles) > 0 )
{
print "E No files to commit\n";
print "ok\n";
cleanupWorkTree();
return;
}
my $treehash = `git write-tree`;
chomp $treehash;
$log->debug("Treehash : $treehash, Parenthash : $parenthash");
my ( $msg_fh, $msg_filename ) = tempfile( DIR => $TEMP_DIR );
print $msg_fh $state->{opt}{m}; if ( defined ( $cfg->{gitcvs}{commitmsgannotation} ) ) {
if ($cfg->{gitcvs}{commitmsgannotation} !~ /^\s*$/ ) {
print $msg_fh "\n\n".$cfg->{gitcvs}{commitmsgannotation}."\n"
}
} else {
print $msg_fh "\n\nvia git-CVS emulator\n";
}
close $msg_fh;
my $commithash = `git commit-tree $treehash -p $parenthash < $msg_filename`;
chomp($commithash);
$log->info("Commit hash : $commithash");
unless ( $commithash =~ /[a-zA-Z0-9]{40}/ )
{
$log->warn("Commit failed (Invalid commit hash)");
print "error 1 Commit failed (unknown reason)\n";
cleanupWorkTree();
exit;
}
my @hook = ( $ENV{GIT_DIR}.'hooks/update', $branchRef,
$parenthash, $commithash );
if( -x $hook[0] ) {
unless( system( @hook ) == 0 )
{
$log->warn("Commit failed (update hook declined to update ref)");
print "error 1 Commit failed (update hook declined)\n";
cleanupWorkTree();
exit;
}
}
if (system(qw(git update-ref -m), "cvsserver ci",
$branchRef, $commithash, $parenthash)) {
$log->warn("update-ref for $state->{module} failed.");
print "error 1 Cannot commit -- update first\n";
cleanupWorkTree();
exit;
}
my $hook = $ENV{GIT_DIR}.'hooks/post-receive';
if( -x $hook ) {
open(my $pipe, "| $hook") || die "can't fork $!";
local $SIG{PIPE} = sub { die 'pipe broke' };
print $pipe "$parenthash $commithash $branchRef\n";
close $pipe || die "bad pipe: $! $?";
}
$updater->update();
$hook = $ENV{GIT_DIR}.'hooks/post-update';
if (-x $hook) {
system($hook, $branchRef);
}
foreach my $filename ( @committedfiles )
{
$filename = filecleanup($filename);
my $meta = $updater->getmeta($filename,$stickyInfo);
unless (defined $meta->{revision}) {
$meta->{revision} = "1.1";
}
my ( $filepart, $dirpart ) = filenamesplit($filename, 1);
$log->debug("Checked-in $dirpart : $filename");
print "M $state->{CVSROOT}/$state->{module}/$filename,v <-- $dirpart$filepart\n";
if ( defined $meta->{filehash} && $meta->{filehash} eq "deleted" )
{
print "M new revision: delete; previous revision: $oldmeta{$filename}{revision}\n";
print "Remove-entry $dirpart\n";
print "$filename\n";
} else {
if ($meta->{revision} eq "1.1") {
print "M initial revision: 1.1\n";
} else {
print "M new revision: $meta->{revision}; previous revision: $oldmeta{$filename}{revision}\n";
}
print "Checked-in $dirpart\n";
print "$filename\n";
my $kopts = kopts_from_path($filename,"sha1",$meta->{filehash});
print "/$filepart/$meta->{revision}//$kopts/" .
getStickyTagOrDate($stickyInfo) . "\n";
}
}
cleanupWorkTree();
print "ok\n";
}
sub req_status
{
my ( $cmd, $data ) = @_;
argsplit("status");
$log->info("req_status : " . ( defined($data) ? $data : "[NULL]" ));
my $updater;
$updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
$updater->update();
argsfromdir($updater);
foreach my $filename ( @{$state->{args}} )
{
$filename = filecleanup($filename);
if ( exists($state->{opt}{l}) &&
index($filename, '/', length($state->{prependdir})) >= 0 )
{
next;
}
my $wrev = revparse($filename);
my $stickyInfo = resolveStickyInfo($filename);
my $meta = $updater->getmeta($filename,$stickyInfo);
my $oldmeta = $meta;
if ( defined($wrev) and $wrev ne $meta->{revision} )
{
my($rmRev)=$wrev;
$rmRev=~s/^-//;
$oldmeta = $updater->getmeta($filename, $rmRev);
}
my $status;
if ( defined ( $wrev ) and defined($meta->{revision}) and
$wrev eq $meta->{revision} and
( ( $state->{entries}{$filename}{unchanged} and
( not defined ( $state->{entries}{$filename}{conflict} ) or
$state->{entries}{$filename}{conflict} !~ /^\+=/ ) ) or
( defined($state->{entries}{$filename}{modified_hash}) and
$state->{entries}{$filename}{modified_hash} eq
$meta->{filehash} ) ) )
{
$status = "Up-to-date"
}
if ( defined ( $wrev ) and defined ( $meta->{revision} ) and
$meta->{revision} ne $wrev and
( $state->{entries}{$filename}{unchanged} or
( defined($state->{entries}{$filename}{modified_hash}) and
$state->{entries}{$filename}{modified_hash} eq
$oldmeta->{filehash} ) ) )
{
$status ||= "Needs Checkout";
}
if ( not defined ( $wrev ) and defined ( $meta->{revision} ) )
{
$status ||= "Needs Checkout";
}
if ( defined ( $wrev ) and defined($meta->{revision}) and
$wrev eq $meta->{revision} and
$wrev ne "0" and
$state->{entries}{$filename}{modified_filename} )
{
$status ||= "Locally Modified";
}
if ( defined ( $wrev ) and defined ( $meta->{revision} ) and
$meta->{revision} ne $wrev and
$state->{entries}{$filename}{modified_filename} )
{
$status ||= "Needs Merge";
}
if ( defined ( $state->{entries}{$filename}{revision} ) and
( !defined($meta->{revision}) ||
$meta->{revision} eq "0" ) )
{
$status ||= "Locally Added";
}
if ( defined ( $wrev ) and defined ( $meta->{revision} ) and
$wrev eq "-$meta->{revision}" )
{
$status ||= "Locally Removed";
}
if ( defined ( $state->{entries}{$filename}{conflict} ) and
$state->{entries}{$filename}{conflict} =~ /^\+=/ )
{
$status ||= "Unresolved Conflict";
}
if ( 0 )
{
$status ||= "File had conflicts on merge";
}
$status ||= "Unknown";
my ($filepart) = filenamesplit($filename);
print "M =======" . ( "=" x 60 ) . "\n";
print "M File: $filepart\tStatus: $status\n";
if ( defined($state->{entries}{$filename}{revision}) )
{
print "M Working revision:\t" .
$state->{entries}{$filename}{revision} . "\n";
} else {
print "M Working revision:\tNo entry for $filename\n";
}
if ( defined($meta->{revision}) )
{
print "M Repository revision:\t" .
$meta->{revision} .
"\t$state->{CVSROOT}/$state->{module}/$filename,v\n";
my($tagOrDate)=$state->{entries}{$filename}{tag_or_date};
my($tag)=($tagOrDate=~m/^T(.+)$/);
if( !defined($tag) )
{
$tag="(none)";
}
print "M Sticky Tag:\t\t$tag\n";
my($date)=($tagOrDate=~m/^D(.+)$/);
if( !defined($date) )
{
$date="(none)";
}
print "M Sticky Date:\t\t$date\n";
my($options)=$state->{entries}{$filename}{options};
if( $options eq "" )
{
$options="(none)";
}
print "M Sticky Options:\t\t$options\n";
} else {
print "M Repository revision:\tNo revision control file\n";
}
print "M\n";
}
print "ok\n";
}
sub req_diff
{
my ( $cmd, $data ) = @_;
argsplit("diff");
$log->debug("req_diff : " . ( defined($data) ? $data : "[NULL]" ));
my ($revision1, $revision2);
if ( defined ( $state->{opt}{r} ) and ref $state->{opt}{r} eq "ARRAY" )
{
$revision1 = $state->{opt}{r}[0];
$revision2 = $state->{opt}{r}[1];
} else {
$revision1 = $state->{opt}{r};
}
$log->debug("Diffing revisions " .
( defined($revision1) ? $revision1 : "[NULL]" ) .
" and " . ( defined($revision2) ? $revision2 : "[NULL]" ) );
my $updater;
$updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
$updater->update();
argsfromdir($updater);
my($foundDiff);
foreach my $argFilename ( @{$state->{args}} )
{
my($filename) = filecleanup($argFilename);
my ( $fh, $file1, $file2, $meta1, $meta2, $filediff );
my $wrev = revparse($filename);
if ( defined ( $revision1 ) )
{
$meta1 = $updater->getmeta($filename, $revision1);
}
elsif( defined($wrev) && $wrev ne "0" )
{
my($rmRev)=$wrev;
$rmRev=~s/^-//;
$meta1 = $updater->getmeta($filename, $rmRev);
}
if ( !defined($meta1) ||
$meta1->{filehash} eq "deleted" )
{
if( !exists($state->{opt}{N}) )
{
if(!defined($revision1))
{
print "E File $filename at revision $revision1 doesn't exist\n";
}
next;
}
elsif( !defined($meta1) )
{
$meta1 = {
name => $filename,
revision => '0',
filehash => 'deleted'
};
}
}
if ( defined ( $revision2 ) )
{
$meta2 = $updater->getmeta($filename, $revision2);
}
elsif(defined($state->{entries}{$filename}{modified_filename}))
{
$file2 = $state->{entries}{$filename}{modified_filename};
$meta2 = {
name => $filename,
revision => '0',
filehash => 'modified'
};
}
elsif( defined($wrev) && ($wrev!~/^-/) )
{
if(!defined($revision1)) {
next;
}
$meta2 = $updater->getmeta($filename, $wrev);
}
if(!defined($file2))
{
if ( !defined($meta2) ||
$meta2->{filehash} eq "deleted" )
{
if( !exists($state->{opt}{N}) )
{
if(!defined($revision2))
{
print "E File $filename at revision $revision2 doesn't exist\n";
}
next;
}
elsif( !defined($meta2) )
{
$meta2 = {
name => $filename,
revision => '0',
filehash => 'deleted'
};
}
}
}
if( $meta1->{filehash} eq $meta2->{filehash} )
{
$log->info("unchanged $filename");
next;
}
( undef, $file1 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
transmitfile($meta1->{filehash}, { targetfile => $file1 });
if(!defined($file2))
{
( undef, $file2 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
transmitfile($meta2->{filehash}, { targetfile => $file2 });
}
print "M Index: $argFilename\n";
print "M =======" . ( "=" x 60 ) . "\n";
print "M RCS file: $state->{CVSROOT}/$state->{module}/$filename,v\n";
if ( defined ( $meta1 ) && $meta1->{revision} ne "0" )
{
print "M retrieving revision $meta1->{revision}\n"
}
if ( defined ( $meta2 ) && $meta2->{revision} ne "0" )
{
print "M retrieving revision $meta2->{revision}\n"
}
print "M diff ";
foreach my $opt ( sort keys %{$state->{opt}} )
{
if ( ref $state->{opt}{$opt} eq "ARRAY" )
{
foreach my $value ( @{$state->{opt}{$opt}} )
{
print "-$opt $value ";
}
} else {
print "-$opt ";
if ( defined ( $state->{opt}{$opt} ) )
{
print "$state->{opt}{$opt} "
}
}
}
print "$argFilename\n";
$log->info("Diffing $filename -r $meta1->{revision} -r " .
( $meta2->{revision} or "workingcopy" ));
my (@diffCmd) = ( 'diff' );
if ( exists($state->{opt}{N}) )
{
push @diffCmd,"-N";
}
if ( exists $state->{opt}{u} )
{
push @diffCmd,("-u","-L");
if( $meta1->{filehash} eq "deleted" )
{
push @diffCmd,"/dev/null";
} else {
push @diffCmd,("$argFilename\trevision $meta1->{revision}");
}
if( defined($meta2->{filehash}) )
{
if( $meta2->{filehash} eq "deleted" )
{
push @diffCmd,("-L","/dev/null");
} else {
push @diffCmd,("-L",
"$argFilename\trevision $meta2->{revision}");
}
} else {
push @diffCmd,("-L","$argFilename\tworking copy");
}
}
push @diffCmd,($file1,$file2);
if(!open(DIFF,"-|",@diffCmd))
{
$log->warn("Unable to run diff: $!");
}
my($diffLine);
while(defined($diffLine=<DIFF>))
{
print "M $diffLine";
$foundDiff=1;
}
close(DIFF);
}
if($foundDiff)
{
print "error \n";
}
else
{
print "ok\n";
}
}
sub req_log
{
my ( $cmd, $data ) = @_;
argsplit("log");
$log->debug("req_log : " . ( defined($data) ? $data : "[NULL]" ));
my ( $revFilter );
if ( defined ( $state->{opt}{r} ) )
{
$revFilter = $state->{opt}{r};
}
my $updater;
$updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
$updater->update();
argsfromdir($updater);
foreach my $filename ( @{$state->{args}} )
{
$filename = filecleanup($filename);
my $headmeta = $updater->getmeta($filename);
my ($revisions,$totalrevisions) = $updater->getlog($filename,
$revFilter);
next unless ( scalar(@$revisions) );
print "M \n";
print "M RCS file: $state->{CVSROOT}/$state->{module}/$filename,v\n";
print "M Working file: $filename\n";
print "M head: $headmeta->{revision}\n";
print "M branch:\n";
print "M locks: strict\n";
print "M access list:\n";
print "M symbolic names:\n";
print "M keyword substitution: kv\n";
print "M total revisions: $totalrevisions;\tselected revisions: " .
scalar(@$revisions) . "\n";
print "M description:\n";
foreach my $revision ( @$revisions )
{
print "M ----------------------------\n";
print "M revision $revision->{revision}\n";
if ( $revision->{modified} =~ /(\d+)\s+(\w+)\s+(\d+)\s+(\S+)/ and
defined($DATE_LIST->{$2}) )
{
$revision->{modified} = sprintf('%04d/%02d/%02d %s',
$3, $DATE_LIST->{$2}, $1, $4 );
}
$revision->{author} = cvs_author($revision->{author});
print "M date: $revision->{modified};" .
" author: $revision->{author}; state: " .
( $revision->{filehash} eq "deleted" ? "dead" : "Exp" ) .
"; lines: +2 -3\n";
my $commitmessage;
$commitmessage = $updater->commitmessage($revision->{commithash});
$commitmessage =~ s/^/M /mg;
print $commitmessage . "\n";
}
print "M =======" . ( "=" x 70 ) . "\n";
}
print "ok\n";
}
sub req_annotate
{
my ( $cmd, $data ) = @_;
argsplit("annotate");
$log->info("req_annotate : " . ( defined($data) ? $data : "[NULL]" ));
my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
$updater->update();
argsfromdir($updater);
setupWorkTree();
$log->info("Temp checkoutdir creation successful, basing annotate session work on '$work->{workDir}', index file is '$ENV{GIT_INDEX_FILE}'");
foreach my $filename ( @{$state->{args}} )
{
$filename = filecleanup($filename);
my $meta = $updater->getmeta($filename);
next unless ( $meta->{revision} );
my $revisions = $updater->gethistorydense($filename);
my $lastseenin = $revisions->[0][2];
system("git", "read-tree", $lastseenin);
unless ($? == 0)
{
print "E error running git-read-tree $lastseenin $ENV{GIT_INDEX_FILE} $!\n";
return;
}
$log->info("Created index '$ENV{GIT_INDEX_FILE}' with commit $lastseenin - exit status $?");
system('git', 'checkout-index', '-f', '-u', $filename);
unless ($? == 0) {
print "E error running git-checkout-index -f -u $filename : $!\n";
return;
}
$log->info("Annotate $filename");
my $a_hints = "$work->{workDir}/.annotate_hints";
if (!open(ANNOTATEHINTS, '>', $a_hints)) {
print "E failed to open '$a_hints' for writing: $!\n";
return;
}
for (my $i=0; $i < @$revisions; $i++)
{
print ANNOTATEHINTS $revisions->[$i][2];
if ($i+1 < @$revisions) { print ANNOTATEHINTS ' ' . $revisions->[$i+1][2];
}
print ANNOTATEHINTS "\n";
}
print ANNOTATEHINTS "\n";
close ANNOTATEHINTS
or (print "E failed to write $a_hints: $!\n"), return;
my @cmd = (qw(git annotate -l -S), $a_hints, $filename);
if (!open(ANNOTATE, "-|", @cmd)) {
print "E error invoking ". join(' ',@cmd) .": $!\n";
return;
}
my $metadata = {};
print "E Annotations for $filename\n";
print "E ***************\n";
while ( <ANNOTATE> )
{
if (m/^([a-zA-Z0-9]{40})\t\([^\)]*\)(.*)$/i)
{
my $commithash = $1;
my $data = $2;
unless ( defined ( $metadata->{$commithash} ) )
{
$metadata->{$commithash} = $updater->getmeta($filename, $commithash);
$metadata->{$commithash}{author} = cvs_author($metadata->{$commithash}{author});
$metadata->{$commithash}{modified} = sprintf("%02d-%s-%02d", $1, $2, $3) if ( $metadata->{$commithash}{modified} =~ /^(\d+)\s(\w+)\s\d\d(\d\d)/ );
}
printf("M %-7s (%-8s %10s): %s\n",
$metadata->{$commithash}{revision},
$metadata->{$commithash}{author},
$metadata->{$commithash}{modified},
$data
);
} else {
$log->warn("Error in annotate output! LINE: $_");
print "E Annotate error \n";
next;
}
}
close ANNOTATE;
}
cleanupWorkTree();
print "ok\n";
}
sub argsplit
{
$state->{args} = [];
$state->{files} = [];
$state->{opt} = {};
return unless( defined($state->{arguments}) and ref $state->{arguments} eq "ARRAY" );
my $type = shift;
if ( defined($type) )
{
my $opt = {};
$opt = { A => 0, N => 0, P => 0, R => 0, c => 0, f => 0, l => 0, n => 0, p => 0, s => 0, r => 1, D => 1, d => 1, k => 1, j => 1, } if ( $type eq "co" );
$opt = { v => 0, l => 0, R => 0 } if ( $type eq "status" );
$opt = { A => 0, P => 0, C => 0, d => 0, f => 0, l => 0, R => 0, p => 0, k => 1, r => 1, D => 1, j => 1, I => 1, W => 1 } if ( $type eq "update" );
$opt = { l => 0, R => 0, k => 1, D => 1, D => 1, r => 2, N => 0 } if ( $type eq "diff" );
$opt = { c => 0, R => 0, l => 0, f => 0, F => 1, m => 1, r => 1 } if ( $type eq "ci" );
$opt = { k => 1, m => 1 } if ( $type eq "add" );
$opt = { f => 0, l => 0, R => 0 } if ( $type eq "remove" );
$opt = { l => 0, b => 0, h => 0, R => 0, t => 0, N => 0, S => 0, r => 1, d => 1, s => 1, w => 1 } if ( $type eq "log" );
while ( scalar ( @{$state->{arguments}} ) > 0 )
{
my $arg = shift @{$state->{arguments}};
next if ( $arg eq "--" );
next unless ( $arg =~ /\S/ );
if ( $arg =~ /^-(\w)(.*)/ )
{
if ( $opt->{$1} )
{
if ( $opt->{$1} > 1 and exists ( $state->{opt}{$1} ) )
{
$state->{opt}{$1} = [ $state->{opt}{$1} ];
if ( length($2) > 0 )
{
push @{$state->{opt}{$1}},$2;
} else {
push @{$state->{opt}{$1}}, shift @{$state->{arguments}};
}
} else {
if ( length($2) > 0 )
{
$state->{opt}{$1} = $2;
} else {
$state->{opt}{$1} = shift @{$state->{arguments}};
}
}
} else {
$state->{opt}{$1} = undef;
}
}
else
{
push @{$state->{args}}, $arg;
}
}
}
else
{
my $mode = 0;
foreach my $value ( @{$state->{arguments}} )
{
if ( $value eq "--" )
{
$mode++;
next;
}
push @{$state->{args}}, $value if ( $mode == 0 );
push @{$state->{files}}, $value if ( $mode == 1 );
}
}
}
sub expandArg
{
my ($updater,$outNameMap,$outDirMap,$path,$isDir) = @_;
my $fullPath = filecleanup($path);
if( defined($state->{dirMap}{$fullPath}) ||
defined($state->{dirMap}{"$fullPath/"}) )
{
$isDir=1;
if(defined($state->{entries}{$fullPath}))
{
$log->fatal("Inconsistent file/dir type");
die "Inconsistent file/dir type";
}
}
elsif(defined($state->{entries}{$fullPath}))
{
$isDir=0;
}
my($revDirMap,$otherRevDirMap);
if(!defined($isDir) || $isDir)
{
if(exists($state->{opt}{A}))
{
$revDirMap=$updater->getRevisionDirMap();
}
elsif( defined($state->{opt}{r}) and
ref $state->{opt}{r} eq "ARRAY" )
{
$revDirMap=$updater->getRevisionDirMap($state->{opt}{r}[0]);
$otherRevDirMap=$updater->getRevisionDirMap($state->{opt}{r}[1]);
}
elsif(defined($state->{opt}{r}))
{
$revDirMap=$updater->getRevisionDirMap($state->{opt}{r});
}
else
{
my($sticky)=getDirStickyInfo($fullPath);
$revDirMap=$updater->getRevisionDirMap($sticky->{tag});
}
if( defined($revDirMap->{$fullPath}) ||
defined($otherRevDirMap->{$fullPath}) )
{
$isDir=1;
}
}
if(!$isDir)
{
$outNameMap->{$fullPath}=1;
}
else
{
$outDirMap->{$fullPath}=1;
if(defined($revDirMap->{$fullPath}))
{
addDirMapFiles($updater,$outNameMap,$outDirMap,
$revDirMap->{$fullPath});
}
if( defined($otherRevDirMap) &&
defined($otherRevDirMap->{$fullPath}) )
{
addDirMapFiles($updater,$outNameMap,$outDirMap,
$otherRevDirMap->{$fullPath});
}
}
}
sub addDirMapFiles
{
my($updater,$outNameMap,$outDirMap,$dirMap)=@_;
my($fullName);
foreach $fullName (keys(%$dirMap))
{
my $cleanName=$fullName;
if(defined($state->{prependdir}))
{
if(!($cleanName=~s/^\Q$state->{prependdir}\E//))
{
$log->fatal("internal error stripping prependdir");
die "internal error stripping prependdir";
}
}
if($dirMap->{$fullName} eq "F")
{
$outNameMap->{$cleanName}=1;
}
elsif($dirMap->{$fullName} eq "D")
{
if(!$state->{opt}{l})
{
expandArg($updater,$outNameMap,$outDirMap,$cleanName,1);
}
}
else
{
$log->fatal("internal error in addDirMapFiles");
die "internal error in addDirMapFiles";
}
}
}
sub argsfromdir
{
my $updater = shift;
if(scalar(@{$state->{args}})==0)
{
$state->{args} = [ "." ];
}
my %allArgs;
my %allDirs;
for my $file (@{$state->{args}})
{
expandArg($updater,\%allArgs,\%allDirs,$file);
}
foreach my $file (keys %{$state->{entries}})
{
$allArgs{remove_prependdir($file)} = 1;
}
$state->{dirArgs} = \%allDirs;
$state->{args} = [
sort {
my @piecesA=split('/',$a);
my @piecesB=split('/',$b);
my $count=scalar(@piecesA);
my $tmp=scalar(@piecesB);
return $count<=>$tmp if($count!=$tmp);
for($tmp=0;$tmp<$count;$tmp++)
{
if($piecesA[$tmp] ne $piecesB[$tmp])
{
return $piecesA[$tmp] cmp $piecesB[$tmp]
}
}
return 0;
} keys(%allArgs) ];
}
sub getDirStickyInfo
{
my($fullPath)=@_;
$fullPath=~s%/+$%%;
while($fullPath ne "" && !defined($state->{dirMap}{"$fullPath/"}))
{
$fullPath=~s%/?[^/]*$%%;
}
if( !defined($state->{dirMap}{"$fullPath/"}) &&
( $fullPath eq "" ||
$fullPath eq "." ) )
{
return $state->{dirMap}{""}{stickyInfo};
}
else
{
return $state->{dirMap}{"$fullPath/"}{stickyInfo};
}
}
sub resolveStickyInfo
{
my($filename,$stickyTag,$stickyDate,$reset) = @_;
my $result;
if($reset)
{
}
elsif( defined($stickyTag) && $stickyTag ne "" )
{
$result={ 'tag' => (defined($stickyTag)?$stickyTag:undef) };
}
elsif( defined($state->{entries}{$filename}) &&
defined($state->{entries}{$filename}{tag_or_date}) &&
$state->{entries}{$filename}{tag_or_date} ne "" )
{
my($tagOrDate)=$state->{entries}{$filename}{tag_or_date};
if($tagOrDate=~/^T([^ ]+)\s*$/)
{
$result = { 'tag' => $1 };
}
elsif($tagOrDate=~/^D([0-9.]+)\s*$/)
{
$result= { 'date' => $1 };
}
else
{
die "Unknown tag_or_date format\n";
}
}
else
{
$result=getDirStickyInfo($filename);
}
return $result;
}
sub getStickyTagOrDate
{
my($stickyInfo)=@_;
my $result;
if(defined($stickyInfo) && defined($stickyInfo->{tag}))
{
$result="T$stickyInfo->{tag}";
}
else
{
$result="";
}
return $result;
}
sub statecleanup
{
$state->{files} = [];
$state->{dirArgs} = {};
$state->{args} = [];
$state->{arguments} = [];
$state->{entries} = {};
$state->{dirMap} = {};
}
sub revparse
{
my $filename = shift;
return $state->{entries}{$filename}{revision};
}
sub transmitfile
{
my $filehash = shift;
my $options = shift;
if ( defined ( $filehash ) and $filehash eq "deleted" )
{
$log->warn("filehash is 'deleted'");
return;
}
die "Need filehash" unless ( defined ( $filehash ) and $filehash =~ /^[a-zA-Z0-9]{40}$/ );
my $type = `git cat-file -t $filehash`;
chomp $type;
die ( "Invalid type '$type' (expected 'blob')" ) unless ( defined ( $type ) and $type eq "blob" );
my $size = `git cat-file -s $filehash`;
chomp $size;
$log->debug("transmitfile($filehash) size=$size, type=$type");
if ( open my $fh, '-|', "git", "cat-file", "blob", $filehash )
{
if ( defined ( $options->{targetfile} ) )
{
my $targetfile = $options->{targetfile};
open NEWFILE, ">", $targetfile or die("Couldn't open '$targetfile' for writing : $!");
print NEWFILE $_ while ( <$fh> );
close NEWFILE or die("Failed to write '$targetfile': $!");
} elsif ( defined ( $options->{print} ) && $options->{print} ) {
while ( <$fh> ) {
if( /\n\z/ ) {
print 'M ', $_;
} else {
print 'MT text ', $_, "\n";
}
}
} else {
print "$size\n";
print while ( <$fh> );
}
close $fh or die ("Couldn't close filehandle for transmitfile(): $!");
} else {
die("Couldn't execute git-cat-file");
}
}
sub filenamesplit
{
my $filename = shift;
my $fixforlocaldir = shift;
my ( $filepart, $dirpart ) = ( $filename, "." );
( $filepart, $dirpart ) = ( $2, $1 ) if ( $filename =~ /(.*)\/(.*)/ );
$dirpart .= "/";
if ( $fixforlocaldir )
{
$dirpart =~ s/^$state->{prependdir}//;
}
return ( $filepart, $dirpart );
}
sub filecleanup
{
my $filename = shift;
return undef unless(defined($filename));
if ( $filename =~ /^\// )
{
print "E absolute filenames '$filename' not supported by server\n";
return undef;
}
if($filename eq ".")
{
$filename="";
}
$filename =~ s/^\.\///g;
$filename =~ s%/+%/%g;
$filename = $state->{prependdir} . $filename;
$filename =~ s%/$%%;
return $filename;
}
sub remove_prependdir
{
my($path) = @_;
if(defined($state->{prependdir}) && $state->{prependdir} ne "")
{
my($pre)=$state->{prependdir};
$pre=~s%/$%%;
if(!($path=~s%^\Q$pre\E/?%%))
{
$log->fatal("internal error missing prependdir");
die("internal error missing prependdir");
}
}
return $path;
}
sub validateGitDir
{
if( !defined($state->{CVSROOT}) )
{
print "error 1 CVSROOT not specified\n";
cleanupWorkTree();
exit;
}
if( $ENV{GIT_DIR} ne ($state->{CVSROOT} . '/') )
{
print "error 1 Internally inconsistent CVSROOT\n";
cleanupWorkTree();
exit;
}
}
sub setupWorkTree
{
my ($ver) = @_;
validateGitDir();
if( ( defined($work->{state}) && $work->{state} != 1 ) ||
defined($work->{tmpDir}) )
{
$log->warn("Bad work tree state management");
print "error 1 Internal setup multiple work trees without cleanup\n";
cleanupWorkTree();
exit;
}
$work->{workDir} = tempdir ( DIR => $TEMP_DIR );
if( !defined($work->{index}) )
{
(undef, $work->{index}) = tempfile ( DIR => $TEMP_DIR, OPEN => 0 );
}
chdir $work->{workDir} or
die "Unable to chdir to $work->{workDir}\n";
$log->info("Setting up GIT_WORK_TREE as '.' in '$work->{workDir}', index file is '$work->{index}'");
$ENV{GIT_WORK_TREE} = ".";
$ENV{GIT_INDEX_FILE} = $work->{index};
$work->{state} = 2;
if($ver)
{
system("git","read-tree",$ver);
unless ($? == 0)
{
$log->warn("Error running git-read-tree");
die "Error running git-read-tree $ver in $work->{workDir} $!\n";
}
}
}
sub ensureWorkTree
{
if( defined($work->{tmpDir}) )
{
$log->warn("Bad work tree state management [ensureWorkTree()]");
print "error 1 Internal setup multiple dirs without cleanup\n";
cleanupWorkTree();
exit;
}
if( $work->{state} )
{
return;
}
validateGitDir();
if( !defined($work->{emptyDir}) )
{
$work->{emptyDir} = tempdir ( DIR => $TEMP_DIR, OPEN => 0);
}
chdir $work->{emptyDir} or
die "Unable to chdir to $work->{emptyDir}\n";
my $ver = `git show-ref -s refs/heads/$state->{module}`;
chomp $ver;
if ($ver !~ /^[0-9a-f]{40}$/)
{
$log->warn("Error from git show-ref -s refs/head$state->{module}");
print "error 1 cannot find the current HEAD of module";
cleanupWorkTree();
exit;
}
if( !defined($work->{index}) )
{
(undef, $work->{index}) = tempfile ( DIR => $TEMP_DIR, OPEN => 0 );
}
$ENV{GIT_WORK_TREE} = ".";
$ENV{GIT_INDEX_FILE} = $work->{index};
$work->{state} = 1;
system("git","read-tree",$ver);
unless ($? == 0)
{
die "Error running git-read-tree $ver $!\n";
}
}
sub cleanupWorkTree
{
if( ! $work->{state} )
{
return;
}
chdir "/" or die "Unable to chdir '/'\n";
if( defined($work->{workDir}) )
{
rmtree( $work->{workDir} );
undef $work->{workDir};
}
undef $work->{state};
}
sub setupTmpDir
{
$work->{tmpDir} = tempdir ( DIR => $TEMP_DIR );
chdir $work->{tmpDir} or die "Unable to chdir $work->{tmpDir}\n";
return $work->{tmpDir};
}
sub cleanupTmpDir
{
if ( !defined($work->{tmpDir}) )
{
$log->warn("cleanup tmpdir that has not been setup");
die "Cleanup tmpDir that has not been setup\n";
}
if( defined($work->{state}) )
{
if( $work->{state} == 1 )
{
chdir $work->{emptyDir} or
die "Unable to chdir to $work->{emptyDir}\n";
}
elsif( $work->{state} == 2 )
{
chdir $work->{workDir} or
die "Unable to chdir to $work->{emptyDir}\n";
}
else
{
$log->warn("Inconsistent work dir state");
die "Inconsistent work dir state\n";
}
}
else
{
chdir "/" or die "Unable to chdir '/'\n";
}
}
sub kopts_from_path
{
my ($path, $srcType, $name) = @_;
if ( defined ( $cfg->{gitcvs}{usecrlfattr} ) and
$cfg->{gitcvs}{usecrlfattr} =~ /\s*(1|true|yes)\s*$/i )
{
my ($val) = check_attr( "text", $path );
if ( $val eq "unspecified" )
{
$val = check_attr( "crlf", $path );
}
if ( $val eq "unset" )
{
return "-kb"
}
elsif ( check_attr( "eol", $path ) ne "unspecified" ||
$val eq "set" || $val eq "input" )
{
return "";
}
else
{
$log->info("Unrecognized check_attr crlf $path : $val");
}
}
if ( defined ( $cfg->{gitcvs}{allbinary} ) )
{
if( ($cfg->{gitcvs}{allbinary} =~ /^\s*(1|true|yes)\s*$/i) )
{
return "-kb";
}
elsif( ($cfg->{gitcvs}{allbinary} =~ /^\s*guess\s*$/i) )
{
if( is_binary($srcType,$name) )
{
$log->debug("... as binary");
return "-kb";
}
else
{
$log->debug("... as text");
}
}
}
return "";
}
sub check_attr
{
my ($attr,$path) = @_;
ensureWorkTree();
if ( open my $fh, '-|', "git", "check-attr", $attr, "--", $path )
{
my $val = <$fh>;
close $fh;
$val =~ s/.*: ([^:\r\n]*)\s*$/$1/;
return $val;
}
else
{
return undef;
}
}
sub is_binary
{
my ($srcType,$name) = @_;
$log->debug("is_binary($srcType,$name)");
my @counts;
my $i;
for($i=0;$i<256;$i++)
{
$counts[$i]=0;
}
my $fh = open_blob_or_die($srcType,$name);
my $line;
while( defined($line=<$fh>) )
{
if( $line =~ /\0|(\r[^\n])/ )
{
close($fh);
return 1;
}
my $len=length($line);
for($i=0;$i<$len;$i++)
{
$counts[ord(substr($line,$i,1))]++;
}
}
close $fh;
$counts[ord("\n")]=0;
$counts[ord("\r")]=0;
my $printable=0;
my $nonprintable=0;
for($i=0;$i<256;$i++)
{
if( $i < 32 &&
$i != ord("\b") &&
$i != ord("\t") &&
$i != 033 && $i != 014 ) {
$nonprintable+=$counts[$i];
}
elsif( $i==127 ) {
$nonprintable+=$counts[$i];
}
else
{
$printable+=$counts[$i];
}
}
return ($printable >> 7) < $nonprintable;
}
sub open_blob_or_die
{
my ($srcType,$name) = @_;
my ($fh);
if( $srcType eq "file" )
{
if( !open $fh,"<",$name )
{
$log->warn("Unable to open file $name: $!");
die "Unable to open file $name: $!\n";
}
}
elsif( $srcType eq "sha1" )
{
unless ( defined ( $name ) and $name =~ /^[a-zA-Z0-9]{40}$/ )
{
$log->warn("Need filehash");
die "Need filehash\n";
}
my $type = `git cat-file -t $name`;
chomp $type;
unless ( defined ( $type ) and $type eq "blob" )
{
$log->warn("Invalid type '$type' for '$name'");
die ( "Invalid type '$type' (expected 'blob')" )
}
my $size = `git cat-file -s $name`;
chomp $size;
$log->debug("open_blob_or_die($name) size=$size, type=$type");
unless( open $fh, '-|', "git", "cat-file", "blob", $name )
{
$log->warn("Unable to open sha1 $name");
die "Unable to open sha1 $name\n";
}
}
else
{
$log->warn("Unknown type of blob source: $srcType");
die "Unknown type of blob source: $srcType\n";
}
return $fh;
}
sub cvs_author
{
my $author_line = shift;
(my $author) = $author_line =~ /<([^@>]*)/;
$author =~ s/[^-a-zA-Z0-9_.]/_/g;
$author =~ s/^-/_/;
$author;
}
sub descramble
{
my @SHIFTS = (
0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15,
16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31,
114,120, 53, 79, 96,109, 72,108, 70, 64, 76, 67,116, 74, 68, 87,
111, 52, 75,119, 49, 34, 82, 81, 95, 65,112, 86,118,110,122,105,
41, 57, 83, 43, 46,102, 40, 89, 38,103, 45, 50, 42,123, 91, 35,
125, 55, 54, 66,124,126, 59, 47, 92, 71,115, 78, 88,107,106, 56,
36,121,117,104,101,100, 69, 73, 99, 63, 94, 93, 39, 37, 61, 48,
58,113, 32, 90, 44, 98, 60, 51, 33, 97, 62, 77, 84, 80, 85,223,
225,216,187,166,229,189,222,188,141,249,148,200,184,136,248,190,
199,170,181,204,138,232,218,183,255,234,220,247,213,203,226,193,
174,172,228,252,217,201,131,230,197,211,145,238,161,179,160,212,
207,221,254,173,202,146,224,151,140,196,205,130,135,133,143,246,
192,159,244,239,185,168,215,144,139,165,180,157,147,186,214,176,
227,231,219,169,175,156,206,198,129,164,150,210,154,177,134,127,
182,128,158,208,162,132,167,209,149,241,153,251,237,236,171,195,
243,233,253,240,194,250,191,155,142,137,245,235,163,242,178,152
);
my ($str) = @_;
{
my $fmt = substr($str, 0, 1);
die "invalid password format `$fmt'" unless $fmt eq 'A';
}
my @str = unpack "C*", substr($str, 1);
my $ret = join '', map { chr $SHIFTS[$_] } @str;
return $ret;
}
sub refHashEqual
{
my($v1,$v2) = @_;
my $out;
if(!defined($v1))
{
if(!defined($v2))
{
$out=1;
}
}
elsif( !defined($v2) ||
scalar(keys(%{$v1})) != scalar(keys(%{$v2})) )
{
}
else
{
$out=1;
my $key;
foreach $key (keys(%{$v1}))
{
if( !exists($v2->{$key}) ||
defined($v1->{$key}) ne defined($v2->{$key}) ||
( defined($v1->{$key}) &&
$v1->{$key} ne $v2->{$key} ) )
{
$out=undef;
last;
}
}
}
return $out;
}
package GITCVS::log;
use strict;
use warnings;
=head1 NAME
GITCVS::log
=head1 DESCRIPTION
This module provides very crude logging with a similar interface to
Log::Log4perl
=head1 METHODS
=cut
=head2 new
Creates a new log object, optionally you can specify a filename here to
indicate the file to log to. If no log file is specified, you can specify one
later with method setfile, or indicate you no longer want logging with method
nofile.
Until one of these methods is called, all log calls will buffer messages ready
to write out.
=cut
sub new
{
my $class = shift;
my $filename = shift;
my $self = {};
bless $self, $class;
if ( defined ( $filename ) )
{
open $self->{fh}, ">>", $filename or die("Couldn't open '$filename' for writing : $!");
}
return $self;
}
=head2 setfile
This methods takes a filename, and attempts to open that file as the log file.
If successful, all buffered data is written out to the file, and any further
logging is written directly to the file.
=cut
sub setfile
{
my $self = shift;
my $filename = shift;
if ( defined ( $filename ) )
{
open $self->{fh}, ">>", $filename or die("Couldn't open '$filename' for writing : $!");
}
return unless ( defined ( $self->{buffer} ) and ref $self->{buffer} eq "ARRAY" );
while ( my $line = shift @{$self->{buffer}} )
{
print {$self->{fh}} $line;
}
}
=head2 nofile
This method indicates no logging is going to be used. It flushes any entries in
the internal buffer, and sets a flag to ensure no further data is put there.
=cut
sub nofile
{
my $self = shift;
$self->{nolog} = 1;
return unless ( defined ( $self->{buffer} ) and ref $self->{buffer} eq "ARRAY" );
$self->{buffer} = [];
}
=head2 _logopen
Internal method. Returns true if the log file is open, false otherwise.
=cut
sub _logopen
{
my $self = shift;
return 1 if ( defined ( $self->{fh} ) and ref $self->{fh} eq "GLOB" );
return 0;
}
=head2 debug info warn fatal
These four methods are wrappers to _log. They provide the actual interface for
logging data.
=cut
sub debug { my $self = shift; $self->_log("debug", @_); }
sub info { my $self = shift; $self->_log("info" , @_); }
sub warn { my $self = shift; $self->_log("warn" , @_); }
sub fatal { my $self = shift; $self->_log("fatal", @_); }
=head2 _log
This is an internal method called by the logging functions. It generates a
timestamp and pushes the logged line either to file, or internal buffer.
=cut
sub _log
{
my $self = shift;
my $level = shift;
return if ( $self->{nolog} );
my @time = localtime;
my $timestring = sprintf("%4d-%02d-%02d %02d:%02d:%02d : %-5s",
$time[5] + 1900,
$time[4] + 1,
$time[3],
$time[2],
$time[1],
$time[0],
uc $level,
);
if ( $self->_logopen )
{
print {$self->{fh}} $timestring . " - " . join(" ",@_) . "\n";
} else {
push @{$self->{buffer}}, $timestring . " - " . join(" ",@_) . "\n";
}
}
=head2 DESTROY
This method simply closes the file handle if one is open
=cut
sub DESTROY
{
my $self = shift;
if ( $self->_logopen )
{
close $self->{fh};
}
}
package GITCVS::updater;
use strict;
use warnings;
use DBI;
=head1 METHODS
=cut
=head2 new
=cut
sub new
{
my $class = shift;
my $config = shift;
my $module = shift;
my $log = shift;
die "Need to specify a git repository" unless ( defined($config) and -d $config );
die "Need to specify a module" unless ( defined($module) );
$class = ref($class) || $class;
my $self = {};
bless $self, $class;
$self->{valid_tables} = {'revision' => 1,
'revision_ix1' => 1,
'revision_ix2' => 1,
'head' => 1,
'head_ix1' => 1,
'properties' => 1,
'commitmsgs' => 1};
$self->{module} = $module;
$self->{git_path} = $config . "/";
$self->{log} = $log;
die "Git repo '$self->{git_path}' doesn't exist" unless ( -d $self->{git_path} );
$self->{commitRefCache} = {};
$self->{dbdriver} = $cfg->{gitcvs}{$state->{method}}{dbdriver} ||
$cfg->{gitcvs}{dbdriver} || "SQLite";
$self->{dbname} = $cfg->{gitcvs}{$state->{method}}{dbname} ||
$cfg->{gitcvs}{dbname} || "%Ggitcvs.%m.sqlite";
$self->{dbuser} = $cfg->{gitcvs}{$state->{method}}{dbuser} ||
$cfg->{gitcvs}{dbuser} || "";
$self->{dbpass} = $cfg->{gitcvs}{$state->{method}}{dbpass} ||
$cfg->{gitcvs}{dbpass} || "";
$self->{dbtablenameprefix} = $cfg->{gitcvs}{$state->{method}}{dbtablenameprefix} ||
$cfg->{gitcvs}{dbtablenameprefix} || "";
my %mapping = ( m => $module,
a => $state->{method},
u => getlogin || getpwuid($<) || $<,
G => $self->{git_path},
g => mangle_dirname($self->{git_path}),
);
$self->{dbname} =~ s/%([mauGg])/$mapping{$1}/eg;
$self->{dbuser} =~ s/%([mauGg])/$mapping{$1}/eg;
$self->{dbtablenameprefix} =~ s/%([mauGg])/$mapping{$1}/eg;
$self->{dbtablenameprefix} = mangle_tablename($self->{dbtablenameprefix});
die "Invalid char ':' in dbdriver" if $self->{dbdriver} =~ /:/;
die "Invalid char ';' in dbname" if $self->{dbname} =~ /;/;
$self->{dbh} = DBI->connect("dbi:$self->{dbdriver}:dbname=$self->{dbname}",
$self->{dbuser},
$self->{dbpass});
die "Error connecting to database\n" unless defined $self->{dbh};
$self->{tables} = {};
foreach my $table ( keys %{$self->{dbh}->table_info(undef,undef,undef,'TABLE')->fetchall_hashref('TABLE_NAME')} )
{
$self->{tables}{$table} = 1;
}
unless ( $self->{tables}{$self->tablename("revision")} )
{
my $tablename = $self->tablename("revision");
my $ix1name = $self->tablename("revision_ix1");
my $ix2name = $self->tablename("revision_ix2");
$self->{dbh}->do("
CREATE TABLE $tablename (
name TEXT NOT NULL,
revision INTEGER NOT NULL,
filehash TEXT NOT NULL,
commithash TEXT NOT NULL,
author TEXT NOT NULL,
modified TEXT NOT NULL,
mode TEXT NOT NULL
)
");
$self->{dbh}->do("
CREATE INDEX $ix1name
ON $tablename (name,revision)
");
$self->{dbh}->do("
CREATE INDEX $ix2name
ON $tablename (name,commithash)
");
}
unless ( $self->{tables}{$self->tablename("head")} )
{
my $tablename = $self->tablename("head");
my $ix1name = $self->tablename("head_ix1");
$self->{dbh}->do("
CREATE TABLE $tablename (
name TEXT NOT NULL,
revision INTEGER NOT NULL,
filehash TEXT NOT NULL,
commithash TEXT NOT NULL,
author TEXT NOT NULL,
modified TEXT NOT NULL,
mode TEXT NOT NULL
)
");
$self->{dbh}->do("
CREATE INDEX $ix1name
ON $tablename (name)
");
}
unless ( $self->{tables}{$self->tablename("properties")} )
{
my $tablename = $self->tablename("properties");
$self->{dbh}->do("
CREATE TABLE $tablename (
key TEXT NOT NULL PRIMARY KEY,
value TEXT
)
");
}
unless ( $self->{tables}{$self->tablename("commitmsgs")} )
{
my $tablename = $self->tablename("commitmsgs");
$self->{dbh}->do("
CREATE TABLE $tablename (
key TEXT NOT NULL PRIMARY KEY,
value TEXT
)
");
}
return $self;
}
=head2 tablename
=cut
sub tablename
{
my $self = shift;
my $name = shift;
if (exists $self->{valid_tables}{$name}) {
return $self->{dbtablenameprefix} . $name;
} else {
return undef;
}
}
=head2 update
Bring the database up to date with the latest changes from
the git repository.
Internal working state is read out of the "head" table and the
"last_commit" property, then it updates "revisions" based on that, and
finally it writes the new internal state back to the "head" table
so it can be used as a starting point the next time update is called.
=cut
sub update
{
my $self = shift;
$ENV{GIT_DIR} = $self->{git_path};
my $commitsha1 = `git rev-parse $self->{module}`;
chomp $commitsha1;
my $commitinfo = `git cat-file commit $self->{module} 2>&1`;
unless ( $commitinfo =~ /tree\s+[a-zA-Z0-9]{40}/ )
{
die("Invalid module '$self->{module}'");
}
my $git_log;
my $lastcommit = $self->_get_prop("last_commit");
if (defined $lastcommit && $lastcommit eq $commitsha1) { $self->clearCommitRefCaches();
return 1;
}
$self->{dbh}->begin_work() or die "Cannot lock database for BEGIN";
my @git_log_params = ('--pretty', '--parents', '--topo-order');
if (defined $lastcommit) {
push @git_log_params, "$lastcommit..$self->{module}";
} else {
push @git_log_params, $self->{module};
}
open(my $gitLogPipe, '-|', 'git', 'rev-list', @git_log_params)
or die "Cannot call git-rev-list: $!";
my @commits=readCommits($gitLogPipe);
close $gitLogPipe;
my $lastpicked;
my $head = {};
if (defined $lastcommit) {
$lastpicked = $lastcommit;
}
my $committotal = scalar(@commits);
my $commitcount = 0;
foreach my $file ( @{$self->gethead(1)} )
{
$head->{$file->{name}} = $file;
}
foreach my $commit ( @commits )
{
$self->{log}->debug("GITCVS::updater - Processing commit $commit->{hash} (" . (++$commitcount) . " of $committotal)");
if (defined $lastpicked)
{
if (!in_array($lastpicked, @{$commit->{parents}}))
{
next;
} elsif (@{$commit->{parents}} > 1) {
my @parents = @{$commit->{parents}};
foreach my $parent (@parents) {
if ($parent eq $lastpicked) {
next;
}
my $base = eval {
safe_pipe_capture('git', 'merge-base',
$lastpicked, $parent);
};
next if ($@);
chomp $base;
if ($base) {
my @merged;
open(GITLOG, '-|', 'git', 'log', '--pretty=medium', "$base..$parent")
or die "Cannot call git-log: $!";
my $mergedhash;
while (<GITLOG>) {
chomp;
if (!defined $mergedhash) {
if (m/^commit\s+(.+)$/) {
$mergedhash = $1;
} else {
next;
}
} else {
if (m/^\s+(\S.*)$/) {
my $title = $1;
$title = substr($title,0,100); unshift @merged, "$mergedhash $title";
undef $mergedhash;
}
}
}
close GITLOG;
if (@merged) {
$commit->{mergemsg} = $commit->{message};
$commit->{mergemsg} .= "\nSummary of merged commits:\n\n";
foreach my $summary (@merged) {
$commit->{mergemsg} .= "\t$summary\n";
}
$commit->{mergemsg} .= "\n\n";
}
}
}
}
}
my $cvsDate = convertToCvsDate($commit->{date});
if ( defined ( $lastpicked ) )
{
my $filepipe = open(FILELIST, '-|', 'git', 'diff-tree', '-z', '-r', $lastpicked, $commit->{hash}) or die("Cannot call git-diff-tree : $!");
local ($/) = "\0";
while ( <FILELIST> )
{
chomp;
unless ( /^:\d{6}\s+([0-7]{6})\s+[a-f0-9]{40}\s+([a-f0-9]{40})\s+(\w)$/o )
{
die("Couldn't process git-diff-tree line : $_");
}
my ($mode, $hash, $change) = ($1, $2, $3);
my $name = <FILELIST>;
chomp($name);
my $dbMode = convertToDbMode($mode);
if ( $change eq "D" )
{
$head->{$name} = {
name => $name,
revision => $head->{$name}{revision} + 1,
filehash => "deleted",
commithash => $commit->{hash},
modified => $cvsDate,
author => $commit->{author},
mode => $dbMode,
};
$self->insert_rev($name, $head->{$name}{revision}, $hash, $commit->{hash}, $cvsDate, $commit->{author}, $dbMode);
}
elsif ( $change eq "M" || $change eq "T" )
{
$head->{$name} = {
name => $name,
revision => $head->{$name}{revision} + 1,
filehash => $hash,
commithash => $commit->{hash},
modified => $cvsDate,
author => $commit->{author},
mode => $dbMode,
};
$self->insert_rev($name, $head->{$name}{revision}, $hash, $commit->{hash}, $cvsDate, $commit->{author}, $dbMode);
}
elsif ( $change eq "A" )
{
$head->{$name} = {
name => $name,
revision => $head->{$name}{revision} ? $head->{$name}{revision}+1 : 1,
filehash => $hash,
commithash => $commit->{hash},
modified => $cvsDate,
author => $commit->{author},
mode => $dbMode,
};
$self->insert_rev($name, $head->{$name}{revision}, $hash, $commit->{hash}, $cvsDate, $commit->{author}, $dbMode);
}
else
{
$log->warn("UNKNOWN FILE CHANGE mode=$mode, hash=$hash, change=$change, name=$name");
die;
}
}
close FILELIST;
} else {
my $seen_files = {};
my $filepipe = open(FILELIST, '-|', 'git', 'ls-tree', '-z', '-r', $commit->{hash}) or die("Cannot call git-ls-tree : $!");
local $/ = "\0";
while ( <FILELIST> )
{
chomp;
unless ( /^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o )
{
die("Couldn't process git-ls-tree line : $_");
}
my ( $mode, $git_type, $git_hash, $git_filename ) = ( $1, $2, $3, $4 );
$seen_files->{$git_filename} = 1;
my ( $oldhash, $oldrevision, $oldmode ) = (
$head->{$git_filename}{filehash},
$head->{$git_filename}{revision},
$head->{$git_filename}{mode}
);
my $dbMode = convertToDbMode($mode);
unless ( defined($oldhash) and $oldhash eq $git_hash and defined($oldmode) and $oldmode eq $dbMode )
{
my $newrevision = ( $oldrevision or 0 ) + 1;
$head->{$git_filename} = {
name => $git_filename,
revision => $newrevision,
filehash => $git_hash,
commithash => $commit->{hash},
modified => $cvsDate,
author => $commit->{author},
mode => $dbMode,
};
$self->insert_rev($git_filename, $newrevision, $git_hash, $commit->{hash}, $cvsDate, $commit->{author}, $dbMode);
}
}
close FILELIST;
foreach my $file ( sort keys %$head )
{
unless ( exists $seen_files->{$file} or $head->{$file}{filehash} eq "deleted" )
{
$head->{$file}{revision}++;
$head->{$file}{filehash} = "deleted";
$head->{$file}{commithash} = $commit->{hash};
$head->{$file}{modified} = $cvsDate;
$head->{$file}{author} = $commit->{author};
$self->insert_rev($file, $head->{$file}{revision}, $head->{$file}{filehash}, $commit->{hash}, $cvsDate, $commit->{author}, $head->{$file}{mode});
}
}
}
if (exists $commit->{mergemsg})
{
$self->insert_mergelog($commit->{hash}, $commit->{mergemsg});
}
$lastpicked = $commit->{hash};
$self->_set_prop("last_commit", $commit->{hash});
}
$self->delete_head();
foreach my $file ( sort keys %$head )
{
$self->insert_head(
$file,
$head->{$file}{revision},
$head->{$file}{filehash},
$head->{$file}{commithash},
$head->{$file}{modified},
$head->{$file}{author},
$head->{$file}{mode},
);
}
$self->clearCommitRefCaches();
$self->{dbh}->commit() or die "Failed to commit changes to SQLite";
}
sub readCommits
{
my $pipeHandle = shift;
my @commits;
my %commit = ();
while ( <$pipeHandle> )
{
chomp;
if (m/^commit\s+(.*)$/) {
if (keys %commit) {
my %copy = %commit;
unshift @commits, \%copy;
%commit = ();
}
my @parents = split(m/\s+/, $1);
$commit{hash} = shift @parents;
$commit{parents} = \@parents;
} elsif (m/^(\w+?):\s+(.*)$/ && !exists($commit{message})) {
$commit{lc($1)} = $2;
} else {
if (!exists($commit{message}) && m/^\s*$/) {
$commit{message} = '';
next;
}
s/^\s+//; s/\s+$//; # trim ws
$commit{message} .= $_ . "\n";
}
}
unshift @commits, \%commit if ( keys %commit );
return @commits;
}
sub convertToCvsDate
{
my $date = shift;
if( $date =~ /^\w+\s+(\w+)\s+(\d+)\s+(\d+:\d+:\d+)\s+(\d+)\s+([+-]\d+)$/ )
{
$date = "$2 $1 $4 $3 $5";
}
return $date;
}
sub convertToDbMode
{
my $mode = shift;
$mode=~/^\d{3}(\d)\d\d$/;
my $userBits=$1;
my $dbMode = "";
$dbMode .= "r" if ( $userBits & 4 );
$dbMode .= "w" if ( $userBits & 2 );
$dbMode .= "x" if ( $userBits & 1 );
$dbMode = "rw" if ( $dbMode eq "" );
return $dbMode;
}
sub insert_rev
{
my $self = shift;
my $name = shift;
my $revision = shift;
my $filehash = shift;
my $commithash = shift;
my $modified = shift;
my $author = shift;
my $mode = shift;
my $tablename = $self->tablename("revision");
my $insert_rev = $self->{dbh}->prepare_cached("INSERT INTO $tablename (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);
$insert_rev->execute($name, $revision, $filehash, $commithash, $modified, $author, $mode);
}
sub insert_mergelog
{
my $self = shift;
my $key = shift;
my $value = shift;
my $tablename = $self->tablename("commitmsgs");
my $insert_mergelog = $self->{dbh}->prepare_cached("INSERT INTO $tablename (key, value) VALUES (?,?)",{},1);
$insert_mergelog->execute($key, $value);
}
sub delete_head
{
my $self = shift;
my $tablename = $self->tablename("head");
my $delete_head = $self->{dbh}->prepare_cached("DELETE FROM $tablename",{},1);
$delete_head->execute();
}
sub insert_head
{
my $self = shift;
my $name = shift;
my $revision = shift;
my $filehash = shift;
my $commithash = shift;
my $modified = shift;
my $author = shift;
my $mode = shift;
my $tablename = $self->tablename("head");
my $insert_head = $self->{dbh}->prepare_cached("INSERT INTO $tablename (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);
$insert_head->execute($name, $revision, $filehash, $commithash, $modified, $author, $mode);
}
sub _get_prop
{
my $self = shift;
my $key = shift;
my $tablename = $self->tablename("properties");
my $db_query = $self->{dbh}->prepare_cached("SELECT value FROM $tablename WHERE key=?",{},1);
$db_query->execute($key);
my ( $value ) = $db_query->fetchrow_array;
return $value;
}
sub _set_prop
{
my $self = shift;
my $key = shift;
my $value = shift;
my $tablename = $self->tablename("properties");
my $db_query = $self->{dbh}->prepare_cached("UPDATE $tablename SET value=? WHERE key=?",{},1);
$db_query->execute($value, $key);
unless ( $db_query->rows )
{
$db_query = $self->{dbh}->prepare_cached("INSERT INTO $tablename (key, value) VALUES (?,?)",{},1);
$db_query->execute($key, $value);
}
return $value;
}
=head2 gethead
=cut
sub gethead
{
my $self = shift;
my $intRev = shift;
my $tablename = $self->tablename("head");
return $self->{gethead_cache} if ( defined ( $self->{gethead_cache} ) );
my $db_query = $self->{dbh}->prepare_cached("SELECT name, filehash, mode, revision, modified, commithash, author FROM $tablename ORDER BY name ASC",{},1);
$db_query->execute();
my $tree = [];
while ( my $file = $db_query->fetchrow_hashref )
{
if(!$intRev)
{
$file->{revision} = "1.$file->{revision}"
}
push @$tree, $file;
}
$self->{gethead_cache} = $tree;
return $tree;
}
=head2 getAnyHead
Returns a reference to an array of getmeta structures, one
per file in the specified tree hash.
=cut
sub getAnyHead
{
my ($self,$hash) = @_;
if(!defined($hash))
{
return $self->gethead();
}
my @files;
{
open(my $filePipe, '-|', 'git', 'ls-tree', '-z', '-r', $hash)
or die("Cannot call git-ls-tree : $!");
local $/ = "\0";
@files=<$filePipe>;
close $filePipe;
}
my $tree=[];
my($line);
foreach $line (@files)
{
$line=~s/\0$//;
unless ( $line=~/^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o )
{
die("Couldn't process git-ls-tree line : $_");
}
my($mode, $git_type, $git_hash, $git_filename) = ($1, $2, $3, $4);
push @$tree, $self->getMetaFromCommithash($git_filename,$hash);
}
return $tree;
}
=head2 getRevisionDirMap
A "revision dir map" contains all the plain-file filenames associated
with a particular revision (tree-ish), organized by directory:
$type = $out->{$dir}{$fullName}
The type of each is "F" (for ordinary file) or "D" (for directory,
for which the map $out->{$fullName} will also exist).
=cut
sub getRevisionDirMap
{
my ($self,$ver)=@_;
if(!defined($self->{revisionDirMapCache}))
{
$self->{revisionDirMapCache}={};
}
my $cacheKey;
my (@fileList);
if( !defined($ver) || $ver eq "" )
{
$cacheKey="";
if( defined($self->{revisionDirMapCache}{$cacheKey}) )
{
return $self->{revisionDirMapCache}{$cacheKey};
}
my @head = @{$self->gethead()};
foreach my $file ( @head )
{
next if ( $file->{filehash} eq "deleted" );
push @fileList,$file->{name};
}
}
else
{
my ($hash)=$self->lookupCommitRef($ver);
if( !defined($hash) )
{
return undef;
}
$cacheKey=$hash;
if( defined($self->{revisionDirMapCache}{$cacheKey}) )
{
return $self->{revisionDirMapCache}{$cacheKey};
}
open(my $filePipe, '-|', 'git', 'ls-tree', '-z', '-r', $hash)
or die("Cannot call git-ls-tree : $!");
local $/ = "\0";
while ( <$filePipe> )
{
chomp;
unless ( /^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o )
{
die("Couldn't process git-ls-tree line : $_");
}
my($mode, $git_type, $git_hash, $git_filename) = ($1, $2, $3, $4);
push @fileList, $git_filename;
}
close $filePipe;
}
my %revMap;
my $file;
foreach $file (@fileList)
{
my($dir) = ($file=~m%^(?:(.*)/)?([^/]*)$%);
$dir='' if(!defined($dir));
my($td)=$dir;
while(!defined($revMap{$td}))
{
$revMap{$td}={};
my($tp)=($td=~m%^(?:(.*)/)?([^/]*)$%);
$tp='' if(!defined($tp));
$td=$tp;
}
$td=$dir;
while($td ne "")
{
my($tp)=($td=~m%^(?:(.*)/)?([^/]*)$%);
$tp='' if(!defined($tp));
if(defined($revMap{$tp}{$td}))
{
if($revMap{$tp}{$td} ne 'D')
{
die "Weird file/directory inconsistency in $cacheKey";
}
last; }
$revMap{$tp}{$td}='D';
$td=$tp;
}
$revMap{$dir}{$file}='F';
}
$self->{revisionDirMapCache}{$cacheKey}=\%revMap;
return $self->{revisionDirMapCache}{$cacheKey};
}
=head2 getlog
See also gethistorydense().
=cut
sub getlog
{
my $self = shift;
my $filename = shift;
my $revFilter = shift;
my $tablename = $self->tablename("revision");
my ( $minrev, $maxrev );
if( defined($revFilter) and
$state->{opt}{r} =~ /^(1.(\d+))?(::?)(1.(\d.+))?$/ )
{
my $control = $3;
$minrev = $2;
$maxrev = $5;
$minrev++ if ( defined($minrev) and $control eq "::" );
}
my $db_query = $self->{dbh}->prepare_cached("SELECT name, filehash, author, mode, revision, modified, commithash FROM $tablename WHERE name=? ORDER BY revision DESC",{},1);
$db_query->execute($filename);
my $totalRevs=0;
my $tree = [];
while ( my $file = $db_query->fetchrow_hashref )
{
$totalRevs++;
if( defined($minrev) and $file->{revision} < $minrev )
{
next;
}
if( defined($maxrev) and $file->{revision} > $maxrev )
{
next;
}
$file->{revision} = "1." . $file->{revision};
push @$tree, $file;
}
return ($tree,$totalRevs);
}
=head2 getmeta
This function takes a filename (with path) argument and returns a hashref of
metadata for that file.
There are several ways $revision can be specified:
- A reference to hash that contains a "tag" that is the
actual revision (one of the below). TODO: Also allow it to
specify a "date" in the hash.
- undef, to refer to the latest version on the main branch.
- Full CVS client revision number (mapped to integer in DB, without the
"1." prefix),
- Complex CVS-compatible "special" revision number for
non-linear history (see comment below)
- git commit sha1 hash
- branch or tag name
=cut
sub getmeta
{
my $self = shift;
my $filename = shift;
my $revision = shift;
my $tablename_rev = $self->tablename("revision");
my $tablename_head = $self->tablename("head");
if ( ref($revision) eq "HASH" )
{
$revision = $revision->{tag};
}
my $meta;
if ( defined($revision) )
{
if ( $revision =~ /^1\.(\d+)$/ )
{
my ($intRev) = $1;
my $db_query;
$db_query = $self->{dbh}->prepare_cached(
"SELECT * FROM $tablename_rev WHERE name=? AND revision=?",
{},1);
$db_query->execute($filename, $intRev);
$meta = $db_query->fetchrow_hashref;
}
elsif ( $revision =~ /^2\.1\.1\.2000(\.[1-3][0-9][0-9]){20}$/ )
{
my ($commitHash)=($revision=~/^2\.1\.1\.2000(.*)$/);
$commitHash=~s/\.([0-9]+)/sprintf("%02x",$1-100)/eg;
if($commitHash=~/^[0-9a-f]{40}$/)
{
return $self->getMetaFromCommithash($filename,$commitHash);
}
print "E Failed to find $filename version=$revision or commit=$commitHash\n";
$log->warning("failed get $revision with commithash=$commitHash");
undef $revision;
}
elsif ( $revision =~ /^[0-9a-f]{40}$/ )
{
my $db_query;
$db_query = $self->{dbh}->prepare_cached(
"SELECT * FROM $tablename_rev WHERE name=? AND commithash=?",
{},1);
$db_query->execute($filename, $revision);
$meta = $db_query->fetchrow_hashref;
if(! $meta)
{
my($revCommit)=$self->lookupCommitRef($revision);
if($revCommit=~/^[0-9a-f]{40}$/)
{
return $self->getMetaFromCommithash($filename,$revCommit);
}
print "E Failed to find $filename version=$revision\n";
$log->warning("failed get $revision");
return $meta;
}
}
else
{
my($revCommit)=$self->lookupCommitRef($revision);
if($revCommit=~/^[0-9a-f]{40}$/)
{
return $self->getMetaFromCommithash($filename,$revCommit);
}
print "E Failed to find $filename version=$revision\n";
$log->warning("failed get $revision");
undef $revision; }
}
if(!defined($revision))
{
my $db_query;
$db_query = $self->{dbh}->prepare_cached(
"SELECT * FROM $tablename_head WHERE name=?",{},1);
$db_query->execute($filename);
$meta = $db_query->fetchrow_hashref;
}
if($meta)
{
$meta->{revision} = "1.$meta->{revision}";
}
return $meta;
}
sub getMetaFromCommithash
{
my $self = shift;
my $filename = shift;
my $revCommit = shift;
my($dirMap)=$self->getRevisionDirMap($revCommit);
my($dir,$file)=($filename=~m%^(?:(.*)/)?([^/]*$)%);
if(!defined($dir))
{
$dir="";
}
if( !defined($dirMap->{$dir}) ||
!defined($dirMap->{$dir}{$filename}) )
{
my($fileHash)="deleted";
my($retVal)={};
$retVal->{name}=$filename;
$retVal->{filehash}=$fileHash;
$retVal->{revision}="0"; $retVal->{commithash}=$revCommit;
return $retVal;
}
my($fileHash)=safe_pipe_capture("git","rev-parse","$revCommit:$filename");
chomp $fileHash;
if(!($fileHash=~/^[0-9a-f]{40}$/))
{
die "Invalid fileHash '$fileHash' looking up"
." '$revCommit:$filename'\n";
}
open(my $gitLogPipe, '-|', 'git', 'rev-list',
'--max-count=1', '--pretty', '--parents',
$revCommit, '--', $filename)
or die "Cannot call git-rev-list: $!";
my @commits=readCommits($gitLogPipe);
close $gitLogPipe;
if(scalar(@commits)!=1)
{
die "Can't find most recent commit changing $filename\n";
}
my($commit)=$commits[0];
if( !defined($commit) || !defined($commit->{hash}) )
{
return undef;
}
my $tablename_rev = $self->tablename("revision");
my $db_query;
$db_query = $self->{dbh}->prepare_cached(
"SELECT * FROM $tablename_rev WHERE name=? AND commithash=?",
{},1);
$db_query->execute($filename, $commit->{hash});
my($meta)=$db_query->fetchrow_hashref;
if($meta)
{
$meta->{revision} = "1.$meta->{revision}";
return $meta;
}
my($revision)=$commit->{hash};
$revision=~s/(..)/'.' . (hex($1)+100)/eg;
$revision="2.1.1.2000$revision";
open(my $filePipe, '-|', 'git', 'ls-tree', '-z',
$commit->{hash}, '--', $filename)
or die("Cannot call git-ls-tree : $!");
local $/ = "\0";
my $line;
$line=<$filePipe>;
if(defined(<$filePipe>))
{
die "Expected only a single file for git-ls-tree $filename\n";
}
close $filePipe;
chomp $line;
unless ( $line=~m/^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o )
{
die("Couldn't process git-ls-tree line : $line\n");
}
my ( $mode, $git_type, $git_hash, $git_filename ) = ( $1, $2, $3, $4 );
my($retVal)={};
$retVal->{name}=$filename;
$retVal->{revision}=$revision;
$retVal->{filehash}=$fileHash;
$retVal->{commithash}=$revCommit;
$retVal->{author}=$commit->{author};
$retVal->{modified}=convertToCvsDate($commit->{date});
$retVal->{mode}=convertToDbMode($mode);
return $retVal;
}
=head2 lookupCommitRef
Convert tag/branch/abbreviation/etc into a commit sha1 hash. Caches
the result so looking it up again is fast.
=cut
sub lookupCommitRef
{
my $self = shift;
my $ref = shift;
my $commitHash = $self->{commitRefCache}{$ref};
if(defined($commitHash))
{
return $commitHash;
}
$commitHash=safe_pipe_capture("git","rev-parse","--verify","--quiet",
$self->unescapeRefName($ref));
$commitHash=~s/\s*$//;
if(!($commitHash=~/^[0-9a-f]{40}$/))
{
$commitHash=undef;
}
if( defined($commitHash) )
{
my $type=safe_pipe_capture("git","cat-file","-t",$commitHash);
if( ! ($type=~/^commit\s*$/ ) )
{
$commitHash=undef;
}
}
if(defined($commitHash))
{
$self->{commitRefCache}{$ref}=$commitHash;
}
return $commitHash;
}
=head2 clearCommitRefCaches
Clears cached commit cache (sha1's for various tags/abbeviations/etc),
and related caches.
=cut
sub clearCommitRefCaches
{
my $self = shift;
$self->{commitRefCache} = {};
$self->{revisionDirMapCache} = undef;
$self->{gethead_cache} = undef;
}
=head2 commitmessage
this function takes a commithash and returns the commit message for that commit
=cut
sub commitmessage
{
my $self = shift;
my $commithash = shift;
my $tablename = $self->tablename("commitmsgs");
die("Need commithash") unless ( defined($commithash) and $commithash =~ /^[a-zA-Z0-9]{40}$/ );
my $db_query;
$db_query = $self->{dbh}->prepare_cached("SELECT value FROM $tablename WHERE key=?",{},1);
$db_query->execute($commithash);
my ( $message ) = $db_query->fetchrow_array;
if ( defined ( $message ) )
{
$message .= " " if ( $message =~ /\n$/ );
return $message;
}
my @lines = safe_pipe_capture("git", "cat-file", "commit", $commithash);
shift @lines while ( $lines[0] =~ /\S/ );
$message = join("",@lines);
$message .= " " if ( $message =~ /\n$/ );
return $message;
}
=head2 gethistorydense
This function takes a filename (with path) argument and returns an arrayofarrays
containing revision,filehash,commithash ordered by revision descending.
This version of gethistory skips deleted entries -- so it is useful for annotate.
The 'dense' part is a reference to a '--dense' option available for git-rev-list
and other git tools that depend on it.
See also getlog().
=cut
sub gethistorydense
{
my $self = shift;
my $filename = shift;
my $tablename = $self->tablename("revision");
my $db_query;
$db_query = $self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM $tablename WHERE name=? AND filehash!='deleted' ORDER BY revision DESC",{},1);
$db_query->execute($filename);
my $result = $db_query->fetchall_arrayref;
my $i;
for($i=0 ; $i<scalar(@$result) ; $i++)
{
$result->[$i][0]="1." . $result->[$i][0];
}
return $result;
}
=head2 escapeRefName
Apply an escape mechanism to compensate for characters that
git ref names can have that CVS tags can not.
=cut
sub escapeRefName
{
my($self,$refName)=@_;
if(! $refName=~/^[1-9][0-9]*(\.[1-9][0-9]*)*$/)
{
$refName=~s/_-/_-u--/g;
$refName=~s/\./_-p-/g;
$refName=~s%/%_-s-%g;
$refName=~s/[^-_a-zA-Z0-9]/sprintf("_-%02x-",$1)/eg;
}
}
=head2 unescapeRefName
Undo an escape mechanism to compensate for characters that
git ref names can have that CVS tags can not.
=cut
sub unescapeRefName
{
my($self,$refName)=@_;
$refName=~s/_-([spu]|[0-9a-f][0-9a-f])-/unescapeRefNameChar($1)/eg;
if( !( $refName=~m%^[^-][-a-zA-Z0-9_/.]*$% ) ||
( $refName=~m%[/.]$% ) ||
( $refName=~/\.lock$/ ) ||
( $refName=~m%\.\.|/\.|[[\\:?*~]|\@\{% ) ) {
$log->warn("illegal refName: $refName");
$refName=undef;
}
return $refName;
}
sub unescapeRefNameChar
{
my($char)=@_;
if($char eq "s")
{
$char="/";
}
elsif($char eq "p")
{
$char=".";
}
elsif($char eq "u")
{
$char="_";
}
elsif($char=~/^[0-9a-f][0-9a-f]$/)
{
$char=chr(hex($char));
}
else
{
$char="_-$char-";
}
return $char;
}
=head2 in_array()
from Array::PAT - mimics the in_array() function
found in PHP. Yuck but works for small arrays.
=cut
sub in_array
{
my ($check, @array) = @_;
my $retval = 0;
foreach my $test (@array){
if($check eq $test){
$retval = 1;
}
}
return $retval;
}
=head2 safe_pipe_capture
an alternative to `command` that allows input to be passed as an array
to work around shell problems with weird characters in arguments
=cut
sub safe_pipe_capture {
my @output;
if (my $pid = open my $child, '-|') {
@output = (<$child>);
close $child or die join(' ',@_).": $! $?";
} else {
exec(@_) or die "$! $?"; }
return wantarray ? @output : join('',@output);
}
=head2 mangle_dirname
create a string from a directory name that is suitable to use as
part of a filename, mainly by converting all chars except \w.- to _
=cut
sub mangle_dirname {
my $dirname = shift;
return unless defined $dirname;
$dirname =~ s/[^\w.-]/_/g;
return $dirname;
}
=head2 mangle_tablename
create a string from a that is suitable to use as part of an SQL table
name, mainly by converting all chars except \w to _
=cut
sub mangle_tablename {
my $tablename = shift;
return unless defined $tablename;
$tablename =~ s/[^\w_]/_/g;
return $tablename;
}
1;