diff options
Diffstat (limited to 'gmi.pl')
| -rwxr-xr-x | gmi.pl | 208 |
1 files changed, 180 insertions, 28 deletions
@@ -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"; + } +} |