1175261Sobrien#! @PERL@ -T 281404Speter# -*-Perl-*- 381404Speter 4175261Sobrien# Copyright (C) 1994-2005 The Free Software Foundation, Inc. 5175261Sobrien 6175261Sobrien# This program is free software; you can redistribute it and/or modify 7175261Sobrien# it under the terms of the GNU General Public License as published by 8175261Sobrien# the Free Software Foundation; either version 2, or (at your option) 9175261Sobrien# any later version. 10175261Sobrien# 11175261Sobrien# This program is distributed in the hope that it will be useful, 12175261Sobrien# but WITHOUT ANY WARRANTY; without even the implied warranty of 13175261Sobrien# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14175261Sobrien# GNU General Public License for more details. 15175261Sobrien 16175261Sobrien############################################################################### 17175261Sobrien############################################################################### 18175261Sobrien############################################################################### 19175261Sobrien# 20175261Sobrien# THIS SCRIPT IS PROBABLY BROKEN. REMOVING THE -T SWITCH ON THE #! LINE ABOVE 21175261Sobrien# WOULD FIX IT, BUT THIS IS INSECURE. WE RECOMMEND FIXING THE ERRORS WHICH THE 22175261Sobrien# -T SWITCH WILL CAUSE PERL TO REPORT BEFORE RUNNING THIS SCRIPT FROM A CVS 23175261Sobrien# SERVER TRIGGER. PLEASE SEND PATCHES CONTAINING THE CHANGES YOU FIND 24175261Sobrien# NECESSARY TO RUN THIS SCRIPT WITH THE TAINT-CHECKING ENABLED BACK TO THE 25175261Sobrien# <@PACKAGE_BUGREPORT@> MAILING LIST. 26175261Sobrien# 27175261Sobrien# For more on general Perl security and taint-checking, please try running the 28175261Sobrien# `perldoc perlsec' command. 29175261Sobrien# 30175261Sobrien############################################################################### 31175261Sobrien############################################################################### 32175261Sobrien############################################################################### 33175261Sobrien 3481404Speter# Author: John Rouillard (rouilj@cs.umb.edu) 3581404Speter# Supported: Yeah right. (Well what do you expect for 2 hours work?) 3681404Speter# Blame-to: rouilj@cs.umb.edu 3781404Speter# Complaints to: Anybody except Brian Berliner, he's blameless for 3881404Speter# this script. 3981404Speter# Acknowlegements: The base code for this script has been acquired 4081404Speter# from the log.pl script. 4181404Speter 4281404Speter# rcslock.pl - A program to prevent commits when a file to be ckecked 4381404Speter# in is locked in the repository. 4481404Speter 4581404Speter# There are times when you need exclusive access to a file. This 4681404Speter# often occurs when binaries are checked into the repository, since 4781404Speter# cvs's (actually rcs's) text based merging mechanism won't work. This 4881404Speter# script allows you to use the rcs lock mechanism (rcs -l) to make 4981404Speter# sure that no changes to a repository are able to be committed if 5081404Speter# those changes would result in a locked file being changed. 5181404Speter 5281404Speter# WARNING: 5381404Speter# This script will work only if locking is set to strict. 5481404Speter# 5581404Speter 5681404Speter# Setup: 5781404Speter# Add the following line to the commitinfo file: 5881404Speter 5981404Speter# ALL /local/location/for/script/lockcheck [options] 6081404Speter 6181404Speter# Where ALL is replaced by any suitable regular expression. 6281404Speter# Options are -v for verbose info, or -d for debugging info. 6381404Speter# The %s will provide the repository directory name and the names of 6481404Speter# all changed files. 6581404Speter 6681404Speter# Use: 6781404Speter# When a developer needs exclusive access to a version of a file, s/he 6881404Speter# should use "rcs -l" in the repository tree to lock the version they 6981404Speter# are working on. CVS will automagically release the lock when the 7081404Speter# commit is performed. 7181404Speter 7281404Speter# Method: 7381404Speter# An "rlog -h" is exec'ed to give info on all about to be 7481404Speter# committed files. This (header) information is parsed to determine 7581404Speter# if any locks are outstanding and what versions of the file are 7681404Speter# locked. This filename, version number info is used to index an 7781404Speter# associative array. All of the files to be committed are checked to 7881404Speter# see if any locks are outstanding. If locks are outstanding, the 7981404Speter# version number of the current file (taken from the CVS/Entries 8081404Speter# subdirectory) is used in the key to determine if that version is 8181404Speter# locked. If the file being checked in is locked by the person doing 8281404Speter# the checkin, the commit is allowed, but if the lock is held on that 8381404Speter# version of a file by another person, the commit is not allowed. 8481404Speter 8581404Speter$ext = ",v"; # The extension on your rcs files. 8681404Speter 8781404Speter$\="\n"; # I hate having to put \n's at the end of my print statements 8881404Speter$,=' '; # Spaces should occur between arguments to print when printed 8981404Speter 9081404Speter# turn off setgid 9181404Speter# 9281404Speter$) = $(; 9381404Speter 9481404Speter# 9581404Speter# parse command line arguments 9681404Speter# 9781404Speterrequire 'getopts.pl'; 9881404Speter 9981404Speter&Getopts("vd"); # verbose or debugging 10081404Speter 10181404Speter# Verbose is useful when debugging 10281404Speter$opt_v = $opt_d if defined $opt_d; 10381404Speter 10481404Speter# $files[0] is really the name of the subdirectory. 10581404Speter# @files = split(/ /,$ARGV[0]); 10681404Speter@files = @ARGV[0..$#ARGV]; 10781404Speter$cvsroot = $ENV{'CVSROOT'}; 10881404Speter 10981404Speter# 11081404Speter# get login name 11181404Speter# 11281404Speter$login = getlogin || (getpwuid($<))[0] || "nobody"; 11381404Speter 11481404Speter# 11581404Speter# save the current directory since we have to return here to parse the 11681404Speter# CVS/Entries file if a lock is found. 11781404Speter# 11881404Speter$pwd = `/bin/pwd`; 11981404Speterchop $pwd; 12081404Speter 12181404Speterprint "Starting directory is $pwd" if defined $opt_d ; 12281404Speter 12381404Speter# 12481404Speter# cd to the repository directory and check on the files. 12581404Speter# 12681404Speterprint "Checking directory ", $files[0] if defined $opt_v ; 12781404Speter 12881404Speterif ( $files[0] =~ /^\// ) 12981404Speter{ 13081404Speter print "Directory path is $files[0]" if defined $opt_d ; 13181404Speter chdir $files[0] || die "Can't change to repository directory $files[0]" ; 13281404Speter} 13381404Speterelse 13481404Speter{ 13581404Speter print "Directory path is $cvsroot/$files[0]" if defined $opt_d ; 13681404Speter chdir ($cvsroot . "/" . $files[0]) || 13781404Speter die "Can't change to repository directory $files[0] in $cvsroot" ; 13881404Speter} 13981404Speter 14081404Speter 14181404Speter# Open the rlog process and apss all of the file names to that one 14281404Speter# process to cut down on exec overhead. This may backfire if there 14381404Speter# are too many files for the system buffer to handle, but if there are 14481404Speter# that many files, chances are that the cvs repository is not set up 14581404Speter# cleanly. 14681404Speter 14781404Speterprint "opening rlog -h @files[1..$#files] |" if defined $opt_d; 14881404Speter 14981404Speteropen( RLOG, "rlog -h @files[1..$#files] |") || die "Can't run rlog command" ; 15081404Speter 15181404Speter# Create the locks associative array. The elements in the array are 15281404Speter# of two types: 15381404Speter# 15481404Speter# The name of the RCS file with a value of the total number of locks found 15581404Speter# for that file, 15681404Speter# or 15781404Speter# 15881404Speter# The name of the rcs file concatenated with the version number of the lock. 15981404Speter# The value of this element is the name of the locker. 16081404Speter 16181404Speter# The regular expressions used to split the rcs info may have to be changed. 16281404Speter# The current ones work for rcs 5.6. 16381404Speter 16481404Speter$lock = 0; 16581404Speter 16681404Speterwhile (<RLOG>) 16781404Speter{ 16881404Speter chop; 16981404Speter next if /^$/; # ditch blank lines 17081404Speter 17181404Speter if ( $_ =~ /^RCS file: (.*)$/ ) 17281404Speter { 17381404Speter $curfile = $1; 17481404Speter next; 17581404Speter } 17681404Speter 17781404Speter if ( $_ =~ /^locks: strict$/ ) 17881404Speter { 17981404Speter $lock = 1 ; 18081404Speter next; 18181404Speter } 18281404Speter 18381404Speter if ( $lock ) 18481404Speter { 18581404Speter # access list: is the line immediately following the list of locks. 18681404Speter if ( /^access list:/ ) 18781404Speter { # we are done getting lock info for this file. 18881404Speter $lock = 0; 18981404Speter } 19081404Speter else 19181404Speter { # We are accumulating lock info. 19281404Speter 19381404Speter # increment the lock count 19481404Speter $locks{$curfile}++; 19581404Speter # save the info on the version that is locked. $2 is the 19681404Speter # version number $1 is the name of the locker. 19781404Speter $locks{"$curfile" . "$2"} = $1 19881404Speter if /[ ]*([a-zA-Z._]*): ([0-9.]*)$/; 19981404Speter 20081404Speter print "lock by $1 found on $curfile version $2" if defined $opt_d; 20181404Speter 20281404Speter } 20381404Speter } 20481404Speter} 20581404Speter 20681404Speter# Lets go back to the starting directory and see if any locked files 20781404Speter# are ones we are interested in. 20881404Speter 20981404Speterchdir $pwd; 21081404Speter 21181404Speter# fo all of the file names (remember $files[0] is the directory name 21281404Speterforeach $i (@files[1..$#files]) 21381404Speter{ 21481404Speter if ( defined $locks{$i . $ext} ) 21581404Speter { # well the file has at least one lock outstanding 21681404Speter 21781404Speter # find the base version number of our file 21881404Speter &parse_cvs_entry($i,*entry); 21981404Speter 22081404Speter # is our version of this file locked? 22181404Speter if ( defined $locks{$i . $ext . $entry{"version"}} ) 22281404Speter { # if so, it is by us? 22381404Speter if ( $login ne ($by = $locks{$i . $ext . $entry{"version"}}) ) 22481404Speter {# crud somebody else has it locked. 22581404Speter $outstanding_lock++ ; 22681404Speter print "$by has file $i locked for version " , $entry{"version"}; 22781404Speter } 22881404Speter else 22981404Speter { # yeah I have it locked. 23081404Speter print "You have a lock on file $i for version " , $entry{"version"} 23181404Speter if defined $opt_v; 23281404Speter } 23381404Speter } 23481404Speter } 23581404Speter} 23681404Speter 23781404Speterexit $outstanding_lock; 23881404Speter 23981404Speter 24081404Speter### End of main program 24181404Speter 24281404Spetersub parse_cvs_entry 24381404Speter{ # a very simple minded hack at parsing an entries file. 24481404Speterlocal ( $file, *entry ) = @_; 24581404Speterlocal ( @pp ); 24681404Speter 24781404Speter 24881404Speteropen(ENTRIES, "< CVS/Entries") || die "Can't open entries file"; 24981404Speter 25081404Speterwhile (<ENTRIES>) 25181404Speter { 25281404Speter if ( $_ =~ /^\/$file\// ) 25381404Speter { 25481404Speter @pp = split('/'); 25581404Speter 25681404Speter $entry{"name"} = $pp[1]; 25781404Speter $entry{"version"} = $pp[2]; 25881404Speter $entry{"dates"} = $pp[3]; 25981404Speter $entry{"name"} = $pp[4]; 26081404Speter $entry{"name"} = $pp[5]; 26181404Speter $entry{"sticky"} = $pp[6]; 26281404Speter return; 26381404Speter } 26481404Speter } 26581404Speter} 266