Guestbook for Gemini

guestbook.gmi

# Guestbook

=> /cgi-bin/guestbook.pl Add your entry

guestbook.pl

#!/usr/bin/perl

use strict;
use warnings;
use v5.12;
use MIME::Base64 qw(encode_base64 decode_base64);

my %CONFIG = (
    temp_dir    => $ENV{TMPDIR} || '/tmp',
    output_file => '/path/to/index.gmi',
    script_url  => "gemini://$ENV{SERVER_NAME}/cgi-bin/guestbook.pl",
    back_url    => "gemini://$ENV{SERVER_NAME}/guestbook/",
);

my @FIELDS = qw(name location comment link);

my $field;
my %session = map { $_, '' } @FIELDS;

my $path_info = $ENV{PATH_INFO};
$path_info =~ s#^/##;
if ($path_info) {
    my $raw_session;
    ($field, $raw_session) = split(m#/#, $path_info, 2);
    decode_session($raw_session, \%session);
}

if ($field) {
    if (grep { $field eq $_ } @FIELDS) {
        handle_field(\%session, $field);
    } elsif ($field eq 'submit') {
        submit(\%session);
    } else {
        header(51, "Not Found");
    }
} else {
    form(\%session);
}

sub header {
    my $status = shift || "20";
    my $meta = shift || "text/gemini";
    print "$status $meta\r\n";
    return;
}

sub form {
    my $session = shift || die 'no session';
    my $error = shift;

    header();
    print "Fill out the form below. All values will be public.\n\n";

    if ($error) {
        print "Error: $error\n\n";
    }

    my $encoded = encode_session($session);
    print "=> $CONFIG{script_url}/name/$encoded Name: $session->{name}\n";
    print "=> $CONFIG{script_url}/location/$encoded Location (optional): $session->{location}\n";
    print "=> $CONFIG{script_url}/link/$encoded Link (optional): $session->{link}\n";
    print "=> $CONFIG{script_url}/comment/$encoded Comment: $session->{comment}\n\n";
    print "=> $CONFIG{script_url}/submit/$encoded Submit\n";
    print "=> $CONFIG{back_url} Cancel\n";
    return;
}

sub handle_field {
    my $session = shift || die 'no session';
    my $field = shift || die 'no field name';

    my $input = $ENV{QUERY_STRING};

    unless ($input) {
        header(10, "Enter your $field");
        return;
    }

    $input =~ s/%([a-f0-9]{2})/pack("C", hex($1))/egi;

    if ($input =~ /^\w*=>/) {
        header(10, "Enter your $field (without a link)");
        return;
    }

    $session{$field} = $input;
    form($session);

    return;
}

sub submit {
    my $session = shift || die 'no session';

    unless ($session->{name}) {
        form($session, "Name is required");
        return;
    }

    unless ($session->{comment}) {
        form($session, "Comment is required");
        return;
    }

    my $entry = format_entry($session);

    my $tmp_file = "$CONFIG{temp_dir}/" . int(rand()*(2**32));
    open(my $out, ">", $tmp_file) || die "unable to write temp file: $1";
    open(my $in, "<", $CONFIG{output_file}) || die "unable to read output file: $!";

    my $written = 0;
    for my $line (<$in>) {
        if (!$written && $line =~ /^## /) {
            print $out $entry;
            $written = 1;
        }
        print $out $line;
    }

    if (!$written) {
            print $out $entry;
    }

    close($in);
    close($out);

    rename($tmp_file, $CONFIG{output_file}) || die "unable to replace guestbook file: $!";

    header();
    print "# Thanks for signing the guest book\n\n";
    print "=> $CONFIG{back_url} Back to the guestbook.\n";
    print "You may need to reload when you get there to see your entry.\n";
    return;
}

sub format_entry {
    my $session = shift || die 'missing session';
    my ($sec, $min, $hour, $mday, $mon, $year) = gmtime(time);
    $year += 1900;
    $mon += 1;
    my $now = sprintf("%d-%02d-%02d %02d:%02d UTC", $year, $mon, $mday, $hour, $min);

    $session->{location} ||= "An unknown location";

    my @entry = (
        "## $session->{name} - $session->{location}",
        $now,
        "",
        $session->{comment}
    );

    if ($session->{link}) {
        push(@entry, "", "=> $session->{link}");
    }

    return join("\n", @entry) . "\n\n";
}

sub decode_session {
    my $raw = shift || "";
    my $session = shift || {};
    my @values = split(m#;#, $raw);

    for (my $i = 0; $i < scalar(@values); $i++) {
        my $key = $FIELDS[$i];
        $session->{$key} = decode_base64($values[$i]);
    }

    return wantarray ? %session : \%session;
}

sub encode_session {
    my $session = shift || die 'no session';
    my @components = map { encode_base64($session->{$_}, '') } @FIELDS;
    return join(';', @components)
}