path: root/gmi.pl

#!/usr/bin/perl

# this is a gemini client

use strict;
use warnings;
use utf8;
use bytes;
use feature qw(refaliasing);
no warnings qw(experimental::refaliasing);

our $VERSION = 'v0.0.11';

# TODO: 
# back() only works once; should fix this
# url() should also handle relative paths

# Modules
use IO::Socket::SSL;                                      # CPAN
use URL::XS qw(parse_url split_url_path parse_url_query); # CPAN
use Term::TUI qw(:all);                                   # CPAN
use IO::Pager;                                            # CPAN
require Text::Wrapper;                                    # CPAN
use Term::ReadKey;                                        # CPAN
use Term::ANSIColor;                                      # Core
use Path::Naive qw(normalize_path);                       # CPAN
use Smart::Comments;                                      # CPAN

my $wrapper = Text::Wrapper->new(columns=>70, body_start=>'');
$ENV{pager} = 'less';
my $use_pager = 1;
my $pager_text_wrap_auto = 1;
my $doc_out = 1; # display doc for human consumption?
my $doc;
my @links;
my $current_url = "";
my @history;

# The way Term::TUI handles the data makes it impossible
# to just give it a variable, but it does support stdin
my %modes =
(".HELP"  => "Super basic gemini glient.\nVersion: $VERSION\n" . 
	"Type 'go' to enter 'go' mode. You can also: 'go url capsule.com' without being in 'go' mode.",

	"go" => {".HELP" => "going to browse",

		"url"  => [ "Make a request to a URL\nThis will set the current working URL" .
			"\nExample: [gemini://]capsule.com/", \&url ],
		"u"  => ["Alias of `url'", \&url ],

		"cwu" => ["Returns current working URL", \&cwu ],
		"c" => ["Alias of `cwu'", \&cwu ],

		"links" => ["Current working URL's links", \&links ],
		"l" => ["Alias of `links'", \&links ],

		"nav" => ["Follow a link.\nSets current working URL", \&nav, 0 ],
		"n" => ["Alias of `nav'", \&nav, 0 ],

		"navh" => ["Follow a link from history.\nSets current working URL", \&nav, 1 ],
		"nh" => ["Alias of `navh'", \&nav, 1 ],

		"root" => ["Navigate to current working URL root\n" .
			"E.G. gemini://capsule.com/blog/20220112.gmi -> gemini://capsule.com/", \&root ],

		"hist" => ["Returns history.", \&hist ],
		"h" => ["Alias of `hist'", \&hist ],

		"back" => ["Go back to the previous URL (uses history)", \&back, 0 ],
		"b" => ["Alias of `back'", \&back, 0 ],

		"backnodisplay" => ["Go back to the previous URL (uses history), ".
			"but do not display the page.", \&back, 1 ],
		"bd" => ["Alias of `backnodisplay'.", \&back, 1 ],

		"display" => ["Display the current working URL.", \&display] ,
		"d" => ["Alias of `display'", \&display ],

	},
	"cert" => {".HELP" => "Manage certs",
		"aaa" => [ "This command returns `aaa'.", \&aaa ],
	},
	"config" => {".HELP" => "Config settings to your liking.",
		"usepager" => ["This toggles pager use.\n" . 
			"1 = use pager, 0 = stdout", \&toggle, 'pager'],

		"textwrap" => ["Input must be an interger or 'auto'. No\n".
			"input returns the current text-wrap.", \&textwrap],

		"pager" => ["Set which pager to use.", \&pager],

		"save" => ["Save your settings (not implimented yet)", \&asdf],
	}
);

my $flag;
$flag=TUI_Run("gc",\%modes);
#print "*** ABORT ***\n" if ($flag);

#TUI_Script(\%modes,"/config pager;");

sub url {
	# gemini://website.com/request-path.gmi
	my ($url) = @_;
	if (!$url) { TUI_Out("Example: [gemini://]capsule.com/\n"); return 0;}
	if ( $url !~ m|^.*://.*|) {
		$url = "gemini://$url";
	}
	### $url
	$url = parse_url($url);
	
	my $cl = IO::Socket::SSL->new(
		PeerHost => "$url->{host}",
		PeerPort => '1965',
	
		SSL_verify_mode => SSL_VERIFY_NONE,
		# will update version when support is better or
		# when gemini removes TLSv1_2 as a supported version
		SSL_version => 'TLSv1_2',
	
	); #or die "error=$!, ssl_error=$SSL_ERROR";

	if ($cl) {
		my $path;
		if (! $url->{path}) {
			$path = '' 
		}
		else {
			$path = "$url->{path}";
		}
		
		$current_url = "$url->{scheme}://$url->{host}/$path";

		# ["absolute_url", "description"]
		update_history( ["$url->{scheme}://$url->{host}/$path", "$url->{host}/$path"] );
	
		# gemini spec: <URL><CR><LF>
		# <URL> is an absolute path
		print $cl "$url->{scheme}://$url->{host}/$path\r\n";
	
		undef($doc);

		while (<$cl>) {
			$doc .= $_;
		}
		
		get_links($doc);
	
		if ($doc_out) {
			display($doc);
		}
	}
	else {
		TUI_Out("error=$!, ssl_error=$SSL_ERROR\n");
	}
}

