From fdbab2372e1f92eacb67eaaa10ddc82da9f668bc Mon Sep 17 00:00:00 2001 From: rudolfkoenig Date: Sat, 23 Jun 2012 16:22:28 +0000 Subject: [PATCH] New telnet module and its consequences git-svn-id: https://fhem.svn.sourceforge.net/svnroot/fhem/trunk/fhem@1638 2b470e98-0d58-463d-a4d8-8e2adae1ed80 --- CHANGED | 1 + FHEM/98_telnet.pm | 190 +++++++++++++++++++++++ FHEM/TcpServerUtils.pm | 150 ++++++++++++++++++ TODO | 2 - docs/commandref.html | 153 ++++++++++++++----- fhem.pl | 269 +++++++-------------------------- webfrontend/pgm2/01_FHEMWEB.pm | 137 +++-------------- 7 files changed, 525 insertions(+), 377 deletions(-) create mode 100644 FHEM/98_telnet.pm create mode 100644 FHEM/TcpServerUtils.pm diff --git a/CHANGED b/CHANGED index 291764b70..f7e715e37 100644 --- a/CHANGED +++ b/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 diff --git a/FHEM/98_telnet.pm b/FHEM/98_telnet.pm new file mode 100644 index 000000000..58f5ee6cf --- /dev/null +++ b/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 telnet [IPV6:] [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; diff --git a/FHEM/TcpServerUtils.pm b/FHEM/TcpServerUtils.pm new file mode 100644 index 000000000..75d7e6c87 --- /dev/null +++ b/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; diff --git a/TODO b/TODO index 1a0cf76fc..85d9e1a18 100644 --- a/TODO +++ b/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 diff --git a/docs/commandref.html b/docs/commandref.html index bab664c06..586d26a93 100644 --- a/docs/commandref.html +++ b/docs/commandref.html @@ -28,7 +28,6 @@
fhem commands
    - attr   backup   CULflash   @@ -167,6 +166,7 @@ notify   sequence   structure   + telnet   watchdog   weblink   @@ -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.

    Example:
      @@ -1179,12 +1180,6 @@ A line ending with \ will be concatenated with the next one, so long lines
      - -
    • allowfrom
      - Comma (,) separated list of ip-addresses or hostnames. If set, - only connections from these addresses are allowed. -

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

      • + +
    • motd
      + 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 +

      • +
    • mseclog
      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.

      • - -
    • port
      - Listen on the TCP/IP port <number> 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.

      - This attribute is optional starting with fhem 5.3.

      - To use IPV6, specify the port as IPV6:<number>, 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. -

      • - - -
    • portpassword
      - 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:
      - - attr global portpassword secret
      - attr global portpassword {use FritzBoxUtils;;FB_checkPw("localhost","$password") } -       -

      • - -
    • statefile
      @@ -5148,8 +5122,6 @@ A line ending with \ will be concatenated with the next one, so long lines

      POKEYS

        - -
        The POKEYS module is used to control the LAN POKEYS device (POKEYS56e) 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. @@ -5214,7 +5186,6 @@ A line ending with \ will be concatenated with the next one, so long lines todo

        - @@ -8544,10 +8515,11 @@ KlikAanKlikUit, NEXA, CHACON, HomeEasy UK.
        You need to define an RFXtrx433
      • HTTPS
        - 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 - module.
        + apt-get install libio-socket-ssl-perl; OSX and the FritzBox-7390 + already have this module.
        + A local certificate has to be generated into a directory called certs, this directory must be in the modpath directory, at the same level as the FHEM directory. @@ -8559,6 +8531,11 @@ KlikAanKlikUit, NEXA, CHACON, HomeEasy UK.
        You need to define an RFXtrx433

        • +
      • allowfrom
        • +
        +
      • loglevel
        • +
        +
      • stylesheetPrefix
        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.
        You need to define an RFXtrx433 + +

        telnet

        +
          +
          + + Define +
            + define <name> telnet <portNumber> [global] +

            + + Listen on the TCP/IP port <portNumber> for incoming + connections. If the second parameter global is not specified, + the server will only listen to localhost connections. +

            + + To use IPV6, specify the portNumber as IPV6:<number>, 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. +

            + Examples: +
              + define tPort telnet 7072 global
              + attr tPort globalpasswort mySecret
              + attr tPort SSL
              +
            +
            + 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. +
          +
          + + + + Set
            N/A

          + + + Get
            N/A

          + + + Attributes: +
            +
          • loglevel
            • +
            + + +
          • password
            + 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:
            + + attr tPort password secret
            + attr tPort password {use FritzBoxUtils;;FB_checkPw("localhost","$password") } +             +

            + + +
          • globalpassword
            + Just like the attribute password, but a password will only required for + non-local connections. +

            + + +
          • SSL
            + Enable SSL encryption of the connection, see the description here on generating the needed SSL certificates. To + connect to such a port use one of the following commands: +
              + socat openssl:fhemhost:fhemport,verify=0 readline
              + ncat --ssl fhemhost fhemport
              + openssl s_client -connect fhemhost:fhemport
              +
            +

            + + +
          • allowfrom
            + Regexp of allowed ip-addresses or hostnames. If set, + only connections from these addresses are allowed. +

            + +
          + +
        + +

        DbLog

          diff --git a/fhem.pl b/fhem.pl index d6a66f95b..d865e4983 100755 --- a/fhem.pl +++ b/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 " . - "modpath nrarchive pidfilename port portpassword statefile title userattr " . + "archivecmd apiversion archivedir configfile lastinclude logfile " . + "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); - die "Can't connect to $addr\n" if(!$server); - syswrite($server, "$ARGV[1] ; quit\n"); - shutdown($server, 1); - while(sysread($server, $buf, 256) > 0) { + my $client = IO::Socket::INET->new(PeerAddr => $addr); + die "Can't connect to $addr\n" if(!$client); + syswrite($client, "$ARGV[1] ; quit\n"); + shutdown($client, 1); + 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" - if(!$attr{global}{motd} || $attr{global}{motd} =~ m/^SecurityCheck/); +my $gp = $attr{global}{port}; +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". - "or restart fhem for a new check if the problem ist fixed.\n" - if($attr{global}{motd} =~ m/^SecurityCheck:\n\n./); -delete($attr{global}{motd}) if($attr{global}{motd} eq "SecurityCheck:\n\n"); + "\nRestart 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/^$sc_text\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; - return "Bye..." if($client{$cl}{prompt}); + $cl->{rcvdQuit} = 1; + 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 [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; - } + return if(!$cl); + my $name = $cl->{NAME}; return "Usage: inform {on|timer|raw|off} [regexp]" if($param !~ m/^(on|off|raw|timer)/); - delete($client{$cl}{inform}); - delete($client{$cl}{informRegexp}); + delete($inform{$name}); 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 - next if(!$client{$c}{inform} || $client{$c}{inform} eq "raw"); + foreach my $c (keys %inform) { + 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}, - ($client{$c}{inform} eq "timer" ? "$tn " : "") . + syswrite($defs{$c}{CD}, + ($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) { - next if(!$client{$c}{inform} || $client{$c}{inform} ne "raw"); - syswrite($client{$c}{fd}, "$hash->{TYPE} $name $dmsg\n"); + foreach my $c (keys %inform) { + if(!$defs{$c} || $defs{$c}{NR} != $inform{$c}{NR}) { + delete($inform{$c}); + next; + } + next if($inform{$c}{type} ne "raw"); + syswrite($defs{$c}{CD}, "$hash->{TYPE} $name $dmsg\n"); } } diff --git a/webfrontend/pgm2/01_FHEMWEB.pm b/webfrontend/pgm2/01_FHEMWEB.pm index 78c859e80..f246eaba8 100755 --- a/webfrontend/pgm2/01_FHEMWEB.pm +++ b/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_jsonp; +my $FW_XHR; # Data only answer, no HTML +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 FHEMWEB [global]" + return "Usage: define FHEMWEB [IPV6:] [global]" if($port !~ m/^(IPV6:)?\d+$/ || ($global && $global ne "global")); - if($port =~ m/^IPV6:(\d+)$/i) { - $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; + return TcpServer_Open($hash, $port, $global); } ##################################### @@ -179,20 +146,7 @@ sub FW_Undef($$) { my ($hash, $arg) = @_; - my $name = $hash->{NAME}; - - 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; + return TcpServer_Close($hash); } ##################################### @@ -203,54 +157,11 @@ FW_Read($) my $name = $hash->{NAME}; if($hash->{SERVERSOCKET}) { # Accept and create a child - - 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}"); + TcpServer_Accept($hash, "FHEMWEB"); 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"; - if($@) { - Log 1, $@; - Log 1, "Can't load IO::Socket::SSL, falling back to HTTP"; - } else { - $hash->{SSL} = 1; - } + TcpServer_SetSSL($hash); } return undef; } @@ -2217,4 +2115,5 @@ WeatherAsHtml($) return $ret; } + 1;