mirror of
				https://github.com/xcat2/xcat-core.git
				synced 2025-11-03 21:02:34 +00:00 
			
		
		
		
	git-svn-id: https://svn.code.sf.net/p/xcat/code/xcat-core/trunk@478 8638fb3e-16cb-4fca-ae20-7b5d299a9bcd
		
			
				
	
	
		
			1270 lines
		
	
	
		
			40 KiB
		
	
	
	
		
			Perl
		
	
	
	
	
	
			
		
		
	
	
			1270 lines
		
	
	
		
			40 KiB
		
	
	
	
		
			Perl
		
	
	
	
	
	
# IBM(c) 2007 EPL license http://www.eclipse.org/legal/epl-v10.html
 | 
						|
 | 
						|
package xCAT_plugin::lsslp;
 | 
						|
use strict;
 | 
						|
use Getopt::Long;
 | 
						|
use Socket;
 | 
						|
use POSIX "WNOHANG";  
 | 
						|
use Storable qw(freeze thaw);
 | 
						|
use Time::HiRes qw(gettimeofday);
 | 
						|
use IO::Select;
 | 
						|
use XML::Simple;
 | 
						|
use xCAT::PPCdb;
 | 
						|
 | 
						|
 | 
						|
######################################
 | 
						|
# Constants
 | 
						|
#######################################
 | 
						|
use constant {
 | 
						|
    HARDWARE_SERVICE => "service:management-hardware.IBM",
 | 
						|
    SOFTWARE_SERVICE => "service:management-software.IBM",
 | 
						|
    WILDCARD_SERVICE => "service:management-*.IBM:",
 | 
						|
    SERVICE_CEC      => "cec-service-processor",
 | 
						|
    SERVICE_BPA      => "bulk-power-controller",
 | 
						|
    SERVICE_HMC      => "hardware-management-console",
 | 
						|
    SERVICE_IVM      => "integrated-virtualization-manager",
 | 
						|
    SERVICE_MM       => "management-module",
 | 
						|
    SERVICE_RSA      => "remote-supervisor-adapter"
 | 
						|
};
 | 
						|
 | 
						|
#######################################
 | 
						|
# Globals
 | 
						|
#######################################
 | 
						|
my %service_slp = (
 | 
						|
    @{[ SERVICE_CEC ]} => "FSP",
 | 
						|
    @{[ SERVICE_BPA ]} => "BPA",
 | 
						|
    @{[ SERVICE_HMC ]} => "HMC",
 | 
						|
    @{[ SERVICE_IVM ]} => "IVM",
 | 
						|
    @{[ SERVICE_MM  ]} => "MM",
 | 
						|
    @{[ SERVICE_RSA ]} => "RSA" 
 | 
						|
);
 | 
						|
 | 
						|
#######################################
 | 
						|
# Basic SLP attributes
 | 
						|
#######################################
 | 
						|
my @header = (
 | 
						|
    ["device",        "%-8s" ],
 | 
						|
    ["type-model",    "%-12s"],
 | 
						|
    ["serial-number", "%-15s"],
 | 
						|
    ["ip-addresses",  "placeholder"],
 | 
						|
    ["hostname",      "%s"]
 | 
						|
);
 | 
						|
 | 
						|
#######################################
 | 
						|
# Hardware specific SLP attributes
 | 
						|
#######################################
 | 
						|
my %exattr = (
 | 
						|
  @{[ SERVICE_CEC ]} => [
 | 
						|
      "bpc-machinetype-model",
 | 
						|
      "bpc-serial-number",
 | 
						|
      "cage-number"
 | 
						|
    ],
 | 
						|
  @{[ SERVICE_BPA ]} => [
 | 
						|
      "frame-number"
 | 
						|
    ]
 | 
						|
);
 | 
						|
 | 
						|
my $verbose    = 0;
 | 
						|
my %ip_addr    = ();
 | 
						|
my %slp_result = ();
 | 
						|
my %opt        = ();
 | 
						|
 | 
						|
 | 
						|
 | 
						|
##########################################################################
 | 
						|
# Command handler method from tables
 | 
						|
##########################################################################
 | 
						|
sub handled_commands {
 | 
						|
    return {
 | 
						|
        lsslp => "lsslp"
 | 
						|
    };
 | 
						|
}
 | 
						|
 | 
						|
 | 
						|
##########################################################################
 | 
						|
# Invokes the callback with the specified message                    
 | 
						|
##########################################################################
 | 
						|
sub send_msg {
 | 
						|
 | 
						|
    my $request = shift;
 | 
						|
    my %output;
 | 
						|
 | 
						|
    #################################################
 | 
						|
    # Called from child process - send to parent
 | 
						|
    #################################################
 | 
						|
    if ( exists( $request->{pipe} )) {
 | 
						|
        my $out = $request->{pipe};
 | 
						|
 | 
						|
        $output{data} = \@_;
 | 
						|
        print $out freeze( [\%output] );
 | 
						|
        print $out "\nENDOFFREEZE6sK4ci\n";
 | 
						|
    }
 | 
						|
    #################################################
 | 
						|
    # Called from parent - invoke callback directly
 | 
						|
    #################################################
 | 
						|
    elsif ( exists( $request->{callback} )) {
 | 
						|
        my $callback = $request->{callback};
 | 
						|
 | 
						|
        $output{data} = \@_;
 | 
						|
        $callback->( \%output );
 | 
						|
    }
 | 
						|
}
 | 
						|
 | 
						|
 | 
						|
 | 
						|
##########################################################################
 | 
						|
# Parse the command line options and operands
 | 
						|
##########################################################################
 | 
						|
