New telnet module and its consequences

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

fhem/CHANGED

@@ -49,6 +49,7 @@
              *Utils.pm files from fhem.pl
   - feature: portpassword and basicAuth may use evaluated functions
   - feature: motd with SecurityCheck added
+  - feature: telnet module added, attr global port moved. allowfrom changed.
 
 - 2011-12-31 (5.2)
   - bugfix:  applying smallscreen attributes to firefox/opera

fhem/FHEM/98_telnet.pm

@@ -0,0 +1,190 @@
+##############################################
+# $Id: 98_telnet.pm 1098 2011-11-12 07:51:08Z rudolfkoenig $
+
+# Note: this is not really a telnet server, but a TCP server with slight telnet
+# features (disable echo on password)
+
+package main;
+use strict;
+use warnings;
+use TcpServerUtils;
+
+##########################
+sub
+telnet_Initialize($)
+{
+  my ($hash) = @_;
+
+  $hash->{DefFn}   = "telnet_Define";
+  $hash->{ReadFn}  = "telnet_Read";
+  $hash->{UndefFn} = "telnet_Undef";
+  $hash->{AttrFn}  = "telnet_Attr";
+  $hash->{NotifyFn}= "telnet_SecurityCheck";
+  $hash->{AttrList} = "loglevel:0,1,2,3,4,5,6 globalpassword password ".
+                        "allowfrom SSL";
+}
+
+#####################################
+sub
+telnet_SecurityCheck($$)
+{
+  my ($ntfy, $dev) = @_;
+  return if($dev->{NAME} ne "global" ||
+            !grep(m/^INITIALIZED$/, @{$dev->{CHANGED}}));
+  my $motd = AttrVal("global", "motd", "");
+  if($motd =~ "^SecurityCheck") {
+      my @list = grep { !(AttrVal($_, "password", undef) ||
+                        AttrVal($_, "globalpassword", undef)) }
+               devspec2array("TYPE=telnet");
+    $motd .= (join(",", sort @list).
+                        " has no password/globalpassword attribute\n")
+        if(@list);
+    $attr{global}{motd} = $motd;
+  }
+  delete $modules{telnet}{NotifyFn};
+  return;
+}
+
+##########################
+sub
+telnet_Define($$$)
+{
+  my ($hash, $def) = @_;
+
+  my @a = split("[ \t][ \t]*", $def);
+  my ($name, $type, $port, $global) = split("[ \t]+", $def);
+  return "Usage: define <name> telnet [IPV6:]<tcp-portnr> [global]"
+        if($port !~ m/^(IPV6:)?\d+$/ || ($global && $global ne "global"));
+
+  return TcpServer_Open($hash, $port, $global);
+}
+
+sub
+telnet_pw($$)
+{
+  my ($sname, $cname) = @_;
+  my $pw = $attr{$sname}{password};
+  return $pw if($pw);
+
+  $pw = $attr{$sname}{globalpassword};
+  return $pw if($pw && $cname !~ m/^telnet:127.0.0.1/);
+
+  return undef;
+}
+
+##########################
+sub
+telnet_Read($)
+{
+  my ($hash) = @_;
+  my $name = $hash->{NAME};
+  if($hash->{SERVERSOCKET}) {   # Accept and create a child
+    my $chash = TcpServer_Accept($hash, "telnet");
+    return if(!$chash);
+    syswrite($chash->{CD}, sprintf("%c%c%cPassword: ", 255, 251, 1)) # WILL ECHO
+        if(telnet_pw($name, $chash->{NAME}));
+    return;
+  }
+
+  my $buf;
+  my $ret = sysread($hash->{CD}, $buf, 256);
+  if(!defined($ret) || $ret <= 0) {
+    CommandDelete(undef, $name);
+    return;
+  }
+  if(ord($buf) == 4) {	# EOT / ^D
+    CommandQuit($hash, "");
+    next;
+  }
+
+  $buf =~ s/\r//g;
+  my $pw = telnet_pw($hash->{SNAME}, $name);
+  if($pw) {
+    $buf =~ s/\xff..//g;              # Telnet IAC stuff
+    $buf =~ s/\xfd(.)//;              # Telnet Do ?
+    syswrite($hash->{CD}, sprintf("%c%c%c", 0xff, 0xfc, ord($1)))
+                      if(defined($1)) # Wont / ^C handling
+  }
+  $hash->{BUF} .= $buf;
+  my @ret;
+  my $gotCmd;
+
+  while($hash->{BUF} =~ m/\n/) {
+    my ($cmd, $rest) = split("\n", $hash->{BUF}, 2);
+    $hash->{BUF} = $rest;
+
+    if(!$hash->{pwEntered}) {
+      if($pw) {
+        syswrite($hash->{CD}, sprintf("%c%c%c\r\n", 255, 252, 1)); # WONT ECHO
+
+        $ret = ($pw eq $cmd);
+        if($pw =~ m/^{.*}$/) {  # Expression as pw
+          my $password = $cmd;
+          $ret = eval $pw;
+          Log 1, "password expression: $@" if($@);
+        }
+
+        if($ret) {
+          $hash->{pwEntered} = 1;
+          next;
+        } else {
+          CommandDelete(undef, $name);
+          return;
+        }
+      }
+    }
+    $gotCmd = 1;
+    if($cmd) {
+      if($cmd =~ m/\\ *$/) {                     # Multi-line
+        $hash->{prevlines} .= $cmd . "\n";
+      } else {
+        if($hash->{prevlines}) {
+          $cmd = $hash->{prevlines} . $cmd;
+          undef($hash->{prevlines});
+        }
+        $ret = AnalyzeCommandChain($hash, $cmd);
+        push @ret, $ret if(defined($ret));
+      }
+    } else {
+      $hash->{prompt} = 1;                  # Empty return
+      if(!$hash->{motdDisplayed}) {
+        my $motd = $attr{global}{motd};
+        push @ret, $motd if($motd && $motd ne "none");
+        $hash->{motdDisplayed} = 1;
+      }
+    }
+    next if($rest);
+  }
+
+  $ret = "";
+  $ret .= (join("\n", @ret) . "\n") if(@ret);
+  $ret .= ($hash->{prevlines} ? "> " : "fhem> ")
+          if($gotCmd && $hash->{prompt} && !$hash->{rcvdQuit});
+  if($ret) {
+    $ret =~ s/\n/\r\n/g if($pw);  # only for DOS telnet 
+    syswrite($hash->{CD}, $ret);
+  }
+  CommandDelete(undef, $name) if($hash->{rcvdQuit});
+}
+
+##########################
+sub
+telnet_Attr(@)
+{
+  my @a = @_;
+  my $hash = $defs{$a[1]};
+
+  if($a[0] eq "set" && $a[2] eq "SSL") {
+    TcpServer_SetSSL($hash);
+  }
+  return undef;
+}
+
+sub
+telnet_Undef($$)
+{
+  my ($hash, $arg) = @_;
+  return TcpServer_Close($hash);
+}
+
+1;

fhem/FHEM/TcpServerUtils.pm

@@ -0,0 +1,150 @@
+##############################################
+# $Id: TcpServerUtils.pm 1098 2011-11-12 07:51:08Z rudolfkoenig $
+
+package main;
+use strict;
+use warnings;
+use IO::Socket;
+
+sub
+TcpServer_Open($$$)
+{
+  my ($hash, $port, $global) = @_;
+  my $name = $hash->{NAME};
+
+  if($port =~ m/^IPV6:(\d+)$/i) {
+    $port = $1;
+    eval "require IO::Socket::INET6; use Socket6;";
+    if($@) {
+      Log 1, $@;
+      Log 1, "$name: Can't load INET6, falling back to IPV4";
+    } else {
+      $hash->{IPV6} = 1;
+    }
+  }
+
+  my @opts = (
+    Domain    => ($hash->{IPV6} ? AF_INET6() : AF_UNSPEC), # Linux bug
+    LocalHost => ($global ? undef : "localhost"),
+    LocalPort => $port,
+    Listen    => 10,
+    ReuseAddr => 1
+  );
+  $hash->{STATE} = "Initialized";
+  $hash->{SERVERSOCKET} = $hash->{IPV6} ?
+        IO::Socket::INET6->new(@opts) : 
+        IO::Socket::INET->new(@opts);
+
+  if(!$hash->{SERVERSOCKET}) {
+    return "$name: Can't open server port at $port: $!";
+  }
+
+  $hash->{FD} = $hash->{SERVERSOCKET}->fileno();
+  $hash->{PORT} = $port;
+
+  $selectlist{"$name.$port"} = $hash;
+  Log(3, "$name: port $port opened");
+  return undef;
+}
+
+sub
+TcpServer_Accept($$)
+{
+  my ($hash, $type) = @_;
+
+  my $name = $hash->{NAME};
+  my $ll = GetLogLevel($name,4);
+  my @clientinfo = $hash->{SERVERSOCKET}->accept();
+  if(!@clientinfo) {
+    Log 1, "Accept failed ($name: $!)";
+    return undef;
+  }
+  $hash->{CONNECTS}++;
+
+  my ($port, $iaddr) = $hash->{IPV6} ? 
+      sockaddr_in6($clientinfo[1]) :
+      sockaddr_in($clientinfo[1]);
+  my $caddr = $hash->{IPV6} ?
+                inet_ntop(AF_INET6(), $iaddr) :
+                inet_ntoa($iaddr);
+
+  my $af = $attr{$name}{allowfrom};
+  if($af) {
+    if($caddr !~ m/$af/) {
+      my $hostname = gethostbyaddr($iaddr, AF_INET);
+      if(!$hostname || $hostname !~ m/$af/) {
+        Log 1, "Connection refused from $caddr:$port";
+        close($clientinfo[0]);
+        return undef;
+      }
+    }
+  }
+
+  if($hash->{SSL}) {
+    # Certs directory must be in the modpath, i.e. at the same level as the
+    # FHEM directory
+    my $mp = AttrVal("global", "modpath", ".");
+    my $ret = IO::Socket::SSL->start_SSL($clientinfo[0], {
+      SSL_server    => 1, 
+      SSL_key_file  => "$mp/certs/server-key.pem",
+      SSL_cert_file => "$mp/certs/server-cert.pem",
+      });
+    if(!$ret && $! ne "Socket is not connected") {
+      Log 1, "$type SSL/HTTPS error: $!";
+      close($clientinfo[0]);
+      return undef;
+    }
+  }
+
+  my $cname = "$type:$caddr:$port";
+  my %nhash;
+  $nhash{NR}    = $devcount++;
+  $nhash{NAME}  = $cname;
+  $nhash{FD}    = $clientinfo[0]->fileno();
+  $nhash{CD}    = $clientinfo[0];     # sysread / close won't work on fileno
+  $nhash{TYPE}  = $type;
+  $nhash{STATE} = "Connected";
+  $nhash{SNAME} = $name;
+  $nhash{TEMPORARY} = 1;              # Don't want to save it
+  $nhash{BUF}   = "";
+  $attr{$cname}{room} = "hidden";
+  $defs{$cname} = \%nhash;
+  $selectlist{$nhash{NAME}} = \%nhash;
+
+
+  Log($ll, "Connection accepted from $nhash{NAME}");
+  return \%nhash;
+}
+
+sub
+TcpServer_SetSSL($)
+{
+  my ($hash) = @_; 
+  eval "require IO::Socket::SSL";
+  if($@) {
+    Log 1, $@;
+    Log 1, "Can't load IO::Socket::SSL, falling back to HTTP";
+  } else {
+    $hash->{SSL} = 1;
+  }
+}
+
+
+sub
+TcpServer_Close($)
+{
+  my ($hash) = @_;
+  my $name = $hash->{NAME};
+
+  if(defined($hash->{CD})) { # Clients
+    close($hash->{CD});
+    delete($selectlist{$name});
+  }
+  if(defined($hash->{SERVERSOCKET})) {          # Server
+    close($hash->{SERVERSOCKET});
+    $name = $name . "." . $hash->{PORT};
+    delete($selectlist{$name});
+  }
+  return undef;
+}
+1;

