#!/usr/bin/env perl # IBM(c) 2007 EPL license http://www.eclipse.org/legal/epl-v10.html package xCAT::DSHCore; BEGIN { $::XCATROOT = $ENV{'XCATROOT'} ? $ENV{'XCATROOT'} : -d '/opt/xcat' ? '/opt/xcat' : '/usr'; } use locale; use strict; use Socket; use xCAT::MsgUtils; use xCAT::Utils; #--------------------------------------------------------------------------- =head3 fork_no_output Forks a process for the given command array and returns the process ID for the forked process. Since no I/O is needed for the pipes, no STDOUT/STDERR pipes are returned to the caller. Arguments: $fork_id - unique identifer to use for tracking the forked process @command - command and parameter array to execute in the forkec process Returns: $pid - process identifer for the forked process Globals: None Error: None Example: $pid = xCAT::DSHCore->fork_no_output('hostname1PID', @command_array); Comments: =cut #--------------------------------------------------------------------------- sub fork_no_output { my ($class, $fork_id, @command) = @_; my $pid; if ($pid = xCAT::Utils->xfork) { } elsif (defined $pid) { open(STDOUT, ">/dev/null"); open(STDERR, ">/dev/null"); select(STDOUT); $| = 1; select(STDERR); $| = 1; if (!(exec {$command[0]} @command)) { return (-4, undef); } } else { return (-3, undef); } return ($pid, undef, undef, undef, undef); } #--------------------------------------------------------------------------- =head3 fork_output Forks a process for the given command array and returns the process ID for the forked process and references to all I/O pipes for STDOUT and STDERR. Arguments: $fork_id - unique identifer to use for tracking the forked process @command - command and parameter array to execute in the forkec process Returns: $pid - process identifer for the forked process Globals: None Error: None Example: $pid = xCAT::DSHCore->fork_no_output('hostname1PID', @command_array); Comments: =cut #--------------------------------------------------------------------------- sub fork_output { my ($class, $fork_id, @command) = @_; no strict; my $pid; my %pipes = (); my $rout_fh = "rout_$fork_id"; my $rerr_fh = "rerr_$fork_id"; my $wout_fh = "wout_$fork_id"; my $werr_fh = "werr_$fork_id"; (pipe($rout_fh, $wout_fh) == -1) && return (-1, undef); (pipe($rerr_fh, $werr_fh) == -1) && return (-2, undef); if ($pid = fork) { close($wout_fh); close($werr_fh); } elsif (defined $pid) { close($rout_fh); close($rerr_fh); !(open(STDOUT, ">&$wout_fh")) && return (-5, undef); !(open(STDERR, ">&$werr_fh")) && return (-6, undef); select(STDOUT); $| = 1; select(STDERR); $| = 1; if (!(exec {$command[0]} @command)) { return (-4, undef); } } else { return (-3, undef); } return ($pid, *$rout_fh, *$rerr_fh, *$wout_fh, *$werr_fh); use strict; } #--------------------------------------------------------------------------- =head3 fork_output_for_commands Forks a process for the given command array and returns the process ID for the forked process and references to all I/O pipes for STDOUT and STDERR. In the child process, it will invoke the xCAT::DSHCore->fork_no_output() for the first command which is a no-output command and waitpid(). And then execute the left commands in the child process. Arguments: $fork_id - unique identifer to use for tracking the forked process @command - command and parameter array to execute in the forkec process Returns: $pid - process identifer for the forked process Globals: None Error: None Example: $pid = xCAT::DSHCore->fork_output_for_commands('hostname1PID', @command_array); Comments: =cut #--------------------------------------------------------------------------- sub fork_output_for_commands { my ($class, $fork_id, @commands) = @_; no strict; my $pid; my %pipes = (); my $rout_fh = "rout_$fork_id"; my $rerr_fh = "rerr_$fork_id"; my $wout_fh = "wout_$fork_id"; my $werr_fh = "werr_$fork_id"; (pipe($rout_fh, $wout_fh) == -1) && return (-1, undef); (pipe($rerr_fh, $werr_fh) == -1) && return (-2, undef); if ($pid = fork) { close($wout_fh); close($werr_fh); } elsif (defined $pid) { close($rout_fh); close($rerr_fh); !(open(STDOUT, ">&$wout_fh")) && return (-5, undef); !(open(STDERR, ">&$werr_fh")) && return (-6, undef); select(STDOUT); $| = 1; select(STDERR); $| = 1; if ( @commands > 1 ) { my $command0 = shift(@commands); my @exe_command0_process = xCAT::DSHCore->fork_no_output($fork_id, @$command0); waitpid($exe_command0_process[0], undef); } my $t_command = shift(@commands); my @command = @$t_command; if (!(exec {$command[0]} @command)) { return (-4, undef); } } else { return (-3, undef); } return ($pid, *$rout_fh, *$rerr_fh, *$wout_fh, *$werr_fh); use strict; } #--------------------------------------------------------------------------- =head3 ifconfig_inet Builds a list of all IP Addresses bound to the local host and stores them in a global list Arguments: None Returns: None Globals: @local_inet Error: None Example: xCAT::DSHCore->ifconfig_inet; Comments: Internal routine only =cut #--------------------------------------------------------------------------- sub ifconfig_inet { my @local_inet = (); if ($^O eq 'aix') { my @ip_address = (); my @output = `/usr/sbin/ifconfig -a`; foreach my $line (@output) { ($line =~ /inet ((\d{1,3}?\.){3}(\d){1,3})\s/o) && (push @local_inet, $1); } } elsif ($^O eq 'linux') { my @ip_address = (); my @output = `/sbin/ifconfig -a`; foreach my $line (@output) { ($line =~ /inet addr:((\d{1,3}?\.){3}(\d){1,3})\s/o) && (push @local_inet, $1); } } } #--------------------------------------------------------------------------- =head3 pipe_handler Handles and processes dsh output from a given read pipe handle. The output is immediately written to each output file handle as it is available. Arguments: $options - options hash table describing dsh configuration options $target_properties - property information of the target related to the pipe handle $read_fh - reference to the read pipe handle $buffer_size - local buffer size to read data from the handle $label - prefix label to use for dsh output $write_buffer - buffer of data that is yet to be written (must wait until \n is read) @write_fhs - array of output file handles where output will be written Returns: 1 if the EOF reached on $read_fh undef otherwise Globals: None Error: None Example: Comments: =cut #--------------------------------------------------------------------------- # NOTE: global environment $::__DSH_LAST_LINE} only can be used in DSHCore::pipe_handler and DSHCore::pipe_handler_buffer $::__DSH_LAST_LINE = undef; sub pipe_handler { my ($class, $options, $target_properties, $read_fh, $buffer_size, $label, $write_buffer, @write_fhs) = @_; my $line; my $target_hostname; my $eof_reached = undef; my $cust_rc_deal =0; if ($::USER_POST_CMD) { # If user provide post-command to display return code, # the keyword 'DSH_RC' will be searched, # the return code is gotten in another way as shown like below: # ... # <output> # <return_code> # DSH_RC # # The last two lines are needed to be moved out from output $cust_rc_deal = 1; } while (sysread($read_fh, $line, $buffer_size) != 0 || ($eof_reached = 1)) { last if ($eof_reached && (!defined($::__DSH_LAST_LINE->{$label}))); if ($line =~ /^\n$/ && scalar(@$write_buffer) == 0) { # need to preserve blank lines in the output. $line = $label . $line; } my @lines = split "\n", $line; if (@$write_buffer) { my $buffered_line = shift @$write_buffer; my $next_line = shift @lines; $next_line = $buffered_line . $next_line; unshift @lines, $next_line; } if ($line !~ /\n$/) { push @$write_buffer, (pop @lines); } if (@lines) { if ($cust_rc_deal) { # Dump the last line at the beginning of current buffer if ($::__DSH_LAST_LINE->{$label}) { unshift @lines, "$::__DSH_LAST_LINE->{$label}" ; } # Pop current buffer to $::__DSH_LAST_LINE->{$label} if($line) { $::__DSH_LAST_LINE->{$label} = $lines[scalar @lines - 1]; pop @lines; # Skip this loop if array @lines is empty. if (scalar @lines == 0) { next; } } } $line = join "\n", @lines; $line .= "\n"; if ($line =~ /:DSH_TARGET_RC=/) { my $start_offset = index($line, ':DSH_TARGET_RC'); my $end_offset = index($line, ':', $start_offset + 1); my $target_rc_string = substr($line, $start_offset, $end_offset - $start_offset); my ($discard, $target_rc) = split '=', $target_rc_string; $line =~ s/:DSH_TARGET_RC=$target_rc:\n//g; $$target_properties{'target-rc'} = $target_rc; } if ( $::__DSH_LAST_LINE->{$label} =~ /DSH_RC/ && $cust_rc_deal) { my $target_rc = undef; # Get the number in the last line $line =~ /[\D]*([0-9]+)\s*$/ ; $target_rc = $1; $$target_properties{'target-rc'} = $target_rc; # Remove the last line $line =~ s/$target_rc\s*\n$//g; #$line = $line . "## ret=$target_rc"; # Clean up $::__DSH_LAST_LINE->{$label} undef $::__DSH_LAST_LINE->{$label} ; # when '-z' is specified, display return code $::DSH_EXIT_STATUS && ($line .="Remote_command_rc = $target_rc"); } if ($line ne '') { if ($line !~ /^$label\n$/) { $line = $label . $line; } $line =~ s/$/\n/ if $line !~ /\n$/; } $line =~ s/\n/\n$label/g; ($line =~ /\n$label$/) && ($line =~ s/\n$label$/\n/); chomp $line; my @output_files = (); my @output_file_nos = (); foreach my $write_fh (@write_fhs) { my $file_no = fileno($write_fh); if (grep /$file_no/, @output_file_nos) { $line =~ s/$label//g; } my $rsp={}; $rsp->{data}->[0] = $line; xCAT::MsgUtils->message("D", $rsp, $::CALLBACK); #print $write_fh $line; } if (@output_files) { foreach my $output_file (@output_files) { pop @write_fhs; close $output_file || print STDOUT "dsh> Error_file_closed $$target_properties{hostname} $output_file\n"; my $rsp={}; $rsp->{error}->[0] = "Error_file_closed $$target_properties{hostname $output_file}.\n"; xCAT::MsgUtils->message("E", $rsp, $::CALLBACK); ($output_file == $$target_properties{'output-fh'}) && delete $$target_properties{'output-fh'}; ($output_file == $$target_properties{'output-fh'}) && delete $$target_properties{'error-fh'}; } } my $rin = ''; vec($rin, fileno($read_fh), 1) = 1; my $fh_count = select($rin, undef, undef, 0); last if ($fh_count == 0); } } return $eof_reached; } #--------------------------------------------------------------------------- =head3 pipe_handler_buffer Handles and processes dsh output from a given read pipe handle. The output is stored in a buffer supplied by the caller. Arguments: $target_properties - property information of the target related to the pipe handle $read_fh - reference to the read pipe handle $buffer_size - local buffer size to read data from the handle $label - prefix label to use for dsh output $write_buffer - buffer of data that is yet to be written (must wait until \n is read) $output_buffer - buffer where output will be written Returns: 1 if the EOF reached on $read_fh undef otherwise Globals: None Error: None Example: Comments: =cut #--------------------------------------------------------------------------- # NOTE: global environment $::__DSH_LAST_LINE only can be used in DSHCore::pipe_handler and DSHCore::pipe_handler_buffer sub pipe_handler_buffer { my ($class, $target_properties, $read_fh, $buffer_size, $label, $write_buffer, $output_buffer) = @_; my $line; my $eof_reached = undef; my $cust_rc_deal =0; if ($::USER_POST_CMD) { # If user provide post-command to display return code, # the keyword 'DSH_RC' will be searched, # the return code is gotten in another way as shown like below: # ... # <output> # <return_code> # DSH_RC # # The last two lines are needed to be moved out from output $cust_rc_deal = 1; } while ( (sysread($read_fh, $line, $buffer_size) != 0) || ($eof_reached = 1)) { last if ($eof_reached && (!defined($::__DSH_LAST_LINE->{$label}))); if ($line =~ /^\n$/ && scalar(@$write_buffer) == 0) { # need to preserve blank lines in the output. $line = $label . $line; } my @lines = split "\n", $line; if (@$write_buffer) { my $buffered_line = shift @$write_buffer; my $next_line = shift @lines; $next_line = $buffered_line . $next_line; unshift @lines, $next_line; } if ($line !~ /\n$/) { push @$write_buffer, (pop @lines); } if (@lines || $::__DSH_LAST_LINE->{$label}) { if ($cust_rc_deal) { # Dump the last line at the beginning of current buffer if ($::__DSH_LAST_LINE->{$label}) { unshift @lines, "$::__DSH_LAST_LINE->{$label}" ; undef $::__DSH_LAST_LINE->{$label} } if ($line) { # Pop current buffer to $::__DSH_LAST_LINE->{$label} $::__DSH_LAST_LINE->{$label} = $lines[scalar @lines - 1]; pop @lines; # Skip this loop if array @lines is empty. if (scalar @lines == 0) { next; } } } $line = join "\n", @lines; $line .= "\n"; if ($line =~ /:DSH_TARGET_RC=/) { my $start_offset = index($line, ':DSH_TARGET_RC'); my $end_offset = index($line, ':', $start_offset + 1); my $target_rc_string = substr($line, $start_offset, $end_offset - $start_offset); my ($discard, $target_rc) = split '=', $target_rc_string; $line =~ s/:DSH_TARGET_RC=$target_rc:\n//g; $$target_properties{'target-rc'} = $target_rc; } if ( $::__DSH_LAST_LINE->{$label} =~ /DSH_RC/ && $cust_rc_deal) { my $target_rc = undef; # Get the number in the last line $line =~ /[\D]*([0-9]+)\s*$/ ; $target_rc = $1; $$target_properties{'target-rc'} = $target_rc; # Remove the last line $line =~ s/$target_rc\s*\n$//g; #$line = $line . "## ret=$target_rc"; # Clean up $::__DSH_LAST_LINE->{$label} undef $::__DSH_LAST_LINE->{$label} ; # when '-z' is specified, display return code $::DSH_EXIT_STATUS && ($line .="Remote_command_rc = $target_rc"); } if ($line ne '') { if ($line !~ /^$label\n$/) { $line = $label . $line; } $line =~ s/$/\n/ if $line !~ /\n$/; } $line =~ s/\n/\n$label/g; ($line =~ /\n$label$/) && ($line =~ s/\n$label$/\n/); push @$output_buffer, $line; my $rin = ''; vec($rin, fileno($read_fh), 1) = 1; my $fh_count = select($rin, undef, undef, 0); last if ($fh_count == 0); } } return $eof_reached; } #--------------------------------------------------------------------------- =head3 ping_hostnames Executes ping on a given list of hostnames and returns a list of those hostnames that did not respond Arguments: @hostnames - list of hostnames to execute for fping Returns: @no_response - list of hostnames that did not respond undef if fping is not installed Globals: None Error: None Example: @bad_hosts = xCAT::DSHCore->ping_hostnames(@host_list); Comments: =cut #--------------------------------------------------------------------------- sub ping_hostnames { my ($class, @hostnames) = @_; my $ping = (($^O eq 'aix') && '/usr/sbin/ping') || (($^O eq 'linux') && '/bin/ping') || undef; !$ping && return undef; my @no_response = (); foreach my $hostname (@hostnames) { (system("$ping -c 1 -w 1 $hostname > /dev/null 2>&1") != 0) && (push @no_response, $hostname); } return @no_response; } #--------------------------------------------------------------------------- =head3 pping_hostnames Executes pping on a given list of hostnames and returns a list of those hostnames that did not respond Arguments: @hostnames - list of hostnames to execute for fping Returns: @no_response - list of hostnames that did not respond Globals: None Error: None Example: @bad_hosts = xCAT::DSHCore->pping_hostnames(@host_list); Comments: =cut #--------------------------------------------------------------------------- sub pping_hostnames { my ($class, @hostnames) = @_; my $hostname_list = join ",", @hostnames; # read site table, usefping attribute # if set then run pping -f to use fping # this fixes a broken nmap in Redhat 6.2 with ip alias (3512) my $cmd="$::XCATROOT/bin/pping $hostname_list"; # default my @usefping=xCAT::TableUtils->get_site_attribute("usefping"); if ((defined($usefping[0])) && ($usefping[0] eq "1")) { $cmd = "$::XCATROOT/bin/pping -f $hostname_list"; } #my $rsp={}; #$rsp->{data}->[0] = "running command $cmd"; #xCAT::MsgUtils->message("I", $rsp, $::CALLBACK); my @output = xCAT::Utils->runcmd($cmd, -1); if ($::RUNCMD_RC !=0) { my $rsp={}; $rsp->{error}->[0] = "Error from pping"; xCAT::MsgUtils->message("E", $rsp, $::CALLBACK); } $::RUNCMD_RC =0; # reset my @no_response = (); foreach my $line (@output) { my ($hostname, $result) = split ':', $line; my ($token, $status) = split ' ', $result; chomp($token); if ($token ne 'ping') { push @no_response, $hostname; } } return @no_response; } 1;