1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
|
#! @PERL@
# -*-Perl-*-
# Author: John Rouillard (rouilj@cs.umb.edu)
# Supported: Yeah right. (Well what do you expect for 2 hours work?)
# Blame-to: rouilj@cs.umb.edu
# Complaints to: Anybody except Brian Berliner, he's blameless for
# this script.
# Acknowlegements: The base code for this script has been acquired
# from the log.pl script.
# rcslock.pl - A program to prevent commits when a file to be ckecked
# in is locked in the repository.
# There are times when you need exclusive access to a file. This
# often occurs when binaries are checked into the repository, since
# cvs's (actually rcs's) text based merging mechanism won't work. This
# script allows you to use the rcs lock mechanism (rcs -l) to make
# sure that no changes to a repository are able to be committed if
# those changes would result in a locked file being changed.
# WARNING:
# This script will work only if locking is set to strict.
#
# Setup:
# Add the following line to the commitinfo file:
# ALL /local/location/for/script/lockcheck [options]
# Where ALL is replaced by any suitable regular expression.
# Options are -v for verbose info, or -d for debugging info.
# The %s will provide the repository directory name and the names of
# all changed files.
# Use:
# When a developer needs exclusive access to a version of a file, s/he
# should use "rcs -l" in the repository tree to lock the version they
# are working on. CVS will automagically release the lock when the
# commit is performed.
# Method:
# An "rlog -h" is exec'ed to give info on all about to be
# committed files. This (header) information is parsed to determine
# if any locks are outstanding and what versions of the file are
# locked. This filename, version number info is used to index an
# associative array. All of the files to be committed are checked to
# see if any locks are outstanding. If locks are outstanding, the
# version number of the current file (taken from the CVS/Entries
# subdirectory) is used in the key to determine if that version is
# locked. If the file being checked in is locked by the person doing
# the checkin, the commit is allowed, but if the lock is held on that
# version of a file by another person, the commit is not allowed.
$ext = ",v"; # The extension on your rcs files.
$\="\n"; # I hate having to put \n's at the end of my print statements
$,=' '; # Spaces should occur between arguments to print when printed
# turn off setgid
#
$) = $(;
#
# parse command line arguments
#
require 'getopts.pl';
&Getopts("vd"); # verbose or debugging
# Verbose is useful when debugging
$opt_v = $opt_d if defined $opt_d;
# $files[0] is really the name of the subdirectory.
# @files = split(/ /,$ARGV[0]);
@files = @ARGV[0..$#ARGV];
$cvsroot = $ENV{'CVSROOT'};
#
# get login name
#
$login = getlogin || (getpwuid($<))[0] || "nobody";
#
# save the current directory since we have to return here to parse the
# CVS/Entries file if a lock is found.
#
$pwd = `/bin/pwd`;
chop $pwd;
print "Starting directory is $pwd" if defined $opt_d ;
#
# cd to the repository directory and check on the files.
#
print "Checking directory ", $files[0] if defined $opt_v ;
if ( $files[0] =~ /^\// )
{
print "Directory path is $files[0]" if defined $opt_d ;
chdir $files[0] || die "Can't change to repository directory $files[0]" ;
}
else
{
print "Directory path is $cvsroot/$files[0]" if defined $opt_d ;
chdir ($cvsroot . "/" . $files[0]) ||
die "Can't change to repository directory $files[0] in $cvsroot" ;
}
# Open the rlog process and apss all of the file names to that one
# process to cut down on exec overhead. This may backfire if there
# are too many files for the system buffer to handle, but if there are
# that many files, chances are that the cvs repository is not set up
# cleanly.
print "opening rlog -h @files[1..$#files] |" if defined $opt_d;
open( RLOG, "rlog -h @files[1..$#files] |") || die "Can't run rlog command" ;
# Create the locks associative array. The elements in the array are
# of two types:
#
# The name of the RCS file with a value of the total number of locks found
# for that file,
# or
#
# The name of the rcs file concatenated with the version number of the lock.
# The value of this element is the name of the locker.
# The regular expressions used to split the rcs info may have to be changed.
# The current ones work for rcs 5.6.
$lock = 0;
while (<RLOG>)
{
chop;
next if /^$/; # ditch blank lines
if ( $_ =~ /^RCS file: (.*)$/ )
{
$curfile = $1;
next;
}
if ( $_ =~ /^locks: strict$/ )
{
$lock = 1 ;
next;
}
if ( $lock )
{
# access list: is the line immediately following the list of locks.
if ( /^access list:/ )
{ # we are done getting lock info for this file.
$lock = 0;
}
else
{ # We are accumulating lock info.
# increment the lock count
$locks{$curfile}++;
# save the info on the version that is locked. $2 is the
# version number $1 is the name of the locker.
$locks{"$curfile" . "$2"} = $1
if /[ ]*([a-zA-Z._]*): ([0-9.]*)$/;
print "lock by $1 found on $curfile version $2" if defined $opt_d;
}
}
}
# Lets go back to the starting directory and see if any locked files
# are ones we are interested in.
chdir $pwd;
# fo all of the file names (remember $files[0] is the directory name
foreach $i (@files[1..$#files])
{
if ( defined $locks{$i . $ext} )
{ # well the file has at least one lock outstanding
# find the base version number of our file
&parse_cvs_entry($i,*entry);
# is our version of this file locked?
if ( defined $locks{$i . $ext . $entry{"version"}} )
{ # if so, it is by us?
if ( $login ne ($by = $locks{$i . $ext . $entry{"version"}}) )
{# crud somebody else has it locked.
$outstanding_lock++ ;
print "$by has file $i locked for version " , $entry{"version"};
}
else
{ # yeah I have it locked.
print "You have a lock on file $i for version " , $entry{"version"}
if defined $opt_v;
}
}
}
}
exit $outstanding_lock;
### End of main program
sub parse_cvs_entry
{ # a very simple minded hack at parsing an entries file.
local ( $file, *entry ) = @_;
local ( @pp );
open(ENTRIES, "< CVS/Entries") || die "Can't open entries file";
while (<ENTRIES>)
{
if ( $_ =~ /^\/$file\// )
{
@pp = split('/');
$entry{"name"} = $pp[1];
$entry{"version"} = $pp[2];
$entry{"dates"} = $pp[3];
$entry{"name"} = $pp[4];
$entry{"name"} = $pp[5];
$entry{"sticky"} = $pp[6];
return;
}
}
}
|
