Net-Gemini
view release on metacpan or search on metacpan
dist_author => q{Jeremy Mates <jmates@thrig.me>},
dist_version_from => 'lib/Net/Gemini.pm',
release_status => 'stable',
create_license => 0,
create_readme => 0,
dynamic_config => 0,
configure_requires => { 'Module::Build' => '0.4004', },
test_requires => {
'Data::Dumper' => '0',
'IO::Socket::IP' => '0',
'IO::Socket::SSL' => '0',
'Parse::MIME' => '0',
'Test2::Tools::Command' => '0.11',
'Test2::V0' => '0.000060',
'perl' => '5.8.0',
},
# NOTE several of these are for gmitool so are not really required
requires => {
'Carp' => '0',
'Cpanel::JSON::XS' => '0',
'Digest::SHA' => '0',
'File::Path' => '0',
'File::Slurper' => '0',
'File::Spec' => '0',
'IO::Socket::IP' => '0',
'IO::Socket::SSL' => '0',
'Net::SSLeay' => '0',
'Parse::MIME' => '0',
'URI' => '0',
'perl' => '5.8.0',
},
sign => 1,
add_to_cleanup => ['Net-Gemini-*'],
auto_features => {
dist_authoring => {
description => "Create new distributions",
interface changes. Better ensure that the socket gets closed
when not needed.
0.03 2022-10-27
Set a minimum bar on IO::Socket:SSL for can_ipv6. Disable
automatic build on Windows due to test failures.
0.02 2022-10-25
Various network tests as expected are not portable, require
AUTHOR_TEST_JMATES for these and note that they're rigged up
only for OpenBSD. Fix missing IO::Socket::SSL require.
0.01 2022-10-24
First version, released on an unsuspecting world.
},
"runtime" : {
"requires" : {
"Carp" : "0",
"Cpanel::JSON::XS" : "0",
"Digest::SHA" : "0",
"File::Path" : "0",
"File::Slurper" : "0",
"File::Spec" : "0",
"IO::Socket::IP" : "0",
"IO::Socket::SSL" : "0",
"Net::SSLeay" : "0",
"Parse::MIME" : "0",
"URI" : "0",
"perl" : "v5.8.0"
}
},
"test" : {
"requires" : {
"Data::Dumper" : "0",
"IO::Socket::IP" : "0",
"IO::Socket::SSL" : "0",
"Parse::MIME" : "0",
"Test2::Tools::Command" : "0.11",
"Test2::V0" : "0.000060",
"perl" : "v5.8.0"
}
}
},
"provides" : {
"Net::Gemini" : {
"file" : "lib/Net/Gemini.pm",
---
abstract: 'a small gemini client'
author:
- 'Jeremy Mates <jmates@thrig.me>'
build_requires:
Data::Dumper: '0'
IO::Socket::IP: '0'
IO::Socket::SSL: '0'
Parse::MIME: '0'
Test2::Tools::Command: '0.11'
Test2::V0: '0.000060'
perl: v5.8.0
configure_requires:
Module::Build: '0.4004'
dynamic_config: 0
generated_by: 'Module::Build version 0.4234, CPAN::Meta::Converter version 2.150010'
license: bsd
meta-spec:
URI::gemini:
file: lib/Net/Gemini.pm
requires:
Carp: '0'
Cpanel::JSON::XS: '0'
Digest::SHA: '0'
File::Path: '0'
File::Slurper: '0'
File::Spec: '0'
IO::Socket::IP: '0'
IO::Socket::SSL: '0'
Net::SSLeay: '0'
Parse::MIME: '0'
URI: '0'
perl: v5.8.0
resources:
license: http://opensource.org/licenses/BSD-3-Clause
repository: https://thrig.me/src/Net-Gemini.git
version: '0.10'
x_serialization_backend: 'CPAN::Meta::YAML version 0.018'
lib/Net/Gemini.pm view on Meta::CPAN
}
package Net::Gemini;
our $VERSION = '0.10';
use strict;
use warnings;
use Digest::SHA 'sha256_hex';
use Encode ();
use Exporter 'import';
use IO::Socket::IP;
use IO::Socket::SSL;
use Net::SSLeay;
use Parse::MIME 'parse_mime_type';
our @EXPORT_OK = qw(gemini_request);
sub _DEFAULT_BUFSIZE () { 4096 }
sub _DEFAULT_MAX_CONTENT () { 2097152 }
sub _DEFAULT_REDIRECTS () { 5 }
sub _DEFAULT_REDIRECT_SLEEP () { 1 }
lib/Net/Gemini.pm view on Meta::CPAN
# gemini://makeworld.space/gemlog/2020-07-03-tofu-rec.gmi
# gemini://alexschroeder.ch/page/2020-07-20%20Does%20a%20Gemini%20certificate%20need%20a%20Common%20Name%20matching%20the%20domain%3F
eval {
$obj{_socket} = IO::Socket::IP->new(
( exists $param{family} ? ( Domain => $param{family} ) : () ),
PeerAddr => $obj{_host},
PeerPort => $obj{_port},
Proto => 'tcp'
) or die $!;
$obj{_ip} = $obj{_socket}->peerhost;
IO::Socket::SSL->start_SSL(
$obj{_socket},
SSL_hostname => $obj{_host}, # SNI
( $param{tofu} ? ( SSL_verifycn_scheme => 'none' ) : () ),
SSL_verify_callback => sub {
my ( $ok, $ctx_store, $certname, $error, $cert, $depth ) = @_;
if ( $depth != 0 ) {
return 1 if $param{tofu};
return $ok;
}
my $digest = ( $param{verify_ssl} || \&_verify_ssl )->(
lib/Net/Gemini.pm view on Meta::CPAN
Net::SSLeay::X509_get_notAfter($cert)
),
okay => $ok,
}
);
},
( exists $param{ssl} ? %{ $param{ssl} } : () ),
) or die $!;
1;
} or do {
@obj{qw(_code _error)} = ( 0, "IO::Socket::SSL failed: $@" );
goto BLESSING;
};
binmode $obj{_socket}, ':raw';
my $n = syswrite $obj{_socket}, "$yuri\r\n";
unless ( defined $n ) {
@obj{qw(_code _error)} = ( 0, "send URI failed: $!" );
goto BLESSING;
}
lib/Net/Gemini.pm view on Meta::CPAN
=over 4
=item B<bufsize> => I<strictly-positive-integer>
Size of buffer to use for requests, 4096 by default. Note that a naughty
server may return data in far smaller increments than this.
=item B<ssl> => { params }
Passes the given parameters to the L<IO::Socket::SSL> constructor. These
could be used to configure e.g. the C<SSL_verify_mode> or to set a
verification callback, or to specify a custom SNI host via
C<SSL_hostname>.
C<Timeout> can be used to set a connect timeout on the socket. However,
a server could wedge at any point following, so it may be necessary to
wrap a B<get> request with the C<alarm> function or similar.
=item B<tofu> => I<boolean>
lib/Net/Gemini/Server.pm view on Meta::CPAN
# Ordeal which clears the just man. They weigh upon the evil man like
# a neck-stock. In Kisiga, their very anciently founded city, the
# trustworthy does not get caught, but the evil cannot pass through."
package Net::Gemini::Server;
our $VERSION = '0.10';
use strict;
use warnings;
# the below code mostly cargo culted from example/ssl_server.pl
use IO::Socket::IP;
use IO::Socket::SSL;
DESTROY { undef $_[0]{_context}; undef $_[0]{_socket} }
sub new {
my ( $class, %param ) = @_;
$param{listen}{LocalPort} = 1965
unless defined $param{listen}{LocalPort};
my %obj;
$obj{_socket} = IO::Socket::IP->new(
Listen => 5,
Reuse => 1,
%{ $param{listen} },
) or die "server failed: $!";
# server default is not to perform any verification
$obj{_context} =
IO::Socket::SSL::SSL_Context->new( %{ $param{context} },
SSL_server => 1, )
or die "context failed: $SSL_ERROR";
$obj{_port} = $obj{_socket}->sockport;
bless \%obj, $class;
}
sub context { $_[0]{_context} }
sub port { $_[0]{_port} }
sub socket { $_[0]{_socket} }
lib/Net/Gemini/Server.pm view on Meta::CPAN
next;
}
my $parent = fork;
die "fork failed: $!" unless defined $parent;
if ($parent) {
close $client;
next;
}
unless ( $param{no_ssl} ) {
unless (
IO::Socket::SSL->start_SSL(
$client,
SSL_server => 1,
SSL_reuse_ctx => $self->{_context}
)
) {
warn "ssl handshake failed: $SSL_ERROR\n";
close $client;
exit;
}
}
lib/Net/Gemini/Server.pm view on Meta::CPAN
=item B<new> I<param>
Constructor. The I<param> should include I<listen> and I<context> key
values to configure the listen object and SSL context object.
=item B<context>
=item B<port>
=item B<socket>
Accessors; return the context object (see L<IO::Socket::SSL>), listen
port, and socket of the server.
=item B<withforks> I<callback>
Accepts connections and forks child processes to handle the client
request with the given I<callback>. The I<callback> is passed the client
socket, size of the request, and the request string.
=back
t/00-load.t view on Meta::CPAN
#!perl
use strict;
use warnings;
use Test2::V0;
use IO::Socket::SSL;
my @modules = <<'EOM' =~ m/([A-Z][A-Za-z0-9:]+)/g;
Net::Gemini::Server
Net::Gemini
EOM
my $loaded = 0;
for my $m (@modules) {
local $@;
eval "require $m";
if ($@) { bail_out("require failed '$m': $@") }
$loaded++;
}
diag("Testing Net::Gemini $Net::Gemini::VERSION, Perl $], $^X");
is( $loaded, scalar @modules );
# gemini needs SNI so we probably should ensure that that is around.
# this might be a problem on way old systems with way outdated OpenSSL.
# is there a minimum IO::Socket::SSL version we should pin to for SNI?
eval { is( IO::Socket::SSL->can_client_sni, 1 ) }
or bail_out("IO::Socket::SSL cannot SNI??");
done_testing 2
t/30-gemini.t view on Meta::CPAN
#!perl
# gemini client tests. there are various PORTABILITY problems for
# some of these tests (e.g. [rt.cpan.org #144920]); therefore, a
# bunch of them have been wrapped in AUTHOR_TEST_JMATES which assumes
# one is running on OpenBSD; these also may break if the OpenBSD
# folks change anything
use strict;
use warnings;
use IO::Socket::IP;
use IO::Socket::SSL;
use Net::Gemini 0.08 'gemini_request';
use Test2::V0;
use lib './t/lib';
use GemServ;
plan 50;
my $u = URI->new('gemini://example.org/');
# TODO not sure how to get coverage on the remainder of the
t/30-gemini.t view on Meta::CPAN
err => qr/^URI is too long/
);
check_that(
req => "gemini://127.0.0.1:1965/",
param => {
ssl => {
SSL_cert_file => "there is no such certificate file or so we hope"
}
},
code => 0,
err => qr/^IO::Socket::SSL failed/
);
# PORTABILITY fiddly network tests that may run into portability
# problems depending on exactly how the socket connection falls
# apart; these assume an OpenBSD test host so will likely need
# adjustment elsewhere
SKIP: {
skip( "no author tests", 6 ) unless $ENV{AUTHOR_TEST_JMATES};
{
my ( $pid, $port ) = GemServ::with_server(
$wsargs,
sub { die "not reached" },
close_on_accept => 1
);
check_that(
req => "gemini://$The_Host:$port/",
code => 0,
err => qr/^IO::Socket::SSL failed/,
);
kill SIGTERM => $pid;
}
{
# this callback might well be reached by the server
my ( $pid, $port ) =
GemServ::with_server( $wsargs, sub { }, no_ssl => 1 );
check_that(
req => "gemini://$The_Host:$port/",
code => 0,
err => qr/^IO::Socket::SSL failed: SSL connect/,
);
kill SIGTERM => $pid;
}
{
my ( $pid, $port ) = GemServ::with_server(
$wsargs,
sub { die "not reached" },
close_before_read => 1
);
check_that(
t/30-gemini.t view on Meta::CPAN
SKIP: {
skip( "no author tests", 3 ) unless $ENV{AUTHOR_TEST_JMATES};
{
diag "blocking after an accept ...";
my ( $pid, $port ) = with_server_terrible();
my $uri = "gemini://$The_Host:$port/";
my ( $gem, $code ) =
Net::Gemini->get( $uri, tofu => 1, ssl => { Timeout => 3 } );
is( $code, 0 );
like( $gem->{_error}, qr/IO::Socket::SSL failed/ );
kill SIGTERM => $pid;
}
{
diag "blocking after start_SSL ...";
my ( $pid, $port ) = with_server_terrible(1);
my $uri = "gemini://$The_Host:$port/";
my $ok = eval {
local $SIG{ALRM} = sub { die "timeout\n" };
alarm 5;
t/30-gemini.t view on Meta::CPAN
sub with_server_terrible {
my ( $mode, $timeout ) = @_;
$timeout = 33 unless $timeout;
my $sock = IO::Socket::IP->new(
Listen => 5,
Reuse => 1,
LocalAddr => $The_Host,
LocalPort => 0,
) or bail_out("server failed: $!");
my $context = IO::Socket::SSL::SSL_Context->new(
SSL_server => 1,
SSL_cert_file => $The_Cert,
SSL_key_file => $The_Key,
) or bail_out("context failed: $SSL_ERROR");
my $port = $sock->sockport;
my $pid = fork;
bail_out("fork failed: $!") unless defined $pid;
unless ($pid) {
while (1) {
my $client = $sock->accept;
unless ($mode) {
sleep $timeout;
} else {
IO::Socket::SSL->start_SSL(
$client,
SSL_server => 1,
SSL_reuse_ctx => $context
) or bail_out("ssl handshake failed: $SSL_ERROR");
sleep $timeout;
}
close $client;
}
}
close $sock;
( run in 0.588 second using v1.01-cache-2.11-cpan-4d50c553e7e )