sub parse_args {
 | 
						|
 | 
						|
    my $request  = shift;
 | 
						|
    my @VERSION  = qw( 2.0 );
 | 
						|
    my %services = (
 | 
						|
        HMC => SOFTWARE_SERVICE.":".SERVICE_HMC.":",
 | 
						|
        IVM => SOFTWARE_SERVICE.":".SERVICE_IVM.":",
 | 
						|
        BPA => HARDWARE_SERVICE.":".SERVICE_BPA,
 | 
						|
        FSP => HARDWARE_SERVICE.":".SERVICE_CEC,
 | 
						|
        RSA => HARDWARE_SERVICE.":".SERVICE_RSA.":",
 | 
						|
        MM  => HARDWARE_SERVICE.":".SERVICE_MM.":" 
 | 
						|
    );
 | 
						|
    my $types = join( "|", keys %services );
 | 
						|
    my $args  = $request->{arg};
 | 
						|
 | 
						|
    #############################################
 | 
						|
    # Responds with usage statement                   
 | 
						|
    #############################################
 | 
						|
    local *usage = sub {
 | 
						|
        my @msg = ( $_[0], 
 | 
						|
          "lsslp  -h|--help",
 | 
						|
          "lsslp  -v]--version",
 | 
						|
          "lsslp [-V|--verbose][-b ip[,ip..]][-w][-r|-x|-z][-s $types]",
 | 
						|
          "    -b   IP(s) the command will broadcast out.",
 | 
						|
          "    -h   writes usage information to standard output.",
 | 
						|
          "    -r   raw slp response.",
 | 
						|
          "    -s   service type interested in discovering.",
 | 
						|
          "    -v   command version.",
 | 
						|
          "    -V   verbose output.",
 | 
						|
          "    -w   writes output to xCat database.",
 | 
						|
          "    -x   xml formatted output.",
 | 
						|
          "    -z   stanza formatted output." );
 | 
						|
        send_msg( $request, @msg );
 | 
						|
    };
 | 
						|
    #############################################
 | 
						|
    # No command-line arguments - use defaults
 | 
						|
    #############################################
 | 
						|
    if ( !defined( $args )) {
 | 
						|
        return(0);
 | 
						|
    }
 | 
						|
    #############################################
 | 
						|
    # Checks case in GetOptions, allows opts
 | 
						|
    # to be grouped (e.g. -vx), and terminates
 | 
						|
    # at the first unrecognized option.
 | 
						|
    #############################################
 | 
						|
    @ARGV = @$args;
 | 
						|
    $Getopt::Long::ignorecase = 0;
 | 
						|
    Getopt::Long::Configure( "bundling" );
 | 
						|
 | 
						|
    #############################################
 | 
						|
    # Process command-line flags
 | 
						|
    #############################################
 | 
						|
    if (!GetOptions(\%opt, qw(h|help V|Verbose v|version b=s x z w r s=s ))) {
 | 
						|
        usage();
 | 
						|
        return(1);
 | 
						|
    }
 | 
						|
    #############################################
 | 
						|
    # Option -h for Help
 | 
						|
    #############################################
 | 
						|
    if ( exists( $opt{h} )) {
 | 
						|
        usage();
 | 
						|
        return(1);
 | 
						|
    }
 | 
						|
    #############################################
 | 
						|
    # Option -v for version
 | 
						|
    #############################################
 | 
						|
    if ( exists( $opt{v} )) {
 | 
						|
        send_msg( $request, \@VERSION );
 | 
						|
        return(1);
 | 
						|
    }
 | 
						|
    #############################################
 | 
						|
    # Check for switch "-" with no option
 | 
						|
    #############################################
 | 
						|
    if ( grep(/^-$/, @ARGV )) {
 | 
						|
        usage( "Missing option: -" );
 | 
						|
        return(1);
 | 
						|
    }
 | 
						|
    #############################################
 | 
						|
    # Check for an argument
 | 
						|
    #############################################
 | 
						|
    if ( defined( $ARGV[0] )) {
 | 
						|
        usage( "Invalid Argument: $ARGV[0]" );
 | 
						|
        return(1);
 | 
						|
    }
 | 
						|
    #############################################
 | 
						|
    # Option -V for verbose output
 | 
						|
    #############################################
 | 
						|
    if ( exists( $opt{V} )) {
 | 
						|
        $verbose = 1;
 | 
						|
    }
 | 
						|
    #############################################
 | 
						|
    # Check for mutually-exclusive formatting 
 | 
						|
    #############################################
 | 
						|
    if ( (exists($opt{r}) + exists($opt{x}) + exists($opt{z})) > 1 ) {
 | 
						|
        usage();
 | 
						|
        return(1);
 | 
						|
    }
 | 
						|
    #############################################
 | 
						|
    # Check for unsupported service type 
 | 
						|
    #############################################
 | 
						|
    if ( exists( $opt{s} )) {
 | 
						|
        if ( !exists( $services{$opt{s}} )) {
 | 
						|
            usage( "Invalid service: $opt{s}" );
 | 
						|
            return(1);
 | 
						|
        }
 | 
						|
        $request->{service} = $services{$opt{s}}; 
 | 
						|
    }
 | 
						|
    return(0);
 | 
						|
}
 | 
						|
 | 
						|
 | 
						|
##########################################################################
 | 
						|
# Validate comma-seperated list of IPs
 | 
						|
##########################################################################
 | 
						|
sub validate_ip {
 | 
						|
 | 
						|
    my $request = shift;
 | 
						|
 | 
						|
    ###########################################
 | 
						|
    # Option -b specified - validate entries 
 | 
						|
    ###########################################
 | 
						|
    if ( exists( $opt{b} )) {
 | 
						|
        foreach ( split /,/, $opt{b} ) {
 | 
						|
            my $ip = $_;
 | 
						|
 | 
						|
            ###################################
 | 
						|
            # Length for IPv4 addresses
 | 
						|
            ###################################
 | 
						|
            my (@octets) = /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/;
 | 
						|
            if ( scalar(@octets) != 4 ) {
 | 
						|
                return( [1,"Invalid IP address: $ip"] );
 | 
						|
            }
 | 
						|
            foreach my $octet ( @octets ) {
 | 
						|
                if (( $octet < 0 ) or ( $octet > 255 )) {
 | 
						|
                    return( [1,"Invalid IP address: $ip"] );
 | 
						|
                 }
 | 
						|
            }
 | 
						|
            $ip_addr{$ip} = 1;
 | 
						|
        }
 | 
						|
    }
 | 
						|
    ###########################################
 | 
						|
    # Option -b not specified - determine IPs 
 | 
						|
    ###########################################
 | 
						|
    else {
 | 
						|
        my $result = ifconfig( $request );
 | 
						|
 | 
						|
        ###########################
 | 
						|
        # Command failed 
 | 
						|
        ###########################
 | 
						|
        if ( @$result[0] ) {
 | 
						|
            return( $result );
 | 
						|
        }
 | 
						|
        if ( (keys %ip_addr) == 0 ) {
 | 
						|
            return( [1,"No adapters configured for broadcast"] );
 | 
						|
        }
 | 
						|
    }
 | 
						|
    return( [0] );
 | 
						|
}
 | 
						|
 | 
						|
 | 
						|
##########################################################################
 | 
						|
# Determine adapters available for broadcast
 | 
						|
##########################################################################
 | 
						|
