FHEM/fhem-mirror
2
0
Fork 0
mirror of https://github.com/fhem/fhem-mirror.git synced 2025-01-31 12:49:34 +00:00
Code Issues Releases Wiki Activity

New telnet module and its consequences

Browse Source 
git-svn-id: https://svn.fhem.de/fhem/trunk@1638 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
rudolfkoenig 2012-06-23 16:22:28 +00:00
parent 5298c9df29
commit 2500cdcd33
7 changed files with 525 additions and 377 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
fhem/CHANGED
View File

@ -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
View 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
View 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;

2
fhem/TODO
View File

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

153
fhem/docs/commandref.html
View File

@ -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
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 &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>

269
fhem/fhem.pl
View File

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

137
fhem/webfrontend/pgm2/01_FHEMWEB.pm
View File

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