fhem/TODO

@@ -1,8 +1,6 @@
 FHEM:
-- FHEMWEB warning
 - finish updatefhem
 - autoload commands -> rename updatefhem, CULflash, etc
-
 - FHEM2FHEM reconnect
 - HomeMatic set log 2
 - implement wiki decisions

fhem/docs/commandref.html

@@ -28,7 +28,6 @@
   <br>
   <b>fhem commands</b>
   <ul>
-
       <a href="#attr">attr</a> &nbsp;
       <a href="#backup">backup</a> &nbsp;
       <a href="#CULflash">CULflash</a> &nbsp;
@@ -167,6 +166,7 @@
     <a href="#notify">notify</a> &nbsp;
     <a href="#sequence">sequence</a> &nbsp;
     <a href="#structure">structure</a> &nbsp;
+    <a href="#telnet">telnet</a> &nbsp;
     <a href="#watchdog">watchdog</a> &nbsp;
     <a href="#weblink">weblink</a> &nbsp;
 
@@ -1004,6 +1004,7 @@ A line ending with \ will be concatenated with the next one, so long lines
   Note: The statefile will be saved first, then the config file will be read
   (all devices will be initialized again), and at last the statefile will be
   reloaded. It triggers upon completion the global:REREADCFG event.
+  All existing connections up to the one issuing the rereadcfg will be closed.
   <br><br>
   Example:
   <ul>
@@ -1179,12 +1180,6 @@ A line ending with \ will be concatenated with the next one, so long lines
     </li><br>
 
 
-    <a name="allowfrom"></a>
-    <li>allowfrom<br>
-        Comma (,) separated list of ip-addresses or hostnames. If set,
-        only connections from these addresses are allowed.
-    </li><br>
-
     <a name="backup_before_update"></a>
     <li>backup_before_update<br>
         If this attribute is set to 0, updatefhem skip always backing up your
@@ -1304,6 +1299,14 @@ A line ending with \ will be concatenated with the next one, so long lines
         modpath attribute definition time).
     </li><br>
 
+    <a name="motd"></a>
+    <li>motd<br>
+        Message Of The Day. Displayed on the homescreen of the FHEMWEB package,
+        or directly after the telnet logon, before displaying the fhem> prompt. 
+        SecurityCheck is setting motd if it is not defined upon startup, to
+        avoid this set the motd value to none
+    </li><br>
+
     <a name="mseclog"></a>
     <li>mseclog<br>
         If set, the timestamp in the logfile will contain a millisecond part.
@@ -1323,35 +1326,6 @@ A line ending with \ will be concatenated with the next one, so long lines
         shutdown.
     </li><br>
 
-    <a name="port"></a>
-    <li>port<br>
-        Listen on the TCP/IP port <code>&lt;number&gt;</code> for incoming
-        connections. To offer at least a little bit of security, the server
-        will only listen for connections from the localhost per default. If
-        there is a second value  "global" then the server will listen for
-        non-localhost connections too.<br><br>
-        This attribute is optional starting with fhem 5.3.<br><br>
-        To use IPV6, specify the port as IPV6:&lt;number&gt;, in this
-        case the perl module IO::Socket:INET6 will be requested.
-        On Linux you may have to install it with cpan -i IO::Socket::INET6 or
-        apt-get libio-socket-inet6-perl; the OSX perl already has this module.
-    </li><br>
-
-    <a name="portpassword"></a>
-    <li>portpassword<br>
-        Specify a port password, which has to be entered as the very first
-        string after the connection is established. If the argument is enclosed
-        in {}, then it will be evaluated, and the $password variable will be
-        set to the password entered. If the return value is true, then the
-        password will be accepted.
-        Example:<br>
-        <code>
-        attr global portpassword secret<br>
-        attr global portpassword {use FritzBoxUtils;;FB_checkPw("localhost","$password") }
-        </code>
-    </li><br>
-
-
     <a name="statefile"></a>
     <a name="statefile"></a>
     <li>statefile<br>
@@ -5148,8 +5122,6 @@ A line ending with \ will be concatenated with the next one, so long lines
 <a name="POKEYS"></a>
 <h3>POKEYS</h3>
 <ul>
-  <table>
-  <tr><td>
   The POKEYS module is used to control the LAN POKEYS device (<a href="http://www.poscope.com/pokeys56e">POKEYS56e</a>) which supports
   up to 56 digital input, analog inputs, counter inputs and digital outputs.
   Each port/pin has to be configured before it can be used.
@@ -5215,7 +5187,6 @@ A line ending with \ will be concatenated with the next one, so long lines
   </ul>
   <br>
 </ul>
-</ul>
 
 <a name="VantagePro2"></a>
 <h3>VantagePro2</h3>
@@ -8544,10 +8515,11 @@ KlikAanKlikUit, NEXA, CHACON, HomeEasy UK. <br> You need to define an RFXtrx433
 
     <a name="HTTPS"></a>
     <li>HTTPS<br>
-        use HTTPS instead of HTTP. This feature requires the perl module
+        Enable HTTPS connections. This feature requires the perl module
         IO::Socket::SSL, to be installed with cpan -i IO::Socket::SSL or
-        apt-get install libio-socket-ssl-perl; the OSX perl already has this
+        apt-get install libio-socket-ssl-perl; OSX and the FritzBox-7390
-        module.<br>
+        already have this module.<br>
+
         A local certificate has to be generated into a directory called certs,
         this directory <b>must</b> be in the <a href="#modpath">modpath</a>
         directory, at the same level as the FHEM directory.
@@ -8559,6 +8531,11 @@ KlikAanKlikUit, NEXA, CHACON, HomeEasy UK. <br> You need to define an RFXtrx433
       <br><br>
     </li>
 
+    <li><a href="#allowfrom">allowfrom</a></li>
+    </li><br>
+    <li><a href="#loglevel">loglevel</a></li>
+    </li><br>
+
     <a name="stylesheetPrefix"></a>
     <li>stylesheetPrefix<br>
       prefix for the files style.css, svg_style.css and svg_defs.svg. If the file