sub ifconfig {
 | 
						|
    
 | 
						|
    my $request = shift;
 | 
						|
    my $cmd     = "ifconfig -a";
 | 
						|
    my $result  = `$cmd`;
 | 
						|
 | 
						|
    ######################################
 | 
						|
    # Error running command
 | 
						|
    ######################################
 | 
						|
    if ( !$result ) {
 | 
						|
        return( [1, "Error running '$cmd': $!"] );
 | 
						|
    }
 | 
						|
 | 
						|
    if ( $verbose ) {
 | 
						|
        trace( $request, $cmd );
 | 
						|
        trace( $request, "Broadcast Interfaces:" );
 | 
						|
    }
 | 
						|
    if (xCAT::Utils->isAIX()) {
 | 
						|
        ##############################################################
 | 
						|
        # Should look like this for AIX:
 | 
						|
        # en0: flags=4e080863,80<UP,BROADCAST,NOTRAILERS,RUNNING,
 | 
						|
        #      SIMPLEX,MULTICAST,GROUPRT,64BIT,PSEG,CHAIN>
 | 
						|
        #      inet 30.0.0.1    netmask 0xffffff00 broadcast 30.0.0.255
 | 
						|
        #      inet 192.168.2.1 netmask 0xffffff00 broadcast 192.168.2.255
 | 
						|
        # en1: ...
 | 
						|
        #
 | 
						|
        ##############################################################
 | 
						|
        my @adapter = split /\w+\d+:\s+flags=/, $result;
 | 
						|
        foreach ( @adapter ) {
 | 
						|
            if ( !($_ =~ /LOOPBACK/ ) and 
 | 
						|
                   $_ =~ /UP(,|>)/ and 
 | 
						|
                   $_ =~ /BROADCAST/ ) {
 | 
						|
 | 
						|
                my @ip = split /\n/;
 | 
						|
                foreach ( @ip ){
 | 
						|
                    if ( $_ =~ /^\s*inet\s+/ and 
 | 
						|
                         $_ =~ /broadcast\s+(\d+\.\d+\.\d+\.\d+)/ ) {
 | 
						|
                        $ip_addr{$1} = 1;
 | 
						|
                    } 
 | 
						|
                }
 | 
						|
            }
 | 
						|
        }
 | 
						|
    }
 | 
						|
    else {
 | 
						|
        ##############################################################
 | 
						|
        # Should look like this for Linux:
 | 
						|
        # eth0 Link encap:Ethernet  HWaddr 00:02:55:7B:06:30
 | 
						|
        #      inet addr:9.114.154.193  Bcast:9.114.154.223
 | 
						|
        #      inet6 addr: fe80::202:55ff:fe7b:630/64 Scope:Link
 | 
						|
        #      UP BROADCAST RUNNING MULTICAST  MTU:1500  Metric:1
 | 
						|
        #      RX packets:1280982 errors:0 dropped:0 overruns:0 frame:0
 | 
						|
        #      TX packets:3535776 errors:0 dropped:0 overruns:0 carrier:0
 | 
						|
        #      collisions:0 txqueuelen:1000
 | 
						|
        #      RX bytes:343489371 (327.5 MiB)  TX bytes:870969610 (830.6 MiB)
 | 
						|
        #      Base address:0x2600 Memory:fbfe0000-fc0000080
 | 
						|
        #
 | 
						|
        # eth1 ...
 | 
						|
        #
 | 
						|
        ##############################################################
 | 
						|
        my @adapter= split /\n{2,}/, $result;
 | 
						|
        foreach ( @adapter ) {
 | 
						|
            if ( !($_ =~ /LOOPBACK / ) and 
 | 
						|
                   $_ =~ /UP / and 
 | 
						|
                   $_ =~ /BROADCAST / ) {
 | 
						|
 | 
						|
                my @ip = split /\n/;
 | 
						|
                foreach ( @ip ) {
 | 
						|
                    if ( $_ =~ /^\s*inet addr:/ and 
 | 
						|
                         $_ =~ /Bcast:(\d+\.\d+\.\d+\.\d+)/ ) {
 | 
						|
                        $ip_addr{$1} = 1;
 | 
						|
                    }
 | 
						|
                }
 | 
						|
            }
 | 
						|
        }
 | 
						|
    }
 | 
						|
    if ( $verbose ) {
 | 
						|
        foreach ( keys %ip_addr ) {
 | 
						|
            trace( $request, "\t\t$_\tUP,BROADCAST" );
 | 
						|
        }
 | 
						|
        if ( (keys %ip_addr) == 0 ) {
 | 
						|
            trace( $request, "$cmd\n$result" );
 | 
						|
        }
 | 
						|
    }
 | 
						|
    return([0]);
 | 
						|
}
 | 
						|
 | 
						|
 | 
						|
##########################################################################
 | 
						|
# Verbose mode (-V)
 | 
						|
##########################################################################
 | 
						|
sub trace {
 | 
						|
 | 
						|
    my $request = shift;
 | 
						|
    my $msg     = shift;
 | 
						|
 | 
						|
    if ( $verbose ) {
 | 
						|
        my ($sec,$min,$hour,$mday,$mon,$yr,$wday,$yday,$dst) = localtime(time);
 | 
						|
        my $msg = sprintf "%02d:%02d:%02d %5d %s", $hour,$min,$sec,$$,$msg;
 | 
						|
        send_msg( $request, $msg );
 | 
						|
    }
 | 
						|
} 
 | 
						|
 | 
						|
 | 
						|
##########################################################################
 | 
						|
# Forks a process to run the slp command (1 per broadcast adapter) 
 | 
						|
##########################################################################
 | 
						|
sub fork_cmd {
 | 
						|
 | 
						|
    my $slpcmd   = shift;
 | 
						|
    my $request  = shift;
 | 
						|
    my $ip       = shift;
 | 
						|
    my $services = shift;
 | 
						|
 | 
						|
    #######################################
 | 
						|
    # Pipe childs output back to parent
 | 
						|
    #######################################
 | 
						|
    my $parent;
 | 
						|
    my $child;
 | 
						|
    pipe $parent, $child;
 | 
						|
    my $pid = fork;
 | 
						|
 | 
						|
    if ( !defined($pid) ) {
 | 
						|
        ###################################
 | 
						|
        # Fork error 
 | 
						|
        ###################################
 | 
						|
        send_msg( $request, "Fork error: $!" );
 | 
						|
        return undef;
 | 
						|
    }
 | 
						|
    elsif ( $pid == 0 ) {
 | 
						|
        ###################################
 | 
						|
        # Child process
 | 
						|
        ###################################
 | 
						|
        close( $parent );
 | 
						|
        $request->{pipe} = $child;
 | 
						|
 | 
						|
        invoke_cmd( $slpcmd, $ip, $services, $request );
 | 
						|
        exit(0);
 | 
						|
    }
 | 
						|
    else {
 | 
						|
        ###################################
 | 
						|
        # Parent process
 | 
						|
        ###################################
 | 
						|
        close( $child );
 | 
						|
        return( $parent );
 | 
						|
    }
 | 
						|
    return(0);
 | 
						|
}
 | 
						|
 | 
						|
 | 
						|
 
 | 
						|
##########################################################################
 | 
						|
# Run the SLP command, process the response, and send to parent  
 | 
						|
##########################################################################
 | 
						|
