################################################################ # # # 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 # 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, "" ) ) { 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 "