Index: ossp-pkg/shiela/Makefile.in RCS File: /v/ossp/cvs/ossp-pkg/shiela/Makefile.in,v rcsdiff -q -kk '-r1.9' '-r1.10' -u '/v/ossp/cvs/ossp-pkg/shiela/Makefile.in,v' 2>/dev/null --- Makefile.in 2005/01/12 20:46:12 1.9 +++ Makefile.in 2006/07/20 08:17:10 1.10 @@ -1,7 +1,7 @@ ## ## OSSP shiela - CVS Access Control and Logging Facility -## Copyright (c) 2000-2005 Ralf S. Engelschall -## Copyright (c) 2000-2005 The OSSP Project +## Copyright (c) 2000-2006 Ralf S. Engelschall +## Copyright (c) 2000-2006 The OSSP Project ## ## This file is part of OSSP shiela, an access control and logging ## facility for Concurrent Versions System (CVS) repositories @@ -41,6 +41,7 @@ libdir = @libdir@ includedir = @includedir@ mandir = @mandir@ +datarootdir = @datarootdir@ DESTDIR = Index: ossp-pkg/shiela/README RCS File: /v/ossp/cvs/ossp-pkg/shiela/README,v rcsdiff -q -kk '-r1.16' '-r1.17' -u '/v/ossp/cvs/ossp-pkg/shiela/README,v' 2>/dev/null --- README 2005/01/12 20:46:13 1.16 +++ README 2006/07/20 08:17:10 1.17 @@ -21,8 +21,8 @@ COPYRIGHT AND LICENSE - Copyright (c) 2000-2005 Ralf S. Engelschall - Copyright (c) 2000-2005 The OSSP Project + Copyright (c) 2000-2006 Ralf S. Engelschall + Copyright (c) 2000-2006 The OSSP Project This file is part of OSSP shiela, an access control and logging facility for Concurrent Versions System (CVS) repositories Index: ossp-pkg/shiela/VERSION RCS File: /v/ossp/cvs/ossp-pkg/shiela/VERSION,v rcsdiff -q -kk '-r1.18' '-r1.19' -u '/v/ossp/cvs/ossp-pkg/shiela/VERSION,v' 2>/dev/null --- VERSION 2005/10/03 12:43:44 1.18 +++ VERSION 2006/07/20 08:17:10 1.19 @@ -2,5 +2,5 @@ VERSION -- Version Information for OSSP shiela (syntax: Text) [automatically generated and maintained by GNU shtool] - This is OSSP shiela, Version 1.1.6 (03-Oct-2005) + This is OSSP shiela, Version 1.1.7 (20-Jul-2006) Index: ossp-pkg/shiela/configure.ac RCS File: /v/ossp/cvs/ossp-pkg/shiela/configure.ac,v rcsdiff -q -kk '-r1.4' '-r1.5' -u '/v/ossp/cvs/ossp-pkg/shiela/configure.ac,v' 2>/dev/null --- configure.ac 2005/01/12 20:46:13 1.4 +++ configure.ac 2006/07/20 08:17:10 1.5 @@ -1,7 +1,7 @@ ## ## OSSP shiela - CVS Access Control and Logging Facility -## Copyright (c) 2000-2005 Ralf S. Engelschall -## Copyright (c) 2000-2005 The OSSP Project +## Copyright (c) 2000-2006 Ralf S. Engelschall +## Copyright (c) 2000-2006 The OSSP Project ## ## This file is part of OSSP shiela, an access control and logging ## facility for Concurrent Versions System (CVS) repositories @@ -30,8 +30,8 @@ V=`./shtool version -ltxt -dlong VERSION` ./shtool echo -e "Configuring %BOSSP shiela%b, Version %B${V}%b" -echo "Copyright (c) 2000-2005 Ralf S. Engelschall " -echo "Copyright (c) 2000-2005 The OSSP Project " +echo "Copyright (c) 2000-2006 Ralf S. Engelschall " +echo "Copyright (c) 2000-2006 The OSSP Project " AC_MSG_CHECKING(for Perl program) AC_ARG_WITH(perl,dnl Index: ossp-pkg/shiela/devtool.conf RCS File: /v/ossp/cvs/ossp-pkg/shiela/devtool.conf,v rcsdiff -q -kk '-r1.13' '-r1.14' -u '/v/ossp/cvs/ossp-pkg/shiela/devtool.conf,v' 2>/dev/null --- devtool.conf 2005/10/03 12:43:44 1.13 +++ devtool.conf 2006/07/20 08:17:11 1.14 @@ -3,8 +3,8 @@ ## %autogen - @autogen shtool 2.0.3 "2.0.*" all - @autogen autoconf 2.59 "2.5[3-9]*" + @autogen shtool 2.0.6 "2.0.*" all + @autogen autoconf 2.60 "2.6*" %autoclean @autoclean shtool Index: ossp-pkg/shiela/shiela-install.pod RCS File: /v/ossp/cvs/ossp-pkg/shiela/shiela-install.pod,v rcsdiff -q -kk '-r1.26' '-r1.27' -u '/v/ossp/cvs/ossp-pkg/shiela/shiela-install.pod,v' 2>/dev/null --- shiela-install.pod 2005/01/12 20:46:13 1.26 +++ shiela-install.pod 2006/07/20 08:17:11 1.27 @@ -1,7 +1,7 @@ ## ## OSSP shiela - CVS Access Control and Logging Facility -## Copyright (c) 2000-2005 Ralf S. Engelschall -## Copyright (c) 2000-2005 The OSSP Project +## Copyright (c) 2000-2006 Ralf S. Engelschall +## Copyright (c) 2000-2006 The OSSP Project ## ## This file is part of OSSP shiela, an access control and logging ## facility for Concurrent Versions System (CVS) repositories Index: ossp-pkg/shiela/shiela-install.sh RCS File: /v/ossp/cvs/ossp-pkg/shiela/shiela-install.sh,v rcsdiff -q -kk '-r1.35' '-r1.36' -u '/v/ossp/cvs/ossp-pkg/shiela/shiela-install.sh,v' 2>/dev/null --- shiela-install.sh 2005/10/03 12:43:44 1.35 +++ shiela-install.sh 2006/07/20 08:17:11 1.36 @@ -1,8 +1,8 @@ #!@SH@ ## ## OSSP shiela - CVS Access Control and Logging Facility -## Copyright (c) 2000-2005 Ralf S. Engelschall -## Copyright (c) 2000-2005 The OSSP Project +## Copyright (c) 2000-2006 Ralf S. Engelschall +## Copyright (c) 2000-2006 The OSSP Project ## ## This file is part of OSSP shiela, an access control and logging ## facility for Concurrent Versions System (CVS) repositories @@ -26,7 +26,7 @@ ## shiela-install.sh: repository install program (syntax: Bourne-Shell) ## -version="1.1.6" +version="1.1.7" prefix="@prefix@" bindir="@bindir@" Index: ossp-pkg/shiela/shiela-test.sh RCS File: /v/ossp/cvs/ossp-pkg/shiela/shiela-test.sh,v rcsdiff -q -kk '-r1.4' '-r1.5' -u '/v/ossp/cvs/ossp-pkg/shiela/shiela-test.sh,v' 2>/dev/null --- shiela-test.sh 2005/01/12 20:46:13 1.4 +++ shiela-test.sh 2006/07/20 08:17:11 1.5 @@ -1,8 +1,8 @@ #!/bin/sh ## ## OSSP shiela - CVS Access Control and Logging Facility -## Copyright (c) 2000-2005 Ralf S. Engelschall -## Copyright (c) 2000-2005 The OSSP Project +## Copyright (c) 2000-2006 Ralf S. Engelschall +## Copyright (c) 2000-2006 The OSSP Project ## ## This file is part of OSSP shiela, an access control and logging ## facility for Concurrent Versions System (CVS) repositories Index: ossp-pkg/shiela/shiela.pl RCS File: /v/ossp/cvs/ossp-pkg/shiela/shiela.pl,v co -q -kk -p'1.71' '/v/ossp/cvs/ossp-pkg/shiela/shiela.pl,v' | diff -u /dev/null - -L'ossp-pkg/shiela/shiela.pl' 2>/dev/null --- ossp-pkg/shiela/shiela.pl +++ - 2024-05-09 18:45:24.733734236 +0200 @@ -0,0 +1,2338 @@ +#!@PERL@ -w +## +## OSSP shiela - CVS Access Control and Logging Facility +## Copyright (c) 2000-2006 Ralf S. Engelschall +## Copyright (c) 2000-2006 The OSSP Project +## +## 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/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 +## 2.0 of the License, or (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## 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 +## 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 . +## +## shiela.pl: control program (syntax: Perl) +## + +my $version = '1.1.7'; + +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 qw(abs_path); # shipped with Perl since 5.005 + +# DEBUGGING +$Data::Dumper::Purity = 1; +$Data::Dumper::Indent = 1; +$Data::Dumper::Terse = 1; +$Data::Dumper::Pad = "| "; + +## _________________________________________________________________ +## +## Main procedure. +## _________________________________________________________________ +## + +# Adjust program environment +$|++; +umask(002); +delete $ENV{TZ}; +$ENV{PATH} = "/bin:/usr/bin:/sbin:/usr/sbin"; + +# Generic program error handler +$SIG{__DIE__} = sub { + my ($text) = @_; + $text =~ s|\s+at\s+.*||s; + print STDERR "cvs:shiela::ERROR: ". $text . ($! ? " ($!)" : "") . "\n"; + exit(1); +}; + +# determine run-time and configuration information +my $PA = &pa_determine(@ARGV); +my $RT = &rt_determine_one($0, $version); +my $CF = &cf_determine(($PA->{OPT}->{config} || $RT->{cvsadmdir} . "/$RT->{name}.cfg")); +$RT = &rt_determine_two($RT, $CF); + +# DEBUGGING +if ($PA->{OPT}->{debug}) { + print STDOUT "| \$PA =\n" . Data::Dumper::Dumper($PA); + print STDOUT "| \$CF =\n" . Data::Dumper::Dumper($CF); + print STDOUT "| \$RT =\n" . Data::Dumper::Dumper($RT); +} + +# dispatch into the various commands +my $rv = 1; +if ($PA->{OPT}->{hook} eq 'taginfo') { + $rv = &hook_taginfo($PA, $RT, $CF); +} +elsif ($PA->{OPT}->{hook} eq 'admininfo') { + $rv = &hook_admininfo($PA, $RT, $CF); +} +elsif ($PA->{OPT}->{hook} eq 'importinfo') { + $rv = &hook_importinfo($PA, $RT, $CF); +} +elsif ($PA->{OPT}->{hook} eq 'commitinfo') { + $rv = &hook_commitinfo($PA, $RT, $CF); +} +elsif ($PA->{OPT}->{hook} eq 'verifymsg') { + $rv = &hook_verifymsg($PA, $RT, $CF); +} +elsif ($PA->{OPT}->{hook} eq 'loginfo') { + $rv = &hook_loginfo($PA, $RT, $CF); +} +else { + die "unknown processing stage (use --hook option)"; +} +exit($rv); + +## _________________________________________________________________ +## +## 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 +## this chicken and egg problem, we determine in two stages. +## _________________________________________________________________ +## + +# Determine run-time information (stage 1) +sub rt_determine_one { + my ($program, $version) = @_; + my $RT = {}; + + # program version and name + $RT->{vers} = $version; + $RT->{name} = ($program =~ m|^.*?([^/]+?)(?:\.[^/.]+)?$|)[0]; + + # program id and process group id + $RT->{pid} = $$; + $RT->{pgrp} = getpgrp(); + + # supplied arguments + $RT->{cvsroot} = $ENV{CVSROOT} or die 'unknown CVS root (set $CVSROOT variable)'; + $RT->{userid} = ($ENV{CVSUSER} || $ENV{LOGNAME} || $ENV{LOGUSER} || $ENV{USER}) or die 'unknown CVS user'; + + # various directory paths + $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}); + + # various file paths + $RT->{logfile} = "$RT->{cvslogdir}/$RT->{name}.log"; + $RT->{tmpfile} = "$RT->{cvstmpdir}/$RT->{name}.$RT->{pgrp}"; + + return $RT; +}; + +# Determine run-time information (stage 2) +sub rt_determine_two { + my ($RT, $CF) = @_; + + # determine user information + $RT->{username} = $CF->{Project}->{User}->{$RT->{userid}}->{name} || + die "CVS user `$RT->{userid}' not found in OSSP shiela configuration"; + $RT->{usermail} = $CF->{Project}->{User}->{$RT->{userid}}->{mail} || + "$RT->{userid}\@localhost"; + + # determine user's groups + my @G = (); + foreach my $group (keys(%{$CF->{Project}->{Group}})) { + my @U = @{$CF->{Project}->{Group}->{$group}->{users}}; + if (grep(m/^$RT->{userid}$/, @U)) { + push(@G, $group); + } + } + $RT->{usergroups} = join(',', @G); + + # optionally set environment variables (like PATH) + foreach my $var (keys(%{$CF->{Environment}->{Setenv}})) { + $ENV{PATH} = $CF->{Environment}->{Setenv}->{$var}; + } + + # determine various program paths + sub find_program { + my ($name) = @_; + my ($prog) = ''; + foreach my $dir (split(/:/, $ENV{PATH})) { + if (-x "$dir/$name") { + $prog = "$dir/$name"; + last; + } + } + return $prog; + } + $RT->{sendmail} = $CF->{Environment}->{Program}->{sendmail} || + &find_program("ssmtp") || + &find_program("sendmail") || + die "unable to find `sendmail' program"; + $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; + my @encode = (0..9, 'A'..'Z'); + srand(time ^ $$ or time ^ ($$ + ($$ << 15))); + for (my $i = 0; $i < 20; $i++) { + $randtag .= $encode[rand($#encode+1)]; + } + $RT->{mimeboundary} = $randtag; + + # determine CVS version and capabilities + 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->{cvsrse} = 0; + $RT->{cvsrse} = 1 if ($v =~ m|\[RSE\]|s); + 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); + + # determine path to history database + $RT->{historydb} = $CF->{Repository}->{History} || "$RT->{cvslogdir}/$RT->{name}.db"; + $RT->{historydb} = $RT->{cvsroot}."/".$RT->{historydb} if ($RT->{historydb} !~ m|^/|); + + return $RT; +} + +## _________________________________________________________________ +## +## C-style configuration syntax parsing. +## +## ::= +## | +## ::= ';' +## | ';' +## ::= +## | +## ::= '{' '}' +## | [^ \t\n]+ +## +## Note: For this task we usually would fire up the lovely +## Parse::RecDescent or some other nifty grammar-based module which +## supports parsing of nested constructs. But we want to operate in a +## stand-alone environment (or at least an environment where we only +## use Perl modules which are already shipped with the required Perl +## version), so we have to do the parsing manually. Fortunately, in +## our configuration syntax there is only one nesting: braced blocks. +## So we do the crual approach and write a poor-man's parser which is +## stand-alone and just slightly inefficient (only nested blocks are +## re-parsed) by taking advantage of the fact that our syntax has this +## very simple nesting only. +## _________________________________________________________________ +## + +# parse a text into a Perl structure and optionally use callbacks +sub parse_config { + my ($t, $cb, $cba) = @_; + + # pre-process syntax and strip comment and blank lines + $t =~ s|^\s*#.+?$||mg; + $t =~ s|^\s*$||mg; + my $C = &parse_config_block($t, $cb, $cba, 0); + + # parse a configuration block + sub parse_config_block { + my ($t, $cb, $cba, $l) = @_; + my $B = []; + my $A; + while ($t ne '') { + $t =~ s|^\s+||s && next; + ($A, $t) = &parse_config_directive($t, $cb, $cba, $l); + push(@{$B}, $A); + } + $B = $cb->($cba, 'B', $l, $B) if (defined($cb)); + return $B; + } + + # parse a single configuration directive + sub parse_config_directive { + my ($t, $cb, $cba, $l) = @_; + my $bcnt = 0; + my $qcnt = 0; + my $A = []; + my $a = ''; + while ($t ne '') { + # escaped meta character + if ($t =~ m|^\\([^{}";])|s) { + $a .= $1; + $t = $'; + } + # plain argument mode + elsif ($qcnt == 0 and $bcnt == 0) { + if ($t =~ m|^;|s) { + $t = $'; + last; + } + elsif ($t =~ m|^\{|s) { + push(@{$A}, $a) if ($a ne ''); + $a = ''; + $bcnt++; + $t = $'; + } + elsif ($t =~ m|^"|s) { + $qcnt++; + $t = $'; + } + elsif ($t =~ m|^\s+|s) { + push(@{$A}, $a) if ($a ne ''); + $a = ''; + $t = $'; + } + elsif ($t =~ m|^([^;\{"\s]+)|s) { + $a .= $1; + $t = $'; + } + } + # block mode + elsif ($qcnt == 0 and $bcnt > 0) { + if ($t =~ m|^\{|s) { + $bcnt++; + $a .= '{'; + $t = $'; + } + elsif ($t =~ m|^\}|s) { + $bcnt--; + $t = $'; + if ($bcnt == 0) { + if ($a ne '') { + # NESTING! + my $C = &parse_config_block($a, $cb, $cba, $l+1); + push(@{$A}, $C); + $a = ''; + } + } + else { + $a .= '}'; + } + } + elsif ($t =~ m|^([^\{\}]+)|s) { + $a .= $1; + $t = $'; + } + } + # quoting mode + elsif ($qcnt > 0 and $bcnt == 0) { + if ($t =~ m|^\\"|s) { + $a .= '"'; + $t = $'; + } + elsif ($t =~ m|^"|s) { + $qcnt--; + $t = $'; + } + elsif ($t =~ m|^([^"\\]+)|s) { + $a .= $1; + $t = $'; + } + } + } + push(@{$A}, $a) if ($a ne ''); + $A = $cb->($cba, 'CMD', $l, $A) if (defined($cb)); + return ($A, $t); + } + + return $C; +} + +## _________________________________________________________________ +## +## Determine OSSP shiela configuration. +## +## We theoretically could directly operate on the syntax tree as +## 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. +## _________________________________________________________________ +## + +sub cf_determine { + my ($file) = @_; + + # read configuration file + my $io = new IO::File "<$file" + or die "unable to open configuration file `$file'"; + my $t = ''; + $t .= $_ while (<$io>); + $io->close; + + # parse configuration syntax into nested internal structure and + # in parallel (through a callback function) create the final + # configuration structure. + my $CF = { + 'Project' => { + 'User' => {}, + 'Group' => {} + }, + 'Repository' => { + 'Module' => {} + }, + 'Logging' => { + 'Report' => {} + }, + 'Environment' => { + 'Program' => {}, + 'Setenv' => {} + } + }; + my $cf = &parse_config($t, \&parse_config_callback, $CF); + sub parse_config_callback { + my ($CF, $action, $level, $cf) = @_; + if ($action eq 'CMD' and $cf->[0] =~ m/(Project|Repository|Logging)/) { + my $a; + foreach $a (@{$cf->[1]}) { + $CF->{$1}->{$a->[0]} = $a->[1] + if ($a->[0] ne 'Users' and + $a->[0] ne 'Groups' and + $a->[0] ne 'Modules' and + $a->[0] ne 'Reports'); + } + } + elsif ($action eq 'CMD' and $cf->[0] eq 'User') { + $CF->{Project}->{User}->{$cf->[1]} = { + 'name' => $cf->[2], + 'mail' => $cf->[3] + }; + } + elsif ($action eq 'CMD' and $cf->[0] eq 'Group') { + $CF->{Project}->{Group}->{$cf->[1]} = { + 'name' => $cf->[2], + 'users' => $cf->[3]->[0] + }; + } + elsif ($action eq 'CMD' and $cf->[0] eq 'Module') { + $CF->{Repository}->{Module}->{$cf->[1]} = { + 'name' => $cf->[2], + 'acl' => [], + 'log' => [], + }; + my $n = \$CF->{Repository}->{Module}->{$cf->[1]}; + foreach $a (@{$cf->[3]}) { + if ($a->[0] eq 'Acl') { + push(@{${$n}->{acl}}, [ splice(@{$a}, 1) ]); + } + elsif ($a->[0] eq 'Log') { + push(@{${$n}->{log}}, [ splice(@{$a}, 1) ]); + } + } + } + elsif ($action eq 'CMD' and $cf->[0] eq 'Report') { + $CF->{Logging}->{Report}->{$cf->[1]} = {}; + my $n = \$CF->{Logging}->{Report}->{$cf->[1]}; + foreach $a (@{$cf->[2]}) { + if ($a->[0] eq 'Content') { + $$n->{Content} = [ splice(@{$a}, 1) ]; + } + elsif ($a->[0] =~ m/^(Prefix|Details)$/) { + $$n->{$1} = $a->[1]; + } + } + } + elsif ($action eq 'CMD' and $cf->[0] eq 'Program') { + $CF->{Environment}->{Program}->{$cf->[1]} = $cf->[2]; + } + elsif ($action eq 'CMD' and $cf->[0] eq 'Setenv') { + $CF->{Environment}->{Setenv}->{$cf->[1]} = $cf->[2]; + } + return $cf; + } + return $CF; +} + +## _________________________________________________________________ +## +## Determine program command line arguments. +## +## This is just a poor man's getopt() variant which provides just the +## functionality we really need. The benefit is that we don't require +## any extra modules. +## _________________________________________________________________ +## + +sub pa_determine { + my (@ARGV) = @_; + my $PA = {}; + + $PA->{OPT} = {}; + while ($#ARGV >= 0) { + if ($ARGV[0] =~ m|--([a-zA-Z0-9-]+)$|) { + $PA->{OPT}->{$1} = 1; + } + elsif ($ARGV[0] =~ m|--([a-zA-Z0-9-]+)=(.*)$|) { + $PA->{OPT}->{$1} = $2; + } + else { + last; + } + shift(@ARGV); + } + $PA->{ARG} = [ @ARGV ]; + + return $PA; +} + +## _________________________________________________________________ +## +## Generalized pattern matching. +## +## In our configuration file we need patterns. But because in 95% of +## all cases, simply shell-style patterns are sufficient (and where +## regular expressions would just complicate the configuration) we +## need some sort of shell-style wildcard matching. For this if the +## pattern still isn't a regular expression, we treat the pattern as +## a shell-style wildcard expression and convert it into a regular +## expression before matching. +## _________________________________________________________________ +## + +sub pattern_match { + my ($pat, $str) = @_; + my $rv; + + # prepare the pattern + if ($pat =~ m|^m(.)(.+)\1$| and $2 !~ m|$1|) { + # pattern is a regular expression, + # so just make sure it is anchored + $pat =~ s|^([^\^])|^$1|; + $pat =~ s|([^\$])$|$1\$|; + } + else { + # pattern is not a full regular expression, + # so treat it like a weaker shell pattern and + # convert it to the regular expression format. + my $braces = 0; + my $pat_orig = $pat; + $pat =~ s@(\\.|\*|.)@ + if ($1 eq '?') { '[^/]'; } + elsif ($1 eq '*') { '.*'; } + elsif ($1 eq '{') { $braces++; '(?:'; } + elsif ($1 eq '}') { die "Unmatched `}' in `$pat_orig'" unless $braces--; ')'; } + elsif ($braces > 0 && $1 eq ',') { '|'; } + elsif (index('()', $1) != -1) { $1; } + else { quotemeta(substr($1, -1)); } + @ges; + $pat = "^$pat\$"; + } + + # perform the matching operation + $rv = ($str =~ m|$pat|s); + return $rv; +} + +## _________________________________________________________________ +## +## 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 +## 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 convenience +## reasons, the communication is encapsulated in a "CVS" class object. +## _________________________________________________________________ +## + +package CVS; + +# communication constructor +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $program = (shift || "cvs"); + my $cvsroot = (shift || $ENV{CVSROOT}) or die "unknown CVSROOT"; + my $trace = shift || 0; + + # spawn a CVS server process and establish a + # bidirectional communication path to it. + my $cvs = {}; + $cvs->{cvsroot} = $cvsroot; + $cvs->{trace} = $trace; + STDOUT->flush; # because of fork() behind open2()! + 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 -f -Q -n server") + or die "cannot spawn CVS server process `$program server'"; + print STDERR "cvs server: spawned (pid $cvs->{pid})\n" if ($trace); + bless ($cvs, $class); + + # perform a little bit of common initial operation. + # lie a little bit about our capabilities, but if we list + # too less responses the CVS server will dislike our request + $cvs->send( + "Valid-responses ok error Valid-requests Checked-in New-entry Checksum " . + "Copy-file Updated Created Update-existing Merged Patched Rcs-diff Mode " . + "Mod-time Removed Remove-entry Set-static-directory Clear-static-directory " . + "Set-sticky Clear-sticky Template Set-checkin-prog Set-update-prog Notified " . + "Module-expansion Wrapper-rcsOption M Mbinary E F"); + $cvs->send("UseUnchanged"); + $cvs->send("Root $cvsroot"); + $cvs->send("noop"); + my $status = $cvs->recv; + die "unexpected initial CVS server response `$status'" if ($status ne 'ok'); + + return $cvs; +} + +# communication destructor +sub DESTROY { + my $cvs = shift; + $cvs->close; + undef $cvs; + return; +} + +# close communication paths +sub close { + my $cvs = shift; + if (defined($cvs->{rfd})) { + close($cvs->{rfd}); + close($cvs->{wfd}); + waitpid($cvs->{pid}, 0); + print STDERR "cvs server: closed (pid $cvs->{pid})\n" if ($cvs->{trace}); + $cvs->{rfd} = undef; + $cvs->{wfd} = undef; + $cvs->{pid} = undef; + } +} + +# send one or more commands to the server +sub send { + my $cvs = shift; + my $data = join("\n", @_); + $data .= "\n" if ($data !~ m|\n$|s); + $cvs->{wfd}->print($data); + if ($cvs->{trace}) { + $data =~ s|^|cvs server: -> |mg; + print STDERR $data; + } +} + +# recv one or more commands from the server +sub recv { + my $cvs = shift; + if (wantarray) { + my @lines = ($cvs->{rfd}->getlines || ()); + my @nlines = (); + foreach my $line (@lines) { + print STDERR "cvs server: <- $line" if ($cvs->{trace}); + $line =~ s|\n$||; + push(@nlines, $line); + } + return @nlines; + } + else { + my $line = ($cvs->{rfd}->getline || ""); + print STDERR "cvs server: <- $line" if ($cvs->{trace}); + $line =~ s|\n$||; + return $line; + } +} + +# convenience wrapper: receive a response +sub result { + my $cvs = shift; + my $line; + my $res = ''; + while (($line = $cvs->recv) =~ m/^(M|E) (.*)$/s) { + $res .= "$2\n" if ($1 eq 'M'); + } + if (wantarray) { + return ($res, $line); + } + else { + return $res; + } +} + +# convenience wrapper: provide a file entry +sub entry { + my $cvs = shift; + my @files = @_; + foreach my $file (@files) { + $cvs->send("Entry /$file////"); + $cvs->send("Unchanged $file"); + } +} + +# convenience wrapper: provide one or more global options +sub global_options { + my $cvs = shift; + my @opts = @_; + foreach my $opt (@opts) { + $cvs->send("Global_option $opt"); + } +} + +# convenience wrapper: provide one or more arguments +sub arguments { + my $cvs = shift; + my @args = @_; + foreach my $arg (@args) { + $cvs->send("Argument $arg"); + } +} + +# convenience wrapper: configure a directory +sub directory { + my $cvs = shift; + my ($dir) = @_; + $cvs->send("Directory .\n".$cvs->{cvsroot}."/".$dir); + $cvs->send("Static-directory"); +} + +package main; + +## _________________________________________________________________ +## +## Send out an Electronic Mail. +## +## Again, there are nice Perl modules which provide mail creation and +## delivery services, but we both want to be maximum stand-alone and +## use a KISS solution. So we assume an existing Sendmail program +## (which is 99% safe, because even non-Sendmail MTAs like Qmail and +## Postfix provide a Sendmail compatibility frontend!) and deliver the +## mail directly to it. +## _________________________________________________________________ +## + +package Sendmail; + +# communication constructor +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $RT = shift; + my $toaddr = shift; + my $trace = shift || 0; + + my $sm = {}; + bless ($sm, $class); + $sm->{trace} = $trace; + $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} = + "From: \"".$RT->{username}."\" <".$RT->{usermail}.">\n" . + "To: $toaddr\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-Transfer-Encoding: 8bit\n"; + $sm->{body} = ''; + return $sm; +} + +# communication destructor +sub DESTROY { + my $sm = shift; + $sm->close; + undef $sm; + return; +} + +# close communication +sub close { + my $sm = shift; + return if (not defined($sm->{body})); + $sm->{body} =~ s|\n$||s; + $sm->{body} .= "\n"; + if ($sm->{header} !~ m|^Lines: |m) { + my $length = length($sm->{body}); + my @lines = split(/\n/, $sm->{body}); + my $lines = $#lines+1; + $sm->{header} .= sprintf("Lines: %d\n", $lines); + } + my $mail = $sm->{header} . "\n" . $sm->{body}; + $sm->{fd}->print($mail); + if ($sm->{trace}) { + $mail =~ s|^|sendmail: -> |mg; + print STDERR $mail; + } + $sm->{fd}->close; + undef $sm->{body}; + print STDERR "sendmail: closed connection\n" if ($sm->{trace}); +} + +# set a particular mail header +sub header { + my $sm = shift; + my ($name, $value) = @_; + if ($sm->{header} =~ m|^$name: .*?$|m) { + $value =~ s|^\s+||s; + $value =~ s|\s+$||s; + $sm->{header} =~ s|^$name: .*?$|$name: $value|m; + } + else { + $sm->{header} .= "$name: $value\n"; + } +} + +# set the mail body +sub body { + my $sm = shift; + my ($body) = @_; + $sm->{body} .= $body; +} + +package main; + +## _________________________________________________________________ +## +## Common file operations. +## +## This is nothing more than a convenience function for +## the common file operations we have do. +## _________________________________________________________________ +## + +sub do_file { + my ($op, $file, $prefix, @lines) = @_; + + # append to or override a file with lines from an array + if ($op eq 'append' or $op eq 'write') { + my $io = new IO::File ($op eq 'append' ? ">>$file" : ">$file") + or die "unable to open `$file' for operation `$op'"; + foreach my $line (@lines) { + $line =~ s|\n+$||s; + $io->print($prefix . $line . "\n"); + } + $io->close; + } + # read a file line by line into an array + elsif ($op eq 'read') { + my @text = (); + my $io = new IO::File "<$file" + or die "unable to open `$file' for $op"; + while (<$io>) { + s|\n$||s; + push(@text, $prefix . $_); + } + $io->close; + return @text; + } +} + +## _________________________________________________________________ +## +## History database support. +## +## The history database is a logfile to where the commit history is +## written by us. In short, in summarizes a particular commit and this +## way can be used later to find out the details of a commit again. +## _________________________________________________________________ +## + +sub history_save { + my ($PA, $RT, $CF, $IN) = @_; + my $O = ''; + foreach my $file (keys(%{$IN->{file}})) { + my $e = $IN->{file}->{$file}; + $O .= $IN->{handle}; + $O .= "|".$RT->{userid}; + $O .= "|".$file; + $O .= "|".$e->{oldrev}; + $O .= "|".$e->{newrev}; + $O .= "|".$e->{branch}; + $O .= "|".$e->{op}; + $O .= "|".$e->{keysub}; + $O .= "|".$e->{date}; + $O .= "|".$e->{delta}; + $O .= "\n"; + } + my $io = new IO::File ">>".$RT->{historydb} + or die "cannot store information to history db `$RT->{historydb}'"; + $io->print($O); + $io->close; + return; +} + +sub history_load { + my ($PA, $RT, $CF, $handle) = @_; + ## STILL MISSING, BECAUSE CURRENTLY NOT USED AT ALL. ## + ## WOULD HAVE TO RE-DETERMINE DIFF AND LOG INFORMATION. ## + return; +} + +## _________________________________________________________________ +## +## Provide Access Control. +## +## This function is called from many hooks to check access control. +## Whether access is allowed or denied depends entirely on the +## particular ACL configuration found in the configuration file. +## _________________________________________________________________ +## + +sub do_access_control { + my ($PA, $RT, $CF, @files) = @_; + + my @denyfiles = (); + my $user = $RT->{userid}; + my @groups = split(/,/, $RT->{usergroups}); + my $file; + foreach $file (@files) { + $file =~ m|^([^/]+)/(.*):([^:]+)$| + or die "invalid file specification `$file' for access control"; + my ($d, $f, $t) = ($1, $2, $3); + my $allow = 0; + foreach my $module (keys(%{$CF->{Repository}->{Module}})) { + if ($module eq $d) { + my $m = $CF->{Repository}->{Module}->{$module}; + my $acl = $m->{acl}; + foreach my $a (@{$acl}) { + my ($file, @require) = @{$a}; + my $tag = 'HEAD'; + if ($file =~ m|^(.+):([^:]+)$|) { + $file = $1; + $tag = $2; + } + if (($t eq '*' or &pattern_match($tag, $t)) + and &pattern_match($file, $f)) { + foreach my $r (@require) { + my $not = 0; + if ($r =~ m|^!(.+)$|) { + $not = 1; + $r = $1; + } + my ($u, $g); + if ($r =~ m|^(.+):(.+)$|) { + ($u, $g) = ($1, $2); + } + else { + ($u, $g) = ($r, '*'); + } + if ( ( not $not + and ($u eq '*' or $u eq $user) + 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)))) { + $allow = 1; + last; + } + } + last; + } + } + last; + } + } + if (not $allow) { + push(@denyfiles, $file); + } + } + return @denyfiles; +} + +## _________________________________________________________________ +## +## Compress a log message. +## +## This compresses a CVS log message by removing unnecessary +## whitespace, empty fields and CVS lines. +## _________________________________________________________________ +## + +sub compress_message { + my ($msg) = @_; + + # make sure CVS: lines do not harm anyone + $msg =~ s/^CVS:.*?$//mg; + + # remove common empty fields (FIXME: PERHAPS TOO HARD-CODED) + $msg =~ s/^(PR|Submitted by|Reviewed by|Approved by|Obtained from):\s*$//img; + + # remove trailing whitespaces + $msg =~ s/[ \t]+$//mg; + + # make optically empty lines really empty for next step + $msg =~ s/^[ \t]+$//mg; + + # remove unnecessary empty lines + $msg =~ s/\n{3,}/\n\n/sg; + $msg =~ s/^\n+//s; + $msg =~ s/\n{2,}$/\n/s; + $msg =~ s/([^\n])$/$1\n/s; + + return $msg; +} + +## _________________________________________________________________ +## +## 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; +} + +## _________________________________________________________________ +## +## Fit text into particular columns. +## +## This makes sure a text fits into a particular columns by +## truncating (and extending with "$") if necessary. +## _________________________________________________________________ +## + +sub fit_columns { + my ($col, $txt) = @_; + if (length($txt) > $col) { + $txt = substr($txt, 0, $col-1) . '$'; + } + return $txt; +} + +## _________________________________________________________________ +## +## TAGINFO HOOK +## +## We hook into CVS via `taginfo' to check whether user is allowed to +## perform tag operation. Additionally we also could check whether the +## specified tag is a valid tag name. +## +## We are called by CVS with four or more arguments: the tagname, the +## operation (`add' for `cvs tag', `mov' for `cvs tag -F', and `del' +## for `cvs tag -d'), the repository path and one or more file and +## revisions pairs. +## _________________________________________________________________ +## + +sub hook_taginfo { + my ($PA, $RT, $CF) = @_; + my $rv = 0; + + # take the arguments + my ($tagname, $tagop, $cvsdir, %cvsfiles) = @{$PA->{ARG}}; + + # strip absolute prefix + $cvsdir =~ s|^$RT->{cvsroot}/?||; + my $cvsdirphysical = Cwd::abs_path($RT->{cvsroot}); + $cvsdir =~ s|^$cvsdirphysical/?||; + + # provide access control + my @paths = (); + foreach my $cvsfile (keys(%cvsfiles)) { + push(@paths, "$cvsdir/$cvsfile:*"); + } + 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: Tagging access for the following file(s) was denied:\n"; + foreach my $file (@denyfiles) { + print "cvs tag: `$file'\n"; + } + print "cvs tag: Contact <".$CF->{Repository}->{Contact}."> for details.\n"; + + # inform administrator + my $subject = "[CVS] ".$CF->{Project}->{Tag}.": ACCESS DENIED: ".$RT->{username}; + my $message = ''; + $message .= "ATTENTION: ACCESS DENIED\n"; + $message .= "\n"; + $message .= $CF->{Repository}->{Name}. " denied TAGGING access for\n"; + $message .= "user ".$RT->{username}." <".$RT->{usermail}."> on files:\n"; + $message .= "\n"; + foreach my $file (@denyfiles) { + $message .= " o $file\n"; + } + my $sm = new Sendmail ($RT, $CF->{Repository}->{Contact}); + $sm->header('Subject', $subject); + $sm->body($message); + $sm->close; + $rv = 1; + } + + return $rv; +} + +## _________________________________________________________________ +## +## ADMININFO HOOK +## +## We hook into CVS via `admininfo' to check whether user is allowed to +## perform admin operations. +## +## We are called by CVS with two or more arguments: the (absolute) +## repository directory, followed by one or more names of files in this +## directory on which the admin operation should be performed. +## _________________________________________________________________ +## + +sub hook_admininfo { + my ($PA, $RT, $CF) = @_; + my $rv = 0; + + # take the arguments + my ($cvsdir, @cvsfiles) = @{$PA->{ARG}}; + $cvsdir =~ s|^$RT->{cvsroot}/?||; + + # provide access control + my @paths = (); + foreach my $cvsfile (@cvsfiles) { + push(@paths, "$cvsdir/$cvsfile:*"); + } + 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: Admin access for the following file(s) was denied:\n"; + foreach my $file (@denyfiles) { + print "cvs admin: `$file'\n"; + } + print "cvs admin: Contact <".$CF->{Repository}->{Contact}."> for details.\n"; + + # inform administrator + my $subject = "[CVS] ".$CF->{Project}->{Tag}.": ACCESS DENIED: ".$RT->{username}; + my $message = ''; + $message .= "ATTENTION: ACCESS DENIED\n"; + $message .= "\n"; + $message .= $CF->{Repository}->{Name}. " denied ADMIN access for\n"; + $message .= "user ".$RT->{username}." <".$RT->{usermail}."> on files:\n"; + $message .= "\n"; + foreach my $file (@denyfiles) { + $message .= " o $file\n"; + } + my $sm = new Sendmail ($RT, $CF->{Repository}->{Contact}); + $sm->header('Subject', $subject); + $sm->body($message); + $sm->close; + $rv = 1; + } + + return $rv; +} + +## _________________________________________________________________ +## +## IMPORTINFO HOOK +## +## We hook into CVS via `importinfo' to check whether user is allowed to +## perform import operations. +## +## We are called by CVS with one argument: the (absolute) repository +## directory into which the import operation should be performed. +## _________________________________________________________________ +## + +sub hook_importinfo { + my ($PA, $RT, $CF) = @_; + my $rv = 0; + + # take the arguments + my ($cvsbranch, $cvsdir, @cvsfiles) = @{$PA->{ARG}}; + $cvsdir =~ s|^$RT->{cvsroot}/?||; + + # provide access control + my @paths = (); + foreach my $cvsfile (@cvsfiles) { + push(@paths, "$cvsdir/$cvsfile:$cvsbranch"); + } + 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: Import access for the following files was denied:\n"; + foreach my $file (@denyfiles) { + print "cvs import: `$file'\n"; + } + print "cvs import: Contact <".$CF->{Repository}->{Contact}."> for details.\n"; + + # inform administrator + my $subject = "[CVS] ".$CF->{Project}->{Tag}.": ACCESS DENIED: ".$RT->{username}; + my $message = ''; + $message .= "ATTENTION: ACCESS DENIED\n"; + $message .= "\n"; + $message .= $CF->{Repository}->{Name}. " denied IMPORT access for\n"; + $message .= "user ".$RT->{username}." <".$RT->{usermail}."> on files:\n"; + $message .= "\n"; + foreach my $file (@denyfiles) { + $message .= " o $file\n"; + } + my $sm = new Sendmail ($RT, $CF->{Repository}->{Contact}); + $sm->header('Subject', $subject); + $sm->body($message); + $sm->close; + $rv = 1; + } + + return $rv; +} + +## _________________________________________________________________ +## +## COMMITINFO HOOK +## +## We hook into CVS via `commitinfo' to provide repository access +## control ("is user allowed to commit") and to provide preparations +## for logging in multi-directory commits. The general problem we have +## is just that CVS does not provide a single hook where the complete +## commit message is available. Instead for a single multi-directory +## commit, we are called multiple times. So in the `loginfo' hook below +## we have to accumlate all information and do the actual logging at +## the last call only. For this we need to know which call is the last +## call. So we use this `commitinfo' hook to determine the last call by +## remembering the directory of the multi-directory commit. +## +## We are called by CVS with the absolute path (prefixed with $CVSROOT) +## to the CVS directory as the first argument, followed by one or more +## names of files which are comitted in this directory. +## _________________________________________________________________ +## + +sub hook_commitinfo { + my ($PA, $RT, $CF) = @_; + my $rv = 0; + + # take the arguments and make the directory relative + my ($cvsdir, @cvsfiles) = @{$PA->{ARG}}; + $cvsdir =~ s|^$RT->{cvsroot}/?||; + + # annotate the files with the branch they stay on + my $cvsstat = ''; + if (not $RT->{useserver}) { + my $io = new IO::File "$RT->{cvs} -f -Q -n status ".join(' ', @cvsfiles)."|" + or 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("-Q", "-n"); + $cvs->directory($cvsdir); + foreach my $cvsfile (@cvsfiles) { + $cvs->entry($cvsfile); + $cvs->arguments($cvsfile); + } + $cvs->send("status"); + $cvsstat .= scalar $cvs->result; + $cvs->close; + } + my @newfiles = (); + foreach my $cvsfile (@cvsfiles) { + my $branch = 'HEAD'; + my $cvsfile_quoted = quotemeta($cvsfile); + if ($cvsstat =~ m|===+\nFile:\s+${cvsfile_quoted}.+?Sticky Tag:\s+(\S+)|s) { + $branch = $1; + $branch = 'HEAD' if ($branch eq '(none)'); + } + $cvsfile .= ":$branch"; + push(@newfiles, $cvsfile); + } + @cvsfiles = @newfiles; + + # provide access control + my @paths = (); + foreach my $cvsfile (@cvsfiles) { + push(@paths, "$cvsdir/$cvsfile"); + } + 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: Commit access for the following file(s) was denied:\n"; + foreach my $file (@denyfiles) { + print "cvs commit: `$file'\n"; + } + print "cvs commit: Contact <".$CF->{Repository}->{Contact}."> for details.\n"; + + # inform administrator + my $subject = "[CVS] ".$CF->{Project}->{Tag}.": ACCESS DENIED: ".$RT->{username}; + my $message = ''; + $message .= "ATTENTION: ACCESS DENIED\n"; + $message .= "\n"; + $message .= $CF->{Repository}->{Name}. " denied COMMIT access for\n"; + $message .= "user ".$RT->{username}." <".$RT->{usermail}."> on files:\n"; + $message .= "\n"; + foreach my $file (@denyfiles) { + $message .= " o $file\n"; + } + my $sm = new Sendmail ($RT, $CF->{Repository}->{Contact}); + $sm->header('Subject', $subject); + $sm->body($message); + $sm->close; + $rv = 1; + } + + # remember the (last) directory + &do_file('write', $RT->{tmpfile}.".lastdir", '', $cvsdir); + + return $rv; +} + +## _________________________________________________________________ +## +## VERIFYMSG HOOK +## +## We hook into CVS via `verifymsg' 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 an anchient +## version, this check is advisory only. If CVS is at least version +## 1.11.2, the log message can be changed and CVS actually reads back +## the contents so that this script can actually make changes. +## +## We are called by CVS with a single argument: the path to the log +## message file. +## _________________________________________________________________ +## + +sub hook_verifymsg { + my ($PA, $RT, $CF) = @_; + my $rv = 0; + + # suck in the log message + my $logfile = $PA->{ARG}->[0]; + my $io = new IO::File "<$logfile" + or die "cannot open message file `$logfile' for reading"; + my $data = ''; + $data .= $_ while (<$io>); + $io->close; + + # filter the log message + $data = &compress_message($data); + + # update the log message + # (CVS with RSE patches reads in this again, stock CVS ignores it) + $io = new IO::File ">$logfile" + or die "cannot open message file `$logfile' for writing"; + $io->print($data); + $io->close; + + # nuke possibly existing editor backup files + unlink("${logfile}~"); + unlink("${logfile}.bak"); + + return $rv; +} + +## _________________________________________________________________ +## +## LOGINFO HOOK +## +## We hook into CVS via `loginfo' to provide accumulated commit mails +## and logfile entries. For this we depend on the `commitinfo' hook, +## which has to determine the last directory. Only this way we can +## decide when to accumulate and when to perform the logging. +## +## We are called by CVS with a single argument which contains the +## ($CVSROOT relative) directory followed by the summary arguments +## about the committed files in this directory - all seperated by +## whitespace. The summary arguments are comma-seperated strings +## of the form ,, +## _________________________________________________________________ +## + +sub hook_loginfo { + my ($PA, $RT, $CF) = @_; + my $rv = 0; + + # collect the information of this particular call + my $cvsdir = &hook_loginfo_collect($PA, $RT, $CF); + + # 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", ''); + $islastcall = 1 if ($lastdir eq $cvsdir); + } + + # stop processing if we are still not the last call + exit(0) if (not $islastcall); + + # cleanup + unlink("$RT->{tmpfile}.lastdir"); + + # accumulate the gathered information + my $IN = &hook_loginfo_accumulate($PA, $RT, $CF); + + # DEBUGGING + if ($PA->{OPT}->{debug}) { + print STDOUT "| \$PA =\n" . Data::Dumper::Dumper($PA); + print STDOUT "| \$CF =\n" . Data::Dumper::Dumper($CF); + print STDOUT "| \$RT =\n" . Data::Dumper::Dumper($RT); + print STDOUT "| \$IN =\n" . Data::Dumper::Dumper($IN); + } + + # remember the information (partly) in our history database + # for use by foreign application calls. + &history_save($PA, $RT, $CF, $IN); + + # process the collected information + &hook_loginfo_process($PA, $RT, $CF, $IN); + + return $rv; +} + +# collect the information +sub hook_loginfo_collect { + my ($PA, $RT, $CF) = @_; + + # take the arguments + 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 = ''; + $cvsmsg .= $_ while (); + + # usually the operation is a regular commit for files + $RT->{cvsop} = 'commit-file'; + + # handle special invocation under `cvs add ' + 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 + # 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 ' commands at all. We are early in processing + # it is acceptable to just exit OSSP shiela immediately. + exit(0); + } + + # handle special invocation under `cvs import '. Here + # 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 (defined($PA->{ARG}->[1]) and $PA->{ARG}->[1] eq '- Imported sources') { # see CVS' src/import.c + # I = ignored + # L = link (=error), + # N = new file + # U = updated w/o conflict + # C = updated w/ conflict + # T = touched/tagged only (RSE extension) + $RT->{cvsop} = 'import'; + @cvsinfo = (); + $cvsmsg =~ s|Status:\n+Vendor Tag:\s+(\S+).*?\nRelease Tags:\s+(.+?)\s*\n(.+)$||s; + my ($It, $IT, $list) = ($1, $2, $3); + $cvsmsg .= sprintf("[Release Tag%s: %s]\n", ($IT =~ m|\s| ? 's' : ''), $IT); + while ($list =~ s|\n([ILNUCT])\s+(\S+)||s) { + my ($Io, $Is) = ($1, $2); + + # canonicalize information + $Is =~ s|^$cvsdir/?||; + if ($Io eq 'I' or $Io eq 'L') { next; } + elsif ($Io eq 'N') { $Io = 'A'; } + elsif ($Io eq 'U' or $Io eq 'C') { $Io = 'M'; } + elsif ($Io eq 'T') { $Io = 'T'; } + + # determine revisions + my $rcslog = ''; + if (not $RT->{useserver}) { + if (not -d './CVS') { + # Oooopps, the user is doing a local import (no + # client server usage), or else CVS would have + # 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: 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); + } + my $io = new IO::File "$RT->{cvs} -f -Q -n log -r$It '$Is'|" + or die "unable to open CVS command pipe for reading"; + $rcslog = $_ while (<$io>); + $io->close; + } + else { + my $cvs = new CVS ($RT->{cvs}, $RT->{cvsroot}); + my ($subdir, $file) = ($cvsdir, $Is); + if ($file =~ m|^(.+)/([^/]+)$|) { + ($subdir, $file) = ($subdir."/".$1, $2); + } + $cvs->directory($subdir); + $cvs->entry($file); + $cvs->arguments("-r$It", $file); + $cvs->send("log"); + $rcslog = scalar $cvs->result; + $cvs->close; + } + my ($IV, $Iv) = ($It, $It); + if ($Io eq 'A') { + if ($rcslog =~ m|^.*?\nrevision\s+([0-9.]+)|s) { + ($IV, $Iv) = ('NONE', $1); + } + } + elsif ($Io eq 'M') { + if ($rcslog =~ m|^.*?\nrevision\s+([0-9.]+).*?\nrevision\s+([0-9.]+)|s) { + ($IV, $Iv) = ($2, $1); + } + } + elsif ($Io eq 'T') { + ($IV, $Iv) = ('NONE', 'NONE'); + } + my $entry = "$Is,$IV,$Iv,$It,$Io"; + push(@cvsinfo, $entry); + } + } + + # parse out log description from provided CVS log information and + # strip leading and trailing blank lines from the log message. + # Also compress multiple blank lines in the body of the message + # down to a single blank line. + my $cvslog = $cvsmsg; + $cvslog =~ s|.*Log Message:\s*\n(.+)$|$1|s; + $cvslog = &compress_message($cvslog); + $cvslog = "*** empty log message ***" if ($cvslog eq ''); + &do_file('write', "$RT->{tmpfile}.log", '', $cvslog); + + # if we are using a stock CVS version, we have to determine + # extra information (which an RSE CVS version would provide). + if ( ( ( defined($cvsinfo[0]) + and $cvsinfo[0] =~ m|^([^,]+),([^,]+),([^,]+)$|) + or not $RT->{cvsrse} ) + and not $RT->{cvsop} eq 'import' ) { + + # parse CVS commit information + my $tag = 'HEAD'; + my $line; + my $state = '-'; + my $files = {}; + foreach $line (split(/\n/, $cvsmsg)) { + $line =~ s/[ \t\n]+$//; + if ($line =~ /^Revision\/Branch:\s*(.+)$/) { + $tag = $1; + next; + } + if ($line =~ m/^[ \t]+Tag:\s*(.+)$/) { + $tag = $1; + next; + } + if ($line =~ m/^[ \t]+No tag$/) { + $tag = 'HEAD'; + next; + } + if ($line =~ m/^Added Files/) { $state = 'A'; next; } + 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)) { + $files->{$file} = "$tag,$state"; + } + } + } + + # extend the CVS summary of each file + my @newinfo = (); + foreach my $info (@cvsinfo) { + $info =~ m|^([^,]+),([^,]+),([^,]+)| + or die "invalid loginfo argument `$info' while extending stock CVS information"; + my ($Is, $IV, $Iv) = ($1, $2, $3); + + my $It = ''; + my $Io = ''; + if ($files->{$Is} =~ m|^([^,]*),([^,]*)$|) { + ($It, $Io) = ($1, $2); + } + + $info = "$Is,$IV,$Iv,$It,$Io"; + push(@newinfo, $info); + } + @cvsinfo = @newinfo; + } + + # extend summary information + my $cvsdiff = ''; + my @newinfo = (); + foreach my $info (@cvsinfo) { + $info =~ m|^([^,]+),([^,]+),([^,]+),([^,]*),([^,]*)$| + or 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 ''); + + # 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 -Q -n log '$Is'|" + or 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' or $Io eq 'R') { + if (not $RT->{useserver}) { + my $io = new IO::File "$RT->{cvs} -f -Q -n log -r$Iv '$Is'|" + or 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("-r$Iv", $Is); + $cvs->send("log"); + $rcslog = scalar $cvs->result; + $cvs->close; + } + } + + # determine keyword substitutions + my $Ik = 'kv'; + if ($rcslog =~ m|keyword\s+substitution:\s+(\S+)|s) { + $Ik = $1; + } + + # determine commit date + my $ID = 0; + if ($rcslog =~ m|\ndate:\s+(\d\d\d\d)[/-](\d\d)[/-](\d\d)\s+(\d\d):(\d\d):(\d\d)(?:\s+[+-]?\d+)?;|s) { + my ($Y,$M,$D,$h,$m,$s) = ($1,$2,$3,$4,$5,$6); + $ID = POSIX::mktime($s, $m, $h, $D, $M-1, $Y-1900); + } + + # determine change delta + my $Id = '+0/-0'; + if ($Ik eq 'b' or -B $Is) { + $Id = 'BLOB'; + } + else { + if ($Io eq 'A') { + # 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) { + $Id = $1; + $Id =~ s|\s+|/|g; + } + } + elsif ($Io eq 'R') { + my $cvs = new CVS ($RT->{cvs}, $RT->{cvsroot}); + $cvs->directory($cvsdir); + $cvs->entry($Is); + $cvs->arguments("-p", "-r$IV", $Is); + $cvs->send("update"); + my $f = scalar $cvs->result; + $cvs->close; + my $l = 0; + $f =~ s|\n|$l++|sge; + $Id = sprintf("+%d/-%d", 0, $l); + } + } + + # determine change difference summary + if ($Io eq 'A') { + ## + ## ADDED FILE + ## + + # retrieve whole file contents + unlink("$RT->{tmpfile}.all"); + my $io = new IO::File ">$RT->{tmpfile}.all" + or 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 -Q -n update -p -r$Iv '$Is'|" + or die "unable to open CVS command pipe for reading"; + while (<$cvs>) { + $io->print($_); + $l++; + } + $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"); + 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) { + # generate binary change patch script + if ($RT->{xdelta} and $RT->{uuencode}) { + $cvsdiff .= + "\n" . + "(cd $cvsdir && \\\n" . + " 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" + or 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 "$RT->{uuencode} $RT->{tmpfile}.xdelta $Is.xdelta |" + or die "unable to open uuencode command pipe for reading"; + $cvsdiff .= $_ while (<$io>); + $io->close; + $cvsdiff .= "@@ .\n"; + $cvsdiff .= "\n"; + unlink("$RT->{tmpfile}.null"); + unlink("$RT->{tmpfile}.xdelta"); + } + } + else { + # generate textual change patch script + if ($RT->{diff}) { + $cvsdiff .= + "\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|" + or 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 .= "\n"; + } + } + + # cleanup + unlink("$RT->{tmpfile}.all"); + } + elsif ($Io eq 'M') { + ## + ## 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" + or die "unable to open temporary file $RT->{tmpfile}.old for writing"; + if (not $RT->{useserver}) { + my $cvs = new IO::File "$RT->{cvs} -f -Q -n update -p -r$IV '$Is'|" + or 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" + or die "unable to open temporary file $RT->{tmpfile}.new for writing"; + if (not $RT->{useserver}) { + my $cvs = new IO::File "$RT->{cvs} -f -Q -n update -p -r$Iv '$Is'|" + or 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 .= + "\n" . + "(cd $cvsdir && \\\n" . + " uudecode <<'@@ .' && \\\n" . + " mv $Is $Is.orig && \\\n" . + " 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 "$RT->{uuencode} $RT->{tmpfile}.xdelta $Is.xdelta |" + or die "unable to open uuencode command pipe for reading"; + $cvsdiff .= $_ while (<$io>); + $io->close; + $cvsdiff .= "@@ .\n"; + $cvsdiff .= "\n"; + unlink("$RT->{tmpfile}.xdelta"); + + # cleanup + unlink("$RT->{tmpfile}.old"); + unlink("$RT->{tmpfile}.new"); + } + } + else { + # generate textual change patch script + my $d = ''; + if (not $RT->{useserver}) { + my $io = new IO::File "$RT->{cvs} -f -Q -n diff -u -r$IV -r$Iv '$Is'|" + or die "unable to open CVS command pipe for reading"; + $d .= $_ while (<$io>); + $io->close; + } + else { + my $cvs = new CVS ($RT->{cvs}, $RT->{cvsroot}); + $cvs->directory($cvsdir); + $cvs->entry($Is); + $cvs->arguments("-u", "-r$IV", "-r$Iv", $Is); + $cvs->send("diff"); + $d .= scalar $cvs->result; + $cvs->close; + } + my $Is_quoted = quotemeta($Is); + $d =~ s|^Index:.+?\ndiff\s+.*?\n||s; + $d =~ s|^(---\s+)${Is_quoted}(\s+)|$1$cvsdir/$Is$2|m; + $d =~ s|^(\+\+\+\s+)${Is_quoted}(\s+)|$1$cvsdir/$Is$2|m; + $cvsdiff .= + "\n" . + "patch -p0 <<'@@ .'\n" . + "Index: $cvsdir/$Is\n" . + ("=" x 76) . "\n" . + "\$ cvs diff -u -r$IV -r$Iv $Is\n" . + $d . + "@@ .\n" . + "\n"; + } + } + elsif ($Io eq 'R') { + ## + ## REMOVED FILE + ## + + # generate binary and textaual change patch script + $cvsdiff .= + "\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" . + "\n"; + } + + $info = "$cvsdir/$Is,$IV,$Iv,$It,$Io,$Ik,$ID,$Id"; + push(@newinfo, $info); + } + @cvsinfo = @newinfo; + + # determine the temporary storage + my $storage; + for (my $i = 0; ; $i++) { + $storage = "$RT->{tmpfile}.$i"; + last if (not -e "$storage.info"); + #my @text = &file_read($storage, ''); + #last if ($#text == -1); + #last if ($cvslogmsg eq join("\n", @text)); + } + + # store the information gathered in this pass + &do_file('write', "$storage.info", '', @cvsinfo); + &do_file('write', "$storage.diff", '', $cvsdiff); + + return $cvsdir; +} + +# accumulate the collected information +sub hook_loginfo_accumulate { + my ($PA, $RT, $CF) = @_; + + # lumb together all information we remembered until now + my $cvslog = join("\n", &do_file('read', "$RT->{tmpfile}.log", ''))."\n"; + unlink("$RT->{tmpfile}.log"); + my @cvsinfo = (); + my $cvsdiff = ''; + for (my $i = 0; ; $i++) { + my $storage = "$RT->{tmpfile}.$i"; + last if (not -e "$storage.info"); + push(@cvsinfo, &do_file('read', "$storage.info", '')); + $cvsdiff .= join("\n", &do_file('read', "$storage.diff", ''))."\n"; + unlink("$storage.info"); + unlink("$storage.diff"); + } + + # parse information into internal structure + my $IN = { + 'file' => {}, + 'handle' => '', + 'log' => $cvslog + }; + $cvsdiff = "\n$cvsdiff\n"; # for easier parsing + my $handle_min; $handle_min = undef; + my $handle_max; $handle_max = undef; + foreach my $cvsinfo (@cvsinfo) { + $cvsinfo =~ m|^([^,]+),([^,]+),([^,]+),([^,]+),([^,]+),([^,]+),([^,]+),([^,]+)$| + or 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; + $e->{newrev} = $Iv; + $e->{branch} = $It; + $e->{op} = $Io; + $e->{keysub} = $Ik; + $e->{date} = $ID; + $e->{delta} = $Id; + $e->{diff} = ''; + my $Is_quoted = quotemeta($Is); + $cvsdiff =~ s|\n\n(.+?\n)|$e->{diff} = $1, ''|se; + $IN->{file}->{$Is} = $e; + $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, + $handle_max - $handle_min); + } + return $IN; +} + +# process the accumulated information +sub hook_loginfo_process { + my ($PA, $RT, $CF, $IN) = @_; + + # determine log locations and corresponding files + my $LG = {}; + my $file; + foreach $file (sort(keys(%{$IN->{file}}))) { + my ($d, $f) = ($file =~ m|^([^/]+)/(.+)$|); + my $t = $IN->{file}->{$file}->{branch}; + foreach my $module (keys(%{$CF->{Repository}->{Module}})) { + if ($module eq $d) { + my $m = $CF->{Repository}->{Module}->{$module}; + foreach my $log (@{$m->{log}}) { + my ($file, @logloc) = @{$log}; + my $tag = 'HEAD'; + if ($file =~ m|^(.+):([^:]+)$|) { + $file = $1; + $tag = $2; + } + if ( &pattern_match($tag, $t) + and &pattern_match($file, $f)) { + foreach my $logloc (@logloc) { + $LG->{$logloc} = [] if (not defined($LG->{$logloc})); + push(@{$LG->{$logloc}}, $file); + } + } + } + } + } + } + + # perform one or more logging operations + foreach my $logloc (sort(keys(%{$LG}))) { + next if ($logloc eq 'none'); + my @files = @{$LG->{$logloc}}; + if ($logloc =~ m|^([^:]+):(.+)$|) { + my ($logtype, $logurl) = ($1, $2); + if ($logurl =~ m|^.+@.+$|) { + # send log message as Email + my $logmsg = &produce_log_message($PA, $RT, $CF, $IN, $logtype, @files); + 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 .= " $file"; + } + $subject = substr($subject, 0, 70)."..." if (length($subject) > 70); + print "cvs commit: Mailing commit message to <$logurl>\n"; + my $sm = new Sendmail ($RT, $logurl); + $sm->header('Subject', $subject); + 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; + } + else { + # append log message to file + 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"; + my $io = new IO::File ">>$logurl" or die "cannot append log message to `$logurl'"; + $io->print($logmsg); + $io->close; + } + } + } +} + +# produce a particular log messages +sub produce_log_message { + my ($PA, $RT, $CF, $IN, $type, @files) = @_; + + # + # Parse out more details. + # + my $cvslist = {}; + my %cvsmodules = (); + my %cvsbranches = (); + my $file; + foreach $file (sort(keys(%{$IN->{file}}))) { + my $e = $IN->{file}->{$file}; + my ($d, $f) = ($file =~ m|^(.+)/([^/]+)$|); + + # build lists + $cvslist->{$e->{op}} = {} if (not defined($cvslist->{$e->{op}})); + $cvslist->{$e->{op}}->{$e->{branch}} = {} if (not defined($cvslist->{$e->{op}}->{$e->{branch}})); + $cvslist->{$e->{op}}->{$e->{branch}}->{$d} = [] if (not defined($cvslist->{$e->{op}}->{$e->{branch}}->{$d})); + push(@{$cvslist->{$e->{op}}->{$e->{branch}}->{$d}}, $f); + + # accumulate modules + ($d, $f) = ($file =~ m|^([^/]+)/(.+)$|); + foreach my $m (sort(keys(%{$CF->{Repository}->{Module}}))) { + if ($m eq $d) { + $cvsmodules{$m} = 0 if (not defined($cvsmodules{$m})); + $cvsmodules{$m}++; + } + } + + # accumulate branches + $cvsbranches{$e->{branch}} = 0 if (not defined($cvsbranches{$e->{branch}})); + $cvsbranches{$e->{branch}}++; + } + $IN->{cvsbranch} = join(' ', keys(%cvsbranches)); + $IN->{cvsmodule} = join(' ', keys(%cvsmodules)); + + # + # Finally generate the logging message. + # + + my $RP = $CF->{Logging}->{Report}->{$type} or die "No report of type `$type' defined"; + my $prefix = $RP->{Prefix} || ''; + my $style = $RP->{Details} || 'patch:plain'; + my $O = ''; + foreach my $content (@{$RP->{Content}}) { + + # the title + if ($content eq 'title') { + $O .= "\n" . + $prefix . $CF->{Repository}->{Name} . "\n" . + $prefix . $CF->{Repository}->{Home} . "\n"; + } + + # a rule + elsif ($content eq 'rule') { + $O .= $prefix . ("_" x 76) . "\n"; + } + + # the header lines + elsif ($content eq 'header') { + my @moy = ( 'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', + 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec' ); + my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time()); + my $txt_date = sprintf("%02d-%s-%04d %02d:%02d:%02d", + $mday, $moy[$mon], 1900+$year, $hour, $min, $sec); + my $txt_server = &fit_columns(32, $CF->{Repository}->{Host}); + my $txt_root = &fit_columns(32, $CF->{Repository}->{Path}); + my $txt_module = &fit_columns(32, $IN->{cvsmodule}); + my $txt_branch = &fit_columns(32, $IN->{cvsbranch}); + my $txt_name = &fit_columns(32, $RT->{username}); + my $txt_email = &fit_columns(32, $RT->{usermail}); + my $txt_handle = &fit_columns(32, $IN->{handle}); + $O .= "\n" . + $prefix . sprintf("%-40s %s\n", "Server: ".$txt_server, "Name: ".$txt_name) . + $prefix . sprintf("%-40s %s\n", "Root: ".$txt_root, "Email: ".$txt_email) . + $prefix . sprintf("%-40s %s\n", "Module: ".$txt_module, "Date: ".$txt_date) . + $prefix . sprintf("%-40s %s\n", "Branch: ".$txt_branch, "Handle: ".$txt_handle); + } + + # the file list + elsif ($content eq 'files') { + $O .= "\n"; + $O .= &format_op($prefix, "Imported files", $cvslist->{I}) if (defined($cvslist->{I})); + $O .= &format_op($prefix, "Added files", $cvslist->{A}) if (defined($cvslist->{A})); + $O .= &format_op($prefix, "Modified files", $cvslist->{M}) if (defined($cvslist->{M})); + $O .= &format_op($prefix, "Touched files", $cvslist->{T}) if (defined($cvslist->{T})); + $O .= &format_op($prefix, "Removed files", $cvslist->{R}) if (defined($cvslist->{R})); + sub format_op { + my ($prefix, $header, $list) = @_; + my $O = ''; + my $branch; + foreach $branch (sort(keys(%{$list}))) { + if ($branch eq 'HEAD') { + $O .= sprintf("%s%s\n", $prefix, "$header:"); + } + else { + $O .= sprintf("%s%-25s %s\n", $prefix, "$header:", "(Branch: $branch)"); + } + $O .= &format_branch($prefix, $header, $branch, $list->{$branch}); + } + return $O; + } + sub format_branch { + my ($prefix, $header, $branch, $list) = @_; + my $O = ''; + my $dir; + foreach $dir (sort(keys(%{$list}))) { + $O .= &format_dir($prefix, $header, $branch, $dir, $list->{$dir}); + } + return $O; + } + sub format_dir { + my ($prefix, $header, $branch, $dir, $list) = @_; + my $O = ''; + my $file; + my $first = 1; + my $col = 0; + foreach $file (sort(@{$list})) { + if (($col + 1 + length($file)) > 78) { + $O .= "\n"; + $col = 0; + } + if ($col == 0) { + if ($first) { + if ((2+length($dir)) > 25) { + $O .= sprintf("%s%s\n", $prefix, " " . $dir); + $O .= sprintf("%s%-25s", $prefix, ""); + } + else { + $O .= sprintf("%s%-25s", $prefix, " " . $dir); + } + $first = 0; + } + else { + $O .= sprintf("%s%-25s", $prefix, ""); + } + $col += length($prefix) + 25; + } + $O .= " " . $file; + $col += 1 + length($file); + } + $O .= "\n" if ($O !~ m|\n$|s); + return $O; + } + } + + # the log message + elsif ($content eq 'log') { + $O .= "\n"; + $O .= $prefix."Log:\n"; + my $log = $IN->{log}; + if ($log !~ m|\n.+|s and length($log) > 70) { + $log = &wrap_message(70, $log); + } + $log =~ s|^|${prefix} |mg; + $O .= $log; + } + + # the change summary + elsif ($content eq 'summary') { + $O .= "\n"; + $O .= $prefix."Summary:\n"; + $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}->{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); + } + } + + # the change details + 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'); + my $url = $urlspec; + $url =~ s|%([sVv])| + if ($1 eq 's') { $file; } + elsif ($1 eq 'V') { $IN->{file}->{$file}->{oldrev}; } + elsif ($1 eq 'v') { $IN->{file}->{$file}->{newrev}; } + |gse; + $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') { + foreach $file (sort(keys(%{$IN->{file}}))) { + next if ($IN->{file}->{$file}->{op} eq 'T'); + my $diff = $IN->{file}->{$file}->{diff}; + $diff =~ s|^|$prefix|mg; + $O .= $diff; + } + } + 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}; + $diff =~ s|\n$||s; + $diff .= "\n\n"; + $O .= "--".$RT->{mimeboundary}."\n"; + $O .= "Content-Type: text/plain; charset=iso-8859-1\n"; + $O .= "Content-Transfer-Encoding: 8bit\n"; + $O .= "Content-Description: changes to $file\n"; + $O .= "Content-Disposition: attachment\n"; + $O .= "\n"; + $O .= "$diff"; + } + } + } + + } + + # post-processing of output + $O =~ s|^\n+||s; + $O =~ s|\n+$|\n|s; + + # MIME post-processing + 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: change summary\n" . + "Content-Disposition: inline\n" . + "\n" . + $O . + "--".$RT->{mimeboundary}."--\n" . + "\n"; + } + + return $O; +} + Index: ossp-pkg/shiela/shiela.pod RCS File: /v/ossp/cvs/ossp-pkg/shiela/shiela.pod,v rcsdiff -q -kk '-r1.24' '-r1.25' -u '/v/ossp/cvs/ossp-pkg/shiela/shiela.pod,v' 2>/dev/null --- shiela.pod 2005/01/12 20:46:14 1.24 +++ shiela.pod 2006/07/20 08:17:11 1.25 @@ -1,7 +1,7 @@ ## ## OSSP shiela - CVS Access Control and Logging Facility -## Copyright (c) 2000-2005 Ralf S. Engelschall -## Copyright (c) 2000-2005 The OSSP Project +## Copyright (c) 2000-2006 Ralf S. Engelschall +## Copyright (c) 2000-2006 The OSSP Project ## ## This file is part of OSSP shiela, an access control and logging ## facility for Concurrent Versions System (CVS) repositories