head	1.73;
access;
symbols
	SHIELA_1_1_7:1.72
	SHIELA_1_1_6:1.70
	SHIELA_1_1_5:1.69
	SHIELA_1_1_4:1.65
	SHIELA_1_1_3:1.63
	SHIELA_1_1_2:1.61
	SHIELA_1_1_1:1.56
	SHIELA_1_1_0:1.55
	SHIELA_1_0_4:1.50
	SHIELA_1_0_3:1.45
	SHIELA_1_0_2:1.40
	SHIELA_1_0_1:1.37
	SHIELA_1_0_0:1.35
	SHIELA_0_9_2:1.16
	SHIELA_0_9_1:1.3
	SHIELA_0_9_0:1.1.1.1
	vendor:1.1.1;
locks; strict;
comment	@# @;


1.73
date	2006.10.13.19.48.31;	author rse;	state Exp;
branches;
next	1.72;
commitid	o07spT3suQ46LyQr;

1.72
date	2006.07.25.13.00.52;	author rse;	state Exp;
branches;
next	1.71;
commitid	UTwOJP02yJXz4fGr;

1.71
date	2006.07.20.08.17.11;	author rse;	state Exp;
branches;
next	1.70;
commitid	aQSB5U4vj5FkFzFr;

1.70
date	2005.10.03.12.43.44;	author rse;	state Exp;
branches;
next	1.69;

1.69
date	2005.01.12.20.46.13;	author rse;	state Exp;
branches;
next	1.68;

1.68
date	2005.01.12.20.44.27;	author rse;	state Exp;
branches;
next	1.67;

1.67
date	2005.01.12.20.42.46;	author rse;	state Exp;
branches;
next	1.66;

1.66
date	2004.08.11.16.50.39;	author rse;	state Exp;
branches;
next	1.65;

1.65
date	2004.07.02.19.24.52;	author rse;	state Exp;
branches;
next	1.64;

1.64
date	2004.07.02.17.22.18;	author rse;	state Exp;
branches;
next	1.63;

1.63
date	2004.06.27.07.45.50;	author rse;	state Exp;
branches;
next	1.62;

1.62
date	2004.06.27.07.44.03;	author rse;	state Exp;
branches;
next	1.61;

1.61
date	2004.05.10.18.14.12;	author rse;	state Exp;
branches;
next	1.60;

1.60
date	2004.05.10.18.13.01;	author rse;	state Exp;
branches;
next	1.59;

1.59
date	2004.05.10.18.01.03;	author rse;	state Exp;
branches;
next	1.58;

1.58
date	2004.05.10.17.57.48;	author rse;	state Exp;
branches;
next	1.57;

1.57
date	2004.05.10.17.54.05;	author ms;	state Exp;
branches;
next	1.56;

1.56
date	2004.05.10.13.38.24;	author rse;	state Exp;
branches;
next	1.55;

1.55
date	2004.05.07.07.48.01;	author rse;	state Exp;
branches;
next	1.54;

1.54
date	2004.05.07.06.27.07;	author rse;	state Exp;
branches;
next	1.53;

1.53
date	2004.05.06.19.45.39;	author rse;	state Exp;
branches;
next	1.52;

1.52
date	2004.05.05.13.11.43;	author rse;	state Exp;
branches;
next	1.51;

1.51
date	2004.05.05.13.07.21;	author rse;	state Exp;
branches;
next	1.50;

1.50
date	2002.12.23.14.45.16;	author rse;	state Exp;
branches;
next	1.49;

1.49
date	2002.12.23.14.42.23;	author rse;	state Exp;
branches;
next	1.48;

1.48
date	2002.12.23.14.33.55;	author rse;	state Exp;
branches;
next	1.47;

1.47
date	2002.12.23.14.21.57;	author rse;	state Exp;
branches;
next	1.46;

1.46
date	2002.12.23.14.08.38;	author rse;	state Exp;
branches;
next	1.45;

1.45
date	2002.12.23.13.10.56;	author rse;	state Exp;
branches;
next	1.44;

1.44
date	2002.12.23.12.13.27;	author rse;	state Exp;
branches;
next	1.43;

1.43
date	2002.12.23.11.50.09;	author rse;	state Exp;
branches;
next	1.42;

1.42
date	2002.12.23.11.32.05;	author rse;	state Exp;
branches;
next	1.41;

1.41
date	2002.12.23.11.21.42;	author rse;	state Exp;
branches;
next	1.40;

1.40
date	2002.12.23.09.13.41;	author rse;	state Exp;
branches;
next	1.39;

1.39
date	2002.12.23.09.09.40;	author rse;	state Exp;
branches;
next	1.38;

1.38
date	2002.12.23.08.52.22;	author rse;	state Exp;
branches;
next	1.37;

1.37
date	2002.12.23.08.50.34;	author rse;	state Exp;
branches;
next	1.36;

1.36
date	2002.12.22.19.32.28;	author rse;	state Exp;
branches;
next	1.35;

1.35
date	2002.12.22.17.37.28;	author rse;	state Exp;
branches;
next	1.34;

1.34
date	2002.12.22.17.10.26;	author rse;	state Exp;
branches;
next	1.33;

1.33
date	2002.12.22.16.30.14;	author rse;	state Exp;
branches;
next	1.32;

1.32
date	2002.12.22.15.04.00;	author rse;	state Exp;
branches;
next	1.31;

1.31
date	2002.12.22.15.01.17;	author rse;	state Exp;
branches;
next	1.30;

1.30
date	2002.12.22.11.19.48;	author rse;	state Exp;
branches;
next	1.29;

1.29
date	2002.12.22.11.10.42;	author rse;	state Exp;
branches;
next	1.28;

1.28
date	2002.12.22.11.06.50;	author rse;	state Exp;
branches;
next	1.27;

1.27
date	2002.12.21.17.02.59;	author rse;	state Exp;
branches;
next	1.26;

1.26
date	2002.12.21.12.38.55;	author rse;	state Exp;
branches;
next	1.25;

1.25
date	2002.12.21.12.23.31;	author rse;	state Exp;
branches;
next	1.24;

1.24
date	2002.12.21.11.40.34;	author rse;	state Exp;
branches;
next	1.23;

1.23
date	2002.12.21.11.29.22;	author rse;	state Exp;
branches;
next	1.22;

1.22
date	2002.12.21.11.24.17;	author rse;	state Exp;
branches;
next	1.21;

1.21
date	2002.12.21.11.00.17;	author rse;	state Exp;
branches;
next	1.20;

1.20
date	2002.12.21.10.32.40;	author rse;	state Exp;
branches;
next	1.19;

1.19
date	2002.12.21.09.53.16;	author rse;	state Exp;
branches;
next	1.18;

1.18
date	2002.12.21.09.42.57;	author rse;	state Exp;
branches;
next	1.17;

1.17
date	2002.12.21.09.20.27;	author rse;	state Exp;
branches;
next	1.16;

1.16
date	2002.08.19.19.10.38;	author rse;	state Exp;
branches;
next	1.15;

1.15
date	2001.12.31.15.00.32;	author rse;	state Exp;
branches;
next	1.14;

1.14
date	2001.12.16.18.16.00;	author rse;	state Exp;
branches;
next	1.13;

1.13
date	2001.12.06.10.13.58;	author rse;	state Exp;
branches;
next	1.12;

1.12
date	2001.12.03.11.39.49;	author rse;	state Exp;
branches;
next	1.11;

