[Date Prev][Date Next] [Thread Prev][Thread Next] [Date Index] [Thread Index]

Re: Errors when committing to webwml



On Tue, Oct 06, 2009 at 01:10:54PM +0100, Peter Krefting wrote:
> While committing a file to webwml, I get these error messages:
> 
> Insecure dependency in unlink while running setgid at /cvs/webwml/CVSROOT/log_accum.pl line 63.
> Insecure $ENV{PATH} while running setgid at /cvs/webwml/CVSROOT/ciabot_cvs.pl line 333.
> 
> Someone might want to look into that...

I've fixed a few of these problems, but I (obviously) haven't
finished.  If anyone's interested in helping, I've attached the
current scripts.

-- 
Matt Kraai                                           http://ftbfs.org/
#!/usr/bin/perl -w
#
# ciabot -- Mail a CVS log message to a given address, for the purposes of CIA
#
# Loosely based on cvslog by Russ Allbery <rra@stanford.edu>
# Copyright 1998  Board of Trustees, Leland Stanford Jr. University
#
# Copyright 2001, 2003, 2004  Petr Baudis <pasky@ucw.cz>
#
# This program is free software; you can redistribute it and/or modify it under
# the terms of the GNU General Public License version 2, as published by the
# Free Software Foundation.
#
# The master location of this file is
#   http://pasky.or.cz/~pasky/dev/cvs/ciabot.pl.
#
# This version has been modified a bit, and is available on CIA's web site:
#   http://cia.navi.cx/clients/cvs/ciabot_cvs.pl
#
# This program is designed to run from the loginfo CVS administration file. It
# takes a log message, massaging it and mailing it to the address given below.
#
# Its record in the loginfo file should look like:
#
#     ALL /usr/bin/perl $CVSROOT/CVSROOT/ciabot_cvs.pl $USER project from_email dest_email ignore_regexp -- %p %s
#
# IMPORTANT: The %{,,,s} in loginfo is new, and is required for proper operation.
#
#            Make sure that you add the script to 'checkoutlist' before
#            committing it. You may need to change /usr/bin/perl to point to your
#            system's perl binary.
#
#            Note that the last four parameters are optional, you can alternatively
#            change the defaults below in the configuration section.
#

use strict;
use vars qw ($project $from_email $dest_email $rpc_uri $sendmail $sync_delay
		$xml_rpc $ignore_regexp $alt_local_message_target);


### Configuration

# Project name (as known to CIA).
#
# NOTE: This shouldn't be a long description of your project. Ideally
#       it is a short identifier with no spaces, punctuation, or
#       unnecessary capitalization. This will be used in URLs related
#       to your project, as an internal identifier, and in IRC messages.
#       If you want a longer name shown for your project on the web
#       interface, please use the "title" metadata key rather than
#       putting that here.
#
$project = 'debian-www';

# The from address in generated mails.
$from_email = 'webmaster@debian.org';

# Mail all reports to this address.
$dest_email = 'cia@cia.navi.cx';

# If using XML-RPC, connect to this URI.
$rpc_uri = 'http://cia.navi.cx/RPC2';

# Path to your USCD sendmail compatible binary (your mailer daemon created this
# program somewhere).
$sendmail = '/usr/sbin/sendmail';

# Number of seconds to wait for possible concurrent instances. CVS calls up
# this script for each involved directory separately and this is the sync
# delay. 5s looks as a safe value, but feel free to increase if you are running
# this on a slower (or overloaded) machine or if you have really a lot of
# directories.
# Increasing this could be a very good idea if you're on Sourceforge ;)
$sync_delay = 5;

# This script can communicate with CIA either by mail or by an XML-RPC
# interface. The XML-RPC interface is faster and more efficient, however you
# need to have RPC::XML perl module installed, and some large CVS hosting sites
# (like Savannah or Sourceforge) might not allow outgoing HTTP connections
# while they allow outgoing mail. Also, this script will hang and eventually
# not deliver the event at all if CIA server happens to be down, which is
# unfortunately not an uncommon condition.
$xml_rpc = 0;

