############################################## # $Id$ # # based / modified Version 98_EGPMS2LAN from ericl # # (c) 2013 - 2017 Copyright: Alex Storny (moselking at arcor dot de) # All rights reserved # # This script 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 # any later version. # # The GNU General Public License can be found at # http://www.gnu.org/copyleft/gpl.html. # # This script 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. # ################################################################ # -> Module 70_EGPM.pm (for a single Socket) needed. ################################################################ package main; use strict; use warnings; use HttpUtils; sub EGPM2LAN_Initialize($) { my ($hash) = @_; $hash->{Clients} = ":EGPM:"; $hash->{GetFn} = "EGPM2LAN_Get"; $hash->{SetFn} = "EGPM2LAN_Set"; $hash->{DefFn} = "EGPM2LAN_Define"; $hash->{AttrList} = "loglevel:0,1,2,3,4,5,6 stateDisplay:sockNumber,sockName autocreate:on,off"; } ################################### sub EGPM2LAN_Get($@) { my ($hash, @a) = @_; my $getcommand; return "argument is missing" if(int(@a) != 2); $getcommand = $a[1]; if($getcommand eq "state") { if(defined($hash->{STATE})) { return $hash->{STATE}; } } elsif($getcommand eq "lastcommand") { if(defined($hash->{READINGS}{lastcommand}{VAL})) { return $hash->{READINGS}{lastcommand}{VAL}; } } else { return "Unknown argument $getcommand, choose one of state:noArg lastcommand:noArg".(exists($hash->{READINGS}{output})?" output:noArg":""); } return ""; } ################################### sub EGPM2LAN_Set($@) { my ($hash, @a) = @_; return "no set value specified" if(int(@a) < 2); return "Unknown argument $a[1], choose one of on:1,2,3,4,all off:1,2,3,4,all toggle:1,2,3,4 clearreadings:noArg statusrequest:noArg password" if($a[1] eq "?"); my $name = shift @a; my $setcommand = shift @a; my $params = join(" ", @a); my $logLevel = GetLogLevel($name,4); Log $logLevel, "EGPM2LAN set $name (". $hash->{IP}. ") $setcommand $params"; EGPM2LAN_Login($hash, $logLevel); if($setcommand eq "on" || $setcommand eq "off") { if($params eq "all") { #switch all Sockets; thanks to eric! for (my $count = 1; $count <= 4; $count++) { EGPM2LAN_Switch($hash, $setcommand, $count, $logLevel); } } else { #switch single Socket EGPM2LAN_Switch($hash, $setcommand, $params, $logLevel); } EGPM2LAN_Statusrequest($hash, $logLevel, 1); } elsif($setcommand eq "toggle") { my $currentstate = EGPM2LAN_Statusrequest($hash, $logLevel, 1); if(defined($currentstate)) { my @powerstates = split(",", $currentstate); my $newcommand="off"; if($powerstates[$params-1] eq "0") { $newcommand="on"; } EGPM2LAN_Switch($hash, $newcommand, $params, $logLevel); EGPM2LAN_Statusrequest($hash, $logLevel, 0); } } elsif($setcommand eq "statusrequest") { EGPM2LAN_Statusrequest($hash, $logLevel, 1); } elsif($setcommand eq "password") { delete $hash->{PASSWORD} if($params eq "" && defined($hash->{PASSWORD})); EGPM2LAN_StorePassword($hash, $params); } elsif($setcommand eq "clearreadings") { delete $hash->{READINGS}; } else { return "unknown argument $setcommand, choose one of on, off, toggle, statusrequest, clearreadings"; } EGPM2LAN_Logoff($hash, $logLevel); $hash->{CHANGED}[0] = $setcommand; $hash->{READINGS}{lastcommand}{TIME} = TimeNow(); $hash->{READINGS}{lastcommand}{VAL} = $setcommand." ".$params; return undef; } ################################ sub EGPM2LAN_StorePassword($$) { my ($hash, $password) = @_; my $index = $hash->{TYPE}."_".$hash->{NAME}."_passwd"; my $key = getUniqueId().$index; my $enc_pwd = ""; if(eval "use Digest::MD5;1") { $key = Digest::MD5::md5_hex(unpack "H*", $key); $key .= Digest::MD5::md5_hex($key); } for my $char (split //, $password) { my $encode=chop($key); $enc_pwd.=sprintf("%.2x",ord($char)^ord($encode)); $key=$encode.$key; } Log 3, "EGPM2LAN write password to file uniqueID"; my $err = setKeyValue($index, $enc_pwd); if(defined($err)){ #Fallback, if file is not available $hash->{PASSWORD}=$password; return "EGPM2LAN write Password failed!"; } $hash->{PASSWORD}="***"; return "Password saved."; } ################################ sub EGPM2LAN_ReadPassword($) { my ($hash) = @_; #password available? return undef if (!defined($hash->{PASSWORD})); #for old installations/fallback if($hash->{PASSWORD} ne "***"){ return $hash->{PASSWORD}; } my $index = $hash->{TYPE}."_".$hash->{NAME}."_passwd"; my $key = getUniqueId().$index; my ($password, $err); Log 3, "EGPM2LAN Read password from file uniqueID"; ($err, $password) = getKeyValue($index); if ( defined($err) ) { Log 1, "EGPM2LAN unable to read password from file: $err"; return undef; } if (defined($password) ) { if ( eval "use Digest::MD5;1" ) { $key = Digest::MD5::md5_hex(unpack "H*", $key); $key .= Digest::MD5::md5_hex($key); } my $dec_pwd = ''; for my $char (map { pack('C', hex($_)) } ($password =~ /(..)/g)) { my $decode=chop($key); $dec_pwd.=chr(ord($char)^ord($decode)); $key=$decode.$key; } return $dec_pwd; } else { Log 1, "EGPM2LAN No password in file"; return undef; } } ################################ sub EGPM2LAN_Switch($$$$) { my ($hash, $state, $port, $logLevel) = @_; $state = ($state eq "on" ? "1" : "0"); my $fritz = 0; #may be important for FritzBox-users my $data = "cte1=" . ($port == "1" ? $state : "") . "&cte2=" . ($port == "2" ? $state : "") . "&cte3=" . ($port == "3" ? $state : "") . "&cte4=". ($port == "4" ? $state : ""); Log $logLevel, "EGPM2LAN $data"; eval { # Parameter: $url, $timeout, $data, $noshutdown, $loglevel GetFileFromURL("http://".$hash->{IP}."/", 5,$data ,$fritz ,$logLevel); }; if ($@){ ### catch block Log $logLevel, "EGPM2LAN error: $@"; }; return 1; } ################################ sub EGPM2LAN_Login($$) { my ($hash, $logLevel) = @_; Log $logLevel,"EGPM2LAN try to Login @".$hash->{IP}; my $passwd = EGPM2LAN_ReadPassword($hash); eval{ GetFileFromURLQuiet("http://".$hash->{IP}."/login.html", 5,"pw=" .(defined($passwd) ? $passwd : ""),0 ,$logLevel); }; if ($@){ ### catch block Log 1, "EGPM2LAN Login error: $@"; return 0; }; Log $logLevel,"EGPM2LAN Login successful!"; return 1; } ################################ sub EGPM2LAN_GetDeviceInfo($$) { my ($hash, $input) = @_; my $logLevel = GetLogLevel($hash->{NAME},4); #try to read Device Name my ($devicename) = $input =~ m/