sub get_links {
	undef(@links);
	my ($doc) = @_;
	#map(push(@links, $_), $doc =~ m/^=>[\s]*([\w\-\\\/\.\:\~\?\=]+)[\s]*(.+)?$/gm);
	for my $line (split('\n', $doc)) {
		if ($line =~ m/^=>[\s]*([\w\d\-\\\/\.\:\~\?\=\#]+)[\s]*(.+)?$/gm) {
			if ($2) {
				push(@links, ["$1", "$2"]);
			}
			else {
				push(@links, ["$1", "$1"]);
			}
		}
	}
	## @links
}

sub hist {
	my $hist;
	my $counter = 1;
	for my $item (@history) {
		$hist .= "[$counter] $$item[0] $$item[1]\n";
		#$hist .= "$$item[1][0]\n";
		$counter++;
	}
	if ($hist) {
		TUI_Out($hist);
	}
	else {
		TUI_Out("\n");
	}
}

sub update_history {
	my ($history) = @_;
	push(@history, $history);
}

sub links {
	my $d;
	my $counter = 1;
	for my $item (@links) {
		$d .= "[$counter] ". colored($$item[0], 'underline') . " $$item[1]\n";
		$counter++;
	}
	if ($d) {
		TUI_Out($d);
	}
	else {
		TUI_Out("No links.\n");
	}
	0;
}

sub cwu {
	TUI_Out("$current_url\n");
	0;
}

sub nav {
	# Setting 0: from links
	# Setting 1: from history
	my ($setting,$n) = @_;
	if (! $n) {
		TUI_Out("Try 'links' or 'hist' then 'nav x', where x is the number.\n");
		return 1;
	}
	$n -= 1;

	### $n
	### $setting
	### @_
	my $link;

	if ($setting == 0) {
		$link = $links[$n][0];
	} elsif ($setting == 1) {
		$link = $history[$n][0];
	}

	# This implies it is valid
	if (has_scheme($link)) {
		url("$link");
	}
	else {
		if ($link =~ m|\.{1,2}/.*|) {
			my $new_url = parse_url($current_url);
			my $parsed_url_path = split_url_path($new_url->{path}, 256);
			my $url_path;

			# request doc will be different
			pop(@$parsed_url_path);
			for (@$parsed_url_path) {
				$url_path .= "/$_";
			}
			### $url_path
			### $link
			my $path = normalize_path("$url_path/$link");

			url("$new_url->{scheme}://$new_url->{host}$path");
		}
		else {
			my $new_url = parse_url($current_url);
			url("$new_url->{scheme}://$new_url->{host}/$link");
		}
	}
}

sub has_scheme {
	#print ($_[0]);
	return ($_[0] =~ m|^.*(://)|);
}

sub root {
	my $new_url = parse_url($current_url);
	url("$new_url->{scheme}://$new_url->{host}/");
}

sub back {
	my ($display) = @_;

	### @_
	### $display
	#
	my $dok_out = $doc_out;

	$doc_out = 0 if ($display == 1);

	url("$history[-2][0]");
	### @history

	$doc_out = $dok_out if ($display == 1);
}

sub aaa {
	TUI_Out("aaa\n");
}

sub display {
	if ($pager_text_wrap_auto) {
		my ($wc) = GetTerminalSize();
		$wrapper->columns($wc);
	}
	if ($use_pager) {
		IO::Pager::open(my $FH) or warn($!);
		print $FH $wrapper->wrap($doc);
	}
	else { 
		TUI_Out($wrapper->wrap($doc));
	}
}

sub toggle {
	my ($t) = @_;
	if ($t eq 'pager') {
		set_toggle($use_pager);
		print "$use_pager\n";
	}
}

sub set_toggle {
	# refaliasing
	\my $t = \$_[0];
	if ($t == 1) {
		$t = 0;
	}
	else {
		$t = 1;
	}
}

sub textwrap {
	my ($c) = @_;
	if ($c and $c =~ m/^\d+$/) {
		$wrapper->columns($c);
		$pager_text_wrap_auto = 0;
	} elsif ($c and $c eq 'auto') {
		$pager_text_wrap_auto = 1;
	}
	else {
		if ($pager_text_wrap_auto) {
			my ($c) = GetTerminalSize();
			TUI_Out("[AUTO] $c\n");
		}
		else {
			TUI_Out("$wrapper->{columns}\n");
		}
	}
}

sub pager {
	my ($p) = @_;
	if ($p) {
		$ENV{pager} = $p;
		0;
	}
	else {
		TUI_Out("$ENV{pager}\n");
	}
}