mirror of
https://github.com/fhem/fhem-mirror.git
synced 2025-05-05 08:20:23 +00:00
Separating HttpUtils.pm
git-svn-id: https://svn.fhem.de/fhem/trunk@1627 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
rudolfkoenig
parent
75764d4c94
commit
1ebd156348
@ -45,6 +45,8 @@
|
||||
- feature: holiday returns all matches, not only the first.
|
||||
- change: CULflash separated from updatefhem to a new module (M. Fischer)
|
||||
- feature: time and internet helper routines added to fhem.pl (Boris)
|
||||
- change: separating common functions used by the FHEM modules into
|
||||
*Utils.pm files from fhem.pl
|
||||
|
||||
- 2011-12-31 (5.2)
|
||||
- bugfix: applying smallscreen attributes to firefox/opera
|
||||
|
||||
@ -4,13 +4,12 @@
|
||||
package main;
|
||||
use strict;
|
||||
use warnings;
|
||||
use IO::Socket;
|
||||
use HttpUtils;
|
||||
|
||||
sub CommandCULflash($$);
|
||||
sub GetHttpFile($$@);
|
||||
sub SplitNewFiletimes($);
|
||||
sub CULflash_SplitNewFiletimes($);
|
||||
|
||||
my $server = "fhem.de:80";
|
||||
my $server = "http://fhem.de:80";
|
||||
my $sdir = "/fhemupdate2";
|
||||
my $ftime = "filetimes.txt";
|
||||
my $dfu = "dfu-programmer";
|
||||
@ -30,7 +29,7 @@ sub
|
||||
CommandCULflash($$)
|
||||
{
|
||||
my ($cl, $param) = @_;
|
||||
my $modpath = (-d "update" ? "update" : $attr{global}{modpath});
|
||||
my $modpath = (-d "updatefhem.dir" ? "updatefhem.dir":$attr{global}{modpath});
|
||||
my $moddir = "$modpath/FHEM";
|
||||
|
||||
my %ctypes = (
|
||||
@ -51,16 +50,16 @@ CommandCULflash($$)
|
||||
|
||||
################################
|
||||
# First get the index file to prove the file size
|
||||
my $filetimes = GetHttpFile($server, "$sdir/$ftime");
|
||||
my $filetimes = GetFileFromURL("$server$sdir/$ftime");
|
||||
return "Can't get $ftime from $server" if(!$filetimes);
|
||||
|
||||
# split filetime and filesize
|
||||
my ($ret, $filetime, $filesize) = SplitNewFiletimes($filetimes);
|
||||
my ($ret, $filetime, $filesize) = CULflash_SplitNewFiletimes($filetimes);
|
||||
return $ret if($ret);
|
||||
|
||||
################################
|
||||
# Now get the firmware file:
|
||||
my $content = GetHttpFile($server, "$sdir/FHEM/$target.hex");
|
||||
my $content = GetFileFromURL("$server$sdir/FHEM/$target.hex");
|
||||
return "File size for $target.hex does not correspond to filetimes.txt entry"
|
||||
if(length($content) ne $filesize->{"FHEM/$target.hex"});
|
||||
my $localfile = "$moddir/$target.hex";
|
||||
@ -84,48 +83,7 @@ CommandCULflash($$)
|
||||
}
|
||||
|
||||
sub
|
||||
GetHttpFile($$@)
|
||||
{
|
||||
my ($host, $filename, $timeout) = @_;
|
||||
$timeout = 2.0 if(!defined($timeout));
|
||||
|
||||
$filename =~ s/%/%25/g;
|
||||
my $conn = IO::Socket::INET->new(PeerAddr => $host);
|
||||
if(!$conn) {
|
||||
Log 1, "CULflash Can't connect to $host\n";
|
||||
undef $conn;
|
||||
return undef;
|
||||
}
|
||||
$host =~ s/:.*//;
|
||||
my $req = "GET $filename HTTP/1.0\r\nHost: $host\r\n\r\n\r\n";
|
||||
syswrite $conn, $req;
|
||||
shutdown $conn, 1; # stopped writing data
|
||||
my ($buf, $ret) = ("", "");
|
||||
|
||||
$conn->timeout($timeout);
|
||||
for(;;) {
|
||||
my ($rout, $rin) = ('', '');
|
||||
vec($rin, $conn->fileno(), 1) = 1;
|
||||
my $nfound = select($rout=$rin, undef, undef, $timeout);
|
||||
if($nfound <= 0) {
|
||||
Log 1, "CULflash GetHttpFile: Select timeout/error: $!";
|
||||
undef $conn;
|
||||
return undef;
|
||||
}
|
||||
|
||||
my $len = sysread($conn,$buf,65536);
|
||||
last if(!defined($len) || $len <= 0);
|
||||
$ret .= $buf;
|
||||
}
|
||||
|
||||
$ret=~ s/(.*?)\r\n\r\n//s; # Not greedy: switch off the header.
|
||||
Log 4, "CULflash Got http://$host$filename, length: ".length($ret);
|
||||
undef $conn;
|
||||
return $ret;
|
||||
}
|
||||
|
||||
sub
|
||||
SplitNewFiletimes($)
|
||||
CULflash_SplitNewFiletimes($)
|
||||
{
|
||||
my $filetimes = shift;
|
||||
my $ret;
|
||||
|
||||
@ -4,16 +4,15 @@
|
||||
package main;
|
||||
use strict;
|
||||
use warnings;
|
||||
use IO::Socket;
|
||||
use HttpUtils;
|
||||
|
||||
sub CommandUpdatefhem($$);
|
||||
sub GetHttpFile($$@);
|
||||
sub ParseChanges($);
|
||||
sub ReadOldFiletimes($);
|
||||
sub SplitNewFiletimes($);
|
||||
sub FileList($);
|
||||
|
||||
my $server = "fhem.de:80";
|
||||
my $server = "http://fhem.de";
|
||||
my $sdir = "/fhemupdate2";
|
||||
my $ftime = "filetimes.txt";
|
||||
|
||||
@ -153,7 +152,7 @@ CommandUpdatefhem($$)
|
||||
my $oldtime = ReadOldFiletimes("$moddir/$ftime");
|
||||
|
||||
# Get new filetimes.txt
|
||||
my $filetimes = GetHttpFile($server, "$sdir/$ftime");
|
||||
my $filetimes = GetFileFromURL("$server$sdir/$ftime");
|
||||
return "Can't get $ftime from $server" if(!$filetimes);
|
||||
|
||||
# split filetime and filesize
|
||||
@ -236,7 +235,8 @@ CommandUpdatefhem($$)
|
||||
push @reload, $mf if($modules{$m} && $modules{$m}{LOADED});
|
||||
}
|
||||
|
||||
my $content = GetHttpFile($server, "$sdir/$remfile");
|
||||
$remfile =~ s/%/%25/g;
|
||||
my $content = GetFileFromURL("$server$sdir/$remfile");
|
||||
my $l1 = length($content);
|
||||
my $l2 = $filesize->{$f};
|
||||
return "File size for $f ($l1) does not correspond to ".
|
||||
@ -310,47 +310,6 @@ CommandUpdatefhem($$)
|
||||
return $ret;
|
||||
}
|
||||
|
||||
sub
|
||||
GetHttpFile($$@)
|
||||
{
|
||||
my ($host, $filename, $timeout) = @_;
|
||||
$timeout = 2.0 if(!defined($timeout));
|
||||
|
||||
$filename =~ s/%/%25/g;
|
||||
my $conn = IO::Socket::INET->new(PeerAddr => $host);
|
||||
if(!$conn) {
|
||||
Log 1, "updatefhem Can't connect to $host\n";
|
||||
undef $conn;
|
||||
return undef;
|
||||
}
|
||||
$host =~ s/:.*//;
|
||||
my $req = "GET $filename HTTP/1.0\r\nHost: $host\r\n\r\n\r\n";
|
||||
syswrite $conn, $req;
|
||||
shutdown $conn, 1; # stopped writing data
|
||||
my ($buf, $ret) = ("", "");
|
||||
|
||||
$conn->timeout($timeout);
|
||||
for(;;) {
|
||||
my ($rout, $rin) = ('', '');
|
||||
vec($rin, $conn->fileno(), 1) = 1;
|
||||
my $nfound = select($rout=$rin, undef, undef, $timeout);
|
||||
if($nfound <= 0) {
|
||||
Log 1, "updatefhem GetHttpFile: Select timeout/error: $!";
|
||||
undef $conn;
|
||||
return undef;
|
||||
}
|
||||
|
||||
my $len = sysread($conn,$buf,65536);
|
||||
last if(!defined($len) || $len <= 0);
|
||||
$ret .= $buf;
|
||||
}
|
||||
|
||||
$ret=~ s/(.*?)\r\n\r\n//s; # Not greedy: switch off the header.
|
||||
Log 4, "updatefhem Got http://$host$filename, length: ".length($ret);
|
||||
undef $conn;
|
||||
return $ret;
|
||||
}
|
||||
|
||||
sub
|
||||
ParseChanges($)
|
||||
{
|
||||
@ -359,7 +318,7 @@ ParseChanges($)
|
||||
my $ret = "List of new / modified files since last update:\n";
|
||||
|
||||
# get list of files
|
||||
my $filetimes = GetHttpFile($server, "$sdir/$ftime");
|
||||
my $filetimes = GetFileFromURL("$server$sdir/$ftime");
|
||||
return $ret."Can't get $ftime from $server" if(!$filetimes);
|
||||
|
||||
# split filetime and filesize
|
||||
@ -388,7 +347,7 @@ ParseChanges($)
|
||||
} else {
|
||||
# get list of changes
|
||||
$ret .= "\nList of changes:\n";
|
||||
my $changed = GetHttpFile($server, "$sdir/CHANGED");
|
||||
my $changed = GetFileFromURL("$server$sdir/CHANGED");
|
||||
if(!$changed || $changed =~ m/Error 404/g) {
|
||||
$ret .= "Can't get list of changes from $server";
|
||||
} else {
|
||||
|
||||
86
fhem/FHEM/HttpUtils.pm
Normal file
86
fhem/FHEM/HttpUtils.pm
Normal file
@ -0,0 +1,86 @@
|
||||
##############################################
|
||||
# $Id: HttpUtils.pm 1148 2011-12-28 19:21:19Z rudolfkoenig $
|
||||
package main;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use IO::Socket::INET;
|
||||
|
||||
##################
|
||||
sub
|
||||
urlEncode($) {
|
||||
$_= $_[0];
|
||||
s/([\x00-\x2F,\x3A-\x40,\x5B-\x60,\x7B-\xFF])/sprintf("%%%02x",ord($1))/eg;
|
||||
return $_;
|
||||
}
|
||||
|
||||
|
||||
##################
|
||||
# if data (which is urlEncoded) is set, then a POST is performed, else a GET
|
||||
# noshutdown must be set for e.g the Fritz!Box
|
||||
sub
|
||||
GetFileFromURL($@)
|
||||
{
|
||||
my ($url, $timeout, $data, $noshutdown) = @_;
|
||||
$timeout = 2.0 if(!defined($timeout));
|
||||
|
||||
if($url !~ /^(http):\/\/([^:\/]+)(:\d+)?(\/.*)$/) {
|
||||
Log 1, "GetFileFromURL $url: malformed URL";
|
||||
return undef;
|
||||
}
|
||||
|
||||
my ($protocol,$host,$port,$path)= ($1,$2,$3,$4);
|
||||
|
||||
if(defined($port)) {
|
||||
$port=~ s/^://;
|
||||
} else {
|
||||
$port= 80;
|
||||
}
|
||||
$path= '/' unless defined($path);
|
||||
|
||||
if($protocol ne "http") {
|
||||
Log 1, "GetFileFromURL $url: invalid protocol";
|
||||
return undef;
|
||||
}
|
||||
|
||||
my $conn = IO::Socket::INET->new(PeerAddr => "$host:$port");
|
||||
if(!$conn) {
|
||||
Log 1, "GetFileFromURL: Can't connect to $host:$port\n";
|
||||
undef $conn;
|
||||
return undef;
|
||||
}
|
||||
$host =~ s/:.*//;
|
||||
my $hdr = ($data ? "POST" : "GET")." $path HTTP/1.0\r\nHost: $host\r\n";
|
||||
if(defined($data)) {
|
||||
$hdr .= "Content-Length: ".length($data)."\r\n";
|
||||
$hdr .= "Content-Type: application/x-www-form-urlencoded";
|
||||
}
|
||||
$hdr .= "\r\n\r\n";
|
||||
syswrite $conn, $hdr;
|
||||
syswrite $conn, $data if(defined($data));
|
||||
shutdown $conn, 1 if(!$noshutdown);
|
||||
|
||||
my ($buf, $ret) = ("", "");
|
||||
$conn->timeout($timeout);
|
||||
for(;;) {
|
||||
my ($rout, $rin) = ('', '');
|
||||
vec($rin, $conn->fileno(), 1) = 1;
|
||||
my $nfound = select($rout=$rin, undef, undef, $timeout);
|
||||
if($nfound <= 0) {
|
||||
Log 1, "GetFileFromURL: Select timeout/error: $!";
|
||||
undef $conn;
|
||||
return undef;
|
||||
}
|
||||
|
||||
my $len = sysread($conn,$buf,65536);
|
||||
last if(!defined($len) || $len <= 0);
|
||||
$ret .= $buf;
|
||||
}
|
||||
|
||||
$ret=~ s/(.*?)\r\n\r\n//s; # Not greedy: switch off the header.
|
||||
Log 4, "GetFileFromURL: Got http://$host$path, length: ".length($ret);
|
||||
undef $conn;
|
||||
return $ret;
|
||||
}
|
||||
|
||||
1;
|
||||
83
fhem/fhem.pl
83
fhem/fhem.pl
@ -226,6 +226,8 @@ $modules{Global}{AttrFn} = "GlobalAttr";
|
||||
Hlp=>"device <options>,modify the definition (e.g. at, notify)" },
|
||||
"quit" => { Fn=>"CommandQuit",
|
||||
Hlp=>",end the client session" },
|
||||
"exit" => { Fn=>"CommandQuit",
|
||||
Hlp=>",end the client session" },
|
||||
"reload" => { Fn=>"CommandReload",
|
||||
Hlp=>"<module-name>,reload the given module (e.g. 99_PRIV)" },
|
||||
"rename" => { Fn=>"CommandRename",
|
||||
@ -1743,6 +1745,7 @@ GlobalAttr($$)
|
||||
my $modpath = "$val/FHEM";
|
||||
|
||||
opendir(DH, $modpath) || return "Can't read $modpath: $!";
|
||||
push @INC, $modpath if(!grep(/$modpath/, @INC));
|
||||
my $counter = 0;
|
||||
|
||||
foreach my $m (sort readdir(DH)) {
|
||||
@ -1760,6 +1763,7 @@ GlobalAttr($$)
|
||||
"the fhem module files <*>.pm";
|
||||
}
|
||||
|
||||
|
||||
}
|
||||
|
||||
return undef;
|
||||
@ -3065,83 +3069,4 @@ secSince2000()
|
||||
return $t;
|
||||
}
|
||||
|
||||
###############################################################################
|
||||
#
|
||||
# internet stuff
|
||||
#
|
||||
##############################################################################
|
||||
|
||||
sub
|
||||
urlEncode($) {
|
||||
$_= $_[0];
|
||||
s/([\x00-\x2F,\x3A-\x40,\x5B-\x60,\x7B-\xFF])/sprintf("%%%02x",ord($1))/eg;
|
||||
return $_;
|
||||
}
|
||||
|
||||
sub
|
||||
GetFileFromURL($@)
|
||||
{
|
||||
my ($url,$timeout)= @_;
|
||||
$timeout = 2.0 if(!defined($timeout));
|
||||
|
||||
if($url !~ /^(http):\/\/([^:\/]+)(:\d+)?(\/.*)$/) {
|
||||
Log 1, "GetFileFromURL $url: malformed URL";
|
||||
return undef;
|
||||
}
|
||||
|
||||
my ($protocol,$host,$port,$path)= ($1,$2,$3,$4);
|
||||
#Debug "Protocol $protocol, host $host port $port, path $path";
|
||||
|
||||
if(defined($port)) {
|
||||
$port=~ s/^://;
|
||||
} else {
|
||||
$port= 80;
|
||||
}
|
||||
$path= '/' unless defined($path);
|
||||
my $hostport= "$host:$port";
|
||||
|
||||
#Debug "Protocol $protocol, host:port $hostport, path $path";
|
||||
|
||||
|
||||
if($protocol ne "http") {
|
||||
Log 1, "GetFileFromURL $url: invalid protocol";
|
||||
return undef;
|
||||
}
|
||||
|
||||
my $conn = IO::Socket::INET->new(PeerAddr => "$hostport");
|
||||
if(!$conn) {
|
||||
Log 1, "GetFileFromURL $url: Can't connect to $hostport\n";
|
||||
undef $conn;
|
||||
return undef;
|
||||
}
|
||||
my $req = "GET $path HTTP/1.0\r\nHost: $hostport\r\n\r\n\r\n";
|
||||
syswrite $conn, $req;
|
||||
shutdown $conn, 1; # stopped writing data
|
||||
my ($buf, $ret) = ("", "");
|
||||
|
||||
$conn->timeout($timeout);
|
||||
for(;;) {
|
||||
my ($rout, $rin) = ('', '');
|
||||
vec($rin, $conn->fileno(), 1) = 1;
|
||||
my $nfound = select($rout=$rin, undef, undef, $timeout);
|
||||
if($nfound <= 0) {
|
||||
Log 1, "GetFileFromURL $url: Select timeout/error: $!";
|
||||
undef $conn;
|
||||
return undef;
|
||||
}
|
||||
|
||||
my $len = sysread($conn,$buf,65536);
|
||||
last if(!defined($len) || $len <= 0);
|
||||
$ret .= $buf;
|
||||
}
|
||||
|
||||
$ret=~ s/(.*?)\r\n\r\n//s; # Not greedy: switch off the header.
|
||||
Log 4, "GetFileFromURL $url: Got file, length: ".length($ret);
|
||||
undef $conn;
|
||||
return $ret;
|
||||
}
|
||||
|
||||
|
||||
##############################################################################
|
||||
|
||||
1;
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user