start cgi stuffcgi

1 files changed, 64 insertions, 2 deletions

diff --git a/gmi.pl b/gmi.pl
index 246b809..9a43433 100755
--- a/gmi.pl
+++ b/gmi.pl
@@ -7,7 +7,7 @@ use warnings;
 use 5.010;
 #use diagnostics;
 
-our $VERSION = 'v0.17.2';
+our $VERSION = 'v0.18.0-cgi_WIP';
 
 # Modules
 use IO::Socket::SSL; # CPAN
@@ -17,7 +17,7 @@ use IO::Socket::UNIX;
 use IO::Select;
 use URL::XS qw(parse_url split_url_path parse_url_query); # CPAN
 use Path::Naive qw(normalize_path); # CPAN
-#use Smart::Comments; # CPAN
+use Smart::Comments; # CPAN
 use URI::Encode qw(uri_encode); # CPAN
 use IO::Select;
 use TOML qw(from_toml);
@@ -28,6 +28,7 @@ use English qw( -no_match_vars );
 use Const::Fast;
 use Carp;
 use String::Substitution qw( gsub_modify );
+use IPC::Run3;
 
 #$IO::Socket::SSL::DEBUG = 15;
 
@@ -252,6 +253,11 @@ sub respond_to_client {
 	}
 	### $doc_loc
 
+	### cgi checking
+	if (check_cgi($doc_loc, $vhost)) {
+		goto DOC_CGI;
+	}
+
 	# not a directory
 	if (! -d $doc_loc) {
 		goto DOC_ASSIGNED;
@@ -287,6 +293,10 @@ sub respond_to_client {
 	speak($cl, 'success', $meta, $doc_loc);
 	return;
 
+	DOC_CGI:
+	do_cgi($doc_loc, $path, $cl);
+	return;
+
 	DIR_LISTING:
 	speak($cl, 'success', 'text/gemini', $doc_loc, $path);
 	return;
@@ -1220,3 +1230,55 @@ sub cert_req {
 	}
 	return;
 }
+
+sub check_cgi {
+	my ($doc_loc, $vhost) = @_;
+	# '.cgi' should be a user defined array
+	if (not -x $doc_loc or substr($doc_loc, -3, 4) eq '.cgi') {
+		### not -x or ending in '.cgi'.
+		return 0;
+	}
+
+	if (exists $config->{$vhost}{cgi_enabled}) {
+		if ($config->{$vhost}{cgi_enabled} eq 'true') {
+			return 1;
+		}
+	}
+	elsif (exists $config->{default}{cgi_enabled}) {
+ 		if ($config->{default}{cgi_enabled} eq 'true') {
+			return 1;
+		}
+	}
+	### not cgi_enabled
+	return;
+}
+
+sub do_cgi {
+	my ($doc_loc, $path, $cl) = @_;
+	$cl_cert ? (local $ENV{'AUTH_TYPE'} = 'cl_cert') : (local $ENV{'AUTH_CERT'} = '');
+	local $ENV{'CONTENT_LENGTH'} = undef;
+	local $ENV{'CONTENT_TYPE'} = undef;
+	local $ENV{'GATEWAY_INTERFACE'} = 'CGI/1.1';
+	local $ENV{'PATH_INFO'} = $doc_loc;
+	local $ENV{'PATH_TRANSLATED'} = $path;
+	local $ENV{'QUERY_STRING'} = ''; # to do - how to get 10 <meta> ?
+	local $ENV{'REMOTE_ADDR'} = $cl->peerhost(); ## will NOT work with UNIX
+	local $ENV{'REMOTE_HOST'} = '';
+	local $ENV{'REMOTE_IDENT'} = undef;
+	local $ENV{'REMOTE_USER'} = $cl_cert;
+	local $ENV{'REQUEST_METHOD'} = '';
+	local $ENV{'SCRIPT_NAME'} = $doc_loc;
+	local $ENV{'SERVER_NAME'} = $cl->get_servername();
+	local $ENV{'SERVER_PORT'} = $DEFAULT_GEMINI_PORT; # TODO: FIX
+	local $ENV{'SERVER_PROTOCOL'} = 'gemini';
+	local $ENV{'SERVER_SOFTWARE'} = $PROGRAM_NAME. '('. $VERSION. ')';
+
+	#my ($run_in, $run_out);
+	my @cmd;
+	push @cmd, $doc_loc;
+	### @cmd
+	### $doc_loc
+	run3(\@cmd); #, \$run_in, \$run_out);
+	# ## $run_in
+	## # $run_out
+}