[wiregate] Fritz!Box steuern per Plugin

[coolrunnings]

Hallo zusammen!

Inspiriert von Amaridians "Fritz!Box als Türklingel" Plugin habe ich das Ganze noch etwas weiter getrieben.

Mit dem Plugin ist es rein theoretisch möglich jede Funktion die auf der Fritz!Box ausgeführt werden kann auch über den Bus auszuführen (z.B. Gast WLAN einschalten).

Das Plugin sieht folgendermaßen aus (ACHTUNG: Funktioniert nur mit Frys' Patch "vorkompilierte Plugins" und JuMi2006s' Erweiterung "abhängiges Plugin subscibe". Ich habe auch noch eine Version die mit dem Standard wiregated.pl funktioniert. Da komm ich nur gerade nicht dran. Stell die aber auch noch online.)

#!/usr/bin/perl
# COMPILE_PLUGIN
#
#################################################
# Fritz-Box PlugIn 
# This PlugIn enables the following functions:
# - Control WLAN
# - Control DECT
# - Control Answering Machine
# 
# Works only with Fritz OS >= 5.50
#
# (c) 2013 coolrunnings unter the GNU Public License
#################################################

use LWP;
use LWP::Simple;
use Digest::MD5 'md5_hex';

#################################################
# Variable Definition
# You should not change them here but in the config file
my $logging = 0;
my $updateInSec = 60;

my $fritz_ip = "";
my $fritz_user = "";
my $fritz_pw = "";

#################################################

$plugin_info{$plugname.'_cycle'} = $updateInSec;

#################################################
# Config file modified since last time?
my $conf="/etc/wiregate/plugin/generic/conf.d/$plugname"; 
$conf.='.conf' unless $conf=~s/\.pl$/.conf/;
unless(-f $conf)
{
    plugin_log($plugname, "Config err: $conf nicht gefunden.");
    exit;
}
my $configtime=24*60*60*(-M $conf);
my $config_modified = ($configtime < $plugin_info{$plugname.'_configtime'}-1);

#################################################
# Get Start Reason

my $event=undef;
if (!$plugin_initflag) { $event='restart'; } # Restart des daemons / Reboot
elsif ($plugin_info{$plugname.'_lastsaved'} > $plugin_info{$plugname.'_last'})
{ $event='modified'; } # Plugin modifiziert
#elsif (%msg) { $event='bus'; } # Bustraffic
elsif (%msg) { $event='bus'; return if !$config_modified && $msg{apci} eq "A_GroupValue_Response"; } # Bustraffic
elsif ($fh) { $event='socket'; } # Netzwerktraffic
else { $event='cycle'; } # Zyklus

#################################################
# Read Config File

if($event=~/restart|modified/ || $config_modified || !defined $plugin_cache{$plugname}{cfg_write_hash}) 
{
	my %write_hash;
	my %read_hash;

	open CONFIG, "<$conf" || return "cannot open config";
	$/=undef;
	my @lines = <CONFIG>;
	close CONFIG;
	eval("@lines");
	return "config error: $@" if $@;
		
	# Konfiguration im Cache speichern:
	$plugin_cache{$plugname}{cfg_logging}=$logging;
	$plugin_cache{$plugname}{cfg_updateInSec}=$updateInSec;
	$plugin_cache{$plugname}{cfg_fritz_ip}=$fritz_ip;
	$plugin_cache{$plugname}{cfg_fritz_user}=$fritz_user;
	$plugin_cache{$plugname}{cfg_fritz_pw}=$fritz_pw;
	
	$plugin_cache{$plugname}{cfg_write_hash}=\%write_hash;
	$plugin_cache{$plugname}{cfg_read_hash}=\%read_hash;
}

$logging = $plugin_cache{$plugname}{cfg_logging};
my $logfile = "/tmp/plugin_fritzbox.log";
$updateInSec = $plugin_cache{$plugname}{cfg_updateInSec};

$fritz_ip = $plugin_cache{$plugname}{cfg_fritz_ip};
$fritz_user = $plugin_cache{$plugname}{cfg_fritz_user};
$fritz_pw = $plugin_cache{$plugname}{cfg_fritz_pw};

