File:  [NetBSD Developer Wiki] / CVSROOT / log_accum
Revision 1.22: download - view: text, annotated - select for diffs
Wed Jul 1 09:37:59 2015 UTC (6 years, 6 months ago) by spz
Branches: MAIN
CVS tags: HEAD
strategic pattern match call correction: will now recognize imports
and new directories correctly

#! /usr/pkg/bin/perl -w
# -*-Perl-*-
#
# Copyright (c) 2006,2009 The NetBSD Foundation, Inc.
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
# 3. All advertising materials mentioning features or use of this software
#    must display the following acknowledgement:
#        This product includes software developed by the NetBSD
#        Foundation, Inc. and its contributors.
# 4. Neither the name of The NetBSD Foundation nor the names of its
#    contributors may be used to endorse or promote products derived
#    from this software without specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE NETBSD FOUNDATION, INC. AND CONTRIBUTORS
# ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
# TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
# PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE FOUNDATION OR CONTRIBUTORS
# BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
#
#ident	"@(#)ccvs/contrib:$NetBSD: log_accum,v 1.22 2015/07/01 09:37:59 spz Exp $"
#
# Perl filter to handle the log messages from the checkin of files in multiple
# directories.  This script will group the lists of files by log message, and
# send one piece of mail per unique message, no matter how many files are
# committed.
#
# This implementation requires:
# 1) a pre-commit checking program that leaves a #cvs.lastdir file containing
#    the name of the last directory,
# 2) the `%{Vvts}' output format in the loginfo file (so that the version
#    numbers and tags are all passed in, and in the right order), and
# 3) perl5-MD5.
#
# Contributed by David Hampton <hampton@cisco.com>
# Hacked greatly by Greg A. Woods <woods@planix.com>
# Rewritten by Charles M. Hannum <mycroft@netbsd.org>
# Least common path routine by Hubert Feyrer <hubertf@netbsd.org>
# rdiff & bugsto support by Darrin B. Jewell <dbj@netbsd.org>
# using MIME::Lite and sending out of diffs by S.P.Zeidler <spz@NetBSD.org>

# Usage: log_accum.pl [-d] [-D] [-S] [-M module] [[-m mailto] ...] [[-R replyto] ...] [-T title] [[-b bugsto] ...] [-f logfile]
#	-d		- turn on debugging
#	-m mailto	- send mail to "mailto" (multiple)
#	-R replyto	- set the "Reply-To:" to "replyto" (multiple)
#	-M modulename	- set module name to "modulename"
#	-f logfile	- write commit messages to logfile too
#       -A approvepw	- approval token for -m and -F
#       -F maildiffsto  - generate diffs and send them as mail to "maildiffsto"
#                         (multiple)
#	-D		- generate diff commands
#	-S		- write to "syncer" file in /tmp used by push script
#	-T		- use "title" instead of "CVS commit: "
#	-W		- write to "www syncer" file in /tmp for www push
#	-b bugsto	- send mail referencing problem reports to this address
#	-w whitelist	- parse wiki commits, including those from OpenIDs
#	-x program	- execute "program" in background


# First things first: we don't want to be interrupted, the commit will
# have happened but the logging/mailing/syncing won't, which would be Bad.

$SIG{INT}	= 'IGNORE';
$SIG{QUIT}	= 'IGNORE';
$SIG{HUP}	= 'IGNORE';

use Digest::MD5;
use MIME::Lite;
use strict;

#
#	Configurable options
#
our $title = "CVS commit: ";

# to avoid - Insecure $ENV{PATH} while running setuid at log_accum
$ENV{PATH}="/bin:/usr/bin:/usr/pkg/bin:/usr/local/bin";

#
#	End user configurable options.
#

our $LASTDIR_FILE = "/tmp/#cvs.lastdir";
our $HASH_FILE    = "/tmp/#cvs.hash";
our $VERSION_FILE = "/tmp/#cvs.version";
our $MESSAGE_FILE = "/tmp/#cvs.message";

our $SYNCER_FILE    = "/tmp/cvs_commits";
our $WWWSYNCER_FILE = "/tmp/wwwcvs_commits";

# Initialize basic variables
#
our $debug = 0;
our $do_diff = 0;
our $do_syncer = 0;
our $do_web_commits = 0;
our $do_wwwsyncer = 0;
our $id = getpgrp();	# note, you *must* use a shell which does setpgrp()
# if we have a web commit we will overwrite the login value
# when reading the commit message
our $login = getpwuid($<)
	or die "*** Who are you?";