sub invoke_cmd {
 | 
						|
 | 
						|
    my $slpcmd   = shift;
 | 
						|
    my $ip       = shift;
 | 
						|
    my $services = shift;
 | 
						|
    my $request  = shift;
 | 
						|
    my $converge = 1;
 | 
						|
    my $tries    = 5;
 | 
						|
    my $values;
 | 
						|
 | 
						|
    my $result = runslp( $slpcmd, $ip, $services, $request, $tries, $converge );
 | 
						|
    if ( !defined( $result )) {
 | 
						|
        return;
 | 
						|
    }
 | 
						|
    ########################################
 | 
						|
    # May have to send additional unicasts  
 | 
						|
    ########################################
 | 
						|
    my $unicast = shift(@$result);
 | 
						|
    $values  = @$result[0];
 | 
						|
 | 
						|
    foreach my $url ( keys %$unicast ) {
 | 
						|
        my ($service,$addr) = split "://", $url;
 | 
						|
        my $sockaddr = inet_aton( $addr );
 | 
						|
 | 
						|
        ####################################
 | 
						|
        # Make sure can resolve if hostname  
 | 
						|
        ####################################
 | 
						|
        if ( !defined( $sockaddr )) {
 | 
						|
            if ( $verbose ) {
 | 
						|
                trace( $request, "Cannot convert '$addr' to dot-notation" );           
 | 
						|
            }
 | 
						|
            next;
 | 
						|
        }
 | 
						|
        $addr = inet_ntoa( $sockaddr );
 | 
						|
        my $result = runslp( $slpcmd, $addr, [$service], $request, 1 );
 | 
						|
 | 
						|
        if ( defined( $result )) {
 | 
						|
            shift(@$result);
 | 
						|
            my $data = @$result[0];
 | 
						|
            $values->{"URL: $url\n@$data\n"} = 1;
 | 
						|
        }
 | 
						|
    }
 | 
						|
    ########################################
 | 
						|
    # Pass result array back to parent 
 | 
						|
    ########################################
 | 
						|
    my @results = ("FORMATDATA6sK4ci", $values );
 | 
						|
    my $out = $request->{pipe};
 | 
						|
 | 
						|
    print $out freeze( \@results );
 | 
						|
    print $out "\nENDOFFREEZE6sK4ci\n";
 | 
						|
}
 | 
						|
 | 
						|
 | 
						|
 | 
						|
##########################################################################
 | 
						|
# Run the SLP command, process the response, and send to parent  
 | 
						|
##########################################################################
 | 
						|
sub runslp {
 | 
						|
 | 
						|
    my $slpcmd   = shift;
 | 
						|
    my $ip       = shift;
 | 
						|
    my $services = shift;
 | 
						|
    my $request  = shift;
 | 
						|
    my $max      = shift;
 | 
						|
    my $converge = shift;
 | 
						|
    my %result   = ();
 | 
						|
    my %unicast  = ();
 | 
						|
 | 
						|
    foreach my $type ( @$services ) {
 | 
						|
        my $try = 0;
 | 
						|
        my $cmd = "$slpcmd --address=$ip --type=$type";
 | 
						|
 | 
						|
        ###############################################
 | 
						|
        # If --converge is specified, slp_query will
 | 
						|
        # broadcast a service-request to the broadcast
 | 
						|
        # address specified by --address. If not
 | 
						|
        # specified, slp_query will unicast an attribute
 | 
						|
        # request to the URL specified by --type to  
 | 
						|
        # the remote target specified by --address.
 | 
						|
        ###############################################
 | 
						|
        if ( defined($converge) ) {
 | 
						|
            $cmd .= " --converge=$converge";
 | 
						|
        }
 | 
						|
        while ( $try++ < $max ) {
 | 
						|
            if ( $verbose ) {
 | 
						|
                trace( $request, $cmd );
 | 
						|
                trace( $request, "Attempt $try of $max\t( $ip\t$type )" );
 | 
						|
            }
 | 
						|
            ###########################################
 | 
						|
            # Serialize broadcasts out each adapter 
 | 
						|
            ###########################################
 | 
						|
            if ( !open( OUTPUT, "$cmd 2>&1 |")) {
 | 
						|
                send_msg( $request, "Fork error: $!" );
 | 
						|
                return undef;
 | 
						|
            }
 | 
						|
            ###############################
 | 
						|
            # Get command output 
 | 
						|
            ###############################
 | 
						|
            my $rsp;
 | 
						|
            while ( <OUTPUT> ) {
 | 
						|
                $rsp.=$_;
 | 
						|
            }
 | 
						|
            close OUTPUT;
 | 
						|
 | 
						|
            ###############################
 | 
						|
            # No replies
 | 
						|
            ###############################
 | 
						|
            if ( !$rsp ) {
 | 
						|
               if ( $verbose ) {
 | 
						|
                    trace( $request, ">>>>>> No Response" );
 | 
						|
                }
 | 
						|
                next;
 | 
						|
            }
 | 
						|
            ###########################################
 | 
						|
            # split into array of individual responses:
 | 
						|
            # 0
 | 
						|
            # 1
 | 
						|
            # 75
 | 
						|
            # URL: service:management-software.IBM...
 | 
						|
            # ATTR: (type=hardware-management-cons...
 | 
						|
            # (serial-number=KPHHK24),(name=c76v2h...
 | 
						|
            # 1ab1dd89ca8e0763e),(ip-address=192.1...
 | 
						|
            # 0CR3*KPHHK24),(web-management-interf...
 | 
						|
            # 2.ppd.pok.ibm.com:8443),(cimom-port=...
 | 
						|
            #
 | 
						|
            # 0
 | 
						|
            # 1
 | 
						|
            # 69
 | 
						|
            # URL: 
 | 
						|
            # ATTR:
 | 
						|
            # ...
 | 
						|
            #
 | 
						|
            # For IVM, running AIX 53J (6/07) release,
 | 
						|
            # there is an AIX SLP bug where IVM will 
 | 
						|
            # respond to SLP broadcasts with its URL
 | 
						|
            # only and not its attributes. An SLP
 | 
						|
            # unicast to the URL address is necessary  
 | 
						|
            # to acquire the attributes. This was fixed 
 | 
						|
            # in AIX 53L (11/07).
 | 
						|
            #
 | 
						|
            ###########################################
 | 
						|
 | 
						|
            foreach ( split /\n{2,}/,$rsp ) {
 | 
						|
                if ( $_ =~ s/(\d+)\n(\d+)\n(\d+)\n// ) {
 | 
						|
                    if ( $verbose ) {
 | 
						|
                        trace( $request, "SrvRqst Response ($1)($2)($3)" );
 | 
						|
                        trace( $request, "$_\n" );
 | 
						|
                    }
 | 
						|
                    ###################################
 | 
						|
                    # Response has "ATTR" field 
 | 
						|
                    ###################################
 | 
						|
                    if ( /ATTR: /  ) {
 | 
						|
                        $result{$_} = 1;
 | 
						|
                    }
 | 
						|
                    ###################################
 | 
						|
                    # No "ATTR" - have to unicast
 | 
						|
                    ###################################
 | 
						|
                    elsif ( /.*URL: (.*)/ ) {
 | 
						|
                        $unicast{$1} = $1;
 | 
						|
                    }
 | 
						|
                } elsif ( $verbose ) {
 | 
						|
                    trace( $request, "DISCARDING: $_" );
 | 
						|
                }
 | 
						|
            }
 | 
						|
        }
 | 
						|
    }
 | 
						|
    return( [\%unicast,\%result] );
 | 
						|
}
 | 
						|
 | 
						|
 | 
						|
 | 
						|
##########################################################################
 | 
						|
# Formats slp responses
 | 
						|
##########################################################################
 | 
						|