my $write_hash_ref = $plugin_cache{$plugname}{cfg_write_hash};
my $read_hash_ref  = $plugin_cache{$plugname}{cfg_read_hash};

#################################################
if ( $logging == 1 ) {open (LOG, ">>$logfile") or $logging = "0";}

if ( $logging == 1 ) {print LOG "===============================================\n";}
if ( $logging == 1 ) {print LOG (localtime)." Start new run [type:".$event."]\n";}
#################################################
# Application

my $user_agent = LWP::UserAgent->new;

# Register for GAs, depending on startup type
if ( $event eq 'restart' | $event eq 'modified' ) {

	#my @logiken=(keys %{$logic->{'_'.$ga}});
    #for my $t (@logiken)

	
	for my $write_ga (keys %{$write_hash_ref}) {
		if ( $logging == 1 ) { print LOG "Register for write GA [".$write_ga."]\n"; }
		$plugin_subscribe{$write_ga}{$plugname} = 1;
	}
	for my $read_ga (keys %{$read_hash_ref}) {
		if ( $logging == 1 ) { print LOG "Register for read GA [".$read_ga."]\n"; }
		delete $plugin_subscribe{$read_ga}{$plugname};
	}
}
################################################
# Get a valid session ID
my $sid = init_session($user_agent);
if ( $logging == 1 ) { print LOG "SID:  [".$sid."]\n"; }

# Depending on startup type, process ...
# Bus message
if($event=~/bus/) {
	my $msg_ga = $msg{'dst'};
	my $msg_write = ( $msg{'apci'} eq "A_GroupValue_Write" );
	my $msg_read = ( $msg{'apci'} eq "A_GroupValue_Read" );
	my $msg_value = decode_dpt($msg{'dst'},$msg{'data'},"1.001");
	
	if ( $logging == 1 ) { print LOG "Received msg [".($msg_write?"write":"").($msg_read?"read":"")."] on GA [".$msg_ga."] value [".$msg_value."]\n"; }
	
	if ( $msg_write ) {
		# find configured ga
		my $fb_cfg_ref = $write_hash_ref->{$msg_ga};
		
		if ( ref $fb_cfg_ref ne "HASH" ) {
			if ( $logging == 1 ) { print LOG "Not configured GA\n" }
			return "Msg for not configured GA";
		}
		fb_write(${$fb_cfg_ref}{site},${$fb_cfg_ref}{parameter},$msg_value, $user_agent);
		
		## Check if there is a corresponding read ga
		my $fb_read_ga = (${$fb_cfg_ref}{read_ga});
		
		my $fb_cfg_ref_read = $read_hash_ref->{$fb_read_ga};
		if ( ref $fb_cfg_ref_read ne "HASH" ) {
			if ( $logging == 1 ) { print LOG "Not read ga configured\n" }
			return;
		}
		
		my $read_value = &fb_read(${$fb_cfg_ref_read}{site},${$fb_cfg_ref_read}{parameter}, $user_agent);
		
		# Send value to bus
		knx_write($fb_read_ga,$read_value,"1.001");
	}
	
	## Handle read message
	#if ( $msg_read ) {
	#	# find configured ga
	#	my $fb_cfg_ref = $read_hash{$msg_ga};
	#	
	#	if ( ref $fb_cfg_ref ne "HASH" ) {
	#		if ( $logging == 1 ) { print LOG "Not configured GA\n" }
	#		return "Msg for not configured GA";
	#	}
	#	
	#	$msg_value = &fb_read(${$fb_cfg_ref}{site},${$fb_cfg_ref}{parameter});
	#	
	#	# Send value to bus
	#	knx_write($msg_ga,$msg_value,"1.001");
	#}


	
	#if ( $logging == 1 ) { print LOG "Content: ".$http_response->content."\n"; }

}
elsif ($event == 'cycle') {
	#Update all read gas
	
	for my $read_ga (keys %{$read_hash_ref}) {
	if ( $logging == 1 ) { print LOG "Update value for read GA [".$read_ga."]\n"; }
	
		my $fb_cfg_ref = $read_hash_ref->{$read_ga};
		
		if ( ref $fb_cfg_ref ne "HASH" ) {
			if ( $logging == 1 ) { print LOG "Not configured GA\n" }
			next;
		}
		
		my $value = &fb_read(${$fb_cfg_ref}{site},${$fb_cfg_ref}{parameter}, $user_agent);
		
		# disconnect
		#delete $plugin_subscribe{$read_ga}{$plugname};
		
		# Send value to bus
		knx_write($read_ga,$value,"1.001");
		
		# reconnect
		#$plugin_subscribe{$read_ga}{$plugname} = 1;
		
	
	}
}

