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

Diff of /ccvs/contrib/commit_prep.pl

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

revision 1.4 by dprice, Fri Jan 5 18:18:18 2001 UTC revision 1.5 by dprice, Thu Oct 6 20:25:12 2005 UTC
# Line 1  Line 1 
1  #! xPERL_PATHx  #! @PERL@ -T
2  # -*-Perl-*-  # -*-Perl-*-
 #  
 #  
 # Perl filter to handle pre-commit checking of files.  This program  
 # records the last directory where commits will be taking place for  
 # use by the log_accum.pl script.  For new files, it forces the  
 # existence of a RCS "Id" keyword in the first ten lines of the file.  
 # For existing files, it checks version number in the "Id" line to  
 # prevent losing changes because an old version of a file was copied  
 # into the direcory.  
 #  
 # Possible future enhancements:  
 #  
 #    Check for cruft left by unresolved conflicts.  Search for  
 #    "^<<<<<<<$", "^-------$", and "^>>>>>>>$".  
 #  
 #    Look for a copyright and automagically update it to the  
 #    current year.  [[ bad idea!  -- woods ]]  
 #  
 #  
 # Contributed by David Hampton <hampton@cisco.com>  
 #  
 # Hacked on lots by Greg A. Woods <woods@web.net>  
3    
4  #  # Copyright (C) 1994-2005 The Free Software Foundation, Inc.
 #       Configurable options  
 #  
5    
6  # Constants (remember to protect strings from RCS keyword substitution)  # 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  $LAST_FILE     = "/tmp/#cvs.lastdir"; # must match name in log_accum.pl  # the Free Software Foundation; either version 2, or (at your option)
9  $ENTRIES       = "CVS/Entries";  # 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  # Patterns to find $Log keywords in files  # Perl filter to handle pre-commit checking of files.  This program
35    # records the last directory where commits will be taking place for
36    # use by the log_accum.pl script.
37  #  #
38  $LogString1 = "\\\$\\Log: .* \\\$";  # IMPORTANT: this script interacts with log_accum, they have to agree
39  $LogString2 = "\\\$\\Log\\\$";  # on the tmpfile name to use.  See $LAST_FILE below.
 $NoLog = "%s - contains an RCS \$Log keyword.  It must not!\n";  
   
 # pattern to match an RCS Id keyword line with an existing ID  
40  #  #
41  $IDstring = "\"@\\(#\\)[^:]*:.*\\\$\Id: .*\\\$\"";  # Contributed by David Hampton <hampton@cisco.com>
42  $NoId = "  # Stripped to minimum by Roy Fielding
 %s - Does not contain a properly formatted line with the keyword \"Id:\".  
         I.e. no lines match \"" . $IDstring . "\".  
         Please see the template files for an example.\n";  
   
 # pattern to match an RCS Id keyword line for a new file (i.e. un-expanded)  
43  #  #
44  $NewId = "\"@(#)[^:]*:.*\\$\Id\\$\"";  ############################################################
45    $TMPDIR        = $ENV{'TMPDIR'} || '/tmp';
46    $FILE_PREFIX   = '#cvs.';
47    
48    # If see a "-u $USER" argument, then destructively remove it from the
49    # argument list, so $ARGV[0] will be the repository dir again, as it
50    # used to be before we added the -u flag.
51    if ($ARGV[0] eq '-u') {
52      shift @ARGV;
53      $CVS_USERNAME = shift (@ARGV);
54    }
55    
56    # This needs to match the corresponding var in log_accum.pl, including
57    # the appending of the pgrp and username suffixes (see uses of this
58    # var farther down).
59    $LAST_FILE = "$TMPDIR/${FILE_PREFIX}lastdir";
60    
61  $NoName = "  sub write_line {
62  %s - The ID line should contain only \"@(#)module/path:\$Name\$:\$\Id\$\"      my ($filename, $line) = @_;
         for a newly created file.\n";  
   
 $BadName = "  
 %s - The file name '%s' in the ID line does not match  
         the actual filename.\n";  
63    
64  $BadVersion = "  # A check of some kind is needed here, but the rules aren't apparent
65  %s - How dare you!!!  You replaced your copy of the file '%s',  # at the moment:
         which was based upon version %s, with an %s version based  
         upon %s.  Please move your '%s' out of the way, perform an  
         update to get the current version, and them merge your changes  
         into that file, then try the commit again.\n";  
