package xCAT::SLP; use Carp; use IO::Select; use strict; use xCAT::Utils; my $ip6support = eval { require IO::Socket::INET6; require Socket6; 1; }; use Socket; unless ($ip6support) { require IO::Socket::INET; } #TODO: somehow get at system headers to get the value, put in linux's for now use constant IPV6_MULTICAST_IF => 17; use constant IP_MULTICAST_IF => 32; use constant REQ_INTERVAL => 1; my %xid_to_srvtype_map; my $xid; my $gprlist; my %searchmacs; my %ip4neigh; my %ip6neigh; sub getmulticasthash { my $hash=0; my @nums = unpack("C*",shift); foreach my $num (@nums) { $hash *= 33; $hash += $num; $hash &= 0xffff; } $hash &= 0x3ff; $hash |= 0x1000; return sprintf("%04x",$hash); } sub dodiscover { my %args = @_; my $rspcount = 0; my $rspcount1 = 0; my $sendcount = 1; $xid = int(rand(16384))+1; unless ($args{'socket'}) { if ($ip6support) { $args{'socket'} = IO::Socket::INET6->new(Proto => 'udp'); } else { $args{'socket'} = IO::Socket::INET->new(Proto => 'udp'); } #make an extra effort to request biggest receive buffer OS is willing to give us if (-r "/proc/sys/net/core/rmem_max") { # we can detect the maximum allowed socket, read it. my $sysctl; open ($sysctl,"<","/proc/sys/net/core/rmem_max"); my $maxrcvbuf=<$sysctl>; my $rcvbuf = $args{'socket'}->sockopt(SO_RCVBUF); if ($maxrcvbuf > $rcvbuf) { $args{'socket'}->sockopt(SO_RCVBUF,$maxrcvbuf/2); } } } unless ($args{SrvTypes}) { croak "SrvTypes argument is required for xCAT::SLP::Dodiscover"; } unless (xCAT::Utils->isAIX()) { # AIX bug, can't set socket with SO_BROADCAST, otherwise multicast can't work. setsockopt($args{'socket'},SOL_SOCKET,SO_BROADCAST,1); #allow for broadcasts to be sent, we know what we are doing } my @srvtypes; if (ref $args{SrvTypes}) { @srvtypes = @{$args{SrvTypes}}; } else { @srvtypes = split /,/,$args{SrvTypes}; } my $interfaces = get_interfaces(%args); if ($args{Ip}) { foreach my $nic (keys %$interfaces) { if (${${$interfaces->{$nic}}{ipv4addrs}}[0] =~ /(\d+\.\d+\.\d+\.\d+)/) { unless ($args{Ip} =~ $1) { delete $interfaces->{$nic}; } } } } my @printip; foreach my $iface (keys %{$interfaces}) { foreach my $sip (@{$interfaces->{$iface}->{ipv4addrs}}) { my $ip = $sip; $ip =~ s/\/(.*)//; push @printip, $ip; } } my $printinfo = join(",", @printip); send_message($args{reqcallback}, 0, "Sending SLP request on interfaces: $printinfo ...") if ($args{reqcallback} and !$args{nomsg} ); foreach my $srvtype (@srvtypes) { send_service_request_single(%args,ifacemap=>$interfaces,SrvType=>$srvtype); } my %rethash; unless ($args{NoWait}) { #in nowait, caller owns the responsibility.. #by default, report all respondants within 3 seconds: my $waitforsocket = IO::Select->new(); $waitforsocket->add($args{'socket'}); my $retrytime = ($args{Retry}>0)?$args{Retry}+1:3; my $retryinterval = ($args{Retry}>0)?$args{Retry}:REQ_INTERVAL; my $waittime = ($args{Time}>0)?$args{Time}:20; my @peerarray; my @pkgarray; my $startinterval = time(); my $interval; my $deadline=time()+$waittime; my( $port,$flow,$ip6n,$ip4n,$scope); my $slppacket; my $peername; while ($deadline > time()) { ######################################## # receive untill there is none ######################################## while ($waitforsocket->can_read(0)) { my $peer = $args{'socket'}->recv($slppacket,3000,0); push @peerarray, $peer; push @pkgarray, $slppacket; } ####################################### # process the packets ####################################### for(my $j = 0; $j< scalar(@peerarray); $j++) { my $pkg = $peerarray[$j]; my $slpkg = $pkgarray[$j]; if ($ip6support) { ( $port,$flow,$ip6n,$scope) = Socket6::unpack_sockaddr_in6_all($pkg); $peername = Socket6::inet_ntop(Socket6::AF_INET6(),$ip6n); } else { ($port,$ip4n) = sockaddr_in($pkg); $peername = inet_ntoa($ip4n); } if ($rethash{$peername}) { next; #got a dupe, discard } my $result = process_slp_packet(packet=>$slpkg,sockaddr=>$pkg,'socket'=>$args{'socket'}); if ($result) { if ($peername =~ /\./) { #ipv4 $peername =~ s/::ffff://; } $result->{peername} = $peername; if ($gprlist) { $gprlist .= ','.$peername if(length($gprlist) < 1250); } else { $gprlist = $peername; } $result->{scopeid} = $scope; $result->{sockaddr} = $pkg; my $hashkey; if ($peername =~ /fe80/) { $peername .= '%'.$scope; } $rspcount++; $rspcount1++; $rethash{$peername} = $result; if ($args{Callback}) { $args{Callback}->($result); } } } ############################# # check if need to return ############################# @peerarray = (); @pkgarray = (); $interval = time() - $startinterval; if ($args{Time} and $args{Count}) { if ($rspcount >= $args{Count} or $interval >= $args{Time}) { send_message($args{reqcallback}, 0, "Received $rspcount1 responses.") if ($args{reqcallback} and !$args{nomsg}); last; } } if ($sendcount > $retrytime and $rspcount1 == 0) { send_message($args{reqcallback}, 0, "Received $rspcount1 responses.") if ($args{reqcallback} and !$args{nomsg}); last; } ######################### # send request again ######################### if ( $interval > $retryinterval){#* (2**$sendcount))) { #double time $sendcount++; $startinterval = time(); send_message($args{reqcallback}, 0, "Received $rspcount1 responses.") if ($args{reqcallback} and !$args{nomsg}); send_message($args{reqcallback}, 0, "Sending SLP request on interfaces: $printinfo ...") if ($args{reqcallback} and !$args{nomsg}); foreach my $srvtype (@srvtypes) { send_service_request_single(%args,ifacemap=>$interfaces,SrvType=>$srvtype); } $rspcount1 = 0; } } } #end nowait foreach my $entry (keys %rethash) { handle_new_slp_entity($rethash{$entry}) } if (xCAT::Utils->isAIX()) { foreach my $iface (keys %{$interfaces}) { foreach my $sip (@{$interfaces->{$iface}->{ipv4addrs}}) { my $ip = $sip; $ip =~ s/\/(.*)//; my $maskbits = $1; my $runcmd = `route delete 239.255.255.253 $ip`; } } } return (\%searchmacs, $sendcount, $rspcount); } sub process_slp_packet { my %args = @_; my $sockaddy = $args{sockaddr}; my $socket = $args{'socket'}; my $packet = $args{packet}; my $parsedpacket = removeslpheader($packet); if ($parsedpacket->{FunctionId} == 2) {#Service Reply parse_service_reply($parsedpacket->{payload},$parsedpacket); unless (ref $parsedpacket->{service_urls} and scalar @{$parsedpacket->{service_urls}}) { return undef; } #send_attribute_request('socket'=>$socket,url=>$parsedpacket->{service_urls}->[0],sockaddr=>$sockaddy); if ($parsedpacket->{attributes}) { #service reply had ext return $parsedpacket; #don't bother sending attrrequest, already got it in first packet } my $srvtype = $xid_to_srvtype_map{$parsedpacket->{Xid}}; my $packet = generate_attribute_request(%args,SrvType=>$srvtype); $socket->send($packet,0,$sockaddy); return undef; } elsif ($parsedpacket->{FunctionId} == 7) { #attribute reply $parsedpacket->{SrvType} = $xid_to_srvtype_map{$parsedpacket->{Xid}}; $parsedpacket->{attributes} = parse_attribute_reply($parsedpacket->{payload}); #delete $parsedpacket->{payload}; return $parsedpacket; } else { return undef; } } sub parse_attribute_reply { my $contents = shift; my @payload = unpack("C*",$contents); if ($payload[0] != 0 or $payload[1] != 0) { return {}; } splice (@payload,0,2); return parse_attribute_list(\@payload); } sub parse_attribute_list { my $payload = shift; my $attrlength = ($payload->[0]<<8)+$payload->[1]; splice(@$payload,0,2); my @attributes = splice(@$payload,0,$attrlength); my $attrstring = pack("C*",@attributes); my %attribs; #now we have a string... my $lastattrstring; while ($attrstring) { if ($lastattrstring eq $attrstring) { #infinite loop $attribs{unparsed_attribdata}=$attrstring; last; } $lastattrstring=$attrstring; if ($attrstring =~ /^\(/) { $attrstring =~ s/([^)]*\)),?//; my $attrib = $1; $attrib =~ s/^\(//; $attrib =~ s/\),?$//; $attrib =~ s/=(.*)$//; $attribs{$attrib}=[]; my $valstring = $1; if (defined $valstring) { foreach(split /,/,$valstring) { push @{$attribs{$attrib}},$_; } } } else { $attrstring =~ s/([^,]*),?//; $attribs{$1}=[]; } } return \%attribs; } sub generate_attribute_request { my %args = @_; my $srvtype = $args{SrvType}; my $scope = "DEFAULT"; if ($args{Scopes}) { $scope = $args{Scopes}; } my $packet = pack("C*",0,0); #no prlist my $service = $srvtype; $service =~ s!://.*!!; my $length = length($service); $packet .= pack("C*",($length>>8),($length&0xff)); $length = length($scope); $packet .= $service.pack("C*",($length>>8),($length&0xff)).$scope; $packet .= pack("C*",0,0,0,0); my $header = genslpheader($packet,FunctionId=>6); $xid_to_srvtype_map{$xid++}=$srvtype; return $header.$packet; # $args{'socket'}->send($header.$packet,0,$args{sockaddry}); } sub parse_service_reply { my $packet = shift; my $parsedpacket = shift; my @reply = unpack("C*",$packet); if ($reply[0] != 0 or $reply[1] != 0) { return (); } if ($parsedpacket->{extoffset}) { my @extdata = splice(@reply,$parsedpacket->{extoffset}-$parsedpacket->{currentoffset}); $parsedpacket->{currentoffset} = $parsedpacket->{extoffset}; parse_extension(\@extdata,$parsedpacket); } my $numurls = ($reply[2]<<8)+$reply[3]; splice (@reply,0,4); while ($numurls--) { push @{$parsedpacket->{service_urls}},extract_next_url(\@reply); } return; } sub parse_extension { my $extdata = shift; my $parsedpacket = shift; my $extid = ($extdata->[0]<<8)+$extdata->[1]; my $nextext = (($extdata->[2])<<16)+(($extdata->[3])<<8)+$extdata->[4]; if ($nextext) { my @nextext = splice(@$extdata,$nextext-$parsedpacket->{currentoffset}); $parsedpacket->{currentoffset} = $nextext; parse_extension(\@nextext,$parsedpacket); } splice(@$extdata,0,5); if ($extid == 2) { #this is defined in RFC 3059, attribute list extension #employed by AMM for one... my $urllen = ((shift @$extdata)<<8)+(shift @$extdata); splice @$extdata,0,$urllen; #throw this out for now.. $parsedpacket->{attributes} = parse_attribute_list($extdata); } } sub extract_next_url { #section 4.3 url entries my $payload = shift; splice (@$payload,0,3); # discard reserved and lifetime which we will not bother using my $urllength = ((shift @$payload)<<8)+(shift @$payload); my @url = splice(@$payload,0,$urllength); my $authblocks = shift @$payload; unless ($authblocks == 0) { $payload = []; #TODO: skip/use auth blocks if needed to get at more URLs } return pack("C*",@url); } sub send_service_request_single { my %args = @_; my $packet = generate_service_request(%args); my $interfaces = $args{ifacemap}; #get_interfaces(%args); my $socket = $args{'socket'}; my @v6addrs; my $v6addr; if ($ip6support) { my $hash=getmulticasthash($args{SrvType}); my $target = "ff02::1:$hash"; my ($fam, $type, $proto, $name); ($fam, $type, $proto, $v6addr, $name) = Socket6::getaddrinfo($target,"svrloc",Socket6::AF_INET6(),SOCK_DGRAM,0); push @v6addrs,$v6addr; ($fam, $type, $proto, $v6addr, $name) = Socket6::getaddrinfo("ff01::1:$hash","svrloc",Socket6::AF_INET6(),SOCK_DGRAM,0); push @v6addrs,$v6addr; } my $ipv4mcastaddr = inet_aton("239.255.255.253"); #per rfc 2608 my $ipv4sockaddr = sockaddr_in(427,$ipv4mcastaddr); foreach my $iface (keys %{$interfaces}) { if ($ip6support) { setsockopt($socket,Socket6::IPPROTO_IPV6(),IPV6_MULTICAST_IF,pack("I",$interfaces->{$iface}->{scopeidx})); foreach $v6addr (@v6addrs) { $socket->send($packet,0,$v6addr); } } foreach my $sip (@{$interfaces->{$iface}->{ipv4addrs}}) { my $ip = $sip; $ip =~ s/\/(.*)//; my $maskbits = $1; if (xCAT::Utils->isAIX()) { my $runcmd = `route add 239.255.255.253 $ip`; } my $ipn = inet_aton($ip); #we are ipv4 only, this is ok my $ipnum=unpack("N",$ipn); $ipnum= $ipnum | (2**(32-$maskbits))-1; my $bcastn = pack("N",$ipnum); my $bcastaddr = sockaddr_in(427,$bcastn); setsockopt($socket,0,IP_MULTICAST_IF,$ipn); $socket->send($packet,0,$ipv4sockaddr); $socket->send($packet,0,$bcastaddr); } } } sub get_interfaces { #TODO: AIX tolerance, no subprocess, include/exclude interface(s) my %ifacemap; my $payingattention=0; my $interface; my $keepcurrentiface; # AIX part if (xCAT::Utils->isAIX()) { $ip6support = 0; my $result = `ifconfig -a`; my @nics = $result =~ /(\w+\d+)\: flags=/g; my @adapter = split /\w+\d+:\s+flags=/, $result; for (my $i=0; $i)/ and $_ =~ /BROADCAST/ ) { my @ip = split /\n/; for my$entry ( @ip ) { if ( $entry =~ /broadcast\s+/ and $entry =~ /^\s*inet\s+(\d+\.\d+\.\d+\.\d+)/) { my $tmpip = $1; if($entry =~ /netmask\s+(0x\w+)/) { my $mask = hex($1); my $co = 31; my $count = 0; while ($co+1) { if((($mask&(2**$co))>>$co) == 1) { $count++; } $co--; } $tmpip = $tmpip.'/'.$count; } push @{$ifacemap{$nics[$i]}->{ipv4addrs}},$tmpip; if( $nics[$i]=~ /\w+(\d+)/){ $ifacemap{$nics[$i]}->{scopeidx} = $1+2; } } } } } } else { my @ipoutput = `ip addr`; foreach my $line (@ipoutput) { if ($line =~ /^\d/) { # new interface, new context.. if ($interface and not $keepcurrentiface) { #don't bother reporting unusable nics delete $ifacemap{$interface}; } $keepcurrentiface=0; unless ($line =~ /MULTICAST/) { #don't care if it isn't multicast capable $payingattention=0; next; } $payingattention=1; $line =~ /^([^:]*): ([^:]*):/; $interface=$2; $ifacemap{$interface}->{scopeidx}=$1; } unless ($payingattention) { next; } #don't think about lines unless in context of paying attention. if ($line =~ /inet/) { $keepcurrentiface=1; } if ($line =~ /\s+inet\s+(\S+)\s/) { #got an ipv4 address, store it push @{$ifacemap{$interface}->{ipv4addrs}},$1; } } } return \%ifacemap; } # discovery is "service request", rfc 2608 # 0 1 2 3 # 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 # +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ # | Service Location header (function = SrvRqst = 1) | # +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ # | length of | String \ # +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ # | length of | String \ # +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ # | length of | String \ # +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ # | length of predicate string | Service Request \ # +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ # | length of string | String \ # +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ sub generate_service_request { my %args = @_; my $srvtype = $args{SrvType}; my $scope = "DEFAULT"; if ($args{Scopes}) { $scope = $args{Scopes}; } my $prlist = $gprlist; my $prlength = length($prlist); my $packet = pack("C*",($prlength>>8),($prlength&0xff)); $packet .= $prlist; my $length = length($srvtype); $packet .= pack("C*",($length>>8),($length&0xff)); $packet .= $srvtype; $length = length($scope); $packet .= pack("C*",($length>>8),($length&0xff)); $packet .= $scope; #no ldap predicates, and no auth, so zeroes.. $packet .= pack("C*",0,0,0,0); $packet .= pack("C*",0,2,0,0,0,0,0,0,0,0); my $extoffset = length($srvtype)+length($scope)+length($prlist)+10; my $header = genslpheader($packet,Multicast=>1,FunctionId=>1,ExtOffset=>$extoffset); $xid_to_srvtype_map{$xid++}=$srvtype; return $packet = $header.$packet; } # SLP header from RFC 2608 # 0 1 2 3 # 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 # +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ # | Version | Function-ID | Length | # +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ # | Length, contd.|O|F|R| reserved |Next Ext Offset| # +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ # | Next Extension Offset, contd.| XID | # +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ # | Language Tag Length | Language Tag \ # +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ sub removeslpheader { my $packet = shift; my %parsedheader; my @payload = unpack("C*",$packet); $parsedheader{Version} = shift @payload; $parsedheader{FunctionId} = shift @payload; splice(@payload,0,3); #remove length splice(@payload,0,2); #TODO: parse flags my $nextoffset = ((shift @payload)<<16)+((shift @payload)<<8)+(shift @payload); $parsedheader{Xid} = ((shift @payload)<<8)+(shift @payload); my $langlen = ((shift @payload)<<8)+(shift @payload); $parsedheader{lang} = pack("C*",splice(@payload,0,$langlen)); $parsedheader{payload} = pack("C*",@payload); if ($nextoffset != 0) { #correct offset since header will be removed $parsedheader{currentoffset} = 14+$langlen; $parsedheader{extoffset}=$nextoffset; } return \%parsedheader; } sub genslpheader { my $packet = shift; my %args = @_; my $flaghigh=0; my $flaglow=0; #this will probably never ever ever change if ($args{Multicast}) { $flaghigh |= 0x20; } my $extoffset=0; if ($args{ExtOffset}) { $extoffset = $args{ExtOffset}+16; } my @extoffset=(($extoffset>>16),(($extoffset>>8)&0xff),($extoffset&0xff)); my $length = length($packet)+16; #our header is 16 bytes due to lang tag invariance if ($length > 1400) { die "Overflow not supported in xCAT SLP"; } return pack("C*",2, $args{FunctionId}, ($length >> 16), ($length >> 8)&0xff, $length&0xff, $flaghigh, $flaglow,@extoffset,$xid>>8,$xid&0xff,0,2)."en"; } unless (caller) { #time to provide unit testing/example usage #somewhat fancy invocation with multiple services and callback for #results on-the-fly require Data::Dumper; Data::Dumper->import(); my $srvtypes = ["service:management-hardware.IBM:chassis-management-module","service:management-hardware.IBM:integrated-management-module2","service:management-hardware.IBM:management-module","service:management-hardware.IBM:cec-service-processor"]; xCAT::SLP::dodiscover(SrvTypes=>$srvtypes,Callback=>sub { print Dumper(@_) }); #example 2: simple invocation of a single service type $srvtypes = "service:management-hardware.IBM:chassis-management-module"; print Dumper(xCAT::SLP::dodiscover(SrvTypes=>$srvtypes)); #TODO: pass-in socket and not wait inside SLP.pm example } ########################################### # Parse the slp resulte data ########################################### sub handle_new_slp_entity { my $data = shift; delete $data->{sockaddr}; #won't need it my $mac = get_mac_for_addr($data->{peername}); unless ($mac) { return; } $searchmacs{$mac} = $data; } ########################################### # Get mac addresses ########################################### sub get_mac_for_addr { my $neigh; my $addr = shift; if ($addr =~ /:/) { get_ipv6_neighbors(); return $ip6neigh{$addr}; } else { get_ipv4_neighbors(); return $ip4neigh{$addr}; } } ########################################### # Get ipv4 mac addresses ########################################### sub get_ipv4_neighbors { if (xCAT::Utils->isAIX()) { my @ipdata = `arp -a`; %ip6neigh=(); for my $entry (@ipdata) { if ($entry =~ /(\d+\.\d+\.\d+\.\d+)/) { my $ip = $1; #if ($entry =~ /at (\w+\:\w+\:\w+\:\w+\:\w+\:\w+)/) { # $ip4neigh{$ip}=$1; if ($entry =~ /at (\w+)\:(\w+)\:(\w+)\:(\w+)\:(\w+)\:(\w+)/) { #$ip4neigh{$ip}=$1.$2.$3.$4.$5.$6; $ip4neigh{$ip}=sprintf("%02s%02s%02s%02s%02s%02s",$1,$2,$3,$4,$5,$6); } } } } else { #TODO: something less 'hacky' my @ipdata = `ip -4 neigh`; %ip6neigh=(); foreach (@ipdata) { if (/^(\S*)\s.*lladdr\s*(\S*)\s/) { $ip4neigh{$1}=$2; } } } } ########################################### # Get ipv6 mac addresses ########################################### sub get_ipv6_neighbors { #TODO: something less 'hacky' my @ipdata = `ip -6 neigh`; %ip6neigh=(); foreach (@ipdata) { if (/^(\S*)\s.*lladdr\s*(\S*)\s/) { $ip6neigh{$1}=$2; } } } sub send_message { my $callback = shift; my $ecode = shift; my $msg = shift; my %output; $output{errorcode} = $ecode; $output{data} = $msg; $callback->( \%output ); } 1;