/[cvs]/ccvs/contrib/log.pl
ViewVC logotype

Diff of /ccvs/contrib/log.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.9 by dprice, Fri Jan 5 18:18:18 2001 UTC revision 1.10 by dprice, Thu Oct 6 20:25:12 2005 UTC
# Line 1  Line 1 
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    
# Line 52  Line 83 
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') {
# Line 74  while (@ARGV) { Line 114  while (@ARGV) {
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;
# Line 83  while (@ARGV) { Line 125  while (@ARGV) {
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....
# Line 104  if ($login eq '') { Line 146  if ($login eq '') {
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  ##  ##

Legend:
Removed from v.1.9  
changed lines
  Added in v.1.10

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26