cert stuff

2 files changed, 182 insertions, 28 deletions

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..29c94cc
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,2 @@
+# create your own certs
+*.pem
diff --git a/gmi.pl b/gmi.pl
index 8516a3e..f301250 100755
--- a/gmi.pl
+++ b/gmi.pl
@@ -5,30 +5,32 @@
 use strict;
 use warnings;
 #use diagnostics;
-use utf8;
+#use utf8;
 #use bytes;
 use feature qw(refaliasing);
 no warnings qw(experimental::refaliasing);
 
-our $VERSION = 'v0.0.26';
+our $VERSION = 'v0.0.27';
 
 # 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 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 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
+# 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';
@@ -36,7 +38,6 @@ $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 @doc;
 my @links;
 my $current_url = "";
@@ -52,6 +53,9 @@ 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;
@@ -121,6 +125,11 @@ my %commands = (
 
 	'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;
@@ -195,17 +204,36 @@ sub url {
 		$url->{port} = '1965';
 	}
 	
-	my $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,
-	);
+	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);
@@ -352,11 +380,19 @@ sub follow_status_code {
 		}
 
 	} elsif ($status_code1 == 6) {
-		print $OUT "The sever is saying something about a cert, but this client doesn't do certs yet.\n" .
-		"For reference: 60 = Client Cert Required, 61 = Client Cert Not Authorized, 62 = Bad Cert\n@doc";
+		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 $bad_code;
+		print $OUT $bad_code;
 	}
 	### @status_code;
 }
@@ -575,7 +611,7 @@ sub access_resource {
 			}
 			substr($c_url->{path},0,1,'');
 			url(return_url($c_url));
-			return 0;
+			return 	0;
 		}
 
 		### current url is a directory ?
@@ -766,3 +802,119 @@ sub clear_query {
 	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 would you like the profile name to 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))? ";
+		chomp(my $expire = <STDIN>);
+		$expire = $expire + time() ;
+		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
+		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>);
+
+		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 "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;
+	}
+
+	local $SIG{INT} = sub { return 1 };
+	print $OUT "ctrl-c to cancel.\n";
+
+	my $counter = 1;
+	my @profiles;
+	for (read_dir('./certs')) { 
+		print $OUT "[$counter] $_\n";
+		push(@profiles, "$_");
+		$counter++;
+	}
+	print $OUT "Delete which profile? ";
+	chomp(my $input = <STDIN>);
+	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";
+	}
+}