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); |