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) = @_;
  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
  79     my $h = HTTP::Headers->new();
  80     foreach my $k (keys %$headers) {
  81         $h->header($k => $headers->{$k});
  82     }
  83
  84     my $req = HTTP::Request->new(
  85         $method,
  86         $uri,
  87         $h,
  88         $content
  89     );
  90     my $res;
  91
  92     eval {
  93         $logger->info("HTTPClient: sending HTTP $method request to $uri");
  94         $res = $ua->request($req);
  95     } or do {
  96         $logger->info("HTTPClient: execution error");
  97         return undef;
  98     };
  99
 100     if ($res->status_line =~ /timeout/) {
 101         $logger->info("HTTPClient: timeout error: " . $res->status_line);
 102         return undef;
 103     }
 104
 105     # TODO handle HTTP response status codes
 106
 107     return $res;
 108 }
 109
 110 # Wrappers for request() using specific HTTP methods (GET, POST etc).
 111 sub get {
 112     my $self = shift;
 113     return $self->request('GET', @_);
 114 }
 115
 116 sub post {
 117     my $self = shift;
 118     return $self->request('POST', @_);
 119 }
 120
 121 sub put {
 122     my $self = shift;
 123     return $self->request('PUT', @_);
 124 }
 125
 126 sub delete {
 127     my $self = shift;
 128     return $self->request('DELETE', @_);
 129 }
 130
 131 1;