# You can make this bot to totally ignore events concerning the objects
# specified below. Each object is composed of <module>/<path>/<filename>,
# therefore file Manifest in root directory of module gentoo will be called
# "gentoo/Manifest", while file src/bfu/inphist.c of module elinks will be
# called "elinks/src/bfu/inphist.c". Easy, isn't it?
#
# This variable should contain regexp, against which will each object be
# checked, and if the regexp is matched, the file is ignored. Therefore ie.  to
# ignore all changes in the two files above and everything concerning module
# 'admin', use:
#
# $ignore_regexp = "^(gentoo/Manifest|elinks/src/bfu/inphist.c|admin/)";
$ignore_regexp = "";

# It can be useful to also grab the generated XML message by some other
# programs and ie. autogenerate some content based on it. Here you can specify
# a file to which it will be appended.
$alt_local_message_target = "";




### The code itself

use vars qw ($user $module $tag @files $logmsg $message);

my @dir; # This array stores all the affected directories
my @dirfiles;  # This array is mapped to the @dir array and contains files
               # affected in each directory


# A nice nonprinting character we can use as a separator relatively safely.
# The commas in loginfo above give us 4 commas and a space between file
# names given to us on the command line. This is the separator used internally.
# Now we can handle filenames containing spaces, and probably anything except
# strings of 4 commas or the ASCII bell character.
#
# This was inspired by the suggestion in:
#  http://mail.gnu.org/archive/html/info-cvs/2003-04/msg00267.html
#
$" = "\7";

### Input data loading


# Figure out who is doing the update.

$user = shift;

# Use the optional parameters, if supplied.

$project = shift unless ($ARGV[0] eq "--");
$from_email = shift unless ($ARGV[0] eq "--");
$dest_email = shift unless ($ARGV[0] eq "--");
$ignore_regexp = shift unless ($ARGV[0] eq "--");

# Remove "--"
shift;

# The directory is specified first
$dir[0] = shift;

# These arguments are from %s; first the relative path in the repository
# and then the list of files modified.

@files = @ARGV;
$dirfiles[0] = "@files" or die "$0: no files specified\n";

# Guess module name.

if ( $dir[0] =~ m#^([A-Za-z.]+)# ) {
    $module = $1;
}


# Parse stdin (what's interesting is the tag and log message)

while (<STDIN>) {
  $tag = $1 if /^\s*Tag: ([a-zA-Z0-9_-]+)/;
  last if /^Log Message/;
}

$logmsg = "";
while (<STDIN>) {
  next unless ($_ and $_ ne "\n" and $_ ne "\r\n");
  s/&/&amp;/g;
  s/</&lt;/g;
  s/>/&gt;/g;
  $logmsg .= $_;
}

### Remove to-be-ignored files

$dirfiles[0] = join (' ',
  grep {
    my $f = "$dir[0]/$_";
    $f !~ m/$ignore_regexp/;
  } split (/\s+/, $dirfiles[0])
) if ($ignore_regexp);
exit unless $dirfiles[0];



### Sync between the multiple instances potentially being ran simultanously

my $sum; # _VERY_ simple hash of the log message. It is really weak, but I'm
         # lazy and it's really sorta exceptional to even get more commits
         # running simultanously anyway.
