1 |
#! xPERL_PATHx |
#! @PERL@ -T |
2 |
# -*-Perl-*- |
# -*-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 |
# XXX: FIXME: handle multiple '-f logfile' arguments |
35 |
# |
# |
36 |
# XXX -- I HATE Perl! This *will* be re-written in shell/awk/sed soon! |
# 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] -f logfile 'dirname file ...' |
# Usage: log.pl [-u user] [[-m mailto] ...] [-s] [-V] -f logfile 'dirname file ...' |
40 |
# |
# |
41 |
# -u user - $USER passed from loginfo |
# -u user - $USER passed from loginfo |
42 |
# -m mailto - for each user to receive cvs log reports |
# -m mailto - for each user to receive cvs log reports |
43 |
# (multiple -m's permitted) |
# (multiple -m's permitted) |
44 |
# -s - to prevent "cvs status -v" messages |
# -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, |
# -f logfile - for the logfile to append to (mandatory, |
47 |
# but only one logfile can be specified). |
# but only one logfile can be specified). |
48 |
|
|
83 |
# CVS-1_4A1 (revision: 1.1.1.1) |
# CVS-1_4A1 (revision: 1.1.1.1) |
84 |
# CVS (branch: 1.1.1) |
# CVS (branch: 1.1.1) |
85 |
|
|
86 |
$cvsroot = $ENV{'CVSROOT'}; |
use strict; |
87 |
|
use IO::File; |
88 |
|
|
89 |
|
my $cvsroot = $ENV{'CVSROOT'}; |
90 |
|
|
91 |
# turn off setgid |
# turn off setgid |
92 |
# |
# |
93 |
$) = $(; |
$) = $(; |
94 |
|
|
95 |
$dostatus = 1; |
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 |
# parse command line arguments |
104 |
# |
# |
105 |
while (@ARGV) { |
while (@ARGV) { |
106 |
$arg = shift @ARGV; |
my $arg = shift @ARGV; |
107 |
|
|
108 |
if ($arg eq '-m') { |
if ($arg eq '-m') { |
109 |
$users = "$users " . shift @ARGV; |
$users = "$users " . shift @ARGV; |
110 |
} elsif ($arg eq '-u') { |
} elsif ($arg eq '-u') { |
111 |
$login = shift @ARGV; |
$login = shift @ARGV; |
112 |
} elsif ($arg eq '-f') { |
} elsif ($arg eq '-f') { |
114 |
$logfile = shift @ARGV; |
$logfile = shift @ARGV; |
115 |
} elsif ($arg eq '-s') { |
} elsif ($arg eq '-s') { |
116 |
$dostatus = 0; |
$dostatus = 0; |
117 |
|
} elsif ($arg eq '-V') { |
118 |
|
$verbosestatus = 0; |
119 |
} else { |
} else { |
120 |
($donefiles) && die "Too many arguments!\n"; |
($donefiles) && die "Too many arguments!\n"; |
121 |
$donefiles = 1; |
$donefiles = 1; |
125 |
|
|
126 |
# the first argument is the module location relative to $CVSROOT |
# the first argument is the module location relative to $CVSROOT |
127 |
# |
# |
128 |
$modulepath = shift @files; |
my $modulepath = shift @files; |
129 |
|
|
130 |
$mailcmd = "| Mail -s 'CVS update: $modulepath'"; |
my $mailcmd = "| Mail -s 'CVS update: $modulepath'"; |
131 |
|
|
132 |
# Initialise some date and time arrays |
# Initialise some date and time arrays |
133 |
# |
# |
134 |
@mos = (January,February,March,April,May,June,July,August,September, |
my @mos = ('January','February','March','April','May','June','July', |
135 |
October,November,December); |
'August','September','October','November','December'); |
136 |
@days = (Sunday,Monday,Tuesday,Wednesday,Thursday,Friday,Saturday); |
my @days = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday'); |
137 |
|
|
138 |
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime; |
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime; |
139 |
$year += 1900; |
$year += 1900; |
140 |
|
|
141 |
# get a login name for the guy doing the commit.... |
# get a login name for the guy doing the commit.... |
146 |
|
|
147 |
# open log file for appending |
# open log file for appending |
148 |
# |
# |
149 |
open(OUT, ">>" . $logfile) || die "Could not open(" . $logfile . "): $!\n"; |
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! |
# send mail, if there's anyone to send to! |
153 |
# |
# |
154 |
|
my $mailfh; |
155 |
if ($users) { |
if ($users) { |
156 |
$mailcmd = "$mailcmd $users"; |
$mailcmd = "$mailcmd $users"; |
157 |
open(MAIL, $mailcmd) || die "Could not Exec($mailcmd): $!\n"; |
$mailfh = new IO::File $mailcmd |
158 |
|
or die "Could not Exec($mailcmd): $!\n"; |
159 |
} |
} |
160 |
|
|
161 |
# print out the log Header |
# print out the log Header |
162 |
# |
# |
163 |
print OUT "\n"; |
$logfh->print ("\n"); |
164 |
print OUT "****************************************\n"; |
$logfh->print ("****************************************\n"); |
165 |
print OUT "Date:\t$days[$wday] $mos[$mon] $mday, $year @ $hour:" . sprintf("%02d", $min) . "\n"; |
$logfh->print ("Date:\t$days[$wday] $mos[$mon] $mday, $year @ $hour:" . sprintf("%02d", $min) . "\n"); |
166 |
print OUT "Author:\t$login\n\n"; |
$logfh->print ("Author:\t$login\n\n"); |
167 |
|
|
168 |
if (MAIL) { |
if ($mailfh) { |
169 |
print MAIL "\n"; |
$mailfh->print ("\n"); |
170 |
print MAIL "Date:\t$days[$wday] $mos[$mon] $mday, $year @ $hour:" . sprintf("%02d", $min) . "\n"; |
$mailfh->print ("Date:\t$days[$wday] $mos[$mon] $mday, $year @ $hour:" . sprintf("%02d", $min) . "\n"); |
171 |
print MAIL "Author:\t$login\n\n"; |
$mailfh->print ("Author:\t$login\n\n"); |
172 |
} |
} |
173 |
|
|
174 |
# print the stuff from logmsg that comes in on stdin to the logfile |
# print the stuff from logmsg that comes in on stdin to the logfile |
175 |
# |
# |
176 |
open(IN, "-"); |
my $infh = new IO::File "< -"; |
177 |
while (<IN>) { |
foreach ($infh->getlines) { |
178 |
print OUT $_; |
$logfh->print; |
179 |
if (MAIL) { |
if ($mailfh) { |
180 |
print MAIL $_; |
$mailfh->print ($_); |
181 |
} |
} |
182 |
} |
} |
183 |
close(IN); |
undef $infh; |
184 |
|
|
185 |
print OUT "\n"; |
$logfh->print ("\n"); |
186 |
|
|
187 |
# after log information, do an 'cvs -Qq status -v' on each file in the arguments. |
# after log information, do an 'cvs -Qq status -v' on each file in the arguments. |
188 |
# |
# |
189 |
if ($dostatus != 0) { |
if ($dostatus != 0) { |
190 |
while (@files) { |
while (@files) { |
191 |
$file = shift @files; |
my $file = shift @files; |
192 |
if ($file eq "-") { |
if ($file eq "-") { |
193 |
print OUT "[input file was '-']\n"; |
$logfh->print ("[input file was '-']\n"); |
194 |
if (MAIL) { |
if ($mailfh) { |
195 |
print MAIL "[input file was '-']\n"; |
$mailfh->print ("[input file was '-']\n"); |
196 |
} |
} |
197 |
last; |
last; |
198 |
} |
} |
199 |
$pid = open(RCS, "-|"); |
my $rcsfh = new IO::File; |
200 |
|
my $pid = $rcsfh->open ("-|"); |
201 |
if ( !defined $pid ) |
if ( !defined $pid ) |
202 |
{ |
{ |
203 |
die "fork failed: $!"; |
die "fork failed: $!"; |
204 |
} |
} |
205 |
if ($pid == 0) |
if ($pid == 0) |
206 |
{ |
{ |
207 |
exec 'cvs', '-nQq', 'status', '-v', $file; |
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: $!"; |
die "cvs exec failed: $!"; |
215 |
} |
} |
216 |
while (<RCS>) { |
my $line; |
217 |
print OUT; |
while ($line = $rcsfh->getline) { |
218 |
if (MAIL) { |
$logfh->print ($line); |
219 |
print MAIL; |
if ($mailfh) { |
220 |
|
$mailfh->print ($line); |
221 |
} |
} |
222 |
} |
} |
223 |
close(RCS); |
undef $rcsfh; |
224 |
} |
} |
225 |
} |
} |
226 |
|
|
227 |
close(OUT); |
$logfh->close() |
228 |
die "Write to $logfile failed" if $?; |
or die "Write to $logfile failed: $!"; |
229 |
|
|
230 |
close(MAIL); |
if ($mailfh) |
231 |
die "Pipe to $mailcmd failed" if $?; |
{ |
232 |
|
$mailfh->close; |
233 |
|
die "Pipe to $mailcmd failed" if $?; |
234 |
|
} |
235 |
|
|
236 |
## must exit cleanly |
## must exit cleanly |
237 |
## |
## |