#################################################
# SUBS
#################################################

# Init Session
# Original from Amaridian 
sub init_session {

	my $user_agent = $_[0];
	my $fritz_ip = $plugin_cache{$plugname}{cfg_fritz_ip};
	my $fritz_user = $plugin_cache{$plugname}{cfg_fritz_user};
	my $fritz_pw = $plugin_cache{$plugname}{cfg_fritz_pw};

	my $sid = '0';
	my $challengeStr = "";

    # Login-Challenge und evtl. vorhandene Session-ID holen        
    my $http_response = $user_agent->post('http://'.$fritz_ip.'/login_sid.lua',
    [
         'sid' => defined($plugin_cache{$plugname}{sid}) ? $plugin_cache{$plugname}{sid} : '0',
    ],
    );
	$http_response->content =~ /<SID>(\w+)<\/SID>\s*<Challenge>(\w+)<\/Challenge>/i and $sid = $1 and $challengeStr = $2;	      
    
    # Wenn noch eine gültige Session da ist, nehmen wir die
    if($sid eq '0000000000000000'){        
        # Challenge zusammen mit PW hashen laut http://www.avm.de/de/Extern/files/session_id/AVM_Technical_Note_-_Session_ID.pdf
        my $ch_Pw = "$challengeStr-$fritz_pw";
        $ch_Pw =~ s/(.)/$1 . chr(0)/eg;
        my $md5 = lc(md5_hex($ch_Pw)); #warum auch immer AVM hier UTF16LE haben möchte...
        my $challenge_response = "$challengeStr-$md5";
	                
        # Mit der frisch errechneten Challenge-Response die Session-ID abholen
        $http_response = $user_agent->post('http://'.$fritz_ip.'/login_sid.lua?username='.$fritz_user.'&response='.$challenge_response,
        [
            'getpage' => '../html/de/menus/menu2.html',
        ],
        );        
        $http_response->content =~ /<SID>(\w+)<\/SID>\s*<Challenge>(\w+)<\/Challenge>/i and $sid = $1 ;
    }
	
	$plugin_cache{$plugname}{sid} = $sid;
	
	return $sid;
}

sub fb_write {

	my $logging = $plugin_cache{$plugname}{cfg_logging};
	my $fritz_ip = $plugin_cache{$plugname}{cfg_fritz_ip};
	my $sid = $plugin_cache{$plugname}{sid};
    my $fb_site = $_[0]; $fb_site =~ s/_sid_/$sid/;
	my $fb_para = $_[1];
	my $fb_val  = $_[2];
	my $user_agent = $_[3];
	
	if ( $logging == 1 ) { print LOG "Build FB write post [site:".$fb_site."][parameter:".$fb_para."]\n"; }
	
	my $response = $user_agent->post('http://'.$fritz_ip.'/'.$fb_site, 
    [
        $fb_para => $fb_val,
        'sid' => $sid,
    ],
	);
	
	return;
}

sub fb_read {
	my $logging = $plugin_cache{$plugname}{cfg_logging};
	my $fritz_ip = $plugin_cache{$plugname}{cfg_fritz_ip};
	my $sid = $plugin_cache{$plugname}{sid};
    my $fb_site = $_[0];  $fb_site =~ s/_sid_/$sid/;
	my $fb_para = $_[1];
	my $user_agent = $_[2];
	
	if ( $logging == 1 ) { print LOG "Build FB read post [site:".$fb_site."][parameter:".$fb_para."]\n"; }
	
	my $response = $user_agent->get('http://'.$fritz_ip.'/'.$fb_site);
	
	if ( $logging == 1 ) { print LOG 'http://'.$fritz_ip.'/'.$fb_site."\n"; }
	
	my $ret = &fb_getValue(\$response->content,$fb_para);
	
	if ( $logging == 1) { print LOG "Read configuration value: [".$ret."]\n"; }
	
	return $ret;
}

