view release on metacpan or  search on metacpan

lib/Net/SSL.pm  view on Meta::CPAN

    my $proxy_server = $ENV{HTTPS_PROXY} || $ENV{https_proxy};
    return unless $proxy_server;

    my($peer_port, $peer_addr) = (
        *$self->{ssl_peer_port},
        *$self->{ssl_peer_addr}
    );
    $peer_addr || croak("no peer addr given");
    $peer_port || croak("no peer port given");

    # see if the proxy should be bypassed
    my @no_proxy = split( /\s*,\s*/,
        $ENV{NO_PROXY} || $ENV{no_proxy} || ''
    );
    my $is_proxied = 1;
    for my $domain (@no_proxy) {
        if ($peer_addr =~ /\Q$domain\E\z/) {
            return;
        }
    }

    $proxy_server =~ s|\Ahttps?://||i;
    # sanitize the end of the string too
    # see also http://www.nntp.perl.org/group/perl.libwww/2012/10/msg7629.html
    # and https://github.com/nanis/Crypt-SSLeay/pull/1
    # Thank you Mark Allen and YigangX Wen
    $proxy_server =~ s|(:[1-9][0-9]{0,4})/\z|$1|;
    $proxy_server;
}

sub configure_certs {
    my $self = shift;
    my $ctx = *$self->{ssl_ctx};

    my $count = 0;
    for (qw(HTTPS_PKCS12_FILE HTTPS_CERT_FILE HTTPS_KEY_FILE)) {
        my $file = $ENV{$_};
        if ($file) {
            (-e $file) or croak("$file file does not exist: $!");
            (-r $file) or croak("$file file is not readable");
            $count++;
            if (/PKCS12/) {
                $count++;
                $ctx->use_pkcs12_file($file ,$ENV{'HTTPS_PKCS12_PASSWORD'}) || croak("failed to load $file: $!");
                last;
            }
            elsif (/CERT/) {
                $ctx->use_certificate_file($file ,1) || croak("failed to load $file: $!");
            }
            elsif (/KEY/) {
                $ctx->use_PrivateKey_file($file, 1) || croak("failed to load $file: $!");
            }
            else {
                croak("setting $_ not supported");
            }
        }
    }

    # if both configs are set, then verify them
    if ($count == 2) {
        if (! $ctx->check_private_key) {
            croak("Private key and certificate do not match");
        }
    }

    $count; # number of successful cert loads/checks
}

sub accept   { shift->_unimpl("accept") }
sub getc     { shift->_unimpl("getc")   }
sub ungetc   { shift->_unimpl("ungetc") }
sub getlines { shift->_unimpl("getlines"); }

sub _unimpl {
    my($self, $meth) = @_;
    croak("$meth not implemented for Net::SSL sockets");
}

1;

__END__

=head1 NAME

Net::SSL - support for Secure Sockets Layer

=head1 METHODS

=over 4

=item new

Creates a new C<Net::SSL> object.

=item configure

Configures a C<Net::SSL> socket for operation.

=item configure_certs

Sets up a certificate file to use for communicating with on
the socket.

=item connect

=item die_with_error

=item get_cipher

=item get_lwp_object

Walks up the caller stack and looks for something blessed into
the C<LWP::UserAgent> namespace and returns it. Vaguely deprecated.

=item get_peer_certificate

Gets the peer certificate from the underlying C<Crypt::SSLeay::Conn>
object.

=item get_peer_verify