sub format_output {
 | 
						|
 | 
						|
    my $request = shift;
 | 
						|
    my $values  = shift;
 | 
						|
    my $length  = 0;
 | 
						|
    my $result;
 | 
						|
 | 
						|
    ###########################################
 | 
						|
    # Parse responses and add to hash
 | 
						|
    ###########################################
 | 
						|
    my $outhash = parse_responses( $request, $values, \$length );
 | 
						|
 | 
						|
    ###########################################
 | 
						|
    # No responses 
 | 
						|
    ###########################################
 | 
						|
    if (( keys %$outhash ) == 0 ){
 | 
						|
        send_msg( $request, "No responses" );
 | 
						|
        return;   
 | 
						|
    }
 | 
						|
    ###########################################
 | 
						|
    # -w flag for write to xCat database
 | 
						|
    ###########################################
 | 
						|
    if ( exists( $opt{w} )) {
 | 
						|
        xCATdB( $outhash );
 | 
						|
    }
 | 
						|
    ###########################################
 | 
						|
    # -r flag for raw response format
 | 
						|
    ###########################################
 | 
						|
    if ( exists( $opt{r} )) {
 | 
						|
        foreach ( keys %$outhash ) {
 | 
						|
            $result .= "@{ $outhash->{$_}}[5]\n";
 | 
						|
        }
 | 
						|
        send_msg( $request, $result );
 | 
						|
        return;
 | 
						|
    }
 | 
						|
    ###########################################
 | 
						|
    # -x flag for xml format
 | 
						|
    ###########################################
 | 
						|
    if ( exists( $opt{x} )) {
 | 
						|
        send_msg( $request, format_xml( $outhash ));
 | 
						|
        return;
 | 
						|
    }
 | 
						|
    ###########################################
 | 
						|
    # -z flag for stanza format
 | 
						|
    ###########################################
 | 
						|
    if ( exists( $opt{z} )) {
 | 
						|
        send_msg( $request, format_stanza( $outhash ));
 | 
						|
        return;
 | 
						|
    }
 | 
						|
 | 
						|
    ###########################################
 | 
						|
    # Get longest IP for formatting purposes
 | 
						|
    ###########################################
 | 
						|
    my $format = sprintf "%%-%ds", ( $length + 2 );
 | 
						|
    $header[3][1] = $format;
 | 
						|
 | 
						|
    ###########################################
 | 
						|
    # Display header
 | 
						|
    ###########################################
 | 
						|
    foreach ( @header ) {
 | 
						|
        $result .= sprintf @$_[1], @$_[0];
 | 
						|
    }
 | 
						|
    $result .= "\n";
 | 
						|
 | 
						|
    ###########################################
 | 
						|
    # Display response attributes
 | 
						|
    ###########################################
 | 
						|
    foreach ( sort keys %$outhash ) {
 | 
						|
        my $data = $outhash->{$_};
 | 
						|
        my $i = 0;
 | 
						|
 | 
						|
        foreach ( @header ) {
 | 
						|
            $result .= sprintf @$_[1], @$data[$i++];
 | 
						|
        }
 | 
						|
        $result .= "\n";
 | 
						|
    }
 | 
						|
    send_msg( $request, $result );
 | 
						|
}
 | 
						|
 | 
						|
 | 
						|
##########################################################################
 | 
						|
# Get hostname from SLP URL response
 | 
						|
##########################################################################
 | 
						|
sub gethost_from_url {
 | 
						|
 | 
						|
    my $request = shift;
 | 
						|
    my $url     = shift;
 | 
						|
 | 
						|
    ######################################################################
 | 
						|
    # Extract the IP from the URL. Generally, the URL
 | 
						|
    # should be in the following format (the ":0" port number
 | 
						|
    # may or may not be present):
 | 
						|
    # service:management-hardware.IBM:management-module://9.114.113.78:0
 | 
						|
    # service:management-software.IBM:integrated-virtualization-manager://zd21p1.rchland.ibm.com
 | 
						|
    ######################################################################
 | 
						|
    if (($url =~ /service:.*:\/\/(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}).*/ )) {
 | 
						|
        my $packed = inet_aton( $1 );
 | 
						|
        if ( length( $packed ) != 4 ) {
 | 
						|
            if ( $verbose ) {
 | 
						|
                trace( $request, "Invalid IP address in URL: $1" );
 | 
						|
            }
 | 
						|
            return undef;
 | 
						|
        }
 | 
						|
        #######################################
 | 
						|
        # Convert IP to hostname
 | 
						|
        #######################################
 | 
						|
        my $host = gethostbyaddr( $packed, AF_INET );
 | 
						|
        if ( !$host or $! ) {
 | 
						|
            return( $1 );
 | 
						|
        }
 | 
						|
        #######################################
 | 
						|
        # Convert hostname to short-hostname
 | 
						|
        #######################################
 | 
						|
        if ( $host =~ /([^\.]+)\./ ) {
 | 
						|
            $host = $1;
 | 
						|
        }
 | 
						|
        return( $host );
 | 
						|
    }
 | 
						|
    ###########################################
 | 
						|
    #  Otherwise, URL is not in IP format
 | 
						|
    ###########################################
 | 
						|
    if ( !($url =~ /service:.*:\/\/(.*)/  )) {
 | 
						|
        if ( $verbose ) {
 | 
						|
            trace( $request, "Invalid URL: $_[0]" );
 | 
						|
        }
 | 
						|
        return undef;
 | 
						|
    }
 | 
						|
    return( $1 );
 | 
						|
 | 
						|
}
 | 
						|
 | 
						|
 | 
						|
##########################################################################
 | 
						|
# Example slp_query command "service-request" output. The following 
 | 
						|
# attributes can be returned in any order within an SLP response.
 | 
						|
# Note: The leading 3 numbers preceeding the URL: and ATTR: fields
 | 
						|
# represent: 
 | 
						|
#        error code, 
 | 
						|
#        URL count, 
 | 
						|
#        URL length, respectively.
 | 
						|
# 0
 | 
						|
# 1
 | 
						|
# 75
 | 
						|
# URL: service:management-software.IBM:hardware-management-console://192.168.1.110
 | 
						|
# ATTR: (type=hardware-management-console),(level=3),(machinetype-model=7310CR3),
 | 
						|
# (serial-number=KPHHK24),(name=c76v2hmc02.ppd.pok.ibm.com),(uuid=de335adf051eb21
 | 
						|
# 1ab1dd89ca8e0763e),(ip-address=192.168.1.110,9.114.47.154),(web-url=),(mtms=731
 | 
						|
# 0CR3*KPHHK24),(web-management-interface=true),(secure-web-url=https://c76v2hmc0
 | 
						|
# 2.ppd.pok.ibm.com:8443),(cimom-port=),(secure-cimom-port=5989)
 | 
						|
#
 | 
						|
# 0
 | 
						|
# 1
 | 
						|
# 69
 | 
						|
# ...
 | 
						|
#
 | 
						|
# Example slp_query command "attribute-request" output. The following 
 | 
						|
# attributes can be returned in any order within an SLP response.
 | 
						|
# Note: The leading 3 numbers preceeding the URL: and ATTR: fields
 | 
						|
# represent:
 | 
						|
#        error code,
 | 
						|
#        0, (hardcoded)
 | 
						|
#        ATTR  length, respectively.
 | 
						|
# 0
 | 
						|
# 0
 | 
						|
# 354
 | 
						|
# ATTR: (type=integrated-virtualization-manager),(level=3),(machinetype-model=911051A),
 | 
						|
