Skip to content

Instantly share code, notes, and snippets.

@afresh1
Last active May 2, 2023 23:56
Show Gist options
  • Star 4 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save afresh1/c4ac35cdd29e6b2cd15eef38246c4c71 to your computer and use it in GitHub Desktop.
Save afresh1/c4ac35cdd29e6b2cd15eef38246c4c71 to your computer and use it in GitHub Desktop.
A monkey patch to let perl's HTTP::Tiny to use the OpenBSD netcat with TLS support to access https sites without installing IO::Socket::SSL and Net::SSLeay.
use v5.16;
use warnings;
package HTTP::Tiny::nc;
use parent 'HTTP::Tiny';
our $VERSION = v0.0.3;
# Copyright (c) 2019-2023 Andrew Hewus Fresh <afresh1@openbsd.org>
#
# Permission to use, copy, modify, and distribute this software for any
# purpose with or without fee is hereby granted, provided that the above
# copyright notice and this permission notice appear in all copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
=head1 NAME
HTTP::Tiny::nc - An HTTP::Tiny extension that uses nc for ssl connections
=head1 SYNOPSIS
use HTTP::Tiny::nc;
my $client = HTTP::Tiny::nc->new( verify_SSL => 1 );
# or just HTTP::Tiny->new, as it overrides the parent
if ( $client->get("https://www.openbsd.org")->{success} ) {
print "Hurray!"
}
=head1 DESCRIPTION
A small subclass of L<HTTP::Tiny> that overrides things to use
the OpenBSD version of L<nc(1)> to connect to C<https> sites.
Supports a subset of C<verify_SSL> and C<SSL_options>,
but not all.
Inherits the default of not verifying the name or certificate.
=head1 BUGS
I'm sure there are lots of ways this could go bad, but in simple
tests it Just Works.
=cut
use IO::Socket;
my ($orig_connect, $orig_connected); BEGIN {
$orig_connect = \&HTTP::Tiny::Handle::connect
// die "\&HTTP::Tiny::Handle::connect is not defined";
$orig_connected = \&HTTP::Tiny::Handle::connected
// die "\&HTTP::Tiny::Handle::connected is not defined";
no warnings 'redefine';
*HTTP::Tiny::Handle::connect = \&connect_with_nc;
*HTTP::Tiny::Handle::connected = \&connected_with_nc;
use warnings 'redefine';
}
sub connect_with_nc {
@_ == 5
|| die( q/Usage: $handle->connect(scheme, host, port, peer)/ . "\n" );
my ( $self, $scheme, $host, $port, $peer ) = @_;
return $orig_connect->(@_) if $scheme ne 'https' or HTTP::Tiny->can_ssl;
my @nc = '/usr/bin/nc';
if ( $scheme eq 'https' ) {
push @nc, '-c';
my $ssl_args = do {
no warnings 'redefine';
local *Net::SSLeay::OPENSSL_VERSION_NUMBER
= sub {0}; # Ignore sane SNI support, we have that
use warnings 'redefine';
$self->_ssl_args($host);
};
# Ignore SSL_verify_mode,
# the more specific options are set if we get this
delete $ssl_args->{SSL_verify_mode};
# These do mean that the *default* mode from HTTP::Tiny::nc
# is now to disable verification as that's what it actually does.
if ( my $name = delete $ssl_args->{SSL_verifycn_name} ) {
push @nc, '-e', $name;
}
else {
push @nc, qw< -T noname >;
}
if ( ( delete $ssl_args->{SSL_verifycn_scheme} || 'none' ) eq 'none' )
{
push @nc, qw< -T noverify >;
}
if ( my $ca_file = delete $ssl_args->{SSL_ca_file} ) {
push @nc, '-R', $ca_file;
}
# TODO: Support more SSL_options and other config.
my $unsupported = join ", ", sort keys %{ $ssl_args };
die "Unsupported ssl args: $unsupported" if $unsupported;
}
elsif ( $scheme ne 'http' ) {
die(qq/Unsupported URL scheme '$scheme'\n/);
}
push @nc, $host, $port;
my ( $parent, $child )
= IO::Socket->socketpair( AF_UNIX, SOCK_STREAM, PF_UNSPEC )
or die "socketpair: $!";
my $pid = fork // die "Unable to fork: $!";
if ( !$pid ) {
$parent->close or die "Unable to close parent socket: $!";
open STDIN, '<&', $child or die "unable to dup to STDIN: $!";
open STDOUT, '>&', $child or die "Unable to dup to STDOUT: $!";
exec @nc or die "Unable to exec nc: $!";
}
$child->close or die "Unable to close child socket: $!";
$self->{fh} = $parent;
binmode($self->{fh})
or die(qq/Could not binmode() socket: '$!'\n/);
$self->{scheme} = $scheme;
$self->{host} = $host;
$self->{peer} = $peer;
$self->{port} = $port;
$self->{pid} = $$;
$self->{_nc_connected} = "$peer:$port";
if ( my $get_tid = $self->can('_get_tid') ) {
$self->{tid} = $get_tid->();
}
return $self;
}
sub connected_with_nc {
my ( $self, @args ) = @_;
if ( my $connection = $self->{_nc_connected} ) {
return wantarray ? ( split /:/, $connection ) : $connection;
}
return $self->$orig_connected(@args);
}
1;
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment