package REJBlibUA::client; use strict; use warnings; #use Net::SSL (); use English qw(-no_match_vars); use HTTP::Status; use LWP::UserAgent; use LWP::Protocol::https; use HTTP::Request; use HTTP::Request::Common; use HTTP::Response; use Log::Log4perl qw(:easy get_logger); use UNIVERSAL::require; use Encode qw(decode encode); my $log_prefix = "[http client] "; sub new { my ($class, %params) = @_; die "non-existing certificate file $params{ca_cert_file}" if $params{ca_cert_file} && ! -f $params{ca_cert_file}; die "non-existing certificate directory $params{ca_cert_dir}" if $params{ca_cert_dir} && ! -d $params{ca_cert_dir}; my $self = { logger => '', user => $params{user}, password => $params{password}, timeout => $params{timeout} || 180, ssl_set => 0, no_ssl_check => $params{no_ssl_check}, ca_cert_dir => $params{ca_cert_dir}, ca_cert_file => $params{ca_cert_file}, SSL_cert_file => $params{SSL_cert_file}, SSL_key_file => $params{SSL_key_file}, }; bless $self, $class; my $conf = q( log4perl.logger = INFO, FileApp, ScreenApp # log4perl.logger = TRACE, FileApp, ScreenApp log4perl.appender.FileApp = Log::Log4perl::Appender::File log4perl.appender.FileApp.filename = lwp.log log4perl.appender.FileApp.layout = PatternLayout log4perl.appender.FileApp.layout.ConversionPattern = %d> %m%n log4perl.appender.ScreenApp = Log::Log4perl::Appender::Screen log4perl.appender.ScreenApp.stderr = 0 log4perl.appender.ScreenApp.layout = PatternLayout log4perl.appender.ScreenApp.layout.ConversionPattern = %d> %m%n ); # Initialize logging behaviour Log::Log4perl->init( \$conf ); # Log::Log4perl->infiltrate_lwp(); *trace = *INFO; *conns = *DEBUG; *debug = *DEBUG; $self->{'logger'} = get_logger(); # create user agent $self->{ua} = LWP::UserAgent->new( parse_head => 0, # No need to parse HTML keep_alive => 1, requests_redirectable => ['POST', 'GET', 'HEAD'] ); $self->{ua}->ssl_opts(verify_hostname => 1, SSL_verify_mode => 1); if ($params{proxy}) { $self->{ua}->proxy(['http', 'https'], $params{proxy}); } else { $self->{ua}->env_proxy(); } $self->{ua}->timeout($self->{timeout}); return $self; } sub request { my ($self, $request, $file) = @_; # $request is a HTTP::Request object, created with only the URL # $file is a message, normally an XML file my $logger = $self->{logger}; my $url = $request->uri(); my $scheme = $url->scheme(); print "\$url = $url\n\t\$scheme = $scheme\n"; print "\t\$self->{ssl_set} = ",$self->{ssl_set},"\n"; print "\t\$self->{ca_cert_dir} = ",$self->{ca_cert_dir},"\n"; print "\t\$self->{ca_cert_file} = ",$self->{ca_cert_file},"\n"; $self->_setSSLOptions() if $scheme eq 'https' && !$self->{ssl_set}; my $result = HTTP::Response->new( 500 ); eval { $result = $self->{ua}->request($request, $file); }; # check result first if (!$result->is_success()) { # authentication required if ($result->code() == 401) { if ($self->{user} && $self->{password}) { $logger->debug( $log_prefix . "authentication required, submitting credentials" ); # compute authentication parameters my $header = $result->header('www-authenticate'); my ($realm) = $header =~ /^Basic realm="(.*)"/; my $host = $url->host(); my $port = $url->port() || ($scheme eq 'https' ? 443 : 80); $self->{ua}->credentials( "$host:$port", $realm, $self->{user}, $self->{password} ); # replay request eval { if ($OSNAME eq 'MSWin32' && $scheme eq 'https') { alarm $self->{timeout}; } $result = $self->{ua}->request($request, $file); }; if (!$result->is_success()) { $logger->error( $log_prefix . "authentication required, wrong credentials" ); } } else { # abort $logger->error( $log_prefix . "authentication required, no credentials available" ); } } else { $logger->error( $log_prefix . "communication error: " . $result->status_line() ); } } return $result; } sub _setSSLOptions { my ($self) = @_; # SSL handling $ENV{HTTPS_DEBUG} = 1; if ($self->{no_ssl_check}) { # LWP 6 default behaviour is to check hostname # Fedora also backported this behaviour change in its LWP5 package, so # just checking on LWP version is not enough $self->{ua}->ssl_opts(verify_hostname => 0, SSL_verify_mode => 0) if $self->{ua}->can('ssl_opts'); } else { # only IO::Socket::SSL can perform full server certificate validation, # Net::SSL is only able to check certification authority, and not # certificate hostname # IO::Socket::SSL->require(); # IO::Socket::SSL->require('debug3'); use IO::Socket::SSL qw(debug3); die "failed to load IO::Socket::SSL, " . "unable to perform SSL certificate validation.\n" . "You can use 'no-ssl-check' option to disable it." if $EVAL_ERROR; # if ($self->{logger}{debug} >= 3) { # $Net::SSLeay::trace = 2; # } print "\t\t\$LWP::VERSION = $LWP::VERSION\n"; if ($LWP::VERSION >= 6) { print "\t\tSetting cert dir and file if available\n"; $self->{ua}->ssl_opts(SSL_ca_file => $self->{ca_cert_file}) if $self->{ca_cert_file}; $self->{ua}->ssl_opts(SSL_ca_path => $self->{ca_cert_dir}) if $self->{ca_cert_dir}; $self->{ua}->ssl_opts(SSL_cert_file => $self->{SSL_cert_file}) if $self->{SSL_cert_file}; $self->{ua}->ssl_opts(SSL_key_file => $self->{SSL_key_file}) if $self->{SSL_key_file}; } } $self->{ssl_set} = 1; } 1;