#!/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.14'; # 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 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; my $prompt = "gmi> "; my %commands = ( 'url' => [sub { url($_[0]) }, 'Go to the specified URL.'], 'u' => [sub { url($_[0]) }, 'Alias of `url\''], 'cwu' => [sub { cwu() }, 'Returns the current working URL.'], 'c' => [sub { cwu() }, 'Alias of `cwu\'.'], 'links' => [sub { links() }, 'Returns the links on the current page.'], 'l' => [sub { links() }, 'Alias of `links\'.'], 'nav' => [sub { nav(0, $_[0]) }, 'Navigate to a link that is on the current page (use links)'], 'n' => [sub { nav(0, $_[0]) }, 'Alias of `nav\'.'], 'navh' => [sub { nav(1, $_[0]) }, 'Navigate to a URL specified from history (use hist)'], 'nh' => [sub { nav(1, $_[0]) }, 'Alias of `navh\'.'], 'root' => [sub { root() }, 'Go to the root of the current URL.\n' . 'Exp: gemini://capsule.com/blog/2020112.gmi -> gemini://capsule.com/' ], 'hist' => [sub { hist() }, 'Returns history.' ], 'h' => [sub { hist() }, 'Alias of `hist\'.' ], 'back' => [sub { back(0) }, 'Go back in history.' ], 'b' => [sub { back(0) }, 'Alias of `back\'.' ], 'backnodisplay' => [sub { back(1) }, 'Go back in history but do not display the page' . '(still accesses the resource).' ], 'bd' => [sub { back(1) }, 'Alias of `backnodisplay\'.'], 'display' => [sub { display() }, 'Display the current page.' ], 'd' => [sub { display() }, 'Alias of `display\'.' ], 'aaa' => [sub { aaa() }, "This command returns `aaa'." ], 'usepager' => [sub { toggle('pager') }, 'This toggles pager use. 1 = use pager, 0 = stdout.' ], 'textwrap' => [sub { textwrap($_[0]) }, 'Set textwrap length.\nGiving \'auto\' will ' . "automatically determine the appropriate length. (Currently $wrapper->{columns})"], 'pager' => [sub { pager($_[0]) }, "Set which pager to use. (currently $ENV{pager})"], 'save' => [sub { ; }, 'Save the config settings. (Not yet implimented)'], 'help' => [sub { help($_[0]); }, 'Use help before a command to get extra info.'], 'cmds' => [sub {cmds()}, 'Returns the available commands.'], 'ver' => [sub {print "$VERSION\n"}, "Returns the version ($VERSION)"], 'exit' => [sub {exit 0;}, "This exits the program with a status code of 0."], ); print "Type 'cmds' to see available commands.\n"; while () { print "$prompt"; chomp(my $input = ); ### $input if ($input) { my ($command, $detail) = split(/\s/, $input); do_command(\$command, \$detail); } } sub do_command { # referenced command, referenced detail my ($rCmd, $rDetail) = @_; ### @_ # checking if %commands even has the command if (exists $commands{$$rCmd}) { # assigning a reference to a subroutine to the value my $rsub = $commands{$$rCmd}[0]; #running the subroutine &$rsub($$rDetail); } # options doesn't have the command else { print "Command is invalid.\n"; } } sub help { my ($cmd) = @_; ### @_ if ($cmd and exists $commands{$cmd}) { print "$commands{$cmd}[1]\n"; } elsif ($cmd) { print "`$cmd' isn't an avaliable command.\n"; } else { print "$commands{help}[1]\n" } } sub url { my ($url) = @_; if (!$url) { print("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', ); 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: # 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 { print("error=$!, ssl_error=$SSL_ERROR\n"); } } sub get_links { undef(@links); my ($doc) = @_; 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] ". colored("$$item[0]", 'underline') ." $$item[1]\n"; $counter++; } if ($hist) { print($hist); } else { print("\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) { print($d); } else { print("No links.\n"); } 0; } sub cwu { print("$current_url\n"); 0; } sub nav { # Setting 0: from links # Setting 1: from history my ($setting,$n) = @_; ### $n ### $setting ### @_ if (! $n or $n !~ /\d+/) { print("Try 'links' or 'hist' then 'nav x', where x is the number.\n"); return 1; } $n -= 1; my $link; if ($setting == 0 and @links) { $link = $links[$n][0]; } elsif ($setting == 1 and @history) { $link = $history[$n][0]; } else { print("'$n' isn't available.\n"); return 1; } # 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 { 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 { print("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 { print($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(); print("[AUTO] $c\n"); } else { print("$wrapper->{columns}\n"); } } } sub pager { my ($p) = @_; if ($p) { $ENV{pager} = $p; 0; } else { print("$ENV{pager}\n"); } } sub cmds { my $c; for (sort keys %commands) { $c .= "$_ "; } print $wrapper->wrap($c); }