changeid.pl #1

#! /usr/bin/env perl

################################################################################
## Perforce server trigger for use in conjunction with P4DTG job replication.
##
## This script can optionally:
##
##  1.  Prevent creation of new jobs in Perforce by anyone other than the
##      replication user.
##  2   Prevent modification of read-only fields of jobs in Perforce by anyone
##      other than the replication user.
##  3.  Create newly mirrored jobs using the same name as that in the defect
##      tracker.
##
## To install, add a line to your triggers table like the following:
##
##    jobId form-in job "/p4/common/site/bin/triggers/changeid.pl %user% %formfile%" 
##
## or if you're on Windows, you need to prepend the Perl interpreter like this:
##
##    jobId form-in job "c:\Perl\bin\perl.exe C:\p4\1\bin\changeid.pl %user% %formfile%" 
##
## Also, don't forget to make the file executable, change the path to the Perl
## interpreter, and set the configuration variables below.
##
## To configure, read and modify the following lines up to the comment that
## reads "END OF CONFIGURATION BLOCK".  You may also need to modify the
## definition of which fields constitute a new job based on your jobspec.  This
## is in the allowed_job() function.
##

## use strict;
## use warnings;
use File::Basename;

my $freeJobCreation = 0; # anyone can create jobs from Perforce. this trumps
                         # the $enforceROFL option.
my $enforceROFL     = 1; # enforce the read-only status of certain fields
my $sameName        = 1; # use the same job name as that in the defect tracker
my $jobPrefix       = "";# text to prepend to the name of new jobs, for use
                         # with $sameName.

# Perforce user that is allowed to create new jobs and edit read-only fields.
# This is the same user that you configured P4DTG to use.  This user defined
# here should be added to the SDP_AUTOMATION_USERS setting in the SDP Instance
# Vars file, i.e. /p4/common/config/p4_N.vars, where N is the SDP instance name.
my $p4authuser = "p4dtg";

# Server connection details.  Needed for "p4 job -o".
# Use P4BROKERPORT if a p4broker is used, otherwise change P4BROKERPORT to P4PORT
# on the next line:
my $p4 = "p4 -p $ENV{P4BROKERPORT} -u $p4authuser ";

# print debugging information to STDOUT.
my $debug = 0;

# List of job fields that are writable by anyone from within Perforce.
# The ROFL (read-only field list) is much more amusing, but usually more verbose,
# so we use the inverse, the WFL (writable field list.)  Note that the case of
# the field names must be the same as is in your jobspec.
# Typically, these are just the job fields copied or mirrored to Bugzilla.

my %wfl = (
    "BZ_STATUSRESOLUTION" => 1, "BZ_ASSIGNEDTO" => 1,
    "BZ_URL" => 1, "BZ_SEVERITY" => 1, "Summary" => 1,
    "BZ_PRIORITY" => 1, "ReportedBy" => 1,
    "BZ_VERSION" => 1
    );

# runtime absolute path of this script.
my $scriptname = abs_path( $0 );
my $shortname = basename ($scriptname);
my $logfile;

if ($ENV{LOGS}) {
    $logfile = "$ENV{LOGS}/$shortname.log";
} else {
    $logfile = "$scriptname.log";
}

## END OF CONFIGURATION BLOCK
################################################################################
## 

# turn off output buffering.
$| = 1;

use Carp                  ;
use strict                ;
use POSIX  qw( strftime ) ;
use Cwd    'abs_path'     ;

