path: root/gmi.pl

#!/usr/bin/perl

# this is a gemini client

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

our $VERSION = 'v0.0.27';

# TODO: 
# back() only works once; should fix this

# 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 Text::ParseWords; # Core
use Term::ReadLine; # CPAN
use Smart::Comments; # CPAN
use URI::Encode qw(uri_encode); # CPAN
use IO::Socket::SSL::Utils; # CPAN
use File::Slurper qw(read_dir); # CPAN

# sudo cpanm IO::Socket::SSL URL::XS IO::Pager Text::Wraper Term::ReadKey Path::Naive  Text::ParseWords Term::ReadLine Smart::Comments URI::Encode IO::Socket::SSL::Utils File::Slurper

my $wrapper = Text::Wrapper->new(columns=>70, body_start=>'');
#$ENV{PAGER} = 'most';
$ENV{PAGER} = 'less -R';
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 = "";
my $pretty_links = 1;
my $pretty_headers = 1;
my $pre_block = 0;
my @status_code;
my $status_code1;
my $status_code2;
my $auto_redirect = 2;
my $auto_redirect_count = 0;
my $sleep;
my $timeout = 3;
my $use_cert = 0;
my $cert;
my $key;

my $term=new Term::ReadLine "hmm, what goes here?";
my $OUT = $term->OUT || \*STDOUT;

my %commands = (
	'url' => [sub { url($_[0]) }, 'Go to the specified URL.'],
	'u' => [sub { url($_[0]) }, 'Alias of `url\''],
	
	'urlrelative' => [sub { urlrelative($_[0]) }, "Navigate the current URL relatively.\n\n"
		."Note: if the current path is '/blog/my-post1.gmi' and 'my-post2.gmi'\n" .
		"was supplied then the resulting path will be: '/blog/my-post2.gmi'\n" .
		"which is probably what you want. You can also use './my-post2.gmi'.\n" .
		"'.', of course, means 'same directory', in this case '/blog/'.\n\n" .
		"To remove the forward slash ('/') at the end of the current url,\n" . 
		"type the back-slash ('\\') by itself.\n\n" .
		"urlrelative without an argument will remove the ending '/' or go\n" .
		"up a directory without appending a forward slash.\n" .
		"IE: '/blog/drafts/secret/post.gmi -> '/blog/drafts/secret' -> '/blog/drafts'"],
	'ur' => [sub { urlrelative($_[0]) }, 'Alias of `urlrelative\''],

	'cwu' => [sub { print $OUT "$current_url\n"; }, 'Returns the current working URL.'],
	'c' => [sub { print $OUT "$current_url\n"; }, '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\'.' ],

	'usepager' => [sub { toggle($use_pager) }, 'This toggles pager use. 1 = use pager, 0 = stdout.' ],
	'pretty_links' => [sub { toggle($pretty_links) }, "0 = do nothing, 1 = pretty."],
	'pretty_headers' => [sub { toggle($pretty_headers) }, "0 = do nothing, 1 = pretty."],
	'textwrap' => [sub { textwrap($_[0]) }, "Set textwrap length.\nGiving 'auto' will " .
		"automatically determine the appropriate length."],
	'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 to see commands)'],
	'ver' => [sub {print $OUT "$VERSION\n"}, "Returns the version ($VERSION)"],
	'exit' => [sub {exit 0;}, "This exits the program with a status code of 0."],

	'autoredirection' => [sub { value_number($auto_redirect,$_[0],'autoredirect') },
		"The amount of times this program is allowed to auto redirect. 0 = none."],
	'timeout' => [sub { value_number($timeout,$_[0],'timeout') },
		"The client will time out when the server takes too long." ],

	'clearquery' => [sub { clear_query() }, "Removes query from current URL"],
	'cq' => [sub { clear_query() }, "Alias of `clearquery'"],

	'reload' => [sub {url($current_url)}, "Reload the current URL."],
	'r' => [sub {url($current_url)}, "Alias of `reload'."],

	'cert-create' => [sub { cert_create() }, "Create a cert. Interactive."],
	'cert-use' => [sub { cert_use() }, "Use a cert. Interactive.\n" . 
		"If a cert has already been loaded, it will unload it."],
	'cert-del' => [sub {cert_del() }, "Delete a cert. Interactive." ],
);

my @completions = keys %commands;

