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