mirror of
https://github.com/fhem/fhem-mirror.git
synced 2025-04-07 19:04:20 +00:00
TcpServerUtils.pm: 126290
git-svn-id: https://svn.fhem.de/fhem/trunk@25831 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
rudolfkoenig
parent
a0361e8164
commit
c40dcf7822
@ -8,11 +8,14 @@ use IO::Socket;
|
||||
use vars qw($SSL_ERROR);
|
||||
|
||||
sub
|
||||
TcpServer_Open($$$)
|
||||
TcpServer_Open($$$;$)
|
||||
{
|
||||
my ($hash, $port, $global) = @_;
|
||||
my ($hash, $port, $global, $multicast) = @_;
|
||||
my $name = $hash->{NAME};
|
||||
|
||||
return 'multicast not supported without SO_REUSEPORT'
|
||||
if($multicast && !defined(&SO_REUSEPORT));
|
||||
|
||||
if($port =~ m/^IPV6:(\d+)$/i) {
|
||||
$port = $1;
|
||||
eval "require IO::Socket::INET6; use Socket6;";
|
||||
@ -26,7 +29,7 @@ TcpServer_Open($$$)
|
||||
|
||||
my $lh = ($global ? ($global eq "global"? undef : $global) :
|
||||
($hash->{IPV6} ? "::1" : "127.0.0.1"));
|
||||
my @opts = (
|
||||
my %opts = (
|
||||
Domain => ($hash->{IPV6} ? AF_INET6() : AF_UNSPEC), # Linux bug / #126448
|
||||
LocalHost => $lh,
|
||||
LocalPort => $port,
|
||||
@ -34,10 +37,18 @@ TcpServer_Open($$$)
|
||||
Blocking => ($^O =~ /Win/ ? 1 : 0), # Needed for .WRITEBUFFER@darwin
|
||||
ReuseAddr => 1
|
||||
);
|
||||
|
||||
if($multicast) {
|
||||
$opts{ReusePort} = 1;
|
||||
$opts{Proto} = 'udp';
|
||||
delete($opts{Listen});
|
||||
$hash->{MULTICAST} = $multicast;
|
||||
}
|
||||
|
||||
readingsSingleUpdate($hash, "state", "Initialized", 0);
|
||||
$hash->{SERVERSOCKET} = $hash->{IPV6} ?
|
||||
IO::Socket::INET6->new(@opts) :
|
||||
IO::Socket::INET->new(@opts);
|
||||
IO::Socket::INET6->new(%opts) :
|
||||
IO::Socket::INET->new(%opts);
|
||||
|
||||
if(!$hash->{SERVERSOCKET}) {
|
||||
return "$name: Can't open server port at $port: $!";
|
||||
@ -51,12 +62,192 @@ TcpServer_Open($$$)
|
||||
return undef;
|
||||
}
|
||||
|
||||
sub
|
||||
TcpServer_SetLoopbackMode($$)
|
||||
{
|
||||
my ($hash, $loopback) = @_;
|
||||
my $name = $hash->{NAME};
|
||||
my $sock = $hash->{SERVERSOCKET};
|
||||
|
||||
my $old;
|
||||
if( !$hash->{IPV6} && $sock->sockdomain() == AF_INET ) {
|
||||
my $packed = getsockopt($sock, Socket::IPPROTO_IP,
|
||||
Socket::IP_MULTICAST_LOOP);
|
||||
if( !$packed ) {
|
||||
Log3 $name, 1, "$name: failed to get loopback mode: $!";
|
||||
return undef;
|
||||
}
|
||||
$old = unpack("I", $packed);
|
||||
|
||||
if( !setsockopt($sock, Socket::IPPROTO_IP,
|
||||
Socket::IP_MULTICAST_LOOP, pack("I", $loopback ) ) ) {
|
||||
Log3 $name, 1, "$name: could not set loopback mode: $!";
|
||||
return undef;
|
||||
}
|
||||
|
||||
} elsif( !$hash->{IPV6} && $sock->sockdomain() == AF_INET6 ) {
|
||||
my $packed = getsockopt($sock, Socket::IPPROTO_IPV6,
|
||||
Socket::IPV6_MULTICAST_LOOP);
|
||||
if( !$packed ) {
|
||||
Log3 $name, 1, "$name: failed to get loopback mode: $!";
|
||||
return undef;
|
||||
}
|
||||
$old = unpack("I", $packed);
|
||||
|
||||
if( setsockopt($sock, Socket::IPPROTO_IPV6,
|
||||
Socket::IPV6_MULTICAST_LOOP, pack("I", $loopback ) ) ) {
|
||||
Log3 $name, 1, "$name: could not set loopback mode: $!";
|
||||
return undef;
|
||||
}
|
||||
|
||||
} else {
|
||||
Log3 $name, 1,
|
||||
"$name: TcpServer_SetLoopbackMode failed: unsupported socket family";
|
||||
return undef;
|
||||
}
|
||||
|
||||
return $old;
|
||||
}
|
||||
|
||||
sub
|
||||
TcpServer_MCastAdd($$)
|
||||
{
|
||||
my ($hash, $addr) = @_;
|
||||
my $name = $hash->{NAME};
|
||||
my $sock = $hash->{SERVERSOCKET};
|
||||
|
||||
$hash->{ADDR} = $addr;
|
||||
|
||||
# disable loopback
|
||||
TcpServer_SetLoopbackMode($hash, 0);
|
||||
|
||||
# add multicast address
|
||||
if(!$hash->{IPV6} && $sock->sockdomain() == AF_INET) {
|
||||
# should we allow to specify the interfache instead of using any?
|
||||
my $ip_mreq = Socket::pack_ip_mreq( inet_aton( $addr ), INADDR_ANY );
|
||||
|
||||
setsockopt($sock, Socket::IPPROTO_IP, Socket::IP_ADD_MEMBERSHIP, $ip_mreq )
|
||||
or return "$name: could not set IP_ADD_MEMBERSHIP socket option: $!";
|
||||
|
||||
} elsif($hash->{IPV6} && $sock->sockdomain() == AF_INET6) {
|
||||
# should we allow to specify the interfache instead of using any?
|
||||
my $ipv6_mreq = Socket::pack_ipv6_mreq( inet_pton( AF_INET6, $addr ), 0 );
|
||||
|
||||
setsockopt($sock, Socket::IPPROTO_IPV6, Socket::IPV6_JOIN_GROUP, $ipv6_mreq )
|
||||
or return "$name: could not set IPV6_JOIN_GROUP socket option: $!";
|
||||
|
||||
} else {
|
||||
return("$name: TcpServer_MCastAdd failed: unsupported socket family" );
|
||||
|
||||
}
|
||||
|
||||
readingsSingleUpdate($hash, "state", "Multicast listen", 0);
|
||||
|
||||
return undef;
|
||||
}
|
||||
|
||||
sub
|
||||
TcpServer_MCastRecv($$$;$)
|
||||
{
|
||||
my ($hash, undef, $length, $flags) = @_;
|
||||
my $name = $hash->{NAME};
|
||||
my $sock = $hash->{SERVERSOCKET};
|
||||
|
||||
my $sockaddr = $sock->recv($_[1], $length, $flags);
|
||||
if(!$hash->{IPV6} && $sock->sockdomain() == AF_INET) {
|
||||
my ($peer_port, $addr) = Socket::unpack_sockaddr_in($sockaddr);
|
||||
my $peer_host = inet_ntoa($addr);
|
||||
return $peer_host, $peer_port;
|
||||
|
||||
} elsif($hash->{IPV6} && $sock->sockdomain() == AF_INET6) {
|
||||
my ($peer_port, $addr) = Socket::unpack_sockaddr_in6($sockaddr);
|
||||
my $peer_host = inet_ntop(AF_INET6(),$addr);
|
||||
return $peer_host, $peer_port;
|
||||
|
||||
} else {
|
||||
Log3 $name, 1, "$name: TcpServer_MCastRecv failed: unsupported socket family";
|
||||
return undef;
|
||||
}
|
||||
}
|
||||
|
||||
sub
|
||||
TcpServer_MCastSend($$;$$)
|
||||
{
|
||||
my ($hash, $data, $addr, $port) = @_;
|
||||
my $name = $hash->{NAME};
|
||||
my $sock = $hash->{SERVERSOCKET};
|
||||
|
||||
$addr = $hash->{ADDR} if( !$addr );
|
||||
$port = $hash->{PORT} if( !$port );
|
||||
|
||||
if( !$addr ) {
|
||||
Log3 $name, 1, "$name: TcpServer_MCastSend failed: address unknown";
|
||||
return undef;
|
||||
}
|
||||
if( !$port ) {
|
||||
Log3 $name, 1, "$name: TcpServer_MCastSend failed: port unknown";
|
||||
return undef;
|
||||
}
|
||||
|
||||
if(!$hash->{IPV6} && $sock->sockdomain() == AF_INET) {
|
||||
my $sockaddr = Socket::pack_sockaddr_in($port, inet_aton($addr));
|
||||
return $sock->send($data,0,$sockaddr);
|
||||
|
||||
} elsif($hash->{IPV6} && $sock->sockdomain() == AF_INET6) {
|
||||
my $sockaddr = Socket::pack_sockaddr_in6($port, inet_pton($addr));
|
||||
return $sock->send($data,0,$sockaddr);
|
||||
|
||||
} else {
|
||||
Log3 $name, 1,"$name: TcpServer_MCastSend failed: unsupported socket family";
|
||||
return undef;
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
sub
|
||||
TcpServer_MCastRemove($$)
|
||||
{
|
||||
my ($hash, $addr) = @_;
|
||||
my $name = $hash->{NAME};
|
||||
my $sock = $hash->{SERVERSOCKET};
|
||||
|
||||
delete $hash->{ADDR};
|
||||
|
||||
if(!$hash->{IPV6} && $sock->sockdomain() == AF_INET) {
|
||||
# should we allow to specify the interfache instead of using any?
|
||||
my $ip_mreq = Socket::pack_ip_mreq( inet_aton( $addr ), INADDR_ANY );
|
||||
|
||||
setsockopt($sock, Socket::IPPROTO_IP, Socket::IP_DROP_MEMBERSHIP, $ip_mreq )
|
||||
or return "$name: could not set IP_DROP_MEMBERSHIP socket option: $!";
|
||||
|
||||
} elsif($hash->{IPV6} && $sock->sockdomain() == AF_INET6) {
|
||||
# should we allow to specify the interfache instead of using any?
|
||||
my $ipv6_mreq = Socket::pack_ipv6_mreq( inet_pton( AF_INET6, $addr ), 0 );
|
||||
|
||||
setsockopt($sock, Socket::IPPROTO_IPV6, Socket::IPV6_LEAVE_GROUP, $ipv6_mreq)
|
||||
or return "$name: could not set IPV6_LEAVE_GROUP socket option: $!";
|
||||
|
||||
} else {
|
||||
return("$name: TcpServer_MCastRemove failed: unsupported socket family" );
|
||||
|
||||
}
|
||||
|
||||
readingsSingleUpdate($hash, "state", "Multicast listen stopped", 0);
|
||||
|
||||
return undef;
|
||||
}
|
||||
|
||||
sub
|
||||
TcpServer_Accept($$)
|
||||
{
|
||||
my ($hash, $type) = @_;
|
||||
|
||||
my $name = $hash->{NAME};
|
||||
|
||||
if($hash->{MULTICAST}) {
|
||||
Log3 $name, 1, "$name: can't accept on a mutlicast socket";
|
||||
return undef;
|
||||
}
|
||||
|
||||
my @clientinfo = $hash->{SERVERSOCKET}->accept();
|
||||
if(!@clientinfo) {
|
||||
Log3 $name, 1, "Accept failed ($name: $!)" if($! != EAGAIN);
|
||||
@ -383,4 +574,49 @@ TcpServer_WriteBlocking($$)
|
||||
return 1; # success
|
||||
}
|
||||
|
||||
=pod
|
||||
|
||||
Multicast:
|
||||
(https://forum.fhem.de/index.php/topic,126290.msg1209591.html#msg1209591)
|
||||
verwendet wird es so:
|
||||
- das socket mit gesetztem optionalen vierten paramter von TcpServer_Open
|
||||
erzeugen: d.h. im define oder sonst wo mit my $ret = TcpServer_Open($hash,
|
||||
'5353', '0.0.0.0', 1); initialisieren. statt der 0.0.0.0 kann man auch die
|
||||
multicast adresse angeben, ich bin mir nicht sicher was richtiger ist und ob
|
||||
es einen unterschied macht. funktionieren tut bei mir beides.
|
||||
- TcpServer_Open schaltet automatisch den loopback mode aus. d.h. man empfängt
|
||||
seine eigenen daten nicht. ich vermute das ist der normalfall. mit
|
||||
TcpServer_SetLoopbackMode($hash,[0|1]); kann man das ändern wenn man es
|
||||
braucht.
|
||||
- mit TcpServer_MCastAdd die multicast adresse zum socket explizit hinzufügen:
|
||||
z.b.: TcpServer_MCastAdd($hash,'224.0.0.251'); erst ab jetzt bekommt man auch
|
||||
tatsächlich daten.
|
||||
- im (device) hash wird für jedes udp packet die ReadFn aufgerufen. dort kann
|
||||
man mit TcpServer_MCastRecv dann die empfangenen daten abholen:
|
||||
my($peer_host, $peer_port) = TcpServer_MCastRecv($hash,$data,$length);
|
||||
|
||||
alternativ kann man auch die low leven routinen direkt aufrufen:
|
||||
- my $sockaddr = $hash->{SERVERSOCKET}->recv($data, 4096);
|
||||
der empfang geht über SERVERSOCKET, nicht wie bei tcp über CD, es wird auch
|
||||
kein accept verwendet
|
||||
- aus $sockaddr kann man sich die gegenstelle zum udp packet holen falls man
|
||||
die braucht:
|
||||
my ($peer_port, $addr) = Socket::sockaddr_in($sockaddr);
|
||||
my $peer_host = inet_ntoa($addr);
|
||||
- eigene daten sendet man mit TcpServer_MCastSend:
|
||||
TcpServer_MCastSend($hash,$data[,$host[,$port]]); hier bei wird der port aus
|
||||
dem TcpServer_Open und die adresse aus TcpServer_MCastAdd verwendet.
|
||||
alternativ kann man beides auch beim aufruf mitgeben.
|
||||
- mit TcpServer_MCastRemove kann man die multicast adresse auch wieder vom
|
||||
socket entfernen:
|
||||
z.b.: TcpServer_MCastRemove($hash,'224.0.0.251');
|
||||
das socket empfängt dann keine daten für diese adresse mehr.
|
||||
- mit wechselweisem TcpServer_MCastAdd und TcpServer_MCastRemove kann man auch
|
||||
zeitweise zwischen empfangen und ignorieren hin und her wechseln. z.b. als
|
||||
reaktion auf disable.
|
||||
- mit TcpServer_Close($hash); das ganze am ende z.b. in der UndefFn wieder zu
|
||||
machen.
|
||||
|
||||
=cut
|
||||
|
||||
1;
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user