# (serial-number=1075ECF),(name=p705ivm.clusters.com),(ip-address=192.168.1.103),
 | 
						|
# (web-url=http://p705ivm.clusters.com/),(mtms=911051A*1075ECF),(web-management-
 | 
						|
# interface=TRUE),(secure-web-url=https://p705ivm.clusters.com/),(cimom-port=5988),
 | 
						|
# (secure-cimom-port=5989),(lparid=1)
 | 
						|
#
 | 
						|
#########################################################################
 | 
						|
sub parse_responses {
 | 
						|
 | 
						|
    my $request = shift;
 | 
						|
    my $values  = shift;
 | 
						|
    my $length  = shift;
 | 
						|
 | 
						|
    my %outhash = ();
 | 
						|
    my @attr    = (
 | 
						|
       "type",
 | 
						|
       "machinetype-model",
 | 
						|
       "serial-number",
 | 
						|
       "ip-address" );
 | 
						|
 | 
						|
    foreach my $rsp ( @$values ) {
 | 
						|
        ###########################################
 | 
						|
        # Get service-type from response 
 | 
						|
        ###########################################
 | 
						|
        my @result = ();
 | 
						|
        my $host;
 | 
						|
 | 
						|
        ###########################################
 | 
						|
        # service-type attribute not found 
 | 
						|
        ###########################################
 | 
						|
        if ( $rsp !~ /\(type=([\w\-\.,]+)\)/ ) {
 | 
						|
            if ( $verbose ) {
 | 
						|
                trace( $request, "(type) attribute not found: $rsp" );
 | 
						|
            }
 | 
						|
            next;
 | 
						|
        }
 | 
						|
        ###########################################
 | 
						|
        # Valid service-type attribute 
 | 
						|
        ###########################################
 | 
						|
        my $type = $1;
 | 
						|
 | 
						|
        ###########################################
 | 
						|
        # Unsupported service-type 
 | 
						|
        ###########################################
 | 
						|
        if ( !exists($service_slp{$type} )) {
 | 
						|
            if ( $verbose ) {
 | 
						|
                trace( $request, "Discarding unsupported type: $type" );
 | 
						|
            }
 | 
						|
            next;
 | 
						|
        }
 | 
						|
        ###########################################
 | 
						|
        # RSA/MM - slightly different attributes
 | 
						|
        ###########################################
 | 
						|
        if (( $type eq SERVICE_RSA ) or ( $type eq SERVICE_MM )) {
 | 
						|
            $attr[1] = "enclosure-machinetype-model";
 | 
						|
            $attr[2] = "enclosure-serial-number";
 | 
						|
        }
 | 
						|
 | 
						|
        ###########################################
 | 
						|
        # Extract the attributes
 | 
						|
        ###########################################
 | 
						|
        foreach ( @attr ) {
 | 
						|
            $rsp =~ /\($_=([\w\-\.,]+)\)/; 
 | 
						|
            push @result, $1;
 | 
						|
        }
 | 
						|
        ###########################################
 | 
						|
        # Use the IP/Hostname contained in the URL
 | 
						|
        # not the (ip-address) field since for FSPs
 | 
						|
        # it may contain default IPs which could  
 | 
						|
        # all be the same. If the response contains 
 | 
						|
        # a "name" attribute as the HMC does, use
 | 
						|
        # that instead of the URL.
 | 
						|
        #
 | 
						|
        ###########################################
 | 
						|
        if (( $type eq SERVICE_HMC ) or ( $type eq SERVICE_IVM )) {
 | 
						|
            if ( $rsp =~ /\(name=([\w\-\.,]+)\)/ ) {
 | 
						|
                $host = $1;
 | 
						|
            }
 | 
						|
        }
 | 
						|
        ###########################################
 | 
						|
        # Seperate ATTR and URL portions:
 | 
						|
        # 0
 | 
						|
        # 1
 | 
						|
        # 75
 | 
						|
        # URL: service:management-software.IBM...
 | 
						|
        # ATTR: (type=hardware-management-cons...
 | 
						|
        # (serial-number=KPHHK24),(name=c76v2h...
 | 
						|
        # 1ab1dd89ca8e0763e),(ip-address=192.1...
 | 
						|
        # 0CR3*KPHHK24),(web-management-interf...
 | 
						|
        # 2.ppd.pok.ibm.com:8443),(cimom-port=...
 | 
						|
        #
 | 
						|
        ###########################################
 | 
						|
        $rsp =~ /.*URL: (.*)\nATTR: +(.*)/;
 | 
						|
 | 
						|
        if ( !defined($host) ) {
 | 
						|
            $host = gethost_from_url( $request, $1 );
 | 
						|
            if ( !defined( $host )) {
 | 
						|
                next;
 | 
						|
            }
 | 
						|
        }
 | 
						|
        push @result, $host;
 | 
						|
        push @result, $2;
 | 
						|
 | 
						|
        ###########################################
 | 
						|
        # Strip commas from IP list
 | 
						|
        ###########################################
 | 
						|
        $result[3] =~ s/,/ /g;
 | 
						|
        my $ip     = $result[3];
 | 
						|
 | 
						|
        ###########################################
 | 
						|
        # Process any extra attributes
 | 
						|
        ###########################################
 | 
						|
        foreach ( @{$exattr{$type}} ) {
 | 
						|
             push @result, ($rsp =~ /\($_=([\w\-\.,]+)\)/) ? $1 : "0";
 | 
						|
        }
 | 
						|
        ###########################################
 | 
						|
        # Save longest IP for formatting purposes
 | 
						|
        ###########################################
 | 
						|
        if ( length( $ip ) > $$length ) {
 | 
						|
            $$length = length( $ip );
 | 
						|
        }
 | 
						|
        $result[0] = $service_slp{$type};
 | 
						|
        $outhash{$host} = \@result;
 | 
						|
    }
 | 
						|
    return( \%outhash );
 | 
						|
}
 | 
						|
 | 
						|
 | 
						|
 | 
						|
##########################################################################
 | 
						|
# Write result to xCat database 
 | 
						|
##########################################################################
 | 
						|
