#!/usr/bin/env perl
# Copyright (C) 2017–2021  Alex Schroeder <alex@gnu.org>

# This program is free software: you can redistribute it and/or modify it under
# the terms of the GNU Affero General Public License as published by the Free
# Software Foundation, either version 3 of the License, or (at your option) any
# later version.
# This program is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
# details.
# You should have received a copy of the GNU Affero General Public License along
# with this program. If not, see <https://www.gnu.org/licenses/>.

=encoding utf8

=head1 NAME

gemini - a command line client for the Gemini protocol


B<gemini> [B<--help>] [B<--force>] [B<--verbose>] [B<--cert_file=>I<filename>
B<--key_file=>I<filename>] I<URL>


This is a very simple client. All it does is print the response. The header is
printed to standard error so the rest can be redirected to get just the content.


    gemini gemini://alexschroeder.ch/Test

Download an image:

    gemini gemini://alexschroeder.ch:1965/do/gallery/2016-aminona/thumbs/Bisse_de_Tsittoret.jpg \
      > Bisse_de_Tsittoret.jpg

Download all the images on a page:

    for url in $(./gemini gemini://alexschroeder.ch:1965/do/gallery/2016-aminona \
                 | grep thumbs | cut --delimiter=' ' --fields=2); do
      echo $url
      ./gemini "$url" > $(basename "$url")

In the shell script above, the first call to gemini gets the page with all the
links, grep then filters for the links to thumbnails, extract the URL using cut
(assuming a space between "=>" and the URL), and download each URL, and save the
output in the filename indicated by the URL.

When the script downloads binary data, then it won't print it to a terminal
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 \


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;

  '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();

# Regular arguments
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
  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)
    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";
	  } 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";
	} 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;

# 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';