Home | History | Annotate | Line # | Download | only in contrib 
      1 #! @PERL@ -T
      2 # -*-Perl-*-
      3 
      4 # Copyright (C) 1994-2005 The Free Software Foundation, Inc.
      5 
      6 # This program is free software; you can redistribute it and/or modify
      7 # it under the terms of the GNU General Public License as published by
      8 # the Free Software Foundation; either version 2, or (at your option)
      9 # any later version.
     10 #
     11 # This program is distributed in the hope that it will be useful,
     12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
     13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     14 # GNU General Public License for more details.
     15 
     16 ###############################################################################
     17 ###############################################################################
     18 ###############################################################################
     19 #
     20 # THIS SCRIPT IS PROBABLY BROKEN.  REMOVING THE -T SWITCH ON THE #! LINE ABOVE
     21 # WOULD FIX IT, BUT THIS IS INSECURE.  WE RECOMMEND FIXING THE ERRORS WHICH THE
     22 # -T SWITCH WILL CAUSE PERL TO REPORT BEFORE RUNNING THIS SCRIPT FROM A CVS
     23 # SERVER TRIGGER.  PLEASE SEND PATCHES CONTAINING THE CHANGES YOU FIND
     24 # NECESSARY TO RUN THIS SCRIPT WITH THE TAINT-CHECKING ENABLED BACK TO THE
     25 # <@PACKAGE_BUGREPORT@> MAILING LIST.
     26 #
     27 # For more on general Perl security and taint-checking, please try running the
     28 # `perldoc perlsec' command.
     29 #
     30 ###############################################################################
     31 ###############################################################################
     32 ###############################################################################
     33 
     34 # XXX: FIXME: handle multiple '-f logfile' arguments
     35 #
     36 # XXX -- I HATE Perl!  This *will* be re-written in shell/awk/sed soon!
     37 #
     38 
     39 # Usage:  log.pl [-u user] [[-m mailto] ...] [-s] [-V] -f logfile 'dirname file ...'
     40 #
     41 #	-u user		- $USER passed from loginfo
     42 #	-m mailto	- for each user to receive cvs log reports
     43 #			(multiple -m's permitted)
     44 #	-s		- to prevent "cvs status -v" messages
     45 #	-V		- without '-s', don't pass '-v' to cvs status
     46 #	-f logfile	- for the logfile to append to (mandatory,
     47 #			but only one logfile can be specified).
     48 
     49 # here is what the output looks like:
     50 #
     51 #    From: woods (at] kuma.domain.top
     52 #    Subject: CVS update: testmodule
     53 #
     54 #    Date: Wednesday November 23, 1994 @ 14:15
     55 #    Author: woods
     56 #
     57 #    Update of /local/src-CVS/testmodule
     58 #    In directory kuma:/home/kuma/woods/work.d/testmodule
     59 #    
     60 #    Modified Files:
     61 #    	test3 
     62 #    Added Files:
     63 #    	test6 
     64 #    Removed Files:
     65 #    	test4 
     66 #    Log Message:
     67 #    - wow, what a test
     68 #
     69 # (and for each file the "cvs status -v" output is appended unless -s is used)
     70 #
     71 #    ==================================================================
     72 #    File: test3           	Status: Up-to-date
     73 #    
     74 #       Working revision:	1.41	Wed Nov 23 14:15:59 1994
     75 #       Repository revision:	1.41	/local/src-CVS/cvs/testmodule/test3,v
     76 #       Sticky Options:	-ko
     77 #    
     78 #       Existing Tags:
     79 #    	local-v2                 	(revision: 1.7)
     80 #    	local-v1                 	(revision: 1.1.1.2)
     81 #    	CVS-1_4A2                	(revision: 1.1.1.2)
     82 #    	local-v0                 	(revision: 1.2)
     83 #    	CVS-1_4A1                	(revision: 1.1.1.1)
     84 #    	CVS                      	(branch: 1.1.1)
     85 
     86 use strict;
     87 use IO::File;
     88 
     89 my $cvsroot = $ENV{'CVSROOT'};
     90 
     91 # turn off setgid
     92 #
     93 $) = $(;
     94 
     95 my $dostatus = 1;
     96 my $verbosestatus = 1;
     97 my $users;
     98 my $login;
     99 my $donefiles;
    100 my $logfile;
    101 my @files;
    102 
    103 # parse command line arguments
    104 #
    105 while (@ARGV) {
    106 	my $arg = shift @ARGV;
    107 
    108 	if ($arg eq '-m') {
    109 		$users = "$users " . shift @ARGV;
    110 	} elsif ($arg eq '-u') {
    111 		$login = shift @ARGV;
    112 	} elsif ($arg eq '-f') {
    113 		($logfile) && die "Too many '-f' args";
    114 		$logfile = shift @ARGV;
    115 	} elsif ($arg eq '-s') {
    116 		$dostatus = 0;
    117 	} elsif ($arg eq '-V') {
    118 		$verbosestatus = 0;
    119 	} else {
    120 		($donefiles) && die "Too many arguments!\n";
    121 		$donefiles = 1;
    122 		@files = split(/ /, $arg);
    123 	}
    124 }
    125 
    126 # the first argument is the module location relative to $CVSROOT
    127 #
    128 my $modulepath = shift @files;
    129 
    130 my $mailcmd = "| Mail -s 'CVS update: $modulepath'";
    131 
    132 # Initialise some date and time arrays
    133 #
    134 my @mos = ('January','February','March','April','May','June','July',
    135 	'August','September','October','November','December');
    136 my @days = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday');
    137 
    138 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime;
    139 $year += 1900;
    140 
    141 # get a login name for the guy doing the commit....
    142 #
    143 if ($login eq '') {
    144 	$login = getlogin || (getpwuid($<))[0] || "nobody";
    145 }
    146 
    147 # open log file for appending
    148 #
    149 my $logfh = new IO::File ">>" . $logfile
    150 	or die "Could not open(" . $logfile . "): $!\n";
    151 
    152 # send mail, if there's anyone to send to!
    153 #
    154 my $mailfh;
    155 if ($users) {
    156 	$mailcmd = "$mailcmd $users";
    157 	$mailfh = new IO::File $mailcmd
    158 		or die "Could not Exec($mailcmd): $!\n";
    159 }
    160 
    161 # print out the log Header
    162 #
    163 $logfh->print ("\n");
    164 $logfh->print ("****************************************\n");
    165 $logfh->print ("Date:\t$days[$wday] $mos[$mon] $mday, $year @ $hour:" . sprintf("%02d", $min) . "\n");
    166 $logfh->print ("Author:\t$login\n\n");
    167 
    168 if ($mailfh) {
    169 	$mailfh->print ("\n");
    170 	$mailfh->print ("Date:\t$days[$wday] $mos[$mon] $mday, $year @ $hour:" . sprintf("%02d", $min) . "\n");
    171 	$mailfh->print ("Author:\t$login\n\n");
    172 }
    173 
    174 # print the stuff from logmsg that comes in on stdin to the logfile
    175 #
    176 my $infh = new IO::File "< -";
    177 foreach ($infh->getlines) {
    178 	$logfh->print;
    179 	if ($mailfh) {
    180 		$mailfh->print ($_);
    181 	}
    182 }
    183 undef $infh;
    184 
    185 $logfh->print ("\n");
    186 
    187 # after log information, do an 'cvs -Qq status -v' on each file in the arguments.
    188 #
    189 if ($dostatus != 0) {
    190 	while (@files) {
    191 		my $file = shift @files;
    192 		if ($file eq "-") {
    193 			$logfh->print ("[input file was '-']\n");
    194 			if ($mailfh) {
    195 				$mailfh->print ("[input file was '-']\n");
    196 			}
    197 			last;
    198 		}
    199 		my $rcsfh = new IO::File;
    200 		my $pid = $rcsfh->open ("-|");
    201 		if ( !defined $pid )
    202 		{
    203 			die "fork failed: $!";
    204 		}
    205 		if ($pid == 0)
    206 		{
    207 			my @command = ('cvs', '-nQq', 'status');
    208 			if ($verbosestatus)
    209 			{
    210 				push @command, '-v';
    211 			}
    212 			push @command, $file;
    213 			exec @command;
    214 			die "cvs exec failed: $!";
    215 		}
    216 		my $line;
    217 		while ($line = $rcsfh->getline) {
    218 			$logfh->print ($line);
    219 			if ($mailfh) {
    220 				$mailfh->print ($line);
    221 			}
    222 		}
    223 		undef $rcsfh;
    224 	}
    225 }
    226 
    227 $logfh->close()
    228 	or die "Write to $logfile failed: $!";
    229 
    230 if ($mailfh)
    231 {
    232 	$mailfh->close;
    233 	die "Pipe to $mailcmd failed" if $?;
    234 }
    235 
    236 ## must exit cleanly
    237 ##
    238 exit 0;
    239