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

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