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

Last change on this file since 1384 was 1384, checked in by ezyang, 15 years ago
Make parallel find /actually/ work with Wizard autoinstalls.
  • 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);
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; 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.";
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    $uid = stat($dirname)->uid;
58    open my $h, "sudo -u #$uid git describe --tags 2>/dev/null |";
59    chomp($val = <$h>);
60    return $val;
61}
62
63sub find ($$) {
64    my $user = shift;
65    my $homedir = shift;
66
67    open my $files, "find $homedir/web_scripts -xdev -name .scripts-version -o -name .scripts 2>/dev/null |";
68    open my $out, ">$dump/$user";
69    while (my $f = <$files>) {
70        chomp $f;
71        my $new_style;
72        $new_style = ($f =~ s!/\.scripts$!!);
73        if (! $new_style) {
74            $f =~ s!/\.scripts-version$!!;
75        }
76        if (! updatable($f)) {
77            print STDERR "not updatable: $f";
78            next;
79        }
80        $v = $new_style ? version($f) : old_version($f);
81        print $out "$f:$v";
82    }
83    return 0;
84}
85
86while (<FILE>) {
87    my ($user, $homedir) = /^([^ ]*) (.*)$/;
88    my $f=fork;
89    if(defined ($f) and $f==0) {
90        if ($homedir !~ m|^/afs/athena| && $homedir !~ m|^/afs/sipb| && $homedir !~ m|^/afs/zone|) {
91            print "ignoring foreign-cell $user $homedir\n";
92            exit(0);
93        }
94        print "$user\n";
95        $ret = find($user, $homedir);
96        sleep rand 1;
97        exit($ret);
98    }
99    1 while waitpid(-1, WNOHANG)>0; # avoids memory leaks in Proc::Queue
100}
101
102unlock($dump);
1031;
Note: See TracBrowser for help on using the repository browser.