path: root/rt/bin/rt-commit-handler.in

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