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