1.11
date	2001.08.30.07.41.03;	author rse;	state Exp;
branches;
next	1.10;

1.10
date	2001.05.22.19.26.12;	author rse;	state Exp;
branches;
next	1.9;

1.9
date	2001.05.12.07.26.54;	author rse;	state Exp;
branches;
next	1.8;

1.8
date	2001.05.12.07.24.16;	author rse;	state Exp;
branches;
next	1.7;

1.7
date	2001.05.11.19.53.45;	author rse;	state Exp;
branches;
next	1.6;

1.6
date	2001.05.04.15.06.55;	author rse;	state Exp;
branches;
next	1.5;

1.5
date	2001.05.04.13.33.53;	author rse;	state Exp;
branches;
next	1.4;

1.4
date	2001.05.04.13.25.18;	author rse;	state Exp;
branches;
next	1.3;

1.3
date	2001.02.10.16.40.26;	author rse;	state Exp;
branches;
next	1.2;

1.2
date	2000.07.18.15.24.27;	author rse;	state Exp;
branches;
next	1.1;

1.1
date	2000.06.18.14.30.52;	author rse;	state Exp;
branches
	1.1.1.1;
next	;

1.1.1.1
date	2000.06.18.14.30.52;	author rse;	state Exp;
branches;
next	;


desc
@@


1.73
log
@fix typo
@
text
@#!@@PERL@@ -w
##
##  OSSP shiela - CVS Access Control and Logging Facility
##  Copyright (c) 2000-2006 Ralf S. Engelschall <rse@@engelschall.com>
##  Copyright (c) 2000-2006 The OSSP Project <http://www.ossp.org/>
##
##  This file is part of OSSP shiela, an access control and logging
##  facility for Concurrent Versions System (CVS) repositories
##  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 <rse@@engelschall.com>.
##
##  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 $cmd = sprintf("%s --version 2>/dev/null", &qsa($RT->{cvs}));
    my $v = `$cmd`;
    $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.
##
##  <config>    ::= <directive>
##                | <config> <directive>
##  <directive> ::= <name> ';'
##                | <name> <args> ';'
##  <args>      ::= <arg>
##                | <args> <arg>
##  <arg>       ::= '{' <config> '}'
##                | [^ \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}, sprintf("%s -f -Q -n server", &main::qsa($program)))
        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;
    my $cmd = sprintf("%s -oi -oem %s", &main::qsa($RT->{sendmail}), &main::qsa($toaddr));
    open($sm->{fd}, "|$cmd");
    print "sendmail: spawned \"$cmd\"\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;
    }
}

#   quote shell argument
sub qsa {
    my ($arg) = @@_;

    #   remove NUL characters at all because
    #   - sh:   removes silenty      (strange)
    #   - bash: removes silenty      (strange)
    #   - ksh:  complains and aborts (problem)
    #   - zsh:  keeps as-is          (ok)
    #   all(!) other characters in the range 0x00-0xff are safe to be
    #   passed through the shell when single quoted as explicit tests
    #   with all(!) characters under sh, bash, ksh and zsh showed.
    $arg =~ s/\x00//sg;
    
    #   single quote argument by
    #   1. escape "single quote" character by
    #      - temporarily ending single quotation
    #      - double quoting "single quote" character
    #      - restarting single quotation
    #   2. embedding remaining string into single quotes
    $arg =~ s/'/'"'"'/sg;
    $arg = "'$arg'";
    
    return $arg;
}   

