Aaron's Perl 6 Blog

The web is slow. Between overloaded pages, overloaded servers, bloated browsers, and ISP throttling, it's not unusual for even simple pages to take a couple seconds to load. But you get used to it, so I was struck by how fast the Internet can actually be when I fired up a gopher client recently.

Yes, gopher still exists, barely. For those who are unfamiliar with it, gopher is a sort of text-based hypertext system that predates the web -- think the web minus graphics, fonts, and interactive scripting, just files and directories and links between them, though you can also offer a few other things like search services. I miss those specialized services like gopher, IRC, and Usenet, that did one thing very well before they were overwhelmed by the web.

Anyway, when I started it, it connected to the server so fast that I thought it had to be faking. Did it install a local dummy server or something, and I was actually connecting to that? Some clicking around showed that, no, I was really connecting to remote servers; it was just so fast it was virtually instantaneous.

That got me thinking I'd like to run a gopher server, just for fun and nostalgia. But I was surprised to find no gopherd in the FreeBSD ports. Net::Gopher has even been dropped from CPAN. There's code out there, but it tends to be old and is considered buggy. I found one recent Python version, but....Python. So I thought I'd write my own, and why not do it in Perl 6?

A very simple, early implementation is below. It handles only the main two gopher types: documents and directories. You give it a directory, and it offers everything under that directory as an information tree.

I continue to love the new IO functions like slurp and dir. They make dealing with the filesystem faster and more intuitive. Actual writing time on this was less than an hour. The filesystem maps to the gopher protocol so well that it almost seems too easy. (I spent at least 3 hours trying to figure out why the gopher client in the FreeBSD ports (net/gopher) didn't like its output, before discovering that lynx likes it fine, so I'm still not sure what was going on there.)

A couple things I added along the way: If a directory contains a .gophermap file, that is sent in place of the directory info, so it will need to be in valid gophermap format. If a directory contains a .gopherhead file, that is sent ahead of the directory listing, so it's a way to put an intro at the top.

Future additions to make it worth distributing:

• Multi-threading to handle multiple connections
• Make path handling cross-platform
• Allow files to be hidden/blocked, maybe .gitignore style
• Security -- make sure it's not possible to get outside the directory
• Documentation
• Installer/Tests
• Error handling
• Modularize it. Net::Gopher?
• Logging by some standard or other
• Binary file downloads
• Additional gopher types

And now the code:

#!/usr/bin/env perl6
use v6;

my $TITLE = 'My Gopher Server';
my $CRLF = "\r\n";
my $SERVER;
my $PORT;
my $DIR;

sub MAIN($host = 'localhost', $port = 7070, $dir = '.'){
    $SERVER = $host;
    $PORT = $port;
    $DIR = $dir;
    $DIR ~~ s/ \/$ //;              # remove any trailing slash
    die "Directory '$DIR' not found" unless $DIR.IO.d;

    my $listen = IO::Socket::INET.new(:listen,
                                      :localhost($host),
                                      :localport($port));
    say "Listening...";
    loop {
        my $connection = $listen.accept;
        say "Answering...";
        my $line = $connection.recv;
        handle-request($connection, $line);
        $connection.close;
        say "Closed...";
    }
}

sub handle-request( $c, $l is copy ){
    $l ~~ s/ <[\t\r\n]> .* //;             # input line ends at first tab or newline
    say "Fetching '$l' for 'remote-addr'"; # looks like the remote address is not available yet
    $l = "$DIR/$l";
    $l ~~ s/ \/$ //;                       # remove any trailing slash
    if $l.IO.d {                           # handle directory
        if "$l/.gophermap".IO.e {
            $c.print( "$l/.gophermap".IO.slurp );
        } else {
            if "$l/.gopherhead".IO.e {
                $c.print( "$l/.gopherhead".IO.slurp );
            }
            for dir $l -> $n {
                next if $n ~~ m/^\./;
                if $n.IO.d {
                    $c.print: 1;
                } elsif $n.IO.f {
                    $c.print: 0;
                } # skip symlinks, pipes, and other oddities
                $c.print: join "\t", "$n", "$n", $SERVER, "$PORT$CRLF";
            }
        }
    } elsif $l.IO.f {                    # handle file
        $c.print: $l.IO.slurp;
    } else {                             # send error
        $c.print: "3Error which should be expanded on.";
    }
    $c.print: ".$CRLF";
}