xref: /dragonfly/contrib/cvs-1.12/contrib/log.in (revision abf903a5) 
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@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
86use strict;
87use IO::File;
88
89my $cvsroot = $ENV{'CVSROOT'};
90
91# turn off setgid
92#
93$) = $(;
94
95my $dostatus = 1;
96my $verbosestatus = 1;
97my $users;
98my $login;
99my $donefiles;
100my $logfile;
101my @files;
102
103# parse command line arguments
104#
105while (@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#
128my $modulepath = shift @files;
129
130my $mailcmd = "| Mail -s 'CVS update: $modulepath'";
131
132# Initialise some date and time arrays
133#
134my @mos = ('January','February','March','April','May','June','July',
135	'August','September','October','November','December');
136my @days = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday');
137
138my ($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#
143if ($login eq '') {
144	$login = getlogin || (getpwuid($<))[0] || "nobody";
145}
146
147# open log file for appending
148#
149my $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#
154my $mailfh;
155if ($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
168if ($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#
176my $infh = new IO::File "< -";
177foreach ($infh->getlines) {
178	$logfh->print;
179	if ($mailfh) {
180		$mailfh->print ($_);
181	}
182}
183undef $infh;
184
185$logfh->print ("\n");
186
187# after log information, do an 'cvs -Qq status -v' on each file in the arguments.
188#
189if ($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
230if ($mailfh)
231{
232	$mailfh->close;
233	die "Pipe to $mailcmd failed" if $?;
234}
235
236## must exit cleanly
237##
238exit 0;
239