(.+)<\/h2><\/div>/si; $hash->{DEVICENAME} = trim($devicename); #try to read Socket Names my @socketlist; while ($input =~ m/

(.+?)<\/h2>/gi) { my $socketname = trim($1); $socketname =~ s/ /_/g; #remove spaces push(@socketlist, $socketname); } #check 4 dublicate Names my %seen; foreach my $entry (@socketlist) { next unless $seen{$entry}++; Log $logLevel, "EGPM2LAN Sorry! Can't use devicenames. ".trim($entry)." is duplicated."; @socketlist = qw(Socket_1 Socket_2 Socket_3 Socket_4); } if(int(@socketlist) < 4) { @socketlist = qw(Socket_1 Socket_2 Socket_3 Socket_4); } return @socketlist; } ################################ sub EGPM2LAN_Statusrequest($$$) { my ($hash, $logLevel, $autoCr) = @_; my $name = $hash->{NAME}; my $response = GetFileFromURL("http://".$hash->{IP}."/", 5,"" , 0 ,$logLevel); #Log 1,$response; if(defined($response) && $response =~ /.,.,.,./) { my $powerstatestring = $&; Log $logLevel, "EGPM2LAN Powerstate: " . $powerstatestring; my @powerstates = split(",", $powerstatestring); if(int(@powerstates) == 4) { my $index; my $newstatestring; my @socketlist = EGPM2LAN_GetDeviceInfo($hash,$response); readingsBeginUpdate($hash); foreach my $powerstate (@powerstates) { $index++; if(length(trim($socketlist[$index-1]))==0) { $socketlist[$index-1]="Socket_".$index; } if(AttrVal($name, "stateDisplay", "sockNumber") eq "sockName") { $newstatestring .= $socketlist[$index-1].": ".($powerstates[$index-1] ? "on" : "off")." "; } else { $newstatestring .= $index.": ".($powerstates[$index-1] ? "on" : "off")." "; } #Create Socket-Object if not available my $defptr = $modules{EGPM}{defptr}{$name.$index}; if($autoCr && AttrVal($name, "autocreate", "on") eq "on" && not defined($defptr)) { if(Value("autocreate") eq "active") { Log $logLevel, "EGPM2LAN: Autocreate EGPM for Socket $index"; CommandDefine(undef, $name."_".$socketlist[$index-1]." EGPM $name $index"); } else { Log 2, "EGPM2LAN: Autocreate disabled in globals section"; $attr{$name}{autocreate} = "off"; } } #Write state 2 related Socket-Object if (defined($defptr)) { if (ReadingsVal($defptr->{NAME},"state","") ne ($powerstates[$index-1] ? "on" : "off")) { #check for chages and update -> trigger event Log $logLevel, "Update State of ".$defptr->{NAME}; readingsSingleUpdate($defptr, "state", ($powerstates[$index-1] ? "on" : "off") ,1); } $defptr->{DEVICENAME} = $hash->{DEVICENAME}; $defptr->{SOCKETNAME} = $socketlist[$index-1]; } readingsBulkUpdate($hash, $index."_".$socketlist[$index-1], ($powerstates[$index-1] ? "on" : "off")); } readingsBulkUpdate($hash, "state", $newstatestring); readingsEndUpdate($hash, 0); #everything is fine return $powerstatestring; } else { Log $logLevel, "EGPM2LAN: Failed to parse powerstate"; } } else { $hash->{STATE} = "Login failed"; Log $logLevel, "EGPM2LAN: Login failed"; } #something went wrong :-( return undef; } ################################ sub EGPM2LAN_Logoff($$) { my ($hash, $logLevel) = @_; GetFileFromURL("http://".$hash->{IP}."/login.html", 5,"" ,0 ,$logLevel); return 1; } ################################ sub EGPM2LAN_Define($$) { my ($hash, $def) = @_; my @a = split("[ \t][ \t]*", $def); my $u = "wrong syntax: define EGPM2LAN IP [Password]"; return $u if(int(@a) < 2); $hash->{IP} = $a[2]; if(int(@a) == 4) { EGPM2LAN_StorePassword($hash, $a[3]); $hash->{DEF} = $a[2]; ## remove password } my $result = EGPM2LAN_Login($hash, 3); if($result == 1) { $hash->{STATE} = "initialized"; EGPM2LAN_Statusrequest($hash, 4, 0); EGPM2LAN_Logoff($hash, 4); } return undef; } 1; =pod =item device =item summary controls a LAN-Socket device from Gembird =item summary_DE steuert eine LAN-Steckdosenleiste von Gembird =begin html

EGPM2LAN

=end html =begin html_DE

EGPM2LAN

=end html_DE =cut