--- shiela 2001/12/16 13:08:11 1.10
+++ shiela 2002/12/22 19:25:51 1.11
@@ -1,15 +1,16 @@
#!/v/ossp/sw/bin/perl -w
##
-## Shiela - CVS Access Control and Logging Facility
-## Copyright (c) 2000 Ralf S. Engelschall <rse@engelschall.com>
+## 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/>
##
-## This file is part of Shiela, an access control and logging
+## This file is part of OSSP shiela, an access control and logging
## facility for Concurrent Versions System (CVS) repositories
-## which can be found at http://www.ossp.org/pkg/shiela/.
+## which can be found at http://www.ossp.org/pkg/tool/shiela/.
##
## This program is free software; you can redistribute it and/or
-## modify it under the terms of the GNU General Public License
-## as published by the Free Software Foundation; either version
+## modify it under the terms of the GNU General Public License
+## as published by the Free Software Foundation; either version
## 2.0 of the License, or (at your option) any later version.
##
## This program is distributed in the hope that it will be useful,
@@ -17,23 +18,25 @@
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
## General Public License for more details.
##
-## You should have received a copy of the GNU General Public License
+## You should have received a copy of the GNU General Public License
## along with this file; if not, write to the Free Software
## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
## USA, or contact Ralf S. Engelschall <rse@engelschall.com>.
##
-## shiela: Shiela control program (syntax: Perl)
+## shiela.pl: control program (syntax: Perl)
##
-my $version = '0.9.2';
+my $version = '1.0.0';
require 5.005;
use strict; # shipped with Perl since 5.000
use POSIX; # shipped with Perl since 5.000
+use IO::File; # shipped with Perl since 5.003
use IO::Handle; # shipped with Perl since 5.003
use IPC::Open2; # shipped with Perl since 5.003
use Data::Dumper; # shipped with Perl since 5.005
+use Cwd; # shipped with Perl since 5.005
# DEBUGGING
$Data::Dumper::Purity = 1;
@@ -102,7 +105,7 @@
## _________________________________________________________________
##
## Run-time information determination.
-##
+##
## This is a two-stage process, because we need parts of the
## information for parsing the configuration, but OTOH we need the
## configuration for determining other information. To simply solve
@@ -115,7 +118,7 @@
my ($program, $version) = @_;
my $RT = {};
- # program version and name
+ # program version and name
$RT->{vers} = $version;
$RT->{name} = ($program =~ m|^.*?([^/]+?)(?:\.[^/.]+)?$|)[0];
@@ -128,7 +131,7 @@
$RT->{userid} = $ENV{CVSUSER} || $ENV{LOGNAME} || $ENV{LOGUSER} || $ENV{USER} || die 'unknown CVS user';
# various directory paths
- $RT->{tmpdir} = $ENV{TMPDIR} || $ENV{TEMPDIR} || '/tmp';
+ $RT->{tmpdir} = $ENV{TMPDIR} || $ENV{TEMPDIR} || '/tmp';
$RT->{cvstmpdir} = (-w "$RT->{cvsroot}/CVSTMP" ? "$RT->{cvsroot}/CVSTMP" : $RT->{tmpdir});
$RT->{cvsadmdir} = "$RT->{cvsroot}/CVSROOT";
$RT->{cvslogdir} = (-w "$RT->{cvsroot}/CVSLOG" ? "$RT->{cvsroot}/CVSLOG" : $RT->{cvsadmdir});
@@ -146,7 +149,7 @@
# determine user information
$RT->{username} = $CF->{Project}->{User}->{$RT->{userid}}->{name} ||
- die "CVS user `$RT->{userid}' not found in Shiela configuration";
+ die "CVS user `$RT->{userid}' not found in OSSP shiela configuration";
$RT->{usermail} = $CF->{Project}->{User}->{$RT->{userid}}->{mail} ||
"$RT->{userid}\@localhost";
@@ -164,7 +167,7 @@
sub find_program {
my ($name) = @_;
my ($prog) = '';
- foreach my $dir (split(/:/, "/v/ossp/sw/bin:/v/ossp/sw/sbin:$ENV{PATH}:/usr/local/lib:/usr/lib:/lib")) {
+ foreach my $dir (split(/:/, "$ENV{PATH}:/usr/local/lib:/usr/lib:/lib")) {
if (-x "$dir/$name") {
$prog = "$dir/$name";
last;
@@ -172,11 +175,22 @@
}
return $prog;
}
- $RT->{sendmail} = &find_program("ssmtp") ||
- &find_program("sendmail") ||
+ $RT->{sendmail} = $CF->{Environment}->{Program}->{sendmail} ||
+ &find_program("ssmtp") ||
+ &find_program("sendmail") ||
die "unable to find `sendmail' program";
- $RT->{cvs} = &find_program("cvs") ||
+ $RT->{cvs} = $CF->{Environment}->{Program}->{cvs} ||
+ &find_program("cvs") ||
die "unable to find `cvs' program";
+ $RT->{diff} = $CF->{Environment}->{Program}->{diff} ||
+ &find_program("diff") ||
+ '';
+ $RT->{xdelta} = $CF->{Environment}->{Program}->{xdelta} ||
+ &find_program("xdelta") ||
+ '';
+ $RT->{uuencode} = $CF->{Environment}->{Program}->{uuencode} ||
+ &find_program("uuencode") ||
+ '';
# pre-calculate a reasonable MIME boundary tag
my $randtag;
@@ -191,8 +205,8 @@
my $v = `$RT->{cvs} --version 2>/dev/null`;
$RT->{cvsvers} = '?';
$RT->{cvsvers} = $1 if ($v =~ m|Concurrent\s+Versions\s+System\s+\(CVS\)\s+([\d.p]+)\s+|s);
- $RT->{cvsossp} = 0;
- $RT->{cvsossp} = 1 if ($v =~ m|OSSP|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]|);
$RT->{useserver} = 0;
$RT->{useserver} = 1 if ($v =~ m|server|s);
@@ -208,7 +222,7 @@
##
## C-style configuration syntax parsing.
##
-## <config> ::= <directive>
+## <config> ::= <directive>
## | <config> <directive>
## <directive> ::= <name> ';'
## | <name> <args> ';'
@@ -284,7 +298,7 @@
$t = $';
}
elsif ($t =~ m|^\s+|s) {
- push(@{$A}, $a) if ($a ne '');
+ push(@{$A}, $a) if ($a ne '');
$a = '';
$t = $';
}
@@ -346,7 +360,7 @@
## _________________________________________________________________
##
-## Determine Shiela configuration.
+## Determine OSSP shiela configuration.
##
## We theoretically could directly operate on the syntax tree as
## created by parse_config() above. But for convinience reasons and
@@ -359,10 +373,10 @@
my ($file) = @_;
# read configuration file
- open(CFG, "<$file") || die "unable to open configuration file `$file'";
+ my $io = new IO::File "<$file" || die "unable to open configuration file `$file'";
my $t = '';
- $t .= $_ while (<CFG>);
- close(CFG);
+ $t .= $_ while (<$io>);
+ $io->close;
# parse configuration syntax into nested internal structure and
# in parallel (through a callback function) create the final
@@ -377,6 +391,9 @@
},
'Logging' => {
'Report' => {}
+ },
+ 'Environment' => {
+ 'Program' => {}
}
};
my $cf = &parse_config($t, \&parse_config_callback, $CF);
@@ -385,7 +402,7 @@
if ($action eq 'CMD' and $cf->[0] =~ m/(Project|Repository|Logging)/) {
my $a;
foreach $a (@{$cf->[1]}) {
- $CF->{$1}->{$a->[0]} = $a->[1]
+ $CF->{$1}->{$a->[0]} = $a->[1]
if ($a->[0] ne 'Users' and
$a->[0] ne 'Groups' and
$a->[0] ne 'Modules' and
@@ -432,6 +449,9 @@
}
}
}
+ elsif ($action eq 'CMD' and $cf->[0] eq 'Program') {
+ $CF->{Environment}->{Program}->{$cf->[1]} = $cf->[2];
+ }
return $cf;
}
return $CF;
@@ -490,7 +510,7 @@
# prepare the pattern
if ($pat =~ m|^m(.)(.+)\1$| and $2 !~ m|$1|) {
# pattern is a regular expression,
- # so just make sure it is anchored
+ # so just make sure it is anchored
$pat =~ s|^([^\^])|^$1|;
$pat =~ s|([^\$])$|$1\$|;
}
@@ -519,7 +539,7 @@
## _________________________________________________________________
##
-## CVS server communication.
+## CVS server communication.
##
## We use this instead of calling the regular CVS client commands
## because we not always have a working directory available (which is
@@ -529,7 +549,7 @@
## process and act as we would be a regular CVS client. For convinience
## reasons, the communication is encapsulated in a "CVS" class object.
## _________________________________________________________________
-##
+##
package CVS;
@@ -541,7 +561,7 @@
my $cvsroot = shift || $ENV{CVSROOT} || die "unknown CVSROOT";
my $trace = shift || 0;
- # spawn a CVS server process and establish a
+ # spawn a CVS server process and establish a
# bidirectional communication path to it.
my $cvs = {};
$cvs->{cvsroot} = $cvsroot;
@@ -602,7 +622,7 @@
$data .= "\n" if ($data !~ m|\n$|s);
$cvs->{wfd}->print($data);
if ($cvs->{trace}) {
- $data =~ s|^|cvs server: -> |mg;
+ $data =~ s|^|cvs server: -> |mg;
print STDERR $data;
}
}
@@ -711,14 +731,13 @@
$sm->{fd} = new IO::Handle;
open($sm->{fd}, "|$RT->{sendmail} -oi -oem $toaddr");
print "sendmail: spawned \"$RT->{sendmail} -oi -oem $toaddr\"\n" if ($sm->{trace});
- $sm->{header} =
+ $sm->{header} =
"From: \"".$RT->{username}."\" <".$RT->{usermail}.">\n" .
"To: $toaddr\n" .
- "User-Agent: ".uc(substr($RT->{name}, 0, 1)).substr($RT->{name}, 1)."/$RT->{vers} " .
- ($RT->{cvsossp} ? "OSSP-CVS" : "CVS")."/$RT->{cvsvers}\n" .
+ "User-Agent: OSSP shiela ".$RT->{vers}." [CVS ".$RT->{cvsvers}.($RT->{cvsrse} ? "+RSE" : "")."]\n" .
"Precedence: bulk\n" .
"Mime-Version: 1.0\n" .
- "Content-Type: text/plain; charset=iso-8859-1\n" .
+ "Content-Type: text/plain; charset=iso-8859-1\n" .
"Content-Transfer-Encoding: 8bit\n";
$sm->{body} = '';
return $sm;
@@ -792,24 +811,24 @@
# append to or override a file with lines from an array
if ($op eq 'append' or $op eq 'write') {
- open(FP, ($op eq 'append' ? ">" : "").">$file") or
- die "unable to open `$file' for $op";
+ my $io = new IO::File ($op eq 'append' ? ">>$file" : ">$file")
+ || die "unable to open `$file' for operation `$op'";
foreach my $line (@lines) {
$line =~ s|\n+$||s;
- print FP $prefix . $line . "\n";
+ $io->print($prefix . $line . "\n");
}
- close(FP);
+ $io->close;
}
# read a file line by line into an array
elsif ($op eq 'read') {
my @text = ();
- open(FP, "<$file") or
- die "unable to open `$file' for $op";
- while (<FP>) {
+ my $io = new IO::File "<$file"
+ || die "unable to open `$file' for $op";
+ while (<$io>) {
s|\n$||s;
push(@text, $prefix . $_);
}
- close(FP);
+ $io->close;
return @text;
}
}
@@ -827,8 +846,7 @@
sub history_save {
my ($PA, $RT, $CF, $IN) = @_;
my $O = '';
- my $file;
- foreach $file (keys(%{$IN->{file}})) {
+ foreach my $file (keys(%{$IN->{file}})) {
my $e = $IN->{file}->{$file};
$O .= $IN->{handle};
$O .= ",$file";
@@ -841,10 +859,10 @@
$O .= ",".$e->{delta};
$O .= "\n";
}
- open(HDB, ">>".$RT->{historydb})
- || die "cannot store information to history db `$file'";
- print HDB $O;
- close(HDB);
+ my $io = new IO::File ">>".$RT->{historydb}
+ || die "cannot store information to history db `$RT->{historydb}'";
+ $io->print($O);
+ $io->close;
return;
}
@@ -873,7 +891,7 @@
my @groups = split(/,/, $RT->{usergroups});
my $file;
foreach $file (@files) {
- $file =~ m|^([^/]+)/(.*):([^:]+)$|
+ $file =~ m|^([^/]+)/(.*):([^:]+)$|
|| die "invalid file specification `$file' for access control";
my ($d, $f, $t) = ($1, $2, $3);
my $allow = 0;
@@ -905,7 +923,7 @@
}
if ( ( not $not
and ($u eq '*' or $u eq $user)
- and ($g eq '*' or grep(m/^$g$/, @groups)))
+ and ($g eq '*' or grep(m/^$g$/, @groups)))
or ( $not
and ($u ne '*' and $u ne $user)
and ($g ne '*' and not grep(m/^$g$/, @groups)))) {
@@ -961,6 +979,41 @@
## _________________________________________________________________
##
+## Wrap a single-line log message.
+##
+## This line-wraps a single-line log message into a multi-line log
+## message.
+## _________________________________________________________________
+##
+
+sub wrap_message {
+ my ($columns, $text) = @_;
+
+ my $r = "";
+ my $nl = "";
+ my $left = "";
+ pos($text) = 0;
+
+ while ($text !~ m/\G\s*\Z/gc) {
+ if ($text =~ /\G([^\n]{0,$columns})(\s|\z)/xmgc) {
+ $r .= $nl . $1;
+ $left = $2;
+ } elsif ($text =~ /\G([^\n]*?)(\s|\z)/xmgc) {
+ $r .= $nl . $1;
+ $left = $2;
+ }
+ $nl = "\n";
+ }
+
+ $r .= $left;
+ $r .= substr($text, pos($text), length($text)-pos($text))
+ if (pos($text) ne length($text));
+
+ return $r;
+}
+
+## _________________________________________________________________
+##
## TAGINFO HOOK
##
## We hook into CVS via `taginfo' to check whether user is allowed to
@@ -980,12 +1033,13 @@
# take the arguments
my ($tagname, $tagop, $cvsdir, %cvsfiles) = @{$PA->{ARG}};
+
+ # strip absolute prefix
$cvsdir =~ s|^$RT->{cvsroot}/?||;
- my $cvsdirphysical = `cd $RT->{cvsroot} && pwd`;
- $cvsdirphysical =~ s|\n$||s;
+ my $cvsdirphysical = Cwd::abs_path($RT->{cvsroot});
$cvsdir =~ s|^$cvsdirphysical/?||;
- # provide access control
+ # provide access control
my @paths = ();
foreach my $cvsfile (keys(%cvsfiles)) {
push(@paths, "$cvsdir/$cvsfile:*");
@@ -993,7 +1047,7 @@
my @denyfiles = &do_access_control($PA, $RT, $CF, @paths);
if ($#denyfiles > -1) {
# inform user
- print "cvs tag: Access Denied - Insufficient Karma!\n";
+ print "cvs tag: Access Denied - Insufficient Karma!\n";
print "cvs tag: Tagging access for the following file(s) was denied:\n";
foreach my $file (@denyfiles) {
print "cvs tag: `$file'\n";
@@ -1042,7 +1096,7 @@
my ($cvsdir, @cvsfiles) = @{$PA->{ARG}};
$cvsdir =~ s|^$RT->{cvsroot}/?||;
- # provide access control
+ # provide access control
my @paths = ();
foreach my $cvsfile (@cvsfiles) {
push(@paths, "$cvsdir/$cvsfile:*");
@@ -1050,7 +1104,7 @@
my @denyfiles = &do_access_control($PA, $RT, $CF, @paths);
if ($#denyfiles > -1) {
# inform user
- print "cvs admin: Access Denied - Insufficient Karma!\n";
+ print "cvs admin: Access Denied - Insufficient Karma!\n";
print "cvs admin: Admin access for the following file(s) was denied:\n";
foreach my $file (@denyfiles) {
print "cvs admin: `$file'\n";
@@ -1098,7 +1152,7 @@
my ($cvsbranch, $cvsdir, @cvsfiles) = @{$PA->{ARG}};
$cvsdir =~ s|^$RT->{cvsroot}/?||;
- # provide access control
+ # provide access control
my @paths = ();
foreach my $cvsfile (@cvsfiles) {
push(@paths, "$cvsdir/$cvsfile:$cvsbranch");
@@ -1106,7 +1160,7 @@
my @denyfiles = &do_access_control($PA, $RT, $CF, @paths);
if ($#denyfiles > -1) {
# inform user
- print "cvs import: Access Denied - Insufficient Karma!\n";
+ print "cvs import: Access Denied - Insufficient Karma!\n";
print "cvs import: Import access for the following files was denied:\n";
foreach my $file (@denyfiles) {
print "cvs import: `$file'\n";
@@ -1166,9 +1220,10 @@
# annotate the files with the branch they stay on
my $cvsstat = '';
if (not $RT->{useserver}) {
- open(CVSS, "$RT->{cvs} -f -l -Q -n status ".join(' ', @cvsfiles)."|");
- $cvsstat .= $_ while (<CVSS>);
- close(CVSS);
+ my $io = new IO::File "$RT->{cvs} -f -l -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});
@@ -1195,7 +1250,7 @@
}
@cvsfiles = @newfiles;
- # provide access control
+ # provide access control
my @paths = ();
foreach my $cvsfile (@cvsfiles) {
push(@paths, "$cvsdir/$cvsfile");
@@ -1203,7 +1258,7 @@
my @denyfiles = &do_access_control($PA, $RT, $CF, @paths);
if ($#denyfiles > -1) {
# inform user
- print "cvs commit: Access Denied - Insufficient Karma!\n";
+ print "cvs commit: Access Denied - Insufficient Karma!\n";
print "cvs commit: Commit access for the following file(s) was denied:\n";
foreach my $file (@denyfiles) {
print "cvs commit: `$file'\n";
@@ -1241,7 +1296,7 @@
## We hook into CVS via `commitinfo' to post-process log messages.
## The intention is to sanitise the results of what the user may have
## `done' while editing the commit log message. If CVS is a standard
-## version, this check is advisory only. If CVS contains the OSSP
+## version, this check is advisory only. If CVS contains the RSE
## patches, the log message is changed and CVS reads back the contents
## so that this script can actually make changes.
##
@@ -1254,27 +1309,29 @@
my ($PA, $RT, $CF) = @_;
my $rv = 0;
- # we require the OSSP patches for operation
- return $rv if (not $RT->{cvsossp});
+ # we require the RSE patches for operation
+ return $rv if (not $RT->{cvsrse});
# suck in the log message
my $logfile = $PA->{ARG}->[0];
- open(FP, "<$logfile") || die "cannot open message file `$logfile' for reading";
+ my $io = new IO::File "<$logfile"
+ || die "cannot open message file `$logfile' for reading";
my $data = '';
- $data .= $_ while (<FP>);
- close(FP);
+ $data .= $_ while (<$io>);
+ $io->close;
# filter the log message
$data = &compress_message($data);
# update the log message
- # (OSSP CVS reads in this again, stock CVS ignores it)
- open(FP, ">$logfile") || die "cannot open message file `$logfile' for writing";
- print FP $data;
- close(FP);
+ # (CVS with RSE patches reads in this again, stock CVS ignores it)
+ $io = new IO::File ">$logfile"
+ || die "cannot open message file `$logfile' for writing";
+ $io->print($data);
+ $io->close;
# nuke possibly existing editor backup files
- unlink("${logfile}~");
+ unlink("${logfile}~");
unlink("${logfile}.bak");
return $rv;
@@ -1307,7 +1364,7 @@
# determine whether we are the last call
my $islastcall = ($RT->{cvsop} eq 'import' ? 1 : 0);
if (-f "$RT->{tmpfile}.lastdir") {
- my ($lastdir) = &do_file('read', "$RT->{tmpfile}.lastdir", '');
+ my ($lastdir) = &do_file('read', "$RT->{tmpfile}.lastdir", '');
$islastcall = 1 if ($lastdir eq $cvsdir);
}
@@ -1341,7 +1398,7 @@
# collect the information
sub hook_loginfo_collect {
my ($PA, $RT, $CF) = @_;
-
+
# take the arguments
my ($cvsdir, @cvsinfo) = split(/\s+/, $PA->{ARG}->[0]);
@@ -1354,14 +1411,14 @@
# handle special invocation under `cvs add <dir>'
if (join(' ', @cvsinfo) eq '- New directory') { # see CVS' src/add.c
- # Hmmm... we always just deal with files in Shiela, so there
+ # 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
# by CVS. Additionally, creating empty directories in the CVS
# repository doesn't harm anyone. A regular cronjob is usually
# used to get rid of them anyway. So we decided to not log
# `cvs add <dir>' commands at all. We are early in processing
- # it is acceptable to just exit Shiela immediately.
+ # it is acceptable to just exit OSSP shiela immediately.
exit(0);
}
@@ -1375,7 +1432,7 @@
# N = new file
# U = updated w/o conflict
# C = updated w/ conflict
- # T = touched/tagged only (OSSP extension)
+ # T = touched/tagged only (RSE extension)
$RT->{cvsop} = 'import';
@cvsinfo = ();
$cvsmsg =~ s|Status:\n+Vendor Tag:\s+(\S+).*?\nRelease Tags:\s+(.+?)\s*\n(.+)$||s;
@@ -1400,15 +1457,16 @@
# provided a temporary working area on the server
# side for us. Now we can only hope the CVS version
# is at least capable of server communications...
- print STDERR "cvs import: Warning: Shiela cannot process local imports\n";
+ print STDERR "cvs import: Warning: OSSP shiela cannot process local imports\n";
print STDERR "cvs import: if the CVS version isn't at least capable of\n";
print STDERR "cvs import: server communications (which we're forced to use).\n";
print STDERR "cvs import: Ignoring this operation - don't expect log messages!\n";
exit(0);
}
- open(CVSS, "$RT->{cvs} -f -l -Q -n log -r$It '$Is'|");
- $rcslog = $_ while (<CVSS>);
- close(CVSS);
+ my $io = new IO::File "$RT->{cvs} -f -l -Q -n log -r$It '$Is'|"
+ || die "unable to open CVS command pipe for reading";
+ $rcslog = $_ while (<$io>);
+ $io->close;
}
else {
my $cvs = new CVS ($RT->{cvs}, $RT->{cvsroot});
@@ -1453,8 +1511,8 @@
&do_file('write', "$RT->{tmpfile}.log", '', $cvslog);
# if we are using a stock CVS version, we have to determine
- # extra information (which an OSSP CVS version would provide).
- if (not $RT->{cvsossp} and not $RT->{cvsop} eq 'import') {
+ # extra information (which an RSE CVS version would provide).
+ if (not $RT->{cvsrse} and not $RT->{cvsop} eq 'import') {
# parse CVS commit information
my $tag = 'HEAD';
@@ -1479,7 +1537,7 @@
if ($line =~ m/^Modified Files/) { $state = 'M'; next; }
if ($line =~ m/^Removed Files/) { $state = 'R'; next; }
if ($line =~ m/^Log Message/) { $state = '-'; next; }
-
+
if ($state =~ m/^[AMR]$/) {
my $file;
foreach $file (split(/\s+/, $line)) {
@@ -1492,7 +1550,7 @@
my @newinfo = ();
foreach my $info (@cvsinfo) {
$info =~ m|^([^,]+),([^,]+),([^,]+)|
- || die "invalid loginfo argument `$info'";
+ || die "invalid loginfo argument `$info' while extending stock CVS information";
my ($Is, $IV, $Iv) = ($1, $2, $3);
my $It = '';
@@ -1512,19 +1570,45 @@
my @newinfo = ();
foreach my $info (@cvsinfo) {
$info =~ m|^([^,]+),([^,]+),([^,]+),([^,]*),([^,]*)$|
- || die "invalid loginfo argument `$info'";
+ || die "invalid loginfo argument `$info' while extending summary information";
my ($Is, $IV, $Iv, $It, $Io) = ($1, $2, $3, $4, $5);
# fix branch/tag and accumulate information
$It = 'HEAD' if ($It eq '');
- # read file log entry
+ # manually determine next revision number for removed files
+ # by fetching the whole revision log and extracting the next
+ # number.
+ 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'|"
+ || die "unable to open CVS command pipe for reading";
+ $rcslog .= $_ while (<$io>);
+ $io->close;
+ }
+ else {
+ my $cvs = new CVS ($RT->{cvs}, $RT->{cvsroot});
+ $cvs->directory($cvsdir);
+ $cvs->entry($Is);
+ $cvs->arguments($Is);
+ $cvs->send("log");
+ $rcslog = scalar $cvs->result;
+ $cvs->close;
+ }
+ if ($rcslog =~ m|^head:\s+([\d.]+)|m) {
+ $Iv = $1;
+ }
+ }
+
+ # read file log entry
my $rcslog = '';
- if ($Io eq 'A' or $Io eq 'M') {
+ if ($Io eq 'A' or $Io eq 'M' or $Io eq 'R') {
if (not $RT->{useserver}) {
- open(CVSS, "$RT->{cvs} -f -l -Q -n log -r$Iv '$Is'|");
- $rcslog .= $_ while (<CVSS>);
- close(CVSS);
+ my $io = new IO::File "$RT->{cvs} -f -l -Q -n log -r$Iv '$Is'|"
+ || die "unable to open CVS command pipe for reading";
+ $rcslog .= $_ while (<$io>);
+ $io->close;
}
else {
my $cvs = new CVS ($RT->{cvs}, $RT->{cvsroot});
@@ -1552,15 +1636,15 @@
# determine change delta
my $Id = '+0/-0';
- if ($Ik eq 'b' or -B $Is) {
+ if ($Ik eq 'b' or -B $Is) {
$Id = 'BLOB';
}
else {
if ($Io eq 'A') {
- open(FP, "<$Is");
+ my $io = new IO::File "<$Is" || die "unable open $Is for reading";
my $l = 0;
- $l++ while (<FP>);
- close(FP);
+ $l++ while (<$io>);
+ $io->close;
$Id = sprintf("+%d/-%d", $l, 0);
}
elsif ($Io eq 'M') {
@@ -1583,100 +1667,168 @@
}
}
- # determine change diff
+ # determine change difference summary
if ($Io eq 'A') {
- # file was added, so we show the whole contents
- if ($Ik eq 'b' or -B $Is) {
- # file seems to be a binary file
- $cvsdiff .=
- "<Diff $cvsdir/$Is>\n" .
- "Index: $cvsdir/$Is\n" .
- "============================================================\n" .
- "\$ cvs update -p -r$Iv $Is | uuencode $Is\n";
- if (not $RT->{useserver}) {
- open(CVSS, "$RT->{cvs} -f -l -Q -n update -p -r$Iv '$Is' | uuencode '$Is' |");
- $cvsdiff .= $_ while (<CVSS>);
- close(CVSS);
- }
- else {
- my $cvs = new CVS ($RT->{cvs}, $RT->{cvsroot});
- $cvs->directory($cvsdir);
- $cvs->entry($Is);
- $cvs->arguments("-p", "-r$Iv", $Is);
- $cvs->send("update");
- $cvsdiff .= scalar $cvs->result;
- $cvs->close;
- }
- $cvsdiff .= "</Diff>\n";
+ ##
+ ## ADDED FILE
+ ##
+
+ # retrieve whole file contents
+ unlink("$RT->{tmpfile}.all");
+ my $io = new IO::File ">$RT->{tmpfile}.all"
+ || die "unable to open temporary file $RT->{tmpfile}.all for writing";
+ if (not $RT->{useserver}) {
+ my $cvs = new IO::File "$RT->{cvs} -f -l -Q -n update -p -r$Iv '$Is'|"
+ || die "unable to open CVS command pipe for reading";
+ $io->print($_) while (<$cvs>);
+ $cvs->close;
}
else {
- # file seems to be a regular text file
- $cvsdiff .=
- "<Diff $cvsdir/$Is>\n" .
- "Index: $cvsdir/$Is\n" .
- "============================================================\n" .
- "\$ cvs update -p -r$Iv $Is\n";
- if (not $RT->{useserver}) {
- open(CVSS, "$RT->{cvs} -f -l -Q -n update -p -r$Iv '$Is'|");
- $cvsdiff .= $_ while (<CVSS>);
- close(CVSS);
+ my $cvs = new CVS ($RT->{cvs}, $RT->{cvsroot});
+ $cvs->directory($cvsdir);
+ $cvs->entry($Is);
+ $cvs->arguments("-p", "-r$Iv", $Is);
+ $cvs->send("update");
+ $io->print(scalar $cvs->result);
+ $cvs->close;
+ }
+ $io->close;
+
+ if ($Ik eq 'b' or -B $Is) {
+ # generate binary change patch script
+ if ($RT->{xdelta} and $RT->{uuencode}) {
+ $cvsdiff .=
+ "<shiela:patch $cvsdir/$Is>\n" .
+ "(cd $cvsdir && uudecode <<'@@ .' && \\\n" .
+ " xdelta patch $Is.xdelta /dev/null $Is && \\\n" .
+ " rm -f $Is.xdelta)\n" .
+ "Index: $cvsdir/$Is\n" .
+ ("=" x 76) . "\n";
+ unlink("$RT->{tmpfile}.null");
+ unlink("$RT->{tmpfile}.xdelta");
+ my $io = new IO::File ">$RT->{tmpfile}.null"
+ || die "unable to open temporary file $RT->{tmpfile}.null for writing";
+ $io->close;
+ system("$RT->{xdelta} delta $RT->{tmpfile}.null " .
+ "$RT->{tmpfile}.all $RT->{tmpfile}.xdelta >/dev/null 2>&1");
+ $io = new IO::File "uuencode $RT->{tmpfile}.xdelta $Is.xdelta |"
+ || die "unable to open uuencode command pipe for reading";
+ $cvsdiff .= $_ while (<$io>);
+ $io->close;
+ $cvsdiff .= "@@ .\n";
+ $cvsdiff .= "</shiela:patch>\n";
+ unlink("$RT->{tmpfile}.null");
+ unlink("$RT->{tmpfile}.xdelta");
}
- else {
- my $cvs = new CVS ($RT->{cvs}, $RT->{cvsroot});
- $cvs->directory($cvsdir);
- $cvs->entry($Is);
- $cvs->arguments("-p", "-r$Iv", $Is);
- $cvs->send("update");
- $cvsdiff .= scalar $cvs->result;
- $cvs->close;
+ }
+ else {
+ # generate textual change patch script
+ if ($RT->{diff}) {
+ $cvsdiff .=
+ "<shiela:patch $cvsdir/$Is>\n" .
+ "patch -p0 <<'@@ .'\n" .
+ "Index: $cvsdir/$Is\n" .
+ ("=" x 76) . "\n" .
+ "\$ cvs diff -u -r0 -r$Iv $Is\n";
+ my $diff = '';
+ my $io = new IO::File "$RT->{diff} -u /dev/null $RT->{tmpfile}.all|"
+ || die "unable to open CVS command pipe for reading";
+ $diff .= $_ while (<$io>);
+ $io->close;
+ my $Is_quoted = quotemeta("$RT->{tmpfile}.all");
+ $diff =~ s|^(\+\+\+\s+)$Is_quoted|$1$Is|m;
+ $cvsdiff .= $diff;
+ $cvsdiff .= "@@ .\n";
+ $cvsdiff .= "</shiela:patch>\n";
}
- $cvsdiff .= "</Diff>\n";
}
+
+ # cleanup
+ unlink("$RT->{tmpfile}.all");
}
elsif ($Io eq 'M') {
- if ($Ik eq 'b' or -B $Is) {
- # file seems to be a binary file
- $cvsdiff .=
- "<Diff $cvsdir/$Is>\n" .
- "Index: $cvsdir/$Is\n" .
- "============================================================\n" .
- "\$ cvs update -p -r$IV $Is >$Is.old\n" .
- "\$ cvs update -p -r$Iv $Is >$Is.new\n" .
- "\$ diff -u $Is.old $Is.new\n";
- if (not $RT->{useserver}) {
- system("$RT->{cvs} -f -l -Q -n update -p -r$IV '$Is' | uuencode '$Is' >$Is.old");
- system("$RT->{cvs} -f -l -Q -n update -p -r$Iv '$Is' | uuencode '$Is' >$Is.new");
- }
- else {
- my $cvs = new CVS ($RT->{cvs}, $RT->{cvsroot});
- $cvs->directory($cvsdir);
- $cvs->entry($Is);
- $cvs->arguments("-p", "-r$IV", $Is);
- $cvs->send("update");
- my $data = scalar $cvs->result;
- open(FP, ">$Is.old") || die "cannot write to $Is.old";
- print FP $data;
- close(FP);
- $cvs->arguments("-p", "-r$Iv", $Is);
- $cvs->send("update");
- $data = scalar $cvs->result;
- open(FP, ">$Is.new") || die "cannot write to $Is.old";
- print FP $data;
- close(FP);
- $cvs->close;
+ ##
+ ## MODIFIED FILE
+ ##
+
+ if ($Ik eq 'b' or -B $Is) {
+ # generate binary change patch script
+
+ if ($RT->{xdelta} and $RT->{uuencode}) {
+ # retrieve whole file contents (old revision)
+ unlink("$RT->{tmpfile}.old");
+ 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'|"
+ || die "unable to open CVS command pipe for reading";
+ $io->print($_) while (<$cvs>);
+ $cvs->close;
+ }
+ else {
+ my $cvs = new CVS ($RT->{cvs}, $RT->{cvsroot});
+ $cvs->directory($cvsdir);
+ $cvs->entry($Is);
+ $cvs->arguments("-p", "-r$IV", $Is);
+ $cvs->send("update");
+ $io->print(scalar $cvs->result);
+ $cvs->close;
+ }
+ $io->close;
+
+ # retrieve whole file contents (new revision)
+ unlink("$RT->{tmpfile}.new");
+ $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'|"
+ || die "unable to open CVS command pipe for reading";
+ $io->print($_) while (<$cvs>);
+ $cvs->close;
+ }
+ else {
+ my $cvs = new CVS ($RT->{cvs}, $RT->{cvsroot});
+ $cvs->directory($cvsdir);
+ $cvs->entry($Is);
+ $cvs->arguments("-p", "-r$Iv", $Is);
+ $cvs->send("update");
+ $io->print(scalar $cvs->result);
+ $cvs->close;
+ }
+ $io->close;
+
+ # generate change patch script
+ $cvsdiff .=
+ "<shiela:patch $cvsdir/$Is>\n" .
+ "(cd $cvsdir && uudecode <<'@@ .' && \\\n" .
+ " mv $Is $Is.orig && xdelta patch $Is.xdelta $Is.orig $Is && \\\n" .
+ " rm -f $Is.orig $Is.xdelta)\n" .
+ "Index: $cvsdir/$Is\n" .
+ ("=" x 76) . "\n";
+ unlink("$RT->{tmpfile}.xdelta");
+ system("$RT->{xdelta} delta $RT->{tmpfile}.old " .
+ "$RT->{tmpfile}.new $RT->{tmpfile}.xdelta >/dev/null 2>&1");
+ $io = new IO::File "uuencode $RT->{tmpfile}.xdelta $Is.xdelta |"
+ || die "unable to open uuencode command pipe for reading";
+ $cvsdiff .= $_ while (<$io>);
+ $io->close;
+ $cvsdiff .= "@@ .\n";
+ $cvsdiff .= "</shiela:patch>\n";
+ unlink("$RT->{tmpfile}.xdelta");
+
+ # cleanup
+ unlink("$RT->{tmpfile}.old");
+ unlink("$RT->{tmpfile}.new");
}
- open(FP, "diff -u $Is.old $Is.new|");
- $cvsdiff .= $_ while (<FP>);
- close(FP);
- $cvsdiff .= "</Diff>\n";
}
else {
- # file was modified, so we show the changed contents only
+ # generate textual change patch script
my $d = '';
if (not $RT->{useserver}) {
- open(FP, "$RT->{cvs} -f -l -Q -n diff -u -r$IV -r$Iv '$Is'|");
- $d .= $_ while (<FP>);
- close(FP);
+ my $io = new IO::File "$RT->{cvs} -f -l -Q -n diff -u -r$IV -r$Iv '$Is'|"
+ || die "unable to open CVS command pipe for reading";
+ $d .= $_ while (<$io>);
+ $io->close;
}
else {
my $cvs = new CVS ($RT->{cvs}, $RT->{cvsroot});
@@ -1692,13 +1844,30 @@
$d =~ s|^(---\s+)${Is_quoted}(\s+)|$1$cvsdir/$Is$2|m;
$d =~ s|^(\+\+\+\s+)${Is_quoted}(\s+)|$1$cvsdir/$Is$2|m;
$cvsdiff .=
- "<Diff $cvsdir/$Is>\n" .
- "Index: $cvsdir/$Is\n" .
- "============================================================\n" .
- "\$ cvs diff -u -r$IV -r$Iv $Is\n" .
- $d .
- "</Diff>\n";
- }
+ "<shiela:patch $cvsdir/$Is>\n" .
+ "patch -p0 <<'@@ .'\n" .
+ "Index: $cvsdir/$Is\n" .
+ ("=" x 76) . "\n" .
+ "\$ cvs diff -u -r$IV -r$Iv $Is\n" .
+ $d .
+ "@@ .\n" .
+ "</shiela:patch>\n";
+ }
+ }
+ elsif ($Io eq 'R') {
+ ##
+ ## REMOVED FILE
+ ##
+
+ # generate binary and textaual change patch script
+ $cvsdiff .=
+ "<shiela:patch $cvsdir/$Is>\n" .
+ "rm -f $cvsdir/$Is <<'@@ .'\n" .
+ "Index: $cvsdir/$Is\n" .
+ ("=" x 76) . "\n" .
+ "[NO CHANGE SUMMARY BECAUSE FILE AS A WHOLE IS JUST REMOVED]\n" .
+ "@@ .\n" .
+ "</shiela:patch>\n";
}
$info = "$cvsdir/$Is,$IV,$Iv,$It,$Io,$Ik,$ID,$Id";
@@ -1752,7 +1921,7 @@
my $handle_max = undef;
foreach my $cvsinfo (@cvsinfo) {
$cvsinfo =~ m|^([^,]+),([^,]+),([^,]+),([^,]+),([^,]+),([^,]+),([^,]+),([^,]+)$|
- || die "invalid loginfo argument `$cvsinfo'";
+ || die "invalid loginfo argument `$cvsinfo' while accumulating information";
my ($Is, $IV, $Iv, $It, $Io, $Ik, $ID, $Id) = ($1, $2, $3, $4, $5, $6, $7, $8, $9);
my $e = {};
$e->{oldrev} = $IV;
@@ -1764,16 +1933,16 @@
$e->{delta} = $Id;
$e->{diff} = '';
my $Is_quoted = quotemeta($Is);
- $cvsdiff =~ s|\n<Diff\s+${Is_quoted}>\n(.+?\n)</Diff>|$e->{diff} = $1, ''|se;
+ $cvsdiff =~ s|\n<shiela:patch\s+${Is_quoted}>\n(.+?\n)</shiela:patch>|$e->{diff} = $1, ''|se;
$IN->{file}->{$Is} = $e;
- $handle_min = $ID if ($ID ne '' and (not defined($handle_min) or $handle_min > $ID));
- $handle_max = $ID if ($ID ne '' and (not defined($handle_max) or $handle_max < $ID));
+ $handle_min = $ID if ($ID ne '' and $ID ne '0' and (not defined($handle_min) or $handle_min > $ID));
+ $handle_max = $ID if ($ID ne '' and $ID ne '0' and (not defined($handle_max) or $handle_max < $ID));
}
$IN->{handle} = '-NONE-';
if (defined($handle_min) and defined($handle_max)) {
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($handle_min);
$IN->{handle} = sprintf("%04d%02d%02d%02d%02d%02d%02d",
- 1900+$year, $mon+1, $mday, $hour, $min, $sec,
+ 1900+$year, $mon+1, $mday, $hour, $min, $sec,
$handle_max - $handle_min);
}
return $IN;
@@ -1823,11 +1992,19 @@
my $subject = "[CVS]";
$subject .= " ".$CF->{Project}->{Tag}.":";
my $dirlast = '';
+ my $branchlast = '';
foreach my $path (sort(keys(%{$IN->{file}}))) {
my ($dir, $file) = ($path =~ m|^(.+)/([^/]+)$|);
+ my $branch = $IN->{file}->{$path}->{branch} || 'HEAD';
+ if ($branchlast ne $branch) {
+ # prefix with branch
+ $branchlast = $branch;
+ $subject .= " $branch:" if ($branch ne 'HEAD');
+ }
if ($dirlast ne $dir) {
+ # prefix with directory
$dirlast = $dir;
- $subject .= " $dir";
+ $subject .= " $dir/";
}
$subject .= " $file";
}
@@ -1835,9 +2012,11 @@
print "cvs commit: Mailing commit message to <$logurl>\n";
my $sm = new Sendmail ($RT, $logurl);
$sm->header('Subject', $subject);
- if ($CF->{Logging}->{Report}->{$logtype}->{Details} eq 'diff:mime') {
- $sm->header('Content-Type',
- "multipart/mixed; boundary=\"".$RT->{mimeboundary}."\"");
+ if (defined($CF->{Logging}->{Report}->{$logtype}->{Details})) {
+ if ($CF->{Logging}->{Report}->{$logtype}->{Details} eq 'patch:mime') {
+ $sm->header('Content-Type',
+ "multipart/mixed; boundary=\"".$RT->{mimeboundary}."\"");
+ }
}
$sm->body($logmsg);
$sm->close;
@@ -1847,9 +2026,9 @@
my $logmsg = &produce_log_message($PA, $RT, $CF, $IN, $logtype, @files);
$logurl = $RT->{cvsroot}."/".$logurl if ($logurl !~ m|^/|);
print "cvs commit: Writing commit message to $logurl\n";
- open(LOG, ">>$logurl") || die "cannot append log message to `$logurl'";
- print LOG $logmsg;
- close(LOG);
+ my $io = new IO::File ">>$logurl" || die "cannot append log message to `$logurl'";
+ $io->print($logmsg);
+ $io->close;
}
}
}
@@ -1859,10 +2038,10 @@
sub produce_log_message {
my ($PA, $RT, $CF, $IN, $type, @files) = @_;
- #
+ #
# Parse out more details.
#
- my $cvslist = {};
+ my $cvslist = {};
my %cvsmodules = ();
my %cvsbranches = ();
my $file;
@@ -1898,7 +2077,7 @@
my $RP = $CF->{Logging}->{Report}->{$type} || die "No report of type `$type' defined";
my $prefix = $RP->{Prefix} || '';
- my $style = $RP->{Details} || 'diff:plain';
+ my $style = $RP->{Details} || 'patch:plain';
my $O = '';
foreach my $content (@{$RP->{Content}}) {
@@ -1927,7 +2106,7 @@
$prefix . sprintf("%-40s %s\n", "Module: ".$IN->{cvsmodule}, "Date: ".$date) .
$prefix . sprintf("%-40s %s\n", "Branch: ".$IN->{cvsbranch}, "Handle: ".$IN->{handle});
}
-
+
# the file list
elsif ($content eq 'files') {
$O .= "\n";
@@ -1999,7 +2178,10 @@
$O .= "\n";
$O .= $prefix."Log:\n";
my $log = $IN->{log};
- $log =~ s|^|$prefix |mg;
+ if ($log !~ m|\n.+|s and length($log) > 70) {
+ $log = &wrap_message(70, $log);
+ }
+ $log =~ s|^|${prefix} |mg;
$O .= $log;
}
@@ -2010,13 +2192,13 @@
$O .= $prefix." Revision Changes Path\n";
foreach $file (sort(keys(%{$IN->{file}}))) {
my ($op, $rev, $delta) = ($IN->{file}->{$file}->{op},
- $IN->{file}->{$file}->{newrev},
+ $IN->{file}->{$file}->{newrev},
$IN->{file}->{$file}->{delta});
next if ($op eq 'T');
if ($delta =~ m|^(.+)/(.+)$|) {
$delta = sprintf("%-3s %-3s", $1, $2);
}
- $O .= $prefix.sprintf(" %-12s%-12s%s\n", $rev, $delta, $file);
+ $O .= $prefix . sprintf(" %-12s%-12s%s\n", $rev, $delta, $file);
}
}
@@ -2036,7 +2218,7 @@
$O .= "$prefix$url\n";
}
}
- elsif ($style eq 'diff:plain') {
+ elsif ($style eq 'patch:plain') {
foreach $file (sort(keys(%{$IN->{file}}))) {
next if ($IN->{file}->{$file}->{op} eq 'T');
my $diff = $IN->{file}->{$file}->{diff};
@@ -2044,7 +2226,7 @@
$O .= $diff;
}
}
- elsif ($style eq 'diff:mime') {
+ elsif ($style eq 'patch:mime') {
foreach $file (sort(keys(%{$IN->{file}}))) {
next if ($IN->{file}->{$file}->{op} eq 'T');
my $diff = $IN->{file}->{$file}->{diff};
@@ -2068,12 +2250,12 @@
$O =~ s|\n+$|\n|s;
# MIME post-processing
- if ($style eq 'diff:mime') {
+ if ($style eq 'patch:mime') {
$O = "This is a multi-part message in MIME format.\n" .
"--".$RT->{mimeboundary}."\n" .
"Content-Type: text/plain; charset=iso-8859-1\n" .
"Content-Transfer-Encoding: 8bit\n" .
- "Content-Description: commit summary\n" .
+ "Content-Description: change summary\n" .
"Content-Disposition: inline\n" .
"\n" .
$O .
@@ -2084,4 +2266,3 @@
return $O;
}
-##EOF##
|