sub xCATdB {
 | 
						|
 | 
						|
    my $outhash = shift;
 | 
						|
    my %keyhash = ();
 | 
						|
    my %updates = ();
 | 
						|
  
 | 
						|
    foreach ( keys %$outhash ) {
 | 
						|
        my $data = $outhash->{$_};
 | 
						|
        my $type = @$data[0];
 | 
						|
 | 
						|
        if ( $type =~ /^BPA$/ ) {
 | 
						|
            my $model  = @$data[1];
 | 
						|
            my $serial = @$data[2];
 | 
						|
            my $ips    = @$data[3];
 | 
						|
            my $name   = @$data[4];
 | 
						|
            my $id     = @$data[6];
 | 
						|
 | 
						|
            ####################################
 | 
						|
            # N/A Values
 | 
						|
            ####################################
 | 
						|
            my $prof  = "";
 | 
						|
            my $frame = "";
 | 
						|
 | 
						|
            my $values = join( ",",
 | 
						|
               lc($type),$name,$id,$model,$serial,$name,$prof,$frame,$ips );
 | 
						|
            xCAT::PPCdb::add_ppc( $type, [$values] );
 | 
						|
        }
 | 
						|
        elsif ( $type =~ /^HMC|IVM$/ ) {
 | 
						|
            my $model  = @$data[1];
 | 
						|
            my $serial = @$data[2];
 | 
						|
            my $ips    = @$data[3];
 | 
						|
            my $name   = @$data[4];
 | 
						|
 | 
						|
            ########################################
 | 
						|
            # N/A Values
 | 
						|
            ########################################
 | 
						|
            my $uid = "";
 | 
						|
            my $pw  = "";
 | 
						|
 | 
						|
            xCAT::PPCdb::add_ppch( $type, $uid, $pw, $name );
 | 
						|
        }
 | 
						|
        elsif ( $type =~ /^FSP$/ ) {
 | 
						|
            ########################################
 | 
						|
            # BPA frame this CEC is in 
 | 
						|
            ########################################
 | 
						|
            my $frame      = "";
 | 
						|
            my $model      = @$data[1];
 | 
						|
            my $serial     = @$data[2];
 | 
						|
            my $ips        = @$data[3];
 | 
						|
            my $name       = @$data[4];
 | 
						|
            my $bpc_model  = @$data[6];
 | 
						|
            my $bpc_serial = @$data[7];
 | 
						|
            my $cageid     = @$data[8];
 | 
						|
 | 
						|
            ########################################
 | 
						|
            # May be no Frame with this FSP
 | 
						|
            ########################################
 | 
						|
            if (( $bpc_model ne "0" ) and ( $bpc_serial ne "0" )) {
 | 
						|
                $frame = "$bpc_model*$bpc_serial";
 | 
						|
            }
 | 
						|
            ########################################
 | 
						|
            # "Factory-default" CEC name format: 
 | 
						|
            # Server-<type>-<model>-<serialnumber>
 | 
						|
            # ie. Server-9117-MMA-SN10F6F3D
 | 
						|
            #
 | 
						|
            # If the IP address cannot be converted
 | 
						|
            # to a shirt-hostname use the following:
 | 
						|
            #
 | 
						|
            # Note that this may not be the name
 | 
						|
            # that the user (or the HMC) knows this 
 | 
						|
            # CEC as. This is the "factory-default"
 | 
						|
            # CEC name. SLP does not return the
 | 
						|
            # user- or system-defined CEC name and
 | 
						|
            # FSPs are assigned dynamic hostnames
 | 
						|
            # by DHCP so there is no point in using
 | 
						|
            # the short-hostname as the name.
 | 
						|
            ########################################
 | 
						|
            if ( $name =~ /^[\d]{1}/ ) {
 | 
						|
                $name = "Server-$model-$serial";
 | 
						|
            }
 | 
						|
            ########################################
 | 
						|
            # N/A Values
 | 
						|
            ########################################
 | 
						|
            my $prof   = "";
 | 
						|
            my $server = "";
 | 
						|
 | 
						|
            my $values = join( ",",
 | 
						|
               $type,$name,$cageid,$model,$serial,$server,$prof,$frame,$ips );
 | 
						|
            xCAT::PPCdb::add_ppc( "fsp", [$values] );
 | 
						|
        }
 | 
						|
        elsif ( $type =~ /^RSA|MM$/ ) {
 | 
						|
            xCAT::PPCdb::add_systemX( $type, $data );
 | 
						|
        }
 | 
						|
    }
 | 
						|
}
 | 
						|
 | 
						|
 | 
						|
##########################################################################
 | 
						|
# Stanza formatting 
 | 
						|
##########################################################################
 | 
						|
sub format_stanza {
 | 
						|
 | 
						|
    my $outhash = shift;
 | 
						|
    my $text;
 | 
						|
 | 
						|
    #####################################
 | 
						|
    # Remove hostname from header 
 | 
						|
    #####################################
 | 
						|
    pop @header;
 | 
						|
 | 
						|
    #####################################
 | 
						|
    # Write attributes 
 | 
						|
    #####################################
 | 
						|
    foreach ( keys %$outhash ) {
 | 
						|
        my @data = @{ $outhash->{$_}};
 | 
						|
        my $i = 0;
 | 
						|
 | 
						|
        #################################
 | 
						|
        # Node attributes
 | 
						|
        #################################
 | 
						|
        $text.= "$data[4]:\n    objtype=node\n";
 | 
						|
 | 
						|
        #################################
 | 
						|
        # Display attributes 
 | 
						|
        #################################
 | 
						|
        foreach ( @header ) {
 | 
						|
            $text.= "    @$_[0]=$data[$i++]\n";
 | 
						|
        }
 | 
						|
        $text.= "\n";
 | 
						|
    }
 | 
						|
    return( $text );
 | 
						|
 | 
						|
}
 | 
						|
 | 
						|
 | 
						|
 | 
						|
##########################################################################
 | 
						|
# XML formatting
 | 
						|
##########################################################################
 | 
						|
sub format_xml {
 | 
						|
 
 | 
						|
    my $outhash = shift; 
 | 
						|
    my $xml;
 | 
						|
 | 
						|
    #####################################
 | 
						|
    # Create XML formatted attributes 
 | 
						|
    #####################################
 | 
						|
    foreach ( keys %$outhash ) {
 | 
						|
        my @data = @{ $outhash->{$_}};
 | 
						|
        my $i = 0;
 | 
						|
 | 
						|
        #################################
 | 
						|
        # Initialize hash reference
 | 
						|
        #################################
 | 
						|
        my $href = {
 | 
						|
            Node => { }
 | 
						|
        };
 | 
						|
        #################################
 | 
						|
        # Add each attribute 
 | 
						|
        #################################
 | 
						|
        foreach ( @header ) {
 | 
						|
            $href->{"Node"}->{@$_[0]} = $data[$i++];
 | 
						|
        }
 | 
						|
        #################################
 | 
						|
        # XML encoding 
 | 
						|
        #################################
 | 
						|
        $xml.= XMLout($href,
 | 
						|
                     NoAttr   => 1,
 | 
						|
                     KeyAttr  => [],
 | 
						|
                     RootName => undef );
 | 
						|
    }
 | 
						|
    return( $xml );
 | 
						|
}
 | 
						|
 | 
						|
 | 
						|
##########################################################################
 | 
						|
# OpenSLP is running on:
 | 
						|
#     p6 FSP
 | 
						|
#     p6 BPA
 | 
						|
# IBM SLP is running on:
 | 
						|
#     p5 FSP
 | 
						|
#     p5 BPA
 | 
						|
#     HMC
 | 
						|
#     MM
 | 
						|
#     RSA
 | 
						|
# AIX SLP
 | 
						|
#     IVM
 | 
						|
#
 | 
						|
# OpenSLP v. IBM SLP
 | 
						|
# (1) OpenSLP does not support wildcards (i.e. service:management-*.IBM: )
 | 
						|
# (2) OpenSLP does not support ':' at the end of services
 | 
						|
#     (i.e. service:management-hardware.IBM:). Unfortunately, IBM SLP
 | 
						|
