1 | #!/usr/bin/perl |
---|
2 | |
---|
3 | # Script to help generate find the .scripts-version files |
---|
4 | |
---|
5 | use lib '/mit/scripts/sec-tools/perl'; |
---|
6 | |
---|
7 | open(FILE, "</mit/scripts/sec-tools/store/scriptslist"); |
---|
8 | my $dump = "/mit/scripts/sec-tools/store/versions"; |
---|
9 | |
---|
10 | (! -e $dump) || die "Output directory exists: $dump"; |
---|
11 | system("mkdir", $dump) && die; |
---|
12 | |
---|
13 | use Proc::Queue size => 40, debug => 0, trace => 0; |
---|
14 | use POSIX ":sys_wait_h"; # imports WNOHANG |
---|
15 | |
---|
16 | # this loop creates new childs, but Proc::Queue makes it wait every |
---|
17 | # time the limit (50) is reached until enough childs exit |
---|
18 | |
---|
19 | # Note that we miss things where one volume is inside another if we |
---|
20 | # use -xdev. May miss libraries stuff. |
---|
21 | |
---|
22 | sub find ($$) { |
---|
23 | my $user = shift; |
---|
24 | my $homedir = shift; |
---|
25 | |
---|
26 | open my $files, "find $homedir/web_scripts -xdev -name .scripts-version 2>/dev/null |"; |
---|
27 | open my $out, ">$dump/$user"; |
---|
28 | while (my $f = <$files>) { |
---|
29 | print $out $f; |
---|
30 | } |
---|
31 | return 0; |
---|
32 | } |
---|
33 | |
---|
34 | while (<FILE>) { |
---|
35 | my ($user, $homedir) = /^([^ ]*) (.*)$/; |
---|
36 | my $f=fork; |
---|
37 | if(defined ($f) and $f==0) { |
---|
38 | if ($homedir !~ m|^/afs/athena|) { |
---|
39 | print "ignoring non-athena-cell $user $homedir\n"; |
---|
40 | exit(0); |
---|
41 | } |
---|
42 | print "$user\n"; |
---|
43 | $ret = find($user, $homedir); |
---|
44 | sleep rand 1; |
---|
45 | exit($ret); |
---|
46 | } |
---|
47 | 1 while waitpid(-1, WNOHANG)>0; # avoids memory leaks in Proc::Queue |
---|
48 | } |
---|