diff options
Diffstat (limited to 'rt/bin/rt-commit-handler.in')
| -rw-r--r-- | rt/bin/rt-commit-handler.in | 846 |
1 files changed, 0 insertions, 846 deletions
diff --git a/rt/bin/rt-commit-handler.in b/rt/bin/rt-commit-handler.in deleted file mode 100644 index 02b01ab..0000000 --- a/rt/bin/rt-commit-handler.in +++ /dev/null @@ -1,846 +0,0 @@ -#!@PERL@ -w -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work 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. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK - -# {{{ Docs -# -*-Perl-*- -# -#ident "@(#)ccvs/contrib:$Name: $:$Id: rt-commit-handler.in,v 1.1 2003-07-15 13:16:15 ivan 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-commit-handler - -=head1 USAGE - - - -=head2 Regular use - -Stick the following in in CVSROOT/commitinfo - - ALL @RT_BIN_PATH@/rt-commit-handler --record-last-dir - -Stick the following in CVSROOT/loginfo - - ALL @RT_BIN_PATH@/rt-commit-handler --cvs-root /pathtocvs/root --rt %{Vvts} - -=head2 Invocation (advanced use) - -rt-commit-handler --cvs-root /path/to/cvs/root [-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 - - --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 lib ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@"); - -use RT::Interface::CLI qw(CleanEnv GetCurrentUser GetMessageContent loc); - -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); - -#Clean out all the nasties from the environment -CleanEnv(); - -#Load etc/config.pm and drop privs -RT::LoadConfig(); - -#Drop setgid permissions -RT::DropSetGIDPermissions(); - -# {{{ 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 '-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( - @log_lines, "\n", - loc("To generate a diff of this commit:\n"), "\n", - format_diffs( @modified_files, @added_files, @removed_files ) - ); -} - -if ($COMMITLOG) { - append_logfile( $COMMITLOG, @text ); -} - -if ($do_diff) { - push @text, ""; - push @text, loc("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", @text ) - ); - if ( $RT::MailCommand eq 'sendmailpipe' ) { - open( MAIL, "|$RT::SendmailPath $RT::SendmailArguments" ) - || 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 (@LogMessage) = (@_); - - #Connect to the database and get RT::SystemUser and RT::Nobody loaded - RT::Init; - - require RT::Ticket; - - #Get the current user all loaded - my $CurrentUser = GetCurrentUser(); - - if ( !$CurrentUser->Id ) { - print -loc("No valid RT user found. RT cvs handler disengaged. Please consult your RT administrator.\n"); - return; - } - - my (@commands) = find_commands( \@LogMessage ); - - my ( @tickets, @errors ); - - # Get the list of tickets we're working with out of commands - grep { $_ =~ /^RT-Ticket:\s*(.*?)$/i && push ( @tickets, $1 ) } @commands; - - my $message = new MIME::Entity; - $message->build( - From => $CurrentUser->EmailAddress, - Subject => 'CVS Commit', - Data => \@LogMessage - ); - - # {{{ comment or correspond, as needed - - foreach my $ticket (@tickets) { - my $TicketObj = RT::Ticket->new($CurrentUser); - $TicketObj->Load($ticket); - my ( $id, $msg ); - unless ( $TicketObj->Id ) { - push ( @errors, -"Couldn't load ticket #$ticket. Not adding commit log to ticket history.\n" - ); - } - - if ( $LogMessage[0] =~ /^(comment|private)$/ ) { - ( $id, $msg ) = $TicketObj->Comment( MIMEObj => $message ); - - } - else { - ( $id, $msg ) = $TicketObj->Correspond( MIMEObj => $message ); - } - - push ( @errors, ">> Log message", - "Ticket #" . $TicketObj->Id . ": " . $msg ); - - } - - # }}} - - my ($reply) = ActOnPseudoHeaders( $CurrentUser, @commands ); - print "$reply\n" if ($reply); - print join ( "\n", @errors ); - print "\n"; - -} - -# }}} - -# {{{ sub find_commands - -sub find_commands { - my $lines = shift; - my (@pseudoheaders); - - while ( my $line = shift @{$lines} ) { - next if $line =~ /^\s*?$/; - if ( $line =~ /^RT-/i ) { - - push ( @pseudoheaders, $line ); - } - - #If we find a line that's not a command, get out. - else { - unshift ( @{$lines}, $line ); - last; - } - } - - return (@pseudoheaders); - -} - -# }}} - -# {{{ sub ActOnPseudoHeaders - -=item ActOnPseudoHeaders $PseudoHeaders - -Takes a string of pseudo-headers, iterates through them and does what they tell it to. - -=cut - -sub ActOnPseudoHeaders { - my $CurrentUser = shift; - my (@actions) = (@_); - - my $ResultsMessage = ''; - my $Ticket = RT::Ticket->new($CurrentUser); - - foreach my $action (@actions) { - my ($val); - my $msg = ''; - - $ResultsMessage .= ">>> $action\n"; - - if ( $action =~ /^RT-(.*?):\s*(.*)$/i ) { - my $command = $1; - my $args = $2; - - if ( $command =~ /^ticket$/i ) { - - $val = $Ticket->Load($args); - unless ($val) { - $ResultsMessage .= - loc("ERROR: Couldn't load ticket '[_1]': [_2].\n", $1, $msg); - . loc("Aborting to avoid unintended ticket modifications.\n") - . loc("The following commands were not proccessed:\n\n") - . join ( "\n", @actions ); - return ($ResultsMessage); - } - $ResultsMessage .= loc("Ticket [_1] loaded\n", $Ticket->Id); - } - else { - unless ( $Ticket->Id ) { - $ResultsMessage .= loc("No Ticket specified. Aborting ticket ") - . loc("modifications\n\n") - . loc("The following commands were not proccessed:\n\n") - . join ( "\n", @actions ); - return ($ResultsMessage); - } - - # Deal with the basics - if ( $command =~ /^(Subject|Owner|Status|Queue)$/i ) { - my $method = 'Set' . ucfirst( lc($1) ); - ( $val, $msg ) = $Ticket->$method($args); - } - - # Deal with the dates - elsif ( $command =~ /^(due|starts|started|resolved)$/i ) { - my $method = 'Set' . ucfirst( lc($1) ); - my $date = new RT::Date($CurrentUser); - $date->Set( Format => 'unknown', Value => $args ); - ( $val, $msg ) = $Ticket->$method( $date->ISO ); - } - - # Deal with the watchers - elsif ( $command =~ /^(requestor|requestors|cc|admincc)$/i ) { - my $operator = "+"; - my ($type); - if ( $args =~ /^(\+|\-)(.*)$/ ) { - $operator = $1; - $args = $2; - } - $type = 'Requestor' if ( $command =~ /^requestor/i ); - $type = 'Cc' if ( $command =~ /^cc/i ); - $type = 'AdminCc' if ( $command =~ /^admincc/i ); - - my $user = RT::User->new($CurrentUser); - $user->Load($args); - - if ($operator eq '+') { - ($val, $msg) = $Ticket->AddWatcher( Type => $type, - PrincipalId => $user->PrincipalId); - } elsif ($operator eq '-') { - ($val, $msg) = $Ticket->DeleteWatcher( Type => $type, - PrincipalId => $user->PrincipalId); - } - - } - $ResultsMessage .= $msg . "\n"; - } - - } - return ($ResultsMessage); - -} - -# }}} - -# {{{ sub untaint -sub untaint { - my $val = shift; - - if ( $val =~ /^([-\#\/\w.]+)$/ ) { - $val = $1; # $data now untainted - } - else { - die loc("Bad data in [_1]", $val); # log this somewhere - } - return ($val); -} - -# }}} - -=head1 AUTHOR - - - - 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@cisco.com> - Hacked greatly by Greg A. Woods <woods@planix.com> - Rewritten by Charles M. Hannum <mycroft@netbsd.org> - -=cut - |