From ea6a2475c8417bd64e955be237c0df492671b09c Mon Sep 17 00:00:00 2001 From: tpoitzsch Date: Fri, 26 Jun 2015 09:24:42 +0000 Subject: [PATCH] FRITZBOX: get tr064ServiceList git-svn-id: svn://svn.code.sf.net/p/fhem/code/trunk@8832 2b470e98-0d58-463d-a4d8-8e2adae1ed80 --- fhem/FHEM/72_FRITZBOX.pm | 111 ++++++++++++++++++++++++++++++++++++--- 1 file changed, 103 insertions(+), 8 deletions(-) diff --git a/fhem/FHEM/72_FRITZBOX.pm b/fhem/FHEM/72_FRITZBOX.pm index 35e7e6b41..2dae9ddef 100644 --- a/fhem/FHEM/72_FRITZBOX.pm +++ b/fhem/FHEM/72_FRITZBOX.pm @@ -47,10 +47,11 @@ eval "use Net::Telnet;1" or $missingModulTelnet .= "Net::Telnet "; eval "use URI::Escape;1" or $missingModul .= "URI::Escape "; eval "use MIME::Base64;1" or $missingModul .= "MIME::Base64 "; +use FritzBoxUtils; ## only for web access login #sudo apt-get install libjson-perl eval "use JSON::XS;1" or $missingModulWeb .= "JSON::XS "; eval "use LWP::UserAgent;1" or $missingModulWeb .= "LWP::UserAgent "; -use FritzBoxUtils; ## only for web access login + eval "use URI::Escape;1" or $missingModulTR064 .= "URI::Escape "; # sudo apt-get install libsoap-lite-perl eval "use SOAP::Lite;1" or $missingModulTR064 .= "Soap::Lite "; @@ -519,7 +520,7 @@ sub FRITZBOX_Get($@) my ($hash, $name, $cmd, @val) = @_; my $returnStr; - if( lc $cmd eq "luaquery" && AttrVal( $name, "allowTR064Command", 0 ) ) { + if( lc $cmd eq "luaquery" && AttrVal( $name, "allowTR064Command", 0 ) && defined $hash->{SECPORT}) { # get Fritzbox luaQuery inetstat:status/Today/BytesReceivedLow # get Fritzbox luaQuery telcfg:settings/AlarmClock/list(Name,Active,Time,Number,Weekdays) Log3 $name, 3, "FRITZBOX: get $name $cmd ".join(" ", @val); @@ -579,10 +580,14 @@ sub FRITZBOX_Get($@) $returnStr .= $tmp; return $returnStr; } - + elsif( lc $cmd eq "tr064servicelist" ) { + return FRITZBOX_TR064_Get_ServiceList ($hash); + } + my $list = "ringTones:noArg"; $list .= " luaQuery" if AttrVal( $name, "allowTR064Command", 0 ); - $list .= " tr064Command" if AttrVal( $name, "allowTR064Command", 0 ); + $list .= " tr064Command" if AttrVal( $name, "allowTR064Command", 0 ) && defined $hash->{SECPORT};; + $list .= " tr064ServiceList:noArg" if AttrVal( $name, "allowTR064Command", 0 ); $list .= " shellCommand" if AttrVal( $name, "allowShellCommand", 0 ); return "Unknown argument $cmd, choose one of $list"; } # end FRITZBOX_Get @@ -1410,9 +1415,11 @@ sub FRITZBOX_Readout_Process($$) # Statistics if ( defined $values{".box_TodayBytesReceivedLow"} && defined $hash->{READINGS}{".box_TodayBytesReceivedLow"}) { my $valueHigh = $values{".box_TodayBytesReceivedHigh"} - $hash->{READINGS}{".box_TodayBytesReceivedHigh"}{VAL}; - my $time = time()-time_str2num($hash->{READINGS}{".box_TodayBytesReceivedLow"}{TIME}); + $valueHigh *= 2**22; my $valueLow = $values{".box_TodayBytesReceivedLow"} - $hash->{READINGS}{".box_TodayBytesReceivedLow"}{VAL};; - readingsBulkUpdate( $hash, "box_rateDown", sprintf ("%.3f", ($valueHigh*2**22+$valueLow/2**10) / $time )); + $valueLow /= 2**10; + my $time = time()-time_str2num($hash->{READINGS}{".box_TodayBytesReceivedLow"}{TIME}); + readingsBulkUpdate( $hash, "box_rateDown", sprintf ("%.3f", ($valueHigh+$valueLow) / $time )); } if ( defined $values{".box_TodayBytesSentLow"} && defined $hash->{READINGS}{".box_TodayBytesSentLow"}) { my $valueHigh = $values{".box_TodayBytesSentHigh"} - $hash->{READINGS}{".box_TodayBytesSentHigh"}{VAL}; @@ -3566,6 +3573,94 @@ sub FRITZBOX_TR064_Cmd($$$) } # End of FRITZBOX_TR064_Cmd +################################################# +# get Fritzbox tr064servicelist +sub FRITZBOX_TR064_Get_ServiceList($) +{ + my ($hash) = @_; + my $name = $defs{NAME}; + + + if ( $missingModulWeb ) { + my $msg = "Error: Perl modul " . $missingModulWeb . "is missing on this system. Please install before using this modul."; + FRITZBOX_Log $hash, 2, $msg; + return $msg; + } + + my $host = AttrVal( $name, "fritzBoxIP", "fritz.box" ); + my $url = 'http://'.$host.":49000/tr64desc.xml"; + + my $returnStr = "TR-064 service actions on the device '$host'\n"; + + FRITZBOX_Log $hash, 5, "Getting service page $url"; + my $agent = LWP::UserAgent->new( env_proxy => 1, keep_alive => 1, protocols_allowed => ['http'], timeout => 10); + my $response = $agent->get( $url ); + + return "$url does not exist" if $response->is_error(); + + my $content = $response->content; + my @serviceArray; + +# Get basic service data + while( $content =~ /(.*?)<\/service>/isg ) { + my $serviceXML = $1; + my @service; + my $service = $1 if $serviceXML =~ m/urn:dslforum-org:service:(.*?)<\/servicetype>/is; + my $control = $1 if $serviceXML =~ m/\/upnp\/control\/(.*?)<\/controlurl>/is; + my $scpd = $1 if $serviceXML =~ m/(.*?)<\/scpdurl>/is; + + push @serviceArray, [$service, $control, $scpd]; + } + +# Get actions of each service + foreach (@serviceArray) { + + $returnStr .= "_" x 100 ."\n\n"; + $returnStr .= "Service: '$_->[0]' Control: '$_->[1]' XML: '$_->[2]'\n"; + $returnStr .= "-" x 100 ."\n"; + + $url = 'http://'.$host.":49000".$_->[2]; + + FRITZBOX_Log $hash, 5, "Getting action page $url"; + my $agent = LWP::UserAgent->new( env_proxy => 1, keep_alive => 1, protocols_allowed => ['http'], timeout => 10); + my $response = $agent->get( $url ); + + return "ServiceSCPD $url does not exist" if $response->is_error(); + + my $content = $response->content; + while( $content =~ /(.*?)<\/action>/isg ) { + + my $serviceXML = $1; + $serviceXML =~ /(.*?)<\/name>/is; + my $action = $1; + $serviceXML =~ /(.*?)<\/argumentlist>/is; + my $argXML = $1; + + $returnStr .= "$action ("; + + my @argArray = ($argXML =~ /(.*?)<\/argument>/isg); + my @argOut; + foreach (@argArray) { + $_ =~ /(.*?)<\/name>/is; + my $argName = $1; + $_ =~ /(.*?)<\/direction>/is; + my $argDir = $1; + if ($argDir eq "in") { $returnStr .= " $argName"; } + else { push @argOut, $argName; } + } + $returnStr .= " )"; + $returnStr .= " = (" if int @argOut; + foreach (@argOut) { + $returnStr .= " $_"; + } + $returnStr .= " )" if int @argOut; + $returnStr .= "\n"; + } + } + + return $returnStr; +} + # Opens a Web connection to an external Fritzbox ############################################ sub FRITZBOX_Web_OpenCon ($) @@ -4055,7 +4150,7 @@ sub FRITZBOX_fritztris($) It needs to be the name of the path on the Fritz!Box. So, it should start with /var/InternerSpeicher if it equals in Windows \\ip-address\fritz.nas
-
  • forceTelnet <0 | 1> +
  • forceTelnetConnection <0 | 1>
    Always use telnet for remote access (instead of access via the WebGUI or TR-064).
    @@ -4359,7 +4454,7 @@ sub FRITZBOX_fritztris($) Es muss ein Pfad auf der Fritz!Box sein. D.h., er sollte mit /var/InternerSpeicher starten, wenn es in Windows unter \\ip-address\fritz.nas erreichbar ist.

    • -
  • forceTelnet <0 | 1> +
  • forceTelnetConnection <0 | 1>
    Erzwingt den Fernzugriff über Telnet (anstatt über die WebGUI oder TR-064).