#     requires it.
 | 
						|
#
 | 
						|
# Given the above, to collect all the above service types, it is 
 | 
						|
# necesary to broadcast:
 | 
						|
# (1) service:management-*.IBM: for all IBM SLP hardware
 | 
						|
# (2) service:management-hardware.IBM for OpenSLP hardware (p6 FSP/BPA)
 | 
						|
#      (IBM SLP hardware will not respond since there is no trailing ":")
 | 
						|
# (3) IBM SLP does not require a trailing ':' with "cec-service-processor"
 | 
						|
#     concrete type only.
 | 
						|
#
 | 
						|
##########################################################################
 | 
						|
sub slp_query {
 | 
						|
 | 
						|
    my $request  = shift;
 | 
						|
    my $callback = $request->{callback};
 | 
						|
    my $slpcmd   = "/usr/sbin/slp_query";
 | 
						|
    my $start;
 | 
						|
    my @services = (
 | 
						|
        HARDWARE_SERVICE,
 | 
						|
        WILDCARD_SERVICE
 | 
						|
    );
 | 
						|
 | 
						|
    if ( !-x $slpcmd ) {
 | 
						|
        send_msg( $request, "Command not installed: $slpcmd" );
 | 
						|
        return(1);
 | 
						|
    }
 | 
						|
    #############################################
 | 
						|
    # Query specific service; otherwise, 
 | 
						|
    # query all hardware/software services
 | 
						|
    #############################################
 | 
						|
    if ( exists( $opt{s} )) {
 | 
						|
        @services = $request->{service};
 | 
						|
    }
 | 
						|
 | 
						|
    if ( $verbose ) {
 | 
						|
        #########################################
 | 
						|
        # Write header for trace
 | 
						|
        #########################################
 | 
						|
        my $tm  = localtime( time );
 | 
						|
        my $msg = "\n--------  $tm\nTime     PID";
 | 
						|
        trace( $request, $msg );
 | 
						|
    }
 | 
						|
    #############################################
 | 
						|
    # Get/validate broadcast IPs
 | 
						|
    #############################################
 | 
						|
    my $result = validate_ip( $request );
 | 
						|
    my $Rc = shift(@$result);
 | 
						|
 | 
						|
    if ( $Rc ) {
 | 
						|
        send_msg( $request, @$result[0] );
 | 
						|
        return(1);
 | 
						|
    }
 | 
						|
    if ( $verbose ) {
 | 
						|
        $start = Time::HiRes::gettimeofday(); 
 | 
						|
    }
 | 
						|
    #############################################
 | 
						|
    # Fork one process per broadcast adapter 
 | 
						|
    #############################################
 | 
						|
    my $children = 0;
 | 
						|
    $SIG{CHLD} = sub { while (waitpid(-1, WNOHANG) > 0) { $children--; } };
 | 
						|
    my $fds = new IO::Select;
 | 
						|
    
 | 
						|
    foreach ( keys %ip_addr ) {
 | 
						|
        my $pipe = fork_cmd( $slpcmd, $request, $_, \@services );
 | 
						|
        if ( $pipe ) {
 | 
						|
            $fds->add( $pipe );
 | 
						|
            $children++;
 | 
						|
        }
 | 
						|
    }
 | 
						|
    #############################################
 | 
						|
    # Process slp responses from children 
 | 
						|
    #############################################
 | 
						|
    while ( $children > 0 ) {
 | 
						|
        child_response( $callback, $fds );
 | 
						|
    }
 | 
						|
    while (child_response($callback,$fds)) {}
 | 
						|
 | 
						|
    if ( $verbose ) {
 | 
						|
        my $elapsed = Time::HiRes::gettimeofday() - $start;
 | 
						|
        my $msg = sprintf( "Total Elapsed Time: %.3f sec\n", $elapsed );
 | 
						|
        trace( $request, $msg ); 
 | 
						|
    }
 | 
						|
    #############################################
 | 
						|
    # Combined responses from all children 
 | 
						|
    #############################################
 | 
						|
    my @all_results = keys %slp_result;
 | 
						|
    format_output( $request, \@all_results );
 | 
						|
    return(0);
 | 
						|
}
 | 
						|
 | 
						|
 | 
						|
##########################################################################
 | 
						|
# Collect output from the slp_query processes 
 | 
						|
##########################################################################
 | 
						|
sub child_response {
 | 
						|
 | 
						|
    my $callback = shift; 
 | 
						|
    my $fds = shift;
 | 
						|
    my @ready_fds = $fds->can_read(1);
 | 
						|
 | 
						|
    foreach my $rfh (@ready_fds) {
 | 
						|
        my $data;
 | 
						|
 | 
						|
        #################################
 | 
						|
        # Read from child process
 | 
						|
        #################################
 | 
						|
        if ( $data = <$rfh> ) {
 | 
						|
            while ($data !~ /ENDOFFREEZE6sK4ci/) {
 | 
						|
                $data .= <$rfh>;
 | 
						|
            }
 | 
						|
            my $responses = thaw($data);
 | 
						|
 | 
						|
            #############################
 | 
						|
            # Command results
 | 
						|
            #############################
 | 
						|
            if ( @$responses[0] =~ /^FORMATDATA6sK4ci$/ ) {
 | 
						|
                shift @$responses;
 | 
						|
 | 
						|
                foreach ( keys %$responses ) {
 | 
						|
                    $slp_result{$_} = 1;
 | 
						|
                }
 | 
						|
                next;
 | 
						|
            }
 | 
						|
            #############################
 | 
						|
            # Message or verbose trace
 | 
						|
            #############################
 | 
						|
            foreach ( @$responses ) {
 | 
						|
                $callback->( $_ );
 | 
						|
            }
 | 
						|
            next;
 | 
						|
        }
 | 
						|
        #################################
 | 
						|
        # Done - close handle 
 | 
						|
        #################################
 | 
						|
        $fds->remove($rfh);
 | 
						|
        close($rfh);
 | 
						|
    }
 | 
						|
}
 | 
						|
 | 
						|
 | 
						|
 | 
						|
##########################################################################
 | 
						|
# Process request from xCat daemon
 | 
						|
##########################################################################
 | 
						|
sub process_request {
 | 
						|
 | 
						|
    my $req      = shift;
 | 
						|
    my $callback = shift;
 | 
						|
 | 
						|
    ####################################
 | 
						|
    # Build hash to pass around
 | 
						|
    ####################################
 | 
						|
    my %request;
 | 
						|
    $request{arg}      = $req->{arg};
 | 
						|
    $request{callback} = $callback;
 | 
						|
 | 
						|
    ###########################################
 | 
						|
    # Parse command-line options
 | 
						|
    ###########################################
 | 
						|
    if ( parse_args( \%request )) {
 | 
						|
        return(1);
 | 
						|
    }
 | 
						|
    ###########################################
 | 
						|
    # Send remote command
 | 
						|
    ###########################################
 | 
						|
    slp_query( \%request );
 | 
						|
}
 | 
						|
 | 
						|
 | 
						|
 | 
						|
1;
 | 
						|
 | 
						|
 |