From 77f8b367decae2bbe1f3061a6945e4c2c98d94cf Mon Sep 17 00:00:00 2001 From: Jeff Davis Date: Fri, 20 Nov 2015 13:54:36 -0800 Subject: [PATCH] LP#1541559: HTTPClient: a utility for sending HTTP requests and handling responses The intent of this package is to provide basic tools for communicating with third-party APIs. It is a dependency of the open-ils.ebook_api service. Signed-off-by: Jeff Davis Signed-off-by: Kathy Lussier --- Open-ILS/examples/opensrf.xml.example | 33 +++++ Open-ILS/src/perlmods/MANIFEST | 1 + .../perlmods/lib/OpenILS/Utils/HTTPClient.pm | 131 ++++++++++++++++++ Open-ILS/src/perlmods/t/14-OpenILS-Utils.t | 3 +- 4 files changed, 167 insertions(+), 1 deletion(-) create mode 100644 Open-ILS/src/perlmods/lib/OpenILS/Utils/HTTPClient.pm diff --git a/Open-ILS/examples/opensrf.xml.example b/Open-ILS/examples/opensrf.xml.example index 9205229ab3..dd128bd959 100644 --- a/Open-ILS/examples/opensrf.xml.example +++ b/Open-ILS/examples/opensrf.xml.example @@ -232,6 +232,39 @@ vim:et:ts=4:sw=4: instructions on mapping the old XML entries to database tables. --> + + + + + + + 60 + + + + 1 + + + + + + OpenILS::WWW::AddedContent::OpenLibrary diff --git a/Open-ILS/src/perlmods/MANIFEST b/Open-ILS/src/perlmods/MANIFEST index f8a77a48f8..216c40d60c 100644 --- a/Open-ILS/src/perlmods/MANIFEST +++ b/Open-ILS/src/perlmods/MANIFEST @@ -132,6 +132,7 @@ lib/OpenILS/Utils/Cronscript.pm lib/OpenILS/Utils/Cronscript.pm.in lib/OpenILS/Utils/CStoreEditor.pm lib/OpenILS/Utils/Fieldmapper.pm +lib/OpenILS/Utils/HTTPClient.pm lib/OpenILS/Utils/ISBN.pm lib/OpenILS/Utils/Lockfile.pm lib/OpenILS/Utils/MFHD.pm diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Utils/HTTPClient.pm b/Open-ILS/src/perlmods/lib/OpenILS/Utils/HTTPClient.pm new file mode 100644 index 0000000000..64745866c4 --- /dev/null +++ b/Open-ILS/src/perlmods/lib/OpenILS/Utils/HTTPClient.pm @@ -0,0 +1,131 @@ +package OpenILS::Utils::HTTPClient; + +use strict; +use warnings; + +use OpenSRF::Utils::SettingsClient; +use OpenSRF::Utils::Logger qw($logger); +use OpenSRF::Utils::JSON; +use LWP::UserAgent; +use HTTP::Request; + +sub new { + my $class = shift; + + my $self = {}; + bless $self, $class; + + $self->_initialize(); + + return $self; +} + +sub _initialize { + my $self = shift; + + # pull settings from opensrf.xml config + my $conf = OpenSRF::Utils::SettingsClient->new(); + my $settings = $conf->config_value('http_client'); + + if ($settings->{useragent}) { + $self->{useragent} = $settings->{useragent}; + } + if ($settings->{default_timeout}) { + $self->{default_timeout} = $settings->{default_timeout}; + } + + # SSL handling options. When communicating over HTTPS, LWP::UserAgent + # falls back to the environment variables whose values are set here. + # See LWP::UserAgent docs for details. + foreach my $opt (keys %{$settings->{ssl_opts}}) { + # check for a valid SSL cert? + if ($opt eq 'verify_hostname') { + $ENV{PERL_LWP_SSL_VERIFY_HOSTNAME} = $settings->{ssl_opts}->{verify_hostname}; + # path to directory for CA certificate files + } elsif ($opt eq 'SSL_ca_path') { + $ENV{PERL_LWP_SSL_CA_PATH} = $settings->{ssl_opts}->{SSL_ca_path}; + # path to CA certificate file + } elsif ($opt eq 'SSL_ca_file') { + $ENV{PERL_LWP_SSL_CA_FILE} = $settings->{ssl_opts}->{SSL_ca_file}; + } + } + + return $self; +} + +# request(): Send an HTTP request. +# +# Params: +# $method - HTTP method (GET, POST, PUT, DELETE) +# $uri - URI of resource to be requested +# $header - hashref containing HTTP headers +# $content - content of request +# $request_timeout - timeout value in seconds; defaults to 60s +# $useragent - user agent string; defaults to SameOrigin/1.0 +# +# Returns an HTTP::Response object, or undef if the request failed/timed out. +# Use $res->content to get response content. +# +sub request { + my ($self, $method, $uri, $headers, $content, $request_timeout, $useragent) = @_; + my $ua = new LWP::UserAgent; + + $request_timeout = $request_timeout || $self->{default_timeout} || 60; + $ua->timeout($request_timeout); + + $useragent = $useragent || $self->{useragent} || 'SameOrigin/1.0'; + $ua->agent($useragent); + + my $h = HTTP::Headers->new(); + foreach my $k (keys %$headers) { + $h->header($k => $headers->{$k}); + } + + my $req = HTTP::Request->new( + $method, + $uri, + $h, + $content + ); + my $res; + + eval { + $logger->info("HTTPClient: sending HTTP $method request to $uri"); + $res = $ua->request($req); + } or do { + $logger->info("HTTPClient: execution error"); + return undef; + }; + + if ($res->status_line =~ /timeout/) { + $logger->info("HTTPClient: timeout error: " . $res->status_line); + return undef; + } + + # TODO handle HTTP response status codes + + return $res; +} + +# Wrappers for request() using specific HTTP methods (GET, POST etc). +sub get { + my $self = shift; + return $self->request('GET', @_); +} + +sub post { + my $self = shift; + return $self->request('POST', @_); +} + +sub put { + my $self = shift; + return $self->request('PUT', @_); +} + +sub delete { + my $self = shift; + return $self->request('DELETE', @_); +} + +1; diff --git a/Open-ILS/src/perlmods/t/14-OpenILS-Utils.t b/Open-ILS/src/perlmods/t/14-OpenILS-Utils.t index 180686f7c0..548bea3101 100644 --- a/Open-ILS/src/perlmods/t/14-OpenILS-Utils.t +++ b/Open-ILS/src/perlmods/t/14-OpenILS-Utils.t @@ -1,6 +1,6 @@ #!perl -T -use Test::More tests => 29; +use Test::More tests => 30; use Test::Warn; use utf8; @@ -20,6 +20,7 @@ use_ok( 'OpenILS::Utils::PermitHold' ); use_ok( 'OpenILS::Utils::RemoteAccount' ); use_ok( 'OpenILS::Utils::ZClient' ); use_ok( 'OpenILS::Utils::EDIReader' ); +use_ok( 'OpenILS::Utils::HTTPClient' ); # LP 800269 - Test MFHD holdings for records that only contain a caption field my $co_marc = MARC::Record->new(); -- 2.43.2