66    
67  #  #    foreach($filename, $line){
68  #       Subroutines  #        $_ =~ m#^([-\@\w.\#]+)$#;
69  #  #        $_ = $1;
70    #    }
71    
72  sub write_line {      open(FILE, ">$filename") || die("Cannot open $filename: $!\n");
     local($filename, $line) = @_;  
     open(FILE, ">$filename") || die("Cannot open $filename, stopped");  
73      print(FILE $line, "\n");      print(FILE $line, "\n");
74      close(FILE);      close(FILE);
75  }  }
76    
 sub check_version {  
     local($i, $id, $rname, $version);  
     local($filename, $cvsversion) = @_;  
   
     open(FILE, "<$filename") || return(0);  
   
     @all_lines = ();  
     $idpos = -1;  
     $newidpos = -1;  
     for ($i = 0; <FILE>; $i++) {  
         chop;  
         push(@all_lines, $_);  
         if ($_ =~ /$IDstring/) {  
             $idpos = $i;  
         }  
         if ($_ =~ /$NewId/) {  
             $newidpos = $i;  
         }  
     }  
   
     if (grep(/$LogString1/, @all_lines) || grep(/$LogString2/, @all_lines)) {  
         print STDERR sprintf($NoLog, $filename);  
         return(1);  
     }  
   
     if ($debug != 0) {  
         print STDERR sprintf("file = %s, version = %d.\n", $filename, $cvsversion{$filename});  
     }  
   
     if ($cvsversion{$filename} == 0) {  
         if ($newidpos != -1 && $all_lines[$newidpos] !~ /$NewId/) {  
             print STDERR sprintf($NoName, $filename);  
             return(1);  
         }  
         return(0);  
     }  
   
     if ($idpos == -1) {  
         print STDERR sprintf($NoId, $filename);  
         return(1);  
     }  
   
     $line = $all_lines[$idpos];  
     $pos = index($line, "Id: ");  
     if ($debug != 0) {  
         print STDERR sprintf("%d in '%s'.\n", $pos, $line);  
     }  
     ($id, $rname, $version) = split(' ', substr($line, $pos));  
     if ($rname ne "$filename,v") {  
         print STDERR sprintf($BadName, $filename, substr($rname, 0, length($rname)-2));  
         return(1);  
     }  
     if ($cvsversion{$filename} < $version) {  
         print STDERR sprintf($BadVersion, $filename, $filename, $cvsversion{$filename},  
                              "newer", $version, $filename);  
         return(1);  
     }  
     if ($cvsversion{$filename} > $version) {  
         print STDERR sprintf($BadVersion, $filename, $filename, $cvsversion{$filename},  
                              "older", $version, $filename);  
         return(1);  
     }  
     return(0);  
 }  
   
 #  
 #       Main Body        
 #  
   
 $id = getpgrp();                # You *must* use a shell that does setpgrp()!  
   
 # Check each file (except dot files) for an RCS "Id" keyword.  
 #  
 $check_id = 0;  
   
 # Record the directory for later use by the log_accumulate stript.  
 #  
 $record_directory = 0;  
   
 # parse command line arguments  
 #  
 while (@ARGV) {  
     $arg = shift @ARGV;  
   
     if ($arg eq '-d') {  
         $debug = 1;  
         print STDERR "Debug turned on...\n";  
     } elsif ($arg eq '-c') {  
         $check_id = 1;  
     } elsif ($arg eq '-r') {  
         $record_directory = 1;  
     } else {  
         push(@files, $arg);  
     }  
 }  
   
 $directory = shift @files;  
   
 if ($debug != 0) {  
     print STDERR "dir   - ", $directory, "\n";  
     print STDERR "files - ", join(":", @files), "\n";  
     print STDERR "id    - ", $id, "\n";  
 }  
   
 # Suck in the CVS/Entries file  
 #  
 open(ENTRIES, $ENTRIES) || die("Cannot open $ENTRIES.\n");  
 while (<ENTRIES>) {  
     local($filename, $version) = split('/', substr($_, 1));  
     $cvsversion{$filename} = $version;  
 }  
   
 # Now check each file name passed in, except for dot files.  Dot files  
 # are considered to be administrative files by this script.  
77  #  #
 if ($check_id != 0) {  
     $failed = 0;  
     foreach $arg (@files) {  
         if (index($arg, ".") == 0) {  
             next;  
         }  
         $failed += &check_version($arg);  
     }  
     if ($failed) {  
         print STDERR "\n";  
         exit(1);  
     }  
 }  
   
78  # Record this directory as the last one checked.  This will be used  # Record this directory as the last one checked.  This will be used
79  # by the log_accumulate script to determine when it is processing  # by the log_accumulate script to determine when it is processing
80  # the final directory of a multi-directory commit.  # the final directory of a multi-directory commit.
81  #  #
82  if ($record_directory != 0) {  $id = getpgrp();
83      &write_line("$LAST_FILE.$id", $directory);  
84  }  &write_line("$LAST_FILE.$id.$CVS_USERNAME", $ARGV[0]);
85    
86  exit(0);  exit(0);

Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5

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