mirror of
https://github.com/fhem/fhem-mirror.git
synced 2025-04-20 07:16:03 +00:00
HttpUtils: complete rewrite, addition of HttpUtils_NonblockingGet
git-svn-id: https://svn.fhem.de/fhem/trunk@4514 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
rudolfkoenig
parent
2930641431
commit
d1d39de466
@ -53,94 +53,174 @@ urlDecode($) {
|
|||||||
return $_;
|
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
|
|
||||||
# 4.0 is needed for some clients trying to reach fhem.de, 2.0 was not enough
|
|
||||||
sub
|
sub
|
||||||
CustomGetFileFromURL($$@)
|
HttpUtils_ConnErr($)
|
||||||
{
|
{
|
||||||
my ($quiet, $url, $timeout, $data, $noshutdown, $loglevel) = @_;
|
my ($hash) = @_;
|
||||||
$timeout = 4.0 if(!defined($timeout));
|
if(defined($hash->{FD})) {
|
||||||
$loglevel = 4 if(!$loglevel);
|
delete($hash->{FD});
|
||||||
|
delete($selectlist{$hash});
|
||||||
|
$hash->{callback}($hash, "connect to $hash->{addr} timed out", "");
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
my $redirects= 0;
|
sub
|
||||||
|
HttpUtils_ReadErr($)
|
||||||
|
{
|
||||||
|
my ($hash) = @_;
|
||||||
|
if(defined($hash->{FD})) {
|
||||||
|
delete($hash->{FD});
|
||||||
|
delete($selectlist{$hash});
|
||||||
|
$hash->{callback}($hash, "read from $hash->{addr} timed out", "");
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
RETRY:
|
|
||||||
|
|
||||||
my $displayurl= $quiet ? "<hidden>" : $url;
|
sub
|
||||||
Log3 undef, $loglevel, "CustomGetFileFromURL url=$displayurl";
|
HttpUtils_Connect($)
|
||||||
if($url !~ /^(http|https):\/\/(([^:\/]+):([^:\/]+)@)?([^:\/]+)(:\d+)?(\/.*)$/) {
|
{
|
||||||
Log3 undef, $loglevel,
|
my ($hash) = @_;
|
||||||
"CustomGetFileFromURL $displayurl: malformed or unsupported URL";
|
|
||||||
return undef;
|
$hash->{timeout} = 4 if(!defined($hash->{timeout}));
|
||||||
|
$hash->{loglevel} = 4 if(!$hash->{loglevel});
|
||||||
|
$hash->{redirects} = 0 if(!$hash->{redirects});
|
||||||
|
$hash->{displayurl} = $hash->{hideurl} ? "<hidden>" : $hash->{url};
|
||||||
|
|
||||||
|
Log3 undef, $hash->{loglevel}, "HttpUtils url=$hash->{displayurl}";
|
||||||
|
|
||||||
|
if($hash->{url} !~
|
||||||
|
/^(http|https):\/\/(([^:\/]+):([^:\/]+)@)?([^:\/]+)(:\d+)?(\/.*)$/) {
|
||||||
|
return "$hash->{displayurl}: malformed or unsupported URL";
|
||||||
}
|
}
|
||||||
|
|
||||||
my ($protocol,$authstring,$user,$pwd,$host,$port,$path) =
|
my ($authstring,$user,$pwd,$port,$host);
|
||||||
($1,$2,$3,$4,$5,$6,$7);
|
($hash->{protocol},$authstring,$user,$pwd,$host,$port,$hash->{path})
|
||||||
|
= ($1,$2,$3,$4,$5,$6,$7);
|
||||||
|
$hash->{host} = $host;
|
||||||
|
|
||||||
if(defined($port)) {
|
if(defined($port)) {
|
||||||
$port =~ s/^://;
|
$port =~ s/^://;
|
||||||
} else {
|
} else {
|
||||||
$port = ($protocol eq "https" ? 443: 80);
|
$port = ($hash->{protocol} eq "https" ? 443: 80);
|
||||||
}
|
}
|
||||||
$path= '/' unless defined($path);
|
$hash->{path} = '/' unless defined($hash->{path});
|
||||||
|
$hash->{addr} = "$hash->{protocol}://$host:$port";
|
||||||
|
$hash->{auth} = encode_base64("$user:$pwd","") if($authstring);
|
||||||
|
|
||||||
my $auth64;
|
if($hash->{callback}) { # Nonblocking staff
|
||||||
if(defined($authstring)) {
|
$hash->{conn} = IO::Socket::INET->new(Proto=>'tcp', Blocking=>0);
|
||||||
$auth64 = encode_base64("$user:$pwd","");
|
if($hash->{conn}) {
|
||||||
|
my $iaddr = inet_aton($host);
|
||||||
|
if(!defined($iaddr)) {
|
||||||
|
my @addr = gethostbyname($host); # This is still blocking
|
||||||
|
return "gethostbyname $host failed" if(!$addr[0]);
|
||||||
|
$iaddr = $addr[4];
|
||||||
|
}
|
||||||
|
my $ret = connect($hash->{conn}, sockaddr_in($port, $iaddr));
|
||||||
|
if(!$ret) {
|
||||||
|
if($!{EINPROGRESS} || int($!)==10035) { # Nonblocking connect
|
||||||
|
|
||||||
|
$hash->{FD} = $hash->{conn}->fileno();
|
||||||
|
$hash->{directWriteFn} = sub() {
|
||||||
|
delete($hash->{FD});
|
||||||
|
delete($hash->{directWriteFn});
|
||||||
|
delete($selectlist{$hash});
|
||||||
|
|
||||||
|
my $packed = getsockopt($hash->{conn}, SOL_SOCKET, SO_ERROR);
|
||||||
|
my $errno = unpack("I",$packed);
|
||||||
|
return $hash->{callback}($hash, "$host: ".strerror($errno), "")
|
||||||
|
if($errno);
|
||||||
|
|
||||||
|
return HttpUtils_Connect2($hash);
|
||||||
|
};
|
||||||
|
$hash->{NAME} = ""; # Delete might check it
|
||||||
|
$selectlist{$hash} = $hash;
|
||||||
|
InternalTimer(gettimeofday()+$hash->{timeout},
|
||||||
|
"HttpUtils_ConnErr", $hash, 0);
|
||||||
|
return undef;
|
||||||
|
} else {
|
||||||
|
return "connect: $!";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
} else {
|
||||||
|
$hash->{conn} = IO::Socket::INET->new(
|
||||||
|
PeerAddr=>"$host:$port", Timeout=>$hash->{timeout});
|
||||||
}
|
}
|
||||||
|
return HttpUtils_Connect2($hash);
|
||||||
|
}
|
||||||
|
|
||||||
my $conn;
|
sub
|
||||||
my $errstr= "";
|
HttpUtils_Connect2($)
|
||||||
if($protocol eq "https") {
|
{
|
||||||
|
my ($hash) = @_;
|
||||||
|
|
||||||
|
if($hash->{protocol} eq "https" && $hash->{conn}) {
|
||||||
eval "use IO::Socket::SSL";
|
eval "use IO::Socket::SSL";
|
||||||
if($@) {
|
if($@) {
|
||||||
Log3 undef, $loglevel, $@;
|
Log3 undef, $hash->{loglevel}, $@;
|
||||||
} else {
|
} else {
|
||||||
$conn = IO::Socket::SSL->new(PeerAddr=>"$host:$port", Timeout=>$timeout);
|
$hash->{conn}->blocking(1);
|
||||||
|
IO::Socket::SSL->start_SSL($hash->{conn}, Timeout=>$hash->{timeout})
|
||||||
|
|| undef $hash->{conn};
|
||||||
}
|
}
|
||||||
} else {
|
|
||||||
$conn = IO::Socket::INET->new(PeerAddr=>"$host:$port", Timeout=>$timeout);
|
|
||||||
}
|
}
|
||||||
$errstr= $@ if(!$conn);
|
if(!$hash->{conn}) {
|
||||||
if(!$conn) {
|
undef $hash->{conn};
|
||||||
Log3 undef, $loglevel, "CustomGetFileFromURL $displayurl: ".
|
return "$hash->{displayurl}: Can't connect to $hash->{addr}: $@";
|
||||||
"Can't connect to $protocol://$host:$port, $errstr";
|
}
|
||||||
undef $conn;
|
|
||||||
|
$hash->{host} =~ s/:.*//;
|
||||||
|
my $hdr = ($hash->{data} ? "POST" : "GET")." $hash->{path} HTTP/1.0\r\n";
|
||||||
|
$hdr .= "Host: $hash->{host}\r\n";
|
||||||
|
$hdr .= "Authorization: Basic $hash->{auth}\r\n" if(defined($hash->{auth}));
|
||||||
|
$hdr .= $hash->{header}."\r\n" if(defined($hash->{header}));
|
||||||
|
if(defined($hash->{data})) {
|
||||||
|
$hdr .= "Content-Length: ".length($hash->{data})."\r\n";
|
||||||
|
$hdr .= "Content-Type: application/x-www-form-urlencoded\r\n"
|
||||||
|
if ($hdr !~ "Content-Type:");
|
||||||
|
}
|
||||||
|
$hdr .= "\r\n";
|
||||||
|
syswrite $hash->{conn}, $hdr;
|
||||||
|
syswrite $hash->{conn}, $hash->{data} if(defined($hash->{data}));
|
||||||
|
shutdown $hash->{conn}, 1 if(!$hash->{noshutdown});
|
||||||
|
|
||||||
|
if($hash->{callback}) { # Nonblocking read
|
||||||
|
$hash->{FD} = $hash->{conn}->fileno();
|
||||||
|
$hash->{buf} = "";
|
||||||
|
$hash->{directReadFn} = sub() {
|
||||||
|
my $buf;
|
||||||
|
my $len = sysread($hash->{conn},$buf,65536);
|
||||||
|
if(!defined($len) || $len <= 0) { # EOF
|
||||||
|
delete($hash->{FD});
|
||||||
|
delete($hash->{directReadFn});
|
||||||
|
delete($selectlist{$hash});
|
||||||
|
my ($err, $ret, $redirect) = HttpUtils_ParseAnswer($hash, $hash->{buf});
|
||||||
|
$hash->{callback}($hash, $err, $ret) if(!$redirect);
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
$hash->{buf} .= $buf;
|
||||||
|
};
|
||||||
|
$selectlist{$hash} = $hash;
|
||||||
|
InternalTimer(gettimeofday()+$hash->{timeout},
|
||||||
|
"HttpUtils_ReadErr", $hash, 0);
|
||||||
return undef;
|
return undef;
|
||||||
}
|
}
|
||||||
|
|
||||||
$host =~ s/:.*//;
|
return undef;
|
||||||
my $hdr = ($data ? "POST" : "GET")." $path HTTP/1.0\r\nHost: $host\r\n";
|
}
|
||||||
if(defined($authstring)) {
|
|
||||||
$hdr .= "Authorization: Basic $auth64\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) = ("", "");
|
sub
|
||||||
$conn->timeout($timeout);
|
HttpUtils_ParseAnswer($$)
|
||||||
for(;;) {
|
{
|
||||||
my ($rout, $rin) = ('', '');
|
my ($hash, $ret) = @_;
|
||||||
vec($rin, $conn->fileno(), 1) = 1;
|
|
||||||
my $nfound = select($rout=$rin, undef, undef, $timeout);
|
|
||||||
if($nfound <= 0) {
|
|
||||||
Log3 undef, $loglevel,
|
|
||||||
"CustomGetFileFromURL $displayurl: Select timeout/error: $!";
|
|
||||||
undef $conn;
|
|
||||||
return undef;
|
|
||||||
}
|
|
||||||
|
|
||||||
my $len = sysread($conn,$buf,65536);
|
$hash->{conn}->close();
|
||||||
last if(!defined($len) || $len <= 0);
|
undef $hash->{conn};
|
||||||
$ret .= $buf;
|
|
||||||
|
if(!$ret) {
|
||||||
|
return ("$hash->{displayurl}: empty answer received", "");
|
||||||
}
|
}
|
||||||
|
|
||||||
$ret=~ s/(.*?)\r\n\r\n//s; # Not greedy: switch off the header.
|
$ret=~ s/(.*?)\r\n\r\n//s; # Not greedy: switch off the header.
|
||||||
@ -149,44 +229,114 @@ CustomGetFileFromURL($$@)
|
|||||||
my $code= $header0[1];
|
my $code= $header0[1];
|
||||||
|
|
||||||
if(!defined($code) || $code eq "") {
|
if(!defined($code) || $code eq "") {
|
||||||
Log3 undef, $loglevel,
|
return ("$hash->{displayurl}: empty answer received", "");
|
||||||
"CustomGetFileFromURL $displayurl: empty answer received";
|
|
||||||
return undef;
|
|
||||||
}
|
}
|
||||||
Log3 undef, $loglevel,
|
Log3 undef,$hash->{loglevel}, "$hash->{displayurl}: HTTP response code $code";
|
||||||
"CustomGetFileFromURL $displayurl: HTTP Response code $code";
|
|
||||||
|
|
||||||
if($code == 301 || $code == 302 || $code == 303) { # redirect
|
if($code==301 || $code==302 || $code==303) { # redirect
|
||||||
if(++$redirects > 5) {
|
if(++$hash->{redirects} > 5) {
|
||||||
Log3 undef, $loglevel,
|
return ("$hash->{displayurl}: Too many redirects", "");
|
||||||
"CustomGetFileFromURL $displayurl: Too many redirects";
|
|
||||||
|
|
||||||
} else {
|
} else {
|
||||||
map { $url=$1 if($_ =~ m/Location:\s*(\S+)$/) } @header;
|
my $ra;
|
||||||
Log3 undef, $loglevel, "CustomGetFileFromURL $displayurl: ".
|
map { $ra=$1 if($_ =~ m/Location:\s*(\S+)$/) } @header;
|
||||||
"Redirect to ".($quiet ? "<hidden>" : $url);
|
$hash->{url} = ($ra =~ m/^http/) ? $ra: $hash->{addr}.$ra;
|
||||||
goto RETRY;
|
Log3 undef, $hash->{loglevel}, "HttpUtils $hash->{displayurl}: ".
|
||||||
|
"Redirect to ".($hash->{hideurl} ? "<hidden>" : $hash->{url});
|
||||||
|
if($hash->{callback}) {
|
||||||
|
HttpUtils_NonblockingGet($hash);
|
||||||
|
return ("", "", 1);
|
||||||
|
} else {
|
||||||
|
return HttpUtils_BlockingGet($hash);
|
||||||
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
my $hostpath= $quiet ? "<hidden>" : $host . $path;
|
# Debug
|
||||||
Log3 undef, $loglevel,
|
Log3 undef, $hash->{loglevel},
|
||||||
"CustomGetFileFromURL $displayurl: Got data, length: ".length($ret);
|
"HttpUtils $hash->{displayurl}: Got data, length: ". length($ret);
|
||||||
if(!length($ret)) {
|
if(!length($ret)) {
|
||||||
Log3 undef, $loglevel,
|
Log3 undef, $hash->{loglevel}, "HttpUtils $hash->{displayurl}: ".
|
||||||
"CustomGetFileFromURL $displayurl: Zero length data, header follows...";
|
"Zero length data, header follows:";
|
||||||
for (@header) {
|
for (@header) {
|
||||||
Log3 undef, $loglevel, "CustomGetFileFromURL $displayurl: $_";
|
Log3 undef, $hash->{loglevel}, " $_";
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
undef $conn;
|
return ("", $ret);
|
||||||
|
}
|
||||||
|
|
||||||
|
# Parameters in the hash:
|
||||||
|
# mandatory:
|
||||||
|
# url, callback
|
||||||
|
# optional(default):
|
||||||
|
# hideurl(0),timeout(4),data(""),noshutdown(0),loglevel(4),header("")
|
||||||
|
# Example:
|
||||||
|
# HttpUtils_NonblockingGet({
|
||||||
|
# url=>"http://192.168.178.112:8888/fhem",
|
||||||
|
# myParam=>7,
|
||||||
|
# callback=>sub($$$){ Log 1,"$_[0]->{myParam} ERR:$_[1] DATA:$_[2]" }
|
||||||
|
# })
|
||||||
|
sub
|
||||||
|
HttpUtils_NonblockingGet($)
|
||||||
|
{
|
||||||
|
my ($hash) = @_;
|
||||||
|
my $err = HttpUtils_Connect($hash);
|
||||||
|
$hash->{callback}($hash, $err, "") if($err);
|
||||||
|
}
|
||||||
|
|
||||||
|
#################
|
||||||
|
# Parameters same as HttpUtils_NonblockingGet up to callback
|
||||||
|
# Returns (err,data)
|
||||||
|
sub
|
||||||
|
HttpUtils_BlockingGet($)
|
||||||
|
{
|
||||||
|
my ($hash) = @_;
|
||||||
|
my $err = HttpUtils_Connect($hash);
|
||||||
|
return ($err, undef) if($err);
|
||||||
|
|
||||||
|
my ($buf, $ret) = ("", "");
|
||||||
|
$hash->{conn}->timeout($hash->{timeout});
|
||||||
|
for(;;) {
|
||||||
|
my ($rout, $rin) = ('', '');
|
||||||
|
vec($rin, $hash->{conn}->fileno(), 1) = 1;
|
||||||
|
my $nfound = select($rout=$rin, undef, undef, $hash->{timeout});
|
||||||
|
if($nfound <= 0) {
|
||||||
|
undef $hash->{conn};
|
||||||
|
return ("$hash->{displayurl}: Select timeout/error: $!", undef);
|
||||||
|
}
|
||||||
|
|
||||||
|
my $len = sysread($hash->{conn},$buf,65536);
|
||||||
|
last if(!defined($len) || $len <= 0);
|
||||||
|
$ret .= $buf;
|
||||||
|
}
|
||||||
|
return HttpUtils_ParseAnswer($hash, $ret);
|
||||||
|
}
|
||||||
|
|
||||||
|
# Deprecated, use GetFileFromURL/GetFileFromURLQuiet
|
||||||
|
sub
|
||||||
|
CustomGetFileFromURL($$@)
|
||||||
|
{
|
||||||
|
my ($hideurl, $url, $timeout, $data, $noshutdown, $loglevel) = @_;
|
||||||
|
my $hash = { hideurl => $hideurl,
|
||||||
|
url => $url,
|
||||||
|
timeout => $timeout,
|
||||||
|
data => $data,
|
||||||
|
noshutdown=> $noshutdown,
|
||||||
|
loglevel => $loglevel,
|
||||||
|
};
|
||||||
|
my ($err, $ret) = HttpUtils_BlockingGet($hash);
|
||||||
|
if($err) {
|
||||||
|
Log3 undef, $hash->{loglevel}, "CustomGetFileFromURL $err";
|
||||||
|
return undef;
|
||||||
|
}
|
||||||
return $ret;
|
return $ret;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
##################
|
##################
|
||||||
# Compatibility mode
|
# Parameter: $url, $timeout, $data, $noshutdown, $loglevel
|
||||||
|
# - if data (which is urlEncoded) is set, then a POST is performed, else a GET.
|
||||||
|
# - noshutdown must be set e.g. if calling the Fritz!Box Webserver
|
||||||
sub
|
sub
|
||||||
GetFileFromURL($@)
|
GetFileFromURL($@)
|
||||||
{
|
{
|
||||||
@ -194,6 +344,8 @@ GetFileFromURL($@)
|
|||||||
return CustomGetFileFromURL(0, $url, @a);
|
return CustomGetFileFromURL(0, $url, @a);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
##################
|
||||||
|
# Same as GetFileFromURL, but the url is not displayed in the log.
|
||||||
sub
|
sub
|
||||||
GetFileFromURLQuiet($@)
|
GetFileFromURLQuiet($@)
|
||||||
{
|
{
|
||||||
@ -208,5 +360,4 @@ GetHttpFile($$)
|
|||||||
return GetFileFromURL("http://$host$file");
|
return GetFileFromURL("http://$host$file");
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
1;
|
1;
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user