view release on metacpan or  search on metacpan

script/gemini  view on Meta::CPAN

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;
	}
      } else {
	# continuing to print
	print $bytes;
      }});
    # Write request
    warn "Requesting $uri\n" if $verbose;
    $stream->write("$uri\r\n")});

# Start event loop if necessary
Mojo::IOLoop->start unless Mojo::IOLoop->is_running;

# Helper
sub extension {
  $_ = shift;
  return 'gmi' if /text\/gemini/;
  return 'txt' if /text\/plain/;
  return 'md' if /text\/markdown/;
  return 'html' if /text\/html/;
  return 'png' if /image\/png/;
  return 'jpg' if /image\/jpeg/;
  return 'gif' if /image\/gif/;
  return 'txt';
}