tcptee added

git-svn-id: https://svn.fhem.de/fhem/trunk@850 2b470e98-0d58-463d-a4d8-8e2adae1ed80

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

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).

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