RE: cvs lock ..

[Christopher.Fouts]

Running your script on my RH Fedora gives the following errors. Any
clues?

"my" variable $key masks earlier declaration in same scope at
./find-cvs-locks.pl line 260.
"my" variable $key masks earlier declaration in same scope at
./find-cvs-locks.pl line 263.
"my" variable $key masks earlier declaration in same scope at
./find-cvs-locks.pl line 266.
"my" variable $key masks earlier declaration in same scope at
./find-cvs-locks.pl line 269.
"my" variable $key masks earlier declaration in same scope at
./find-cvs-locks.pl line 272.
Global symbol "@dirlist" requires explicit package name at
./find-cvs-locks.pl line 186.
syntax error at ./find-cvs-locks.pl line 194, near ");"
Global symbol "@dirlist" requires explicit package name at
./find-cvs-locks.pl line 209.
Global symbol "@dirlist" requires explicit package name at
./find-cvs-locks.pl line 222.
Global symbol "@dirlist" requires explicit package name at
./find-cvs-locks.pl line 224.
Global symbol "@dirlist" requires explicit package name at
./find-cvs-locks.pl line 279.
Global symbol "@dirlist" requires explicit package name at
./find-cvs-locks.pl line 284.
Global symbol "@dirlist" requires explicit package name at
./find-cvs-locks.pl line 291.
Unmatched right curly bracket at ./find-cvs-locks.pl line 417, at end of
line
syntax error at ./find-cvs-locks.pl line 417, near "}"
./find-cvs-locks.pl has too many errors.

>-----Original Message-----
>From: address@hidden 
>[mailto:address@hidden
>] On Behalf Of Mark D. Baushke
>Sent: Saturday, October 09, 2004 12:09 PM
>To: Gurpreet Singh (SCM)
>Cc: address@hidden
>Subject: Re: cvs lock .. 
>
>
>-----BEGIN PGP SIGNED MESSAGE-----
>Hash: SHA1
>
>Here is a script I have used in the past to locate and 
>possibly to clean stale cvs locks that might exist.
>
>It should be noted that most of those stale locks only happen 
>when cvs exits abnormally or the system itself crashes.
>
>I hope you find it useful.
>
>       Enjoy!
>       -- Mark
>
>  -------------- find-cvs-locks ---------------
>#!/usr/bin/perl
># -*-Perl-*-
>
>=head1 NAME
>
>find-cvs-locks - locate and possibly remove stale cvs locks
>
>=head1 SYNOPSIS
>
>find-cvs-locks [options]
>
>Options:
>
>  -d cvsroot          specify the local CVSROOT to be used
>  -l,--list           print an ls-style of lock filenames
>  -n,--dry-run        do not do anything to modify the filesystem
>  -c,--clean          clean up stale locks (implies --pid)
>  -p,--pid            check lock pids for stale processes
>  -h,--help           print a help message
>  -v,--verbose        verbose mode
>  --man               a man page for this program
>  --debug             turn on debugging
>
>=head1 OPTIONS
>
>=over 8
>
>=item B<-d cvsroot>
>
>    Specify the pathname on the local system to
>    the CVSROOT to be searched. The default
>    cvsroot is /var/cvs which may not exist on
>    your system.
>
>=item B<--list>
>
>    Print an ls-style output for the lock
>    filename. This is useful to see who owned the
>    lock files that are present or are about to be
>    removed.
>
>=item B<--clean>
>
>    Try to remove stale locks from the system.
>    This options implicitly turns on the --pid
>    option.
>
>=item B<--dry-run>
>
>    Do not do anything to modify the filesystem.
>
>    If --pid is used, then some locks may be
>    determined to be stale. This option will
>    disable actually removing any stale locks.
>
>    By default, if a pid is known to be stale for
>    a lock, the lock will be removed. However,
>    unless --pid is used, no pids will be examined.
>
>=item B<--pid>
>
>    Run the /bin/ps command locally (or, if the
>    lock appears to have a hostname, remotely on
>    the given host) in order to determine if the
>    process id found as a part of the lock name is
>    still alive or is dead.
>
>    Locks associasted with pids that do not exist
>    are considered to be stale.
>
>    Stale lock files will be removed unless the
>    --dry-run option is given on the command line.
>
>=item B<--verbose>
>
>    Add more verbosity to indicate what is
>    happening.
>
>=item B<--help>
>
>    Prints a brief help message and exits.
>
>=item B<--man>
>
>    Prints the manual page and exists.
>
>=item B<--debug>
>
>    Print some diagnostics that are not generally
>    useful for normal operation.
>
>=back
>
>=head1 LICENSING
>
>find-cvs-locks - locate and possibly remove stale cvs locks
>
>Copyright (c) 2003, 2004 by Mark D. Baushke <address@hidden> 
>All rights reserved.
>
>This program is free software; you can redistribute it and/or 
>modify it under the terms of the GNU General Public License as 
>published by the Free Software Foundation; either version 2 of 
>the License, or (at your option) any later version.
>
>This program is distributed in the hope that it will be 
>useful, but WITHOUT ANY WARRANTY; without even the implied 
>warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR 
>PURPOSE.  See the GNU General Public License for more details.
>
>You should have received a copy of the GNU General Public 
>License along with this program; if not, write to the Free 
>Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, 
>MA  02111-1307  USA
>
>=head1 DESCRIPTION
>
>This program -- B<find-cvs-locks> -- is provided for cvs 
>repository administrators to try to detect cvs locks.
>
>If given the C<--pid> option, the program will also attempt
>to remove any stale locks associated with pids that no
>longer exist according to the C</usr/bin/ps> command.
>
>=head1 ERRORS
>
>=over
>
>=item CVSROOT=/var/cvs/. specifies an invalid repository.
>
>    This means that the (default) repository
>    (/var/cvs) provided does not exist or is not a
>    valid CVSROOT.
>
>=back
>
>=head1 AUTHOR
>
>Mark D. Baushke E<lt>address@hidden<gt>
>    
>=cut
>
>require 5.005;
>use strict;
>use warnings;
>use File::Find;
>use Sys::Hostname;
>use Getopt::Long;
>use Pod::Usage;
>
>my $VERSION = 1.2; # Current version of this program
>
># Global defaults:
>
>my $repository = '/var/cvs';
>my @pscmd_args = ('/bin/ps', '-p');
>my $remote_shell = defined($ENV{'CVS_RSH'}) ? $ENV{'CVS_RSH'} 
>: '/usr/bin/rsh';
>
># Option defaults
>my($debug, $dry_run, $help, $filelist, $man, $try_ps, $verbose) =
>    (0, 0, 0, 0, 0, 0, 1);
>
>GetOptions('clean|c' => sub { $dry_run = 0; $try_ps = 1; },
>          'debug!' => \$debug,
>          'dry-run!' => \$dry_run,
>          'help|h|?' => \$help,
>          'list|l' => \$filelist,
>          'man' => \$man,
>          'n' => sub { $dry_run = 1; },
>          'pid|p' => \$try_ps,
>          'quiet|q' => sub { $verbose = 0 },
>          'cvsroot|d=s' => \$repository,
>          'verbose|v+' => \$verbose);
>pod2usage(1) if $help;
>pod2usage(-exitstatus => 0, -verbose => 2) if $man;
>
>sub oneday { 86400; }          # in seconds
>
>my $maxtime    = oneday;
>my $thishost   = hostname;
>
>my $found      = 0;
>my $locksnuked = 0;
>
>my($uid_user, @locks, %oldcvsuser, %uid_user, %lockfiles,
>   %rfl_lock, %pfl_lock, %wfl_lock, %tfl_lock, %dir_lock);
>
>$repository .= '/.' if (-l $repository); # deal with symbolic links
>
>pod2usage(-message => "'$repository' is an invalid repository",
>         -exitstatus => 1, -verbose => 0)
>    if (! -d $repository);
>
># Cleanup should probably include both the Repository and the 
>LockDir # even if the LockDir is provided. my @dirlist;
>
>if ( -d $repository.'/CVSROOT' ) {
>    push(@dirlist, $repository);
>    print("Checking CVSROOT=$repository\n") if ($verbose);
>} else {
>    print(STDERR "CVSROOT=$repository points to non-repository.\n");
>    exit 1;
>}
>
># Check CVSROOT/config for a LockDir directive 
>print("Attempting to read $repository/CVSROOT/config\n")
>    if ($debug);
>if (open(CONFIG, $repository.'/CVSROOT/config')) {
>    my $line;
>    while($line = <CONFIG>) {
>        if ($line =~ /^LockDir=(.*)$/) {
>            my $lockdir = $1;
>            if ( -d $lockdir) {
>                if ( -l $lockdir ) {
>                   my $link = readlink($lockdir);
>                    print("LockDir=$lockdir is a symlink to $link\n")
>                       if ($verbose);
>                    $lockdir .= '/.';
>                }
>                # Found one
>                if ( -d $lockdir ) {
>                    push(@dirlist, $lockdir);
>                    print("Checking LockDir=$lockdir\n") if ($verbose);
>                }
>            }
>           unless ( -d $lockdir) {
>               print("Warning: LockDir=$lockdir is not a directory\n");
>           }
>        }
>    }
>    close(CONFIG);
>}
>
># Do the search.
>print("Starting find ", join(' ', @dirlist), "\n")
>    if ($debug);
>File::Find::find(\&wanted, @dirlist);
>
># Print out uses of ancient versions of cvs when
># lock files were different.
>foreach my $key (sort keys %oldcvsuser) {
>    printf("On %s, %s used an old version of cvs\n",
>           filetime($oldcvsuser{$key}), $key)
>       if ($verbose);
>}
>
>my $last = '';
>foreach my $lock (sort @locks) {
>    next if ($lock eq $last);
>    $last = $lock;
>    my($pid, $host) = split("\t", $lock);
>    if (do_ps($pid, $host) eq stalelock()) {
>       my(@delfiles) = split(/\t/, $lockfiles{$lock});
>
>       print(join("\n\t",
>                  ($dry_run) ? "Need to delete files:" : 
>"Deleting files:",
>                  @delfiles),"\n");
>       unless ($dry_run) {
>           foreach my $file (@delfiles) {
>               print("rm $file\n") if ($verbose > 1);
>               if (unlink($file)) {
>                   $locksnuked++;
>               } else {
>                   warn "Unable to rmemove $file: $!";
>               }
>           }
>       }
>    }
>}
>
># Print the results of the search
>print "\n";
>foreach my $key (sort keys %rfl_lock) {
>    print "There were $rfl_lock{$key} read locks owned by 
>uid=$key ($uid_user{$key})\n"; }
>
>foreach my $key (sort keys %pfl_lock) {
>    print "There were $pfl_lock{$key} promotable read locks 
>owned by uid=$key ($uid_user{$key})\n"; }
>
>foreach my $key (sort keys %wfl_lock) {
>    print "There were $wfl_lock{$key} write locks owned by 
>uid=$key ($uid_user{$key})\n"; }
>
>foreach my $key (sort keys %tfl_lock) {
>    print "There were $tfl_lock{$key} temp locks owned by 
>uid=$key ($uid_user{$key})\n"; }
>
>foreach my $key (sort keys %dir_lock) {
>    print "There were $dir_lock{$key} dir locks owned by 
>uid=$key ($uid_user{$key})\n"; }
>
>print(report_choice($found,
>                   'There are no locks',
>                   'Found a total of 1 lock',
>                   "Found a total of $found locks"),
>      " in:\n\t", join("\n\t", @dirlist), "\n", 
>      report_choice($locksnuked,
>                   'No locks were',
>                   'A total of 1 lock was',
>                   "A total of $locksnuked locks were"),
>      " removed from:\n\t", join("\n\t", @dirlist), "\n");
>if ($locksnuked > 0) {
>    $found -= $locksnuked;
>    print(report_choice($found,
>                       'There are no locks',
>                       'There is a total of 1 lock',
>                       "There are a total of $found locks"),
>         " remaining in:\n\t", join("\n\t", @dirlist), "\n");
>}
>
>exit 0;
>
>sub stalelock   {"Lock is stale";}
>sub activelock  {"Lock still active";}
>sub unknownlock {"Lock may or may not be present";}
>
>sub report_choice {
>    my($cnt, @list) = @_;
>
>    $cnt = 0 if ($cnt < 0);
>    $cnt = 2 if ($cnt > 1);
>    $list[$cnt];
>}
>
>
># when wanted() is called
>#       $dir    - current directory name
>#       $_      - the current filename within $dir
>#       $name   - "$dir/$_"
># current directory is $dir
>#       $prune  - may be set to prune the tree
>sub wanted {
>    my($dir)  = $File::Find::dir;
>    my($name) = $File::Find::name;
>    my($file) = $_;
>    my($username);
>
>    if ($verbose > 1 && ($name !~ /Attic$/) && -d $_ ) {
>        print "find-locks scanning directory ", $name, "\n";
>    }
>    if ($file =~ /^\#cvs/) {
>        $found++;
>        print $name,"\n" if ($debug || (!$filelist));
>        do_ls($name) if ($filelist);
>
>        my($uid,$gid,$rdev,$size,$atime,$mtime) = (stat($name))[4..9];
>       # Transient lock files go away very fast, use the
>       # cached stat handle "_" to see if it already gone.
>        return if (! -e _);
>
>        my($user, $igd, $username, $lock, $mach, $proc);
>        ($user, undef, undef, $gid, undef, undef, $username) = 
>getpwuid($uid);
>        $user = "uid$uid" if ($user eq '');
>        $uid_user{$uid} = $user;
>       my(@parts) = split(/\./, $file);
>       $proc = pop(@parts);
>       shift(@parts);
>       $lock = shift(@parts);
>       $mach = join('.',@parts);
>        printf(STDERR "lock=%s, uid=%s (%s:%s), machine=%s, pid=%s\n",
>               $lock, $uid, $user, $username, $mach, $proc) if 
>($debug);
>        my($time) = time;
>        if ($file =~ /\#cvs\.wfl/) { # write file lock
>            $wfl_lock{$uid}++;
>        }
>        elsif ($file =~ /\#cvs\.rfl/) { # read file lock
>            $rfl_lock{$uid}++;
>        }
>        elsif ($file =~ /\#cvs\.pfl/) { # promotable read file lock
>            $pfl_lock{$uid}++;
>        }
>        elsif ($file =~ /\#cvs\.tfl/) { # transient file lock
>            $tfl_lock{$uid}++;
>        }
>        elsif ( $file =~ /\#cvs\.lock/ ) {
>            $dir_lock{$uid}++;
>        }
>
>        if (($time - $mtime) > $maxtime) {
>            print("lock is more than $maxtime seconds old!\n")
>                if ($verbose > 1);
>        }
>        if ($proc ne '') {
>            push(@locks, "$proc\t$mach") if ($try_ps);
>           if (!defined($lockfiles{"$proc\t$mach"})) {
>               $lockfiles{"$proc\t$mach"} = $name;
>           } else {
>               $lockfiles{"$proc\t$mach"} .= "\t".$name;
>           }
>        }
>        elsif ($file ne "\#cvs.lock") {
>            my $key = "\"$username\" <$user> (uid=$uid)";
>            $oldcvsuser{$key} = $mtime if ($oldcvsuser{$key} < $mtime);
>        }
>    }
>}
>
># This function does its own 'ls' command implementation 
>because # transient lock files go away very quickly and firing 
>up an 'ls' # for every lock that the find saw can really pound 
>your cvs server. sub do_ls {
>    my($filename) = @_;
>    my($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,
>       $atime, $mtime) = lstat($filename);
>
>    # Transient lock files go away very fast, use the cached
>    # lstat handle "_" to see if it already gone.
>    return if (! -e _);
>
>    my $user = (getpwuid($uid))[0];
>    my $group = (getgrgid($gid))[0];
>
>    return if (! -e $filename);        # transient lock files 
>go away very fast
>
>    my $modebuf = filemode($mode);
>    my $timebuf = filetime($mtime);
>
>    $user  = $uid if ($user eq '');
>    $group = $gid if ($group eq '');
>
>    printf("%s%3d %-8.8s %-8.8s %8d %s %s", $modebuf, $nlink, $user,
>           $group, $size, $timebuf, $filename);
>    if (S_ISLNK($mode)) {
>        printf("-> %s\n", readlink($filename));
>        ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,
>         $atime, $mtime) = stat($filename);
>        $user  = (getpwuid($uid))[0];
>        $group = (getgrgid($gid))[0];
>        $modebuf = filemode($mode);
>        $timebuf = filetime($mtime);
>
>        printf("%s%3d %-8.8s %-8.8s %8d %s %s", $modebuf, 
>$nlink, $user,
>               $group, $size, $timebuf, readlink($filename));
>
>    }
>    print("\n");
>}
>
># There are probably better ways to do this
>sub do_ps {
>    my($pid, $host) = @_;
>    my @text;
>    my $res;
>
>    if ($host eq $thishost) {
>       print(join(' ', @pscmd_args, $pid), "\n")
>           if ($verbose);
>       open(PSCMD, "-|") || exec @pscmd_args, $pid;
>       @text = <PSCMD>;
>       close(PSCMD);
>    } else {
>       print(join(' ',$remote_shell, $host, @pscmd_args, $pid), "\n")
>           if ($verbose);
>       open(PSCMD, "-|") || exec $remote_shell, $host, 
>@pscmd_args, $pid;
>       @text = <PSCMD>;
>       close(PSCMD);
>    }
>    if (scalar(@text)) {
>       print(@text) if ($verbose);
>       my($line) = pop(@text);
>       if ($line =~ /^\s*$pid\s/) {
>           $res = activelock();
>       } else {
>           $res = stalelock();
>       }
>    } else {
>       $res = unknownlock();
>    }
>    $res
>}
>
>sub filetime {
>    my($time) = @_;
>    my($current_time) = time;
>    my($sixmonths) = 6 * 30 * 24 * 60 * 60;
>    my(@MoY) = ('Jan','Feb','Mar','Apr','May','Jun',
>                'Jul','Aug','Sep','Oct','Nov','Dec');
>    my($sec, $min, $hour, $mday, $mon, $year) = localtime($time);
>    my($res);
>
>    $year += 1900;
>    if (($current_time > ($time + $sixmonths)) ||
>        ($current_time < ($time - (60 * 60)))) {
>        $res = sprintf("%s %2d  %d", $MoY[$mon], $mday, $year);
>    }
>    else {
>        $res = sprintf("%s %2d %02d:%02d", $MoY[$mon], $mday, 
>$hour, $min);
>    }
>
>    $res;
>}
>
>sub filemode {
>    my($mode) = @_;
>    my @digits = (split(//,sprintf("%o",$mode)));
>
>    my $o = pop(@digits);
>    my $g = pop(@digits);
>    my $u = pop(@digits);
>    my $s = pop(@digits);
>
>    my $modebuf  = '?';
>    $modebuf  = 'b' if S_IFBLK($mode);         # for block special
>    $modebuf  = 'c' if S_ISCHR($mode);         # for character
>    $modebuf  = 'd' if S_ISDIR($mode);         # for directory
>    $modebuf  = '-' if S_ISREG($mode);         # for regular file
>    $modebuf  = 'p' if S_ISFIFO($mode);        # for fifo
>    $modebuf  = 'l' if S_ISLNK($mode);         # for symbolic link
>    $modebuf  = 's' if S_ISSOCK($mode);        # for socket
>    $modebuf  = 'w' if S_ISWHT($mode);         # for whiteout
>
>    $modebuf .= modebits($u, ($mode & 04000), 's', 'S');
>    $modebuf .= modebits($g, ($mode & 02000), 's', 'S');
>    $modebuf .= modebits($o, ($mode & 01000), 't', 'T');
>
>    $modebuf;
>}
>
>sub modebits {
>    my($oct, $bit, $x1, $x2) = @_;
>    my($res);
>    if ($oct & 04) { $res  = 'r'; } else { $res  = '-'; }
>    if ($oct & 02) { $res .= 'w'; } else { $res .= '-'; }
>    if (($oct & 01) && $bit)       { $res .= $x1; }
>    elsif (($oct & 01) && (!$bit)) { $res .= 'x'; }
>    elsif ($bit)                   { $res .= $x2; }
>    else                           { $res .= '-'; }
>
>    $res;
>}
>
>sub S_IFMT   { 0170000; }       # type of file
>sub S_IFIFO  { 0010000; }       # FIFO special
>sub S_IFCHR  { 0020000; }       # character special
>sub S_IFDIR  { 0040000; }       # directory
>sub S_IFBLK  { 0060000; }       # block special
>sub S_IFREG  { 0100000; }       # regular file
>sub S_IFLNK  { 0120000; }       # symbolic link
>sub S_IFSOCK { 0140000; }       # socket
>sub S_IFWHT  { 0160000; }       # whiteout
>
>sub S_ISDIR  { my($m) = @_; ((S_IFMT() & $m) == S_IFDIR());  } 
>sub S_ISCHR  { my($m) = @_; ((S_IFMT() & $m) == S_IFCHR());  } 
>sub S_ISBLK  { my($m) = @_; ((S_IFMT() & $m) == S_IFBLK());  } 
>sub S_ISREG  { my($m) = @_; ((S_IFMT() & $m) == S_IFREG());  } 
>sub S_ISLNK  { my($m) = @_; ((S_IFMT() & $m) == S_IFLNK());  } 
>sub S_ISSOCK { my($m) = @_; ((S_IFMT() & $m) == S_IFSOCK()); } 
>sub S_ISFIFO { my($m) = @_; ((S_IFMT() & $m) == S_IFIFO());  } 
>sub S_ISWHT  { my($m) = @_; ((S_IFMT() & $m) == S_IFWHT());  } 
>__END__ -----BEGIN PGP SIGNATURE-----
>Version: GnuPG v1.2.3 (FreeBSD)
>
>iD8DBQFBaA0E3x41pRYZE/gRAiqAAJ90ywMnpmquveitVAnEdCKO8TCPfQCdHbFr
>ItIJe+cV8IuRAeOTJD6E7G4=
>=Cut7
>-----END PGP SIGNATURE-----
>
>
>_______________________________________________
>Info-cvs mailing list
>address@hidden
>http://lists.gnu.org/mailman/listinfo/info-cvs
>