Index: CVSROOT/README RCS File: /v/ossp/cvs/CVSROOT/README,v co -q -kk -p'1.1' '/v/ossp/cvs/CVSROOT/README,v' | diff -u /dev/null - -L'CVSROOT/README' 2>/dev/null --- CVSROOT/README +++ - 2024-05-05 07:14:38.663150164 +0200 @@ -0,0 +1,51 @@ + + OSSP CVS REPOSITORY ADMINISTRATIVE AREA + ======================================= + + This is the administrative area of the OSSP CVS master repository. + It is consulted by the CVS program internally and is maintained by + the OSSP CVS master only. The administrative files are consulted in + dependency of the used CVS command. + + On `cvs checkout': + 1. CVSROOT/config (general configuration) + 2. CVSROOT/modules (determine module names) + 3. CVSROOT/cvswrappers (file handling) + 4. CVSROOT/history (logging of the commit step) + + On `cvs commit': + 1. CVSROOT/config (general configuration) + 2. CVSROOT/modules (determine module names) + 3. CVSROOT/commitinfo (access control) + 4. CVSROOT/rcsinfo (log message template) + 5. CVSROOT/editinfo (run the log message editor) + 6. CVSROOT/verifymsg (evaluate/adjust log message after editing) + 3. CVSROOT/cvswrappers (file handling) + 7. CVSROOT/loginfo (extra logging after commit) + 8. CVSROOT/history (logging of the commit step) + + On `cvs import': + 1. CVSROOT/config (general configuration) + 2. CVSROOT/modules (determine module names) + 2. CVSROOT/importinfo (access control) + 4. CVSROOT/rcsinfo (log message template) + 5. CVSROOT/editinfo (run the log message editor) + 6. CVSROOT/verifymsg (evaluate/adjust log message after editing) + 3. CVSROOT/cvswrappers (file handling) + 7. CVSROOT/loginfo (extra logging after commit) + 8. CVSROOT/history (logging of the commit step) + + On `cvs tag': + 1. CVSROOT/config (general configuration) + 2. CVSROOT/modules (determine module names) + 3. CVSROOT/taginfo (access control and tag evaluation) + 4. CVSROOT/history (logging of the tag step) + + On `cvs admin': + 1. CVSROOT/config (general configuration) + 2. CVSROOT/modules (determine module names) + 3. CVSROOT/admininfo (access control) + 4. CVSROOT/history (logging of the admin step) + + In case of any questions, contact the OSSP CVS master . + Index: CVSROOT/admininfo RCS File: /v/ossp/cvs/CVSROOT/admininfo,v co -q -kk -p'1.2' '/v/ossp/cvs/CVSROOT/admininfo,v' | diff -u /dev/null - -L'CVSROOT/admininfo' 2>/dev/null --- CVSROOT/admininfo +++ - 2024-05-05 07:14:38.665805111 +0200 @@ -0,0 +1,23 @@ +#!/bin/sh +## +## CVSROOT/admininfo -- pre-admin consistency checking +## Copyright (c) 2000 Ralf S. Engelschall +## + +# This file is used to control pre-admin checks. +# +# The filter on the right is invoked with the (absolute) repository +# directory path followed by one or more names of files in this +# directory on which `cvs admin' operations should be performed. A +# non-zero exit of the filter program will cause the operation to be +# aborted. The first entry on a line is a regular expression which +# is tested against the directory that the change is being committed +# to, relative to the $CVSROOT. For the first match that is found, +# then the remainder of the line is the name of the filter to run. If +# the repository name does not match any of the regular expressions +# in this file, the "DEFAULT" line is used, if it is specified. If +# the name "ALL" appears as a regular expression it is always used in +# addition to the first matching regex or "DEFAULT". + +ALL $CVSROOT/CVSROOT/shiela --hook=admininfo + Index: CVSROOT/checkoutlist RCS File: /v/ossp/cvs/CVSROOT/checkoutlist,v co -q -kk -p'1.2' '/v/ossp/cvs/CVSROOT/checkoutlist,v' | diff -u /dev/null - -L'CVSROOT/checkoutlist' 2>/dev/null --- CVSROOT/checkoutlist +++ - 2024-05-05 07:14:38.668422121 +0200 @@ -0,0 +1,18 @@ +## +## CVSROOT/checkoutlist -- automatically checked out files from CVSROOT +## Copyright (c) 2000 Ralf S. Engelschall +## + +# This file is used to support additional version controlled +# administrative files in $CVSROOT/CVSROOT, such as template files. +# The first entry on a line is a filename which will be checked out +# from the corresponding RCS file in the $CVSROOT/CVSROOT directory. +# The remainder of the line is an error message to use if the file +# cannot be checked out. +# Format: [][] + +README +shiela +shiela.cfg +shiela.msg + Index: CVSROOT/commitinfo RCS File: /v/ossp/cvs/CVSROOT/commitinfo,v co -q -kk -p'1.2' '/v/ossp/cvs/CVSROOT/commitinfo,v' | diff -u /dev/null - -L'CVSROOT/commitinfo' 2>/dev/null --- CVSROOT/commitinfo +++ - 2024-05-05 07:14:38.670991719 +0200 @@ -0,0 +1,20 @@ +## +## CVSROOT/commitinfo -- pre-commit hooking +## Copyright (c) 2000 Ralf S. Engelschall +## + +# This file is used to control pre-commit checks. The filter on the +# right is invoked with the repository and a list of files to check. +# A non-zero exit of the filter program will cause the commit to be +# aborted. The first entry on a line is a regular expression which +# is tested against the directory that the change is being committed +# to, relative to the $CVSROOT. For the first match that is found, +# then the remainder of the line is the name of the filter to run. If +# the repository name does not match any of the regular expressions +# in this file, the "DEFAULT" line is used, if it is specified. If +# the name "ALL" appears as a regular expression it is always used in +# addition to the first matching regex or "DEFAULT". +# Format: + +ALL $CVSROOT/CVSROOT/shiela --hook=commitinfo + Index: CVSROOT/config RCS File: /v/ossp/cvs/CVSROOT/config,v co -q -kk -p'1.2' '/v/ossp/cvs/CVSROOT/config,v' | diff -u /dev/null - -L'CVSROOT/config' 2>/dev/null --- CVSROOT/config +++ - 2024-05-05 07:14:38.673599231 +0200 @@ -0,0 +1,40 @@ +## +## CVSROOT/config -- main configuration file +## Copyright (c) 2000 Ralf S. Engelschall +## + +# This is file is the main CVS configuration file which +# controls some global aspects of the repository. +# Format: = + +# pserver shouldn't check system users/passwords +SystemAuth=no + +# do not to save file status information in the repository +# (buggy feature, do not set to `yes'!) +PreservePermissions=no + +# do not create a CVS directory at the top level of new working directories +TopLevelAdmin=no + +# we store lock files in a separate directory for file permission reasons +#LockDir=/e/ossp/cvs/CVSLOCK + +# configure which transactions are logged to history file (`all' or `TOFEWGCMAR' +# to log all transactions; or a subset as needed, ie `TMAR' logs all write operations) +# [only available with CVS >= 1.10.8.1!] +LogHistory=TMAR + +# Set `HistoryFile' to the path name (relative to CVSROOT) of the history file +# if you do not want to store it not under CVSROOT/history +# [only available with OSSP patches] +#HistoryFile=CVSROOT/history + +# Set `LocalIdName' to the name of a local tag to use in addition to $Id$ +# [only available with OSSP patches] +LocalIdName=OSSP + +# Set `UMask' to the octal value of the umask under which CVS should run +# [only available with OSSP patches] +UMask=002 + Index: CVSROOT/cvsignore RCS File: /v/ossp/cvs/CVSROOT/cvsignore,v co -q -kk -p'1.1' '/v/ossp/cvs/CVSROOT/cvsignore,v' | diff -u /dev/null - -L'CVSROOT/cvsignore' 2>/dev/null --- CVSROOT/cvsignore +++ - 2024-05-05 07:14:38.676189934 +0200 @@ -0,0 +1,33 @@ +## +## CVSROOT/cvsignore -- files to ignore in working copies +## Copyright (c) 2000 Ralf S. Engelschall +## + +# This file defines patterns of files which should be ignored +# by CVS when staying around in working copies. + +# automatically generated files +*.bak +*.orig +*.rej + +# standard output files +*.a +*.o +*.so + +# GNU autoconf generated files +config.log +config.cache +config.status + +# GNU libtool generated files +libtool +.libs +*.lo +*.la + +# debugging stuff +core +*.core + Index: CVSROOT/cvswrappers RCS File: /v/ossp/cvs/CVSROOT/cvswrappers,v co -q -kk -p'1.2' '/v/ossp/cvs/CVSROOT/cvswrappers,v' | diff -u /dev/null - -L'CVSROOT/cvswrappers' 2>/dev/null --- CVSROOT/cvswrappers +++ - 2024-05-05 07:14:38.678770218 +0200 @@ -0,0 +1,23 @@ +## +## CVSROOT/cvswrappers -- handling of files +## Copyright (c) 2000 Ralf S. Engelschall +## + +# This file affects handling of files based on their names. The -t/-f +# options allow one to treat directories of files as a single file, +# or to transform a file in other ways on its way in and out of CVS. +# The -m option specifies whether CVS attempts to merge files. The +# -k option specifies keyword expansion (e.g. -kb for binary). The +# format of this file ($CVSROOT/CVSROOT/cvswrappers) is the same as +# for .cvswrappers files: [] [] +# ..., where option is one of +# -f from cvs filter value: path to filter +# -t to cvs filter value: path to filter +# -m update methodology value: MERGE or COPY +# -k expansion mode value: b, o, kkv, &c +# and value is a single-quote delimited value. + +*.(Z|gz|bz2) -k 'b' -m 'COPY' +*.(gif|jpg|tif|png|pdf) -k 'b' -m 'COPY' +configure -k 'b' -m 'COPY' + Index: CVSROOT/editinfo RCS File: /v/ossp/cvs/CVSROOT/editinfo,v co -q -kk -p'1.2' '/v/ossp/cvs/CVSROOT/editinfo,v' | diff -u /dev/null - -L'CVSROOT/editinfo' 2>/dev/null --- CVSROOT/editinfo +++ - 2024-05-05 07:14:38.681383554 +0200 @@ -0,0 +1,20 @@ +## +## CVSROOT/editinfo -- pre-edit hooking (LOCAL REPOSITORY USE ONLY!) +## Copyright (c) 2000 Ralf S. Engelschall +## + +# This file is used to allow verification of logging information. It works +# best when a template (as specified in the rcsinfo file) is provided for +# the logging procedure. Given a template with locations for, a bug-id +# number, a list of people who reviewed the code before it can be checked +# in, and an external process to catalog the differences that were code +# reviewed, the following test can be applied to the code: 1. Making sure +# that the entered bug-id number is correct. 2. Validating that the code +# that was reviewed is indeed the code being checked in (using the bug-id +# number or a seperate review number to identify this particular code set). +# If any of the above test failed, then the commit would be aborted. +# Actions such as mailing a copy of the report to each reviewer are better +# handled by an entry in the loginfo file. One thing that should be noted +# is the the ALL keyword is not supported. There can be only one entry that +# matches a given repository. + Index: CVSROOT/importinfo RCS File: /v/ossp/cvs/CVSROOT/importinfo,v co -q -kk -p'1.2' '/v/ossp/cvs/CVSROOT/importinfo,v' | diff -u /dev/null - -L'CVSROOT/importinfo' 2>/dev/null --- CVSROOT/importinfo +++ - 2024-05-05 07:14:38.683951399 +0200 @@ -0,0 +1,22 @@ +#!/bin/sh +## +## CVSROOT/importinfo -- pre-import consistency checking +## Copyright (c) 2000 Ralf S. Engelschall +## + +# This file is used to control pre-import checks. The filter on +# the right is invoked with the vendor branch tag, the (absolute) +# repository directory path into which the `cvs import' operation +# should be performed plus zero or more relative paths of imported +# files. A non-zero exit of the filter program will cause the +# operation to be aborted. The first entry on a line is a regular +# expression which is tested against the directory that the import is +# performed to, relative to the $CVSROOT. For the first match that +# is found, then the remainder of the line is the name of the filter +# to run. If the repository name does not match any of the regular +# expressions in this file, the "DEFAULT" line is used, if it is +# specified. If the name "ALL" appears as a regular expression it is +# always used in addition to the first matching regex or "DEFAULT". + +ALL $CVSROOT/CVSROOT/shiela --hook=importinfo + Index: CVSROOT/loginfo RCS File: /v/ossp/cvs/CVSROOT/loginfo,v co -q -kk -p'1.2' '/v/ossp/cvs/CVSROOT/loginfo,v' | diff -u /dev/null - -L'CVSROOT/loginfo' 2>/dev/null --- CVSROOT/loginfo +++ - 2024-05-05 07:14:38.686524250 +0200 @@ -0,0 +1,27 @@ +## +## CVSROOT/loginfo -- log message hooking +## Copyright (c) 2000 Ralf S. Engelschall +## + +# This file controls where "cvs commit" log information is sent. The +# first entry on a line is a regular expression which must match +# the directory that the change is being made to, relative to the +# $CVSROOT. If a match is found, then the remainder of the line is a +# filter program that should expect log information on its standard +# input. If the repository name does not match any of the regular +# expressions in this file, the "DEFAULT" line is used, if it is +# specified. If the name "ALL" appears as a regular expression it is +# always used in addition to the first matching regex or "DEFAULT". +# You may specify a format string as part of the filter. The string +# is composed of a `%' followed by a single format character, or +# followed by a set of format characters surrounded by `{' and `}' as +# separators. The format characters are: +# s = file name +# V = old version number (pre-checkin) +# v = new version number (post-checkin) +# t = tag name (OSSP only) +# o = operation type (OSSP only: "A", "M" or "R") +# d = date (OSSP only) + +ALL $CVSROOT/CVSROOT/shiela --hook=loginfo %{sVvto} + Index: CVSROOT/modules RCS File: /v/ossp/cvs/CVSROOT/modules,v co -q -kk -p'1.2' '/v/ossp/cvs/CVSROOT/modules,v' | diff -u /dev/null - -L'CVSROOT/modules' 2>/dev/null --- CVSROOT/modules +++ - 2024-05-05 07:14:38.689090286 +0200 @@ -0,0 +1,47 @@ +## +## CVSROOT/modules -- module aliasing +## Copyright (c) 2000 Ralf S. Engelschall +## + +# This file provides aliases for repository paths. +# +# Three different line formats are valid: +# key -a aliases... +# key [options] directory +# key [options] directory files... +# +# Where "options" are composed of: +# -i prog Run "prog" on "cvs commit" from top-level of module. +# -o prog Run "prog" on "cvs checkout" of module. +# -e prog Run "prog" on "cvs export" of module. +# -t prog Run "prog" on "cvs rtag" of module. +# -u prog Run "prog" on "cvs update" of module. +# -d dir Place module in directory "dir" instead of module name. +# -l Top-level directory only -- do not recurse. +# +# NOTE: If you change any of the "Run" options above, you'll have to +# release and re-checkout any working directories of these modules. And +# "directory" is a path to a directory relative to $CVSROOT. The "-a" +# option specifies an alias. An alias is interpreted as if everything on +# the right of the "-a" had been typed on the command line. You can encode +# a module within a module by using the special '&' character to interpose +# another module into the current module. This can be useful for creating a +# module that consists of many directories spread out over the entire source +# repository. + +# convenient aliases +all -a . + +# CVSROOT support +CVSROOT CVSROOT #: mail=rse@engelschall.com log=CVSLOG/CVSROOT +rcsinfo CVSROOT rcsinfo +rcstemplate CVSROOT rcstemplate + +# the real modules +ossp-core ossp-core #: mail=ossp-core@ossp.org log=CVSLOG/ossp-core +ossp-src ossp-src #: mail=ossp-cvs@ossp.org log=CVSLOG/ossp-src +ossp-web ossp-web #: mail=ossp-cvs@ossp.org log=CVSLOG/ossp-web +ossp-play ossp-web #: mail=ossp-cvs@ossp.org log=CVSLOG/ossp-play +test test #: mail=rse@engelschall.com log=CVSLOG/test + + Index: CVSROOT/notify RCS File: /v/ossp/cvs/CVSROOT/notify,v co -q -kk -p'1.2' '/v/ossp/cvs/CVSROOT/notify,v' | diff -u /dev/null - -L'CVSROOT/notify' 2>/dev/null --- CVSROOT/notify +++ - 2024-05-05 07:14:38.691830137 +0200 @@ -0,0 +1,15 @@ +## +## CVSROOT/notify -- notify hook +## Copyright (c) 2000 Ralf S. Engelschall +## + +# This file controls where notifications from watches set by "cvs watch add" +# or "cvs edit" are sent. The first entry on a line is a regular expression +# which is tested against the directory that the change is being made to, +# relative to the $CVSROOT. If it matches, then the remainder of the line +# is a filter program that should contain one occurrence of %s for the user +# to notify, and information on its standard input. "ALL" or "DEFAULT" can +# be used in place of the regular expression. + +#ALL mail %s -s "CVS notification" + Index: CVSROOT/rcsinfo RCS File: /v/ossp/cvs/CVSROOT/rcsinfo,v co -q -kk -p'1.2' '/v/ossp/cvs/CVSROOT/rcsinfo,v' | diff -u /dev/null - -L'CVSROOT/rcsinfo' 2>/dev/null --- CVSROOT/rcsinfo +++ - 2024-05-05 07:14:38.694405587 +0200 @@ -0,0 +1,18 @@ +## +## CVSROOT/rcsinfo -- log message templates +## Copyright (c) 2000 Ralf S. Engelschall +## + +# This file is used to control templates with which the editor is +# invoked on commit and import. The first entry on a line is a regular +# expression which is tested against the directory that the change is +# being made to, relative to the $CVSROOT. For the first match that +# is found, then the remainder of the line is the name of the file +# that contains the template. If the repository name does not match +# any of the regular expressions in this file, the "DEFAULT" line is +# used, if it is specified. If the name "ALL" appears as a regular +# expression it is always used in addition to the first matching regex +# or "DEFAULT". + +ALL $CVSROOT/CVSROOT/shiela.msg + Index: CVSROOT/shiela RCS File: /v/ossp/cvs/CVSROOT/shiela,v co -q -kk -p'1.1' '/v/ossp/cvs/CVSROOT/shiela,v' | diff -u /dev/null - -L'CVSROOT/shiela' 2>/dev/null --- CVSROOT/shiela +++ - 2024-05-05 07:14:38.697033279 +0200 @@ -0,0 +1,2067 @@ +#!/v/ossp/sw/bin/perl -w +## +## Shiela - CVS Access Control and Logging Facility +## Copyright (c) 2000 Ralf S. Engelschall +## +## This file is part of Shiela, an access control and logging +## facility for Concurrent Versions System (CVS) repositories +## which can be found at http://www.ossp.org/pkg/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: Shiela control program (syntax: Perl) +## + +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::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 + +# 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}; + +# Generic program error handler +$SIG{__DIE__} = sub { + my ($text) = @_; + $text =~ s|\s+at\s+.*||s; + my $name = ($0 =~ m|^.*?([^/]+?)(?:\.[^/.]+)?$|)[0]; + print STDERR $name.":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 hook (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} || die 'unknown CVS root (set $CVSROOT variable)'; + $RT->{userid} = $ENV{LOGUSER} || $ENV{USER} || $ENV{LOGNAME} || 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 "unknown user `$RT->{userid}'"; + $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); + + # determine various program paths + sub find_program { + my ($name) = @_; + my ($prog) = ''; + foreach my $dir (split(/:/, "$ENV{PATH}:/usr/local/lib:/usr/lib:/lib")) { + if (-x "$dir/$name") { + $prog = "$dir/$name"; + last; + } + } + return $prog; + } + $RT->{sendmail} = &find_program("ssmtp") || + &find_program("sendmail") || + die "unable to find `sendmail' program"; + $RT->{cvs} = &find_program("cvs") || + die "unable to find `cvs' program"; + + # 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.]+)\s+|s); + $RT->{cvsossp} = 0; + $RT->{cvsossp} = 1 if ($v =~ m|OSSP|s); + die "$RT->{cvs} is not at least CVS 1.10" if ($RT->{cvsvers} !~ m|^1\.10|); + $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 Shiela configuration. +## +## We theoretically could directly operate on the syntax tree as +## created by parse_config() above. But for convinience 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 + open(CFG, "<$file") || die "unable to open configuration file `$file'"; + my $t = ''; + $t .= $_ while (); + close(CFG); + + # 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' => {} + } + }; + 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]; + } + } + } + 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 achored + $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 convinience +## 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} || 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 -Q -l -n server") + || 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 MT"); + $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; + } +} + +# convinience 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; + } +} + +# convinience wrapper: provide a file entry +sub entry { + my $cvs = shift; + my @files = @_; + foreach my $file (@files) { + $cvs->send("Entry /$file////"); + $cvs->send("Unchanged $file"); + } +} + +# convinience wrapper: provide one or more global options +sub global_options { + my $cvs = shift; + my @opts = @_; + foreach my $opt (@opts) { + $cvs->send("Global_option $opt"); + } +} + +# convinience wrapper: provide one or more arguments +sub arguments { + my $cvs = shift; + my @args = @_; + foreach my $arg (@args) { + $cvs->send("Argument $arg"); + } +} + +# convinience 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: ".uc(substr($RT->{name}, 0, 1)).substr($RT->{name}, 1)."/$RT->{vers} " . + ($RT->{cvsossp} ? "OSSP-CVS" : "CVS")."/$RT->{cvsvers}\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 convinience 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') { + open(FP, ($op eq 'append' ? ">" : "").">$file") or + die "unable to open `$file' for $op"; + foreach my $line (@lines) { + $line =~ s|\n+$||s; + print FP $prefix . $line . "\n"; + } + close(FP); + } + # 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 () { + s|\n$||s; + push(@text, $prefix . $_); + } + close(FP); + 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 = ''; + my $file; + foreach $file (keys(%{$IN->{file}})) { + my $e = $IN->{file}->{$file}; + $O .= $IN->{handle}; + $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"; + } + open(HDB, ">>".$RT->{historydb}) + || die "cannot store information to history db `$file'"; + print HDB $O; + close(HDB); + return; +} + +sub history_load { + my ($PA, $RT, $CF, $handle) = @_; + # XXX STILL MISSING, BECAUSE NOT USED XXX + # XXX HAS TO RE-DETERMINE DIFF AND LOG INFORMATION XXX + 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|^([^/]+)/(.*):([^:]+)$| + || 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 + $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; +} + +## _________________________________________________________________ +## +## 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}}; + $cvsdir =~ s|^$RT->{cvsroot}/?||; + + # 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}) { + open(CVSS, "$RT->{cvs} -f -l -Q -n status ".join(' ', @cvsfiles)."|"); + $cvsstat .= $_ while (); + close(CVSS); + } + else { + my $cvs = new CVS ($RT->{cvs}, $RT->{cvsroot}); + $cvs->global_options("-l", "-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'; + if ($cvsstat =~ m|===+\nFile:\s+$cvsfile.+?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 `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 +## patches, the log message is changed and CVS 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; + + # we require the OSSP patches for operation + return $rv if (not $RT->{cvsossp}); + + # suck in the log message + my $logfile = $PA->{ARG}->[0]; + open(FP, "<$logfile") || die "cannot open message file `$logfile' for reading"; + my $data = ''; + $data .= $_ while (); + close(FP); + + # 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); + + # 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, @cvsinfo) = split(/\s+/, $PA->{ARG}->[0]); + + # 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 (join(' ', @cvsinfo) eq '- New directory') { # see CVS' src/add.c + # Hmmm... we always just deal with files in 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 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 (join(' ', @cvsinfo) 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 (OSSP 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 .= "[Release Tags: $IT]\n"; + 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 $subdir = $Is; + $subdir =~ s|/?[^/]+$||; + $subdir =~ s|^$|.|; + 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: 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 (); + close(CVSS); + } + else { + my $cvs = new CVS ($RT->{cvs}, $RT->{cvsroot}); + $cvs->directory($cvsdir); + $cvs->entry($Is); + $cvs->arguments("-r$It", $Is); + $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 OSSP CVS version would provide). + if (not $RT->{cvsossp} 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|^([^,]+),([^,]+),([^,]+)$| + || die "invalid loginfo argument `$info'"; + 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|^([^,]+),([^,]+),([^,]+),([^,]*),([^,]*)$| + || die "invalid loginfo argument `$info'"; + 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 + my $rcslog = ''; + if ($Io eq 'A' or $Io eq 'M') { + if (not $RT->{useserver}) { + open(CVSS, "$RT->{cvs} -f -l -Q -n log -r$Iv $Is|"); + $rcslog .= $_ while (); + close(CVSS); + } + 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) { + 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' or $Io eq 'R') { + open(FP, "<$Is"); + my $l = 0; + $l++ while (); + close(FP); + $Id = sprintf("+%d/-%d", ($Io eq 'A' ? $l : 0), ($Io eq 'A' ? 0 : $l)); + } + elsif ($Io eq 'M') { + # if ($rcslog =~ m|\ndate:.*lines:\s*(.+?)\s*\n|s) { + if ($rcslog =~ m|\ndate:.*lines:\s*([\d \t-]+)|s) { + $Id = $1; + $Id =~ s|\s+|/|g; + } + } + } + + # determine change diff + 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 .= + "\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 (); + 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 .= "\n"; + } + else { + # file seems to be a regular text file + $cvsdiff .= + "\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 (); + 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 .= "\n"; + } + } + elsif ($Io eq 'M') { + if ($Ik eq 'b' or -B $Is) { + # file seems to be a binary file + $cvsdiff .= + "\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; + } + open(FP, "diff -u $Is.old $Is.new|"); + $cvsdiff .= $_ while (); + close(FP); + $cvsdiff .= "\n"; + } + else { + # file was modified, so we show the changed contents only + my $d = ''; + if (not $RT->{useserver}) { + open(FP, "$RT->{cvs} -f -l -Q -n diff -u -r$IV -r$Iv $Is|"); + $d .= $_ while (); + close(FP); + } + 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; + } + $d =~ s|^Index:.+?\ndiff\s+.*?\n||s; + $d =~ s|^(---\s+)$Is(\s+)|$1$cvsdir/$Is$2|m; + $d =~ s|^(\+\+\+\s+)$Is(\s+)|$1$cvsdir/$Is$2|m; + $cvsdiff .= + "\n" . + "Index: $cvsdir/$Is\n" . + "============================================================\n" . + "\$ cvs diff -u -r$IV -r$Iv $Is\n" . + $d . + "\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 = undef; + my $handle_max = undef; + foreach my $cvsinfo (@cvsinfo) { + $cvsinfo =~ m|^([^,]+),([^,]+),([^,]+),([^,]+),([^,]+),([^,]+),([^,]+),([^,]+)$| + || die "invalid loginfo argument `$cvsinfo'"; + 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} = ''; + $cvsdiff =~ s|\n\n(.+?\n)|$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)); + } + $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 = ''; + foreach my $path (sort(keys(%{$IN->{file}}))) { + my ($dir, $file) = ($path =~ m|^(.+)/([^/]+)$|); + if ($dirlast ne $dir) { + $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 ($CF->{Logging}->{Report}->{$logtype}->{Details} eq 'diff: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"; + open(LOG, ">>$logurl") || die "cannot append log message to `$logurl'"; + print LOG $logmsg; + close(LOG); + } + } + } +} + +# 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} || die "No report of type `$type' defined"; + my $prefix = $RP->{Prefix} || ''; + my $style = $RP->{Details} || 'diff: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 $date = sprintf("%02d-%s-%04d %02d:%02d:%02d", + $mday, $moy[$mon], 1900+$year, $hour, $min, $sec); + $O .= "\n" . + $prefix . sprintf("%-40s %s\n", "Server: ".$CF->{Repository}->{Host}, "Name: ".$RT->{username}) . + $prefix . sprintf("%-40s %s\n", "Root: ".$CF->{Repository}->{Path}, "Email: ".$RT->{usermail}) . + $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"; + $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 .= $prefix."$header:\n"; + } + else { + $O .= $prefix.sprintf("%-25s %s\n", "$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+length($file)+1 > 78) { + $O .= "\n"; + $col = 0; + } + if ($col == 0) { + if ($first) { + if (length($dir) > 25) { + $O .= $prefix.sprintf("%s\n$prefix%-25s", " $dir", ""); + } + else { + $O .= $prefix.sprintf("%-25s", " $dir"); + } + $first = 0; + } + else { + $O .= $prefix.sprintf("%-25s", ""); + } + $col += length($prefix)+25; + } + $O .= " $file"; + $col += length($file)+1; + } + $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}; + $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'); + $delta =~ s|/| |g; + $O .= $prefix.sprintf(" %-12s%-12s%s\n", $rev, $delta, $file); + } + } + + # the change details + elsif ($content eq 'details') { + $O .= "\n"; + if ($style =~ m|^url:(.+)|) { + 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 'diff: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 'diff: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 'diff: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-Disposition: inline\n" . + "\n" . + $O . + "--".$RT->{mimeboundary}."--\n" . + "\n"; + } + + return $O; +} + +##EOF## Index: CVSROOT/shiela.cfg RCS File: /v/ossp/cvs/CVSROOT/shiela.cfg,v co -q -kk -p'1.1' '/v/ossp/cvs/CVSROOT/shiela.cfg,v' | diff -u /dev/null - -L'CVSROOT/shiela.cfg' 2>/dev/null --- CVSROOT/shiela.cfg +++ - 2024-05-05 07:14:38.701388385 +0200 @@ -0,0 +1,103 @@ +## +## Shiela - CVS Access Control and Logging Facility +## Copyright (c) 2000 Ralf S. Engelschall +## +## This file is part of Shiela, an access control and logging +## facility for Concurrent Versions System (CVS) repositories +## which can be found at http://www.ossp.org/pkg/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.cfg: Shiela configuration (syntax: Shiela C-style) +## + +Project { + Tag OSSP; + Name "Open Structured Server Platform"; + Contact ossp@ossp.org; + Home http://www.ossp.org/; + Users { + User ossp "OSSP Project Master" ossp@ossp.org; + User rse "Ralf S. Engelschall" rse@engelschall.com; + }; + Groups { + Group core "OSSP Core Team" { ossp rse }; + Group devel "OSSP Developer Team" { ossp rse }; + Group contrib "OSSP Contributor Team" { }; + Group guest "OSSP Guests" { }; + }; +}; + +Repository { + Tag OSSP; + Name "OSSP CVS Master Repository"; + Contact cvs@ossp.org; + Home http://cvs.ossp.org/; + Host cvs.ossp.org; + Path /v/ossp/cvs; + History CVSROOT/shiela.log; + Modules { + Module CVSROOT "CVS Administrative Files" { + Acl modules *:core *:devel *:contrib; + Acl * *:core; + Log passwd none; + #Log modules mail.diff:ossp-cvs@ossp.org mail.diff:ossp-core@ossp.org file:CVSLOG/CVSROOT; + #Log * mail.diff:ossp-core@ossp.org file:CVSLOG/CVSROOT; + Log * mail.diff:rse@engelschall.com file:CVSLOG/CVSROOT; + }; + Module ossp-adm "OSSP Administration" { + Acl * *:core; + Log * mail:ossp-core@ossp.org file:CVSLOG/ossp-adm; + }; + Module ossp-src "OSSP Source" { + Acl * *:core *:devel *:contrib; + Log * mail:ossp-cvs@ossp.org file:CVSLOG/ossp-src; + }; + Module ossp-pkg "OSSP Packages" { + Acl * *:core *:devel *:contrib; + Log * mail:ossp-cvs@ossp.org file:CVSLOG/ossp-pkg; + }; + Module ossp-play "OSSP Playground" { + Acl * *:core *:devel *:contrib *:guests; + Log * mail:ossp-cvs@ossp.org file:CVSLOG/ossp-play; + }; + Module test "OSSP Playground" { + Acl *:vendor *:core; + Log *:vendor mail.url:rse@engelschall.com file:CVSLOG/test; + Acl * *:core *:devel *:contrib *:guests; + Log * mail.diff:rse@engelschall.com file:CVSLOG/test; + }; + }; +}; + +Logging { + Reports { + Report mail.diff { + Prefix " "; + Content title rule header files log summary rule details; + Details diff:mime; + }; + Report mail.url { + Prefix " "; + Content title rule header files log summary rule details; + Details url:http://cvs.ossp.org/cvsweb.cgi/%s?cvsroot=ossp&r1=%V&r2=%v; + }; + Report file { + Content rule file header files log summary; + }; + }; +}; + Index: CVSROOT/shiela.msg RCS File: /v/ossp/cvs/CVSROOT/shiela.msg,v co -q -kk -p'1.1' '/v/ossp/cvs/CVSROOT/shiela.msg,v' | diff -u /dev/null - -L'CVSROOT/shiela.msg' 2>/dev/null --- CVSROOT/shiela.msg +++ - 2024-05-05 07:14:38.704172454 +0200 @@ -0,0 +1,13 @@ + +PR: +Submitted by: +Reviewed by: +Approved by: +Obtained from: +CVS: ---------------------------------------------------------------------- +CVS: PR: Fill this in if a problem report is affected +CVS: Submitted by: Fill this in if someone else sent you the change +CVS: Reviewed by: Fill this in if someone else reviewed your modification +CVS: Approved by: Fill this in if you needed approval for this commit +CVS: Obtained from: Fill this in if the change is from third party software +CVS: ---------------------------------------------------------------------- Index: CVSROOT/taginfo RCS File: /v/ossp/cvs/CVSROOT/taginfo,v co -q -kk -p'1.2' '/v/ossp/cvs/CVSROOT/taginfo,v' | diff -u /dev/null - -L'CVSROOT/taginfo' 2>/dev/null --- CVSROOT/taginfo +++ - 2024-05-05 07:14:38.706748257 +0200 @@ -0,0 +1,26 @@ +#!/bin/sh +## +## CVSROOT/taginfo -- pre-tag consistency checking +## Copyright (c) 2000 Ralf S. Engelschall +## + +# This file is used to control pre-tag checks. +# +# The filter on the right is invoked with the following arguments: +# $1 -- tagname +# $2 -- operation "add" for tag, "mov" for tag -F, and "del" for tag -d +# $3 -- repository +# $4 -- file revision [file revision ...] +# +# A non-zero exit of the filter program will cause the tag to be aborted. +# The first entry on a line is a regular expression which is tested against +# the directory that the change is being committed to, relative to the +# $CVSROOT. For the first match that is found, then the remainder of the +# line is the name of the filter to run. If the repository name does not +# match any of the regular expressions in this file, the "DEFAULT" line is +# used, if it is specified. If the name "ALL" appears as a regular +# expression it is always used in addition to the first matching regex or +# "DEFAULT". + +ALL $CVSROOT/CVSROOT/shiela --hook=taginfo + Index: CVSROOT/verifymsg RCS File: /v/ossp/cvs/CVSROOT/verifymsg,v co -q -kk -p'1.2' '/v/ossp/cvs/CVSROOT/verifymsg,v' | diff -u /dev/null - -L'CVSROOT/verifymsg' 2>/dev/null --- CVSROOT/verifymsg +++ - 2024-05-05 07:14:38.709345154 +0200 @@ -0,0 +1,24 @@ +## +## CVSROOT/verifymsg -- post-edit hooking +## Copyright (c) 2000 Ralf S. Engelschall +## + +# This file is used to allow verification of logging information. It works +# best when a template (as specified in the $CVSROOT/CVSROOT/rcsinfo file) +# is provided for the logging procedure. Given a template with locations +# for, a bug-id number, a list of people who reviewed the code before it can +# be checked in, and an external process to catalog the differences that +# were code reviewed, the following test can be applied to the code: 1. +# Making sure that the entered bug-id number is correct. 2. Validating that +# the code that was reviewed is indeed the code being checked in (using the +# bug-id number or a seperate review number to identify this particular code +# set.). If any of the above test failed, then the commit would be aborted. +# Actions such as mailing a copy of the report to each reviewer are better +# handled by an entry in the loginfo file. One thing that should be noted is +# the the ALL keyword is not supported. There can be only one entry that +# matches a given repository. + +#DEFAULT $CVSROOT/CVSROOT/logcheck + +DEFAULT $CVSROOT/CVSROOT/shiela --hook=verifymsg +