diff options
author | 2020-04-29 23:29:53 -0700 | |
---|---|---|
committer | 2020-04-29 23:29:53 -0700 | |
commit | a8b0ba36853eea23c0e07bcc680bdbe877dcd68e (patch) | |
tree | ca5eef8135de11b1e5e7d2e9c30765223319e5c7 | |
parent | probe-mirmon: discard rsync stderr (diff) | |
download | gentoo-mirrorstats-a8b0ba36853eea23c0e07bcc680bdbe877dcd68e.tar.gz gentoo-mirrorstats-a8b0ba36853eea23c0e07bcc680bdbe877dcd68e.tar.bz2 gentoo-mirrorstats-a8b0ba36853eea23c0e07bcc680bdbe877dcd68e.zip |
probe-mirmon: use libcurl instead of exec wget
Signed-off-by: Robin H. Johnson <robbat2@gentoo.org>
-rwxr-xr-x | probe-mirmon | 38 |
1 files changed, 37 insertions, 1 deletions
diff --git a/probe-mirmon b/probe-mirmon index 8c57691..6d67fbf 100755 --- a/probe-mirmon +++ b/probe-mirmon @@ -21,6 +21,7 @@ use strict; use warnings; use Date::Parse (); # dev-perl/TimeDate use File::Tempdir; # dev-perl/File-Tempdir +use WWW::Curl::Easy; sub main { my ( $timeout, $url ) = @_; @@ -28,10 +29,45 @@ sub main { handle_rsync( $timeout, $url ); } else { - handle_wget( $timeout, $url ); + handle_libcurl( $timeout, $url ); } } +sub handle_libcurl { + my ( $timeout, $url ) = @_; + + my $curl = WWW::Curl::Easy->new; + + $curl->setopt(CURLOPT_HEADER, 0); + $curl->setopt(CURLOPT_CONNECTTIMEOUT, $timeout); + $curl->setopt(CURLOPT_TIMEOUT, $timeout); + $curl->setopt(CURLOPT_FTP_USE_EPSV, 1); + $curl->setopt(CURLOPT_URL, $url); + + # A filehandle, reference to a scalar or reference to a typeglob can be used here. + my $response_body; + $curl->setopt(CURLOPT_WRITEDATA,\$response_body); + + # Starts the actual request + my $retcode = $curl->perform; + + # Looking at the results... + if ($retcode == 0) { + #print("Transfer went ok\n"); + my $response_code = $curl->getinfo(CURLINFO_HTTP_CODE); + # judge result and next action based on $response_code + #print("Received response: $response_code $response_body\n"); + chomp $response_body; + #print("s='$response_body'\n"); + print(munge_date($response_body), "\n"); + } else { + # Error code, type of error, error message + #print("An error happened: $retcode ".$curl->strerror($retcode)." ".$curl->errbuf."\n"); + exit 800; + } + +} + sub handle_wget { my ( $timeout, $url ) = @_; # TODO: replace this with native HTTP |