@@ -9625,6 +9602,98 @@ KlikAanKlikUit, NEXA, CHACON, HomeEasy UK. <br> You need to define an RFXtrx433
 
 </ul>
 
+<a name="telnet"></a>
+<h3>telnet</h3>
+<ul>
+  <br>
+  <a name="telnetdefine"></a>
+  <b>Define</b>
+  <ul>
+    <code>define &lt;name&gt; telnet &lt;portNumber&gt; [global]</code>
+    <br><br>
+
+    Listen on the TCP/IP port <code>&lt;portNumber&gt;</code> for incoming
+    connections. If the second parameter global is <b>not</b> specified,
+    the server will only listen to localhost connections.
+    <br><br>
+
+    To use IPV6, specify the portNumber as IPV6:&lt;number&gt;, in this
+    case the perl module IO::Socket:INET6 will be requested.
+    On Linux you may have to install it with cpan -i IO::Socket::INET6 or
+    apt-get libio-socket-inet6-perl; OSX and the FritzBox-7390 perl already has
+    this module.
+    <br><br>
+    Examples:
+    <ul>
+        <code>define tPort telnet 7072 global</code><br>
+        <code>attr tPort globalpasswort mySecret</code><br>
+        <code>attr tPort SSL</code><br>
+    </ul>
+    <br>
+    Note: The old global attribute port is automatically converted to a
+    telnet instance with the name telnetPort. The global allowfrom attibute is
+    lost in this conversion.
+  </ul>
+  <br>
+
+
+  <a name="telnetset"></a>
+  <b>Set</b> <ul>N/A</ul><br>
+
+  <a name="telnetget"></a>
+  <b>Get</b> <ul>N/A</ul><br>
+
+  <a name="telnetattr"></a>
+  <b>Attributes:</b>
+  <ul>
+    <li><a href="#loglevel">loglevel</a></li>
+    <br>
+
+    <a name="password"></a>
+    <li>password<br>
+        Specify a password, which has to be entered as the very first string
+        after the connection is established. If the argument is enclosed in {},
+        then it will be evaluated, and the $password variable will be set to
+        the password entered. If the return value is true, then the password
+        will be accepted. If thies parameter is specified, fhem sends telnet
+        IAC requests to supress echo while entering the password.
+        Also all returned lines are terminated with \r\n.
+        Example:<br>
+        <code>
+        attr tPort password secret<br>
+        attr tPort password {use FritzBoxUtils;;FB_checkPw("localhost","$password") }
+        </code>
+        <br><br>
+
+    <a name="globalpassword"></a>
+    <li>globalpassword<br>
+        Just like the attribute password, but a password will only required for
+        non-local connections.
+        <br><br>
+
+    <a name="SSL"></a>
+    <li>SSL<br>
+        Enable SSL encryption of the connection, see the description <a 
+        href="#HTTPS">here</a> on generating the needed SSL certificates. To
+        connect to such a port use one of the following commands:
+        <ul>
+          socat openssl:fhemhost:fhemport,verify=0 readline<br>
+          ncat --ssl fhemhost fhemport<br>
+          openssl s_client -connect fhemhost:fhemport<br>
+        </ul>
+        <br><br>
+
+    <a name="allowfrom"></a>
+    <li>allowfrom<br>
+        Regexp of allowed ip-addresses or hostnames. If set,
+        only connections from these addresses are allowed.
+        <br><br>
+
+  </ul>
+
+</ul>
+
+
 <a name="DbLog"></a>
 <h3>DbLog</h3>
 <ul>

fhem/fhem.pl

@@ -50,7 +50,6 @@ sub addToAttrList($);
 sub CallFn(@);
 sub CommandChain($$);
 sub CheckDuplicate($$);
-sub DoClose($);
 sub DoTrigger($$);
 sub Dispatch($$$);
 sub FmtDateTime($);
@@ -160,13 +159,12 @@ use vars qw($reread_active);
 
 my $AttrList = "room group comment alias eventMap";
 
-my $server;			# Server socket
 my %comments;			# Comments from the include files
 my $ipv6;			# Using IPV6
 my $currlogfile;		# logfile, without wildcards
 my $currcfgfile="";		# current config/include file
 my $logopened = 0;              # logfile opened or using stdout
-my %client;			# Client array
+my %inform;			# Inform hash
 my $rcvdquit;			# Used for quit handling in init files
 my $sig_term = 0;		# if set to 1, terminate (saving the state)
 my %intAt;			# Internal at timer hash.
@@ -190,8 +188,8 @@ $init_done = 0;
 $modules{Global}{ORDER} = -1;
 $modules{Global}{LOADED} = 1;
 $modules{Global}{AttrList} =
-  "archivecmd allowfrom apiversion archivedir configfile lastinclude logfile " .
+  "archivecmd apiversion archivedir configfile lastinclude logfile " .
-  "modpath nrarchive pidfilename port portpassword statefile title userattr " .
+  "modpath nrarchive pidfilename port statefile title userattr " .
   "verbose:1,2,3,4,5 mseclog version nofork logdir holiday2we " .
   "autoload_undefined_devices dupTimeout latitude longitude " .
   "backupcmd backupdir backupsymlink backup_before_update " .
