File-RsyBak
view release on metacpan or search on metacpan
script/rsybak view on Meta::CPAN
# && $@ =~ m{^(?:Socket closed|Unexpected end)};
# }
#
# if (my $e = $@) {
# if ( ref $e eq 'HASH' && exists $e->{status} ) {
# $e->{redirects} = delete $args->{_redirects} if @{ $args->{_redirects} || []};
# return $e;
# }
#
# $e = "$e";
# $response = {
# url => $url,
# success => q{},
# status => 599,
# reason => 'Internal Exception',
# content => $e,
# headers => {
# 'content-type' => 'text/plain',
# 'content-length' => length $e,
# },
# ( @{$args->{_redirects} || []} ? (redirects => delete $args->{_redirects}) : () ),
# };
# }
# return $response;
#}
#
#
#sub www_form_urlencode {
# my ($self, $data) = @_;
# (@_ == 2 && ref $data)
# or _croak(q/Usage: $http->www_form_urlencode(DATAREF)/ . "\n");
# (ref $data eq 'HASH' || ref $data eq 'ARRAY')
# or _croak("form data must be a hash or array reference\n");
#
# my @params = ref $data eq 'HASH' ? %$data : @$data;
# @params % 2 == 0
# or _croak("form data reference must have an even number of terms\n");
#
# my @terms;
# while( @params ) {
# my ($key, $value) = splice(@params, 0, 2);
# if ( ref $value eq 'ARRAY' ) {
# unshift @params, map { $key => $_ } @$value;
# }
# else {
# push @terms, join("=", map { $self->_uri_escape($_) } $key, $value);
# }
# }
#
# return join("&", (ref $data eq 'ARRAY') ? (@terms) : (sort @terms) );
#}
#
#
#sub can_ssl {
# my ($self) = @_;
#
# my($ok, $reason) = (1, '');
#
# local @INC = @INC;
# pop @INC if $INC[-1] eq '.';
# unless (eval {require IO::Socket::SSL; IO::Socket::SSL->VERSION(1.42)}) {
# $ok = 0;
# $reason .= qq/IO::Socket::SSL 1.42 must be installed for https support\n/;
# }
#
# unless (eval {require Net::SSLeay; Net::SSLeay->VERSION(1.49)}) {
# $ok = 0;
# $reason .= qq/Net::SSLeay 1.49 must be installed for https support\n/;
# }
#
# if ( ref($self) && ( $self->{verify_SSL} || $self->{SSL_options}{SSL_verify_mode} ) ) {
# my $handle = HTTP::Tiny::Handle->new(
# SSL_options => $self->{SSL_options},
# verify_SSL => $self->{verify_SSL},
# );
# unless ( eval { $handle->_find_CA_file; 1 } ) {
# $ok = 0;
# $reason .= "$@";
# }
# }
#
# wantarray ? ($ok, $reason) : $ok;
#}
#
#
#sub connected {
# my ($self) = @_;
#
# if ($self->{handle} && $self->{handle}{fh}) {
# my $socket = $self->{handle}{fh};
#
# if ($socket->connected) {
# return wantarray
# ? ($socket->peerhost, $socket->peerport)
# : join(':', $socket->peerhost, $socket->peerport);
# }
# }
# return;
#}
#
#
#my %DefaultPort = (
# http => 80,
# https => 443,
#);
#
#sub _agent {
# my $class = ref($_[0]) || $_[0];
# (my $default_agent = $class) =~ s{::}{-}g;
# return $default_agent . "/" . $class->VERSION;
#}
#
#sub _request {
# my ($self, $method, $url, $args) = @_;
#
# my ($scheme, $host, $port, $path_query, $auth) = $self->_split_url($url);
#
# my $request = {
# method => $method,
# scheme => $scheme,
# host => $host,
# port => $port,
# host_port => ($port == $DefaultPort{$scheme} ? $host : "$host:$port"),
script/rsybak view on Meta::CPAN
# %args
# }, $class;
#}
#
#sub timeout {
# my ($self, $timeout) = @_;
# if ( @_ > 1 ) {
# $self->{timeout} = $timeout;
# if ( $self->{fh} && $self->{fh}->can('timeout') ) {
# $self->{fh}->timeout($timeout);
# }
# }
# return $self->{timeout};
#}
#
#sub connect {
# @_ == 5 || die(q/Usage: $handle->connect(scheme, host, port, peer)/ . "\n");
# my ($self, $scheme, $host, $port, $peer) = @_;
#
# if ( $scheme eq 'https' ) {
# $self->_assert_ssl;
# }
# elsif ( $scheme ne 'http' ) {
# die(qq/Unsupported URL scheme '$scheme'\n/);
# }
# $self->{fh} = $SOCKET_CLASS->new(
# PeerHost => $peer,
# PeerPort => $port,
# $self->{local_address} ?
# ( LocalAddr => $self->{local_address} ) : (),
# Proto => 'tcp',
# Type => SOCK_STREAM,
# Timeout => $self->{timeout},
# ) or die(qq/Could not connect to '$host:$port': $@\n/);
#
# binmode($self->{fh})
# or die(qq/Could not binmode() socket: '$!'\n/);
#
# if ( $self->{keep_alive} ) {
# unless ( defined( $self->{fh}->setsockopt( SOL_SOCKET, SO_KEEPALIVE, 1 ) ) ) {
# CORE::close($self->{fh});
# die(qq/Could not set SO_KEEPALIVE on socket: '$!'\n/);
# }
# }
#
# $self->start_ssl($host) if $scheme eq 'https';
#
# $self->{scheme} = $scheme;
# $self->{host} = $host;
# $self->{peer} = $peer;
# $self->{port} = $port;
# $self->{pid} = $$;
# $self->{tid} = _get_tid();
#
# return $self;
#}
#
#sub start_ssl {
# my ($self, $host) = @_;
#
# if ( ref($self->{fh}) eq 'IO::Socket::SSL' ) {
# unless ( $self->{fh}->stop_SSL ) {
# my $ssl_err = IO::Socket::SSL->errstr;
# die(qq/Error halting prior SSL connection: $ssl_err/);
# }
# }
#
# my $ssl_args = $self->_ssl_args($host);
# IO::Socket::SSL->start_SSL(
# $self->{fh},
# %$ssl_args,
# SSL_create_ctx_callback => sub {
# my $ctx = shift;
# Net::SSLeay::CTX_set_mode($ctx, Net::SSLeay::MODE_AUTO_RETRY());
# },
# );
#
# unless ( ref($self->{fh}) eq 'IO::Socket::SSL' ) {
# my $ssl_err = IO::Socket::SSL->errstr;
# die(qq/SSL connection failed for $host: $ssl_err\n/);
# }
#}
#
#sub close {
# @_ == 1 || die(q/Usage: $handle->close()/ . "\n");
# my ($self) = @_;
# CORE::close($self->{fh})
# or die(qq/Could not close socket: '$!'\n/);
#}
#
#sub write {
# @_ == 2 || die(q/Usage: $handle->write(buf)/ . "\n");
# my ($self, $buf) = @_;
#
# if ( $] ge '5.008' ) {
# utf8::downgrade($buf, 1)
# or die(qq/Wide character in write()\n/);
# }
#
# my $len = length $buf;
# my $off = 0;
#
# local $SIG{PIPE} = 'IGNORE';
#
# while () {
# $self->can_write
# or die(qq/Timed out while waiting for socket to become ready for writing\n/);
# my $r = syswrite($self->{fh}, $buf, $len, $off);
# if (defined $r) {
# $len -= $r;
# $off += $r;
# last unless $len > 0;
# }
# elsif ($! == EPIPE) {
# die(qq/Socket closed by remote server: $!\n/);
# }
# elsif ($! != EINTR) {
# if ($self->{fh}->can('errstr')){
# my $err = $self->{fh}->errstr();
# die (qq/Could not write to SSL socket: '$err'\n /);
# }
# else {
# die(qq/Could not write to socket: '$!'\n/);
# }
#
# }
# }
# return $off;
#}
#
#sub read {
# @_ == 2 || @_ == 3 || die(q/Usage: $handle->read(len [, allow_partial])/ . "\n");
# my ($self, $len, $allow_partial) = @_;
#
# my $buf = '';
# my $got = length $self->{rbuf};
#
# if ($got) {
# my $take = ($got < $len) ? $got : $len;
script/rsybak view on Meta::CPAN
#
# my $line = $self->readline;
#
# $line =~ /\A (HTTP\/(0*\d+\.0*\d+)) [\x09\x20]+ ([0-9]{3}) [\x09\x20]+ ([^\x0D\x0A]*) \x0D?\x0A/x
# or die(q/Malformed Status-Line: / . $Printable->($line). "\n");
#
# my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4);
#
# die (qq/Unsupported HTTP protocol: $protocol\n/)
# unless $version =~ /0*1\.0*[01]/;
#
# return {
# status => $status,
# reason => $reason,
# headers => $self->read_header_lines,
# protocol => $protocol,
# };
#}
#
#sub write_request_header {
# @_ == 5 || die(q/Usage: $handle->write_request_header(method, request_uri, headers, header_case)/ . "\n");
# my ($self, $method, $request_uri, $headers, $header_case) = @_;
#
# return $self->write_header_lines($headers, $header_case, "$method $request_uri HTTP/1.1\x0D\x0A");
#}
#
#sub _do_timeout {
# my ($self, $type, $timeout) = @_;
# $timeout = $self->{timeout}
# unless defined $timeout && $timeout >= 0;
#
# my $fd = fileno $self->{fh};
# defined $fd && $fd >= 0
# or die(qq/select(2): 'Bad file descriptor'\n/);
#
# my $initial = time;
# my $pending = $timeout;
# my $nfound;
#
# vec(my $fdset = '', $fd, 1) = 1;
#
# while () {
# $nfound = ($type eq 'read')
# ? select($fdset, undef, undef, $pending)
# : select(undef, $fdset, undef, $pending) ;
# if ($nfound == -1) {
# $! == EINTR
# or die(qq/select(2): '$!'\n/);
# redo if !$timeout || ($pending = $timeout - (time - $initial)) > 0;
# $nfound = 0;
# }
# last;
# }
# $! = 0;
# return $nfound;
#}
#
#sub can_read {
# @_ == 1 || @_ == 2 || die(q/Usage: $handle->can_read([timeout])/ . "\n");
# my $self = shift;
# if ( ref($self->{fh}) eq 'IO::Socket::SSL' ) {
# return 1 if $self->{fh}->pending;
# }
# return $self->_do_timeout('read', @_)
#}
#
#sub can_write {
# @_ == 1 || @_ == 2 || die(q/Usage: $handle->can_write([timeout])/ . "\n");
# my $self = shift;
# return $self->_do_timeout('write', @_)
#}
#
#sub _assert_ssl {
# my($ok, $reason) = HTTP::Tiny->can_ssl();
# die $reason unless $ok;
#}
#
#sub can_reuse {
# my ($self,$scheme,$host,$port,$peer) = @_;
# return 0 if
# $self->{pid} != $$
# || $self->{tid} != _get_tid()
# || length($self->{rbuf})
# || $scheme ne $self->{scheme}
# || $host ne $self->{host}
# || $port ne $self->{port}
# || $peer ne $self->{peer}
# || eval { $self->can_read(0) }
# || $@ ;
# return 1;
#}
#
#sub _find_CA_file {
# my $self = shift();
#
# my $ca_file =
# defined( $self->{SSL_options}->{SSL_ca_file} )
# ? $self->{SSL_options}->{SSL_ca_file}
# : $ENV{SSL_CERT_FILE};
#
# if ( defined $ca_file ) {
# unless ( -r $ca_file ) {
# die qq/SSL_ca_file '$ca_file' not found or not readable\n/;
# }
# return $ca_file;
# }
#
# local @INC = @INC;
# pop @INC if $INC[-1] eq '.';
# return Mozilla::CA::SSL_ca_file()
# if eval { require Mozilla::CA; 1 };
#
# foreach my $ca_bundle (
# "/etc/ssl/certs/ca-certificates.crt",
# "/etc/pki/tls/certs/ca-bundle.crt",
# "/etc/ssl/ca-bundle.pem",
# "/etc/openssl/certs/ca-certificates.crt",
# "/etc/ssl/cert.pem",
# "/usr/local/share/certs/ca-root-nss.crt",
# "/etc/pki/tls/cacert.pem",
# "/etc/certs/ca-certificates.crt",
( run in 0.805 second using v1.01-cache-2.11-cpan-2398b32b56e )