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

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