diff --git a/fhem/CHANGED b/fhem/CHANGED index 199bf5b27..13b007dd1 100644 --- a/fhem/CHANGED +++ b/fhem/CHANGED @@ -1,5 +1,6 @@ # Add changes at the top of the list. Keep it in ASCII, and 80-char wide. # Do not insert empty lines here, update check depends on it. + - feature: new module 02_FTUISRV.pm for server side templates for tablet UI - feature: 30_pilight_switch: new attribute 'sendCount' to send the command n times. - feature: 98_rssFeed: creating some readings containing ticker data. diff --git a/fhem/FHEM/02_FTUISRV.pm b/fhem/FHEM/02_FTUISRV.pm new file mode 100644 index 000000000..2b4703a19 --- /dev/null +++ b/fhem/FHEM/02_FTUISRV.pm @@ -0,0 +1,936 @@ +################################################################ +# +# +# 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 +# +################################################################ +#TODO: +# +# Allow if for separate sections +# log count of replacements +# +# 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\.[^\.]+\$"; + +##### <\?ftui-inc="([^"\?]+)"\s+([^\?]*)\?> +my $FTUISRV_ftuimatch_inc = '<\?ftui-inc="([^"\?]+)"\s+([^\?]*)\?>'; + +#my $FTUISRV_ftuimatch_header = '<\?ftui-header="([^"\?]*)"\s+([^\?]*)\?>'; +my $FTUISRV_ftuimatch_header = '<\?ftui-header="([^"\?]*)"\s+(.*?)\?>'; + +my $FTUISRV_ftuimatch_keysegment = '^\s*([^=\s]+)(="([^"]*)")?\s*'; + +my $FTUISRV_ftuimatch_keygeneric = '<\?ftui-key=([^\s]+)\s*\?>'; + +######################### +# FORWARD DECLARATIONS + +sub FTUISRV_handletemplatefile( $$$$ ); +sub FTUISRV_validateHtml( $$$$ ); + + + + + + + +######################### +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 " . + "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}; + +# 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($defs{$name}, $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( $name, $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( $name, $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 ($name, $content, $validateLevel, $filename ) = @_; + + # 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, "" ) ) { + 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 "