mirror of
https://github.com/fhem/fhem-mirror.git
synced 2025-01-31 06:39:11 +00:00
New telnet module and its consequences
git-svn-id: https://svn.fhem.de/fhem/trunk@1638 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
parent
5298c9df29
commit
2500cdcd33
@ -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
|
||||
|
190
fhem/FHEM/98_telnet.pm
Normal file
190
fhem/FHEM/98_telnet.pm
Normal file
@ -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;
|
150
fhem/FHEM/TcpServerUtils.pm
Normal file
150
fhem/FHEM/TcpServerUtils.pm
Normal file
@ -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;
|
@ -1,8 +1,6 @@
|
||||
FHEM:
|
||||
- FHEMWEB warning
|
||||
- finish updatefhem
|
||||
- autoload commands -> rename updatefhem, CULflash, etc
|
||||
|
||||
- FHEM2FHEM reconnect
|
||||
- HomeMatic set log 2
|
||||
- implement wiki decisions
|
||||
|
@ -28,7 +28,6 @@
|
||||
<br>
|
||||
<b>fhem commands</b>
|
||||
<ul>
|
||||
|
||||
<a href="#attr">attr</a>
|
||||
<a href="#backup">backup</a>
|
||||
<a href="#CULflash">CULflash</a>
|
||||
@ -167,6 +166,7 @@
|
||||
<a href="#notify">notify</a>
|
||||
<a href="#sequence">sequence</a>
|
||||
<a href="#structure">structure</a>
|
||||
<a href="#telnet">telnet</a>
|
||||
<a href="#watchdog">watchdog</a>
|
||||
<a href="#weblink">weblink</a>
|
||||
|
||||
@ -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><number></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:<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.
|
||||
</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.
|
||||
@ -5214,7 +5186,6 @@ A line ending with \ will be concatenated with the next one, so long lines
|
||||
todo <br>
|
||||
</ul>
|
||||
<br>
|
||||
</ul>
|
||||
</ul>
|
||||
|
||||
<a name="VantagePro2"></a>
|
||||
@ -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
|
||||
module.<br>
|
||||
apt-get install libio-socket-ssl-perl; OSX and the FritzBox-7390
|
||||
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 <name> telnet <portNumber> [global]</code>
|
||||
<br><br>
|
||||
|
||||
Listen on the TCP/IP port <code><portNumber></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:<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.
|
||||
<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>
|
||||
|
269
fhem/fhem.pl
269
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 " .
|
||||
"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 <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;
|
||||
}
|
||||
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");
|
||||
}
|
||||
}
|
||||
|
||||
|
@ -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 <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) {
|
||||
$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;
|
||||
|
Loading…
Reference in New Issue
Block a user