#!/usr/bin/perl
#
# https://avm.de/fileadmin/user_upload/Global/Service/Schnittstellen/AHA-HTTP-Interface.pdf
#
use warnings;
use strict;
use POSIX;
use utf8;
use Config::Simple;
use LockFile::Simple;
use LWP::UserAgent;
use XML::Simple;
use Digest::MD5 "md5_hex";
use Data::Dumper;

# config
my $cfg = new Config::Simple( syntax => 'ini' );
$cfg->autosave(1);
$cfg->read($ENV{HOME} . "/.fritz.rc");

my $host = $cfg->param('host');
my $passwd = $cfg->param('passwd');

# global variables
my ($ua, $sid, $devlist);

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

sub login {
	# get challenge
	my $url = "http://${host}/login_sid.lua";
	my $req = HTTP::Request->new(GET => $url);
	my $res = $ua->request($req);
	die "login http request #1 failed" unless $res->is_success;
        #print $res->content;
	my $xml = XMLin($res->content);

	# construct response
	my $cr = $xml->{'Challenge'} . "-" . $passwd;
	$cr =~ s/(.)/$1 . chr(0)/eg;  # to utf16
	my $md5 = lc(md5_hex($cr));
	$url = "http://${host}/login_sid.lua"
            . "?username=" . $cfg->param('user')
            . ";response=" . $xml->{'Challenge'} . "-" . $md5;
        #print $url . "\n";
        #print Dumper($xml);
        
	# login and get session id
	$req = HTTP::Request->new(GET => $url);
	$res = $ua->request($req);
	die "login http request #2 failed" unless $res->is_success;
        #print $res->content;
	$xml = XMLin($res->content);
	$sid = $xml->{'SID'};
	die "login failed" if $sid eq "0000000000000000";

#	printf "login ok (sid %s)\n\n", $sid;
}

sub get_devlist {
	my $url = "http://${host}/webservices/homeautoswitch.lua?" .
	    "switchcmd=getdevicelistinfos&sid=" . $sid;
	my $req = HTTP::Request->new(GET => $url);
	my $res = $ua->request($req);
	die "devlist http request failed" unless $res->is_success;
	$devlist = XMLin($res->content);
}

sub print_devlist {
	foreach my $name (sort keys %{$devlist->{'device'}}) {
		my $dev = $devlist->{'device'}->{$name};
		printf "%-20s %-20s", $name, $dev->{'productname'};
		if (defined($dev->{'switch'})) {
			printf("  sw: %-3s",
			       $dev->{'switch'}->{'state'} ? "on" : "off");
		}
		if (defined($dev->{'temperature'})) {
			printf("  temp: %.1f",
			       $dev->{'temperature'}->{'celsius'} / 10);
		}
		if (defined($dev->{'present'}) && $dev->{'present'} == 0) {
			printf("  (offline)");
		}
		printf "\n";
	}
}

sub set_switch {
	my $switch = shift;
	my $state = shift;
	my $cmd;

	die "device $switch not found"
	    unless defined($devlist->{'device'}->{$switch});
	die "device $switch is not a switch"
	    unless defined($devlist->{'device'}->{$switch}->{'switch'});

	$cmd = "setswitchon"  if $state =~ m/(1|on)/i;
	$cmd = "setswitchoff" if $state =~ m/(0|off)/i;
	die "unknown switch state: $state" unless defined($cmd);

	my $url = "http://${host}/webservices/homeautoswitch.lua?" .
	    "switchcmd=" . $cmd . "&sid=" . $sid . "&ain=" . 
	    $devlist->{'device'}->{$switch}->{'identifier'};
	my $req = HTTP::Request->new(GET => $url);
	my $res = $ua->request($req);
	die "setswitch http request failed" unless $res->is_success;
}

sub get_switch {
	my $switch = shift;
	my $state;

	die "device $switch not found"
	    unless defined($devlist->{'device'}->{$switch});
	die "device $switch is not a switch"
	    unless defined($devlist->{'device'}->{$switch}->{'switch'});

	$state = $devlist->{'device'}->{$switch}->{'switch'}->{'state'};
	printf "%s\n", $state ? "on" : "off";
}

sub get_temp {
	my $sensor = shift;
	my $temp;

	die "device $sensor not found"
	    unless defined($devlist->{'device'}->{$sensor});
	die "device $sensor is not a temp sensor"
	    unless defined($devlist->{'device'}->{$sensor}->{'temperature'});

	$temp = $devlist->{'device'}->{$sensor}->{'temperature'};
	printf "%.1f\n", $temp->{'celsius'} / 10;
}


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

sub print_help {
	print <<EOF;

usage:
   general
      fritz help                    print this text

   configure
      fritz host <host|ip>          set hostname
      fritz passwd <pw>             set password

   query
      fritz devlist                 print device list (default)
      fritz rawlist [ <name> ]      dump raw device info (all or <name> only)

      fritz get-switch <name>       print switch state
      fritz get-temp <name>         print temperature

   control
      fritz switch <name> <on|off>  set switch

EOF
}

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

my $mode = shift;
$ua = LWP::UserAgent->new;

# print help
if (defined($mode) && ($mode eq "h" || $mode eq "-h" || $mode eq "help")) {
	print_help();
	exit;
}

# set host & passwd
if (defined($mode) && ($mode eq "passwd" || $mode eq "host")) {
	my $value = shift;
	$cfg->param($mode, $value);
	exit;
}

# serialize
my $lockmgr = LockFile::Simple->make( -autoclean => 1,
                                      -stale     => 1,
                                      -wfunc     => undef);
my $lock = $lockmgr->lock($ENV{HOME} . "/.fritz.one") || die "can't get lock";

# start talking to fritzbox
login();
get_devlist();

# print device list
if (!defined($mode) || $mode eq "devlist" || $mode eq "list") {
	print_devlist();
	exit;
}
if ($mode eq "rawlist" || $mode eq "raw") {
	my $dev = shift;
	if (defined($dev) && defined($devlist->{'device'}->{$dev})) {
		print Dumper($devlist->{'device'}->{$dev});
	} else {
		print Dumper($devlist);
	}
	exit;
}

# operate switch
if ($mode eq "switch" || $mode eq "sw") {
	my $switch = shift;
	my $state = shift;
	die "missing switch args"
	    if !defined($switch) || !defined($state);
	set_switch($switch, $state);
	exit;
}

# query sensors
if ($mode eq "get-switch" || $mode eq "get-sw") {
	my $switch = shift;
	die "missing get-switch args"
	    if !defined($switch);
	get_switch($switch);
	exit;
}
if ($mode eq "get-temp") {
	my $sensor = shift;
	die "missing get-temp args"
	    if !defined($sensor);
	get_temp($sensor);
	exit;
}

# Huh?
die "unknown command: $mode (try help)";