Open-ILS/src/perlmods/lib/OpenILS/Utils/HTTPClient.pm

   1 package OpenILS::Utils::HTTPClient;
   2
   3 use strict;
   4 use warnings;
   5
   6 use OpenSRF::Utils::SettingsClient;
   7 use OpenSRF::Utils::Logger qw($logger);
   8 use OpenSRF::Utils::JSON;
   9 use LWP::UserAgent;
  10 use HTTP::Request;
  11
  12 sub new {
  13     my $class = shift;
  14
  15     my $self = {};
  16     bless $self, $class;
  17
  18     $self->_initialize();
  19
  20     return $self;
  21 }
  22
  23 sub _initialize {
  24     my $self = shift;
  25
  26     # pull settings from opensrf.xml config
  27     my $conf = OpenSRF::Utils::SettingsClient->new();
  28     my $settings = $conf->config_value('http_client');
  29
  30     if ($settings->{useragent}) {
  31         $self->{useragent} = $settings->{useragent};
  32     }
  33     if ($settings->{default_timeout}) {
  34         $self->{default_timeout} = $settings->{default_timeout};
  35     }
  36
  37     # SSL handling options. When communicating over HTTPS, LWP::UserAgent
  38     # falls back to the environment variables whose values are set here.
  39     # See LWP::UserAgent docs for details.
  40     foreach my $opt (keys %{$settings->{ssl_opts}}) {
  41         # check for a valid SSL cert?
  42         if ($opt eq 'verify_hostname') {
  43             $ENV{PERL_LWP_SSL_VERIFY_HOSTNAME} = $settings->{ssl_opts}->{verify_hostname};
  44         # path to directory for CA certificate files
  45         } elsif ($opt eq 'SSL_ca_path') {
  46             $ENV{PERL_LWP_SSL_CA_PATH} = $settings->{ssl_opts}->{SSL_ca_path};
  47         # path to CA certificate file
  48         } elsif ($opt eq 'SSL_ca_file') {
  49             $ENV{PERL_LWP_SSL_CA_FILE} = $settings->{ssl_opts}->{SSL_ca_file};
  50         }
  51     }
  52
  53     return $self;
  54 }
  55
  56 # request(): Send an HTTP request.
  57 #
  58 # Params:
  59 #   $method - HTTP method (GET, POST, PUT, DELETE)
  60 #   $uri - URI of resource to be requested
  61 #   $header - hashref containing HTTP headers
  62 #   $content - content of request
  63 #   $request_timeout - timeout value in seconds; defaults to 60s
  64 #   $useragent - user agent string; defaults to SameOrigin/1.0
  65 #
  66 # Returns an HTTP::Response object, or undef if the request failed/timed out.
  67 # Use $res->content to get response content.
  68 #
  69 sub request {
  70     my ($self, $method, $uri, $headers, $content, $request_timeout, $useragent, $do_not_redirect) = @_;
  71     my $ua = new LWP::UserAgent;
  72
  73     $request_timeout = $request_timeout || $self->{default_timeout} || 60;
  74     $ua->timeout($request_timeout);
  75
  76     $useragent = $useragent || $self->{useragent} || 'SameOrigin/1.0';
  77     $ua->agent($useragent);
  78     if ($do_not_redirect) {
  79         $ua->requests_redirectable([]);
  80     }
  81
  82     my $h = HTTP::Headers->new();
  83     foreach my $k (keys %$headers) {
  84         $h->header($k => $headers->{$k});
  85     }
  86
  87     my $req = HTTP::Request->new(
  88         $method,
  89         $uri,
  90         $h,
  91         $content
  92     );
  93     my $res;
  94
  95     eval {
  96         $logger->info("HTTPClient: sending HTTP $method request to $uri");
  97         $res = $ua->request($req);
  98     } or do {
  99         $logger->info("HTTPClient: execution error");
 100         return undef;
 101     };
 102
 103     if ($res->status_line =~ /timeout/) {
 104         $logger->info("HTTPClient: timeout error: " . $res->status_line);
 105         return undef;
 106     }
 107
 108     # TODO handle HTTP response status codes
 109
 110     return $res;
 111 }
 112
 113 # Wrappers for request() using specific HTTP methods (GET, POST etc).
 114 sub get {
 115     my $self = shift;
 116     return $self->request('GET', @_);
 117 }
 118
 119 sub post {
 120     my $self = shift;
 121     return $self->request('POST', @_);
 122 }
 123
 124 sub put {
 125     my $self = shift;
 126     return $self->request('PUT', @_);
 127 }
 128
 129 sub delete {
 130     my $self = shift;
 131     return $self->request('DELETE', @_);
 132 }
 133
 134 1;