################################################################
#
#
# 02_FTUISRV.pm
#
# written by Johannes Viegener
# based on 02_HTTPSRV written by Dr. Boris Neubert 2012-08-27
#
# This file is part of Fhem.
#
# Fhem is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
#
# Fhem is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Fhem. If not, see .
#
##############################################################################
################################################################
#
# FTUISRV https://github.com/viegener/Telegram-fhem/ftuisrv
#
# This module provides a mini HTTP server plugin for FHEMWEB for the specific use with FTUI or new FHEM tablet UI
#
# It serves files from a given directory and parses them according to specific rules.
# The goal is to be able to create reusable elements of multiple widgets and
# surrounding tags on multiple pages and even with different devices or other
# modifications. Therefore changes to the design have to be done only at one place
# and not at every occurence of the template (called parts in this doc).
#
# Discussed in FHEM Forum: https://forum.fhem.de/index.php/topic,43110.0.html
#
# $Id$
#
##############################################################################
# 0.0 Initial version FTUIHTTPSRV
# enable include und key value replacement
# also recursive operation
# show missing key definitions
# 0.1 - First working version FTUISRV
#
# check and warn for remaining keys
# added header for includes also for defining default values
# changed key replacement to run through all content instead of list of keys
# removed all callback elements
# allow device content readings (and perl commands) in header
# add validateFiles / validateResult as attributes for HTML validation
# validate for HTML and part files
# validate a specific file only once (if unchanged)
# validate* 1 means only errors/warnings / 2 means also opening and closing being logged
# documentation for validate* added
# 0.2 - Extended by validation of html, device data and default values (header)
#
# add documentation for device readings (set logic)
# allow reading values also in inc tag
# 0.3 - 2016-04-25 - Version for publication in SVN
#
# Allow replacements setp by step in headerline --> ?> must be escaped to ?\>
# added if else endif for segments ftui-if=( )
# simplified keyvalue parsing
# simplified include in separate sub
# add loopinc for looping include multiple times loopinc="" =( )
# summary for commandref
# added if and loopinc to commandref
# add new attribute for defining special template urls templateFiles
# allow spaces around = and after for more tolerance
# do not require space at end of tag before ?> for more tolerance
# more tolerance on spaces around =
# doc change on ftui-if
# FIX: changed replaceSetmagic to hand over real device hash
# FIX: $result might be undefined in some cases for loop/if
#
################################################################
#TODO:
#
#
# deepcopy only if new keys found
#
##############################################
#
# ATTENTION: filenames need to have .ftui. before extension to be parsed
#
#
################################################################
package main;
use strict;
use warnings;
use vars qw(%data);
use File::Basename;
#use HttpUtils;
my $FTUISRV_matchlink = "^\/?(([^\/]*(\/[^\/]+)*)\/?)\$";
my $FTUISRV_matchtemplatefile = "^.*\.ftui\.[^\.]+\$";
my $FTUISRV_ftuimatch_header = '<\?\s*ftui-header\s*=\s*"([^"\?]*)"\s+(.*?)\?>';
my $FTUISRV_ftuimatch_keysegment = '^\s*([^=\s]+)(\s*=\s*"([^"]*)")?\s*';
my $FTUISRV_ftuimatch_keygeneric = '<\?\s*ftui-key\s*=\s*([^\s\?]+)\s*\?>';
my $FTUISRV_ftuimatch_if_het = '^(.*?)<\?\s*ftui-if\s*=\s*\((.*?)\)\s*\?>(.*)$';
my $FTUISRV_ftuimatch_else_ht = '^(.*?)<\?\s*ftui-else\s*\?>(.*)$';
my $FTUISRV_ftuimatch_endif_ht = '^(.*?)<\?\s*ftui-endif\s*\?>(.*)$';
my $FTUISRV_ftuimatch_inc_hfvt = '^(.*?)<\?\s*ftui-inc\s*=\s*"([^"\?]+)"\s+([^\?]*)\?>(.*?)$';
my $FTUISRV_ftuimatch_loopinc_hfkevt = '^(.*?)<\?\s*ftui-loopinc\s*=\s*"([^"\?]+)"\s+([^=\s]+)\s*=\s*\((.+?)\)\s+([^\?]*)\?>(.*?)$';
#########################
# FORWARD DECLARATIONS
sub FTUISRV_handletemplatefile( $$$$ );
sub FTUISRV_validateHtml( $$$$ );
sub FTUISRV_handleIf( $$$ );
#########################
sub
FTUISRV_addExtension($$$$) {
my ($name,$func,$link,$friendlyname)= @_;
# do some cleanup on link/url
# link should really show the link as expected to be called (might include trailing / but no leading /)
# url should only contain the directory piece with a leading / but no trailing /
# $1 is complete link without potentially leading /
# $2 is complete link without potentially leading / and trailing /
$link =~ /$FTUISRV_matchlink/;
my $url = "/".$2;
my $modlink = $1;
Log3 $name, 3, "Registering FTUISRV $name for URL $url and assigned link $modlink ...";
$data{FWEXT}{$url}{deviceName}= $name;
$data{FWEXT}{$url}{FUNC} = $func;
$data{FWEXT}{$url}{LINK} = $modlink;
$data{FWEXT}{$url}{NAME} = $friendlyname;
}
sub
FTUISRV_removeExtension($) {
my ($link)= @_;
# do some cleanup on link/url
# link should really show the link as expected to be called (might include trailing / but no leading /)
# url should only contain the directory piece with a leading / but no trailing /
# $1 is complete link without potentially leading /
# $2 is complete link without potentially leading / and trailing /
$link =~ /$FTUISRV_matchlink/;
my $url = "/".$2;
my $name= $data{FWEXT}{$url}{deviceName};
Log3 $name, 3, "Unregistering FTUISRV $name for URL $url...";
delete $data{FWEXT}{$url};
}
##################
sub
FTUISRV_Initialize($) {
my ($hash) = @_;
$hash->{DefFn} = "FTUISRV_Define";
$hash->{UndefFn} = "FTUISRV_Undef";
$hash->{AttrList} = "directoryindex templateFiles ".
"readings validateFiles:0,1,2 validateResult:0,1,2 ";
$hash->{AttrFn} = "FTUISRV_Attr";
#$hash->{SetFn} = "FTUISRV_Set";
return undef;
}
##################
sub
FTUISRV_Define($$) {
my ($hash, $def) = @_;
my @a = split("[ \t]+", $def, 6);
return "Usage: define FTUISRV " if(( int(@a) < 5) );
my $name= $a[0];
my $infix= $a[2];
my $directory= $a[3];
my $friendlyname;
$friendlyname = $a[4].(( int(@a) == 6 )?" ".$a[5]:"");
$hash->{fhem}{infix}= $infix;
$hash->{fhem}{directory}= $directory;
$hash->{fhem}{friendlyname}= $friendlyname;
Log3 $name, 3, "$name: new ext defined infix:$infix: dir:$directory:";
FTUISRV_addExtension($name, "FTUISRV_CGI", $infix, $friendlyname);
$hash->{STATE} = $name;
return undef;
}
##################
sub
FTUISRV_Undef($$) {
my ($hash, $name) = @_;
FTUISRV_removeExtension($hash->{fhem}{infix});
return undef;
}
##################
sub
FTUISRV_Attr(@)
{
my ($cmd,$name,$aName,$aVal) = @_;
if ($cmd eq "set") {
if ($aName =~ "readings") {
if ($aVal !~ /^[A-Z_a-z0-9\,]+$/) {
Log3 $name, 2, "$name: Invalid reading list in attr $name $aName $aVal (only A-Z, a-z, 0-9, _ and , allowed)";
return "Invalid reading name $aVal (only A-Z, a-z, 0-9, _ and , allowed)";
}
addToDevAttrList($name, $aName);
} elsif ($aName =~ "validateFiles") {
$attr{$name}{'validateFiles'} = (($aVal eq "2")? "2": (($aVal eq "1")? "1": "0"));
} elsif ($aName =~ "validateResult") {
$attr{$name}{'validateResult'} = (($aVal eq "2")? "2": (($aVal eq "1")? "1": "0"));
}
}
return undef;
}
##################
#
# here we answer any request to http://host:port/fhem/$infix and below
sub FTUISRV_CGI() {
my ($request) = @_; # /$infix/filename
# Debug "request= $request";
Log3 undef, 4, "FTUISRV: Request to FTUISRV :$request:";
# Match request first without trailing / in the link part
if($request =~ m,^(/[^/]+)(/([^\?]*)?)?(\?([^#]*))?$,) {
my $link= $1;
my $filename= $3;
my $qparams= $5;
my $name;
# If FWEXT not found for this make a second try with a trailing slash in the link part
if(! $data{FWEXT}{$link}) {
$link = $link."/";
return("text/plain; charset=utf-8", "Illegal request: $request") if(! $data{FWEXT}{$link});
}
# get device name
$name= $data{FWEXT}{$link}{deviceName};
# get corresponding hash
my $hash = $defs{$name};
# check system / device loglevel
my $logLevel = $attr{global}{verbose};
$logLevel = $attr{$name}{verbose} if ( defined( $attr{$name}{verbose} ) );
# Log3 undef, 3, "FTUISRV: Request to FTUISRV :$request:";
if ( 4 <= $logLevel ) {
if ( ( $request =~ /index.html/ ) || ( $request =~ /\/$/ ) ) {
Log3 $name, 4, "FTUISRV: request to FTUISRV :$request: Header :".join("\n",@FW_httpheader).":";
}
}
# Debug "link= ".((defined($link))?$link:"");
# Debug "filename= ".((defined($filename))?$filename:"");
# Debug "qparams= ".((defined($qparams))?$qparams:"");
# Debug "name= $name";
if ( ! $name ) {
Log3 undef, 1, "FTUISRV: Request to FTUISRV but no link found !! :$request:";
}
# return error if no such device
return("text/plain; charset=utf-8", "No FTUISRV device for $link") unless($name);
my $fullName = $filename;
foreach my $reading (split (/,/, AttrVal($name, "readings", ""))) {
my $value = "";
if ($fullName =~ /^([^\?]+)\?(.*)($reading)=([^;&]*)([&;].*)?$/) {
$filename = $1;
$value = $4;
Log3 $name, 5, "$name: set Reading $reading = $value";
readingsSingleUpdate($hash, $reading, $value, 1);
}
};
Log3 $name, 5, "$name: Request to :$request:";
$filename= AttrVal($name,"directoryindex","index.html") unless($filename);
my $MIMEtype= filename2MIMEType($filename);
my $directory= $defs{$name}{fhem}{directory};
$filename= "$directory/$filename";
#Debug "read filename= $filename";
return("text/plain; charset=utf-8", "File not found: $filename") if(! -e $filename );
my $parhash = {};
my $validatehash = {};
my ($err, $validated, $content) = FTUISRV_handletemplatefile( $hash, $filename, $parhash, $validatehash );
# Validate HTML Result after parsing
my $validate = AttrVal($name,'validateResult',0);
if ( ( $validate ) && ( ( $filename =~ /\.html?$/i ) || ( $filename =~ /\.part?$/i ) ) && ( ! $validated ) ) {
FTUISRV_validateHtml( $hash, $content, $validate, $filename );
}
return("text/plain; charset=utf-8", "Error in filehandling: $err") if ( defined($err) );
return("$MIMEtype; charset=utf-8", $content);
} else {
return("text/plain; charset=utf-8", "Illegal request: $request");
}
}
##############################################
##############################################
##
## validate HTML
##
##############################################
##############################################
##################
#
# validate HTML according to basic criteria
# should be best build with HTML::Parser (cpan) --> allows also to parse processing instructions
# example: 23_KOSTALPIKO.pm
# comments correctly closed
# build tag dictionary / array
# optional: check FTUI
sub FTUISRV_validateHtml( $$$$ ) {
my ($hash, $content, $validateLevel, $filename ) = @_;
my $name = $hash->{NAME};
# state: 0: normal / 1: in tag / 2: in comment / 3: in quotes / 4: in dquotes / 5: in ptag
#
# tags contains
# as end of tag
# handle no close tags ==> meta, img
# handle doctype with as in processing tag no end
# pushtag / poptag add prefix FTUISRV_
Log3 $name, (( $validateLevel > 1 )?1:4), "$name: validate parsed HTML for request :$filename:";
$content .= " ";
my $state = 0;
my $line = 1;
my $pos = 0;
my $slen = length( $content );
my @tags = ();
my @tagline= ();
my $ctag = "";
while ( $pos < $slen ) {
my $ch = substr( $content, $pos, 1 );
$pos++;
# Processing tag
if ( $state == 5 ) {
if ( $ch eq "\\" ) {
$pos++;
} elsif ( $ch eq "\"" ) {
pushTag( \@tags, \@tagline, "", $line );
$state = 4;
} elsif ( $ch eq "\'" ) {
$state = 3;
pushTag( \@tags, \@tagline, "", $line );
} elsif ( ( $ch eq "?" ) && ( substr( $content, $pos, 1 ) eq ">" ) ) {
Log3( $name, 1, "<< Leave Processing Tag: #$line" ) if ( $validateLevel > 1 );
$pos++;
( $state, $ctag ) = popTag( \@tags, \@tagline );
}
# quote tags
} elsif ( $state >= 3 ) {
if ( $ch eq "\\" ) {
$pos++;
} elsif ( ( $ch eq "\"" ) && ( $state == 4 ) ){
( $state, $ctag ) = popTag( \@tags, \@tagline );
# Debug "New state $state #$line";
} elsif ( $ch eq "\"" ) {
pushTag( \@tags, \@tagline, "\'", $line );
$state = 4;
} elsif ( ( $ch eq "\'" ) && ( $state == 3 ) ){
( $state, $ctag ) = popTag( \@tags, \@tagline );
} elsif ( $ch eq "\'" ) {
$state = 3;
pushTag( \@tags, \@tagline, "\"", $line );
}
# comment tag
} elsif ( $state == 2 ) {
if ( ( $ch eq "-" ) && ( substr( $content, $pos, 2 ) eq "->" ) ) {
$pos+=2;
Log3( $name, 1, "<< Leave Comment: #$line" ) if ( $validateLevel > 1 );
( $state, $ctag ) = popTag( \@tags, \@tagline );
}
# in tag
} elsif ( $state == 1 ) {
if ( $ch eq "\"" ) {
pushTag( \@tags, \@tagline, $ctag, $line );
# Debug "Go to state 4 #$line";
$state = 4;
} elsif ( $ch eq "\'" ) {
pushTag( \@tags, \@tagline, $ctag, $line );
$state = 3;
} elsif ( ( $ch eq "<" ) && ( substr( $content, $pos, 1 ) eq "?" ) ) {
pushTag( \@tags, \@tagline, $ctag, $line );
$pos++;
$state = 5;
} elsif ( ( $ch eq "<" ) && ( substr( $content, $pos, 3 ) eq "!--" ) ) {
pushTag( \@tags, \@tagline, $ctag, $line );
$pos+=2;
$state = 2;
} elsif ( $ch eq "<" ) {
Log3( $name, 1, "FTUISRV_validate: Warning Spurious < in $filename (line $line)" );
} elsif ( ( $ch eq "/" ) && ( substr( $content, $pos, 1 ) eq ">" ) ) {
my $dl = $tagline[$#tagline];
( $state, $ctag ) = popTag( \@tags, \@tagline );
Log3( $name, 1, "<< end tag directly :$ctag: #$line" ) if ( $validateLevel > 1 );
# correct state (outside tag)
$state = 0;
} elsif ( $ch eq ">" ) {
my $dl = $tagline[$#tagline];
( $state, $ctag ) = popTag( \@tags, \@tagline );
Log3( $name, 1, "-- start tag complete :$ctag: #$line" ) if ( $validateLevel > 1 );
# restore old tag start line
pushTag( \@tags, \@tagline, substr($ctag,1), $dl );
# correct state (outside tag)
$state = 0;
}
# out of everything
} else {
if ( ( $ch eq "<" ) && ( substr( $content, $pos, 1 ) eq "?" ) ) {
pushTag( \@tags, \@tagline, "", $line );
$pos++;
$state = 5;
Log3( $name, 1, ">> Enter Processing Tag #$line" ) if ( $validateLevel > 1 );
} elsif ( ( $ch eq "<" ) && ( substr( $content, $pos, 3 ) eq "!--" ) ) {
pushTag( \@tags, \@tagline, "", $line );
$pos+=2;
$state = 2;
Log3( $name, 1, ">> Enter Comment #$line" ) if ( $validateLevel > 1 );
} elsif ( ( $ch eq "<" ) && ( substr( $content, $pos, 1 ) eq "/" ) ) {
$pos++;
my $tag = "";
while ( $pos < $slen ) {
my $ch2 = substr( $content, $pos, 1 );
$pos++;
if ( $ch2 eq ">" ) {
last;
} elsif (( $ch2 eq "\n" ) || ( $ch2 eq " " ) || ( $ch2 eq "\t" ) ) {
$pos = $slen;
} else {
$tag .= $ch2;
}
}
if ( $pos >= $slen ) {
Log3( $name, 1, "FTUISRV_validate: Error incomplete tag :".(defined($tag)?$tag:"").": not finished with > in $filename (line $line)" );
@tags = 0;
} else {
Log3( $name, 1, "<< end tag $tag: #$line" ) if ( $validateLevel > 1 );
while ( scalar(@tags) > 0 ) {
my $ptag = pop( @tags );
my $pline = pop( @tagline );
if ( $ptag eq $tag ) {
Log3( $name, 1, "FTUISRV_validate: Warning void tag :".(defined($tag)?$tag:"").": unnecessarily closed $filename (opened in line $pline)" ) if ( FTUISRV_isVoidTag( $tag ) );
last;
} elsif ( scalar(@tags) == 0 ) {
Log3( $name, 1, "FTUISRV_validate: Error tag :".(defined($tag)?$tag:"").": closed but not open $filename (line $line)" );
$pos = $slen;
} else {
Log3( $name, 1, "FTUISRV_validate: Warning tag :".(defined($ptag)?$ptag:"").": not closed $filename (opened in line $pline)" )
if ( ! FTUISRV_isVoidTag( $ptag ) );
}
}
}
} elsif ( $ch eq "<" ) {
# identify tag
my $tag = "<";
while ( $pos < $slen ) {
my $ch2 = substr( $content, $pos, 1 );
$pos++;
if ( $ch2 eq ">" ) {
$pos--;
last;
} elsif (( $ch2 eq "\n" ) || ( $ch2 eq " " ) || ( $ch2 eq "\t" ) ) {
$pos--;
last;
} else {
$tag .= $ch2;
}
}
if ( $pos >= $slen ) {
Log3( $name, 1, "FTUISRV_validate: Warning start tag :".(defined($tag)?$tag:"").": not finished in $filename (line $line)" );
} else {
Log3( $name, 1, "<< start tag $tag: #$line" ) if ( $validateLevel > 1 );
$ctag = $tag;
$state = 1;
pushTag( \@tags, \@tagline, $ctag, $line );
}
}
}
$line++ if ( $ch eq "\n" );
# ???
# $pos = $slen if ( $line > 50 );
}
# remaining tags report
while ( scalar(@tags) > 0 ) {
my $ptag = pop( @tags );
my $pline = pop( @tagline );
Log3( $name, 1, "FTUISRV_validate: Warning tag :".(defined($ptag)?$ptag:"").": not closed $filename (opened in line $pline)" )
if ( ! FTUISRV_isVoidTag( $ptag ) );
}
}
##################
# Check if tag does not require an explicit end
sub FTUISRV_isVoidTag( $ ) {
my ($tag) = @_;
return ( index( " area base br col command embed hr img input link meta param source !DOCTYPE ", " ".$tag." " ) != -1 );
}
##############################################
sub pushTag( $$$$ ) {
my ( $ptags, $ptagline, $ch, $line ) = @_ ;
push( @{ $ptags }, $ch );
push( @{ $ptagline }, $line );
}
##############################################
sub popTag( $$ ) {
my ( $ptags, $ptagline ) = @_;
return (0, "") if ( scalar($ptags) == 0 );
my $ch = pop( @{ $ptags } );
my $line = pop( @{ $ptagline } );
my $state = 0;
# state: 0: normal / 1: in tag / 2: in comment / 3: in quotes / 4: in dquotes / 5: in ptag
if ( $ch eq "" ) {
$state = 0;
} elsif ( $ch eq "