2
0
mirror of https://github.com/fhem/fhem-mirror.git synced 2025-03-13 17:26:34 +00:00

tcptee added

git-svn-id: https://svn.fhem.de/fhem/trunk@850 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
rudolfkoenig 2011-03-10 17:41:38 +00:00
parent 7309cc8bfc
commit eb893f97bf
3 changed files with 164 additions and 0 deletions

View File

@ -19,6 +19,7 @@
- bugfix: serial port setting on Linux broken if running in the background - bugfix: serial port setting on Linux broken if running in the background
- feature: IPV6 support, FHEMWEB basicAuth and HTTPS support - feature: IPV6 support, FHEMWEB basicAuth and HTTPS support
- feature: createlog added to the autocreate module - feature: createlog added to the autocreate module
- feature: contrib/tcptee.pl added
- 2010-08-15 (5.0) - 2010-08-15 (5.0)
- **NOTE*: The default installation path is changed to satisfy lintian - **NOTE*: The default installation path is changed to satisfy lintian

View File

@ -65,3 +65,6 @@
Produces an overview on the RSSI readings from a log. Good for checking 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 the signal quality at various locations for CUL and CUN. See begin of
script for usage instructions. 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).

160
fhem/contrib/tcptee.pl Normal file
View File

@ -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);
}