view release on metacpan or  search on metacpan

script/gemini  view on Meta::CPAN

unless you use C<--force>; redirecting binary data to a file or piping it to
some other script is fine, though.

Use C<--verbose> to see what URL the script is requesting. This is useful when
debugging issues around decoding and encoding.

=head2 Client Certificates

You can provide a certificate and a key file:

        gemini --cert_file=cert.pem --key_file=key.pem \
          gemini://campaignwiki.org/play/ijirait

=cut

use Modern::Perl '2018';
use Mojo::IOLoop;
use Pod::Text;
use Getopt::Long;
use Encode::Locale qw(decode_argv $ENCODING_CONSOLE_OUT);
use Encode qw(encode decode_utf8 encode_utf8);
use Net::IDN::Encode qw(:all);
use URI::Escape;
use IRI;

my $cert;
my $key;
my $help;
my $force;
my $verbose;

GetOptions(
  'help' => \$help,
  'verbose' => \$verbose,
  'force' => \$force,
  'cert_file=s' => \$cert,
  'key_file=s' => \$key)
    or die("Error in command line arguments\n");

# Help
if ($help) {
  my $parser = Pod::Text->new();
  $parser->parse_file($0);
  exit;
}

# Regular arguments
decode_argv();
my ($uri) = @ARGV;

die "âš  You must provide an URI\n" unless $uri;

my $iri = IRI->new(value => encode_utf8 $uri);

die "âš  The URI '$uri' must use the gemini scheme\n" unless $iri->scheme and $iri->scheme eq 'gemini';
die "âš  The URI '$uri' must have an authority\n" unless $iri->authority;

my $host = domain_to_ascii(decode_utf8 $iri->host);
my $port = $iri->port || 1965;
my $unsafe = "^A-Za-z0-9\-\._~%"; # the default + already encoded
my $path = uri_escape_utf8($iri->path, $unsafe . "/"); # path separator are safe
my $query = uri_escape_utf8($iri->query, $unsafe . "&;="); # parameter separators are safe
my $fragment = uri_escape_utf8($iri->fragment); # use the default

$uri = $iri->scheme . '://' . $host . ':' . $port;
$uri .= $path if $path;
$uri .= '?' . $query if $query;
$uri .= '#' . $fragment if $fragment;

warn "Contacting $host:$port" if $verbose;

# create client
Mojo::IOLoop->client({
  address => $host,
  port => $port,
  tls => 1,
  tls_cert => $cert,
  tls_key => $key,
  tls_options => { SSL_verify_mode => 0x00 }} => sub {
    my ($loop, $err, $stream) = @_;
    die $err if $err;
    # 1h timeout (for chat)
    $stream->timeout(3600);
    my ($header, $mimetype, $encoding);
    $stream->on(read => sub {
      my ($stream, $bytes) = @_;
      if (not $header) {
	# decide how to decode the bytes
	($header) = $bytes =~ /^(.*?)\r\n/;
	$header = decode_utf8 $header;
	warn "$header\n";
	if ($header =~ /^2\d* (?:text\/\S+)?(?:; *charset=(\S+))?$/g) {
	  # empty, or text without charset defaults to UTF-8
	  $encoding = $1 || 'UTF-8';
	}
	$bytes =~ s/^(.*?)\r\n//;
	return unless $bytes;
	if (-t STDOUT) {
	  # connected to a tty
	  if ($force) {
	    binmode(STDOUT, ":raw");
	    print $bytes;
	  } elsif ($encoding) {
	    if ($encoding eq $ENCODING_CONSOLE_OUT) {
	      print $bytes;
	    } else {
	      warn "The console takes $ENCODING_CONSOLE_OUT but this text uses $encoding, so better not print it (use --force to do it anyway)\n";
	      warn "Or even better, redirect it to a file:\n";
	      warn "gemini $uri > data.txt\n";
	      Mojo::IOLoop->stop;
	    }
	  } else {
	    my $extension = extension($header);
	    warn "Better not to print binary data to a terminal (use --force to do it anyway)\n";
	    warn "Or even better, redirect it to a file:\n";
	    warn "gemini $uri > data.$extension\n";
	    Mojo::IOLoop->stop;
	  }
	} else {
	  # connected to a file or pipe
	  binmode(STDOUT, ":raw");
	  print $bytes;
	}