💾 Archived View for blinkyshark.chickenkiller.com › nofer captured on 2023-06-16 at 16:24:21. Gemini links have been rewritten to link to archived content
-=-=-=-=-=-=-
my $USER = `whoami`;
chomp $USER;
my $HOME = "/home/$USER";
my $LOG = "$HOME/tmp/nofer.log";
my $PORT = 70;
my $FQDN = `hostname -f`; # fully qualified domain name
chomp $FQDN;
$HOST = "\t$FQDN\t$PORT";
my $SRCROOT = "/home/pi/repos/gemtext";
use Cwd;
use Socket;
use Text::Tabs;
use IO::Socket;
sub url_parts {
# $scheme, $authority, $path, $query, $fragment
return $_ =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?|;
}
sub get_host {
my $link = shift;
my($scheme, $authority, $path, $query, $fragment) = url_parts($link);
my ($host, $port) = split(/:/, $authority);
return $host;
}
sub print_link {
my ($fout, $link, $text) = @_;
$text = Text::Tabs::expand $text;
if ($link =~ /^(gemini:|http:|https:|spartan:)/) {
my $host = get_host($link);
print $fout "h$text\tURL:$link\t$host\t70\r\n";
return;
}
if ($link =~ /.*\.gmi$/) {
print $fout "1$text\t/$link$HOST\r\n";
return;
}
if ($link =~ /^(gopher:\/\/)(.*)/ ) {
my ($server, $path) = split /\// , $2 , 2;
if ( $path =~ /^(1\/)(.*)/ ) {
$path = "/$2"; # eliminate stray "1/" at beginning
}
print $fout "1$text\t$path\t$server\t70\r\n"; # port of 70 assumed
return;
}
# ensure link starts with a /
if($link !~ /^\//) { $link = "/" . $link; }
if($link =~ /\.(jpg|JPG)$/) {
print $fout "I$text\t$link$HOST\r\n";
return;
}
print $fout "0$text\t$link$HOST\r\n";
}
sub handle_mapfile {
my $fout = shift;
while(<FH>) {
my $input = $_;
$input =~ chomp $input;
if( $_ =~ /^=>\s+(\S+)\s+(.*)/) {
print_link($fout, $1, $2);
} else {
$input = Text::Tabs::expand $input;
print $fout "i$input\t\tnull.host\t1\r\n";
}
}
#print $fout "-------------------------- Served by nofer\r\n";
}
sub handle_nonmapfile {
my $fout = shift;
while(<FH>) { print $fout "$_"; }
}
sub mkresponse {
my $request = shift;
$request =~ s/\r//g;
$request =~ s/\n//g;
if($request eq "") { $request = "index.gmi"; }
if($request eq "/") { $request = "index.gmi"; }
#print "request is <$request>\n";
# check that client is not trying to snoop around our filesystem
my $path1 = "$SRCROOT/$request";
#my $can_path = File::Spec->canonpath($requested_path);
my $can_path = Cwd::abs_path($path1);
my $rascal = substr($can_path, 0, length($SRCROOT)) ne $SRCROOT;
#print "rascal is <$rascal>\n";
my $output = "";
open(my $fout, ">", \$output);
if( $rascal || ! (-e $can_path)) {
print $fout "3Error: File or directory not found!\n";
return $output;
#exit 1;
}
open(FH, "<", "$can_path");
if($request =~ m/\.gmi$/) {
handle_mapfile($fout) ;
} else {
handle_nonmapfile($fout);
}
close FH;
close $fout;
# LOGGING
# TODO : it doesn't yet log unfound files/directories
open(FH, ">>", $LOG);
my $dt = localtime();
use Socket;
my $rip = "STDIN"; # In case we invoke from command-line for testing purposes
my $pname = getpeername(STDIN);
if( $pname ) {
my ($port,$iaddr) = sockaddr_in($pname);
$rip = inet_ntoa($iaddr);
}
print FH "$dt:$rip:$request\n";
close FH;
return $output;
}
sub via_stdio() {
my $request = <>;
print mkresponse($request);
}
sub via_socket1() {
my $socket = new IO::Socket::INET->new (
#LocalHost => 'localhost',
LocalPort => 70,
Proto => 'tcp',
#Listen => 1,
#Reuse => 1,
);
die "Could not create socket: $!n" unless $socket;
print "Waiting for data from the client end\n";
my $new_socket = $socket->accept();
#my $request = <$new_socket>;
$socket->recv(my $request, 180);
print "Request is: $request";
print $socket mkresponse($request);
#while(<$new_socket>)
#{
# print $_;
#}
close($socket);
}
sub via_socket() {
print "Running as server\n";
# cribbed from
# https://www.tutorialspoint.com/perl/perl_socket_programming.htm
my $port = $PORT;
my $proto = getprotobyname('tcp');
my $server = $FQDN; # Host IP running the server
# create a socket, make it reusable
#socket(SOCKET, PF_INET, SOCK_STREAM, $proto) or die "Can't open socket $!\n";
#setsockopt(SOCKET, SOL_SOCKET, SO_REUSEADDR, 1) or die "Can't set socket option to SO_REUSEADDR $!\n";
socket(SOCKET, PF_INET, SOCK_STREAM, $proto) || die $!;
setsockopt(SOCKET, SOL_SOCKET, SO_REUSEADDR, 1) or die "Can't set socket option to SO_REUSEADDR $!\n";
my $sin = sockaddr_in(70, INADDR_ANY);
# bind to a port, then listen
#bind(SOCKET, pack_sockaddr_in($port, inet_aton($server))) or die "Can't bind to port $port! \n";
bind(SOCKET, $sin) || die $!;
listen(SOCKET, 5) or die "listen: $!";
print "SERVER started on port $port\n";
# accepting a connection
#my $client_addr;
my $id = 0;
use IO::Handle;
while (my $client_addr = accept(NEW_SOCKET, SOCKET)) {
#$NEW_SOCKET->autoflush;
# send them a message, close connection
my $name = gethostbyaddr($client_addr, AF_INET );
my $request = <NEW_SOCKET>;
$request =~ s/\r//g;
$request =~ s/\n//g;
#while(<NEW_SOCKET>) { $request += $_; }
#recv(NEW_SOCKET, $request);
print "\n", $id, ": Connection recieved from $name\n";
print "Request is <$request>\n";
#print NEW_SOCKET "Smile from the server";
my $response = mkresponse($request);
#print $response;
print NEW_SOCKET $response;
close NEW_SOCKET;
$id++;
}
}
sub main() {
# example argument parsing from
# https://codereview.stackexchange.com/questions/64753/parsing-command-line-arguments-in-perl
my $server =0;
while (@ARGV) {
for(shift(@ARGV)) {
($_ eq '-s' || $_ eq '--server') && do { $server = 1; }
}
}
if($server) {
via_socket();
} else {
via_stdio();
#print "Run as stdio";
}
}
main();