$term->Attribs->{'do_expand'}=1;
$term->Attribs->{'completion_entry_function'} = $term->Attribs->{'list_completion_function'};
$term->Attribs->{'completion_word'} = \@completions;
$term->ornaments(0);

$prompt = "$current_url > ";

print $OUT "Press <tab><tab> to see available commands.\n";
while ( defined ($_ = $term->readline($prompt)) ) {
	if ($_) {
		my ($command, $detail) = split(/\s/, $_);
		do_command(\$command, \$detail);
	}
	$prompt = "$current_url > ";
}

sub do_command {
	# referenced command, referenced arg
	my ($rCmd, $rArg) = @_; 

	# ## @_
	# 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($$rArg);
	}
	# options doesn't have the command
	else {
		print $OUT "Command is invalid.\n";
	}	
}

sub help {
	my ($cmd) = @_;
	### @_
	if ($cmd and exists $commands{$cmd}) {
		print $OUT "$commands{$cmd}[1]\n";
	} elsif ($cmd) {
		print $OUT "`$cmd' isn't an avaliable command.\n";
	}
	else {
		print $OUT "$commands{help}[1]\n"
	}
}

sub url {
	my ($url) = @_;
	### $url
	if (!$url) { print("Example: [gemini://]capsule.com/\n"); return 1;}
	if (! has_scheme($url) ) {
		$url = "gemini://$url";
	}
	 
	eval {
		$url = parse_url($url);
	};
	if ($@) {
		print $OUT "$@\n";
		return 1;
	}

	### $url
	if (! $url->{port} or $url->{port} eq 0) {
		$url->{port} = '1965';
	}
	
	my $cl;
	if ($use_cert and $cert and $key) {
		$cl = IO::Socket::SSL->new(
			PeerHost => "$url->{host}",
			PeerPort => "$url->{port}",
	
			SSL_verify_mode => SSL_VERIFY_NONE,
			SSL_verifycn_name => "$url->{host}",
			SSL_version => '!SSLv2:!SSLv3:!TLSv1:!TLSv1_1',
			SSL_fast_shutdown => 1,
	
			SSL_cert_file => "$cert",
			SSL_key_file => "$key",
	
			Timeout => 2,
		);
	}
	else {
		$cl = IO::Socket::SSL->new(
			PeerHost => "$url->{host}",
			PeerPort => "$url->{port}",
	
			SSL_verify_mode => SSL_VERIFY_NONE,
			SSL_verifycn_name => "$url->{host}",
			SSL_version => '!SSLv2:!SSLv3:!TLSv1:!TLSv1_1',
			SSL_fast_shutdown => 1,
	
			Timeout => 2,
		);
	}

	if ($cl) {
		$current_url = return_url($url);
		### $current_url
		### $url

		undef(@doc);
	
		eval {
			local $SIG{ALRM} = sub {close ($cl); unshift(@doc,""); die "TIMEOUT";};
			alarm $timeout;

			# gemini spec: <URL><CR><LF>
			# <URL> is an absolute path
			print $cl "$current_url\r\n";

			@doc = <$cl>;

			close($cl); # if this isnt here, the kernel will have to clean up unused ports

			alarm 0;
		};

		if ($@) {
			print $OUT "Timed out after $timeout seconds - server is taking too long.\n";
			update_history( ["$current_url", "timed out"] );
			### @doc
		} else {
			follow_status_code();
		}
	}
	
	else {
		print $OUT "error=$!, ssl_error=$SSL_ERROR\n";
	}
}

