TR064Utils.pm: first check in, Forum #38395

git-svn-id: https://svn.fhem.de/fhem/trunk@15434 2b470e98-0d58-463d-a4d8-8e2adae1ed80

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: TR064Utils.pm added
   - changed: 88_HMCCU: Improved attributes ccureadingfilter, stripnumber
   - feature: 89_FULLY: New commands for motion detection and brightness
   - update:  98_Siro.pm: add Disable attribute

fhem/FHEM/HttpUtils.pm

@@ -293,7 +293,7 @@ HttpUtils_Connect($)
   $hash->{displayurl} = $hash->{hideurl} ? "<hidden>" : $hash->{url};
   $hash->{sslargs}    = {} if(!defined($hash->{sslargs}));
 
-  Log3 $hash, $hash->{loglevel}, "HttpUtils url=$hash->{displayurl}";
+  Log3 $hash, $hash->{loglevel}+1, "HttpUtils url=$hash->{displayurl}";
 
   if($hash->{url} !~ /
       ^(http|https):\/\/                # $1: proto
@@ -798,7 +798,7 @@ HttpUtils_ParseAnswer($)
   }
 
   # Debug
-  Log3 $hash, $hash->{loglevel},
+  Log3 $hash, $hash->{loglevel}+1,
     "HttpUtils $hash->{displayurl}: Got data, length: ". length($ret);
   Log3 $hash, $hash->{loglevel}+1,
     "HttpUtils response header:\n$hash->{httpheader}" if($hash->{httpheader});

fhem/FHEM/TR064Utils.pm

@@ -0,0 +1,107 @@
+##############################################
+# $Id$
+
+package main;
+
+use strict;
+use warnings;
+use Digest::MD5;
+use HttpUtils;
+use Data::Dumper;
+sub TR064_Action($);
+
+# Demo/Examples, result is written into the FHEM-log
+# FHEM-Modules have to use TR064_Action directly
+# { setKeyValue("TR064_user", "replaceMe") }
+# { setKeyValue("TR064_password", "replaceMe") }
+#
+# { TR064Cmd("DeviceInfo:1", "GetSecurityPort") }
+# { TR064Cmd("WANCommonInterfaceConfig:1", "GetCommonLinkProperties") }
+# { TR064Cmd("Time:1", "GetInfo") }
+# { TR064Cmd("X_AVM-DE_OnTel:1", "GetPhoneBook", {NewPhonebookID=>0}) }
+# { TR064Cmd("X_AVM-DE_Homeauto:1", "GetGenericDeviceInfos", {NewIndex=>0}) }
+
+sub
+TR064Cmd($$;$)
+{
+  my ($serviceType, $action, $param) = @_;
+  my $usr = getKeyValue("TR064_user");
+  my $pwd = getKeyValue("TR064_password");
+  TR064_Action({
+    server => sprintf('http://%s:%s@fritz.box:49000', 
+                      urlEncode($usr),urlEncode($pwd)),
+    serviceType => "urn:dslforum-org:service:$serviceType",
+    action => $action,
+    param => $param,
+    retFn => sub { Log 1, $_[1] ? $_[1] : Dumper($_[2]); }
+  });
+
+}
+
+my $tr064_es   = "http://schemas.xmlsoap.org/soap/encoding/";
+my $tr064_ns   = "http://schemas.xmlsoap.org/soap/envelope/";
+my $tr064_auth = "http://soap-authentication.org/digest/2001/10/";
+
+sub
+TR064_Action($)
+{
+  my ($hash) = @_;
+
+  my $retFn = sub {
+    my ($hash, $err, $data) = @_;
+    delete $hash->{callback};
+    delete $hash->{data};
+    delete $hash->{header};
+    delete $hash->{httpheader};
+    return &{$hash->{retFn}}($hash, $err, $data);
+  };
+
+  $hash->{digest} = 1;
+  if(!$hash->{control_url} || !$hash->{control_url}{$hash->{serviceType}}) {
+    $hash->{url} = $hash->{server}."/tr64desc.xml";
+    $hash->{callback} = sub($$$) {
+      my ($par, $err, $data) = @_;
+      return &$retFn($hash, "GET tr64desc.xml: $err") if($err);
+      my $pattern = "\<serviceType\>(.*?)\<\/serviceType\>.*?"
+                  . "\<controlURL\>(.*?)\<\/controlURL\>";
+      $data =~ s/$pattern/$hash->{control_url}{$1} = $2/sge;
+      if(!$hash->{control_url} || !$hash->{control_url}{$hash->{serviceType}}) {
+        return &$retFn($hash,"$hash->{server} offers no $hash->{serviceType}");
+      }
+      TR064_Action($hash);
+    };
+    return HttpUtils_NonblockingGet($hash);
+  }
+
+  my $param="";
+  $param = join("", map {"<$_>$hash->{param}{$_}</$_>"} keys %{$hash->{param}})
+    if($hash->{param});
+
+  $hash->{data} = <<EOD;
+    <?xml version="1.0" encoding="utf-8"?>
+    <s:Envelope s:encodingStyle="$tr064_es" xmlns:s="$tr064_ns">
+      <s:Body>
+        <u:$hash->{action} xmlns:u="$hash->{serviceType}">
+          $param
+        </u:$hash->{action}>
+      </s:Body>
+    </s:Envelope>
+EOD
+
+  $hash->{url} = $hash->{server}.$hash->{control_url}{$hash->{serviceType}};
+  $hash->{method} = "POST";
+  $hash->{header} = "SOAPACTION: $hash->{serviceType}#$hash->{action}\r\n".
+                    "Content-Type: text/xml; charset=utf-8";
+
+  $hash->{callback} = sub($$$) {
+    my ($par, $err, $data) = @_;
+    return &$retFn($hash, "POST $err") if($err);
+    my %ret; # Quick&Dirty: Extract Tags, 1st. level only
+    $data =~ s/.*<s:Body>//s;
+    $data =~ s,<([^\n\r/>]+)>([^<\n\r]+)<,$ret{$1}=$2;,ge;
+    return &$retFn($hash, undef, \%ret);
+  };
+  return HttpUtils_NonblockingGet($hash);
+}
+ 
+1;

fhem/MAINTAINER.txt

@@ -495,6 +495,7 @@ FHEM/SHC_parser.pm           rr2000               Sonstige Systeme
 FHEM/SubProcess.pm           neubert              FHEM Development
 FHEM/TcpServerUtils.pm       rudolfkoenig         Automatisierung
 FHEM/TimeSeries.pm           neubert     /jensb   FHEM Development
+FHEM/TR064Utils.pm           rudolfkoenig         Automatisierung
 FHEM/UConv.pm                loredo               FHEM Development
 FHEM/Unit.pm                 loredo               FHEM Development
 FHEM/YahooWeatherAPI.pm      neubert              Unterstuetzende Dienste/Wettermodule