diff --git a/fhem/CHANGED b/fhem/CHANGED index 60f8652e5..4aac64e44 100644 --- a/fhem/CHANGED +++ b/fhem/CHANGED @@ -19,6 +19,7 @@ - bugfix: serial port setting on Linux broken if running in the background - feature: IPV6 support, FHEMWEB basicAuth and HTTPS support - feature: createlog added to the autocreate module + - feature: contrib/tcptee.pl added - 2010-08-15 (5.0) - **NOTE*: The default installation path is changed to satisfy lintian diff --git a/fhem/contrib/README b/fhem/contrib/README index 578e5a514..dc897d9e0 100755 --- a/fhem/contrib/README +++ b/fhem/contrib/README @@ -65,3 +65,6 @@ Produces an overview on the RSSI readings from a log. Good for checking the signal quality at various locations for CUL and CUN. See begin of script for usage instructions. +- tcptee.pl + Used to connect e.g. a fhem and a CCU to a single HM-Lan config (the + correstponding fhem device should have the attribute dummy). diff --git a/fhem/contrib/tcptee.pl b/fhem/contrib/tcptee.pl new file mode 100644 index 000000000..2bb16870c --- /dev/null +++ b/fhem/contrib/tcptee.pl @@ -0,0 +1,160 @@ +#!/usr/bin/perl + +# it is actually a 1-m tcp data distributor. + +use warnings; +use strict; +use IO::Socket; + +my $bidi; +my $loop; +my $myIp; +my $myPort; +my $serverHost; +my $serverPort; +my $usage = "Usage: tcptee.pl [--bidi] [--loop] " . + "[myIp:]myPort:serverHost:serverPort\n"; + +while(@ARGV) { + my $opt = shift @ARGV; + + if($opt =~ m/^--bidi$/i) { + $bidi = 1; + + } elsif($opt =~ m/^--loop$/i) { + $loop = 1 + + } elsif($opt =~ m/^(.*):(\d+):(.*):(\d+)/) { + $myIp = $1; + $myPort = $2; + $serverHost = $3; + $serverPort = $4; + + } elsif($opt =~ m/^(\d+):(.*):(\d+)/) { + $myPort = $1; + $serverHost = $2; + $serverPort = $3; + + } else { + die $usage; + + } +} + +die $usage if(!$serverHost); + +my ($sfd, $myfd, %clients, $discoMsg); + +sub +tPrint($) +{ + my $arg = shift; + my @t = localtime; + printf("%04d.%02d.%02d %02d:%02d:%02d %s\n", + $t[5]+1900,$t[4]+1,$t[3], $t[2],$t[1],$t[0], $arg); +} + + +for(;;) { + + # Open the server first + $sfd = IO::Socket::INET->new(PeerAddr => "$serverHost:$serverPort"); + if(!$sfd) { + tPrint "Cannot connect to $serverHost:$serverPort : $!" if(!$discoMsg); + $discoMsg = 1; + last if(!$loop); + sleep(5); + next; + } + $discoMsg = 1; + tPrint "Connected to $serverHost:$serverPort"; + + + # Now open our listener + $myfd = IO::Socket::INET->new( + LocalHost => $myIp, + LocalPort => $myPort, + Listen => 10, + ReuseAddr => 1 + ); + die "Opening port $myPort: $!\n" if(!$myfd); + tPrint "Port $myPort opened"; + + my $firstmsg; # HMLAN special + + # Data loop + for(;;) { + my ($rin,$rout) = ('',''); + vec($rin, $sfd->fileno(), 1) = 1; + vec($rin, $myfd->fileno(), 1) = 1; + foreach my $c (keys %clients) { + vec($rin, fileno($clients{$c}{fd}), 1) = 1; + } + + my $nfound = select($rout=$rin, undef, undef, undef); + if($nfound < 0) { + tPrint("select: $!"); + last; + } + + # New connection + if(vec($rout, $myfd->fileno(), 1)) { + my @clientinfo = $myfd->accept(); + if(!@clientinfo) { + tPrint "Accept failed: $!"; + next; + } + my ($port, $iaddr) = sockaddr_in($clientinfo[1]); + my $fd = $clientinfo[0]; + $clients{$fd}{fd} = $fd; + $clients{$fd}{addr} = inet_ntoa($iaddr) . ":$port"; + tPrint "Connection accepted from $clients{$fd}{addr}"; + + syswrite($fd, $firstmsg) if($firstmsg); + } + + # Data from the server + if(vec($rout, $sfd->fileno(), 1)) { + my $buf; + my $ret = sysread($sfd, $buf, 256); + if(!defined($ret) || $ret <= 0) { + tPrint "Short read from the server, disconnecting the clients."; + last; + } + foreach my $c (keys %clients) { + syswrite($clients{$c}{fd}, $buf); + } + $firstmsg = $buf if(!$firstmsg); + } + + # Data from one of the clients + foreach my $c (keys %clients) { + next if(!vec($rout, fileno($clients{$c}{fd}), 1)); + my $buf; + my $ret = sysread($clients{$c}{fd}, $buf, 256); + if(!defined($ret) || $ret <= 0) { + close($clients{$c}{fd}); + tPrint "Client $clients{$c}{addr} left us"; + delete($clients{$c}); + next; + } + + syswrite($sfd, $buf); + if($bidi) { + foreach my $c2 (keys %clients) { + syswrite($clients{$c2}{fd}, $buf) if($c2 ne $c); + } + } + } + + } + + close($sfd); + close($myfd); + foreach my $c (keys %clients) { + close($clients{$c}{fd}); + delete($clients{$c}); + } + last if(!$loop); + sleep(1); +}