source: trunk/locker/sbin/parallel-find.pl @ 1371

Last change on this file since 1371 was 1371, checked in by ezyang, 13 years ago
Fix some tab/space problems, add missing parameter to unlock_and_die.
  • Property svn:executable set to *
File size: 2.9 KB
Line 
1#!/usr/bin/perl
2
3# Script to help generate find the .scripts-version files
4
5use LockFile::Simple qw(trylock unlock);
6
7use lib '/mit/scripts/sec-tools/perl';
8
9open(FILE, "</mit/scripts/sec-tools/store/scriptslist");
10my $dump = "/mit/scripts/sec-tools/store/versions";
11my $dumpbackup = "/mit/scripts/sec-tools/store/versions-backup";
12
13# try to grab a lock on the version directory
14trylock($dump) || die "Can't acquire lock on $dump .  Another parallel-find may be running.  If you are SURE there is not, remove the lock file and retry.";
15
16sub unlock_and_die ($) {
17    my $msg = shift;
18    unlock($dump);
19    die $msg;
20}
21
22# if the versions directory exists, move it to versions-backup
23# (removing the backup directory if necessary).  Then make a new copy.
24if (-e $dump){
25    if (-e $dumpbackup){
26        system("rm -rf $dumpbackup") && unlock_and_die "Can't remove old backup directory $dumpbackup";
27    }
28    system("mv", $dump, $dumpbackup) && unlock_and_die "Unable to back up current directory $dump";
29}
30system("mkdir", $dump) && unlock_and_die "mkdir failed to create $dump";
31
32use Proc::Queue size => 40, debug => 0, trace => 0;
33use POSIX ":sys_wait_h"; # imports WNOHANG
34
35# this loop creates new childs, but Proc::Queue makes it wait every
36# time the limit (50) is reached until enough childs exit
37
38# Note that we miss things where one volume is inside another if we
39# use -xdev.  May miss libraries stuff.
40
41sub updatable ($) {
42    my $filename = shift;
43    for my $l (`fs la "$filename"`) {
44        return 1 if ($l =~ /^  system:scripts-security-upd rlidwk/);
45    }
46    return 0;
47}
48
49sub old_version ($) {
50    my $dirname = shift;
51    open my $h, "$dirname/.scripts-version";
52    return (<$h>)[-1];
53}
54
55sub version ($) {
56    my $dirname = shift;
57    open my $h, "$dirname/.scripts/version";
58    return (<$h>)[-1];
59}
60
61sub find ($$) {
62    my $user = shift;
63    my $homedir = shift;
64
65    open my $files, "find $homedir/web_scripts -xdev -name .scripts-version -o -name .scripts 2>/dev/null |";
66    open my $out, ">$dump/$user";
67    while (my $f = <$files>) {
68        chomp $f;
69        my $old_style;
70        $old_style = ($f =~ s!/\.scripts-version$!!);
71        if (! $old_style) {
72            $f =~ s!/\.scripts$!!;
73        }
74        if (! updatable($f)) {
75            print STDERR "not updatable: $f";
76            next;
77        }
78        $v = $old_style ? old_version($f) : version($f);
79        print $out "$f:$v";
80    }
81    return 0;
82}
83
84while (<FILE>) {
85    my ($user, $homedir) = /^([^ ]*) (.*)$/;
86    my $f=fork;
87    if(defined ($f) and $f==0) {
88        if ($homedir !~ m|^/afs/athena| && $homedir !~ m|^/afs/sipb| && $homedir !~ m|^/afs/zone|) {
89            print "ignoring foreign-cell $user $homedir\n";
90            exit(0);
91        }
92        print "$user\n";
93        $ret = find($user, $homedir);
94        sleep rand 1;
95        exit($ret);
96    }
97    1 while waitpid(-1, WNOHANG)>0; # avoids memory leaks in Proc::Queue
98}
99
100unlock($dump);
1011;
Note: See TracBrowser for help on using the repository browser.