sub follow_status_code {
	return 1 if (!@doc);
	@status_code = split(' ', $doc[0]);
	$status_code1 = substr($doc[0],0,1);
	$status_code2 = substr($doc[0],1,1);
	update_history( ["$current_url", "$status_code1$status_code2"] );
	my $bad_code = "The server sent an invalid status code, not defined by gemini specifications.\n@doc";

	if ($status_code1 == 2) { # 2 will probably be the most common server reply
		if ($status_code2 == 0) {
			shift(@doc); # user probably doesn't want to see the 20 */* every time
			             # at some point deal with image/* and other media
			get_links();
			pretty_links() if ($pretty_links);
			pretty_headers() if ($pretty_headers);

			if ($doc_out) {
				display();
			}
		}
		else {
			print $OUT $bad_code;
		}

	} elsif ($status_code1 == 1) {
		if ($status_code2 == 0) {
			print $OUT "Server wants you to type something:\n@doc";
		} elsif ($status_code2 == 1) {
			print $OUT "Server wants you to type something secretly (do note: not secure):\n@doc";
			ReadMode 2;
		} else {
			print $bad_code;
			print $OUT "\nPresumably, the server wants you to type something:\n";
		}
		chomp(my $input = <STDIN>);
		$input = uri_encode($input);
		ReadMode 1;
		url("$current_url?$input");
		clear_query();

	} elsif ($status_code1 == 3) { 
		print $bad_code if ($status_code2 !~ m/^0|1$/); # not worrying about permanent/temporary yet
		print $OUT "Redirecting anyway.\n" if ($status_code2 !~ m/^0|1$/);
		if ($auto_redirect) {
			$auto_redirect_count++;
			if ($auto_redirect_count < $auto_redirect) {
				print $OUT "Redirection...\n";
				### @status_code
				access_resource($status_code[1]); # redirection can be './hello.gmi'
			}
			else {
				print $OUT "Reached limit for auto redirection.\n@doc";
			}
		}
		else {
			print $OUT "The server wants to redirect us, however, autoredirect has turned off.\n@doc";
		}
		$auto_redirect_count = 0;

	} elsif ($status_code1 == 4) {
		if ($status_code2 == 0) {
			print $OUT "Temporary failure.\n@doc";
		} elsif  ($status_code2 == 1) {
			print $OUT "Server is unavailable (yet somehow sent a reply to us).\n@doc";
		} elsif ($status_code2 == 2) {
			print $OUT "Server's CGI script is broken.\n@doc";
		} elsif ($status_code2 == 3) {
			print $OUT "Server was unable to proxy content.\n@doc";
		} elsif ($status_code2 == 4) {
			if (!$sleep) {
				$sleep = 5;
				print $OUT "Server wants us to slow down.\n" .
				"Reconnecting after $sleep seconds\n" .
				"Press 'ctrl-C' to cancel sleep\n" .
				"@doc\n";
				eval {
					local $SIG{INT} = sub { die "Cancelling Sleep!\n" };
					sleep ($sleep); # give the server an extra second
					url($current_url);
				}
			}
			else {
				print $OUT "The server is asking us to slow down and try again.\n" .
				"We have already done this once: not doing it again.\n";
			}
			undef($sleep);
		}
		else {
			print $bad_code;
		}

	} elsif ($status_code1 == 5) {
		if ($status_code2 == 0) {
			print $OUT "Permanent failure. Requests to this URI will reliably fail.\n@doc";
		} elsif ($status_code2 == 1) {
			print $OUT "Not found. Not available but *may* be in the future\n@doc";
		} elsif ($status_code2 == 2) {
			print $OUT "Gone. This resource will not be available again.\n@doc";
		} elsif ($status_code2 == 3) {
			print $OUT "Proxy Request Refused. Resource not served by this server and this\n" .
			"server does not accept proxy requests.\n@doc";
		} elsif ($status_code2 == 9) {
			print $OUT "Bad Request. The server is unable to parse our request.\n@doc";
		}
		else {
			print $bad_code;
		}

	} elsif ($status_code1 == 6) {
		if ($status_code2 == 0) {
			print $OUT "The server is asking you for a certificate. (cert-use to load a cert)\n@doc";
		} elsif ($status_code2 == 1) {
			print $OUT "The certificate you supplied is not authorized to access this resource.\n@doc";
		} elsif ($status_code2 == 2) {
			print $OUT "The certificate you supplied is malformed. There is something wrong with it.\n@doc";
		}
		else {
			print $OUT $bad_code;
		}
	}
	else {
		print $OUT $bad_code;
	}
	### @status_code;
}