##  _________________________________________________________________
##
##  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 sprintf("%s -f -Q -n status %s|", &qsa($RT->{cvs}), join(' ', map { &qsa($_) } @@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 <op>,<file>,
##  _________________________________________________________________
##

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 (<STDIN>);

    #   usually the operation is a regular commit for files
    $RT->{cvsop} = 'commit-file';

    #   handle special invocation under `cvs add <dir>'
    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 <dir>' 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 <dir>'. 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 sprintf("%s -f -Q -n log -r%s %s|", &qsa($RT->{cvs}), &qsa($It), &qsa($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 sprintf("%s -f -Q -n log %s|", &qsa($RT->{cvs}), &qsa($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 sprintf("%s -f -Q -n log -r%s %s|", &qsa($RT->{cvs}), &qsa($Iv), &qsa($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 sprintf("%s -f -Q -n update -p -r%s %s|", &qsa($RT->{cvs}), &qsa($Iv), &qsa($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 .=
                        "<shiela:patch $cvsdir/$Is>\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(sprintf("%s delta %s.null %s.all %s.xdelta >/dev/null 2>&1",
                           &qsa($RT->{xdelta}), &qsa($RT->{tmpfile}), &qsa($RT->{tmpfile}), &qsa($RT->{tmpfile})));
                    $io = new IO::File sprintf("%s %s.xdelta %s.xdelta|", &qsa($RT->{uuencode}), &qsa($RT->{tmpfile}), &qsa($Is))
                        or die "unable to open uuencode command pipe for reading";
                    $cvsdiff .= $_ while (<$io>);
                    $io->close;
                    $cvsdiff .= "@@@@ .\n";
                    $cvsdiff .= "</shiela:patch>\n";
                    unlink("$RT->{tmpfile}.null");
                    unlink("$RT->{tmpfile}.xdelta");
                }
            }
            else {
                #   generate textual change patch script
                if ($RT->{diff}) {
                    $cvsdiff .=
                        "<shiela:patch $cvsdir/$Is>\n" .
                        "patch -p0 <<'@@@@ .'\n" .
                        "Index: $cvsdir/$Is\n" .
                        ("=" x 76) . "\n" .
                        "\$ cvs diff -u -r0 -r$Iv $Is\n";
                    my $diff = '';
                    my $io = new IO::File sprintf("%s -u /dev/null %s.all|", &qsa($RT->{diff}), &qsa($RT->{tmpfile}))
                        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 .= "</shiela:patch>\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 sprintf("%s -f -Q -n update -p -r%s %s|", &qsa($RT->{cvs}), &qsa($IV), &qsa($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 sprintf("%s -f -Q -n update -p -r%s %s|", &qsa($RT->{cvs}), &qsa($Iv), &qsa($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 .=
                        "<shiela:patch $cvsdir/$Is>\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(sprintf("%s delta %s.old %s.new %s.xdelta >/dev/null 2>&1",
                        &qsa($RT->{xdelta}), &qsa($RT->{tmpfile}), &qsa($RT->{tmpfile})));
                    $io = new IO::File sprintf("%s %s.xdelta %s.xdelta|", &qsa($RT->{uuencode}), &qsa($RT->{tmpfile}), &qsa($Is))
                        or die "unable to open uuencode command pipe for reading";
                    $cvsdiff .= $_ while (<$io>);
                    $io->close;
                    $cvsdiff .= "@@@@ .\n";
                    $cvsdiff .= "</shiela:patch>\n";
                    unlink("$RT->{tmpfile}.xdelta");

                    #   cleanup
                    unlink("$RT->{tmpfile}.old");
                    unlink("$RT->{tmpfile}.new");
                }
            }
            else {
                #   generate textual change patch script
                my $d = '';
                if (not $RT->{useserver}) {
                    my $io = new IO::File sprintf("%s -f -Q -n diff -u -r%s -r%s %s|", &qsa($RT->{cvs}), &qsa($IV), &qsa($Iv), &qsa($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 .=
                    "<shiela:patch $cvsdir/$Is>\n" .
                    "patch -p0 <<'@@@@ .'\n" .
                    "Index: $cvsdir/$Is\n" .
                    ("=" x 76) . "\n" .
                    "\$ cvs diff -u -r$IV -r$Iv $Is\n" .
                    $d .
                    "@@@@ .\n" .
                    "</shiela:patch>\n";
            }
        }
        elsif ($Io eq 'R') {
            ##
            ##   REMOVED FILE
            ##

            #   generate binary and textaual change patch script
            $cvsdiff .=
                "<shiela:patch $cvsdir/$Is>\n" .
                "rm -f $cvsdir/$Is <<'@@@@ .'\n" .
                "Index: $cvsdir/$Is\n" .
                ("=" x 76) . "\n" .
                "[NO CHANGE SUMMARY BECAUSE FILE AS A WHOLE IS JUST REMOVED]\n" .
                "@@@@ .\n" .
                "</shiela:patch>\n";
        }

        $info = "$cvsdir/$Is,$IV,$Iv,$It,$Io,$Ik,$ID,$Id";
        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<shiela:patch\s+${Is_quoted}>\n(.+?\n)</shiela:patch>|$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;
}

@


1.72
log
@Fix "arbitrary shell command execution" security bug caused by
missing shell command argument escaping for user supplied arguments.

Submitted by: Brian Caswell <bmc@@shmoo.com>, Sourcefire
@
text
@d63 1
a63 1
    print STDERR "cvs:shiela::ERROR: ". $text . ($! ? " ($!)" : "") . "\n";
@


1.71
log
@Adjust copyright messages for new year 2006 and upgrade build environment.
@
text
@d210 2
a211 1
    my $v = `$RT->{cvs} --version 2>/dev/null`;
d584 1
a584 1
    $cvs->{pid} = IPC::Open2::open2($cvs->{rfd}, $cvs->{wfd}, "$program -f -Q -n server")
d743 3
a745 2
    open($sm->{fd}, "|$RT->{sendmail} -oi -oem $toaddr");
    print "sendmail: spawned \"$RT->{sendmail} -oi -oem $toaddr\"\n" if ($sm->{trace});
d848 26
d1279 1
a1279 1
        my $io = new IO::File "$RT->{cvs} -f -Q -n status ".join(' ', @@cvsfiles)."|"
d1524 1
a1524 1
                my $io = new IO::File "$RT->{cvs} -f -Q -n log -r$It '$Is'|"
d1646 1
a1646 1
                my $io = new IO::File "$RT->{cvs} -f -Q -n log '$Is'|"
d1669 1
a1669 1
                my $io = new IO::File "$RT->{cvs} -f -Q -n log -r$Iv '$Is'|"
d1740 1
a1740 1
                my $cvs = new IO::File "$RT->{cvs} -f -Q -n update -p -r$Iv '$Is'|"
d1780 3
a1782 3
                    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 |"
d1802 1
a1802 1
                    my $io = new IO::File "$RT->{diff} -u /dev/null $RT->{tmpfile}.all|"
d1831 1
a1831 1
                        my $cvs = new IO::File "$RT->{cvs} -f -Q -n update -p -r$IV '$Is'|"
d1852 1
a1852 1
                        my $cvs = new IO::File "$RT->{cvs} -f -Q -n update -p -r$Iv '$Is'|"
d1879 3
a1881 3
                    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 |"
d1898 1
a1898 1
                    my $io = new IO::File "$RT->{cvs} -f -Q -n diff -u -r$IV -r$Iv '$Is'|"
@


1.70
log
@flush pending changes
@
text
@d4 2
a5 2
##  Copyright (c) 2000-2005 Ralf S. Engelschall <rse@@engelschall.com>
##  Copyright (c) 2000-2005 The OSSP Project <http://www.ossp.org/>
d29 1
a29 1
my $version = '1.1.6';
@


1.69
log
@Adjust copyright messages for new year 2005.
@
text
@d29 1
a29 1
my $version = '1.1.5';
@


1.68
log
@bump version number
@
text
@d4 2
a5 2
##  Copyright (c) 2000-2004 Ralf S. Engelschall <rse@@engelschall.com>
##  Copyright (c) 2000-2004 The OSSP Project <http://www.ossp.org/>
@


1.67
log
@1. Fix internal error handling by replacing "|| die" with "or die"
constructs because the different binding priority of "||" and "or"
leaded to wrong results.

2. Fix shiela-install.pod's description of --loginfo hook for the
non-RSE-patches situation: the %p construct has to be used there, too.
@
text
@d29 1
a29 1
my $version = '1.1.4';
@


1.66
log
@Workaround a buggy feature in Perl versions 5.8.4 and higher
which totally optimized away "my $var = undef;" constructs
instead of optimizing them to just "my $var;".
@
text
@d130 2
a131 2
    $RT->{cvsroot} = $ENV{CVSROOT} || die 'unknown CVS root (set $CVSROOT variable)';
    $RT->{userid}  = $ENV{CVSUSER} || $ENV{LOGNAME} || $ENV{LOGUSER} || $ENV{USER} || die 'unknown CVS user';
d382 1
a382 1
        || die "unable to open configuration file `$file'";
d570 2
a571 2
    my $program = shift || "cvs";
    my $cvsroot = shift || $ENV{CVSROOT} || die "unknown CVSROOT";
d584 1
a584 1
        || die "cannot spawn CVS server process `$program server'";
d825 1
a825 1
            || die "unable to open `$file' for operation `$op'";
d836 1
a836 1
            || die "unable to open `$file' for $op";
d874 1
a874 1
         || die "cannot store information to history db `$RT->{historydb}'";
d906 1
a906 1
            || die "invalid file specification `$file' for access control";
d1252 1
a1252 1
            || die "unable to open CVS command pipe for reading";
d1343 1
a1343 1
        || die "cannot open message file `$logfile' for reading";
d1354 1
a1354 1
        || die "cannot open message file `$logfile' for writing";
d1497 1
a1497 1
                    || die "unable to open CVS command pipe for reading";
d1586 1
a1586 1
                || die "invalid loginfo argument `$info' while extending stock CVS information";
d1606 1
a1606 1
            || die "invalid loginfo argument `$info' while extending summary information";
d1619 1
a1619 1
                    || die "unable to open CVS command pipe for reading";
d1642 1
a1642 1
                    || die "unable to open CVS command pipe for reading";
d1709 1
a1709 1
                || die "unable to open temporary file $RT->{tmpfile}.all for writing";
d1713 1
a1713 1
                    || die "unable to open CVS command pipe for reading";
d1750 1
a1750 1
                        || die "unable to open temporary file $RT->{tmpfile}.null for writing";
d1755 1
a1755 1
                        || die "unable to open uuencode command pipe for reading";
d1775 1
a1775 1
                        || die "unable to open CVS command pipe for reading";
d1801 1
a1801 1
                        || die "unable to open temporary file $RT->{tmpfile}.old for writing";
d1804 1
a1804 1
                            || die "unable to open CVS command pipe for reading";
d1822 1
a1822 1
                        || die "unable to open temporary file $RT->{tmpfile}.new for writing";
d1825 1
a1825 1
                            || die "unable to open CVS command pipe for reading";
d1854 1
a1854 1
                        || die "unable to open uuencode command pipe for reading";
d1871 1
a1871 1
                        || die "unable to open CVS command pipe for reading";
d1966 1
a1966 1
             || die "invalid loginfo argument `$cvsinfo' while accumulating information";
d2071 1
a2071 1
                my $io = new IO::File ">>$logurl" || die "cannot append log message to `$logurl'";
d2120 1
a2120 1
    my $RP = $CF->{Logging}->{Report}->{$type} || die "No report of type `$type' defined";
@


1.65
log
@bump before release
@
text
@d1962 2
a1963 2
    my $handle_min = undef;
    my $handle_max = undef;
@


1.64
log
@Fix determination of the "handle" field under new CVS 1.12.x
where ISO format dates are used in the output of "cvs log".
@
text
@d29 1
a29 1
my $version = '1.1.3';
@


1.63
log
@bump to version 1.1.3 for release
@
text
@d1665 1
a1665 1
        if ($rcslog =~ m|\ndate:\s+(\d\d\d\d)/(\d\d)/(\d\d)\s+(\d\d):(\d\d):(\d\d);|s) {
@


1.62
log
@Fix determination of the line counts in the "Changes" field
by no longer announcing to the CVS server that OSSP shiela can
handle "MT" (message tagged) responses. The problem is CVS 1.12.x
starts to send some important responses as "MT" responses now and
OSSP shiela only accepts "M" responses.

Determined by: Geoff Thorpe <geoff@@geoffthorpe.net>
@
text
@d29 1
a29 1
my $version = '1.1.2';
@


1.61
log
@bump to version 1.1.2 for release
@
text
@d596 1
a596 1
        "Module-expansion Wrapper-rcsOption M Mbinary E F MT");
@


1.60
log
@fix previous commit
@
text
@d29 1
a29 1
my $version = '1.1.1';
@


1.59
log
@Fixed two more warnings about undefined variables.

Submitted by: Michael Schloh von Bennewitz
@
text
@d1733 1
a1733 1
            $Id = sprintf("+%d/-%d", $l, 0) if ($Ik eq 'b' or -B $Is);
@


1.58
log
@Optimize and bugfix the determination of the number of lines in case of
added files.

This especially fixes the following error:

| Use of uninitialized value in <HANDLE> at /e/openpkg/cvs/CVSROOT/shiela line 1679.
| readline() on unopened filehandle at /e/openpkg/cvs/CVSROOT/shiela line 1679.
| cvs:shiela::ERROR: Can't call method "close" on an undefined value (No such file or directory)
@
text
@d1443 1
a1443 1
    if ($PA->{ARG}->[1] eq '- New directory') { # see CVS' src/add.c
d1459 1
a1459 1
    if ($PA->{ARG}->[1] eq '- Imported sources') { # see CVS' src/import.c
@


1.57
log
@correct spelling of convenience
@
text
@d1677 2
a1678 5
                my $io = new IO::File "<$Is" || die "unable to open $Is for reading";
                my $l = 0;
                $l++ while (<$io>);
                $io->close;
                $Id = sprintf("+%d/-%d", $l, 0);
d1710 1
d1714 4
a1717 1
                $io->print($_) while (<$cvs>);
d1726 2
a1727 1
                $io->print(scalar $cvs->result);
d1729 3
d1733 1
@


1.56
log
@Workaround a syntax problem on Solaris /bin/sh.

Submitted by: Michael Schloh
@
text
@d371 1
a371 1
##  created by parse_config() above. But for convinience reasons and
d559 1
a559 1
##  process and act as we would be a regular CVS client. For convinience
d661 1
a661 1
#   convinience wrapper: receive a response
d677 1
a677 1
#   convinience wrapper: provide a file entry
d687 1
a687 1
#   convinience wrapper: provide one or more global options
d696 1
a696 1
#   convinience wrapper: provide one or more arguments
d705 1
a705 1
#   convinience wrapper: configure a directory
d814 1
a814 1
##  This is nothing more than a convinience function for
@


1.55
log
@avoid unused variables
@
text
@d29 1
a29 1
my $version = '1.1.0';
@


1.54
log
@bump version number
@
text
@d644 1
a644 1
         my @@lines = $cvs->{rfd}->getlines;
d654 1
a654 1
         my $line = $cvs->{rfd}->getline;
@


1.53
log
@flush the whole bunch of my fixes and cleanups
@
text
@d29 1
a29 1
my $version = '1.0.4';
@


1.52
log
@Bump year in copyright messages for 2003 and 2004
@
text
@d215 1
a215 1
    die "$RT->{cvs} is not at least CVS 1.10" if ($RT->{cvsvers} !~ m|^1\.1[0-9]|);
d1428 6
a1433 1
    my ($cvsdir, @@cvsinfo) = split(/\s+/, $PA->{ARG}->[0]);
d1443 1
a1443 1
    if (join(' ', @@cvsinfo) eq '- New directory') { # see CVS' src/add.c
d1459 1
a1459 1
    if (join(' ', @@cvsinfo) eq '- Imported sources') { # see CVS' src/import.c
d2253 1
d2263 1
a2263 1
                    $O .= "$prefix$url\n";
d2267 1
a2267 1
                $O .= "To re-generate the difference summary of this commit, execute:\n";
d2269 14
a2282 5
                    $O .= "cvs rdiff -uN " .
                          " -r" . $IN->{file}->{$file}->{oldrev} .
                          " -r" . $IN->{file}->{$file}->{newrev} .
                          " " . $file .
                          "\n";
@


1.51
log
@Flush pending changes:
- Provide "cvs rdiff" support in diff outputs.
- Support CVS 1.12.x (option -l no longer existing).
@
text
@d4 2
a5 2
##  Copyright (c) 2000-2002 Ralf S. Engelschall <rse@@engelschall.com>
##  Copyright (c) 2000-2002 The OSSP Project <http://www.ossp.org/>
@


1.50
log
@bump to version 1.0.4 for release
@
text
@d583 1
a583 1
    $cvs->{pid} = IPC::Open2::open2($cvs->{rfd}, $cvs->{wfd}, "$program -Q -l -n server")
d1251 1
a1251 1
        my $io = new IO::File "$RT->{cvs} -f -l -Q -n status ".join(' ', @@cvsfiles)."|"
d1258 1
a1258 1
        $cvs->global_options("-l", "-Q", "-n");
d1491 1
a1491 1
                my $io = new IO::File "$RT->{cvs} -f -l -Q -n log -r$It '$Is'|"
d1613 1
a1613 1
                my $io = new IO::File "$RT->{cvs} -f -l -Q -n log '$Is'|"
d1636 1
a1636 1
                my $io = new IO::File "$RT->{cvs} -f -l -Q -n log -r$Iv '$Is'|"
d1672 1
a1672 1
                my $io = new IO::File "<$Is" || die "unable open $Is for reading";
d1709 1
a1709 1
                my $cvs = new IO::File "$RT->{cvs} -f -l -Q -n update -p -r$Iv '$Is'|"
d1792 1
a1792 1
                        my $cvs = new IO::File "$RT->{cvs} -f -l -Q -n update -p -r$IV '$Is'|"
d1813 1
a1813 1
                        my $cvs = new IO::File "$RT->{cvs} -f -l -Q -n update -p -r$Iv '$Is'|"
d1859 1
a1859 1
                    my $io = new IO::File "$RT->{cvs} -f -l -Q -n diff -u -r$IV -r$Iv '$Is'|"
d2258 10
@


1.49
log
@polish sources a little bit more
@
text
@d29 1
a29 1
my $version = '1.0.3';
@


1.48
log
@switch to bar character to be more similar to CVSROOT/history
@
text
@d63 1
a63 2
    my $name = ($0 =~ m|^.*?([^/]+?)(?:\.[^/.]+)?$|)[0];
    print STDERR $name.":ERROR: $text" . ($! ? " ($!)" : "") . "\n";
d70 1
a70 1
my $CF = &cf_determine(($PA->{OPT}->{config} || $RT->{cvsadmdir}."/$RT->{name}.cfg"));
d381 2
a382 1
    my $io = new IO::File "<$file" || die "unable to open configuration file `$file'";
d882 2
a883 2
    # XXX STILL MISSING, BECAUSE NOT USED XXX
    # XXX HAS TO RE-DETERMINE DIFF AND LOG INFORMATION XXX
d973 1
a973 1
    #   remove common empty fields
d1540 1
a1540 1
    if (    (   (    defined($cvsinfo[0]) 
@


1.47
log
@Log also the user id of the committer in the OSSP shiela logfile
to remove the burden on foreign applications having to merge
the CVSROOT/history and the shiela logfile in order to get all
information.
@
text
@d862 9
a870 9
        $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};
@


1.46
log
@1. Added "Setenv <variable <value>" configuration command to
"Environment" configuration section which allows one to set
environment variables like PATH, etc. This especially allows now
non-absolute paths on "Program" configuration commands.

2. Fixed indentation on "Content files" report part.
@
text
@d862 2
a863 1
        $O .= ",$file";
@


1.45
log
@bump to version 1.0.3 for release
@
text
@d57 1
d102 1
a102 1
    die "unknown hook (use --hook option)";
d167 5
d176 1
a176 1
        foreach my $dir (split(/:/, "$ENV{PATH}:/bin:/usr/bin:/sbin:/usr/sbin")) {
d402 2
a403 1
            'Program' => {}
d462 3
d2161 1
a2161 1
                        $O .= $prefix."$header:\n";
d2164 1
a2164 1
                        $O .= $prefix.sprintf("%-25s %s\n", "$header:", "(Branch: $branch)");
d2186 1
a2186 1
                    if ($col+length($file)+1 > 78) {
d2192 3
a2194 2
                            if (length($dir) > 25) {
                                $O .= $prefix.sprintf("%s\n$prefix%-25s", "  $dir", "");
d2197 1
a2197 1
                                $O .= $prefix.sprintf("%-25s", "  $dir");
d2202 1
a2202 1
                            $O .= $prefix.sprintf("%-25s", "");
d2204 1
a2204 1
                        $col += length($prefix)+25;
d2206 2
a2207 2
                    $O .= " $file";
                    $col += length($file)+1;
@


1.44
log
@CVS since 1.11.2 allows verifymsg-hooked scripts to actually
change the message and reads the contents back. So we do no longer
require CVS with RSE patches applied for the verifymsg hook to be
activated.
@
text
@d29 1
a29 1
my $version = '1.0.2';
@


1.43
log
@Make sure that the header in reports is not optically destroyed by
too long columns (as it is the case all the time for PMOD commits
in the OpenPKG project).
@
text
@d1313 6
a1318 6
##  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 RSE
##  patches, the log message is changed and CVS reads back the contents
##  so that this script can actually make changes.
a1327 3

    #   we require the RSE patches for operation
    return $rv if (not $RT->{cvsrse});
@


1.42
log
@1. Correctly recognize and configure RSE CVS version in shiela-install
program.

2. Be smart and allow a RSE CVS version to be driven like a stock CVS
version in loginfo (still using "sVv" instead of "sVvto" as the flags).
@
text
@d1017 17
d2094 2
a2095 2
    $IN->{cvsbranch} = join(', ', keys(%cvsbranches));
    $IN->{cvsmodule} = join(', ', keys(%cvsmodules));
d2124 9
a2132 2
            my $date = sprintf("%02d-%s-%04d %02d:%02d:%02d",
                               $mday, $moy[$mon], 1900+$year, $hour, $min, $sec);
d2134 4
a2137 4
                $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});
@


1.41
log
@fix comment
@
text
@d1296 1
a1296 1
##  We hook into CVS via `verifymsg' to post-process log messages.
d1515 4
a1518 1
    if (not $RT->{cvsrse} and not $RT->{cvsop} eq 'import') {
@


1.40
log
@bump to version 1.0.2 for release
@
text
@d1296 1
a1296 1
##  We hook into CVS via `commitinfo' to post-process log messages.
@


1.39
log
@1. Make sure that /bin:/usr/bin:/sbin:/usr/sbin is in $PATH when
locating tool.

2. Correctly use the path in "Program uuencode <path>" when running
uuencode.
@
text
@d29 1
a29 1
my $version = '1.0.1';
@


1.38
log
@Avoid over-sized lines in xdelta based patch scripts.
@
text
@d170 1
a170 1
        foreach my $dir (split(/:/, "$ENV{PATH}:/usr/local/lib:/usr/lib:/lib")) {
d1715 1
a1715 1
                    $io = new IO::File "uuencode $RT->{tmpfile}.xdelta $Is.xdelta |"
d1814 1
a1814 1
                    $io = new IO::File "uuencode $RT->{tmpfile}.xdelta $Is.xdelta |"
@


1.37
log
@flush pending changes
@
text
@d1702 2
a1703 1
                        "(cd $cvsdir && uudecode <<'@@@@ .' && \\\n" .
d1804 4
a1807 2
                        "(cd $cvsdir && uudecode <<'@@@@ .' && \\\n" .
                        " mv $Is $Is.orig && xdelta patch $Is.xdelta $Is.orig $Is && \\\n" .
@


1.36
log
@Fixed run-time under Perl 5.8.0: import only abs_path()
from module Cwd to avoid conflicts with POSIX module.
@
text
@d29 1
a29 1
my $version = '1.0.0';
@


1.35
log
@bump for release
@
text
@d33 7
a39 7
use strict;       # shipped with Perl since 5.000
use POSIX;        # shipped with Perl since 5.000
use IO::File;     # shipped with Perl since 5.003
use IO::Handle;   # shipped with Perl since 5.003
use IPC::Open2;   # shipped with Perl since 5.003
use Data::Dumper; # shipped with Perl since 5.005
use Cwd;          # shipped with Perl since 5.005
@


1.34
log
@1. Add branch information to the Subject lines of generated Emails.
Additionally, for better readability, use a trailing slash on directory
names in the Subject lines of generated Emails.

2. Use Cwd::abs_path instead of Cwd::realpath because the latter is
not available in older Cwd.pm versions (as those distributed with Perl
5.005, etc).
@
text
@d29 1
a29 1
my $version = '0.9.3';
@


1.33
log
@Line-break single-line log messages into multi-line log messages
to make the usual log messages produced by "cvs commit -m '...'"
more readable in the report.
@
text
@d39 1
a39 1
use Cwd;          # shipped with Perl since 5.003
d1039 1
a1039 1
    my $cvsdirphysical = Cwd::realpath($RT->{cvsroot});
d1995 1
d1998 6
d2005 1
d2007 1
a2007 1
                        $subject .= " $dir";
@


1.32
log
@simplify command
@
text
@d982 35
d2173 4
a2176 1
            $log =~ s|^|$prefix  |mg;
@


1.31
log
@cleanup version stuff
@
text
@d1830 1
a1830 1
                "(cat <<'@@@@ .' >/dev/null && rm -f $cvsdir/$Is)\n" .
@


1.30
log
@talk about changes, not commits
@
text
@d29 1
a29 1
my $version = '0.9.3 (21-Dec-2002)';
d737 1
a737 2
        "User-Agent: ".uc(substr($RT->{name}, 0, 1)).substr($RT->{name}, 1)."/$RT->{vers} " .
                     "CVS/".$RT->{cvsvers}.($RT->{cvsrse} ? "+RSE" : "")."\n" .
@


1.29
log
@remove trailing whitespaces
@
text
@d2213 1
a2213 1
             "Content-Description: commit summary\n" .
@


1.28
log
@Fully reimplemented the "Content" "details" (the change summary in
reports). It now supports both textual (via diff(1)) and binary
(via xdelta(1)) file changes. Additionally each change report part
is now a small executable shell-script which can passed through
/bin/sh for reproducing the patch locally. This way, especially
binary change reports are more meaningsful and consistent with the
textual change reports.
@
text
@d12 2
a13 2
##  modify it under the terms of the GNU General Public  License 
##  as published by the Free Software Foundation; either version 
d21 1
a21 1
##  You should have received a copy of the GNU General Public License 
d108 1
a108 1
##  
d121 1
a121 1
    #   program version and name 
d180 1
a180 1
                      &find_program("sendmail") || 
d183 1
a183 1
                      &find_program("cvs") || 
d189 1
a189 1
                      &find_program("xdelta") || 
d192 1
a192 1
                      &find_program("uuencode") || 
d225 1
a225 1
##  <config>    ::= <directive> 
d301 1
a301 1
                    push(@@{$A}, $a) if ($a ne ''); 
d405 1
a405 1
                $CF->{$1}->{$a->[0]} = $a->[1] 
d513 1
a513 1
        #   so just make sure it is anchored 
d542 1
a542 1
##  CVS server communication. 
d552 1
a552 1
## 
d564 1
a564 1
    #   spawn a CVS server process and establish a 
d625 1
a625 1
        $data =~ s|^|cvs server: -> |mg; 
d734 1
a734 1
    $sm->{header} = 
d741 1
a741 1
        "Content-Type: text/plain; charset=iso-8859-1\n" . 
d895 1
a895 1
        $file =~ m|^([^/]+)/(.*):([^:]+)$| 
d927 1
a927 1
                                    and ($g eq '*' or grep(m/^$g$/, @@groups))) 
d1008 1
a1008 1
    #   provide access control 
d1016 1
a1016 1
        print "cvs tag: Access Denied - Insufficient Karma!\n"; 
d1065 1
a1065 1
    #   provide access control 
d1073 1
a1073 1
        print "cvs admin: Access Denied - Insufficient Karma!\n"; 
d1121 1
a1121 1
    #   provide access control 
d1129 1
a1129 1
        print "cvs import: Access Denied - Insufficient Karma!\n"; 
d1219 1
a1219 1
    #   provide access control 
d1227 1
a1227 1
        print "cvs commit: Access Denied - Insufficient Karma!\n"; 
d1300 1
a1300 1
    unlink("${logfile}~");    
d1333 1
a1333 1
        my ($lastdir) = &do_file('read', "$RT->{tmpfile}.lastdir", ''); 
d1367 1
a1367 1
    
d1506 1
a1506 1
            
d1570 1
a1570 1
        #   read file log entry   
d1605 1
a1605 1
        if ($Ik eq 'b' or -B $Is) { 
d1663 1
a1663 1
            if ($Ik eq 'b' or -B $Is) { 
d1666 1
a1666 1
                    $cvsdiff .= 
d1693 1
a1693 1
                    $cvsdiff .= 
d1720 1
a1720 1
            if ($Ik eq 'b' or -B $Is) { 
d1767 1
a1767 1
                    $cvsdiff .= 
d1911 1
a1911 1
                                1900+$year, $mon+1, $mday, $hour, $min, $sec, 
d1975 1
a1975 1
                        $sm->header('Content-Type', 
d1999 1
a1999 1
    #   
d2002 1
a2002 1
    my $cvslist = {}; 
d2067 1
a2067 1
        
d2150 1
a2150 1
                                          $IN->{file}->{$file}->{newrev}, 
d2156 1
a2156 1
                $O .= $prefix.sprintf("  %-12s%-12s%s\n", $rev, $delta, $file);
@


1.27
log
@provide revision number also for removed files
@
text
@d186 5
a190 2
                      &find_program("diff") || 
                      die "unable to find `diff' program";
d193 1
a193 1
                      die "unable to find `uuencode' program";
d1636 1
a1636 1
        #   determine change diff
d1638 25
a1662 1
            #   file was added, so we show the whole contents
d1664 18
a1681 9
                #   file seems to be a binary file
                $cvsdiff .= 
                    "<Diff $cvsdir/$Is>\n" .
                    "Index: $cvsdir/$Is\n" .
                    "============================================================\n" .
                    "\$ cvs update -p -r$Iv $Is | uuencode $Is\n";
                if (not $RT->{useserver}) {
                    my $io = new IO::File "$RT->{cvs} -f -l -Q -n update -p -r$Iv '$Is' | uuencode '$Is' |"
                        || die "unable to open CVS command pipe for reading";
d1684 4
a1688 10
                else {
                    my $cvs = new CVS ($RT->{cvs}, $RT->{cvsroot});
                    $cvs->directory($cvsdir);
                    $cvs->entry($Is);
                    $cvs->arguments("-p", "-r$Iv", $Is);
                    $cvs->send("update");
                    $cvsdiff .= scalar $cvs->result;
                    $cvs->close;
                }
                $cvsdiff .= "</Diff>\n";
d1691 10
a1700 8
                #   file seems to be a regular text file
                $cvsdiff .= 
                    "<Diff $cvsdir/$Is>\n" .
                    "Index: $cvsdir/$Is\n" .
                    "============================================================\n" .
                    "\$ cvs update -p -r$Iv $Is\n";
                if (not $RT->{useserver}) {
                    my $io = new IO::File "$RT->{cvs} -f -l -Q -n update -p -r$Iv '$Is'|"
d1702 1
a1702 1
                    $cvsdiff .= $_ while (<$io>);
d1704 5
a1709 10
                else {
                    my $cvs = new CVS ($RT->{cvs}, $RT->{cvsroot});
                    $cvs->directory($cvsdir);
                    $cvs->entry($Is);
                    $cvs->arguments("-p", "-r$Iv", $Is);
                    $cvs->send("update");
                    $cvsdiff .= scalar $cvs->result;
                    $cvs->close;
                }
                $cvsdiff .= "</Diff>\n";
d1711 3
d1716 4
d1721 43
a1763 21
                #   file seems to be a binary file
                $cvsdiff .= 
                    "<Diff $cvsdir/$Is>\n" .
                    "Index: $cvsdir/$Is\n" .
                    "============================================================\n" .
                    "\$ cvs update -p -r$IV $Is >$Is.old\n" .
                    "\$ cvs update -p -r$Iv $Is >$Is.new\n" .
                    "\$ diff -u $Is.old $Is.new\n";
                if (not $RT->{useserver}) {
                    system("$RT->{cvs} -f -l -Q -n update -p -r$IV '$Is' | $RT->{uuencode} '$Is' >$Is.old");
                    system("$RT->{cvs} -f -l -Q -n update -p -r$Iv '$Is' | $RT->{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;
                    my $io = new IO::File ">$Is.old" || die "cannot write to $Is.old";
                    $io->print($data);
d1765 15
a1779 5
                    $cvs->arguments("-p", "-r$Iv", $Is);
                    $cvs->send("update");
                    $data = scalar $cvs->result;
                    $io = new IO::File ">$Is.new" || die "cannot write to $Is.old";
                    $io->print($data);
d1781 7
a1787 1
                    $cvs->close;
a1788 5
                my $io = new IO::File "$RT->{diff} -u $Is.old $Is.new|"
                    || die "unable to open diff command pipe for reading";
                $cvsdiff .= $_ while (<$io>);
                $io->close;
                $cvsdiff .= "</Diff>\n";
d1791 1
a1791 1
                #   file was modified, so we show the changed contents only
d1813 2
a1814 1
                    "<Diff $cvsdir/$Is>\n" .
d1816 1
a1816 1
                    "============================================================\n" .
d1819 2
a1820 1
                    "</Diff>\n";
d1824 13
a1836 8
            if ($Ik eq 'b' or -B $Is) { 
                #   file seems to be a binary file
                #   FIXME
            }
            else {
                #   file seems to be a regular file
                #   FIXME
            }
d1902 1
a1902 1
        $cvsdiff =~ s|\n<Diff\s+${Is_quoted}>\n(.+?\n)</Diff>|$e->{diff} = $1, ''|se;
d1974 1
a1974 1
                    if ($CF->{Logging}->{Report}->{$logtype}->{Details} eq 'diff:mime') {
d2038 1
a2038 1
    my $style = $RP->{Details} || 'diff:plain';
d2176 1
a2176 1
            elsif ($style eq 'diff:plain') {
d2184 1
a2184 1
            elsif ($style eq 'diff:mime') {
d2208 1
a2208 1
    if ($style eq 'diff:mime') {
a2223 1
##EOF##
@


1.26
log
@fix handle calculation for removed files again
@
text
@d1542 25
d1569 1
a1569 1
        if ($Io eq 'A' or $Io eq 'M') {
d1747 15
a1761 5
                     "Index: $cvsdir/$Is\n" .
                     "============================================================\n" .
                     "\$ cvs diff -u -r$IV -r$Iv $Is\n" .
                     $d .
                     "</Diff>\n";
a1817 5
        if ($Io eq 'R' and $ID eq '0') {
            #   CVS does not provide a commit time for removed files
            #   so use the current time as a replacement
            $ID = time();
        }
@


1.25
log
@fix Environment parsing
@
text
@d1783 5
@


1.24
log
@syntactical fixes and cosmetic
@
text
@d178 1
a178 1
    $RT->{sendmail} = $CF->{Environment}->{Program}->{cvs} ||
d182 1
a182 1
    $RT->{cvs}      = $CF->{Environment}->{Program}->{sendmail} ||
d448 3
@


1.23
log
@Make sure that CVS diff handles are calculated correctly
if files are added or deleted.
@
text
@d134 1
a134 1
    $RT->{tmpdir}   = $ENV{TMPDIR} || $ENV{TEMPDIR} || '/tmp';
d732 1
a732 1
                     "CVS/".$RT->{cvsvers}.($RT->{cvsrse} ? "+RSE" : "")."\n";
d809 2
a810 2
        my $io = new IO::File ($op eq 'append' ? ">>" : ">").$file
            || die "unable to open `$file' for $op";
@


1.22
log
@Fix incorrect use (and hence producing a warning for uninitialized
variable) of variables in the writing of history files.
@
text
@d1792 2
a1793 2
        $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));
@


1.21
log
@Finally really use the "Environment" configuration section to find
"cvs" and "sendmail" directly and add a "Program" sub-command to it
for easier extension of the "Environment" section in the future.

Additionally, replace more "Shiela" occurrences with "OSSP shiela".
@
text
@d844 1
a844 2
    my $file;
    foreach $file (keys(%{$IN->{file}})) {
d858 1
a858 1
         || die "cannot store information to history db `$file'";
@


1.20
log
@Consistently use IO objects instead of the anchient direct
fiddling with Perl's filedescriptor symbol globs.
@
text
@d152 1
a152 1
                      die "CVS user `$RT->{userid}' not found in Shiela configuration";
d178 2
a179 1
    $RT->{sendmail} = &find_program("ssmtp") ||
d182 2
a183 1
    $RT->{cvs}      = &find_program("cvs") || 
d185 6
d360 1
a360 1
##  Determine Shiela configuration.
d391 3
d1375 1
a1375 1
        #   Hmmm... we always just deal with files in Shiela, so there
d1382 1
a1382 1
        #   it is acceptable to just exit Shiela immediately.
d1421 1
a1421 1
                    print STDERR "cvs import: Warning: Shiela cannot process local imports\n";
d1669 2
a1670 2
                    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");
d1690 1
a1690 1
                my $io = new IO::File "diff -u $Is.old $Is.new|"
@


1.19
log
@Correctly determine CVS version and optional RSE patches (from OpenPKG
"cvs" package).
@
text
@d35 1
d365 1
a365 1
    open(CFG, "<$file") || die "unable to open configuration file `$file'";
d367 2
a368 2
    $t .= $_ while (<CFG>);
    close(CFG);
d798 2
a799 2
        open(FP, ($op eq 'append' ? ">" : "").">$file") or
            die "unable to open `$file' for $op";
d802 1
a802 1
            print FP $prefix . $line . "\n";
d804 1
a804 1
        close(FP);
d809 3
a811 3
        open(FP, "<$file") or
            die "unable to open `$file' for $op";
        while (<FP>) {
d815 1
a815 1
        close(FP);
d847 1
a847 1
    open(HDB, ">>".$RT->{historydb}) 
d849 2
a850 2
    print HDB $O;
    close(HDB);
d1173 4
a1176 3
        open(CVSS, "$RT->{cvs} -f -l -Q -n status ".join(' ', @@cvsfiles)."|");
        $cvsstat .= $_ while (<CVSS>);
        close(CVSS);
d1267 2
a1268 1
    open(FP,  "<$logfile") || die "cannot open message file `$logfile' for reading";
d1270 2
a1271 2
    $data .= $_ while (<FP>);
    close(FP);
d1278 4
a1281 3
    open(FP, ">$logfile") || die "cannot open message file `$logfile' for writing";
    print FP $data;
    close(FP);
d1416 4
a1419 3
                open(CVSS, "$RT->{cvs} -f -l -Q -n log -r$It '$Is'|");
                $rcslog = $_ while (<CVSS>);
                close(CVSS);
d1533 4
a1536 3
                open(CVSS, "$RT->{cvs} -f -l -Q -n log -r$Iv '$Is'|");
                $rcslog .= $_ while (<CVSS>);
                close(CVSS);
d1569 1
a1569 1
                open(FP, "<$Is"); 
d1571 2
a1572 2
                $l++ while (<FP>);
                close(FP);
d1606 4
a1609 3
                    open(CVSS, "$RT->{cvs} -f -l -Q -n update -p -r$Iv '$Is' | uuencode '$Is' |");
                    $cvsdiff .= $_ while (<CVSS>);
                    close(CVSS);
d1630 4
a1633 3
                    open(CVSS, "$RT->{cvs} -f -l -Q -n update -p -r$Iv '$Is'|");
                    $cvsdiff .= $_ while (<CVSS>);
                    close(CVSS);
d1668 3
a1670 3
                    open(FP, ">$Is.old") || die "cannot write to $Is.old";
                    print FP $data;
                    close(FP);
d1674 3
a1676 3
                    open(FP, ">$Is.new") || die "cannot write to $Is.old";
                    print FP $data;
                    close(FP);
d1679 4
a1682 3
                open(FP, "diff -u $Is.old $Is.new|");
                $cvsdiff .= $_ while (<FP>);
                close(FP);
d1689 4
a1692 3
                    open(FP, "$RT->{cvs} -f -l -Q -n diff -u -r$IV -r$Iv '$Is'|");
                    $d .= $_ while (<FP>);
                    close(FP);
d1865 3
a1867 3
                open(LOG, ">>$logurl") || die "cannot append log message to `$logurl'";
                print LOG $logmsg;
                close(LOG);
@


1.18
log
@Consistently switch to the "OSSP shiela" branding.
@
text
@d196 2
a197 2
    $RT->{cvsossp} = 0;
    $RT->{cvsossp} = 1 if ($v =~ m|OSSP|s);
d720 1
a720 1
                     ($RT->{cvsossp} ? "OSSP-CVS" : "CVS")."/$RT->{cvsvers}\n" .
d1247 1
a1247 1
##  version, this check is advisory only. If CVS contains the OSSP
d1260 2
a1261 2
    #   we require the OSSP patches for operation
    return $rv if (not $RT->{cvsossp});
d1274 1
a1274 1
    #  (OSSP CVS reads in this again, stock CVS ignores it)
d1381 1
a1381 1
        #   T = touched/tagged only (OSSP extension)
d1459 2
a1460 2
    #   extra information (which an OSSP CVS version would provide).
    if (not $RT->{cvsossp} and not $RT->{cvsop} eq 'import') {
@


1.17
log
@Fix the "invalid file specification `<absolute path>' for access
control" issue by using Cwd::realpath to resolve the absolute path
instead of calling `pwd`.

Additionally, bump version.
@
text
@d3 1
a3 1
##  Shiela - CVS Access Control and Logging Facility
d5 1
d7 1
a7 1
##  This file is part of Shiela, an access control and logging
d9 1
a9 1
##  which can be found at http://www.ossp.org/pkg/shiela/.
d26 1
a26 1
##  shiela: Shiela control program (syntax: Perl)
@


1.16
log
@Switched to the OSSP devtool build environment
and upgraded to GNU shtool 1.6.1 and GNU autoconf 2.53.
@
text
@d28 1
a28 1
my $version = '0.9.2 (19-Aug-2002)';
d37 1
d987 1
a987 2
    my $cvsdirphysical = `cd $RT->{cvsroot} && pwd`;
    $cvsdirphysical =~ s|\n$||s; 
@


1.15
log
@bump copyright years
@
text
@d28 1
a28 1
my $version = '0.9.2';
@


1.14
log
@allow strings like 1.11.1p1
@
text
@d4 1
a4 1
##  Copyright (c) 2000 Ralf S. Engelschall <rse@@engelschall.com>
@


1.13
log
@avoid nasty warning
@
text
@d193 1
a193 1
    $RT->{cvsvers} = $1 if ($v =~ m|Concurrent\s+Versions\s+System\s+\(CVS\)\s+([\d.]+)\s+|s);
@


1.12
log
@fix tag hook
@
text
@d1840 5
a1844 3
                if ($CF->{Logging}->{Report}->{$logtype}->{Details} eq 'diff:mime') {
                    $sm->header('Content-Type', 
                                "multipart/mixed; boundary=\"".$RT->{mimeboundary}."\"");
@


1.11
log
@better reporting plus bugfix for stock CVS
@
text
@d983 2
d986 3
@


1.10
log
@fix shiela for removed files
@
text
@d1491 2
a1492 2
            $info =~ m|^([^,]+),([^,]+),([^,]+)$|
                || die "invalid loginfo argument `$info'";
d1512 1
a1512 1
            || die "invalid loginfo argument `$info'";
d1752 1
a1752 1
             || die "invalid loginfo argument `$cvsinfo'";
@


1.9
log
@more quoting
@
text
@d1556 1
a1556 1
            if ($Io eq 'A' or $Io eq 'R') {
d1561 1
a1561 1
                $Id = sprintf("+%d/-%d", ($Io eq 'A' ? $l : 0), ($Io eq 'A' ? 0 : $l));
d1568 12
@


1.8
log
@More quotemeta required
@
text
@d1406 1
a1406 1
                open(CVSS, "$RT->{cvs} -f -l -Q -n log -r$It $Is|");
d1522 1
a1522 1
                open(CVSS, "$RT->{cvs} -f -l -Q -n log -r$Iv $Is|");
d1582 1
a1582 1
                    open(CVSS, "$RT->{cvs} -f -l -Q -n update -p -r$Iv $Is | uuencode $Is |");
d1605 1
a1605 1
                    open(CVSS, "$RT->{cvs} -f -l -Q -n update -p -r$Iv $Is|");
d1632 2
a1633 2
                    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");
d1662 1
a1662 1
                    open(FP, "$RT->{cvs} -f -l -Q -n diff -u -r$IV -r$Iv $Is|");
d1678 1
a1678 1
                $d =~ s|^(\+\+\+\s+)$Is(\s+)|$1$cvsdir/$Is$2|m;
@


1.7
log
@*** empty log message ***
@
text
@d1675 1
d1677 1
a1677 1
                $d =~ s|^(---\s+)$Is(\s+)|$1$cvsdir/$Is$2|m;
@


1.6
log
@add support for CVSUSER variable
@
text
@d1185 2
a1186 1
        if ($cvsstat =~ m|===+\nFile:\s+$cvsfile.+?Sticky Tag:\s+(\S+)|s) {
d1750 2
a1751 1
        $cvsdiff =~ s|\n<Diff\s+$Is>\n(.+?\n)</Diff>|$e->{diff} = $1, ''|se;
@


1.5
log
@Accept CVS 1.11 and newer
@
text
@d128 1
a128 1
    $RT->{userid}  = $ENV{LOGNAME} || $ENV{LOGUSER} || $ENV{USER} || die 'unknown CVS user';
d149 1
a149 1
                      die "unknown user `$RT->{userid}'";
@


1.4
log
@Update for Shtool 1.5.3 and new version
@
text
@d196 1
a196 1
    die "$RT->{cvs} is not at least CVS 1.10" if ($RT->{cvsvers} !~ m|^1\.10|);
@


1.3
log
@   *) Upgraded to GNU shtool 1.5.2-pre.
      [Ralf S. Engelschall]

   *) Added --with-perl=PATH and --with-cvs=PATH Autoconf options
      to allow one to force the use of particular programs.
      [Ralf S. Engelschall]

   *) Added $(DESTDIR) support for "make install".
      [Ralf S. Engelschall]
@
text
@d28 1
a28 1
my $version = '0.9.1';
@


1.2
log
@beautify imports
@
text
@d28 1
a28 1
my $version = '0.9.0';
d493 1
a493 1
        #   so just make sure it is achored 
@


1.1
log
@Initial revision
@
text
@d1379 1
a1379 1
        $cvsmsg .= "[Release Tags: $IT]\n";
@


1.1.1.1
log
@Import of OSSP Shiela

@
text
@@