PageRenderTime 22ms CodeModel.GetById 14ms app.highlight 3ms RepoModel.GetById 1ms app.codeStats 0ms

/scripts/dshbak

https://code.google.com/
Perl | 361 lines | 163 code | 51 blank | 147 comment | 27 complexity | 743b7e4d62e3008812328f4840b1b2ec MD5 | raw file
  1#!/usr/bin/perl -w
  2#############################################################################
  3# $Id$
  4#############################################################################
  5#
  6#  Copyright (C) 2001-2006 The Regents of the University of California.
  7#  Copyright (C) 2007-2011 Lawrence Livermore National Security, LLC.
  8#  Produced at Lawrence Livermore National Laboratory (cf, DISCLAIMER).
  9#  Written by Jim Garlick <garlick@llnl.gov>.
 10#  UCRL-CODE-2003-005.
 11#
 12#  This file is part of Pdsh, a parallel remote shell program.
 13#  For details, see <http://www.llnl.gov/linux/pdsh/>.
 14#
 15#  Pdsh is free software; you can redistribute it and/or modify it under
 16#  the terms of the GNU General Public License as published by the Free
 17#  Software Foundation; either version 2 of the License, or (at your option)
 18#  any later version.
 19#
 20#  Pdsh is distributed in the hope that it will be useful, but WITHOUT ANY
 21#  WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
 22#  FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
 23#  details.
 24#
 25#  You should have received a copy of the GNU General Public License along
 26#  with Pdsh; if not, write to the Free Software Foundation, Inc.,
 27#  59 Temple Place, Suite 330, Boston, MA  02111-1307  USA.
 28#
 29#############################################################################
 30
 31require 5.003;
 32use strict;
 33
 34use Getopt::Std;
 35use File::Basename qw/ basename /;
 36use File::Path;
 37
 38use constant GETOPTS_ARGS => "chfd:";
 39use vars map { "\$opt_$_" } split(/:*/, GETOPTS_ARGS);
 40
 41#############################################################################
 42my $prog  = basename $0;
 43my $usage = <<EOF;
 44Usage: $prog [OPTION]...
 45 -h       Display this help message
 46 -c       Coalesce identical output from hosts
 47 -d DIR   Send output to files in DIR, one file per host
 48 -f       With -d, force creation of DIR
 49EOF
 50
 51#
 52#  Save the desired output type in output_fn, which
 53#   can be do_output_normal, do_output_per_file, or do_output_coalesced.
 54#
 55my $output_fn = \&do_output_normal;
 56
 57#############################################################################
 58
 59getopts(GETOPTS_ARGS) or usage();
 60
 61#############################################################################
 62#
 63#  Process args:
 64#
 65$opt_h and usage(0);
 66
 67if ($opt_c) {
 68	&log_fatal ("Do not specify both -c and -d\n") if ($opt_d);
 69	$output_fn = \&do_output_coalesced;
 70}
 71
 72if ($opt_d) {
 73    if ($opt_f and not -d $opt_d) {
 74		eval { mkpath ($opt_d) };
 75		&log_fatal ("Failed to create $opt_d: $@\n") if ($@);
 76	}
 77	-d $opt_d or &log_fatal ("Output directory $opt_d does not exist\n");
 78
 79	$output_fn = \&do_output_per_file;
 80}
 81
 82&log_fatal ("Option -f may only be used with -d\n") if ($opt_f && !$opt_d);
 83
 84
 85#############################################################################
 86#
 87#  Grab all lines of input and produce output:
 88#
 89my %lines = &process_lines ();
 90&$output_fn ($_) for (sortn (keys %lines));
 91
 92exit 0;
 93#############################################################################
 94#
 95#  Functions:
 96#
 97#
 98sub log_msg   { print STDERR "$prog: ", @_;       }
 99sub log_fatal { &log_msg ("Fatal: ", @_); exit 1; }