sub urlrelative {
	my ($urlr) = @_;
	if (! $urlr) { $urlr = ""}
	if (! $current_url) {print $OUT "Relative movement impossible: no current URL.\n"; return 1;}
	my $end_with_slash = 1 if ($urlr =~ m|/$|);
	my $dot_only = 1 if ($urlr =~ m|^\.$|);
	my $dot_2_only = 1 if ($urlr =~ m|^\.\.$|); # since we are going up into a dir
	my $c_url_directory = 1 if ($current_url =~ m|/$|);
	my $remove_slash = 1 if ($urlr =~ m|^\\$|);  # back slash \ not a forward slash /

	### is urlr a slash only ?
	if ($urlr =~ m|^/$|) { # if slash only
		$current_url .= "/";
		url("$current_url");
		return 0;
	}

	### remove slash ?
	if ($remove_slash) {
		substr($current_url,-1,1,'');
		### $current_url
		url($current_url);
		return 0;
	}

	### is the current url a directory?
	if ($c_url_directory) {
		$current_url .= "$urlr";
		my $c_p_url = parse_url($current_url);
		### $c_p_url
		# if $urlr has '..' then normalize_path will not go beyond the last element
		# which is why prefixing a '/' and then taking it away (parse_url doesnt have
		# the forward / ) will result in expected behavior as host always end with '/'
		$c_p_url->{path} = normalize_path("/" . $c_p_url->{path});
		if ($end_with_slash or $dot_only or $dot_2_only) {
			$c_p_url->{path} .= "/"; # normalize path will remove it
		}
		substr($c_p_url->{path},0,1,'');
		url(return_url($c_p_url));
		return 0;
	}

	### current url is not a directory, so should be fine to remove last item on path
	# ^ some servers serve index page on 'dir' rather than 'dir/'  :v annoying
	# authors using servers like that will notice that the links on index page need to be
	# carefully managed, because ALL clients (that handle links correctly) *will* mess up. 
	if (! $c_url_directory) {
		my $c_p_url = parse_url($current_url);
		### $c_p_url
		my $c_paths_url = split_url_path($c_p_url->{path}, 256);
		### $c_paths_url
		pop(@$c_paths_url);
		### $c_paths_url
		delete ($c_p_url->{path});
		for (@$c_paths_url) {
			$c_p_url->{path} .= "$_/";
		}
		### $c_p_url
		$c_p_url->{path} .= "$urlr";
		$c_p_url->{path} = normalize_path("/" . "$c_p_url->{path}");
		if ($end_with_slash or $dot_only or $dot_2_only) {
			$c_p_url->{path} .= "/"; # normalize path will remove it
		}
		substr($c_p_url->{path},0,1,'');
		### $c_p_url
		url(return_url($c_p_url));
		return 0;
	}
}

sub return_url {
	my ($url) = @_;
	my $url_string;
	# ## @_
	if (ref($url) ne 'HASH') { # assuming string
		if ($url !~ m|.*://|) {
			$url =~ s|(.*)|gemini://$1|;
		}
		$url = parse_url($url);
	}
	my $scheme = $url->{scheme};
	my $username = $url->{username};
	my $password = $url->{password};
	my $host = $url->{host};
	my $port = $url->{port};
	my $path = $url->{path};
	my $query = $url->{query};
	my $fragment = $url->{fragment};
	
	# 'https://peter:bro@localhost:8989/some/path/to/resource?q1=yes&q2=no&q3=maybe#frag=1';
	# a valid url ^^
	if (! $scheme) {
		$url_string .= "gemini://";
	} 
	else {
		$url_string .= "$scheme://";
	}
	if ($username and $password) {
		$url_string .= "$username:$password@";
	} elsif ($username) {
		$url_string .= "$username@";
	}
	$url_string .= "$host" if ($host);
	if ($port and $port ne 1965) {
		$url_string .= ":$port";
	}
	$url_string .= "/";
	$url_string .= "$path" if ($path);
	$url_string .= "?$query" if ($query);
	$url_string .= "#$fragment" if ($fragment);

	return $url_string;
}

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

sub hist {
	my $hist;
	my $counter = 1;
	for my $item (@history) {
		$hist .= "[$counter] ". colored("$$item[0]", 'underline') ." $$item[1]\n";
		$counter++;
	}
	if ($hist) {
		print $OUT $hist;
	}
	else {
		print $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) {
		print $OUT $d;
	}
	else {
		print $OUT "No links.\n";
	}
}

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

	my $link;

	if ($setting == 0 and @links and exists $links[$n][0]) {
		$link = $links[$n][0];
	} elsif ($setting == 1 and @history and exists $history[$n][0]) {
		$link = $history[$n][0];
	}
	else {
		my $m = $n+1;
		print $OUT "'$m' isn't available.\n";
		return 1;
	}
	access_resource($link);
}

