[rt-users] rt-cvsgate
John Jasen
jjasen at datafoundation.com
Mon Sep 8 15:14:11 EDT 2003
I pulled down rt-cvsgate from http://www.fsck.com/pub/rt/contrib/3.0/, but
ran into some problems with it.
I'm not, by any means, the premier perl hacker, but ...
+ mail notification now works.
+ no undefined variable errors when being run.
I'm not quite sure if the ability to resolve tickets, change the subject,
etc still work, as it seems that these are dependant on an 'enhanced
mailgate' which I could not find. And besides, things like resolving
tickets are restricted to the person who admins that queue here ...
regardless, I hope someone gets some use out of this.
If the original author or current maintainer see this, feel free to get
ahold of me.
-------------- next part --------------
#!/usr/bin/perl -w
# {{{ Docs
# -*-Perl-*-
#
#ident "@(#)ccvs/contrib:$Name: $:$Id: rt-commit-handler,v 1.10 2002/01/30 03:33:53 jesse 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.
=head1 NAME rt-cvsgate
=head1 USAGE
=head2 Regular use
Stick the following in in CVSROOT/commitinfo
ALL /opt/rt3/bin/rt-cvsgate --record-last-dir
Stick the following in CVSROOT/loginfo
ALL /opt/rt3/bin/rt-cvsgate --cvs-root $CVSROOT --rt %{Vvts}
OR
ALL /opt/rt3/bin/rt-cvsgate --cvs-root $CVSROOT --user `id -urn` --rt %{Vvts}
=head2 Invocation (advanced use)
rt-cvsgate --cvs-root /path/to/cvs/root [--user username] [-d] [-D] [-r] \
[-M module] [[-m mailto] ...] [[-R replyto] ...] [-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
-D - generate diff commands
--rt - invoke RT commit handler
--cvs-root - specify your CVS root
--user - specify your CVSing user (combined with $cvs_domain
variable, to create From: address for RT message)
--record-last-dir - Record the last directory with changes in
pre-commit (commitinfo) mode
=cut
# }}}
use strict;
use Carp;
use Getopt::Long;
use Text::Wrap;
use Digest::MD5;
use MIME::Entity;
use LWP::UserAgent;
use vars
qw(@MAILER $TMPDIR $FILE_PREFIX $LASTDIR_FILE $HASH_FILE $VERSION_FILE
$MESSAGE_FILE $MAIL_FILE $DEBUG $MAILTO $REPLYTO $id $MODULE_NAME
$LOGIN $COMMITLOG $CVS_ROOT $RT_HANDLER $VERSION);
$VERSION = "1.0";
# Configuration settings
my $cvs_user = 'cvs'; # default... overridden by --user
my $cvs_domain = 'DOMAIN.COM'; # $cvs_user@$cvs_domain must be valid
my $rt_address = 'rt at DOMAIN.COM'; # To: address
my $rt_name = 'DOMAIN.COM'; # [$rt_name #1234]
my $rt_url = 'http://www.DOMAIN.COM/rt'; # URL to base of RT site, without trailing '/'
# {{{ Variable setup
$TMPDIR = '/tmp';
$FILE_PREFIX = $TMPDIR . '/#cvs.';
# The root of your CVS install. we should get this from some smarter place.
# It needs a trailing /
$LASTDIR_FILE = $FILE_PREFIX . "lastdir";
$HASH_FILE = $FILE_PREFIX . "hash";
$VERSION_FILE = $FILE_PREFIX . "version";
$MESSAGE_FILE = $FILE_PREFIX . "message";
$MAIL_FILE = $FILE_PREFIX . "mail";
$DEBUG = 0;
$RT_HANDLER = 1;
$MAILTO = '';
my @files = ();
my (@log_lines);
my $do_diff = 0;
my $id = getpgrp(); # note, you *must* use a shell which does setpgrp()
$LOGIN = getpwuid($<);
# }}}
die "User could not be found" unless ($LOGIN);
# {{{ parse command line arguments (file list is seen as one arg)
#
while ( my $arg = shift @ARGV ) {
if ( $arg eq '-d' ) {
$DEBUG = 1;
warn "Debug turned on...\n";
}
elsif ( $arg =~ /^--record-last-dir$/i ) {
record_last_dir( $id, $ARGV[0] );
exit(0);
}
elsif ( $arg eq '-m' ) {
$MAILTO .= ", " if $MAILTO;
$MAILTO .= shift @ARGV;
}
elsif ( $arg eq '--rt' ) {
$RT_HANDLER = 1;
}
elsif ( $arg eq '-R' ) {
$REPLYTO .= ", " if $REPLYTO;
$REPLYTO .= shift @ARGV;
}
elsif ( $arg eq '-M' ) {
die ("too many '-M' args\n") if $MODULE_NAME;
$MODULE_NAME = shift @ARGV;
}
elsif ( $arg eq '--cvs-root' ) {
$CVS_ROOT = shift @ARGV;
$CVS_ROOT .= "/" unless ($CVS_ROOT =~ /\/$/);
}
elsif ( $arg eq '--user' ) {
$cvs_user = shift @ARGV;
}
elsif ( $arg 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 = untaint($COMMITLOG);
}
elsif ( $arg eq '-D' ) {
$do_diff = 1;
}
else {
@files = split ( ' ', $arg );
last;
}
}
# }}}
$REPLYTO = $LOGIN unless ($REPLYTO);
# 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.
#
unless ($MODULE_NAME) {
($MODULE_NAME) = split ( '/', $dir, 2 );
}
if ($DEBUG) {
warn "module - ", $MODULE_NAME, "\n";
warn "dir - ", $dir, "\n";
warn "files - ", join ( " ", @files ), "\n";
warn "id - ", $id, "\n";
}
# {{{ Check for a new directory or an import command.
#
# files[0] - "-"
# files[1] - "New"
# files[2] - "directory"
#
# files[0] - "-"
# files[1] - "Imported"
# files[2] - "sources"
#
if ( $files[0] eq "-" ) {
#we just don't care about New Directory notes
unless ( $files[1] eq "New" && $files[2] eq "directory" ) {
my @text = ();
push @text, build_header();
push @text, "";
while ( my $line = <STDIN> ) {
chop $line; # Drop the newline
push @text, $line;
}
append_logfile( $COMMITLOG, @text ) if ($COMMITLOG);
mail_notification( $id, @text );
}
exit 0;
}
# }}}
# {{{ Collect just the log message from stdin.
#
while ( my $line = <STDIN> ) {
chop $line; # strip the newline
last if ( $line =~ /^Log Message:$/ );
}
while ( my $line = <STDIN> ) {
chop $line; # strip the newline
$line =~ s/\s+$//; # strip trailing white space
push @log_lines, $line;
}
my $md5 = Digest::MD5->new();
foreach my $line (@log_lines) {
$md5->add( $line . "\n" );
}
my $hash = $md5->hexdigest();
warn "hash = $hash\n" if ($DEBUG);
if ( !-e "$MESSAGE_FILE.$id.$hash" ) {
append_logfile( "$HASH_FILE.$id", $hash );
write_file( "$MESSAGE_FILE.$id.$hash", @log_lines );
}
# }}}
# Spit out the information gathered in this pass.
append_logfile( "$VERSION_FILE.$id.$hash", $dir . '/', @files );
# {{{ Check whether this is the last directory. If not, quit.
warn "Checking current dir against last dir $LASTDIR_FILE.$id\n" if ($DEBUG);
my @last_dir = read_file("$LASTDIR_FILE.$id");
unless ($CVS_ROOT) {
die "No cvs root specified with --cvs-root. Can't continue.";
}
if ( $last_dir[0] ne $CVS_ROOT . $dir ) {
warn "Current directory $CVS_ROOT$dir is not last directory $last_dir[0].\n"
if ($DEBUG);
exit 0;
}
# }}}
# {{{ 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_file("$HASH_FILE.$id");
my (@text);
push @text, build_header();
push @text, "";
my ( @added_files, @modified_files, @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]*)/ || die "*** Hacking attempt detected\n";
$hash = $1;
my @files = read_file("$VERSION_FILE.$id.$hash");
my @log_lines = read_file("$MESSAGE_FILE.$id.$hash");
my $working_on_dir; # gets set as we iterate through the files.
foreach my $file (@files) {
#If we've entered a new directory, make a note of that and remove the trailing /
if ( $file =~ s'\/$'' ) {
$working_on_dir = $file;
next;
}
my @file_entry = ( split ( ',', $file, 4 ), $working_on_dir );
# file_entry looks like ths:
# 0 1 2 3 4
# Old rev : new rev : tag: file :directory
my $entry = {};
$entry->{'old'} = $file_entry[0];
$entry->{'new'} = $file_entry[1];
$entry->{'tag'} = $file_entry[2];
$entry->{'file'} = $file_entry[3];
$entry->{'dir'} = $file_entry[4];
if ( $file_entry[0] eq 'NONE' ) {
$entry->{'old'} = '0';
push @added_files, $entry;
}
elsif ( $file_entry[1] eq 'NONE' ) {
$entry->{'new'} = '0';
push @removed_files, $entry;
}
else {
push @modified_files, $entry;
}
}
}
# }}}
# {{{ start building up the body
# 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;
@log_lines = map {
my $wasblank = $blank;
$blank = $_ eq '';
$blank && $wasblank ? () : $_;
} @log_lines;
pop @log_lines if $blank;
@modified_files = order_and_summarize_diffs(@modified_files);
@added_files = order_and_summarize_diffs(@added_files);
@removed_files = order_and_summarize_diffs(@removed_files);
push @text, "Modified Files:", format_lists(@modified_files)
if (@modified_files);
push @text, "Added Files:", format_lists(@added_files) if (@added_files);
push @text, "Removed Files:", format_lists(@removed_files) if (@removed_files);
push @text, "", "Log Message", @log_lines if (@log_lines);
push @text, "";
if ($RT_HANDLER) {
rt_handler(join('', format_diffs( @modified_files, @added_files, @removed_files )), @log_lines);
}
if ($COMMITLOG) {
append_logfile( $COMMITLOG, @text );
}
if ($do_diff) {
push @text, "";
push @text, "To generate a diff of this commit:";
push @text, format_diffs( @modified_files, @added_files, @removed_files );
push @text, "";
}
# }}}
# {{{ Mail out the notification.
mail_notification( $id, @text );
# }}}
# {{{ clean up
unless ($DEBUG) {
$hash = untaint($hash);
$id = untaint($id);
unlink "$VERSION_FILE.$id.$hash";
unlink "$MESSAGE_FILE.$id.$hash";
unlink "$MAIL_FILE.$id";
unlink "$LASTDIR_FILE.$id";
unlink "$HASH_FILE.$id";
}
# }}}
exit 0;
# {{{ Subroutines
#
# {{{ append_logfile
sub append_logfile {
my $filename = shift;
my (@lines) = @_;
$filename = untaint($filename);
open( FILE, ">>$filename" )
|| die ("Cannot open file $filename for append.\n");
foreach my $line (@lines) {
print FILE $line . "\n";
}
close(FILE);
}
# }}}
# {{{ write_file
sub write_file {
my $filename = shift;
my (@lines) = @_;
$filename = untaint($filename);
open( FILE, ">$filename" )
|| die ("Cannot open file $filename for write.\n");
foreach my $line (@lines) {
print FILE $line . "\n";
}
close(FILE);
}
# }}}
# {{{ read_file
sub read_file {
my $filename = shift;
my (@lines);
open( FILE, "<$filename" )
|| die ("Cannot open file $filename for read.\n");
while ( my $line = <FILE> ) {
chop $line;
push @lines, $line;
}
close(FILE);
return (@lines);
}
# }}}
# {{{ sub format_lists
sub format_lists {
my @items = (@_);
my $files = "";
map {
$_->{'files'} && ( $files .= ' ' . join ( ' ', @{ $_->{'files'} } ) );
} @items;
my @lines = wrap( "\t", "\t\t", $files );
return (@lines);
}
# }}}
# {{{ sub format_diffs
sub format_diffs {
my @items = (@_);
my @lines;
foreach my $item (@items) {
next unless ( $item->{'files'} );
push ( @lines,
"cvs diff -r"
. $item->{'old'} . " -r"
. $item->{'new'} . " "
. join ( " ", @{ $item->{'files'} } ) . "\n" );
}
@lines = fill( "\t", "\t\t", @lines );
return (@lines);
}
# }}}
# {{{ sub order_and_summarize_diffs {
# takes an array of file items
# returns a sorted array of fileset items, which are like file items, except they can have an array of files, rather than
# a singleton file.
sub order_and_summarize_diffs {
my @files = (@_);
# Sort by tag, dir, file.
@files = sort {
$a->{'tag'} cmp $b->{'tag'}
|| $a->{'dir'} cmp $b->{'dir'}
|| $a->{'file'} cmp $b->{'file'};
} @files;
# Combine adjacent rows that are the same modulo the file name.
my @items = (undef);
foreach my $file (@files) {
if ( $#items == -1 #if it's empty
|| ( !defined $items[-1]->{'old'}
|| $items[-1]->{'old'} ne $file->{'old'} )
|| ( !defined $items[-1]->{'new'}
|| $items[-1]->{'new'} ne $file->{'new'} )
|| ( !defined $items[-1]->{'tag'}
|| $items[-1]->{'tag'} ne $file->{'tag'} ) )
{
push ( @items, $file );
}
push ( @{ $items[-1]->{'files'} },
$file->{'dir'} . "/" . $file->{'file'} );
}
return (@items);
}
# }}}
# {{{ build_header
sub build_header {
my $now = gmtime;
my $header =
sprintf( "Module Name:\t%s\nCommitted By:\t%s\nDate:\t\t%s %s %s",
$MODULE_NAME, $LOGIN, substr( $now, 0, 19 ), "UTC",
substr( $now, 20, 4 ) );
return ($header);
}
# }}}
# {{{ mail_notification
sub mail_notification {
my $id = shift;
my (@text) = @_;
write_file( "$MAIL_FILE.$id", "From: " . $LOGIN,
"Subject: CVS commit: " . $MODULE_NAME, "To: " . $MAILTO,
"Reply-To: " . $REPLYTO, "", "", @text );
my $entity = MIME::Entity->build(
From => $LOGIN,
To => $MAILTO,
Subject => "CVS commit: " . $MODULE_NAME,
'Reply-To' => $REPLYTO,
Data => join("\n", at text)
);
#
# FIXME - This doesn't work, due to lack of RT config
#
# if ( $RT::MailCommand eq 'sendmailpipe' ) {
# open( MAIL, "|$RT::SendmailPath $RT::SendmailArguments" )
open( MAIL, "|/usr/lib/sendmail -oi -t -ODeliveryMode=b -OErrorMode=m" )
|| die "Couldn't send mail: " . $@ . "\n";
print MAIL $entity->as_string;
close(MAIL);
# }
# else {
# $entity->send( $RT::MailCommand, $RT::MailParams );
# }
}
# }}}
# {{{ sub record_last_dir
sub record_last_dir {
my $id = shift;
my $dir = shift;
# make a note of this directory. later, we'll use this to
# figure out if we've gone through the whole commit,
# for something that is a bad mockery of attomic commits.
warn "about to write $dir to $LASTDIR_FILE.$id" if ($DEBUG);
write_file( "$LASTDIR_FILE.$id", $dir );
}
# }}}
# {{{ Get the RT stuff set up
# {{{ sub rt_handler
sub rt_handler {
my $diffCommands = shift;
my $ticket = '';
my $opts;
my $act;
my $subject;
my $ticketMessage;
push @_, '#0'; # Hack to make sure we do parsing at end of message
foreach my $line (@_) {
if ($line =~ /^#([0-9][0-9,]*)(:?[sdr!]+)*$/) {
my $newTicket = $1;
my $newOpts = $2;
if ($newOpts) {
$opts = $newOpts;
}
else {
$opts = '';
}
if ($ticket ne '' and $ticket ne '0') {
foreach my $tickNo (split(/,/, $ticket)) {
# Append diff instructions, if option requests we do so
$ticketMessage .= "\nTo generate a diff of this commit:\n$diffCommands"
if ($opts =~ /d/);
# Prepend standard mail headers to ticket message
# Probably doesn't need a To:, really.
$ticketMessage = "From: $cvs_user\@$cvs_domain\nTo: $rt_address\nSubject: [$rt_name #$tickNo] $subject\n\n$ticketMessage";
my %args = (
action => $act,
message => $ticketMessage,
SessionType => 'REST' # Suppress login box
);
my $ua = LWP::UserAgent->new();
# do we need to do this? the mailgate option isn't even documented, so i guess not.
#$ua->cookie_jar( { file => $opts{jar} } );
my $r = $ua->post( "$rt_url/REST/1.0/NoAuth/mail-gateway", {%args} );
if (! $r->is_success()) {
print "rt-cvsgate: Server failure on ticket #$tickNo!\n";
}
}
}
$ticketMessage = '';
$subject = '';
$ticket = $newTicket;
if ($newOpts) {
$opts = $newOpts;
}
else {
$opts = '';
}
print "options:".$opts."\n";
$act = 'comment';
$act = 'correspond' if ($opts =~ /r/); # Reply, not comment
$subject = 'CVS Commit' unless ($opts =~ /s/); # Set subject to default, or first non-blank line?
print "subject:".$subject."\n";
$ticketMessage .= "Status: resolved\n" if ($opts =~ /!/); # Resolve ticket?
} elsif ($ticket ne '' and $ticket ne '0') {
if ($opts =~ /s/ && $subject eq '') {
$subject = $line;
} else {
$ticketMessage .= "$line\n";
}
}
}
}
# }}}
# {{{ sub untaint
sub untaint {
my $val = shift;
if ( $val =~ /^([-\#\/\w.]+)$/ ) {
$val = $1; # $data now untainted
}
else {
die "Bad data in $val"; # log this somewhere
}
return ($val);
}
# }}}
=head1 AUTHOR
Copyright (c) 1996-2002 Jesse Vincent <jesse at bestpractical.com>
rt-commit-handler is a rewritten version of the NetBSD commit handler,
which was placed in the public domain by Charles Hannum. It bore the following
authors statement:
Contributed by David Hampton <hampton at cisco.com>
Hacked greatly by Greg A. Woods <woods at planix.com>
Rewritten by Charles M. Hannum <mycroft at netbsd.org>
=cut
More information about the rt-users
mailing list