@@ -294,11 +292,11 @@ if(int(@ARGV) == 2) {
   my $buf;
   my $addr = $ARGV[0];
   $addr = "localhost:$addr" if($ARGV[0] !~ m/:/);
-  $server = IO::Socket::INET->new(PeerAddr => $addr);
+  my $client = IO::Socket::INET->new(PeerAddr => $addr);
-  die "Can't connect to $addr\n" if(!$server);
+  die "Can't connect to $addr\n" if(!$client);
-  syswrite($server, "$ARGV[1] ; quit\n");
+  syswrite($client, "$ARGV[1] ; quit\n");
-  shutdown($server, 1);
+  shutdown($client, 1);
-  while(sysread($server, $buf, 256) > 0) {
+  while(sysread($client, $buf, 256) > 0) {
     print($buf);
   }
   exit(0);
@@ -336,7 +334,6 @@ while(time() < 2*3600) {
 
 my $ret = CommandInclude(undef, $attr{global}{configfile});
 Log 1, "configfile: $ret" if($ret);
-#die("No port specified in the configfile.\n") if(!$server);
 
 if($attr{global}{statefile} && -r $attr{global}{statefile}) {
   $ret = CommandInclude(undef, $attr{global}{statefile});
@@ -355,17 +352,30 @@ if($pfn) {
 # create the global interface definitions
 createInterfaceDefinitions();
 
-$attr{global}{motd} = "SecurityCheck:\n\n"
+my $gp = $attr{global}{port};
-        if(!$attr{global}{motd} || $attr{global}{motd} =~ m/^SecurityCheck/);
+if($gp) {
+  Log 3, "Converting 'attr global port $gp' to 'define telnetPort telnet $gp'";
+  CommandDefine(undef, "telnetPort telnet $gp");
+  delete($attr{global}{port});
+}
+
+my $sc_text = "SecurityCheck:";
+$attr{global}{motd} = "$sc_text\n\n"
+        if(!$attr{global}{motd} || $attr{global}{motd} =~ m/^$sc_text/);
 
 $init_done = 1;
 DoTrigger("global", "INITIALIZED");
 
 $attr{global}{motd} .=
-        "\nSet the global attribute motd to none to supress this message,\n".
+        "\nRestart fhem for a new check if the problem ist fixed,\n".
-        "or restart fhem for a new check if the problem ist fixed.\n"
+        "or set the global attribute motd to none to supress this message.\n"
-        if($attr{global}{motd} =~ m/^SecurityCheck:\n\n./);
+        if($attr{global}{motd} =~ m/^$sc_text\n\n./);
-delete($attr{global}{motd}) if($attr{global}{motd} eq "SecurityCheck:\n\n");
+my $motd = $attr{global}{motd};
+if($motd eq "$sc_text\n\n") {
+  delete($attr{global}{motd});
+} else {
+  Log 2, $motd if($motd ne "none");
+}
 
 Log 0, "Server started (version $attr{global}{version}, pid $$)";
 
@@ -380,17 +390,9 @@ while (1) {
 
   my $timeout = HandleTimeout();
 
-  vec($rin, $server->fileno(), 1) = 1 if($server);
   foreach my $p (keys %selectlist) {
     vec($rin, $selectlist{$p}{FD}, 1) = 1;
   }
-  foreach my $c (keys %client) {
-    vec($rin, fileno($client{$c}{fd}), 1) = 1;
-  }
-
-  # for documentation see
-  # man 2 select
-  # http://perldoc.perl.org/functions/select.html
   $timeout = $readytimeout if(keys(%readyfnlist) &&
                               (!defined($timeout) || $timeout > $readytimeout));
   my $nfound = select($rout=$rin, undef, undef, $timeout);
@@ -445,63 +447,6 @@ while (1) {
     }
   }
 
-  if($server && vec($rout, $server->fileno(), 1)) {
-    my @clientinfo = $server->accept();
-    if(!@clientinfo) {
-      Log 1, "Accept failed: $!";
-      next;
-    }
-    my ($port, $iaddr) = $ipv6 ?
-        sockaddr_in6($clientinfo[1]) :
-        sockaddr_in($clientinfo[1]);
-    my $caddr = $ipv6 ?
-        inet_ntop(AF_INET6(), $iaddr):
-        inet_ntoa($iaddr);
-    my $af = $attr{global}{allowfrom};
-    if($af) {
-      if(",$af," !~ m/,$caddr,/) {
-        my $hostname = gethostbyaddr($iaddr, AF_INET);
-        if(!$hostname || ",$af," !~ m/,$hostname,/) {
-          Log 1, "Connection refused from $caddr:$port";
-          close($clientinfo[0]);
-          next;
-        }
-      }
-    }
-
-    my $fd = $clientinfo[0];
-    $client{$fd}{fd}   = $fd;
-    $client{$fd}{addr} = "$caddr:$port";
-    $client{$fd}{buffer} = "";
-    Log 4, "Connection accepted from $client{$fd}{addr}";
-    syswrite($fd, sprintf("%c%c%cPassword: ", 255, 251, 1))   # WILL ECHO
-        if($attr{global}{portpassword});
-  }
-
-  foreach my $c (keys %client) {
-
-    next unless (vec($rout, fileno($client{$c}{fd}), 1));
-
-    my $buf;
-    my $ret = sysread($client{$c}{fd}, $buf, 256);
-    if(!defined($ret) || $ret <= 0) {
-      DoClose($c);
-      next;
-    }
-    if(ord($buf) == 4) {	# EOT / ^D
-      CommandQuit($c, "");
-      next;
-    }
-    $buf =~ s/\r//g;
-    if($attr{global}{portpassword}) {
-      $buf =~ s/\xff..//g;              # Telnet IAC stuff
-      $buf =~ s/\xfd(.)//;              # Telnet Do ?
-      syswrite($client{$c}{fd}, sprintf("%c%c%c", 0xff, 0xfc, ord($1)))
-                        if(defined($1)) # Wont / ^C handling
-    }
-    $client{$c}{buffer} .= $buf;
-    AnalyzeInput($c);
-  }
 }
 
 ################################################
@@ -585,18 +530,6 @@ Log($$)
 }
 
 
-#####################################
-sub
-DoClose($)
-{
-  my $c = shift;
-
-  Log 4, "Connection closed for $client{$c}{addr}";
-  close($client{$c}{fd});
-  delete($client{$c});
-  return undef;
-}
-
 #####################################
 sub
 IOWrite($@)
@@ -647,69 +580,6 @@ CommandIOWrite($$)
 }
 
 
-#####################################
-sub
-AnalyzeInput($)
-{
-  my $c = shift;
-  my @ret;
-  my $gotCmd;
-
-  while($client{$c}{buffer} =~ m/\n/) {
-    my ($cmd, $rest) = split("\n", $client{$c}{buffer}, 2);
-    $client{$c}{buffer} = $rest;
-
-    if($attr{global}{portpassword} && !$client{$c}{pwEntered}) {
-      syswrite($client{$c}{fd}, sprintf("%c%c%c\r\n", 255, 252, 1)); # WONT ECHO
-
-      my $ret = ($attr{global}{portpassword} eq $cmd);
-      if($attr{global}{portpassword} =~ m/^{.*}$/) {  # Expression as pw
-        my $password = $cmd;
-        $ret = eval $attr{global}{portpassword};
-        Log 1, "portpasswd expression: $@" if($@);
-      }
-
-      if($ret) {
-        $client{$c}{pwEntered} = 1;
-        next;
-      } else {
-        DoClose($c);
-        return;
-      }
-    }
-    $gotCmd = 1;
-    if($cmd) {
-      if($cmd =~ m/\\ *$/) {                     # Multi-line
-        $client{$c}{prevlines} .= $cmd . "\n";
-      } else {
-        if($client{$c}{prevlines}) {
-          $cmd = $client{$c}{prevlines} . $cmd;
-          undef($client{$c}{prevlines});
-        }
-        my $ret = AnalyzeCommandChain($c, $cmd);
-        push @ret, $ret if(defined($ret));
-      }
-    } else {
-      $client{$c}{prompt} = 1;                  # Empty return
-      if(!$client{$c}{motdDisplayed}) {
-        my $motd = $attr{global}{motd};
-        push @ret, $motd if($motd && $motd ne "none");
-        $client{$c}{motdDisplayed} = 1;
-      }
-    }
-    next if($rest);
-  }
-  my $ret = "";
-  $ret .= (join("\n", @ret) . "\n") if(@ret);
-  $ret .= ($client{$c}{prevlines} ? "> " : "fhem> ")
-          if($gotCmd && $client{$c}{prompt} && !$client{$c}{rcvdQuit});
-  if($ret) {
-    $ret =~ s/\n/\r\n/g if($attr{global}{portpassword});
-    syswrite($client{$c}{fd}, $ret);
-  }
-  DoClose($c) if($client{$c}{rcvdQuit});
-}
-
 #####################################
 # i.e. split a line by ; (escape ;;), and execute each
 sub
@@ -1000,6 +870,7 @@ sub
 CommandRereadCfg($$)
 {
   my ($cl, $param) = @_;
+  my $name = $cl->{NAME} if($cl);
 
   WriteStatefile();
 
@@ -1007,7 +878,7 @@ CommandRereadCfg($$)
   $init_done = 0;
 
   foreach my $d (keys %defs) {
-    my $ret = CallFn($d, "UndefFn", $defs{$d}, $d);
+    my $ret = CallFn($d, "UndefFn", $defs{$d}, $d) if($name && $name ne $d);
     return $ret if($ret);
   }
 
@@ -1017,6 +888,7 @@ CommandRereadCfg($$)
   %attr = ();
   %selectlist = ();
   %readyfnlist = ();
+  %inform = ();
 
   doGlobalDef($cfgfile);
   setGlobalAttrBeforeFork($cfgfile);
@@ -1027,6 +899,7 @@ CommandRereadCfg($$)
     $ret = (defined($ret) ? "$ret\n$ret2" : $ret2) if(defined($ret2));
   }
   DoTrigger("global", "REREADCFG");
+  $defs{$name} = $selectlist{$name} = $cl if($name);
 
   $init_done = 1;
   $reread_active=0;
@@ -1042,8 +915,8 @@ CommandQuit($$)
   if(!$cl) {
     $rcvdquit = 1;
   } else {
-    $client{$cl}{rcvdQuit} = 1;
+    $cl->{rcvdQuit} = 1;
-    return "Bye..." if($client{$cl}{prompt});
+    return "Bye..." if($cl->{prompt});
   }
   return undef;
 }
@@ -1713,45 +1586,6 @@ GlobalAttr($$)
     }
   }
 