sub fb_getValue {
	my $logging = $plugin_cache{$plugname}{cfg_logging};
	my $response_ref = $_[0]; #$response = $$response;
	my $fb_para = $_[1];
	my $ret = 0;
	
	#print LOG "Check response for value ".$response."\n";
	
	if ( $fb_para =~ m/^tam/ ) {
		$fb_para =~ /tam:settings\/TAM(.*)/ and my $tam_idx = $1;
		my @tam_para = split('/',$tam_idx);
		my $tam_no = $tam_para[0]+1;		
		my $tam_var = $tam_para[1];
		
		if ( $logging == 1 ) { print LOG "---- Search for TAM setting [idx:".$tam_no."][var:".$tam_var."]\n"; }
		
		#print LOG "String was: ".$$response_ref."\n";
				
		$$response_ref =~ /tam:settings\/TAM\/list\(.*\)\"\]\s=\s\{.*\[$tam_no\].*?\"$tam_var\"\]\s=\s\"([^\"]+)\"(.*)/s and $ret = $1;
	}
	else {
		#if ( $logging == 1 ) { print LOG "No Tam settings\n"; }
		
		$$response_ref =~ /\s*\[\"$fb_para\"\]\s\=\s\"(\d)\"/ and $ret = $1;		
	}
	
	#if ( $logging == 1) { print LOG "Read value: [".$ret."]\n"; }
	
	return $ret;
}

Im Plugin selber muss eigentlich nichts angepasst werden, es sei denn man will neue Features hinzufügen oder Fehler beheben
Die Konfiguration sieht folgendermaßen aus:

# Definitionen
$fritz_ip = 'xxx';
$logging = 1;			# enable log output
$updateInSec = 300;		# interval in seconds that the Fritz!Box values shall be checked

# User needs to be configured in the WEB-GUI of the Fritz!Box
$fritz_user  = 'xxx';
$fritz_pw  = 'xxx';

# Status Queries
# site: 'http://'.$fritz_ip.'/'CONFIG_STRING?sid='.$sid.,
# _sid_ in the address will be replaced by the actual SID.

# Control WLAN 2.4 GHz
$write_hash{'9/1/0'} = { site => '/cgi-bin/webcm',	parameter => 'wlan:settings/ap_enabled', read_ga => '9/1/1', };
$read_hash{'9/1/1'} = { site => 'wlan/wlan_settings.lua?sid=_sid_',	parameter => 'wlan:settings/ap_enabled',};
# Control WLAN 5 GHz
$write_hash{'9/1/2'} = { site => '/cgi-bin/webcm',	parameter => 'wlan:settings/ap_enabled_scnd', read_ga => '9/1/3', };
$read_hash{'9/1/3'} = { site => 'wlan/wlan_settings.lua?sid=_sid_',	parameter => 'wlan:settings/ap_enabled_scnd',};
# Control DECT
$write_hash{'9/1/4'} = { site => '/cgi-bin/webcm',	parameter => 'dect:settings/enabled', read_ga => '9/1/5', };
$read_hash{'9/1/5'} = { site => 'dect/dect_settings.lua?sid=_sid_',	parameter => 'dect:settings/enabled',};
# Control guest WLAN
$write_hash{'9/1/14'} = { site => '/cgi-bin/webcm',	parameter => 'wlan:settings/guest_ap_enabled', read_ga => '9/1/14', };
$read_hash{'9/1/15'} = { site => 'wlan/guest_access.lua?sid=_sid_',	parameter => 'wlan:settings/guest_ap_enabled',};

# Control Anwering Machine 1
$write_hash{'9/1/10'} = { site => '/cgi-bin/webcm',  parameter => 'tam:settings/TAM0/Active', read_ga => '9/1/11', };
$read_hash{'9/1/11'} = { site => 'fon_devices/tam_list.lua?sid=_sid_',	parameter => 'tam:settings/TAM0/Active',};
# Control Answering Machine 2
$write_hash{'9/1/12'} = { site => '/cgi-bin/webcm',  parameter => 'tam:settings/TAM1/Active', read_ga => '9/1/13', };
$read_hash{'9/1/13'} = { site => 'fon_devices/tam_list.lua?sid=_sid_',	parameter => 'tam:settings/TAM1/Active',};

In der Visu lässt sich dann z.B. das Gäste-WLAN ein- bzw. ausschalten oder auch der AB anschalten (Nützlich wenn man ein kleines Kind hat was schlafen soll).

Das Ganze funktioniert bei mir soweit ganz gut, was aber nicht heißt, dass in dem Plugin nicht noch Fehler stecken.

Gruß

[StefanW]

Sehr schön!

kleiner Hinweis von unserer Seite:

(ACHTUNG: Funktioniert nur mit Frys' Patch "vorkompilierte Plugins" und JuMi2006s' Erweiterung "abhängiges Plugin subscibe".

Diese Modifikationen sollen - sofern alle Tests erfolgreich verlaufen - mit unserem nächsten Patchlevel kommen (ich hoffe noch im Januar). Wir sind auf jeden Fall dran.


lg

Stefan

[XueSheng]

@coolrunnings: Wieviel Zeit benötigt denn das Plugin bei Status Abfrage von Fritzbox Werten?

Habe nur mal aus Spaß die wesentlichen Zeilen in ein Perlskript auf dem Wiregate gepackt und benötige alleine um eine Session Id (sid) zu holen rund 2 Sekunden. Für eine gesamte Response sind mal eben 6 Sekunden vergangen.

Im Verlinken "Türklingel" Thread war in Bezug auf das Auslösen der Klingel etwas im Bereich von einer Sekunde die Rede, wenn ich das richtig gesehen habe.

[coolrunnings]

Das Abholen der Informationen dauert schon etwas.
Bei mir so ~10 Sekunden für alles. Ins Timeout gelaufen ist das Plugin deshalb aber noch nicht.
Nur hier kann man sicherlich noch optimieren. Bisher hat mir nur die Zeit und Motivation dafür gefehlt. Erstmal läuft es ja

Gruß

[XueSheng]

Wenn alleine das Abholen der SID schon 1-2 Sekunden braucht, muss man drauf achten, dass andere zeitkritische Plugins nicht gestört werden.

Mir ist beim Testen übrigens aufgefallen, dass beim Abruf der site 'wlan/wlan_settings.lua?sid=_sid_' in der Response bereits alle Werte (auch für dect uws. enthalten sind). Hier gibt es sicherlich noch Optimierungsmöglichkeiten. Vielleicht kann man die Abfrage der Seite weiter eingrenzen oder alles auf nur eine generelle Abfrage für alle Werte beschränken.

[coolrunnings]

Es ist ja bald Wochenende, da werd ich mal sehen, was sich machen lässt

[XueSheng]

Dass alleine das Holen der sid so ewig dauert, fuchst mich.

Hier das gekürzte Test-Skript, das nur den ersten http_request durchführt:

#!/usr/bin/perl

use strict;
use warnings;

use LWP;

my $fritz_ip = "192.168.0.1";
my $fritz_user = "user";
my $fritz_pw = "pass";

my $ua = LWP::UserAgent->new;
my $http_response = $ua->get("http://$fritz_ip/login_sid.lua");

print "http_response: ".$http_response->content."\n";

Ausgeführt auf meinem PC (libwww-perl 6.05):

$ time perl perl-testing9.pl 
http_response: <?xml version="1.0" encoding="utf-8"?><SessionInfo><SID>0000000000000000</SID><Challenge>425fd7dd</Challenge><BlockTime>0</BlockTime><Rights></Rights></SessionInfo>

real    0m0.309s
user    0m0.076s
sys    0m0.004s

Ausgeführt auf meinem Wiregate (libwww-perl 5.813):

# time perl perl-testing9.pl 
http_response: <?xml version="1.0" encoding="utf-8"?><SessionInfo><SID>0000000000000000</SID><Challenge>dcc1f2bb</Challenge><BlockTime>0</BlockTime><Rights></Rights></SessionInfo>

real    0m2.759s
user    0m0.988s
sys    0m0.060s

Wobei die Runtime auf dem Wiregate von 1,7 bis 2,7 Sekunden schwankt.
Wenn ich aber "LWP::Simple" verwende, dauert das "get" auch auf dem Wiregate nur 0.3 Sekunden!

Ob das jetzt an den älteren Paketen auf dem wiregate liegt oder eine andere Ursache hat, weiss ich nicht.

Aber falls jemand einen guten Tip zur Beschleunigung hat, immer her damit .

[heckmannju]

Hi,
rein Netzwerkteschnisch sind dein PC und das WG gleich ähnlich angebunden?
Viele Grüsse
Jürgen

[XueSheng]

Beide über den selben Gigabit Switch. Daran sollte es nicht liegen (kein WLAN o.ä. im Spiel).

[coolrunnings]

WWW::Curl::Simple soll angeblich schneller sein. Aber da blick ich noch nicht durch. Evtl. hat da jemand mehr Erfahrung.

[XueSheng]

WWW::Curl::Simple scheint nicht im repo des Wiregate zu sein. Stattdessen habe ich das Skript mal auf WWW::Curl::Easy umgebaut. Der Umbau war etwas nervig, weil WWW::Curl an sich schon kompliziert genug ist und zudem die veraltete Version auf dem Wiregate noch eine Sonderbehandlung braucht (Stichwort filehandle und scalar reference... da gabs wohl ein paar Umbauten).

Das Holen der sid geht nun wesentlich flotter (0.7 anstatt bis zu 2.7 Sekunden), jedoch braucht der Post Request länger... Unterm Strich sind es also für die komplette Abfrage 6 Sekunden (bei LWP waren es 6.5 Sekunden).

Für mich ist das Thema vorerst durch.

[coolrunnings]

Ich kram das Ganze hier nochmal raus. Bisher habe ich leider noch keine Möglichkeit gefunden das Skript zu optimieren.
Aber besteht evtl. die Möglichkeit perl zu updaten? Oder verträgt sich das nicht mit den installierten Debian?

Weil mit der aktuelleren Version von libwww-perl lieft ja das Skript anscheinend auch schneller.

Ausgeführt auf meinem PC (libwww-perl 6.05):

$ time perl perl-testing9.pl 
http_response: <?xml version="1.0" encoding="utf-8"?><SessionInfo><SID>0000000000000000</SID><Challenge>425fd7dd</Challenge><BlockTime>0</BlockTime><Rights></Rights></SessionInfo>

real    0m0.309s
user    0m0.076s
sys    0m0.004s

Ausgeführt auf meinem Wiregate (libwww-perl 5.813):

# time perl perl-testing9.pl 
http_response: <?xml version="1.0" encoding="utf-8"?><SessionInfo><SID>0000000000000000</SID><Challenge>dcc1f2bb</Challenge><BlockTime>0</BlockTime><Rights></Rights></SessionInfo>

real    0m2.759s
user    0m0.988s
sys    0m0.060s

[XueSheng]

Aber besteht evtl. die Möglichkeit perl zu updaten? Oder verträgt sich das nicht mit den installierten Debian?

Weil mit der aktuelleren Version von libwww-perl lieft ja das Skript anscheinend auch schneller.

Ein Update könnte man sicherlich durchführen. Grundsätzlich könnte man dadurch aber auch Probleme mit zukünftigen "offiziellen" Updates bekommen (wobei sich die "Update-Flut" beim Wiregate stark in Grenzen hält, *hust*).
Das Thema mit den "veralteten" Paketen auf dem Wiregate wurde ja mittlerweile oft genug geführt. Hier hatte StefanW mal angedeutet, dass da was neues kommen könnte (kostenpflichtig).

[tger977]

Hallo,

hole den Thread hier mal wieder hoch, da ich gerade nach einer Lösung Suche per Plugin das WLAN meiner Fritzbox ein und aus zu schalten.

Gibt es bezüglich der langen Laufzeiten weitere Neuigkeiten?

Gruß
Andi

[tger977]

habe nun mal versucht das Plugin von #1 zum Laufen zu bringen.

Es scheitert bei mir wohl immer am Login der Fritzbox, da ich immer eine SID mit 0 bekomme.

Wenn ich mir das aktuelle SVN Plugin von Amaridian (Telfonklingel) ansehe sind dort auch ganz andere Pfade bei der init sub drin als hier im Plugin.

Hat das Plugin hier jemand am Laufen und kann eine aktuelle Version nochmal hier posten, da es im SVN keine Version gibt?

Gruß
Andi