external/gpl2/xcvs/dist/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;