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: [EMAIL PROTECTED] >[mailto:[EMAIL PROTECTED] >] On Behalf Of Mark D. Baushke >Sent: Saturday, October 09, 2004 12:09 PM >To: Gurpreet Singh (SCM) >Cc: [EMAIL PROTECTED] >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 <[EMAIL PROTECTED]> >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>[EMAIL PROTECTED]<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 >[EMAIL PROTECTED] >http://lists.gnu.org/mailman/listinfo/info-cvs > _______________________________________________ Info-cvs mailing list [EMAIL PROTECTED] http://lists.gnu.org/mailman/listinfo/info-cvs
