4 # Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
6 # (Except where explictly superceded by other copyright notices)
8 # This work is made available to you under the terms of Version 2 of
9 # the GNU General Public License. A copy of that license should have
10 # been provided with this software, but in any event can be snarfed
13 # This work is distributed in the hope that it will be useful, but
14 # WITHOUT ANY WARRANTY; without even the implied warranty of
15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
16 # General Public License for more details.
18 # Unless otherwise specified, all modifications, corrections or
19 # extensions to this work which alter its source code become the
20 # property of Best Practical Solutions, LLC when submitted for
21 # inclusion in the work.
29 #ident "@(#)ccvs/contrib:$Name: $:$Id: rt-commit-handler,v 1.2 2007-08-01 22:20:32 ivan Exp $"
31 # Perl filter to handle the log messages from the checkin of files in multiple
32 # directories. This script will group the lists of files by log message, and
33 # send one piece of mail per unique message, no matter how many files are
36 =head1 NAME rt-commit-handler
44 Stick the following in in CVSROOT/commitinfo
46 ALL /opt/rt3/bin/rt-commit-handler --record-last-dir
48 Stick the following in CVSROOT/loginfo
50 ALL /opt/rt3/bin/rt-commit-handler --cvs-root /pathtocvs/root --rt %{Vvts}
52 =head2 Invocation (advanced use)
54 rt-commit-handler --cvs-root /path/to/cvs/root [-d] [-D] [-r] [-M module] \
55 [[-m mailto] ...] [[-R replyto] ...] [-f logfile]
58 -d - turn on debugging
59 -m mailto - send mail to "mailto" (multiple)
60 -R replyto - set the "Reply-To:" to "replyto" (multiple)
61 -M modulename - set module name to "modulename"
62 -f logfile - write commit messages to logfile too
63 -D - generate diff commands
64 --rt - invoke RT commit handler
65 --cvs-root - specify your CVS root
67 --record-last-dir - Record the last directory with changes in
68 pre-commit (commitinfo) mode
82 use lib ("/opt/rt3/lib", "/opt/rt3/local/lib");
84 use RT::Interface::CLI qw(CleanEnv GetCurrentUser GetMessageContent loc);
87 qw(@MAILER $TMPDIR $FILE_PREFIX $LASTDIR_FILE $HASH_FILE $VERSION_FILE $MESSAGE_FILE $MAIL_FILE $DEBUG $MAILTO $REPLYTO $id $MODULE_NAME
88 $LOGIN $COMMITLOG $CVS_ROOT $RT_HANDLER);
90 #Clean out all the nasties from the environment
93 #Load etc/config.pm and drop privs
96 #Drop setgid permissions
97 RT::DropSetGIDPermissions();
101 $FILE_PREFIX = $TMPDIR . '/#cvs.';
103 # The root of your CVS install. we should get this from some smarter place.
104 # It needs a trailing /
106 $LASTDIR_FILE = $FILE_PREFIX . "lastdir";
107 $HASH_FILE = $FILE_PREFIX . "hash";
108 $VERSION_FILE = $FILE_PREFIX . "version";
109 $MESSAGE_FILE = $FILE_PREFIX . "message";
110 $MAIL_FILE = $FILE_PREFIX . "mail";
120 my $id = getpgrp(); # note, you *must* use a shell which does setpgrp()
121 $LOGIN = getpwuid($<);
125 die "User could not be found" unless ($LOGIN);
127 # {{{ parse command line arguments (file list is seen as one arg)
129 while ( my $arg = shift @ARGV ) {
131 if ( $arg eq '-d' ) {
133 warn "Debug turned on...\n";
135 elsif ( $arg =~ /^--record-last-dir$/i ) {
136 record_last_dir( $id, $ARGV[0] );
139 elsif ( $arg eq '-m' ) {
140 $MAILTO .= ", " if $MAILTO;
141 $MAILTO .= shift @ARGV;
143 elsif ( $arg eq '--rt' ) {
146 elsif ( $arg eq '-R' ) {
147 $REPLYTO .= ", " if $REPLYTO;
148 $REPLYTO .= shift @ARGV;
150 elsif ( $arg eq '-M' ) {
151 die ("too many '-M' args\n") if $MODULE_NAME;
152 $MODULE_NAME = shift @ARGV;
154 elsif ( $arg eq '--cvs-root' ) {
155 $CVS_ROOT = shift @ARGV;
156 $CVS_ROOT .= "/" unless ( $CVS_ROOT =~ /\/$/ );
158 elsif ( $arg eq '-f' ) {
159 die ("too many '-f' args\n") if $COMMITLOG;
160 $COMMITLOG = shift @ARGV;
162 # This is a disgusting hack to untaint $COMMITLOG if we're running from
164 $COMMITLOG = untaint($COMMITLOG);
166 elsif ( $arg eq '-D' ) {
170 @files = split ( ' ', $arg );
177 $REPLYTO = $LOGIN unless ($REPLYTO);
179 # for now, the first "file" is the repository directory being committed,
180 # relative to the $CVSROOT location
182 my $dir = shift @files;
184 # XXX there are some ugly assumptions in here about module names and
185 # XXX directories relative to the $CVSROOT location -- really should
186 # XXX read $CVSROOT/CVSROOT/modules, but that's not so easy to do, since
187 # XXX we have to parse it backwards.
189 # XXX For now we set the `module' name to the top-level directory name.
191 unless ($MODULE_NAME) {
192 ($MODULE_NAME) = split ( '/', $dir, 2 );
196 warn "module - ", $MODULE_NAME, "\n";
197 warn "dir - ", $dir, "\n";
198 warn "files - ", join ( " ", @files ), "\n";
199 warn "id - ", $id, "\n";
202 # {{{ Check for a new directory or an import command.
207 # files[2] - "directory"
210 # files[1] - "Imported"
211 # files[2] - "sources"
213 if ( $files[0] eq "-" ) {
215 #we just don't care about New Directory notes
216 unless ( $files[1] eq "New" && $files[2] eq "directory" ) {
220 push @text, build_header();
223 while ( my $line = <STDIN> ) {
224 chop $line; # Drop the newline
228 append_logfile( $COMMITLOG, @text ) if ($COMMITLOG);
230 mail_notification( $id, @text );
238 # {{{ Collect just the log message from stdin.
241 while ( my $line = <STDIN> ) {
242 chop $line; # strip the newline
243 last if ( $line =~ /^Log Message:$/ );
245 while ( my $line = <STDIN> ) {
246 chop $line; # strip the newline
247 $line =~ s/\s+$//; # strip trailing white space
248 push @log_lines, $line;
251 my $md5 = Digest::MD5->new();
252 foreach my $line (@log_lines) {
253 $md5->add( $line . "\n" );
255 my $hash = $md5->hexdigest();
257 warn "hash = $hash\n" if ($DEBUG);
259 if ( !-e "$MESSAGE_FILE.$id.$hash" ) {
260 append_logfile( "$HASH_FILE.$id", $hash );
261 write_file( "$MESSAGE_FILE.$id.$hash", @log_lines );
266 # Spit out the information gathered in this pass.
268 append_logfile( "$VERSION_FILE.$id.$hash", $dir . '/', @files );
270 # {{{ Check whether this is the last directory. If not, quit.
272 warn "Checking current dir against last dir $LASTDIR_FILE.$id\n" if ($DEBUG);
274 my @last_dir = read_file("$LASTDIR_FILE.$id");
277 die "No cvs root specified with --cvs-root. Can't continue.";
280 if ( $last_dir[0] ne $CVS_ROOT . $dir ) {
281 warn "Current directory $CVS_ROOT$dir is not last directory $last_dir[0].\n"
288 # {{{ End Of Commits!
291 # This is it. The commits are all finished. Lump everything together
292 # into a single message, fire a copy off to the mailing list, and drop
293 # it on the end of the Changes file.
297 # Produce the final compilation of the log messages
300 my @hashes = read_file("$HASH_FILE.$id");
303 push @text, build_header();
306 my ( @added_files, @modified_files, @removed_files );
308 foreach my $hash (@hashes) {
310 # In case we're running setgid, make sure the hash file hasn't been hacked.
311 $hash =~ m/([a-z0-9]*)/ || die "*** Hacking attempt detected\n";
314 my @files = read_file("$VERSION_FILE.$id.$hash");
315 my @log_lines = read_file("$MESSAGE_FILE.$id.$hash");
317 my $working_on_dir; # gets set as we iterate through the files.
318 foreach my $file (@files) {
320 #If we've entered a new directory, make a note of that and remove the trailing /
322 if ( $file =~ s'\/$'' ) {
323 $working_on_dir = $file;
327 my @file_entry = ( split ( ',', $file, 4 ), $working_on_dir );
329 # file_entry looks like ths:
332 # Old rev : new rev : tag: file :directory
334 $entry->{'old'} = $file_entry[0];
335 $entry->{'new'} = $file_entry[1];
336 $entry->{'tag'} = $file_entry[2];
337 $entry->{'file'} = $file_entry[3];
338 $entry->{'dir'} = $file_entry[4];
340 if ( $file_entry[0] eq 'NONE' ) {
341 $entry->{'old'} = '0';
342 push @added_files, $entry;
344 elsif ( $file_entry[1] eq 'NONE' ) {
345 $entry->{'new'} = '0';
346 push @removed_files, $entry;
349 push @modified_files, $entry;
356 # {{{ start building up the body
358 # Strip leading and trailing blank lines from the log message. Also
359 # compress multiple blank lines in the body of the message down to a
365 my $wasblank = $blank;
367 $blank && $wasblank ? () : $_;
370 pop @log_lines if $blank;
372 @modified_files = order_and_summarize_diffs(@modified_files);
373 @added_files = order_and_summarize_diffs(@added_files);
374 @removed_files = order_and_summarize_diffs(@removed_files);
376 push @text, "Modified Files:", format_lists(@modified_files)
377 if (@modified_files);
379 push @text, "Added Files:", format_lists(@added_files) if (@added_files);
381 push @text, "Removed Files:", format_lists(@removed_files) if (@removed_files);
383 push @text, "", "Log Message", @log_lines if (@log_lines);
390 loc("To generate a diff of this commit:\n"), "\n",
391 format_diffs( @modified_files, @added_files, @removed_files )
396 append_logfile( $COMMITLOG, @text );
401 push @text, loc("To generate a diff of this commit:");
402 push @text, format_diffs( @modified_files, @added_files, @removed_files );
408 # {{{ Mail out the notification.
410 mail_notification( $id, @text );
417 $hash = untaint($hash);
419 unlink "$VERSION_FILE.$id.$hash";
420 unlink "$MESSAGE_FILE.$id.$hash";
421 unlink "$MAIL_FILE.$id";
422 unlink "$LASTDIR_FILE.$id";
423 unlink "$HASH_FILE.$id";
435 my $filename = shift;
438 $filename = untaint($filename);
440 open( FILE, ">>$filename" )
441 || die ("Cannot open file $filename for append.\n");
442 foreach my $line (@lines) {
443 print FILE $line . "\n";
452 my $filename = shift;
455 $filename = untaint($filename);
457 open( FILE, ">$filename" )
458 || die ("Cannot open file $filename for write.\n");
459 foreach my $line (@lines) {
460 print FILE $line . "\n";
469 my $filename = shift;
472 open( FILE, "<$filename" )
473 || die ("Cannot open file $filename for read.\n");
474 while ( my $line = <FILE> ) {
485 # {{{ sub format_lists
492 $_->{'files'} && ( $files .= ' ' . join ( ' ', @{ $_->{'files'} } ) );
495 my @lines = wrap( "\t", "\t\t", $files );
502 # {{{ sub format_diffs
508 foreach my $item (@items) {
509 next unless ( $item->{'files'} );
512 . $item->{'old'} . " -r"
513 . $item->{'new'} . " "
514 . join ( " ", @{ $item->{'files'} } ) . "\n" );
518 @lines = fill( "\t", "\t\t", @lines );
525 # {{{ sub order_and_summarize_diffs {
527 # takes an array of file items
528 # returns a sorted array of fileset items, which are like file items, except they can have an array of files, rather than
531 sub order_and_summarize_diffs {
535 # Sort by tag, dir, file.
537 $a->{'tag'} cmp $b->{'tag'}
538 || $a->{'dir'} cmp $b->{'dir'}
539 || $a->{'file'} cmp $b->{'file'};
542 # Combine adjacent rows that are the same modulo the file name.
546 foreach my $file (@files) {
547 if ( $#items == -1 #if it's empty
548 || ( !defined $items[-1]->{'old'}
549 || $items[-1]->{'old'} ne $file->{'old'} )
550 || ( !defined $items[-1]->{'new'}
551 || $items[-1]->{'new'} ne $file->{'new'} )
552 || ( !defined $items[-1]->{'tag'}
553 || $items[-1]->{'tag'} ne $file->{'tag'} ) )
556 push ( @items, $file );
558 push ( @{ $items[-1]->{'files'} },
559 $file->{'dir'} . "/" . $file->{'file'} );
572 sprintf( "Module Name:\t%s\nCommitted By:\t%s\nDate:\t\t%s %s %s",
573 $MODULE_NAME, $LOGIN, substr( $now, 0, 19 ), "UTC",
574 substr( $now, 20, 4 ) );
580 # {{{ mail_notification
581 sub mail_notification {
584 write_file( "$MAIL_FILE.$id", "From: " . $LOGIN,
585 "Subject: CVS commit: " . $MODULE_NAME, "To: " . $MAILTO,
586 "Reply-To: " . $REPLYTO, "", "", @text );
588 my $entity = MIME::Entity->build(
591 Subject => "CVS commit: " . $MODULE_NAME,
592 'Reply-To' => $REPLYTO,
593 Data => join ( "\n", @text )
595 if ( $RT::MailCommand eq 'sendmailpipe' ) {
596 open( MAIL, "|$RT::SendmailPath $RT::SendmailArguments" )
597 || die "Couldn't send mail: " . $@ . "\n";
598 print MAIL $entity->as_string;
602 $entity->send( $RT::MailCommand, $RT::MailParams );
609 # {{{ sub record_last_dir
611 sub record_last_dir {
615 # make a note of this directory. later, we'll use this to
616 # figure out if we've gone through the whole commit,
617 # for something that is a bad mockery of attomic commits.
619 warn "about to write $dir to $LASTDIR_FILE.$id" if ($DEBUG);
621 write_file( "$LASTDIR_FILE.$id", $dir );
626 # {{{ Get the RT stuff set up
631 my (@LogMessage) = (@_);
633 #Connect to the database and get RT::SystemUser and RT::Nobody loaded
638 #Get the current user all loaded
639 my $CurrentUser = GetCurrentUser();
641 if ( !$CurrentUser->Id ) {
643 loc("No valid RT user found. RT cvs handler disengaged. Please consult your RT administrator.\n");
647 my (@commands) = find_commands( \@LogMessage );
649 my ( @tickets, @errors );
651 # Get the list of tickets we're working with out of commands
652 grep { $_ =~ /^RT-Ticket:\s*(.*?)$/i && push ( @tickets, $1 ) } @commands;
654 my $message = new MIME::Entity;
656 From => $CurrentUser->EmailAddress,
657 Subject => 'CVS Commit',
661 # {{{ comment or correspond, as needed
663 foreach my $ticket (@tickets) {
664 my $TicketObj = RT::Ticket->new($CurrentUser);
665 $TicketObj->Load($ticket);
667 unless ( $TicketObj->Id ) {
669 "Couldn't load ticket #$ticket. Not adding commit log to ticket history.\n"
673 if ( $LogMessage[0] =~ /^(comment|private)$/ ) {
674 ( $id, $msg ) = $TicketObj->Comment( MIMEObj => $message );
678 ( $id, $msg ) = $TicketObj->Correspond( MIMEObj => $message );
681 push ( @errors, ">> Log message",
682 "Ticket #" . $TicketObj->Id . ": " . $msg );
688 my ($reply) = ActOnPseudoHeaders( $CurrentUser, @commands );
689 print "$reply\n" if ($reply);
690 print join ( "\n", @errors );
697 # {{{ sub find_commands
703 while ( my $line = shift @{$lines} ) {
704 next if $line =~ /^\s*?$/;
705 if ( $line =~ /^RT-/i ) {
707 push ( @pseudoheaders, $line );
710 #If we find a line that's not a command, get out.
712 unshift ( @{$lines}, $line );
717 return (@pseudoheaders);
723 # {{{ sub ActOnPseudoHeaders
725 =item ActOnPseudoHeaders $PseudoHeaders
727 Takes a string of pseudo-headers, iterates through them and does what they tell it to.
731 sub ActOnPseudoHeaders {
732 my $CurrentUser = shift;
733 my (@actions) = (@_);
735 my $ResultsMessage = '';
736 my $Ticket = RT::Ticket->new($CurrentUser);
738 foreach my $action (@actions) {
742 $ResultsMessage .= ">>> $action\n";
744 if ( $action =~ /^RT-(.*?):\s*(.*)$/i ) {
748 if ( $command =~ /^ticket$/i ) {
750 $val = $Ticket->Load($args);
753 loc("ERROR: Couldn't load ticket '[_1]': [_2].\n", $1, $msg);
754 . loc("Aborting to avoid unintended ticket modifications.\n")
755 . loc("The following commands were not proccessed:\n\n")
756 . join ( "\n", @actions );
757 return ($ResultsMessage);
759 $ResultsMessage .= loc("Ticket [_1] loaded\n", $Ticket->Id);
762 unless ( $Ticket->Id ) {
763 $ResultsMessage .= loc("No Ticket specified. Aborting ticket ")
764 . loc("modifications\n\n")
765 . loc("The following commands were not proccessed:\n\n")
766 . join ( "\n", @actions );
767 return ($ResultsMessage);
770 # Deal with the basics
771 if ( $command =~ /^(Subject|Owner|Status|Queue)$/i ) {
772 my $method = 'Set' . ucfirst( lc($1) );
773 ( $val, $msg ) = $Ticket->$method($args);
776 # Deal with the dates
777 elsif ( $command =~ /^(due|starts|started|resolved)$/i ) {
778 my $method = 'Set' . ucfirst( lc($1) );
779 my $date = new RT::Date($CurrentUser);
780 $date->Set( Format => 'unknown', Value => $args );
781 ( $val, $msg ) = $Ticket->$method( $date->ISO );
784 # Deal with the watchers
785 elsif ( $command =~ /^(requestor|requestors|cc|admincc)$/i ) {
788 if ( $args =~ /^(\+|\-)(.*)$/ ) {
792 $type = 'Requestor' if ( $command =~ /^requestor/i );
793 $type = 'Cc' if ( $command =~ /^cc/i );
794 $type = 'AdminCc' if ( $command =~ /^admincc/i );
796 my $user = RT::User->new($CurrentUser);
799 if ($operator eq '+') {
800 ($val, $msg) = $Ticket->AddWatcher( Type => $type,
801 PrincipalId => $user->PrincipalId);
802 } elsif ($operator eq '-') {
803 ($val, $msg) = $Ticket->DeleteWatcher( Type => $type,
804 PrincipalId => $user->PrincipalId);
808 $ResultsMessage .= $msg . "\n";
812 return ($ResultsMessage);
822 if ( $val =~ /^([-\#\/\w.]+)$/ ) {
823 $val = $1; # $data now untainted
826 die loc("Bad data in [_1]", $val); # log this somewhere
837 rt-commit-handler is a rewritten version of the NetBSD commit handler,
838 which was placed in the public domain by Charles Hannum. It bore the following
841 Contributed by David Hampton <hampton@cisco.com>
842 Hacked greatly by Greg A. Woods <woods@planix.com>
843 Rewritten by Charles M. Hannum <mycroft@netbsd.org>