our $id2 = $id.".".$login; 
our $is_web_commit = 0;

if ( -e "$HASH_FILE.$id2" ) {
    my $n = 2;
    while (-e "$HASH_FILE.$id2" && (time - (stat("$HASH_FILE.$id2"))[9]) > 3600) {
	$id2 = $id.".".$login.".".$n;
	$n += 1;
    }
}

# uninitialized global vars are:
our $approvepw = "";
our $mailto = "";
our $maildiffsto = "";
our $bugsto = "";
our $replyto = "";
our $modulename = "";
our $commitlog = "";
our $openid_whitelist = "";
our $external_program = "";

#
#	Subroutines
#

#
# An O(n) routine to find the least common directory in a number
# of paths  - Hubert Feyrer <hubertf@netbsd.org>
#
# Beware: paths are anon-arrays of [0, 1, 2, 3, "path"] !
#
sub lcpath
{
    my(@paths) = @_;
    my($lcpathlen, @lcpath, $i, @c, $dir, $ref, $firstpath);
    
    $lcpathlen=0;
    $firstpath = 1;
    for($i=0; $i<100; $i++) { $lcpath[$i] = "/"; }
    
    foreach $ref (@paths){
	$dir = $$ref[4];
	print STDERR "HF: dir=$dir lcpath=".
	      join("/", @lcpath[0..$lcpathlen])." ($lcpathlen)\n"
	    if $debug;
	
	@c = split(/\//, $dir);
      component:
	for($i=0; $i <= $#c; $i++) {
	    print STDERR "$i: $c[$i]	lc=$lcpath[$i]" .
		  "      lcpath=". join("/", @lcpath[0..$lcpathlen-1])."\n"
		if $debug;
	    
	    if ($lcpath[$i] eq "/") {
		if ($firstpath) {
		    # never been there
		    $lcpath[$i] = $c[$i];
		    $lcpathlen = $i;
		    print STDERR "-> $c[$i] added at $i\n"
			if $debug;
		} else {
		    # Something was here before - stop!
		    print STDERR "-> stopped by earlier shorter path\n"
			if $debug;
		    last component;
		}
	    } else {
		if ($c[$i] ne $lcpath[$i]) {
		    # different names 
		    $lcpath[$i] = "";
		    $lcpathlen = $i-1;
		    print STDERR "-> truncated at $lcpathlen ($c[$i])\n"
			if $debug;
		    last component;
		}
	    }
	}
	
	if ($lcpathlen > $#c and $lcpathlen > 0) {
	    $lcpathlen = $#c;
	    $lcpath[$#c + 1] = "";
	    print STDERR "-> truncated at $#c\n"
		if $debug;
	}

	$firstpath = 0
	    if $firstpath;
	
	print STDERR "\n"
	    if $debug;
    }	
    
    print STDERR "lcpath = ".join("/", @lcpath[0..$lcpathlen])." ($lcpathlen)\n"
	if $debug;
    
    return join("/", @lcpath[0..$lcpathlen]);
}

sub extract_branches {
    my (@input) = @_;
    my %branches = ();

    foreach my $in (@input) {
	$branches{$$in[2] ne ""? $$in[2] : "trunk" } = 1;
    }

    return join(", ", sort(keys(%branches)));
}

sub append_logfile {
    my($filename, $lines) = @_;

    open(FILE, ">>$filename")
	or die("Cannot open file $filename for append.\n");
    print FILE "$lines\n";
    close(FILE);

    return 1;
}

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

    open(FILE, ">$filename")
	or die("Cannot open file $filename for write.\n");
    print FILE $lines."\n";
    close(FILE);

    return 1;
}

sub read_logfile {
    my($filename) = @_;
    my(@lines);

    open(FILE, "<$filename")
	or die("Cannot open file $filename for read.\n");
    while (<FILE>) {
	chop;
	push @lines, $_;
    }
    close(FILE);

    return @lines;
}

sub format_lists {
    my (@input) = @_; # array of refs to array (oldvers, newvers, tag, filename, dir)
    my (@lines, $line, $last, $f);

    if ($debug) {
	foreach my $l (@input) {
	    print STDERR "format_lists(): files = ", join(" ", @$l), ".\n";
	}
    }

    # Sort by tag, dir, file.
    @input = sort {
	$$a[2] cmp $$b[2] ||
	$$a[4] cmp $$b[4] ||
	$$a[3] cmp $$b[3];
    } @input;

    # Combine adjacent rows that are the same modulo the file name.
    @input = map {
	if (!$last || $$_[2] ne $$last[2] || $$_[4] ne $$last[4]) {
	    $last = [@$_[0..2], [$$_[3]], @$_[4]];
	    $last;
	} else {
	    push @{$$last[3]}, $$_[3];
	    ();
	}
    } @input;

    foreach my $in (@input) {
	my $line = "\t".$$in[4];
	$line .= " [".$$in[2]."]" if $$in[2];
	$line .= ":";
	foreach $f (@{$$in[3]}) {
	    if (length($line) + length($f) > 71) {
		push(@lines, $line);
		$line = "\t   ";
	    }
	    $line .= " ".$f;
	}
	push @lines, $line;
    }

    return join("\n",@lines)."\n";
}

sub format_diffs {
    my (@input) = @_;
    my(@lines, $line, $last, $f);

    if ($debug) {
	foreach my $l (@input) {
	    print STDERR "format_diffs(): files = ", join(" ", @$l), ".\n";
	}
    }

    # Sort by dir, old, new, file.
    @input = sort {
	$$a[4] cmp $$b[4] ||
	$$a[0] cmp $$b[0] ||
	$$a[1] cmp $$b[1] ||
	$$a[3] cmp $$b[3];
    } @input;

    # Combine adjacent rows that are the same modulo the file name.
    @input = map {
	if (!$last || $$_[4] ne $$last[4] || $$_[0] ne $$last[0] ||
		      $$_[1] ne $$last[1]) {
	    $last = [@$_[0..2], [$$_[3]], @$_[4]];
	    $last;
	} else {
	    push @{$$last[3]}, $$_[3];
	    ();
	}
    } @input;

    # Sort by dir, file.
    @input = sort {
	$$a[4] cmp $$b[4] ||
	$$a[3][0] cmp $$b[3][0];
    } @input;

    foreach my $in (@input) {
	$line = "cvs rdiff -u -r$$in[0] -r$$in[1]";
	foreach $f (@{$$in[3]}) {
	    if (length($line) + length($$in[4]."/".$f) > 76) {
		push @lines, $line." \\";
		$line = "   ";
	    }
	    $line .= " ".$$in[4]."/".$f;
	}
	push @lines, $line;
    }

    return join("\n",@lines)."\n";
}

sub create_diffs {
    my (@input) = @_;
    my($diff, $line, $last, $f);
    my @lines=();

    if ($debug) {
	foreach my $l (@input) {
	    print STDERR "create_diffs(): files = ", join(" ", @$l), ".\n";
	}
    }

    # Sort by dir, old, new, file.
    @input = sort {
	$$a[4] cmp $$b[4] ||
	$$a[0] cmp $$b[0] ||
	$$a[1] cmp $$b[1] ||
	$$a[3] cmp $$b[3];
    } @input;

    # Combine adjacent rows that are the same modulo the file name.
    @input = map {
	if (!$last || $$_[4] ne $$last[4] || $$_[0] ne $$last[0] ||
		      $$_[1] ne $$last[1]) {
	    $last = [@$_[0..2], [$$_[3]], @$_[4]];
	    $last;
	} else {
	    push @{$$last[3]}, $$_[3];
	    ();
	}
    } @input;

    # Sort by dir, file.
    @input = sort {
	$$a[4] cmp $$b[4] ||
	$$a[3][0] cmp $$b[3][0];
    } @input;

    foreach my $in (@input) {
	$line = "cvs -u rdiff -u -r$$in[0] -r$$in[1]";
	foreach my $f (@{$$in[3]}) {
	    $line .= " ".$$in[4]."/".$f;
	}
	$line =~ /([^;&|]*)/;
	push @lines, $1;
    }

    foreach my $rdiff (@lines) {
	$diff .= `$rdiff`;
	$diff .= "\n";
    }

    return $diff;
}

sub build_header {
    my($header, $now);
    $now = gmtime;

    $header  = "Module Name:\t$modulename\n";
    $header .= "Committed By:\t$login\n";
    $header .= "Date:\t\t".substr($now, 0, 19)." UTC ".substr($now, 20, 4)."\n";

    return $header;
}

# Search text for possible references to gnats prs
sub search_for_prs {
    my($text) = @_;
    my $last ;
    my @prs = 
        ($text =~ m{\bP(?:roblem)?\s*?R(?:eport)?\s*/?\#?\s*(?:\b[\w-]+/)?(\d+)[[:punct:]]*(?:$|\s)}sigo);
    @prs = map { if (!$last || $last ne $_) { $last = $_ ; } else { () } } sort @prs;

    return @prs;
}

sub mail_notification {
    my($text,$lcpath,$diff,$branches) = @_;
    my($s, $name, $emailaddress);
    my $subject;

    if ($debug) {
	print STDERR "mail-Mailto: $mailto\n";
	print STDERR "mail-cvspath: $lcpath\n";
	print STDERR "mail-Text:\n$text\n";
    }
    # prepend any branches that we might have ...
    #
    if ($branches && $branches ne "trunk") {
	# branch commit!
        $subject = "[$branches] ";
    } else {
	$subject = "";
    }

    # ... and add least common path component of all dirs
    #
    if (defined $lcpath && $lcpath ne "/" && $lcpath ne "") {
	$subject .= $lcpath;		# cvs commit or import
	if ($do_syncer) {
		append_logfile($SYNCER_FILE, $lcpath);
	}
	if ($do_wwwsyncer) {
		append_logfile($WWWSYNCER_FILE, $lcpath);
	}
    }
	
    if ($is_web_commit && is_openid($login)) {
	($name, $emailaddress) = lookup_openid($login);
    } else {
	($name, $emailaddress) = lookup_developer($login);
    }

    # Quote for RFC822
    if ($name =~ m{[^- !#-'*+/-9=?A-Z^-~]}) {
	$name =~ s/[\"\\]/\\$&/;
	$name = "\"".$name."\"";
    }
    my $from = ($name ? $name." <".$emailaddress.">" : $emailaddress);

    if (! $replyto) {
	$replyto = $emailaddress;
    }

    my $msg = MIME::Lite->new(
	'From'     => $from,
	'Subject'  => "$title$subject",
	'To'       => $mailto,
	'Type'     => 'TEXT',
	'Data'     => $text
    );
    if ($approvepw) {
	$msg->add('Approved' => $approvepw);
    }
    if ($replyto) {
	$msg->add('Reply-To' => $replyto);
    }
    $msg->delete('X-Mailer');
    $msg->add('X-Mailer' => 'log_accum');
    $msg->send;

    if ($maildiffsto) {
	my $msg = MIME::Lite->new(
	    'From'     => $from,
	    'Subject'  => "$title$subject",
	    'To'       => $maildiffsto,
	    'Type'     => 'TEXT',
	    'Data'     => $text
	);
	if ($approvepw) {
	    $msg->add('Approved' => $approvepw);
	}
	if ($replyto) {
	    $msg->add('Reply-To' => $replyto);
	}
	if ($diff) {
	    $msg->attach(
		'Type'   => 'text/x-diff',
		'Data'   => $diff
	    );
	}
        $msg->delete('X-Mailer');
	$msg->add('X-Mailer' => 'log_accum');
	$msg->send;
    }

    if ($bugsto) {
        my @prs = search_for_prs($text);
        foreach my $pr (@prs) {
	    my $msg = MIME::Lite->new(
		'From'     => $from,
		'Subject'  => "PR/$pr CVS commit: $subject",
		'To'       => $bugsto,
		'Type'     => 'TEXT',
		'Data'     => $text
	    );
	    if ($replyto) {
		$msg->add('Reply-To' => $replyto);
	    }
	    $msg->delete('X-Mailer');
	    $msg->add('X-Mailer' => 'log_accum');
	    $msg->send;
        }
    }
}

sub is_openid {
    my $creds = shift;
    return ($creds =~ /.*:\/\/.*/);
}

sub lookup_openid {
    my $openid = shift;

    # Fetch the user's name and email from the OpenID whitelist.
    #
    open(WL, $openid_whitelist)
	or die("Cannot open OpenID whitelist $openid_whitelist for read.\n");
    my @matches = grep {/\t$openid$/} <WL>;
    1 == @matches
	or die("Cannot match exactly one whitelist entry for $openid.\n");
    my @fields = split(/\t/, $matches[0]);
    4 == @fields
	or die("Cannot find exactly four fields for $openid.\n");

    return ($fields[1], $fields[2]);
}

sub lookup_developer {
    my $username = shift;

    # Fetch the user's full name from the GECOS field.  We have to do the
    # magic & substitution.
    #
    my $name = (split(",", (getpwnam($username))[6]))[0];
    $name =~ s/&/\u$username/g;

    return ($name, $username);
}

#
#	Main Body
#

my @files; # only in main

# parse command line arguments (file list is seen as one arg)
#
while (@ARGV) {
    $_ = shift @ARGV;
    if ($_ eq '-d') {
	$debug = 1;
	print STDERR "Debug turned on...\n";
    } elsif ($_ eq '-m') {
	$mailto .= ", " if $mailto;
	$mailto .= shift @ARGV;
    } elsif ($_ eq '-b') {
	$bugsto .= ", " if $bugsto;
	$bugsto .= shift @ARGV;
    } elsif ($_ eq '-R') {
	$replyto .= ", " if $replyto;
	$replyto .= shift @ARGV;
    } elsif ($_ eq '-M') {
	die("too many '-M' args\n") if $modulename;
	$modulename = shift @ARGV;
    } elsif ($_ eq '-f') {
	die("too many '-f' args\n") if $commitlog;
	$commitlog = shift @ARGV;
	# This is a disgusting hack to untaint $commitlog if we're running from
	# setgid cvs.
	$commitlog =~ m/(.*)/;
	$commitlog = $1;
    } elsif ($_ eq '-D') {
	$do_diff = 1;
    } elsif ($_ eq '-F') {
	$maildiffsto .= ", " if $maildiffsto;
	$maildiffsto .= shift @ARGV;
    } elsif ($_ eq '-A') {
	$approvepw = shift @ARGV;
    } elsif ($_ eq '-S') {
	$do_syncer = 1;
    } elsif ($_ eq '-T') {
	$title = shift @ARGV;
    } elsif ($_ eq '-W') {
	$do_wwwsyncer = 1;
    } elsif ($_ eq '-w') {
	$do_web_commits = 1;
	$openid_whitelist = shift @ARGV;
    } elsif ($_ eq '-x') {
	$external_program = shift @ARGV;
    } else {
	@files = split;
	last;
    }
}
if (@ARGV) {
    die("Too many arguments!  Check usage.\n");
}

if (! $mailto) {
    die("No mail recipient specified (use -m)\n");
}

# for now, the first "file" is the repository directory being committed,
# relative to the $CVSROOT location
#
my $dir = shift @files;

# 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.
#
# XXX For now we set the `module' name to the top-level directory name.
#
if (! $modulename) {
    ($modulename) = split('/', $dir, 2);
}

if ($debug) {
    print STDERR "module - ", $modulename, "\n";
    print STDERR "dir    - ", $dir, "\n";
    print STDERR "files  - ", join(" ", @files), "\n";
    print STDERR "id     - ", $id, "\n";
    print STDERR "id2    - ", $id2, "\n";
}

# Check for a new directory or an import command.
#
#    files[0] - "NONE,NONE,,-"
#    files[1] - "New"
#    files[2] - "directory"
#
#    files[0] - "NONE,NONE,$version,-"
#    files[1] - "Imported"
#    files[2] - "sources"
#
if ($files[0] =~ m{NONE,NONE,\S*,-}) {
    if ($files[1] eq "New" && $files[2] eq "directory") {
	# Forget about it
    } else {
	system("$external_program &") if $external_program;
	my $text = build_header();
	$text .= "\n";
	while (<STDIN>) {
		$text .= $_;
	}

	# Write to the commitlog file
	#
	if ($commitlog) {
	    append_logfile($commitlog, $text);
	}

	# Mail out the notification.
	#
	mail_notification($text,$dir);
    }

    exit 0;
}

if ($debug) {
    print STDERR "files  - ", join(" ", @files), "\n";
}

# Collect just the log message from stdin.
#
while (<STDIN>) {
    chop;			# strip the newline
    last if (/^Log Message:$/);
}

my @log_lines=();

foreach my $line (<STDIN>) {
    chop $line;			# strip the newline
    $line =~ s/\s+$//;		# strip trailing white space
    if ($do_web_commits) {
	# copied verbatim from IkiWiki.pm's default web_commit_regexp
	my $web_commit_regexp = qr/^web commit (by (.*?(?=: |$))|from ([0-9a-fA-F:.]+[0-9a-fA-F])):?(.*)/;
	if ($line =~ /$web_commit_regexp/) {
	    $login = $2;
	    $line = $4;
	    $line =~ s/^\s+//;
	    $is_web_commit = 1;
	}
    }
    push @log_lines, $line;
}

my $md5 = Digest::MD5->new();
foreach my $line (@log_lines) {
    $md5->add($line."\n");
}
my $hash = $md5->hexdigest();
undef $md5;

if ($debug) {
    print STDERR "hash = $hash\n";
}
if (! -e "$MESSAGE_FILE.$id2.$hash") {
    append_logfile("$HASH_FILE.$id2", $hash);
    write_logfile("$MESSAGE_FILE.$id2.$hash", join("\n",@log_lines));
}
    
# Spit out the information gathered in this pass.
#
append_logfile("$VERSION_FILE.$id2.$hash", $dir.'/');
append_logfile("$VERSION_FILE.$id2.$hash", join("\n",@files));

# Check whether this is the last directory.  If not, quit.
#
if ($debug) {
    print STDERR "Checking current dir against last dir.\n";
}
my @lastdir = read_logfile("$LASTDIR_FILE.$id");

if ($lastdir[0] ne $dir) {
    if ($debug) {
	print STDERR sprintf("Current directory %s is not last directory %s.\n", $dir, $lastdir[0]);
    }
    exit 0;
}
if ($debug) {
    print STDERR sprintf("Current directory %s is last directory %s -- all commits done.\n", $dir, $lastdir[0]);
}

system("$external_program &") if $external_program;

#
#	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
#

my @hashes = read_logfile("$HASH_FILE.$id2");

my @modified_files = ();
my @added_files = ();
my @removed_files = ();

foreach my $hash (@hashes) {
    # In case we're running setgid, make sure the hash file hasn't been hacked.
    $hash =~ m/([a-z0-9]*)/
	or die "*** Hacking attempt detected\n";
    $hash = $1;

    my $text = build_header();
    $text .= "\n";

    @files = read_logfile("$VERSION_FILE.$id2.$hash");
    @log_lines = read_logfile("$MESSAGE_FILE.$id2.$hash");

    foreach my $line (@files) {
	if ($line =~ s|/$|| ) {
	    $dir = $line;
	    next;
	}
	my $elems = [split(',', $line, 4), $dir];
	if ($$elems[0] eq 'NONE') {
	    $$elems[0] = '0';
	    push @added_files, $elems;
	} elsif ($$elems[1] eq 'NONE') {
	    $$elems[1] = '0';
	    push @removed_files, $elems;
	} else {
	    push @modified_files, $elems;
	}
    }

    # 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 $blank = 1;
    my $wasblank;
    @log_lines = map {$wasblank = $blank;
		      $blank = $_ eq '';
		      $blank && $wasblank ? () : $_;} @log_lines;
    pop @log_lines if $blank;

    if (@modified_files) {
	$text .= "Modified Files:\n";
	$text .= format_lists(@modified_files);
    }
    if (@added_files) {
	$text .= "Added Files:\n";
	$text .= format_lists(@added_files);
    }
    if (@removed_files) {
	$text .= "Removed Files:\n";
	$text .= format_lists(@removed_files);
    }
    if (@log_lines) {
	$text .= "\n";
	$text .= "Log Message:\n";
	$text .= join("\n",@log_lines);
	$text .= "\n";
    }
    $text .= "\n";

    # Write to the commitlog file
    #
    if ($commitlog) {
	append_logfile($commitlog, $text);
    }

    if ($do_diff) {
	$text .= "\n";
	$text .= "To generate a diff of this commit:\n";
	$text .= format_diffs(@modified_files, @added_files, @removed_files);
	$text .= "\n";
	$text .= "Please note that diffs are not public domain; they are subject to the\n";
	$text .= "copyright notices on the relevant files.\n";
	$text .= "\n";
    }

    my $diff;
    if ($maildiffsto) {
	$diff = "";
	if (scalar @modified_files) {
	    $diff .= "Modified files:\n\n";
	    $diff .= create_diffs(@modified_files);
	}
	if (scalar @added_files) {
	    $diff .= "Added files:\n\n";
	    $diff .= create_diffs(@added_files);
	}
	if (length($diff) > 1000000) {
	    $diff = "diffs are larger than 1MB and have been omitted\n";
	}
    }

    my $lcpath = lcpath(@added_files, @removed_files, @modified_files);
    my $branches = extract_branches(@added_files, @removed_files, @modified_files);

    # Mail out the notification.
    #
    mail_notification($text, $lcpath, $diff, $branches);

    if (! $debug) {
	unlink "$VERSION_FILE.$id2.$hash";
	unlink "$MESSAGE_FILE.$id2.$hash";
    }
}

if (! $debug) {
    unlink "$LASTDIR_FILE.$id";
    unlink "$HASH_FILE.$id2";
}

exit 0;

CVSweb for NetBSD wikisrc <wikimaster@NetBSD.org> software: FreeBSD-CVSweb