*** log 2006-08-07 09:34:44.000000000 -0400 --- log.pl 2006-08-07 10:47:31.000000000 -0400 *************** *** 1,8 **** ! #! /usr/bin/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) --- 1,6 ---- ! #!/usr/bin/perl -Tw # 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) *************** *** 12,66 **** # 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 ! # 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: --- 10,50 ---- # 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. ! # # 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 ! # * requires Mail exist in this PATH: ! # /bin:/usr/bin/:/usr/local/bin # -s - to prevent "cvs status -v" messages # -V - without '-s', don't pass '-v' to cvs status ! # -f logfile - for each logfile to append to ! # * -f is no longer mandatory ! # * you can now include multiple -f options ! # * logfile names can only consist of ! # alphanumerics, dots, hyphens & underscores ! # -q - quiet (do not output log message to STDOUT) ! # ! # here is what the output looks like: ! # ! # C V S U P D A T E ! # ======================================================================== ! # DATE Friday 04 August 2006 20:43:18 ! # AUTHOR kenneth ! # MODULE CVSROOT ! # SERVER tesla.cs.columbia.edu ! # CVSROOT /home/kenneth/repository ! # ======================================================================== ! # ! # Update of /home/kenneth/repository/CVSROOT ! # In directory tesla.cs.columbia.edu:/tmp/cvs-serv23695 ! # # Modified Files: ! # checkoutlist # Added Files: ! # log.pl # Removed Files: # test4 # Log Message: *************** *** 82,117 **** # 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') { --- 66,125 ---- # local-v0 (revision: 1.2) # CVS-1_4A1 (revision: 1.1.1.1) # CVS (branch: 1.1.1) ! # ! # ! # EXAMPLES ! # ! # To have every commit message mailed to a list and written to a log, ! # add something like the following to your loginfo file: ! # ! # DEFAULT $CVSROOT/CVSROOT/log.pl %s -f $CVSROOT/commit.log -m myproject@example.com ! # ! # don't forget to add log.pl to your CVSROOT (make it executable first), ! # and list it in checkoutlist use strict; use IO::File; + # see perldoc perlsec + delete @ENV{qw(IFS CDPATH ENV BASH_ENV)}; # Make %ENV safer + $ENV{PATH} = '/bin:/usr/bin:/usr/local/bin'; + my $cvsroot = $ENV{'CVSROOT'}; # turn off setgid $) = $(; my $dostatus = 1; + my $quiet = 0; my $verbosestatus = 1; ! my $users = ''; ! my $user = ''; ! my $login = ''; my $donefiles; ! my $logfile; ! my @logfiles; my @files; # parse command line arguments while (@ARGV) { my $arg = shift @ARGV; if ($arg eq '-m') { ! $user = shift @ARGV; ! $user =~ m/^([\w\d\/\.\-\@]+)$/ or die "bad user: $user\n"; ! $user = $1; ! $users = "$users $user"; } elsif ($arg eq '-u') { $login = shift @ARGV; } elsif ($arg eq '-f') { $logfile = shift @ARGV; + # $logfile only has allowed chars? + $logfile =~ m/^([\w\d\/\.\-\_]+)$/ or die "bad logfile: $logfile\n"; + # untaint + $logfile = $1; + push(@logfiles, $logfile) + } elsif ($arg eq '-q') { + $quiet = 1; } elsif ($arg eq '-s') { $dostatus = 0; } elsif ($arg eq '-V') { *************** *** 124,204 **** } # 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: $!"; } --- 132,198 ---- } # the first argument is the module location relative to $CVSROOT ! my $modulepath = shift @files; ! $modulepath =~ m/^([^\n]+)$/ or die "bad modulepath: $modulepath\n"; ! $modulepath = $1; 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; + $mday = sprintf('%02d', $mday); + $min = sprintf('%02d', $min); + $hour = sprintf('%02d', $hour); + $sec = sprintf('%02d', $sec); ! # get a login name if ($login eq '') { $login = getlogin || (getpwuid($<))[0] || "nobody"; } ! chomp(my $server = `hostname`); ! my $stdin = join('', ()); ! my $logmsg = <open("-|"); ! if ( ! defined $pid ) { die "fork failed: $!"; } *************** *** 210,238 **** 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; --- 204,239 ---- push @command, '-v'; } push @command, $file; ! exec @command ! or die "cvs exec failed: $!"; } my $line; while ($line = $rcsfh->getline) { ! $statusmsg .= $line; } undef $rcsfh; } } ! # write to logfiles, if any ! foreach (@logfiles) { ! $logfile = $_; ! my $logfh = new IO::File ">>" . $logfile ! or die "Could not open(" . $logfile . "): $!\n"; ! $logfh->print($logmsg . $statusmsg); ! $logfh->close() or die "Write to $logfile failed: $!"; ! } ! # 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"; ! $mailfh->print($logmsg . $statusmsg); ! $mailfh->close ! or die "Pipe to $mailcmd failed" if $?; } ! # must exit cleanly exit 0;