# takes the %formfile% data from is_new_job() and parses it into a hash.
sub read_form_var
{
    my @ar   = @_ ;
    my %hash      ;
    my $lino = 0  ;

    while( @ar )
    {
	$_ = shift @ar;
	$lino += 1;
	if( $debug ) { print "starting.\n"; }

	if( /^#/ || /^$/ )
	{
	    if( $debug ) { print "skipping comment/empty line:  \"$_\".\n"; }
	    next;
	}

	if( $debug ) { print "after comment:  \"$_\"\n"; }

	# "key:  word" or, "key:\n\tword".
	if( /^(\w+):\s*(.*)/ )
	{
	    if( $debug ) { print "found \"$1\" and \"$2\".\n"; }
	    my $k = $1;
	    $hash{ $k } = $2 ;
	    my $x = shift @ar;
	    if( $debug ) { print "found next \"$x\".\n"; }

	    $lino += 1;

	    while( $x =~ /^\s+(.*)/ )
	    {
		$lino += 1;
		$hash{ $k } .= $1;

		if( $debug ) { print "also found \"$1\"\n\n"; }

		$x = shift @ar;
		last if ! length $x;
	    }

	    if( ( length $x ) > 0 )
	    {
		unshift @ar, $x;
		if( $debug ) { print "pushing \"$x\" back.\n"; }
	    }
	}
	if( $debug ) { print "out:  \"$_\".\n"; }

    }
    if( $debug ) { print "out of read_form:  $lino.\n\n\n"; }

    # if the field is owned by DTG, trim any trailing whitespace
    # to accommodate non-conforming clients.  the modification to the
    # data here just affects the comparison, not saving.
    foreach my $k (keys %hash)
    {
	my $v = $hash{ $k };
	if( $k =~ /^DTG_\w+/ && $v =~ /\s+$/ )
	{
	    # we don't substitute leading whitespace since that's already
	    # trimmed by the parse.
	    $hash{ $k } =~ s/\s+$//g;
	    if( $debug )
	    {
		print "\nTrimmed whitespace in DTG field - '$k'.\n";
		print "'$v' became '$hash{$k}'\n"
	    }
	}
    }
    return %hash;
}

# run a p4 command and return the results.
sub P4()
{
    my $cmd = "@_";
    my $p4cmd = "$p4 $cmd 2>&1";
    my $result = `$p4cmd`;
    if( $result =~ /^Perforce client error:/ ||
	$result =~ /^Perforce password \(P4PASSWD\) invalid or unset\./ )
    {
	my $errmsg = "\n\n$scriptname:  Possible script configuration error.\n";
	$errmsg .= "Found Perforce error text in command result.  Command was:\n";
	$errmsg .= "\"$p4cmd\"\nResulting text is:\n\n$result\n\n";
	print LOG $errmsg;
	print $errmsg;
	close LOG;
	exit 1;
    }
    return $result;
}


# determines if a job is allowed or not.  this is based on whether or not
# the job is new, or if it doesn't touch read-only fields.
sub allowed_job()
{
    # the job as edited by the user.
    my %edjob = @_;

    my $jobname = $edjob{ "Job" };
    # check for metacharacters to prevent shell expansion.
    if( $jobname =~ /([\$\`\;\(])/g )
    { return 2; }

    # fetch the named job from the server so we can compare its
    # fields against that which the user is submitting.
    my $job = &P4( "job -o $jobname" );

    # the job of the same name as retrieved from the server.
    my %value = &read_form_var( split( /\n/, $job ) );

    if( $value{ "Job" } eq "new" )
    {
	if( $debug ) { print "Rejected as new by name.\n"; }
	return 1;
    }

    if( $debug )
    {
	foreach ( keys %edjob ) { print "edjob:  $_:  \"" . $edjob{ $_ } . "\"\n"; }
	foreach ( keys %value ) { print "value:  $_:  \"" . $value{$_}   . "\"\n"; }
    }

    # definition of a new job.  may need to be changed if jobspec differs.
    if( $value{ "Status" } =~ /unconfirmed/i &&
	$value{ "Summary" } =~ /\s*<enter description here>\s*/  ||
	$value{ "Description" } =~ /\s*<enter description here>\s*/ )
	# && $value{ "BZ_CREATIONDATE" } eq "1969/12/31 16:00:00" )
    {
	if( $debug )
	{
	    print "Rejected as new by stat/desc/date:  " .
		$value{ "Status" }. ", " .
		$value{ "Description" } . "\n";
	}
	return 1;
    }

    foreach my $k ( keys %edjob )
    {
	# some clients insert a pair of double quotes when they really
	# mean "empty field".  ignore the change if that's the case.
	if( !defined $value{ $k } && $edjob{ $k } eq '""' ) 
	{
	    next;
	}
	if( $wfl{ $k } != 1 && $edjob{ $k } ne $value{ $k } )
	{
	    if( $debug )
	    {
		print "\n\nnew by wfl:  $k:\n\"" . $edjob{ $k }  . "\"\n\"" .
		    $value{ $k } . "\"\n";
		print "l ed:  "   . length $edjob{ $k };
		print "\nl va:  " . length $value{ $k };
	    }
	    return $k;
	}
    }

    return 0;
}

sub date_format()
{
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
    my @abbr = qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec );
    $year = $year + 1900;

    return "$year-$abbr[$mon] $mday,  $hour:$min:$sec";
}

################################################################################
## MAIN

# from %user% in trigger table
my $user       = $ARGV[ 0 ];

# from %formfile% in trigger table
my $formfile   = $ARGV[ 1 ];

chomp( $user     );
chomp( $formfile );

my $now = &date_format();

if ( "$user" eq "" || "$formfile" eq "" )
{
    print "$scriptname: Error: Missing argument\n";
    exit 1;
}

open( LOG,">> $logfile" )
    or croak( "$scriptname:  Couldn't open log file \"$logfile\":  $!" );

# read the form from the temporary file on disk.
open( F, "< $formfile" )
    or croak( "$scriptname:  Couldn't open temporary file \"$formfile\": $!" );
my @f = <F>;
my %value = read_form_var( @f );
close F;

my $jobname = $value{ "Job" };

my $result = &allowed_job( %value );

if( $freeJobCreation == 1 && $result == 1 )
{
    close LOG;
    exit 0;
}

if( "$user" ne "$p4authuser" && $result )
{
    print "\n\n";
    print "$scriptname:\n\nError:\n\tYou are not authorized to ";

    if( $result == 1 )
    {
	print "create new jobs.\n";
	print LOG "$now:  user \"$user\" tried to create a new job named ";
	print LOG "\"$jobname\".\n";
    }
    elsif( $result == 2 )
    {
	print "create a job with the specified name (\"$jobname\").\n";
	print LOG "$now:  user \"$user\" tried to create a job name with ";
	print LOG "shell metacharacters (\"$jobname\").\n";
    }
    else
    {
	print "modify read-only fields in an existing job.\n\tYou modified ";
	print "the \"$result\" field.  The fields that you may\n\tmodify ";
	print "are:\n\n";
	foreach( keys %wfl ) { print "\t\t$_\n"; }

	print LOG "$now:  user \"$user\" tried to modify read-only field ";
	print LOG "\"$result\" for job \"$jobname\".\n";
    }

    print "\n";
    close LOG;
    exit 1;
}

my $dtName = $value{ "DTG_DTISSUE" };
if( $sameName == 1 && $value{ "Job" } =~ /new/i && length( $dtName ) > 0 )
{
    ## print "formfile:  $formfile\n";

    open( F, "> $formfile" ) or
croak( "$scriptname $now:  Couldn't open formfile \"$formfile\" for write.  $!"
);
    foreach my $line ( @f )
    {
        if( $line =~ /^Job:/ ) { $line = "Job: $jobPrefix$dtName\n"; }
        print F $line;
    }
    close F;
}

close LOG;

# exit, reporting to the Perforce server that the job edit can proceed.
exit 0;