Net-ICAP-Client
view release on metacpan or search on metacpan
lib/Net/ICAP/Client.pm view on Meta::CPAN
package Net::ICAP::Client;
use strict;
use warnings;
use English qw(-no_match_vars);
use IO::Socket::INET();
use IO::Socket::SSL();
use Carp();
use URI();
use HTTP::Request();
use HTTP::Response();
use POSIX();
our $VERSION = '0.08';
sub _CHUNK_SIZE { return 4096 }
sub _FILE_READ_SIZE { return 8192 }
sub _ENTIRE_ICAP_HEADERS_REGEX { return qr/\A(.*?)\r?\n\r?\n/smx }
sub _STAT_SIZE_IDX { return 7 }
sub _DEBUG_PREFIX_SIZE { return 3 }
sub _ICAP_RESPONSE_PEEK_SIZE { return 1 }
sub new {
my ( $class, $uri, %params ) = @_;
my $self = {
_uri => URI->new($uri),
_agent => "perl($class) v$VERSION",
_allow_204 => 1,
_allow_preview => 1,
};
if ( $self->{_uri}->_scheme() eq 'icaps' ) {
$self->{_ssl} = { SSL_verify_mode => 1 };
foreach my $possible_ca_file (
'/etc/pki/tls/certs/ca-bundle.crt',
'/usr/share/ssl/certs/ca-bundle.crt',
)
{
if ( -f $possible_ca_file ) {
$self->{_ssl}->{SSL_ca_file} = $possible_ca_file;
}
}
foreach my $possible_ca_path ( '/usr/share/ca-certificates', ) {
if ( -f $possible_ca_path ) {
$self->{_ssl}->{SSL_ca_path} = $possible_ca_path;
}
}
$self->{_ssl}->{SSL_verifycn_scheme} = 'http';
$self->{_ssl}->{SSL_verifycn_name} = $self->{_uri}->host();
delete $params{SSL};
}
foreach my $key ( sort { $a cmp $b } keys %params ) {
if ( $key =~ /^SSL_/smx ) {
$self->{_ssl}->{$key} = delete $params{$key};
}
}
bless $self, $class;
return $self;
}
sub debug {
my ( $self, $debug ) = @_;
my $old = $self->{_debug};
if ( @ARG > 1 ) {
$self->{_debug} = $debug;
}
return $old;
}
lib/Net/ICAP/Client.pm view on Meta::CPAN
}
elsif ( $self->{_previous_direction} ) {
my $quoted_previous_direction =
quotemeta $self->{_previous_direction};
$self->{_debug_buffer} =~
s/(\r?\n)/$1$self->{_previous_direction}/smxg;
$self->{_debug_buffer} =~ s/\A/$self->{_previous_direction}/smxg;
$self->{_debug_buffer} =~ s/$quoted_previous_direction\Z//smxg;
print {*STDERR} "$self->{_debug_buffer}"
or Carp::croak("Failed to write to STDERR:$EXTENDED_OS_ERROR");
$self->{_debug_buffer} = $string;
}
else {
$self->{_debug_buffer} = $string;
}
while ( $self->{_debug_buffer} =~ s/\A([^\n]+\r?\n)//smx ) {
print {*STDERR} "$direction$1"
or Carp::croak("Failed to write to STDERR:$EXTENDED_OS_ERROR");
}
$self->{_previous_direction} = $direction;
}
return;
}
sub _debug_flush {
my ($self) = @_;
if ( $self->{_debug} ) {
my $quoted_previous_direction = quotemeta $self->{_previous_direction};
$self->{_debug_buffer} =~ s/(\r?\n)/$1$self->{_previous_direction}/smxg;
$self->{_debug_buffer} =~ s/\A/$self->{_previous_direction}/smxg;
$self->{_debug_buffer} =~ s/$quoted_previous_direction\Z//smxg;
print {*STDERR} "$self->{_debug_buffer}"
or Carp::croak("Failed to write to STDERR:$EXTENDED_OS_ERROR");
$self->{_debug_buffer} = q[];
}
return;
}
sub _write {
my ( $self, $string ) = @_;
my $icap_uri = $self->uri();
my $socket = $self->_socket();
$self->_debug(">> $string");
my $number_of_bytes = syswrite $socket, "$string"
or Carp::croak(
"Failed to write to icap server at $icap_uri:$EXTENDED_OS_ERROR");
return $number_of_bytes;
}
sub _socket {
my ($self) = @_;
return $self->{_socket};
}
sub _connect {
my ($self) = @_;
if ( !$self->{_socket} ) {
my $socket_class = 'IO::Socket::INET';
my %options;
if ( $self->_scheme() eq 'icaps' ) {
$socket_class = 'IO::Socket::SSL';
%options = %{ $self->{_ssl} };
}
my $socket = $socket_class->new(
PeerAddr => $self->uri()->host(),
PeerPort => $self->uri()->port(),
Proto => 'tcp',
%options,
)
or Carp::croak(
'Failed to connect to '
. $self->uri()->host()
. ' on port '
. $self->uri()->port() . q[:]
. (
$socket_class eq 'IO::Socket::SSL'
? $socket_class->errstr()
: $EXTENDED_OS_ERROR
)
);
$self->{_socket} = $socket;
}
return $self->{_socket};
}
sub _disconnect {
my ($self) = @_;
delete $self->{_socket};
return;
}
sub _process_icap_headers {
my ( $self, $icap_headers, $icap_method ) = @_;
my $quoted_pair = qr/\\./smx;
my $qdtext = qr/[^"]/smx;
my $quoted_string = qr/"((?:$quoted_pair|$qdtext)+)"/smx;
if ( $icap_headers =~ /\r?\nISTag:[ ]*$quoted_string(?:\r?\n|$)/smx ) {
$self->{_is_tag} = ($1);
}
elsif ( $icap_headers =~ /\r?\nISTag:[ ]*(\S+)(?:\r?\n|$)/smx )
{ # This violates RFC but is necessary to get the c-icap project to work
$self->{_is_tag} = ($1);
}
if ( $icap_method eq 'OPTIONS' ) {
delete $self->{_options};
if ( $icap_headers =~ /\r?\nMethods:[ ]*(.*?)(?:\r?\n|$)/smx ) {
foreach my $method ( split /,[ ]*/smx, $1 ) {
$self->{_options}->{methods}->{$method} = 1;
}
}
if ( $icap_headers =~ /\r?\nPreview:[ ]*(\d+)(?:\r?\n|$)/smx ) {
$self->{_options}->{preview} = $1;
}
if ( $icap_headers =~ /\r?\nService:[ ]*(.*?)(?:\r?\n|$)/smx ) {
$self->{_options}->{service} = $1;
}
if ( $icap_headers =~ /\r?\nMax\-Connections:[ ]*(\d+)(?:\r?\n|$)/smx )
{
$self->{_options}->{max_connections} = $1;
}
if ( $icap_headers =~ /\r?\nOptions\-TTL:[ ]*(\d+)(?:\r?\n|$)/smx ) {
$self->{_options}->{ttl} = $1;
$self->{_options}->{expiry} = time + $1;
}
if ( $icap_headers =~ /\r?\nAllow:[ ]*(.*?)(?:\r?\n|$)/smx ) {
foreach my $allowed ( split /,[ ]*/smx, $1 ) {
$self->{_options}->{allowed}->{$allowed} = 1;
}
}
}
return;
}
sub _get_icap_header {
my ( $self, $peek_buffer ) = @_;
lib/Net/ICAP/Client.pm view on Meta::CPAN
Failed to write to the remote icap server. Check network status.
=item C<< Failed to write to STDERR >>
Failed to write to STDERR. Check local machine settings.
=item C<< Incorrectly formatted debug line >>
A debug call was made without being prefixed with a '>> ' or '<< '. This is a bug in Net::ICAP::Client
=item C<< Failed to connect to %s on port %s >>
The connection to the remote icap server failed. Check network/SSL/TLS settings and status
=item C<< Failed to read from %s >>
Failed to read from the remote icap server. Check network status
=item C<< Failed to seek to start of temporary file >>
Failed to do a disk operation. Check disk settings for the mount point belonging to where temp files are being created
=item C<< Failed to seek to start of content handle >>
Failed to do a disk operation. Check disk settings for the mount point belonging to the file that are passed into the request/response method
=item C<< ICAP Server returned a %s error >>
The remote ICAP server returned an error. The TCP connection to the remote ICAP server will be automatically disconnected. Capture the network traffic and enter a bug report
=item C<< Failed to parse chunking length >>
This is a bug in Net::ICAP::Client
=item C<< Unable to parse Encapsulated header >>
The remote ICAP server did not return an Encapsulated header that could be understood by Net::ICAP::Client. Capture the network traffic and enter a bug report
=item C<< Unable to parse ICAP header >>
The remote ICAP server did not return an ICAP header that could be understood by Net::ICAP::Client. Capture the network traffic and enter a bug report
=item C<< Failed to read from content handle >>
Failed to do a disk operation. Check disk settings for the mount point belonging to the file that are passed into the request/response method
=back
=head1 CONFIGURATION AND ENVIRONMENT
Net::ICAP::Client requires no configuration files or environment variables.
=head1 DEPENDENCIES
Net::ICAP::Client requires the following non-core modules
HTTP::Request
HTTP::Response
IO::Socket::INET
IO::Socket::SSL
URI
=head1 INCOMPATIBILITIES
None reported
=head1 BUGS AND LIMITATIONS
To report a bug, or view the current list of bugs, please visit L<https://github.com/david-dick/net-icap-client/issues>
=head1 LICENSE AND COPYRIGHT
Copyright 2016 David Dick.
This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.
See L<http://dev.perl.org/licenses/> for more information.
( run in 0.903 second using v1.01-cache-2.11-cpan-39bf76dae61 )