$sum = 0;
map { if ( /(.)/ ) { $sum += ord $1 } } split(//, $logmsg);

my $syncfile; # Name of the file used for syncing
$syncfile = "/tmp/cvscia.$project.$module.$sum";


if (-f $syncfile and -w $syncfile) {
  # The synchronization file for this file already exists, so we are not the
  # first ones. So let's just dump what we know and exit.

  open(FF, ">>$syncfile") or die "aieee... can't log, can't log! $syncfile blocked!";
  print FF "$dirfiles[0]!@!$dir[0]\n";
  close(FF);
  exit;

} else {
  # We are the first one! Thus, we'll fork, exit the original instance, and
  # wait a bit with the new one. Then we'll grab what the others collected and
  # go on.

  # We don't need to care about permissions since all the instances of the one
  # commit will obviously live as the same user.

  # system("touch") in a different way
  open(FF, ">>$syncfile") or die "aieee... can't log, can't log! $syncfile blocked!";
  close(FF);

  exit if (fork);
  sleep($sync_delay);

  open(FF, $syncfile);
  my ($dirnum) = 1; # 0 is the one we got triggerred for
  while (<FF>) {
    chomp;
    ($dirfiles[$dirnum], $dir[$dirnum]) = split(/!@!/);
    $dirnum++;
  }
  close(FF);

  unlink($syncfile);
}



### Compose the mail message


my ($VERSION) = '2.4';
my ($URL) = 'http://cia.navi.cx/clients/cvs/ciabot_cvs.pl';
my $ts = time;

$message = <<EM
<message>
   <generator>
       <name>CIA Perl client for CVS</name>
       <version>$VERSION</version>
       <url>$URL</url>
   </generator>
   <source>
       <project>$project</project>
       <module>$module</module>
EM
;
$message .= "       <branch>$tag</branch>" if ($tag);
$message .= <<EM
   </source>
   <timestamp>
       $ts
   </timestamp>
   <body>
       <commit>
           <author>$user</author>
           <files>
EM
;

for (my $dirnum = 0; $dirnum < @dir; $dirnum++) {
  map {
    $_ = $dir[$dirnum] . '/' . $_;
    s#^.*?/##; # weed out the module name
    s/&/&amp;/g;
    s/</&lt;/g;
    s/>/&gt;/g;
    $message .= "  <file>$_</file>\n";
  } split($", $dirfiles[$dirnum]);
}

$message .= <<EM
           </files>
           <log>
$logmsg
           </log>
       </commit>
   </body>
</message>
EM
;



### Write the message to an alt-target

if ($alt_local_message_target and open (ALT, ">>$alt_local_message_target")) {
  print ALT $message;
  close ALT;
}



### Send out the XML-RPC message


if ($xml_rpc) {
  # We gotta be careful from now on. We silence all the warnings because
  # RPC::XML code is crappy and works with undefs etc.
  $^W = 0;
  $RPC::XML::ERROR if (0); # silence perl's compile-time warning

  require RPC::XML;
  require RPC::XML::Client;

  my $rpc_client = new RPC::XML::Client $rpc_uri;
  my $rpc_request = RPC::XML::request->new('hub.deliver', $message);
  my $rpc_response = $rpc_client->send_request($rpc_request);

  unless (ref $rpc_response) {
    die "XML-RPC Error: $RPC::XML::ERROR\n";
  }
  exit;
}



### Send out the mail


# Open our mail program

open (MAIL, "| $sendmail -t -oi -oem") or die "Cannot execute $sendmail : " . ($?>>8);


# The mail header

print MAIL <<EOM;
From: $from_email
To: $dest_email
Content-type: text/xml
Subject: DeliverXML

EOM

print MAIL $message;


# Close the mail

close MAIL;
die "$0: sendmail exit status " . ($? >> 8) . "\n" unless ($? == 0);

# vi: set sw=2:
#!/usr/bin/perl
# -*-Perl-*-
##
#
# This script, taken from the OpenBSD CVS repository.
#
# Perl filter to handle the log messages from the checkin of files in
# a directory.  This script will group the lists of files by log
# message, and mail a single consolidated log message at the end of
# the commit.
#
# This file assumes a pre-commit checking program that leaves the
# names of the first and last commit directories in a temporary file.
#
# Contributed by David Hampton <hampton@cisco.com>
#
# hacked greatly by Greg A. Woods <woods@web.net>

# Usage: log_accum.pl [-d] [-s] [-M module] [[-m mailto] ...] [-f logfile]
#	-d		- turn on debugging
#	-m mailto	- send mail to "mailto" (multiple)
#	-M modulename	- set module name to "modulename"
#	-f logfile	- write commit messages to logfile too
#	-s		- *don't* run "cvs status -v" for each file

#
#	Configurable options
#

$MAILER	       = "/usr/sbin/sendmail";

# Constants (don't change these!)
#
$STATE_NONE    = 0;
$STATE_CHANGED = 1;
$STATE_ADDED   = 2;
$STATE_REMOVED = 3;
$STATE_LOG     = 4;

$TMP_DIR       = "/cvs/webwml/CVSROOT/tmp";
$LAST_FILE     = "$TMP_DIR/#cvs.lastdir";

$CHANGED_FILE  = "$TMP_DIR/#cvs.files.changed";
$ADDED_FILE    = "$TMP_DIR/#cvs.files.added";
$REMOVED_FILE  = "$TMP_DIR/#cvs.files.removed";
$LOG_FILE      = "$TMP_DIR/#cvs.files.log";

$FILE_PREFIX   = "#cvs.files";

#
#	Subroutines
#

sub cleanup_tmpfiles {
    local($wd, @files);

    $wd = `pwd`;
    chdir("$TMP_DIR") || die("Can't chdir('$TMP_DIR')\n");
    opendir(DIR, ".");
    push(@files, grep(/^$FILE_PREFIX\..*\.$id$/, readdir(DIR)));
    closedir(DIR);
    foreach (@files) {
	unlink $_;
    }
    unlink $LAST_FILE . "." . $id;

    chdir($wd);
}

sub write_logfile {
    local($filename, @lines) = @_;

    open(FILE, ">$filename") || die("Cannot open log file $filename.\n");
    print FILE join("\n", @lines), "\n";
    close(FILE);
}

sub format_names {
    local($dir, @files) = @_;
    local(@lines);

    if ($dir =~ /^\.\//) {
	$dir = $';
    }
    if ($dir =~ /\/$/) {
	$dir = $`;
    }
    if ($dir eq "") {
	$dir = ".";
    }

    $format = "\t%-" . sprintf("%d", length($dir) > 15 ? length($dir) : 15) . "s%s ";

    $lines[0] = sprintf($format, $dir, ":");

    if ($debug) {
	print STDERR "format_names(): dir = ", $dir, "; files = ", join(":", @files), ".\n";
    }
    foreach $file (@files) {
	if (length($lines[$#lines]) + length($file) > 65) {
	    $lines[++$#lines] = sprintf($format, " ", " ");
	}
	$lines[$#lines] .= $file . " ";
    }

    @lines;
}

sub format_lists {
    local(@lines) = @_;
    local(@text, @files, $lastdir);

    if ($debug) {
	print STDERR "format_lists(): ", join(":", @lines), "\n";
    }
    @text = ();
    @files = ();
    $lastdir = shift @lines;	# first thing is always a directory
    if ($lastdir !~ /.*\/$/) {
	die("Damn, $lastdir doesn't look like a directory!\n");
    }
    foreach $line (@lines) {
	if ($line =~ /.*\/$/) {
	    push(@text, &format_names($lastdir, @files));
	    $lastdir = $line;
	    @files = ();
	} else {
	    push(@files, $line);
	}
    }
    push(@text, &format_names($lastdir, @files));

    @text;
}

sub accum_subject {
    local(@lines) = @_;
    local(@files, $lastdir);

    $lastdir = shift @lines;	# first thing is always a directory
    @files = ($lastdir);
    if ($lastdir !~ /.*\/$/) {
	die("Damn, $lastdir doesn't look like a directory!\n");
    }
    foreach $line (@lines) {
	if ($line =~ /.*\/$/) {
	    $lastdir = $line;
	    push(@files, $line);
	} else {
	    push(@files, $lastdir . $line);
	}
    }

    @files;
}

sub compile_subject {
    local(@files) = @_;
    local($text, @a, @b, @c, $dir, $topdir, $topsuffix);

    # find the highest common directory
    $dir = '-';
    do {
	$topdir = $dir;
	foreach $file (@files) {
	    if ($file =~ /.*\/$/) {
		if ($dir eq '-') {
		    $dir = $file;
		} else {
		    if (index($dir,$file) == 0) {
			$dir = $file;
		    } elsif (index($file,$dir) != 0) {
			@a = split /\//,$file;
			@b = split /\//,$dir;
			@c = ();
			CMP: while ($#a > 0 && $#b > 0) {
			    if ($a[0] eq $b[0]) {
				push(@c, $a[0]);
				shift @a;
				shift @b;
			    } else {
				last CMP;
			    }
			}
			$dir = join('/',@c) . '/';
		    }
		}
	    }
	}
    } until $dir eq $topdir;

    # strip out directories and the common prefix topdir.
    chop $topdir;
    $topsuffix = length($topdir) ? ('/' . $topdir) : '';
    @c = ($modulename . $topsuffix);
    foreach $file (@files) {
	if (!($file =~ /.*\/$/)) {
	    push(@c, substr($file, length($topsuffix)));
	}
    }

    # put it together and limit the length.
    $text = join(' ',@c);
    if (length($text) > 50) {
	$text = substr($text, 0, 46) . ' ...';
    }

    $text;
}

sub append_names_to_file {
    local($filename, $dir, @files) = @_;

    if (@files) {
	open(FILE, ">>$filename") || die("Cannot open file $filename.\n");
	print FILE $dir, "\n";
	print FILE join("\n", @files), "\n";
	close(FILE);
    }
}

sub read_line {
    local($line);
    local($filename) = @_;

    open(FILE, "<$filename") || die("Cannot open file $filename.\n");
    $line = <FILE>;
    close(FILE);
    chop($line);
    $line;
}

sub read_logfile {
    local(@text);
    local($filename, $leader) = @_;

    open(FILE, "<$filename");
    while (<FILE>) {
	chop;
	push(@text, $leader.$_);
    }
    close(FILE);
    @text;
}

sub build_header {
    local($header);
    local($sec,$min,$hour,$mday,$mon,$year) = localtime(time);
    $header = sprintf("CVSROOT:\t%s\nModule name:\t%s\n",
		      $cvsroot,
		      $modulename);
    if (defined($branch)) {
	$header .= sprintf("Branch: \t%s\n",
		      $branch);
    }
    $header .= sprintf("Changes by:\t%s\t%02d/%02d/%02d %02d:%02d:%02d",
		      $login,
		      $year%100, $mon+1, $mday,
		      $hour, $min, $sec);
}

sub mail_notification {
    local($name, $subject, @text) = @_;
    open MAIL, "| $MAILER -t";
# the Approved header seems to be necessary to post to -www-cvs
    print MAIL <<EOF ;
Approved: webmaster\@debian.org
From: Debian WWW CVS <webmaster\@debian.org>
To: $name
Subject: Debian WWW CVS commit by $login: $subject
Mail-Followup-To: debian-www\@lists.debian.org
Mail-Copies-To: never

EOF
    print MAIL join("\n", @text), "\n";
    close MAIL;
    if ($debug) {
	print STDERR "mail_notification(): name = ", $name, "; subject = ", $subject, ".\n";
    }
}

sub write_commitlog {
    local($logfile, @text) = @_;

    open(FILE, ">>$logfile");
    print FILE join("\n", @text), "\n\n";
    close(FILE);
}

#
#	Main Body
#

# Initialize basic variables
#
$debug = 0;
$id = getpgrp();	# note, you *must* use a shell which does setpgrp()
$state = $STATE_NONE;

$login = $ENV{'CVS_USER'} || getlogin || (getpwuid($<))[0] || "nobody";
#$login = $ENV{'LOGNAME'} || getlogin || (getpwuid($<))[0] || "nobody";

$cvsroot = $ENV{'CVSROOT'};
$do_status = 1;
$modulename = "";

# parse command line arguments (file list is seen as one arg)
#
@files = ();
while (@ARGV) {
    $arg = shift @ARGV;

    if ($arg eq '-d') {
	$debug = 1;
	print STDERR "Debug turned on...\n";
    } elsif ($arg eq '-m') {
	$mailto = "$mailto " . shift @ARGV;
    } elsif ($arg eq '-M') {
	$modulename = shift @ARGV;
    } elsif ($arg eq '-s') {
	$do_status = 0;
    } elsif ($arg eq '-f') {
	($commitlog) && die("Too many '-f' args\n");
	$commitlog = shift @ARGV;
    } else {
	push(@files, $arg);
    }
}
($mailto) || die("No -m mail recipient specified\n");

$ENV{PATH} = '/usr/bin:/bin';

# for now, the first "file" is the repository directory being committed,
# relative to the $CVSROOT location
#
@path = split('/', $files[0]);

# XXX there are some ugly assumptions in here about module names and
# XXX directories relative to the $CVSROOT location -- really should
# XXX read $CVSROOT/CVSROOT/modules, but that's not so easy to do, since
# XXX we have to parse it backwards.
#
if ($modulename eq "") {
    $modulename = $path[0];	# I.e. the module name == top-level dir
}
if ($commitlog ne "") {
    $commitlog = $cvsroot . "/" . $modulename . "/" . $commitlog unless ($commitlog =~ /^\//);
}
if ($#path == 0) {
    $dir = ".";
} else {
    $dir = join('/', @path[1..$#path]);
}
$dir = $dir . "/";

if ($debug) {
    print STDERR "module - ", $modulename, "\n";
    print STDERR "dir    - ", $dir, "\n";
    print STDERR "path   - ", join(":", @path), "\n";
    print STDERR "files  - ", join(":", @files), "\n";
    print STDERR "id     - ", $id, "\n";
    print STDERR "login  - ", $login, "\n";
    print STDERR "CVS_USER - ", $ENV{'CVS_USER'}, "\n";
}

# Check for a new directory first.  This appears with files set as follows:
#
#    files[0] - "path/name/newdir"
#    files[1] - "- New directory"
#
if ($files[1] eq "- New directory") {
    local(@text);

    @text = ();
    push(@text, &build_header());
    push(@text, "");
    push(@text, $files[0]);
    push(@text, "");

    while (<STDIN>) {
	chop;			# Drop the newline
	push(@text, $_);
    }

    &mail_notification($mailto, $files[0], @text);

    if ($commitlog) {
	&write_commitlog($commitlog, @text);
    }

    exit 0;
}

# Iterate over the body of the message collecting information.
#
while (<STDIN>) {
    chop;			# Drop the newline

    if (/^Modified Files/) { $state = $STATE_CHANGED; next; }
    if (/^Added Files/)    { $state = $STATE_ADDED;   next; }
    if (/^Removed Files/)  { $state = $STATE_REMOVED; next; }
    if (/^Log Message/)    { $state = $STATE_LOG;     next; }
    if (/^Revision\/Branch/) { /^[^:]+:\s*(.*)/; $branch = $+; next; }

    s/^[ \t\n]+// if ($state != $STATE_LOG);		# delete leading whitespace
    s/[ \t\n]+$//;		# delete trailing whitespace
    
    if ($state == $STATE_CHANGED) { push(@changed_files, split); }
    if ($state == $STATE_ADDED)   { push(@added_files,   split); }
    if ($state == $STATE_REMOVED) { push(@removed_files, split); }
    if ($state == $STATE_LOG)     { push(@log_lines,     $_); }
}

# 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.
#
while ($#log_lines > -1) {
    last if ($log_lines[0] ne "");
    shift(@log_lines);
}
while ($#log_lines > -1) {
    last if ($log_lines[$#log_lines] ne "");
    pop(@log_lines);
}
for ($i = $#log_lines; $i > 0; $i--) {
    if (($log_lines[$i - 1] eq "") && ($log_lines[$i] eq "")) {
	splice(@log_lines, $i, 1);
    }
}

# Check for an import command.  This appears with files set as follows:
#
#    files[0] - "path/name"
#    files[1] - "- Imported sources"
#
if ($files[1] eq "- Imported sources") {
    local(@text);

    @text = ();
    push(@text, &build_header());
    push(@text, "");

    push(@text, "Log message:");
    while ($#log_lines > -1) {
	push (@text, "    " . $log_lines[0]);
	shift(@log_lines);
    }

    &mail_notification($mailto, "Import $file[0]", @text);

    if ($commitlog) {
	&write_commitlog($commitlog, @text);
    }

    exit 0;
}

if ($debug) {
    print STDERR "Searching for log file index...";
}
# Find an index to a log file that matches this log message
#
for ($i = 0; ; $i++) {
    local(@text);

    last if (! -e "$LOG_FILE.$i.$id"); # the next available one
    @text = &read_logfile("$LOG_FILE.$i.$id", "");
    last if ($#text == -1);	# nothing in this file, use it
    last if (join(" ", @log_lines) eq join(" ", @text)); # it's the same log message as another
}
if ($debug) {
    print STDERR " found log file at $i.$id, now writing tmp files.\n";
}

# Spit out the information gathered in this pass.
#
&append_names_to_file("$CHANGED_FILE.$i.$id", $dir, @changed_files);
&append_names_to_file("$ADDED_FILE.$i.$id",   $dir, @added_files);
&append_names_to_file("$REMOVED_FILE.$i.$id", $dir, @removed_files);
&write_logfile("$LOG_FILE.$i.$id", @log_lines);

#
#	End Of Commits!
#

# This is it.  The commits are all finished.  Lump everything together
# into a single message, fire a copy off to the mailing list, and drop
# it on the end of the Changes file.
#

#
# Produce the final compilation of the log messages
#
@text = ();
@status_txt = ();
@subject_files = ();
push(@text, &build_header());
push(@text, "");

for ($i = 0; ; $i++) {
    last if (! -e "$LOG_FILE.$i.$id"); # we're done them all!
    @lines = &read_logfile("$CHANGED_FILE.$i.$id", "");
    if ($#lines >= 0) {
	push(@text, "Modified files:");
	push(@text, &format_lists(@lines));
	push(@subject_files, &accum_subject(@lines));
    }
    @lines = &read_logfile("$ADDED_FILE.$i.$id", "");
    if ($#lines >= 0) {
	push(@text, "Added files:");
	push(@text, &format_lists(@lines));
	push(@subject_files, &accum_subject(@lines));
    }
    @lines = &read_logfile("$REMOVED_FILE.$i.$id", "");
    if ($#lines >= 0) {
	push(@text, "Removed files:");
	push(@text, &format_lists(@lines));
	push(@subject_files, &accum_subject(@lines));
    }
    if ($#text >= 0) {
	push(@text, "");
    }
    @lines = &read_logfile("$LOG_FILE.$i.$id", "\t");
    if ($#lines >= 0) {
	push(@text, "Log message:");
	push(@text, @lines);
	push(@text, "");
    }
    if ($do_status) {
	local(@changed_files);

	@changed_files = ();
	push(@changed_files, &read_logfile("$CHANGED_FILE.$i.$id", ""));
	push(@changed_files, &read_logfile("$ADDED_FILE.$i.$id", ""));
	push(@changed_files, &read_logfile("$REMOVED_FILE.$i.$id", ""));

	if ($debug) {
	    print STDERR "main: pre-sort changed_files = ", join(":", @changed_files), ".\n";
	}
	@changed_files = sort(@changed_files);
	if ($debug) {
	    print STDERR "main: post-sort changed_files = ", join(":", @changed_files), ".\n";
	}

	foreach $dofile (@changed_files) {
	    if ($dofile =~ /\/$/) {
		next;		# ignore the silly "dir" entries
	    }
	    if ($debug) {
		print STDERR "main(): doing status on $dofile\n";
	    }
	    open(STATUS, "-|") || exec 'cvs', '-n', 'status', '-v', $dofile;
	    while (<STATUS>) {
		chop;
		push(@status_txt, $_);
	    }
	}
    }
}

$subject_txt = &compile_subject(@subject_files);

# Write to the commitlog file
#
if ($commitlog) {
    &write_commitlog($commitlog, @text);
}

if ($#status_txt >= 0) {
    push(@text, @status_txt);
}

# Mailout the notification.
#
&mail_notification($mailto, $subject_txt, @text);

# cleanup
#
if (! $debug) {
    &cleanup_tmpfiles();
}

exit 0;

Reply to: