info-cvs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: CVS Lock Files


From: Mark D. Baushke
Subject: Re: CVS Lock Files
Date: Thu, 23 Jun 2005 13:17:39 -0700

-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1


 The following script will try to only remove stale CVS locks when the
 --pid option is used. However, it does assume that /usr/bin/ps accepts
 the -p switch which may not be true on your platform. It will even try
 to clean up locks in the LockDir directory if your repository has been
 configured to use one of those instead.

        Good luck,
        -- Mark

: # use perl -*-Perl-*-
eval 'exec perl -S $0 ${1+"$@"}'
    if 0;

=head1 NAME

find-locks.perl - locate and possibly remove stale cvs locks

=head1 SYNOPSIS

find-locks.perl [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-locks.perl - 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-locks.perl> -- 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.006;
use strict;
use warnings;
use File::Find;
use Sys::Hostname;
use Getopt::Long;
use Pod::Usage;

# Current version of this program
my $VERSION =
    sprintf("%s", q$Id: find-locks.perl,v 1.6 2004/10/11 14:50:04 mdb Exp $
            =~ /(\d+\.\d+)/);

# 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, $version) =
    (0, 0, 0, 0, 0, 0, 1, 0);

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,
           'version' => \$version);
pod2usage(1) if $help;
pod2usage(-exitstatus => 0, -verbose => 2) if $man;

# Print the version and exit if the users wants to know
if ($version) {
    printf("%s version %s\n", $0 =~ m{.*/(.*)}, $VERSION);
    exit 0;
}

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)

iD8DBQFCuxjj3x41pRYZE/gRAvw1AKCJ0fIPhQLgtcSLQciv9aFInNaxXwCgqdmu
hPJ/gVTajOCFTOYvKWtZLQA=
=HZIg
-----END PGP SIGNATURE-----




reply via email to

[Prev in Thread] Current Thread [Next in Thread]