Public/fhem-mirror
1
0
Fork 0
mirror of https://github.com/fhem/fhem-mirror.git synced 2025-05-04 22:19:38 +00:00
Code Issues Packages Projects Releases Wiki Activity

Make it 5.5 resistant

Browse Source 
git-svn-id: https://svn.fhem.de/fhem/trunk@2389 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
rudolfkoenig 2012-12-29 17:05:48 +00:00
parent 9d544e8cce
commit be6088f887
1 changed files with 28 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
fhem/FHEM/FritzBoxUtils.pm
View File

@ -7,23 +7,37 @@ use warnings;
use Digest::MD5 "md5_hex"; use Digest::MD5 "md5_hex";
use HttpUtils; use HttpUtils;
my ($lastOkPw, $lastOkTime) =("", 0); my ($lastOkPw, $lastOkHost, $lastOkTime) =("", "", 0);
sub sub
FB_getPage($$$) FB_doCheckPW($$)
{ {
my ($host, $pw, $page) = @_; my ($host, $pw) = @_;
my $data = GetFileFromURL("http://$host". my $data = GetFileFromURL("http://$host/login_sid.lua", undef, undef, 1);
"/cgi-bin/webcm?getpage=../html/login_sid.xml", undef, undef, 1);
return undef if(!$data); return undef if(!$data);
my $chl; my $chl;
$chl = $1 if($data =~ /<Challenge>(\w+)<\/Challenge>/i); $chl = $1 if($data =~ /<Challenge>(\w+)<\/Challenge>/i);
my $chlAnsw .= "$chl-$pw"; my $chlAnsw .= "$chl-$pw";
$chlAnsw =~ s/(.)/$1.chr(0)/eg; # works probably only with ascii $chlAnsw =~ s/(.)/$1.chr(0)/eg; # works probably only with ascii
$chlAnsw = "$chl-".lc(md5_hex($chlAnsw)); $chlAnsw = "$chl-".lc(md5_hex($chlAnsw));
my @d = ( "login:command/response=$chlAnsw", "getpage=$page" );
$data = join("&", map {join("=", map {urlEncode($_)} split("=",$_,2))} @d); if($data =~ m/iswriteaccess/) { # Old version
return GetFileFromURL("http://$host/cgi-bin/webcm", undef, $data, 1); my @d = ( "login:command/response=$chlAnsw",
"getpage=../html/de/internet/connect_status.txt" );
$data = join("&", map {join("=", map {urlEncode($_)} split("=",$_,2))} @d);
$data = GetFileFromURL("http://$host/cgi-bin/webcm", undef, $data, 1);
my $isOk = ($data =~ m/checkStatus/);
return $isOk;
} else { # FritzOS >= 5.50
my @d = ( "response=$chlAnsw", "page=/login_sid.lua" );
$data = join("&", map {join("=", map {urlEncode($_)} split("=",$_,2))} @d);
$data = GetFileFromURL("http://$host/login_sid.lua", undef, $data, 1);
my $sid = $1 if($data =~ /<SID>(\w+)<\/SID>/i);
$sid = undef if($sid =~ m/^0*$/);
return $sid;
}
} }
sub sub
@ -32,12 +46,13 @@ FB_checkPw($$)
my ($host, $pw) = @_; my ($host, $pw) = @_;
my $now = time(); my $now = time();
return 1 if($lastOkPw eq $pw && ($now - $lastOkTime) < 300); # 5min cache return 1 if($lastOkPw eq $pw && $lastOkHost eq $host &&
($now - $lastOkTime) < 300); # 5min cache
my $data = FB_getPage($host, $pw, "../html/de/internet/connect_status.txt"); if(FB_doCheckPW($host, $pw)) {
$lastOkPw = $pw;
if(defined($data) && $data =~ m/"checkStatus":/) { $lastOkTime = $now;
$lastOkPw = $pw; $lastOkTime = $now; $lastOkHost = $host;
return 1; return 1;
} else { } else {