CVSROOT/commit_prep

   1 #! /usr/bin/perl
   2 # -*-Perl-*-
   3 #
   4 #ident  "@(#)cvs/contrib:$Name:  $:$Id: commit_prep,v 1.1 2006/05/09 01:06:37 bdemsky Exp $"
   5
   6 # first thing: delegate to cvs_acls for access controls.
   7 system "$CVSROOT/CVSROOT/cvs_acls" == 0
   8     or exit 1; # bad access controls!
   9
  10 #
  11 # Perl filter to handle pre-commit checking of files.  This program
  12 # records the last directory where commits will be taking place for
  13 # use by the log_accum.pl script.  For new files, it forces the
  14 # existence of a RCS "Id" keyword in the first ten lines of the file.
  15 # For existing files, it checks version number in the "Id" line to
  16 # prevent losing changes because an old version of a file was copied
  17 # into the direcory.
  18 #
  19 # Possible future enhancements:
  20 #
  21 #    Check for cruft left by unresolved conflicts.  Search for
  22 #    "^<<<<<<<$", "^-------$", and "^>>>>>>>$".
  23 #
  24 #    Look for a copyright and automagically update it to the
  25 #    current year.  [[ bad idea!  -- woods ]]
  26 #
  27 #
  28 # Contributed by David Hampton <hampton@cisco.com>
  29 #
  30 # Hacked on lots by Greg A. Woods <woods@web.net>
  31
  32 #
  33 #       Configurable options
  34 #
  35
  36 # Constants (remember to protect strings from RCS keyword substitution)
  37 #
  38 $LAST_FILE     = "/tmp/#cvs.lastdir"; # must match name in log_accum.pl
  39 $DIFF_FILE     = "/tmp/#cvs.diff";    # must match name in log_accum.pl
  40 $ENTRIES       = "CVS/Entries";
  41
  42 # Patterns to find $Log keywords in files
  43 #
  44 $LogString1 = "\\\$\\Log: .* \\\$";
  45 $LogString2 = "\\\$\\Log\\\$";
  46 $NoLog = "%s - contains an RCS \$Log keyword.  It must not!\n";
  47
  48 # pattern to match an RCS Id keyword line with an existing ID
  49 #
  50 $IDstring = "\"@\\(#\\)[^:]*:.*\\\$\Id: .*\\\$\"";
  51 $NoId = "
  52 %s - Does not contain a properly formatted line with the keyword \"Id:\".
  53         I.e. no lines match \"" . $IDstring . "\".
  54         Please see the template files for an example.\n";
  55
  56 # pattern to match an RCS Id keyword line for a new file (i.e. un-expanded)
  57 #
  58 $NewId = "\"@(#)[^:]*:.*\\$\Id\\$\""; # emacs-fontify gets confused by the "
  59
  60 $NoName = "
  61 %s - The ID line should contain only \"@(#)module/path:\$Name\$:\$\Id\$\"
  62         for a newly created file.\n";
  63
  64 $BadName = "
  65 %s - The file name '%s' in the ID line does not match
  66         the actual filename.\n";
  67
  68 $BadVersion = "
  69 %s - How dare you!!!  You replaced your copy of the file '%s',
  70         which was based upon version %s, with an %s version based
  71         upon %s.  Please move your '%s' out of the way, perform an
  72         update to get the current version, and them merge your changes
  73         into that file, then try the commit again.\n";
  74
  75 $BadCR = "
  76 %s - contains a CR (^M, ascii 13) character, which is not a valid
  77         line ending on this platform.  Either tag this as a binary
  78         file or remove the bogus CR characters, and then try the
  79         commit again.\n";
  80 #
  81 #       Subroutines
  82 #
  83
  84 sub write_line {
  85     local($filename, $line) = @_;
  86     open(FILE, ">$filename") || die("Cannot open $filename, stopped");
  87     print(FILE $line, "\n");
  88     close(FILE);
  89 }
  90
  91 sub append_line {
  92     local($filename, $line) = @_;
  93     open(FILE, ">>$filename") || die("Cannot open $filename, stopped");
  94     print(FILE $line, "\n");
  95     close(FILE);
  96 }
  97
  98 sub check_version {
  99     local($i, $id, $rname, $version);
 100     local($filename) = @_;
 101
 102     open(FILE, "<$filename") || return(0);
 103
 104     @all_lines = ();
 105     $idpos = -1;
 106     $newidpos = -1;
 107     for ($i = 0; <FILE>; $i++) {
 108         chomp;
 109         push(@all_lines, $_);
 110         if ($_ =~ /$IDstring/) {
 111             $idpos = $i;
 112         }
 113         if ($_ =~ /$NewId/) {
 114             $newidpos = $i;
 115         }
 116         if ($_ =~ /\015/ && $cvsflags{$filename} !~ /-kb/) {
 117             print STDERR sprintf($BadCR, $filename);
 118             return(1);
 119         }
 120     }
 121
 122     if (grep(/$LogString1/, @all_lines) || grep(/$LogString2/, @all_lines)) {
 123         print STDERR sprintf($NoLog, $filename);
 124         return(1);
 125     }
 126
 127     if ($debug != 0) {
 128         print STDERR sprintf("file = %s, version = %d.\n", $filename, $cvsversion{$filename});
 129     }
 130
 131     if ($cvsversion{$filename} == 0) {
 132         if ($newidpos != -1 && $all_lines[$newidpos] !~ /$NewId/) {
 133             print STDERR sprintf($NoName, $filename);
 134             return(1);
 135         }
 136         return(0);
 137     }
 138
 139     if ($idpos == -1) {
 140         print STDERR sprintf($NoId, $filename);
 141         return(1);
 142     }
 143
 144     $line = $all_lines[$idpos];
 145     $pos = index($line, "Id: ");
 146     if ($debug != 0) {
 147         print STDERR sprintf("%d in '%s'.\n", $pos, $line);
 148     }
 149     ($id, $rname, $version) = split(' ', substr($line, $pos));
 150     if ($rname ne "$filename,v") {
 151         print STDERR sprintf($BadName, $filename, substr($rname, 0, length($rname)-2));
 152         return(1);
 153     }
 154     if ($cvsversion{$filename} < $version) {
 155         print STDERR sprintf($BadVersion, $filename, $filename, $cvsversion{$filename},
 156                              "newer", $version, $filename);
 157         return(1);
 158     }
 159     if ($cvsversion{$filename} > $version) {
 160         print STDERR sprintf($BadVersion, $filename, $filename, $cvsversion{$filename},
 161                              "older", $version, $filename);
 162         return(1);
 163     }
 164     return(0);
 165 }
 166
 167 #
 168 #       Main Body
 169 #
 170
 171 $id = getpgrp();                # You *must* use a shell that does setpgrp()!
 172
 173 # Check each file (except dot files) for an RCS "Id" keyword.
 174 #
 175 $check_id = 0;
 176
 177 # Record the directory for later use by the log_accumulate script.
 178 #
 179 $record_directory = 0;
 180
 181 # Keep track of diffs for later use by the log_accumulate script.
 182 #
 183 $track_diffs = 0;
 184
 185 # parse command line arguments
 186 #
 187 while (@ARGV) {
 188     $arg = shift @ARGV;
 189
 190     if ($arg eq '-d') {
 191         $debug = 1;
 192         print STDERR "Debug turned on...\n";
 193     } elsif ($arg eq '-c') {
 194         $check_id = 1;
 195     } elsif ($arg eq '-r') {
 196         $record_directory = 1;
 197     } elsif ($arg eq '-u') {
 198         $track_diffs = 1;
 199     } else {
 200         push(@files, $arg);
 201     }
 202 }
 203
 204 $directory = shift @files;
 205
 206 if ($debug != 0) {
 207     print STDERR "dir   - ", $directory, "\n";
 208     print STDERR "files - ", join(":", @files), "\n";
 209     print STDERR "id    - ", $id, "\n";
 210 }
 211
 212 # Suck in the CVS/Entries file
 213 #
 214 open(ENTRIES, $ENTRIES) || die("Cannot open $ENTRIES.\n");
 215 while (<ENTRIES>) {
 216     local($filename, $version, $verdate, $flags)=split('/', substr($_, 1));
 217     $cvsversion{$filename} = $version;
 218     $cvsflags{$filename} = $flags;
 219 }
 220 close(ENTRIES);
 221
 222 # Now check each file name passed in, except for dot files.  Dot files
 223 # are considered to be administrative files by this script.
 224 #
 225 if ($check_id != 0) {
 226     $failed = 0;
 227     foreach $arg (@files) {
 228         if (index($arg, ".") == 0) {
 229             next;
 230         }
 231         $failed += &check_version($arg);
 232     }
 233     if ($failed) {
 234         print STDERR "\n";
 235         exit(1);
 236     }
 237 }
 238
 239 # Create a diff for each file name passed in.
 240 if ($track_diffs != 0) {
 241     @diff_txt = ();
 242     foreach $arg (@files) {
 243 #       open(STATUS, "-|") ||
 244 #           exec 'cvs', '-nQq', 'diff', '-u', $arg;
 245         open(STATUS, "-|") || # redirect stderr, too.
 246             exec 'csh', '-c', "cvs -nQq diff -u $arg |& cat";
 247         while (<STATUS>) {
 248             chop;
 249             push(@diff_txt, $_);
 250         }
 251         close(STATUS);
 252     }
 253     &append_line("$DIFF_FILE.$id", join("\n", @diff_txt));
 254 }
 255
 256 # Record this directory as the last one checked.  This will be used
 257 # by the log_accumulate script to determine when it is processing
 258 # the final directory of a multi-directory commit.
 259 #
 260 if ($record_directory != 0) {
 261     &write_line("$LAST_FILE.$id", $directory);
 262 }
 263 exit(0);