sub access_resource {
	my ($link) = @_;
	# This implies it is valid fqdn
	if (has_scheme($link)) {
		url("$link");
	}
	else {
		my $c_url = parse_url($current_url);
		my $end_with_slash = 1 if ($link =~ m|.*/$|);
		my $begin_with_slash = 1 if ($link =~ m|^/.*|);

		### absolute location ?
		if ($begin_with_slash) {
			delete($c_url->{path});
			$c_url->{path} = $link;
			if ($end_with_slash){
				$c_url->{path} .= "/";
			}
			substr($c_url->{path},0,1,'');
			url(return_url($c_url));
			return 	0;
		}

		### current url is a directory ?
		if ($current_url =~ m|.*/$|) {
			$current_url .= $link;
			#if ($end_with_slash) {
			#	$current_url .= "/";
			#}
			url(return_url($current_url));
			return 0;
		} 
		else { 
			### current url must NOT be a directory
			my $d;
			if ($c_url->{path}) {
				my $cp_url = split_url_path($c_url->{path}, 256);
				pop(@$cp_url);
				for (@$cp_url) {
					$d .= "$_/";
				}
			}
			$d .= $link;
			$c_url->{path} = normalize_path($d);
			if ($end_with_slash) {
				$c_url->{path} .= "/";
			}
			url(return_url($c_url));
			return 0;
		}
	}
}

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

	if (@history >= 2) {
		url("$history[-2][0]");
	}
	else {
		print $OUT "No such history there.";
	}
	### @history

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

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