100
101#
102#  Read lines of stdin produced from pdsh and push onto a hash
103#   per host prefix.
104#
105sub process_lines
106{
107	my %lines = ();
108	#
109	# Stdin consists of lines of the form "hostname: output...".
110	# Store these in a hash, keyed by hostname, of lists of lines.
111	#
112	while (<>) {
113		my ($tag, $data) = m/^\s*(\S+?)\s*: ?(.*\n)$/;
114		#  Ignore lines that aren't prefixed with a hostname:
115		next unless $tag;
116		push(@{$lines{$tag}}, $data);
117	}
118	return %lines;
119}
120
121#
122#  Print the standard dshbak header
123#
124sub print_header
125{
126	my $div = "----------------\n";
127	print $div, join (",", @_), "\n", $div
128}
129
130#
131#  Normal output function
132#
133sub do_output_normal
134{
135	my ($tag) = @_;
136	&print_header ($tag);
137	print @{$lines{$tag}};
138}
139
140#
141#  Put each host output into separate files in directory
142#   specified by $opt_d.
143#
144sub do_output_per_file
145{
146	my ($tag) = @_;
147	my $file = "$opt_d/$tag";
148	open (OUTPUT, ">$file") ||
149		&log_fatal ("Failed to open output file '$file': $!\n");
150
151	print OUTPUT @{$lines{$tag}};
152}
153
154#
155#  Print identical output only once, tagged with the list of
156#   hosts producing matching data.
157#
158sub do_output_coalesced
159{
160	my ($tag) = @_;
161	my @identical = ();
162
163	#
164	#  Ignore any deleted tags, lines from these hosts has already
165	#   been printed:
166	#
167	return if not defined ($lines{$tag});
168
169	#
170	#  Look for other hosts with identical output:
171	#
172	for my $tag2 (keys %lines) {
173		next if ($tag2 eq $tag);
174		next unless (cmp_list ($lines{$tag}, $lines{$tag2}));
175		#
176		#  Output is identical -- stash the tag of this match and
177		#   delete it from further processing:
178		#
179		push (@identical, $tag2);
180		delete ($lines{$tag2});
181	}
182
183	&print_header (compress (sort (@identical, $tag)));
184	print @{$lines{$tag}};
185}
186
187#
188# Compare two lists-o-strings
189#	\@l1 (IN)	list1
190#	\@l2 (IN)	list2
191#	RETURN		1 if match, 0 if not
192#
193sub cmp_list
194{
195	my ($l1, $l2) = @_;
196	my ($i, $retval);
197
198	$retval = 1;
199
200	if ($#{$l1} != $#{$l2}) {
201		return 0;
202	}
203	for ($i = 0; $i <= $#{$l1} && $retval == 1; $i++) {
204		if (!defined(${$l2}[$i]) || ${$l1}[$i] ne ${$l2}[$i]) {
205			$retval = 0;
206		}
207	}
208
209	return $retval;
210}
211
212sub usage
213{
214	my ($rc) = $@ ? $@ : 0;
215	printf STDERR $usage;
216	exit $rc;
217}
218
219
220#
221#  Try to compress a list of hosts into a host range
222#
223sub compress 
224{
225	my %suffixes = ();
226	my @list = ();
227 
228	#   Each suffix key points to a list of hostnames with corresponding
229	#    suffix stripped off.
230	push (@{$suffixes{$$_[1]}}, $$_[0]) 
231	   for map { [/(.*?\d*)(\D*)$/] } sortn (@_);
232
233	#
234	#   For each suffix, run compress on hostnames without suffix, then
235	#    reapply suffix name.
236	for my $suffix (keys %suffixes) {
237	    map { push (@list, "$_$suffix") } 
238	        compress_inner (@{$suffixes{$suffix}}); 
239	}
240
241	local $"=",";
242	return wantarray ?  @list : "@list";
243}
244
245
246sub compress_inner
247{
248	my %rng = comp(@_);
249	my @list = ();
250
251	local $"=",";
252
253	@list = map {  $_ .
254		      (@{$rng{$_}}>1 || ${$rng{$_}}[0] =~ /-/ ?
255		                "[@{$rng{$_}}]" :
256				 "@{$rng{$_}}"
257		      )
258	            } sort keys %rng;
259
260	return wantarray ? @list : "@list";
261}
262
263#
264#  Return the zeropadded width of $n, where the zero-padded
265#   width is the minimum format width a number with the given
266#   zero-padding. That is, no zero-padding is 1, because 0-9
267#   have a minimum width of 1, "01" has a width of 2, 010 has
268#   a width of 3 and so on.
269#
270sub zeropadwidth
271{
272   my ($n) = @_;
273
274   #
275   #  zeropad width is the length of $n if there are any leading
276   #   zeros and the number is not zero itself.
277   #
278   return length $n if (($n =~ /^0/) and ($n ne "0"));
279
280   #
281   #  If no leading zeros (or $n == 0) then the width is always '1'
282   #
283   return 1;
284}
285
286sub comp
287{
288	my (%i) = ();
289	my (%s) = ();
290
291	# turn off warnings here to avoid perl complaints about 
292	# uninitialized values for members of %i and %s
293	local ($^W) = 0;
294
295
296	for my $host (sortn (@_)) {
297		my ($p, $n) = $host =~ /(.*?)(\d*)$/;
298		my $zp = &zeropadwidth ($n);
299		#
300		#  $s{$p} is a reference to an array of arrays
301		#   that indicate individual range elements of
302		#   the form [ N_start, N_end]. If only one element
303		#   is present then the range element is a singleton.
304		#
305		#  $i{$p}{$zp}${n} tracks the index of prefix $p and suffix $n
306		#   with zero-padding $zp into the @{$s{$p}} array.
307
308		#
309		#  Need to check if $n-1 exists in the $s{$p} array, but the
310		#   zero-padded width must be compatible. e.g.. "9" and "09"
311		#   are compatible with 10, but not with 010. 
312		#
313		my $idx = $i{$p}{$zp}{$n-1};
314
315		#
316		#  If the current zeropad is 1, and the length of $n is > 1,
317		#   then we check for a previous number with either zp == 1 or
318		#   zp == length. This catches 09-10, 099-100, etc .
319		#
320		if (!defined $idx && $zp == 1) {
321			$idx = $i{$p}{length $n}{$n-1};
322		}
323
324		if (defined $idx) {
325			#
326			#  $n - 1 is already in array, so update END:
327			#
328			$s{$p}[$idx][1] = "$n";
329			$i{$p}{$zp}{$n-0} = $idx;
330		}
331		else {
332			#
333			#   Otherwise, we create a new single entry
334			#    and update $i{} (Use $n-0 to force a number)
335			#
336			push (@{$s{$p}}, [ $n ]);
337			$i{$p}{$zp}{$n-0} = $#{$s{$p}};
338		}
339	}
340
341	#
342	#
343	#  Now return $s{} as a hash of prefixes with a list of range elemts:
344	#   e.g. $s{"host"} = [ "1-10", "25", "100-101" ]
345	#
346	for my $key (keys %s) {
347		@{$s{$key}} =
348			map { $#$_>0 ? "$$_[0]-$$_[$#$_]" : "$$_[0]" }  @{$s{$key}};
349	}
350	return %s;
351}
352
353# sortn:
354#
355# sort a group of alphanumeric strings by the last group of digits on
356# those strings, if such exists (good for numerically suffixed host lists)
357#
358sub sortn
359{
360	map {$$_[0]} sort {($$a[1]||0)<=>($$b[1]||0)} map {[$_,/(\d*)$/]} @_;
361}