d93542fc49
git-svn-id: https://svn.code.sf.net/p/xcat/code/xcat-core/trunk@11886 8638fb3e-16cb-4fca-ae20-7b5d299a9bcd
227 lines
7.4 KiB
Perl
227 lines
7.4 KiB
Perl
package xCAT::SLP;
|
|
use Carp;
|
|
use IO::Select;
|
|
use strict;
|
|
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;
|
|
|
|
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 = @_;
|
|
unless ($args{'socket'}) {
|
|
if ($ip6support) {
|
|
$args{'socket'} = IO::Socket::INET6->new(Proto => 'udp');
|
|
} else {
|
|
croak "TODO: SLP without ipv6";
|
|
}
|
|
}
|
|
unless ($args{SrvTypes}) { croak "SrvTypes argument is required for xCAT::SLP::Dodiscover"; }
|
|
my @srvtypes;
|
|
if (ref $args{SrvTypes}) {
|
|
@srvtypes = @{$args{SrvTypes}};
|
|
} else {
|
|
@srvtypes = split /,/,$args{SrvTypes};
|
|
}
|
|
foreach my $srvtype (@srvtypes) {
|
|
senddiscover_single(%args,SrvType=>$srvtype);
|
|
}
|
|
unless ($args{NoWait}) { #in nowait, caller owns the responsibility..
|
|
#by default, report all respondants within 3 seconds:
|
|
my %rethash;
|
|
my $waitforsocket = IO::Select->new();
|
|
$waitforsocket->add($args{'socket'});
|
|
my $deadline=time()+3;
|
|
while ($deadline > time()) {
|
|
while ($waitforsocket->can_read(1)) {
|
|
my $slppacket;
|
|
my $peer = $args{'socket'}->recv($slppacket,1400);
|
|
my( $port,$flow,$ip6n,$scope) = Socket6::unpack_sockaddr_in6_all($peer);
|
|
my $peername = Socket6::inet_ntop(Socket6::AF_INET6(),$ip6n);
|
|
if ($rethash{$peername}) {
|
|
next; #got a dupe, discard
|
|
}
|
|
process_slp_packet(packet=>$slppacket,sockaddr=>$peer);
|
|
print $peername."\n";
|
|
print $scope."\n";
|
|
if ($args{Callback}) {
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
sub process_slp_packet {
|
|
my %args = @_;
|
|
my $sockaddy = $args{sockaddr};
|
|
my $packet = $args{packet};
|
|
my $parsedpacket = removeslpheader($packet);
|
|
if ($parsedpacket->{FunctionId} == 2) {#Service Reply
|
|
$parsedpacket->{service_urls} = parse_service_reply($parsedpacket->{payload});
|
|
delete $parsedpacket->{payload};
|
|
}
|
|
use Data::Dumper;
|
|
print Dumper($parsedpacket);
|
|
}
|
|
|
|
sub parse_service_reply {
|
|
my $packet = shift;
|
|
my @reply = unpack("C*",$packet);
|
|
if ($reply[0] != 0 or $reply[1] != 0) {
|
|
return ();
|
|
}
|
|
my @urls;
|
|
my $numurls = ($reply[2]<<8)+$reply[3];
|
|
splice (@reply,0,4);
|
|
while ($numurls--) {
|
|
push @urls,extract_next_url(\@reply);
|
|
}
|
|
return \@urls;
|
|
}
|
|
|
|
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 senddiscover_single {
|
|
my %args = @_;
|
|
my $packet = gendiscover(%args);
|
|
my @interfaces = get_interfaces(%args);
|
|
my $socket = $args{'socket'};
|
|
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);
|
|
}
|
|
foreach my $iface (@interfaces) {
|
|
if ($ip6support) {
|
|
setsockopt($socket,Socket6::IPPROTO_IPV6(),IPV6_MULTICAST_IF,pack("I",$iface));
|
|
$socket->send($packet,0,$v6addr);
|
|
}
|
|
#TODO: IPv4 support
|
|
# setsockopt($socket,IPPROTO_IP,IP_MULTICAST_IF,
|
|
}
|
|
}
|
|
|
|
sub get_interfaces {
|
|
#TODO: AIX tolerance, no subprocess, include/exclude interface(s)
|
|
my @ipoutput = `ip link`;
|
|
my @ifaceoutput = grep(/MULTICAST/,@ipoutput);
|
|
my @interfaces;
|
|
foreach (@ifaceoutput) {
|
|
chomp;
|
|
s/:.*//;
|
|
push @interfaces,$_;
|
|
}
|
|
return @interfaces;
|
|
}
|
|
# 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 <PRList> | <PRList> String \
|
|
# +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
|
|
# | length of <service-type> | <service-type> String \
|
|
# +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
|
|
# | length of <scope-list> | <scope-list> String \
|
|
# +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
|
|
# | length of predicate string | Service Request <predicate> \
|
|
# +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
|
|
# | length of <SLP SPI> string | <SLP SPI> String \
|
|
# +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
|
|
sub gendiscover {
|
|
my %args = @_;
|
|
my $srvtype = $args{SrvType};
|
|
my $scope = "DEFAULT";
|
|
if ($args{Scopes}) { $scope = $args{Scopes}; }
|
|
my $packet = pack("C*",0,0); #start with PRList, we have no prlist so zero
|
|
#TODO: actually accumulate PRList, particularly between IPv4 and IPv6 runs
|
|
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);
|
|
my $header = genslpheader($packet,Multicast=>1,FunctionId=>1);
|
|
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
|
|
splice(@payload,0,3); #ignore next ext offset for now
|
|
$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);
|
|
return \%parsedheader;
|
|
}
|
|
|
|
|
|
|
|
sub genslpheader {
|
|
my $packet = shift;
|
|
my %args = @_;
|
|
my $xid = rand(65535);
|
|
my $flaghigh=0;
|
|
my $flaglow=0; #this will probably never ever ever change
|
|
if ($args{Multicast}) { $flaghigh |= 0x20; }
|
|
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,0,0,0,$xid>>8,$xid&0xff,0,2)."en";
|
|
}
|
|
|