home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1992 March / Source_Code_CD-ROM_Walnut_Creek_March_1992.iso / usenet / altsrcs / 0 / 0996 < prev    next >
Encoding:
Internet Message Format  |  1990-12-28  |  8.7 KB
  1. From: merlyn@iwarp.intel.com (Randal Schwartz)
  2. Newsgroups: comp.lang.perl,alt.sources
  3. Subject: multiple host command launcher (gsh) in Perl
  4. Message-ID: <1990Mar7.190633.3801@iwarp.intel.com>
  5. Date: 7 Mar 90 19:06:33 GMT
  6.  
  7. Here's the 'gsh' I've been using for a while (industrial strength by
  8. now).  The coding style is not pretty, but it has been roadtested.
  9.  
  10. Yes, this stuff was inspired by the 'gsh' in the Perl distribution,
  11. although I've taken it about three steps further.  Mine has parallel
  12. launching and waiting, a built-in (but overridable/extensible)
  13. hostlist, and a timeout for those rsh's that launch but "never" come
  14. back.  You'll want to edit the builtin hostlist, unless you just
  15. *happen* to have a bunch of systems named 'iwarpa', 'iwarpb', etc.
  16. etc. :-)
  17.  
  18. Enjoy.
  19.  
  20. ================================================== snip here
  21. #!/local/merlyn/bin/perl
  22. ## Copyright (C) 1989, 1990, by Randal L. Schwartz.  All Rights Reserved.
  23. ## usage: gsh [options] hostspec [command [arg]...]
  24. ## Runs command and args on hosts according to hostspec.  Results are
  25. ## sent to STDOUT, with hostname prefix.  A missing command means to just
  26. ## echo the computed hostnames on STDOUT. 'hostspec' is one of:
  27. ##   hostname, hostattribute, hostspec+hostspec, hostspec-hostspec
  28. ## Default hostlist is defined in @HOSTLIST later on.
  29. ##
  30. ## options:
  31. ## -d: don't run any commands on other hosts... but fork anyway.
  32. ## -h hostlist: extend the hostlist with the contents of the named file.
  33. ## -H hostlist: replace the hostlist with the contents of the named file.
  34. ## -i: give STDIN to the processes as STDIN
  35. ## -o place: send the outputs to "place$host" instead of STDOUT
  36. ## -n procs: run this many processes at a time (default 5).
  37. ##           (remember that each rsh is two processes on this host!)
  38. ## -v: be noisy about starting and finishing processes.
  39. ## -z sec: zap processes after sec seconds (default 300).
  40.  
  41. ## requires 3.0 beta or better
  42. @HOSTLIST = split(/\n/, <<'ENDHOSTLIST');  # comments allowed in here...
  43. all=vax+sun
  44. sun=sun3+sun4+sun386
  45. sun3=sun3server+sun3client
  46. sun4=sun4server+sun4client
  47. sunserver=sun3server+sun4server
  48. sunclient=sun3client+sun4client
  49. sun3server=sun3/160s+sun3/260s+sun3/280s
  50. sun3client=sun3/50c+sun3/60c+sun3/75c+sun3/140c
  51. sun4server=sun4/280s
  52. sun4client=sun4/110c
  53. sun386=sun386i
  54. iwarpa iwa a vax ultrix2
  55. iwarpb iwb b vax ultrix2
  56. iwarpc iwc c vax ultrix2
  57. iwarpd iwd d vax ultrix2
  58. iwarpe iwe e vax ultrix2
  59. iwarpf iwf f vax ultrix2
  60. iwarpg iwg g vax ultrix2
  61. iwarph iwh h vax ultrix2
  62. iwarpi iwi i vax ultrix2
  63. iwarpj iwj j sun3/160s sunos4 diskserver
  64. iwarpj0 iwj0 j0 sun3/75c sunos4 diskclient
  65. iwarpj1 iwj1 j1 sun3/75c sunos4 diskclient
  66. iwarpj2 iwj2 j2 sun3/75c sunos4 diskclient
  67. iwarpj3 iwj3 j3 sun3/75c sunos4 diskclient
  68. iwarpk iwk k sun3/260s sunos4 diskserver
  69. iwarpk0 iwk0 k0 sun3/75c sunos4 diskclient
  70. iwarpk1 iwk1 k1 sun3/75c sunos4 diskclient
  71. iwarpk2 iwk2 k2 sun3/75c sunos4 diskclient
  72. iwarpk3 iwk3 k3 sun3/75c sunos4 diskclient
  73. iwarpl iwl l sun3/260s sunos4 diskserver
  74. iwarpl0 iwl0 l0 sun3/75c sunos4 diskclient
  75. iwarpl1 iwl1 l1 sun3/75c sunos4 diskclient
  76. iwarpl2 iwl2 l2 sun3/75c sunos4 diskclient
  77. iwarpl3 iwl3 l3 sun3/75c sunos4 diskclient
  78. iwarpm iwm m sun3/260s sunos4 diskserver
  79. iwarpm0 iwm0 m0 sun3/140c sunos4 diskclient
  80. iwarpm1 iwm1 m1 sun3/140c sunos4 diskclient
  81. iwarpm2 iwm2 m2 sun3/140c sunos4 diskclient
  82. iwarpm3 iwm3 m3 sun3/140c sunos4 diskclient
  83. iwarpn iwn n sun3/260s sunos4 diskserver
  84. iwarpn0 iwn0 n0 sun3/140c sunos4 diskclient
  85. iwarpn1 iwn1 n1 sun3/140c sunos4 diskclient
  86. iwarpn2 iwn2 n2 sun3/140c sunos4 diskclient
  87. ## iwarpn3 iwn3 n3 sun3/140c sunos4 diskclient
  88. iwarpo iwo o sun3/260s sunos4 diskserver
  89. iwarpo0 iwo0 o0 sun3/140c sunos4 diskclient
  90. iwarpo1 iwo1 o1 sun3/140c sunos4 diskclient
  91. iwarpo2 iwo2 o2 sun3/140c sunos4 diskclient
  92. iwarpo3 iwo3 o3 sun3/140c sunos4 diskclient
  93. iwarpp iwp p sun3/280s sunos4
  94. iwarpp0 iwp0 p0 sun386i sunos4
  95. iwarpp1 iwp1 p1 sun386i sunos4
  96. iwarpp2 iwp2 p2 sun386i sunos4
  97. iwarpp3 iwp3 p3 sun386i sunos4
  98. iwarpp4 iwp4 p4 sun386i sunos4
  99. iwarpp5 iwp5 p5 sun386i sunos4
  100. iwarpq iwq q sun4/280s sunos4 diskserver
  101. ## iwarpq0 iwq0 q0 sun4/110c sunos4 diskclient
  102. ## iwarpq1 iwq1 q1 sun4/110c sunos4 diskclient
  103. iwarpr iwr r sun3/280s sunos4 diskserver
  104. iwarpr0 iwr0 r0 sun3/60c sunos4 diskclient
  105. iwarpr1 iwr1 r1 sun3/60c sunos4 diskclient
  106. iwarpr2 iwr2 r2 sun3/60c sunos4 diskclient
  107. iwarpr3 iwr3 r3 sun3/60c sunos4 diskclient
  108. iwarpr4 iwr4 r4 sun3/60c sunos4 diskclient
  109. ## iwarps iws s sun3/160s sunos4
  110. iwarpv iwv v vax ultrix2
  111. iwarpw iww w vax ultrix2
  112. iwarpx iwx x vax ultrix2
  113. iwarpy iwy y vax ultrix2
  114. iwarpz iwz z sun3/260s sunos4 diskserver
  115. iwarpz0 iwz0 z0 sun3/60c sunos4 diskclient
  116. iwarpz1 iwz1 z1 sun3/60c sunos4 diskclient
  117. iwarpz2 iwz2 z2 sun3/60c sunos4 diskclient
  118. iwarpz3 iwz3 z3 sun3/60c sunos4 diskclient
  119. ENDHOSTLIST
  120.  
  121. $| = 1; # don't buffer STDOUT
  122.  
  123. $the_task_filename = "/tmp/$$.thetask";
  124.  
  125. $tasks = 0;
  126. $taskmax = 5;
  127. $zapsecs = 300;
  128.  
  129. sub start {
  130.     local($host) = @_;
  131.  
  132.     print "starting '$host'...\n" if $verbose;
  133.     
  134.     while ($tasks > 0 && $tasks >= $taskmax) {
  135.         &finish();
  136.     };
  137.     unless ($pid = fork) {    # child
  138.         open(STDIN, "<$the_task_filename") ||
  139.             die "Cannot open $the_task_filename as STDIN ($!)";
  140.         open(STDOUT, ">$place$host") ||
  141.             die "Cannot open $place$host ($!)";
  142.         open(STDERR, ">&STDOUT");
  143.         exec 'cat' if $debug;
  144.         $parent = $$;
  145.         if (fork) { # still the child
  146.             exec 'rsh', $host, '/bin/sh';
  147.             die "Cannot exec rsh ($!)";
  148.         }
  149.         # child child
  150.         $zaptime = time + $zapsecs;
  151.         while (time < $zaptime) {
  152.             sleep 5;
  153.             exit 0 if getppid == 1;
  154.         }
  155.         kill 9, $parent;
  156.         print "\nTIMED OUT AFTER $zapsecs SECONDS\n";
  157.         exit 0;
  158.     }
  159.     $tasklist{$pid} = $host;
  160.     $tasks++;
  161. }
  162.  
  163. sub finish {
  164.     return unless $tasks > 0;
  165.     print "waiting on '", join(" ", sort values(tasklist)), "'...\n"
  166.         if $verbose;
  167.     do {
  168.         die "Nothing to wait for??? ($!)" unless ($pid = wait) > 0;
  169.     } until $tasklist{$pid};
  170.     print "finished task on '", delete $tasklist{$pid}, "'.\n"
  171.         if $verbose;
  172.     $tasks--;
  173. }
  174.  
  175. sub finishall {
  176.     while ($tasks > 0) {
  177.         &finish();
  178.     }
  179. }
  180.  
  181. sub gethostlist {
  182.     local($f,$replace) = @_;
  183.     open(GETHOSTLIST, "<$f") || die "Cannot open '$f' ($!)";
  184.     @HOSTLIST = () if $replace;
  185.     unshift(@HOSTLIST, <GETHOSTLIST>); # put it at the beginning
  186.     close(GETHOSTLIST);
  187. }
  188.  
  189. # end initialization... begin code...
  190.  
  191. while ($ARGV[0] =~ /^-/) {
  192.     $_ = shift;
  193.     $debug++, $verbose++, next if /^-d/;
  194.     $verbose++, next if /^-v/;
  195.     $taskmax = $1, next if /^-n(.+)/;
  196.     $taskmax = shift, next if /^-n/;
  197.     &gethostlist($1, 1), next if /^-H(.+)/;
  198.     &gethostlist(shift, 1), next if /^-H/;
  199.     &gethostlist($1), next if /^-h(.+)/;
  200.     &gethostlist(shift), next if /^-h/;
  201.     $do_stdin++, next if /^-i/;
  202.     $place = $1, next if /^-o(.+)/;
  203.     $place = shift, next if /^-o/;
  204.     $zapsecs = $1, next if /^-z(.+)/;
  205.     $zapsecs = shift, next if /^-z/;
  206.     die "unknown flag $_";
  207. }
  208.  
  209. $place = "/tmp/$$.", $do_stdout++ unless $place;
  210.  
  211. unshift(@HOSTLIST,"TARGET=" . shift);
  212.  
  213. $the_task .= join(" ", @ARGV);
  214. if ($do_stdin) {
  215.     $_ = join("",<STDIN>);
  216.     chop if /\n$/;
  217.     $the_task = "($the_task ;) <<'FoObAr'\n$_\nFoObAr\n";
  218.     # if I got tricky, I could skip the extra shell, but, hey... it works
  219. }
  220.  
  221. @TARGETS = ();
  222.  
  223. $attr{'TARGET'} = 1;    # this is what I want.
  224.  
  225. for $_ (@HOSTLIST) {
  226.     s/\s*\n?$//;    # toss trailing white
  227.     s/^\s*//;    # toss leading white
  228.     next if /^(#.*)?$/; # skip comment lines and blank lines
  229.     if (/^([^-+=]+)=(.*)/) {
  230.         ($name,$repl) = ($1,"+$2");
  231.         next unless $yes = $attr{$name}; # +1 if wanted, -1 if not
  232.         while ($repl =~ s/^([+-])([^-+]+)//) {
  233.             next if $attr{$2};
  234.             $attr{$2} = ($1 eq '-') ? - $yes : $yes;
  235.             print "assigning $attr{$2} to $2\n" if $debug;
  236.         }
  237.     } else {    # must be a terminal node:
  238.         @attr = split;
  239.         $host = $attr[0];
  240.         $wanted = 0;
  241.         for $attr (@attr) {
  242.             $wanted++, next if $attr{$attr} > 0;
  243.             $wanted=-1, last if $attr{$attr} < 0;
  244.         }
  245.         push(TARGETS, $host) if $wanted > 0;
  246.     }
  247. }
  248.  
  249. if ($the_task =~ /^\s*$/) { # no command?  just list the hosts
  250.     print join("\n", @TARGETS), "\n";
  251.     exit 0;
  252. }
  253.  
  254. open(THE_TASK, ">$the_task_filename") || die "Cannot open THE_TASK ($!)";
  255. print THE_TASK $the_task;
  256. close(THE_TASK);
  257.  
  258. for $host (@TARGETS) {    # launch'em all, $taskmax at a time
  259.     &start($host);
  260. }
  261.  
  262. &finishall();        # and hang out while the last $taskmax finish
  263.  
  264. unlink $the_task_filename; # no need for this anymore
  265.  
  266. exit 0 unless $do_stdout;
  267.  
  268. for $host (@TARGETS) {    # show what they said
  269.     open(F,"<$place$host") || die "missing output for $host ($!)";
  270.     if ($_ = join("$host:\t", <F>)) {
  271.         print "$host:\t$_";
  272.         print "\n" unless /\n$/;
  273.     }
  274.     close(F);
  275.     unlink "$place$host";
  276. }
  277. exit 0;
  278. ================================================== snip here
  279.  
  280. Just another Perl hacker,
  281. -- 
  282. /=Randal L. Schwartz, Stonehenge Consulting Services (503)777-0095 ==========\
  283. | on contract to Intel's iWarp project, Beaverton, Oregon, USA, Sol III      |
  284. | merlyn@iwarp.intel.com ...!any-MX-mailer-like-uunet!iwarp.intel.com!merlyn |
  285. \=Cute Quote: "Welcome to Portland, Oregon, home of the California Raisins!"=/
  286.