lib/cvs/contrib/rcslock

   1 #! /bin/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 #
  67 require '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`;
  89 chop $pwd;
  90
  91 print "Starting directory is $pwd" if defined $opt_d ;
  92
  93 #
  94 # cd to the repository directory and check on the files.
  95 #
  96 print "Checking directory ", $files[0] if defined $opt_v ;
  97
  98 if ( $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 }
 103 else
 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
 117 print "opening rlog -h @files[1..$#files] |" if defined $opt_d;
 118
 119 open( 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
 136 while (<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
 179 chdir $pwd;
 180
 181 # fo all of the file names (remember $files[0] is the directory name
 182 foreach $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
 207 exit $outstanding_lock;
 208
 209
 210 ### End of main program
 211
 212 sub parse_cvs_entry
 213 { # a very simple minded hack at parsing an entries file.
 214 local ( $file, *entry ) = @_;
 215 local ( @pp );
 216
 217
 218 open(ENTRIES, "< CVS/Entries") || die "Can't open entries file";
 219
 220 while (<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 }