-  ################
-  elsif($name eq "port") {
-
-    return undef if($reread_active);
-    my ($port, $global) = split(" ", $val);
-    if($global && $global ne "global") {
-      return "Bad syntax, usage: attr global port <portnumber> [global]";
-    }
-    if($port =~ m/^IPV6:(\d+)$/i) {
-      $port = $1;
-      $ipv6 = 1;
-      eval "require IO::Socket::INET6; use Socket6;";
-      if($@) {
-        Log 1, "attr global port: $@";
-        Log 1, "Can't load INET6, falling back to IPV4";
-        $ipv6 = 0;
-      }
-    }
-
-    my $server2;
-    my @opts = (
-        Domain    => ($ipv6 ? AF_INET6() : AF_UNSPEC), # Linux bug
-        LocalHost => ($global ? undef : "localhost"),
-        LocalPort => $port,
-        Listen    => 10,
-        ReuseAddr => 1
-    );
-    $server2 = $ipv6 ? IO::Socket::INET6->new(@opts) : 
-                       IO::Socket::INET->new(@opts);
-    if(!$server2) {
-      Log 1, "attr global port: Can't open server port at $port: $!";
-      return "$!" if($init_done);
-      die "Can't open server port at $port: $!\n";
-    }
-    Log 2, "Telnet port $port opened";
-    close($server) if($server);
-    $server = $server2;
-  }
-
   ################
   elsif($name eq "verbose") {
     if($val =~ m/^[0-5]$/) {
@@ -1962,22 +1796,21 @@ CommandInform($$)
 {
   my ($cl, $param) = @_;
 
-  if(!$cl) {
+  return if(!$cl);
-    return;
+  my $name = $cl->{NAME};
-  }
 
   return "Usage: inform {on|timer|raw|off} [regexp]"
         if($param !~ m/^(on|off|raw|timer)/);
 
-  delete($client{$cl}{inform});
+  delete($inform{$name});
-  delete($client{$cl}{informRegexp});
   if($param !~ m/^off/) {
     my ($type, $regexp) = split(" ", $param);
-    $client{$cl}{inform} = $type;
+    $inform{$name}{NR} = $cl->{NR};
+    $inform{$name}{type} = $type;
     if($regexp) {
       eval { "Hallo" =~ m/$regexp/ };
       return "Bad regexp: $@" if($@);
-      $client{$cl}{informRegexp} = $regexp;
+      $inform{$name}{regexp} = $regexp;
     }
     Log 4, "Setting inform to $param";
 
@@ -2295,19 +2128,23 @@ DoTrigger($$)
     # Inform
     if($defs{$dev}{CHANGED}) {    # It gets deleted sometimes (?)
       $max = int(@{$defs{$dev}{CHANGED}}); # can be enriched in the notifies
-      foreach my $c (keys %client) {        # Do client loop first, is cheaper
+      foreach my $c (keys %inform) {
-        next if(!$client{$c}{inform} || $client{$c}{inform} eq "raw");
+        if(!$defs{$c} || $defs{$c}{NR} != $inform{$c}{NR}) {
+          delete($inform{$c});
+          next;
+        }
+        next if($inform{$c}{type} eq "raw");
         my $tn = TimeNow();
         if($attr{global}{mseclog}) {
           my ($seconds, $microseconds) = gettimeofday();
           $tn .= sprintf(".%03d", $microseconds/1000);
         }
-        my $re = $client{$c}{informRegexp};
+        my $re = $inform{$c}{regexp};
         for(my $i = 0; $i < $max; $i++) {
           my $state = $defs{$dev}{CHANGED}[$i];
           next if($re && $state !~ m/$re/);
-          syswrite($client{$c}{fd},
+          syswrite($defs{$c}{CD},
-            ($client{$c}{inform} eq "timer" ? "$tn " : "") .
+            ($inform{$c}{type} eq "timer" ? "$tn " : "") .
             "$defs{$dev}{TYPE} $dev $state\n");
         }
       }
@@ -2539,9 +2376,13 @@ Dispatch($$$)
   ################
   # Inform raw
   if(!$iohash->{noRawInform}) {
-    foreach my $c (keys %client) {
+    foreach my $c (keys %inform) {
-      next if(!$client{$c}{inform} || $client{$c}{inform} ne "raw");
+      if(!$defs{$c} || $defs{$c}{NR} != $inform{$c}{NR}) {
-      syswrite($client{$c}{fd}, "$hash->{TYPE} $name $dmsg\n");
+        delete($inform{$c});
+        next;
+      }
+      next if($inform{$c}{type} ne "raw");
+      syswrite($defs{$c}{CD}, "$hash->{TYPE} $name $dmsg\n");
     }
   }
 

fhem/webfrontend/pgm2/01_FHEMWEB.pm

@@ -4,7 +4,7 @@ package main;
 
 use strict;
 use warnings;
-use IO::Socket;
+use TcpServerUtils;
 
 #########################
 # Forward declaration
@@ -74,10 +74,11 @@ my %FW_types;      # device types, for sorting
 my @FW_zoom;       # "qday", "day","week","month","year"
 my %FW_zoom;       # the same as @FW_zoom
 my %FW_hiddenroom; # hash of hidden rooms
-my $FW_longpoll;
+my $FW_longpoll;   # Set if longpoll (i.e. server notification) is active
 my $FW_inform;
-my $FW_XHR;
+my $FW_XHR;        # Data only answer, no HTML
-my $FW_jsonp;
+my $FW_jsonp;      # jasonp answer (sending function calls to the client)
+my $FW_chash;      # client fhem hash
 #my $FW_encoding="ISO-8859-1";
 my $FW_encoding="UTF-8";
 
@@ -97,7 +98,7 @@ FHEMWEB_Initialize($)
                      "plotmode:gnuplot,gnuplot-scroll,SVG plotsize refresh " .
                      "touchpad smallscreen plotfork basicAuth basicAuthMsg ".
                      "stylesheetPrefix hiddenroom HTTPS longpoll:1,0 ".
-                     "redirectCmds:0,1 ";
+                     "redirectCmds:0,1 allowfrom ";
 
   ###############
   # Initialize internal structures
@@ -125,7 +126,7 @@ FW_SecurityCheck($$)
     $attr{global}{motd} = $motd;
   }
   $modules{FHEMWEB}{NotifyFn}= "FW_Notify";
-  return undef;
+  return;
 }
 
 #####################################
@@ -134,44 +135,10 @@ FW_Define($$)
 {
   my ($hash, $def) = @_;
   my ($name, $type, $port, $global) = split("[ \t]+", $def);
-  return "Usage: define <name> FHEMWEB <tcp-portnr> [global]"
+  return "Usage: define <name> FHEMWEB [IPV6:]<tcp-portnr> [global]"
         if($port !~ m/^(IPV6:)?\d+$/ || ($global && $global ne "global"));
 
-  if($port =~ m/^IPV6:(\d+)$/i) {
+  return TcpServer_Open($hash, $port, $global);
-    $port = $1;
-    eval "require IO::Socket::INET6; use Socket6;";
-    if($@) {
-      Log 1, $@;
-      Log 1, "Can't load INET6, falling back to IPV4";
-    } else {
-      $hash->{IPV6} = 1;
-    }
-  }
-
-  my @opts = (
-    Domain    => ($hash->{IPV6} ? AF_INET6() : AF_UNSPEC), # Linux bug
-    LocalHost => ($global ? undef : "localhost"),
-    LocalPort => $port,
-    Listen    => 10,
-    ReuseAddr => 1
-  );
-  $hash->{STATE} = "Initialized";
-  $hash->{SERVERSOCKET} = $hash->{IPV6} ?
-        IO::Socket::INET6->new(@opts) : 
-        IO::Socket::INET->new(@opts);
-
-  if(!$hash->{SERVERSOCKET}) {
-    my $msg = "Can't open server port at $port: $!";
-    Log 1, $msg;
-    return $msg;
-  }
-
-  $hash->{FD} = $hash->{SERVERSOCKET}->fileno();
-  $hash->{PORT} = $port;
-
-  $selectlist{"$name.$port"} = $hash;
-  Log(2, "FHEMWEB port $port opened");
-  return undef;
 }
 
 #####################################
@@ -179,20 +146,7 @@ sub
 FW_Undef($$)
 {
   my ($hash, $arg) = @_;
-  my $name = $hash->{NAME};
+  return TcpServer_Close($hash);
-
-  return undef if($hash->{INUSE});
-
-  if(defined($hash->{CD})) { # Clients
-    close($hash->{CD});
-    delete($selectlist{$name});
-  }
-  if(defined($hash->{SERVERSOCKET})) {          # Server
-    close($hash->{SERVERSOCKET});
-    $name = $name . "." . $hash->{PORT};
-    delete($selectlist{$name});
-  }
-  return undef;
 }
 
 #####################################
@@ -203,54 +157,11 @@ FW_Read($)
   my $name = $hash->{NAME};
 
   if($hash->{SERVERSOCKET}) {   # Accept and create a child
-
+    TcpServer_Accept($hash, "FHEMWEB");
-    my $ll = GetLogLevel($name,4);
-    my @clientinfo = $hash->{SERVERSOCKET}->accept();
-    if(!@clientinfo) {
-      Log(1, "Accept failed for HTTP port ($name: $!)");
-      return;
-    }
-    $hash->{CONNECTS}++;
-
-    my @clientsock = $hash->{IPV6} ? 
-        sockaddr_in6($clientinfo[1]) :
-        sockaddr_in($clientinfo[1]);
-
-    my %nhash;
-    my $cname = "FHEMWEB:".
-        ($hash->{IPV6} ?
-                inet_ntop(AF_INET6(), $clientsock[1]) :
-                inet_ntoa($clientsock[1])) .":".$clientsock[0];
-    $nhash{NR}    = $devcount++;
-    $nhash{NAME}  = $cname;
-    $nhash{FD}    = $clientinfo[0]->fileno();
-    $nhash{CD}    = $clientinfo[0];     # sysread / close won't work on fileno
-    $nhash{TYPE}  = "FHEMWEB";
-    $nhash{STATE} = "Connected";
-    $nhash{SNAME} = $name;
-    $nhash{TEMPORARY} = 1;              # Don't want to save it
-    $nhash{BUF}   = "";
-    $attr{$cname}{room} = "hidden";
-
-    $defs{$nhash{NAME}} = \%nhash;
-    $selectlist{$nhash{NAME}} = \%nhash;
-
-    if($hash->{SSL}) {
-      # Certs directory must be in the modpath, i.e. at the same level as the
-      # FHEM directory
-      my $mp = AttrVal("global", "modpath", ".");
-      my $ret = IO::Socket::SSL->start_SSL($nhash{CD}, {
-        SSL_server    => 1, 
-        SSL_key_file  => "$mp/certs/server-key.pem",
-        SSL_cert_file => "$mp/certs/server-cert.pem",
-        });
-      Log 1, "FHEMWEB HTTPS: $!" if(!$ret && $! ne "Socket is not connected");
-    }
-
-    Log($ll, "Connection accepted from $nhash{NAME}");
     return;
   }
 
+  $FW_chash = $hash;
   $FW_wname = $hash->{SNAME};
   $FW_cname = $name;
   $FW_subdir = "";
@@ -330,16 +241,9 @@ FW_Read($)
     return if(($arg =~ m/cmd=showlog/) && ($pid = fork));
   }
 
-  $hash->{INUSE} = 1;
   my $cacheable = FW_AnswerCall($arg);
-  delete($hash->{INUSE});
   return if($cacheable == -1); # Longpoll / inform request;
 
-  if(!$selectlist{$name}) {             # removed by rereadcfg, reinsert
-    $selectlist{$name} = $hash;
-    $defs{$name} = $hash;
-  }
-
   my $compressed = "";
   if(($FW_RETTYPE =~ m/text/i ||
       $FW_RETTYPE =~ m/svg/i ||
@@ -1199,13 +1103,13 @@ FW_substcfg($$$$$$)
   $fileesc =~ s/\\/\\\\/g;      # For Windows, by MarkusRR
   my $title = AttrVal($wl, "title", "\"$fileesc\"");
 
-  $title = AnalyzeCommand(undef, "{ $title }");
+  $title = AnalyzeCommand($FW_chash, "{ $title }");
   my $label = AttrVal($wl, "label", undef);
   my @g_label;
   if ($label) {
     @g_label = split("::",$label);
     foreach (@g_label) {
-      $_ = AnalyzeCommand(undef, "{ $_ }");
+      $_ = AnalyzeCommand($FW_chash, "{ $_ }");
     }
   }
   $attr{global}{verbose} = $oll;
@@ -1839,7 +1743,7 @@ sub
 FW_fC($)
 {
   my ($cmd) = @_;
-  my $ret = AnalyzeCommand(undef, $cmd);
+  my $ret = AnalyzeCommand($FW_chash, $cmd);
   return $ret;
 }
 
@@ -1852,7 +1756,7 @@ FW_showWeblink($$$$)
   my $attr = AttrVal($d, "htmlattr", "");
 
   if($t eq "htmlCode") {
-    $v = AnalyzePerlCommand(undef, $v) if($v =~ m/^{(.*)}$/);
+    $v = AnalyzePerlCommand($FW_chash, $v) if($v =~ m/^{(.*)}$/);
     FW_pO $v;
 
   } elsif($t eq "link") {
@@ -1924,13 +1828,7 @@ FW_Attr(@)
   my $hash = $defs{$a[1]};
 
   if($a[0] eq "set" && $a[2] eq "HTTPS") {
-    eval "require IO::Socket::SSL";
+    TcpServer_SetSSL($hash);
-    if($@) {
-      Log 1, $@;
-      Log 1, "Can't load IO::Socket::SSL, falling back to HTTP";
-    } else {
-      $hash->{SSL} = 1;
-    }
   }
   return undef;
 }
@@ -2217,4 +2115,5 @@ WeatherAsHtml($)
   return $ret;
 }
 
+
 1;