source: branches/locker-dev/locker/sbin/parallel-find.pl @ 1973

Last change on this file since 1973 was 1414, checked in by ezyang, 15 years ago
Merged in changes from trunk --- Merging r1262 through r1413 into 'deploy/bin': U deploy/bin/django C deploy/bin/rails > Resolved by accepting working copy --- Merging r1221 through r1413 into '.': U sql/bin/get-password U sql/bin/save-password U doc/tickets/rt.txt U doc/tickets/cnames.txt U bin/fix-php-ini C bin/scripts-rails > Resolved by accepting working copy Skipped 'bin/for-each-server' U bin U sbin/parallel-find.pl U sbin/commit-email.pl U sbin/commit-zephyr Summary of conflicts: Tree conflicts: 2 Skipped paths: 1
  • Property svn:executable set to *
File size: 3.3 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    chomp (my $v = (<$h>)[-1]);
54    return $v;
55}
56
57sub version ($) {
58    my $dirname = shift;
59    $uid = stat($dirname)->uid;
60    open my $h, "sudo -u#$uid git --git-dir=$dirname/.git describe --tags --always 2>/dev/null |";
61    chomp($val = <$h>);
62    if (! $val) {
63        print "Failed to read value for $dirname\n"
64    }
65    return $val;
66}
67
68sub find ($$) {
69    my $user = shift;
70    my $homedir = shift;
71
72    open my $files, "find $homedir/web_scripts -xdev -name .scripts-version -o -name .scripts 2>/dev/null |";
73    open my $out, ">$dump/$user";
74    while (my $f = <$files>) {
75        chomp $f;
76        my $new_style;
77        $new_style = ($f =~ s!/\.scripts$!!);
78        if (! $new_style) {
79            $f =~ s!/\.scripts-version$!!;
80            # Don't use .scripts-version of .scripts is around!
81            if (-d "$f/.scripts") {
82                next;
83            }
84        }
85        if (! updatable($f)) {
86            print STDERR "not updatable: $f";
87            next;
88        }
89        $v = $new_style ? version($f) : old_version($f);
90        print $out "$f:$v\n";
91    }
92    return 0;
93}
94
95while (<FILE>) {
96    my ($user, $homedir) = /^([^ ]*) (.*)$/;
97    my $f=fork;
98    if(defined ($f) and $f==0) {
99        if ($homedir !~ m|^/afs/athena| && $homedir !~ m|^/afs/sipb| && $homedir !~ m|^/afs/zone|) {
100            print "ignoring foreign-cell $user $homedir\n";
101            exit(0);
102        }
103        print "$user\n";
104        $ret = find($user, $homedir);
105        sleep rand 1;
106        exit($ret);
107    }
108    1 while waitpid(-1, WNOHANG)>0; # avoids memory leaks in Proc::Queue
109}
110
111unlock($dump);
1121;
Note: See TracBrowser for help on using the repository browser.