• merge latest version of rannotate code from corecode
[alioth/cvs.git] / contrib / log.in
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
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;