From 83f7b1dc2f27acced24cb99963b985c0b05d3f09 Mon Sep 17 00:00:00 2001
From: jake <jake@jakes-mail.top>
Date: Thu, 13 Jan 2022 01:32:55 -0500
Subject: Less basic client
---
gmi.pl | 327 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++----
1 file changed, 311 insertions(+), 16 deletions(-)
diff --git a/gmi.pl b/gmi.pl
index b16a178..3012dda 100755
--- a/gmi.pl
+++ b/gmi.pl
@@ -6,28 +6,323 @@ use strict;
use warnings;
use utf8;
use bytes;
+use feature qw(refaliasing);
+no warnings qw(experimental::refaliasing);
-our $VERSION = '0.0.1';
+our $VERSION = 'v0.0.9';
+
+#TODO: back() only works once; should fix this
# Modules
-use IO::Socket::SSL; # CPAN
+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 Smart::Comments; # CPAN
+
+#my ($wchar) = GetTerminalSize();
+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 ],
+
+ "cwu" => ["Returns current working URL", \&cwu ],
+
+ "links" => ["Current working URL's links", \&links ],
+
+ "nav" => ["Follow a link.\n" .
+ "Sets current working URL.", \&nav, 0 ],
+
+ "navh" => ["Follow a link from history.\n", \&nav, 1 ],
+
+ "root" => ["Go to current working URL root\n" .
+ "E.G. gemini://capsule.com/blog/20220112.gmi -> gemini://capsule.com/", \&root ],
+
+ "hist" => ["Returns history.", \&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\n", \&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) = @_;
+ $n -= 1;
+
+ ### $n
+ ### $setting
+ ### @_
+ my $link;
+
+ if ($setting == 0) {
+ $link = $links[$n][0];
+ } elsif ($setting == 1) {
+ $link = $history[$n][0];
+ }
+
+ if (has_scheme($link)) {
+ url("$link");
+ 0;
+ }
+ else {
+ url("$current_url$link");
+ 0;
+ }
+}
+
+sub has_scheme {
+ print ($_[0]);
+ return ($_[0] =~ m|^.*(://)|);
+}
+
+sub root {
+ TUI_Out("Not implimented yet.");
+}
+
+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");
+}
-# Global variables
-# ARGV[0]: gemini://website.com/request-path.gmi
-my $url = $ARGV[0];
-$url = parse_url($url);
+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));
+ }
+}
-my $cl = IO::Socket::SSL->new(
- PeerHost => "$url->{host}",
- PeerPort => '1965',
+sub toggle {
+ my ($t) = @_;
+ if ($t eq 'pager') {
+ set_toggle($use_pager);
+ print "$use_pager\n";
+ }
+}
- 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',
+sub set_toggle {
+ # refaliasing
+ \my $t = \$_[0];
+ if ($t == 1) {
+ $t = 0;
+ }
+ else {
+ $t = 1;
+ }
+}
-) or die "error=$!, ssl_error=$SSL_ERROR";
+sub textwrap {
+ my ($c) = @_;
+ if ($c and $c =~ m/^\d+$/) {
+ $wrapper->columns($c);
+ #$wchar = $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");
+ }
+ }
+}
-print $cl "$url->{scheme}://$url->{host}/$url->{path}\r\n";
-print <$cl>;
+sub pager {
+ my ($p) = @_;
+ if ($p) {
+ $ENV{pager} = $p;
+ 0;
+ }
+ else {
+ TUI_Out("$ENV{pager}\n");
+ }
+}
--
cgit v1.2.3