sub toggle {
	# refaliasing
	\my $t = \$_[0];
	if ($t == 1) {
		$t = 0;
	}
	else {
		$t = 1;
	}
	if (! $_[1]) {
		print $OUT "$t\n";
	}
}

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 pretty_links {
	my $counter = 1;
	for (@doc) {
		_pre_block($_);
		if ((substr($_,0,2)) eq '=>' and not $pre_block) {
			$_ =~ m/^=>[\s]*([\w\d\-\\\/\.\:\~\?\=\#]+)[\s]*(.+)?$/;
			if ($2) {
				$_ = colored("[$counter" . _is_not_scheme_gemini($1) . "]",'underline') . " $2\n";
			}
			else {
				$_ = colored("[$counter" . _is_not_scheme_gemini($1) . "]",'underline') . " $1\n";
			}
			$counter++;
		}
	}
}

sub pretty_headers {
	for (@doc) {
		_pre_block($_);
		if ((substr($_,0,3)) eq '###' and not $pre_block) {
			$_ =~ s/^###[\s]*(.*)$/colored("$1",'underline')/e;
		}
		if ((substr($_,0,2)) eq '##' and not $pre_block) {
			$_ =~ s/^##[\s]*(.*)$/colored("$1",'bold')/e;
		}
		if ((substr($_,0,1)) eq '#' and not $pre_block) {
			$_ =~ s/^#[\s]*(.*)$/colored("$1",'bold', 'underline')/e;
		}
	}
}

sub _is_not_scheme_gemini {
	### @_
	my ($thing) = $_[0];
	if (has_scheme($thing)) {
			$_[0] =~ m|(.*)://.*|;
			if ($1 ne 'gemini') {
				return " $1";
			}
	}
	return '';
}

sub _pre_block {
	if (substr($_[0],0,3) eq '```') {
		toggle($pre_block,1);
	}
}

sub value_number {
	# refaliasing
	\my $v = \$_[0];
	my $numb = $_[1];
	my $k = $_[2];
	$v = $numb if ($numb =~ m/^\d*$/);
	print $OUT "$k is now: $v\n";
	### @_
}

sub clear_query {
	return 1 if (!$current_url);
	my @url = split('\?', $current_url);
	$current_url = $url[0];
}

sub cert_create {
	# this should create certs somewhere more optimal, rather than the working directory 

	my $old_umask = umask(077);

	if (! -e './certs') {
		mkdir('./certs');
	}
	print $OUT "What should the profile name be? ";
	chomp(my $input = <STDIN>);
	$input =~ tr|/|.|;
	if (-e "./certs/$input") {
		print $OUT "Sorry, but that already exists.\n";
	}
	else {
		mkdir("./certs/$input");
		print $OUT "What should the commonName be? (it will be used to identify you easily) ";
		chomp(my $common_name = <STDIN>);
		#print $OUT "When should this expire (in seconds ('31536000' = 1 year))? ";
		my $expire;
		while (1) {
			print $OUT "When should this expire? (1s, 1h, 1d, 1m, 1y, 0s (cancel)) ";
			chomp($expire = <STDIN>);
			if ($expire =~ m/^(\d+)+(\w)$/) {
				if (lc $2 eq 's') {
					if ($1 == 0) {
						print $OUT "Cancelling.\n";
						umask($old_umask);
						return 1;
					}
					else {
						$expire = $1 + time();
					}
				} elsif (lc $2 eq 'h') {
					$expire = ($1*3600) + time(); # 3600 seconds in an hour
				} elsif (lc $2 eq 'd') {
					$expire = ($1*86400) + time(); # 86400 seconds in a day
				} elsif (lc $2 eq 'm') {
					$expire = ($1*2592000) + time(); # 2592000 seconds in 30 days (month)
				} elsif (lc $2 eq 'y') {
					$expire = ($1*31536000) + time(); # 31536000 seconds in 365 days (year)
				} else {
					next;
				}
			}
			else {
				next;
			}
			last;
		}
		my $not_before = time();
		### $expire
		### $not_before
		my %cert = (
			'subject' => {
				'commonName' => "$common_name",
			},
			'not_before' => $not_before,
			'not_after' => $expire,
		);
		my ($cert, $key) = CERT_create(%cert);
		PEM_cert2file($cert,"./certs/$input/cert.pem");
		PEM_key2file($key,"./certs/$input/key.pem");
		CERT_free($cert);
		KEY_free($key);
	}
	umask($old_umask);
}

sub cert_use {
	if (! $use_cert) {

		my $counter = 1;
		my @profiles;
		# this should read dirs from a more optimal location, rather than working directory
		if (! -e './certs') {
			print $OUT "You need to create a cert first: 'cert-create'.\n";
			return 1;
		}
		for (read_dir('./certs')) { 
			print $OUT "[$counter] $_\n";
			push(@profiles, "$_");
			$counter++;
		}
		if (! @profiles) {
			print $OUT "You need to create a cert first: 'cert-create'.\n";
			return 1;
		}

		print $OUT "Which profile? ";
		chomp(my $input = <STDIN>);

		if ($input) {
			print $OUT "Loading 'certs/$profiles[$input-1]/cert.pem' and 'certs/$profiles[$input-1]/key.pem'\n";
			eval {
				$cert = PEM_file2cert("certs/$profiles[$input-1]/cert.pem");
					$key = PEM_file2key("certs/$profiles[$input-1]/key.pem");
				CERT_free($cert);
				KEY_free($key);
				$cert = "certs/$profiles[$input-1]/cert.pem";
				$key = "certs/$profiles[$input-1]/key.pem";
			};
			if ($@) {
				print $OUT "Something is wrong with the certificate/key. Will not use.\n$@";
				$cert = "";
				$key = "";
			}
			else {
				print $OUT "Cert and Key loaded.\n";
				toggle($use_cert);
			}
		}
		else {
			print $OUT "Did not load anything.\n";
		}
	}
	else {
		print $OUT "Unloading cert and key.\n";
		toggle($use_cert);
	}
}

sub cert_del {
	# cert dir should be in a more optimal place, not working directory.
	if (! -e './certs') {
		print $OUT "You have no certs/ directory.\n";
		return 0;
	}

	my $counter = 1;
	my @profiles;
	for (read_dir('./certs')) { 
		print $OUT "[$counter] $_\n";
		push(@profiles, "$_");
		$counter++;
	}
	if (! @profiles) {
		print $OUT "You need to create a cert first: 'cert-create'.\n";
		return 1;
	}
	print $OUT "Delete which profile? ";
	chomp(my $input = <STDIN>);
	if ($input) {
		print $OUT "Are you sure you want to delete certs/$profiles[$input-1]/? y/N\n";
		chomp(my $yORn = <STDIN>);
		if (lc $yORn eq 'y') {
			unlink("./certs/$profiles[$input-1]/cert.pem","./certs/$profiles[$input-1]/key.pem");
			rmdir("./certs/$profiles[$input-1]");
			if ($!) {
				print $OUT "Unable to delete profile.\n$!\n";
			}
			else {
				print $OUT "Profile '$profiles[$input-1]' succesfully deleted.\n";
			}
		}
		else {
			print $OUT "Nothing is deleted.\n";
		}
	}
	else {
		print $OUT "Nothing is deleted.\n";
	}
}