--- shiela 2002/12/23 14:51:34 1.16
+++ shiela 2004/06/09 19:09:31 1.17
@@ -1,8 +1,8 @@
#!/v/ossp/sw/bin/perl -w
##
## OSSP shiela - CVS Access Control and Logging Facility
-## Copyright (c) 2000-2002 Ralf S. Engelschall <rse@engelschall.com>
-## Copyright (c) 2000-2002 The OSSP Project <http://www.ossp.org/>
+## Copyright (c) 2000-2004 Ralf S. Engelschall <rse@engelschall.com>
+## Copyright (c) 2000-2004 The OSSP Project <http://www.ossp.org/>
##
## This file is part of OSSP shiela, an access control and logging
## facility for Concurrent Versions System (CVS) repositories
@@ -26,7 +26,7 @@
## shiela.pl: control program (syntax: Perl)
##
-my $version = '1.0.4';
+my $version = '1.1.2';
require 5.005;
@@ -212,7 +212,7 @@
$RT->{cvsvers} = $1 if ($v =~ m|Concurrent\s+Versions\s+System\s+\(CVS\)\s+([\d.p]+)\s+|s);
$RT->{cvsrse} = 0;
$RT->{cvsrse} = 1 if ($v =~ m|\[RSE\]|s);
- die "$RT->{cvs} is not at least CVS 1.10" if ($RT->{cvsvers} !~ m|^1\.1[0-9]|);
+ die "$RT->{cvs} is not at least CVS 1.12" if ($RT->{cvsvers} !~ m|^1\.1[2-9]|);
$RT->{useserver} = 0;
$RT->{useserver} = 1 if ($v =~ m|server|s);
@@ -368,7 +368,7 @@
## Determine OSSP shiela configuration.
##
## We theoretically could directly operate on the syntax tree as
-## created by parse_config() above. But for convinience reasons and
+## created by parse_config() above. But for convenience reasons and
## to greatly simplify the processing, we use callback functions for
## parse_config() and build an own configuration structure.
## _________________________________________________________________
@@ -556,7 +556,7 @@
## required by most of the CVS client commands), e.g. when an import
## is done locally (no client/server). So we generally use the CVS
## client/server protocol to communicate with a spawned CVS server
-## process and act as we would be a regular CVS client. For convinience
+## process and act as we would be a regular CVS client. For convenience
## reasons, the communication is encapsulated in a "CVS" class object.
## _________________________________________________________________
##
@@ -580,7 +580,7 @@
STDERR->flush; # because of fork() behind open2()!
$cvs->{rfd} = new IO::Handle;
$cvs->{wfd} = new IO::Handle;
- $cvs->{pid} = IPC::Open2::open2($cvs->{rfd}, $cvs->{wfd}, "$program -Q -l -n server")
+ $cvs->{pid} = IPC::Open2::open2($cvs->{rfd}, $cvs->{wfd}, "$program -f -Q -n server")
|| die "cannot spawn CVS server process `$program server'";
print STDERR "cvs server: spawned (pid $cvs->{pid})\n" if ($trace);
bless ($cvs, $class);
@@ -641,7 +641,7 @@
sub recv {
my $cvs = shift;
if (wantarray) {
- my @lines = $cvs->{rfd}->getlines;
+ my @lines = ($cvs->{rfd}->getlines || ());
my @nlines = ();
foreach my $line (@lines) {
print STDERR "cvs server: <- $line" if ($cvs->{trace});
@@ -651,14 +651,14 @@
return @nlines;
}
else {
- my $line = $cvs->{rfd}->getline;
+ my $line = ($cvs->{rfd}->getline || "");
print STDERR "cvs server: <- $line" if ($cvs->{trace});
$line =~ s|\n$||;
return $line;
}
}
-# convinience wrapper: receive a response
+# convenience wrapper: receive a response
sub result {
my $cvs = shift;
my $line;
@@ -674,7 +674,7 @@
}
}
-# convinience wrapper: provide a file entry
+# convenience wrapper: provide a file entry
sub entry {
my $cvs = shift;
my @files = @_;
@@ -684,7 +684,7 @@
}
}
-# convinience wrapper: provide one or more global options
+# convenience wrapper: provide one or more global options
sub global_options {
my $cvs = shift;
my @opts = @_;
@@ -693,7 +693,7 @@
}
}
-# convinience wrapper: provide one or more arguments
+# convenience wrapper: provide one or more arguments
sub arguments {
my $cvs = shift;
my @args = @_;
@@ -702,7 +702,7 @@
}
}
-# convinience wrapper: configure a directory
+# convenience wrapper: configure a directory
sub directory {
my $cvs = shift;
my ($dir) = @_;
@@ -811,7 +811,7 @@
##
## Common file operations.
##
-## This is nothing more than a convinience function for
+## This is nothing more than a convenience function for
## the common file operations we have do.
## _________________________________________________________________
##
@@ -1248,14 +1248,14 @@
# annotate the files with the branch they stay on
my $cvsstat = '';
if (not $RT->{useserver}) {
- my $io = new IO::File "$RT->{cvs} -f -l -Q -n status ".join(' ', @cvsfiles)."|"
+ my $io = new IO::File "$RT->{cvs} -f -Q -n status ".join(' ', @cvsfiles)."|"
|| die "unable to open CVS command pipe for reading";
$cvsstat .= $_ while (<$io>);
$io->close;
}
else {
my $cvs = new CVS ($RT->{cvs}, $RT->{cvsroot});
- $cvs->global_options("-l", "-Q", "-n");
+ $cvs->global_options("-Q", "-n");
$cvs->directory($cvsdir);
foreach my $cvsfile (@cvsfiles) {
$cvs->entry($cvsfile);
@@ -1425,7 +1425,12 @@
my ($PA, $RT, $CF) = @_;
# take the arguments
- my ($cvsdir, @cvsinfo) = split(/\s+/, $PA->{ARG}->[0]);
+ my $cvsdir = $PA->{ARG}->[0];
+ my @cvsinfo = ();
+ my $k = ($RT->{cvsrse} ? 5 : 3);
+ for (my $i = 1; $i <= $#{$PA->{ARG}}; $i += $k) {
+ push(@cvsinfo, join(",", @{$PA->{ARG}}[$i..$i+$k-1]));
+ }
# suck in the standard log information which CVS provides
my $cvsmsg = '';
@@ -1435,7 +1440,7 @@
$RT->{cvsop} = 'commit-file';
# handle special invocation under `cvs add <dir>'
- if (join(' ', @cvsinfo) eq '- New directory') { # see CVS' src/add.c
+ if (defined($PA->{ARG}->[1]) and $PA->{ARG}->[1] eq '- New directory') { # see CVS' src/add.c
# Hmmm... we always just deal with files in OSSP shiela, so there
# is no obvious and consistent way to deal now with only a
# plain directory. And there is also no log message provided
@@ -1451,7 +1456,7 @@
# CVS only calls us inside the loginfo hook and never in the
# commitinfo hook before. Additionally CVS doesn't provide us with
# the %{sVvto} information :(
- if (join(' ', @cvsinfo) eq '- Imported sources') { # see CVS' src/import.c
+ if (defined($PA->{ARG}->[1]) and $PA->{ARG}->[1] eq '- Imported sources') { # see CVS' src/import.c
# I = ignored
# L = link (=error),
# N = new file
@@ -1488,7 +1493,7 @@
print STDERR "cvs import: Ignoring this operation - don't expect log messages!\n";
exit(0);
}
- my $io = new IO::File "$RT->{cvs} -f -l -Q -n log -r$It '$Is'|"
+ my $io = new IO::File "$RT->{cvs} -f -Q -n log -r$It '$Is'|"
|| die "unable to open CVS command pipe for reading";
$rcslog = $_ while (<$io>);
$io->close;
@@ -1610,7 +1615,7 @@
if ($Io eq 'R' and $Iv eq 'NONE') {
my $rcslog ='';
if (not $RT->{useserver}) {
- my $io = new IO::File "$RT->{cvs} -f -l -Q -n log '$Is'|"
+ my $io = new IO::File "$RT->{cvs} -f -Q -n log '$Is'|"
|| die "unable to open CVS command pipe for reading";
$rcslog .= $_ while (<$io>);
$io->close;
@@ -1633,7 +1638,7 @@
my $rcslog = '';
if ($Io eq 'A' or $Io eq 'M' or $Io eq 'R') {
if (not $RT->{useserver}) {
- my $io = new IO::File "$RT->{cvs} -f -l -Q -n log -r$Iv '$Is'|"
+ my $io = new IO::File "$RT->{cvs} -f -Q -n log -r$Iv '$Is'|"
|| die "unable to open CVS command pipe for reading";
$rcslog .= $_ while (<$io>);
$io->close;
@@ -1669,11 +1674,8 @@
}
else {
if ($Io eq 'A') {
- my $io = new IO::File "<$Is" || die "unable open $Is for reading";
- my $l = 0;
- $l++ while (<$io>);
- $io->close;
- $Id = sprintf("+%d/-%d", $l, 0);
+ # determined later below when we have to read in the
+ # whole content anyway in order to create the difference.
}
elsif ($Io eq 'M') {
if ($rcslog =~ m|\ndate:.*lines:\s*([\d \t+-]+)|s) {
@@ -1705,10 +1707,14 @@
unlink("$RT->{tmpfile}.all");
my $io = new IO::File ">$RT->{tmpfile}.all"
|| die "unable to open temporary file $RT->{tmpfile}.all for writing";
+ my $l = 0;
if (not $RT->{useserver}) {
- my $cvs = new IO::File "$RT->{cvs} -f -l -Q -n update -p -r$Iv '$Is'|"
+ my $cvs = new IO::File "$RT->{cvs} -f -Q -n update -p -r$Iv '$Is'|"
|| die "unable to open CVS command pipe for reading";
- $io->print($_) while (<$cvs>);
+ while (<$cvs>) {
+ $io->print($_);
+ $l++;
+ }
$cvs->close;
}
else {
@@ -1717,9 +1723,14 @@
$cvs->entry($Is);
$cvs->arguments("-p", "-r$Iv", $Is);
$cvs->send("update");
- $io->print(scalar $cvs->result);
+ my $r = scalar $cvs->result;
+ $io->print($r);
$cvs->close;
+ if ($r ne '') {
+ $l++ while ($r =~ m/^/mg);
+ }
}
+ $Id = sprintf("+%d/-%d", $l, 0) if (not ($Ik eq 'b' or -B $Is));
$io->close;
if ($Ik eq 'b' or -B $Is) {
@@ -1789,7 +1800,7 @@
my $io = new IO::File ">$RT->{tmpfile}.old"
|| die "unable to open temporary file $RT->{tmpfile}.old for writing";
if (not $RT->{useserver}) {
- my $cvs = new IO::File "$RT->{cvs} -f -l -Q -n update -p -r$IV '$Is'|"
+ my $cvs = new IO::File "$RT->{cvs} -f -Q -n update -p -r$IV '$Is'|"
|| die "unable to open CVS command pipe for reading";
$io->print($_) while (<$cvs>);
$cvs->close;
@@ -1810,7 +1821,7 @@
$io = new IO::File ">$RT->{tmpfile}.new"
|| die "unable to open temporary file $RT->{tmpfile}.new for writing";
if (not $RT->{useserver}) {
- my $cvs = new IO::File "$RT->{cvs} -f -l -Q -n update -p -r$Iv '$Is'|"
+ my $cvs = new IO::File "$RT->{cvs} -f -Q -n update -p -r$Iv '$Is'|"
|| die "unable to open CVS command pipe for reading";
$io->print($_) while (<$cvs>);
$cvs->close;
@@ -1856,7 +1867,7 @@
# generate textual change patch script
my $d = '';
if (not $RT->{useserver}) {
- my $io = new IO::File "$RT->{cvs} -f -l -Q -n diff -u -r$IV -r$Iv '$Is'|"
+ my $io = new IO::File "$RT->{cvs} -f -Q -n diff -u -r$IV -r$Iv '$Is'|"
|| die "unable to open CVS command pipe for reading";
$d .= $_ while (<$io>);
$io->close;
@@ -2245,6 +2256,7 @@
elsif ($content eq 'details') {
$O .= "\n";
if ($style =~ m|^url:(.+)|) {
+ $O .= "Change details:\n";
my $urlspec = $1;
foreach $file (sort(keys(%{$IN->{file}}))) {
next if ($IN->{file}->{$file}->{op} eq 'T');
@@ -2254,7 +2266,26 @@
elsif ($1 eq 'V') { $IN->{file}->{$file}->{oldrev}; }
elsif ($1 eq 'v') { $IN->{file}->{$file}->{newrev}; }
|gse;
- $O .= "$prefix$url\n";
+ $O .= " $prefix$url\n";
+ }
+ }
+ elsif ($style eq 'rdiff') {
+ $O .= "Change details:\n";
+ foreach $file (sort(keys(%{$IN->{file}}))) {
+ next if ($IN->{file}->{$file}->{op} eq 'T');
+ if ($IN->{file}->{$file}->{op} eq 'A') {
+ $O .= " \$ cvs rdiff -u" .
+ " -r0 -r" . $IN->{file}->{$file}->{newrev} .
+ " " . $file .
+ "\n";
+ }
+ else {
+ $O .= " \$ cvs rdiff -u" .
+ " -r" . $IN->{file}->{$file}->{oldrev} .
+ " -r" . $IN->{file}->{$file}->{newrev} .
+ " " . $file .
+ "\n";
+ }
}
}
elsif ($style eq 'patch:plain') {
|
