Do not load entire request into memory.

Added support for webm magic detection.

Fix bug

Bug fix

1 files changed, 54 insertions, 15 deletions

diff --git a/gmi.pl b/gmi.pl
index d55c772..f8d97c9 100755
--- a/gmi.pl
+++ b/gmi.pl
@@ -7,7 +7,7 @@ use warnings;
 use 5.010;
 #use diagnostics;
 
-our $VERSION = 'v0.0.2';
+our $VERSION = 'v0.0.3b';
 
 # Modules
 use IO::Socket::SSL; # CPAN
@@ -379,7 +379,7 @@ while () {
 	my $cv = check_vhost_settings($vhost);
 	# we already know it exists and is readable
 	if (! -d $doc_loc) {
-		$doc = _slurp($doc_loc);
+		#$doc = _slurp($doc_loc);
 		goto DOC_ASSIGNED;
 	}
 	elsif (-d $doc_loc) {
@@ -392,13 +392,13 @@ while () {
 		# if assume_index
 		if (($cv == 1 or $cv == 3) and is_exists_and_readable($doc_loc. '/index.gmi') ) {
 			$doc_loc .= '/index.gmi';
-			$doc = _slurp($doc_loc);
+			#$doc = _slurp($doc_loc);
 			goto DOC_ASSIGNED;
 		}
 		# if dir_listing
 		elsif ($cv == 2 or $cv == 3) {
-			$doc = dir_listing($doc_loc, $path);
-			goto DOC_ASSIGNED;
+			#$doc = dir_listing($doc_loc, $path);
+			goto DIR_LISTING;
 		}
 		else {
 			goto FAILURE;
@@ -406,12 +406,28 @@ while () {
 	}
 
 	DOC_ASSIGNED:
-	my $meta = $ft->checktype_contents($doc);
+	#my $meta = $ft->checktype_contents($doc);
+	my $meta = $ft->checktype_filename($doc_loc);
 	if ($meta eq "application/octet-stream") {
 		# 'text/gemini' is non-standard mime-type
 		if ((substr($doc_loc, -4, 4) eq '.gmi') or (substr($doc_loc, -1, 1) eq '/' and ($cv == 2 or $cv == 3))) {
 			$meta = 'text/gemini';
 		}
+		# Manually support webm until better magic detection is used
+		elsif (substr($doc_loc, -4, 4) eq 'webm') {
+			open(my $fh, '<', $doc_loc);
+			my $h;
+			read($fh, $h, 1*1024);
+			if ($h =~ m/V_VP9/) {
+				$meta = 'video/VP9';
+			} elsif ($h =~ m/V_VP8/) {
+				$meta = 'video/VP8';
+			} else {
+				$meta = 'application/octet-stream';
+			}
+			close $fh;
+			undef($h);
+		}
 		elsif (exists $config->{$vhost}{default_mime}) {
 			$meta = $config->{$vhost}{default_mime};
 		}
@@ -420,11 +436,15 @@ while () {
 		}
 		### $meta
 	}
-	speak($cl, 'success', $meta, $doc);
+	speak($cl, 'success', $meta, $doc_loc);
+	goto CLOSE;
+
+	DIR_LISTING:
+	speak($cl, 'success', 'text/gemini', $doc_loc, $path);
 	goto CLOSE;
 
 	FAILURE:
-	speak($cl, 'failure') or print $out "No file handle?";
+	speak($cl, 'failure');
 	goto CLOSE;
 
 	CLOSE:
@@ -558,17 +578,36 @@ sub gem_code {
 	return $res;
 }
 
+# TODO: remove magic numbers
 sub speak {
-	my ($cl, $header, $meta, $doc) = @_;
+	my ($cl, $header, $meta, $doc_loc, $path) = @_;
 	### $meta
 	my $head = gem_code($header, $meta);
 	$log .= " $head";
-	if ($doc) {
-		syswrite($cl, "$head\r\n");
-		print $cl $doc; 
-	}
-	else {
-		syswrite($cl, "$head\r\n");
+	syswrite($cl, "$head\r\n");
+
+	if ($doc_loc) {
+		if (is_exists_and_readable($doc_loc) and ! -d $doc_loc) {
+			my $r;
+			open (my $fh, '<', $doc_loc);
+			# An SSL packet can only have about 16k bytes 
+			# so, read less 16k, send it until eof
+			while (sysread($fh, $r, 15*1024)) { 
+				syswrite($cl, $r);
+				undef($r);
+			}
+			close $fh;
+		}
+		elsif (is_exists_and_readable($doc_loc) and -d $doc_loc) {
+			my $doc;
+			$path ? ($doc = dir_listing($doc_loc, $path)) : ($doc = dir_listing($doc_loc));
+			
+			# It is possible that a dir listing can produce more than 16k bytes
+			my $offset = 0;
+			while (my $w = syswrite($cl, $doc, 15*1024, $offset)) {
+				$offset += $w;
+			}
+		}
 	}
 }