#! @PERL@ -T # -*-Perl-*- # Copyright (C) 1994-2005 The Free Software Foundation, Inc. # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2, or (at your option) # any later version. # # This program 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. ############################################################################### ############################################################################### ############################################################################### # # THIS SCRIPT IS PROBABLY BROKEN. REMOVING THE -T SWITCH ON THE #! LINE ABOVE # WOULD FIX IT, BUT THIS IS INSECURE. WE RECOMMEND FIXING THE ERRORS WHICH THE # -T SWITCH WILL CAUSE PERL TO REPORT BEFORE RUNNING THIS SCRIPT FROM A CVS # SERVER TRIGGER. PLEASE SEND PATCHES CONTAINING THE CHANGES YOU FIND # NECESSARY TO RUN THIS SCRIPT WITH THE TAINT-CHECKING ENABLED BACK TO THE # <@PACKAGE_BUGREPORT@> MAILING LIST. # # For more on general Perl security and taint-checking, please try running the # `perldoc perlsec' command. # ############################################################################### ############################################################################### ############################################################################### # XXX: FIXME: handle multiple '-f logfile' arguments # # XXX -- I HATE Perl! This *will* be re-written in shell/awk/sed soon! # # Usage: log.pl [-u user] [[-m mailto] ...] [-s] [-V] -f logfile 'dirname file ...' # # -u user - $USER passed from loginfo # -m mailto - for each user to receive cvs log reports # (multiple -m's permitted) # -s - to prevent "cvs status -v" messages # -V - without '-s', don't pass '-v' to cvs status # -f logfile - for the logfile to append to (mandatory, # but only one logfile can be specified). # here is what the output looks like: # # From: woods@kuma.domain.top # Subject: CVS update: testmodule # # Date: Wednesday November 23, 1994 @ 14:15 # Author: woods # # Update of /local/src-CVS/testmodule # In directory kuma:/home/kuma/woods/work.d/testmodule # # Modified Files: # test3 # Added Files: # test6 # Removed Files: # test4 # Log Message: # - wow, what a test # # (and for each file the "cvs status -v" output is appended unless -s is used) # # ================================================================== # File: test3 Status: Up-to-date # # Working revision: 1.41 Wed Nov 23 14:15:59 1994 # Repository revision: 1.41 /local/src-CVS/cvs/testmodule/test3,v # Sticky Options: -ko # # Existing Tags: # local-v2 (revision: 1.7) # local-v1 (revision: 1.1.1.2) # CVS-1_4A2 (revision: 1.1.1.2) # local-v0 (revision: 1.2) # CVS-1_4A1 (revision: 1.1.1.1) # CVS (branch: 1.1.1) use strict; use IO::File; my $cvsroot = $ENV{'CVSROOT'}; # turn off setgid # $) = $(; my $dostatus = 1; my $verbosestatus = 1; my $users; my $login; my $donefiles; my $logfile; my @files; # parse command line arguments # while (@ARGV) { my $arg = shift @ARGV; if ($arg eq '-m') { $users = "$users " . shift @ARGV; } elsif ($arg eq '-u') { $login = shift @ARGV; } elsif ($arg eq '-f') { ($logfile) && die "Too many '-f' args"; $logfile = shift @ARGV; } elsif ($arg eq '-s') { $dostatus = 0; } elsif ($arg eq '-V') { $verbosestatus = 0; } else { ($donefiles) && die "Too many arguments!\n"; $donefiles = 1; @files = split(/ /, $arg); } } # the first argument is the module location relative to $CVSROOT # my $modulepath = shift @files; my $mailcmd = "| Mail -s 'CVS update: $modulepath'"; # Initialise some date and time arrays # my @mos = ('January','February','March','April','May','June','July', 'August','September','October','November','December'); my @days = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday'); my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime; $year += 1900; # get a login name for the guy doing the commit.... # if ($login eq '') { $login = getlogin || (getpwuid($<))[0] || "nobody"; } # open log file for appending # my $logfh = new IO::File ">>" . $logfile or die "Could not open(" . $logfile . "): $!\n"; # send mail, if there's anyone to send to! # my $mailfh; if ($users) { $mailcmd = "$mailcmd $users"; $mailfh = new IO::File $mailcmd or die "Could not Exec($mailcmd): $!\n"; } # print out the log Header # $logfh->print ("\n"); $logfh->print ("****************************************\n"); $logfh->print ("Date:\t$days[$wday] $mos[$mon] $mday, $year @ $hour:" . sprintf("%02d", $min) . "\n"); $logfh->print ("Author:\t$login\n\n"); if ($mailfh) { $mailfh->print ("\n"); $mailfh->print ("Date:\t$days[$wday] $mos[$mon] $mday, $year @ $hour:" . sprintf("%02d", $min) . "\n"); $mailfh->print ("Author:\t$login\n\n"); } # print the stuff from logmsg that comes in on stdin to the logfile # my $infh = new IO::File "< -"; foreach ($infh->getlines) { $logfh->print; if ($mailfh) { $mailfh->print ($_); } } undef $infh; $logfh->print ("\n"); # after log information, do an 'cvs -Qq status -v' on each file in the arguments. # if ($dostatus != 0) { while (@files) { my $file = shift @files; if ($file eq "-") { $logfh->print ("[input file was '-']\n"); if ($mailfh) { $mailfh->print ("[input file was '-']\n"); } last; } my $rcsfh = new IO::File; my $pid = $rcsfh->open ("-|"); if ( !defined $pid ) { die "fork failed: $!"; } if ($pid == 0) { my @command = ('cvs', '-nQq', 'status'); if ($verbosestatus) { push @command, '-v'; } push @command, $file; exec @command; die "cvs exec failed: $!"; } my $line; while ($line = $rcsfh->getline) { $logfh->print ($line); if ($mailfh) { $mailfh->print ($line); } } undef $rcsfh; } } $logfh->close() or die "Write to $logfile failed: $!"; if ($mailfh) { $mailfh->close; die "Pipe to $mailcmd failed" if $?; } ## must exit cleanly ## exit 0;