summaryrefslogtreecommitdiff
path: root/gmi.pl
diff options
context:
space:
mode:
Diffstat (limited to 'gmi.pl')
-rwxr-xr-xgmi.pl69
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;
+ }
+ }
}
}