#!/usr/bin/perl
# Copyright (C) 2017–2020  Alex Schroeder <alex@gnu.org>

# This program is free software: you can redistribute it and/or modify it under
# the terms of the GNU Affero General Public License as published by the Free
# Software Foundation, either version 3 of the License, or (at your option) any
# later version.
#
# This program is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
# details.
#
# You should have received a copy of the GNU Affero General Public License along
# with this program. If not, see <https://www.gnu.org/licenses/>.

=encoding utf8

=head1 NAME

Phoebe - serve a wiki as a Gemini site

=head1 SYNOPSIS

B<phoebe> [B<--host=>I<hostname> ...] [B<--port=>I<port>]
[B<--cert_file=>I<filename>] [B<--key_file=>I<filename>]
[B<--log_level=error>|B<warn>|B<info>|B<debug>] [B<--log_file=>I<filename>]
[B<--wiki_dir=>I<directory>] [B<--wiki_token=>I<token> ...]
[B<--wiki_page=>I<pagename> ...] [B<--wiki_main_page=>I<pagename>]
[B<--wiki_mime_type=>I<mimetype> ...] [B<--wiki_page_size_limit=>I<n>]
[B<--wiki_space=>I<space> ...]

=head1 DESCRIPTION

Phoebe does two and a half things:

It's a program that you run on a computer and other people connect to it using
their Gemini client in order to read the pages on it.

It's a wiki, which means that people can edit the pages without needing an
account. All they need is a client that speaks both Gemini and Titan, and the
password. The default password is "hello". 😃

People can also access it using a regular web browser. They'll get a very
simple, read-only version of the site.

To take a look for yourself, check out the test wiki via the web or via the web.

=over

=item L<https://gemini.circumlunar.space/clients.html>

=item L<https://transjovian.org:1965/test>

=item L<gemini://transjovian.org/test>

=back

=head1 GEMTEXT

Pages are written in gemtext, a lightweight hypertext format. You can use your
favourite text editor to write them.

A text line is a paragraph of text.

    This is a paragraph.
    This is another paragraph.

A link line starts with "=>", a space, a URL, optionally followed by whitespace
and some text; the URL can be absolute or relative.

    => http://transjovian.org/ The Transjovian Council on the web
    => Welcome                 Welcome to The Transjovian Council

A line starting with "```" toggles preformatting on and off.

    Example:
    ```
    ./phoebe
    ```

A line starting with "#", "##", or "###", followed by a space and some text is a
heading.

    ## License
    The GNU Affero General Public License.

A line starting with "*", followed by a space and some text is a list item.

    * one item
    * another item

A line starting with ">", followed by a space and some text is a quote.

    The monologue at the end is fantastic, with the city lights and the rain.
    > I've seen things you people wouldn't believe.

=head1 EDITING THE WIKI

How do you edit a Phoebe wiki? You need to use a Titan-enabled client.

Titan is a companion protocol to Gemini: it allows clients to upload files to
Gemini sites, if servers allow this. On Phoebe, you can edit "raw" pages. That
is, at the bottom of a page you'll see a link to the "raw" page. If you follow
it, you'll see the page content as plain text. You can submit a changed version
of this text to the same URL using Titan. There is more information for
developers available on Community Wiki. L<https://communitywiki.org/wiki/Titan>

Known clients:

This repository comes with a Perl script called F<titan> to upload files.
L<https://alexschroeder.ch/cgit/phoebe/plain/titan>

I<Gemini Write> is an extension for the Emacs Gopher and Gemini client
I<Elpher>. L<https://alexschroeder.ch/cgit/gemini-write/>
L<https://thelambdalab.xyz/elpher/>

Gemini & Titan for Bash are two shell functions that allow you to download and
upload files. L<https://alexschroeder.ch/cgit/gemini-titan/about/>

=head1 INSTALLATION

Using C<cpan>:

    cpan App::phoebe

Manual install:

    perl Makefile.PL
    make
    make install

=head2 Dependencies

Perl libraries you need to install if you want to run Phoebe:

=over

=item L<Algorithm::Diff>, or C<libalgorithm-diff-xs-perl>

=item L<File::ReadBackwards>, or C<libfile-readbackwards-perl>

=item L<File::Slurper>, or C<libfile-slurper-perl>

=item L<Mojolicious>, or C<libmojolicious-perl>

=item L<IO::Socket::SSL>, or C<libio-socket-ssl-perl>

=item L<Modern::Perl>, or C<libmodern-perl-perl>

=item L<URI::Escape>, or C<liburi-escape-xs-perl>

=item L<Net::IDN::Encode>, or C<libnet-idn-encode-perl>

=item L<Encode::Locale>, or C<libencode-locale-perl>

=back

I'm going to be using F<curl> and F<openssl> in the L</Quickstart> instructions,
so you'll need those tools as well. And finally, when people download their
data, the code calls C<tar> (available from packages with the same name on
Debian derived systems).

The F<update-readme.pl> script I use to generate F<README.md> also requires some
libraries:

=over

=item L<Pod::Markdown>, or C<libpod-markdown-perl>

=item L<Text::Slugify>, which has no Debian package, apparently 😭

=back

=head2 Quickstart

I'm going to assume that you're going to create a new user just to be safe.

    sudo adduser --disabled-login --disabled-password phoebe
    sudo su phoebe --shell=/bin/bash
    cd

Now you're in your home directory, F</home/phoebe>. We're going to install
things right here.

    cpan App::phoebe

Start Phoebe. It's going to prompt you for a hostname and create certificates
for you. If in doubt, answer C<localhost>. The certificate and a private key are
stored in the F<cert.pem> and F<key.pem> files, using elliptic curves, valid for
five years, without password protection.

    perl5/bin/phoebe

This starts the server in the foreground. If it aborts, see the
L</Troubleshooting> section below. If it runs, open a second terminal and test
it:

    perl5/bin/gemini gemini://localhost/

You should see a Gemini page starting with the following:

    20 text/gemini; charset=UTF-8
    Welcome to Phoebe!

Success!! 😀 🚀🚀

Let's create a new page using the Titan protocol, from the command line:

    echo "Welcome to the wiki!" > test.txt
    echo "Please be kind." >> test.txt
    perl5/bin/titan --url=titan://localhost/raw/Welcome --token=hello test.txt

You should get a nice redirect message, with an appropriate date.

    30 gemini://localhost:1965/page/Welcome

You can check the page, now (replacing the appropriate date):

    perl5/bin/gemini gemini://localhost:1965/page/Welcome

You should get back a page that starts as follows:

    20 text/gemini; charset=UTF-8
    Welcome to the wiki!
    Please be kind.

Yay! 😁🎉 🚀🚀

If you have a bunch of Gemtext files in a directory, you can upload them all in
one go:

    titan --url=titan://localhost/ --token=hello *.gmi

=head2 Image uploads

OK, how do image uploads work? First, we need to specify which MIME types Phoebe
accepts. The files are going to be served back with that MIME type, so even if
somebody uploads an executable and claim it's an image, other people's clients
will treat it as an image instead of executing it (one hopes!) – so let's start
with a list of common MIME types.

=over

=item C<image/jpeg> is for photos (usually with the C<jpg> extension)

=item C<image/png> is for graphics (usually with the C<png> extension)

=item C<audio/mpeg> is for sound (usually with the C<mp3> extension)

=back

Let's continue using the setup we used for the L</Quickstart> section. Restart
the server and allow photos:

    perl5/bin/phoebe --wiki_mime_type=image/jpeg

Upload the image using the C<titan> script:

    perl5/bin/titan --url=titan://localhost:1965/jupiter.jpg \
      --token=hello Pictures/Planets/Juno.jpg

You should get back a redirect to the uploaded image:

    30 gemini://localhost:1965/file/jupiter.jpg

How did the C<titan> script know the MIME-type to use for the upload? If you
don't specify a MIME-type using C<--mime>, the C<file> utility is called to
guess the MIME type of the file.

Test it:

    file --mime-type --brief Pictures/Planets/Juno.jpg

The result is the MIME-type we enabled for our wiki:

    image/jpeg

Here's what happens when you're trying to upload an unsupported MIME-type:

    titan --url=titan://localhost:1965/earth.png \
      --token=hello Pictures/Planets/Earth.png

What you get back explains the problem:

    59 This wiki does not allow image/png

In order to allow such graphics as well, you need to restart Phoebe:

    perl phoebe --wiki_mime_type=image/jpeg --wiki_mime_type=image/png

Except that in my case, the image is too big:

    59 This wiki does not allow more than 100000 bytes per page

I could scale it down before I upload the image, using C<convert> (which is part
of ImageMagick):

    convert -scale 20% Pictures/Planets/Earth.png earth-small.png

Try again:

    titan --url=titan://localhost:1965/earth.png \
      --token=hello earth-small.png

Alternatively, you can increase the size limit using the
C<--wiki_page_size_limit> option, but you need to restart Phoebe:

    perl phoebe --wiki_page_size_limit=10000000 \
      --wiki_mime_type=image/jpeg --wiki_mime_type=image/png

Now you can upload about 10MB…

=head2 Using systemd

Systemd is going to handle daemonisation for us. There's more documentation
available online.
L<https://www.freedesktop.org/software/systemd/man/systemd.service.html>.

Basically, this is the template for our service:

    [Unit]
    Description=Phoebe
    After=network.target
    [Service]
    Type=simple
    WorkingDirectory=/home/phoebe
    ExecStart=/home/phoebe/phoebe
    Restart=always
    User=phoebe
    Group=phoebe
    MemoryMax=100M
    MemoryHigh=90M
    [Install]
    WantedBy=multi-user.target

Save this as F<phoebe.service>, and then link it:

    sudo ln -s /home/phoebe/phoebe.service /etc/systemd/system/

Reload systemd:

    sudo systemctl daemon-reload

Start Phoebe:

    sudo systemctl start phoebe

Check the log output:

    sudo journalctl --unit phoebe

=head2 Troubleshooting

🔥 B<1408A0C1:SSL routines:ssl3_get_client_hello:no shared cipher> 🔥 If you
created a new certificate and key using elliptic curves using an older OpenSSL,
you might run into this. Try to create a RSA key instead. It is larger, but at
least it'll work.

    openssl req -new -x509 -newkey rsa \
    -days 1825 -nodes -out cert.pem -keyout key.pem

=head1 FILES

Your home directory should now also contain a wiki directory called F<wiki>,
your wiki directory. In it, you'll find a few more files:

F<page> is the directory with all the page files in it; each file has the C<gmi>
extension and should be written in Gemtext format

F<index> is a file containing all the files in your F<page> directory for quick
access; if you create new files in the F<page> directory, you should delete the
F<index> file – it will get regenerated when needed; the format is one page name
(without the C<.gmi> extension) per line, with lines separated from each other
by a single C<\n>

F<keep> is the directory with all the old revisions of pages in it – if you've
only made one change, then it won't exist; if you don't care about the older
revisions, you can delete them; assuming you have a page called C<Welcome> and
edit it once, you have the current revision as F<page/Welcome.gmi>, and the old
revision in F<keep/Welcome/1.gmi> (the page name turns into a subdirectory and
each revision gets an apropriate number)

F<file> is the directory with all the uploaded files in it – if you haven't
uploaded any files, then it won't exist; you must explicitly allow MIME types
for upload using the C<--wiki_mime_type> option (see I<Options> below)

F<meta> is the directory with all the meta data for uploaded files in it – there
should be a file here for every file in the F<file> directory; if you create new
files in the F<file> directory, you should create a matching file here; if you
have a file F<file/alex.jpg> you want to create a file F<meta/alex.jpg>
containing the line C<content-type: image/jpeg>

F<changes.log> is a file listing all the pages made to the wiki; if you make
changes to the files in the F<page> or F<file> directory, they aren't going to
be listed in this file and thus people will be confused by the changes you made
– your call (but in all fairness, if you're collaborating with others you
probably shouldn't do this); the format is one change per line, with lines
separated from each other by a single C<\n>, and each line consisting of time
stamp, pagename or filename, revision number if a page or 0 if a file, and the
numeric code of the user making the edit (see L</Privacy> below), all separated
from each other with a C<\x1f>

F<config> probably doesn't exist, yet; it is an optional file containing Perl
code where you can add new features and change how Phoebe works (see
L</Configuration> below)

F<conf.d> probably doesn't exist, either; it is an optional directory containing
even more Perl files where you can add new features and change how Phoebe works
(see L</Configuration> below); the idea is that people can share stand-alone
configurations that you can copy into this directory without having to edit your
own F<config> file.

=head1 OPTIONS

=over

=item C<--wiki_token> is for the token that users editing pages have to provide;
      the default is "hello"; you can use this option multiple times and give
      different users different passwords, if you want

=item C<--wiki_page> is an extra page to show in the main menu; you can use this
      option multiple times; this is ideal for general items like I<About> or
      I<Contact>

=item C<--wiki_main_page> is the page containing your header for the main page;
      that's were you would put your ASCII art header, your welcome message, and
      so on, see L</Main Page and Title> below

=item C<--wiki_mime_type> is a MIME type to allow for uploads; text/plain is
      always allowed and doesn't need to be listed; you can also just list the
      type without a subtype, eg. C<image> will allow all sorts of images (make
      sure random people can't use your server to exchange images – set a
      password using C<--wiki_token>)

=item C<--wiki_page_size_limit> is the number of bytes to allow for uploads,
      both for pages and for files; the default is 10000 (10kB)

=item C<--host> is the hostname to serve; the default is C<localhost> – you
      probably want to pick the name of your machine, if it is reachable from
      the Internet; if you use it multiple times, each host gets its own wiki
      space (see C<--wiki_space> below)

=item C<--port> is the port to use; the default is 1965

=item C<--wiki_dir> is the wiki data directory to use; the default is either the
      value of the C<PHOEBE_DATA_DIR> environment variable, or the "./wiki"
      subdirectory

=item C<--wiki_space> adds an extra space that acts as its own wiki; a
      subdirectory with the same name gets created in your wiki data directory
      and thus you shouldn't name spaces like any of the files and directories
      already there (see L</Wiki Directory>); not that settings such as
      C<--wiki_page> and C<--wiki_main_page> apply to all spaces, but the page
      content will be different for every wiki space

=item C<--cert_file> is the certificate PEM file to use; the default is
      F<cert.pem>

=item C<--key_file> is the private key PEM file to use; the default is
      F<key.pem>

=item C<--log_level> is the log level to use (C<fatal>, C<error>, C<warn>,
      C<info>, C<debug>); the default is C<warn>

=item C<--log_file> is the log file to use; the default is undefined, which
      means that STDERR is used

=back

=head2 FILES

If you allow uploads of binary files, these are stored separately from the
regular pages; the wiki doesn't keep old revisions of files around. If somebody
overwrites a file, the old revision is gone.

You definitely don't want random people uploading all sorts of images, videos
and binaries to your server. Make sure you set up those L<tokens|/Security>
using C<--wiki_token>!

=head1 NOTES

=head2 Security

The server uses "access tokens" to check whether people are allowed to edit
files. You could also call them "passwords", if you want. They aren't associated
with a username. You set them using the C<--wiki_token> option. By default, the
only password is "hello". That's why the Titan command above contained
"token=hello". 😊

If you're going to check up on your wiki often (daily!), you could just tell
people about the token on a page of your wiki. Spammers would at least have to
read the instructions and in my experience the hardly ever do.

You could also create a separate password for every contributor and when they
leave the project, you just remove the token from the options and restart
Phoebe. They will no longer be able to edit the site.

=head2 Privacy

The server only actively logs changes to pages. It calculates a "code" for every
contribution: it is a four digit octal code. The idea is that you could colour
every digit using one of the eight standard terminal colours and thus get little
four-coloured flags.

This allows you to make a pretty good guess about edits made by the same person,
without telling you their IP numbers.

The code is computed as follows: the IP numbers is turned into a 32bit number
using a hash function, converted to octal, and the first four digits are the
code. Thus all possible IP numbers are mapped into 8⁴=4096 codes.

If you increase the log level, the server will produce more output, including
information about the connections happening, like C<2020/06/29-15:35:59 CONNECT
SSL Peer: "[::1]:52730" Local: "[::1]:1965"> and the like (in this case C<::1>
is my local address so that isn't too useful but it could also be your visitor's
IP numbers, in which case you will need to tell them about it using in order to
comply with the
L<GDPR|https://en.wikipedia.org/wiki/General_Data_Protection_Regulation>.

=head1 EXAMPLE

Here's an example for how to start Phoebe. It listens on C<localhost> port 1965,
adds the "Welcome" and the "About" page to the main menu, and allows editing
using one of two tokens.

    perl phoebe \
      --wiki_token=Elrond \
      --wiki_token=Thranduil \
      --wiki_page=Welcome \
      --wiki_page=About

Here's what my F<phoebe.service> file actually looks like:

    [Unit]
    Description=Phoebe
    After=network.target
    [Install]
    WantedBy=multi-user.target
    [Service]
    Type=simple
    WorkingDirectory=/home/alex/farm
    Restart=always
    User=alex
    Group=ssl-cert
    MemoryMax=100M
    MemoryHigh=90M
    ExecStart=/home/alex/src/phoebe/script/phoebe \
     --port=1965 \
     --log_level=debug \
     --wiki_dir=/home/alex/phoebe \
     --host=transjovian.org \
     --cert_file=/var/lib/dehydrated/certs/transjovian.org/fullchain.pem \
     --key_file=/var/lib/dehydrated/certs/transjovian.org/privkey.pem \
     --host=toki.transjovian.org \
     --cert_file=/var/lib/dehydrated/certs/transjovian.org/fullchain.pem \
     --key_file=/var/lib/dehydrated/certs/transjovian.org/privkey.pem \
     --host=vault.transjovian.org \
     --cert_file=/var/lib/dehydrated/certs/transjovian.org/fullchain.pem \
     --key_file=/var/lib/dehydrated/certs/transjovian.org/privkey.pem \
     --host=communitywiki.org \
     --cert_file=/var/lib/dehydrated/certs/communitywiki.org/fullchain.pem \
     --key_file=/var/lib/dehydrated/certs/communitywiki.org/privkey.pem \
     --host=alexschroeder.ch \
     --cert_file=/var/lib/dehydrated/certs/alexschroeder.ch/fullchain.pem \
     --key_file=/var/lib/dehydrated/certs/alexschroeder.ch/privkey.pem \
     --host=next.oddmuse.org \
     --cert_file=/var/lib/dehydrated/certs/oddmuse.org/fullchain.pem \
     --key_file=/var/lib/dehydrated/certs/oddmuse.org/privkey.pem \
     --host=emacswiki.org \
     --cert_file=/var/lib/dehydrated/certs/emacswiki.org/fullchain.pem \
     --key_file=/var/lib/dehydrated/certs/emacswiki.org/privkey.pem \
     --wiki_main_page=Welcome \
     --wiki_page=About \
     --wiki_mime_type=image/png \
     --wiki_mime_type=image/jpeg \
     --wiki_mime_type=audio/mpeg \
     --wiki_space=transjovian.org/test \
     --wiki_space=transjovian.org/phoebe \
     --wiki_space=transjovian.org/anthe \
     --wiki_space=transjovian.org/gemini \
     --wiki_space=transjovian.org/titan

=head2 Certificates and File Permission

In the example above, I'm using certificates I get from Let's Encrypt. Thus, the
regular website served on port 443 and the Phoebe website on port 1965 use the
same certificates. My problem is that for the regular website, Apache can read
the certificates, but in the setup above Phoebe runs as the user C<alex> and
cannot access the certificates. My solution is to use the group C<ssl-cert>.
This is the group that already has read access to F</etc/ssl/private> on my
system. I granted the following permissions:

    drwxr-x--- root ssl-cert /var/lib/dehydrated/certs
    drwxr-s--- root ssl-cert /var/lib/dehydrated/certs/*
    drwxr----- root ssl-cert /var/lib/dehydrated/certs/*/*.pem

=head2 Main Page and Title

The main page will include ("transclude") a page of your choosing if you use the
C<--wiki_main_page> option. This also sets the title of your wiki in various
places like the RSS and Atom feeds.

In order to be more flexible, the name of the main page does not get printed. If
you want it, you need to add it yourself using a header. This allows you to keep
the main page in a page called "Welcome" containing some ASCII art such that the
word "Welcome" does not show on the main page. This assumes you're using
C<--wiki_main_page=Welcome>, of course.

If you have pages with names that start with an ISO date like 2020-06-30, then
I'm assuming you want some sort of blog. In this case, up to ten of them will be
shown on your front page.

=head2 GUS and robots.txt

There are search machines out there that will index your site. Ideally, these
wouldn't index the history pages and all that: they would only get the list of
all pages, and all the pages. I'm not even sure that we need them to look at all
the files. The Robots Exclusion Standard lets you control what the bots ought to
index and what they ought to skip. It doesn't always work.
L<https://en.wikipedia.org/wiki/Robots_exclusion_standard>

Here's my suggestion:

    User-agent: *
    Disallow: /raw
    Disallow: /html
    Disallow: /diff
    Disallow: /history
    Disallow: /do/comment
    Disallow: /do/changes
    Disallow: /do/all/changes
    Disallow: /do/all/latest/changes
    Disallow: /do/rss
    Disallow: /do/atom
    Disallow: /do/all/atom
    Disallow: /do/new
    Disallow: /do/more
    Disallow: /do/match
    Disallow: /do/search
    # allowing do/index!
    Crawl-delay: 10

In fact, as long as you don't create a page called C<robots> then this is what
gets served. I think it's a good enough way to start. If you're using spaces,
the C<robots> pages of all the spaces are concatenated.

If you want to be more paranoid, create a page called C<robots> and put this on
it:

    User-agent: *
    Disallow: /

Note that if you've created your own C<robots> page, and you haven't decided to
disallow them all, then you also have to do the right thing for all your spaces,
if you use them at all.

=head2 Limited, read-only HTTP support

You can actually look at your wiki pages using a browser! But beware: these days
browser will refuse to connect to sites that have self-signed certificates.
You'll have to click buttons and make exceptions and all of that, or get your
certificate from Let's Encrypt or the like. Anyway, it works in theory. If you
went through the L</Quickstart>, visiting C<https://localhost:1965/> should
work!

Notice that Phoebe doesn't have to live behind another web server like
Apache or nginx. It's a (simple) web server, too!

Here's how you could serve the wiki both on Gemini, and the standard HTTPS port,
443:

    sudo ./phoebe --port=443 --port=1965 \
      --user=$(id --user --name) --group=$(id --group  --name)

We need to use F<sudo> because all the ports below 1024 are priviledge ports and
that includes the standard HTTPS port. Since we don't want the server itself to
run with all those priviledges, however, I'm using the C<--user> and C<--group>
options to change effective and user and group ID. The F<id> command is used to
get your user and your group IDs instead. If you've followed the L</Quickstart>
and created a separate C<phoebe> user, you could simply use C<--user=phoebe> and
C<--group=phoebe> instead. 👍

=head2 Configuration

This section describes some hooks you can use to customize your wiki using the
F<config> file, or using a Perl file (ending in F<*.pl> or F<*.pm>) in the
F<conf.d> directory. Once you're happy with the changes you've made, reload the
server to make it read the config file. You can do that by sending it the HUP
signal, if you know the pid, or if you have a pid file:

    kill -s SIGHUP `cat phoebe.pid`

Here are the ways you can hook into Phoebe code:

C<@extensions> is a list of code references allowing you to handle additional
URLs; return 1 if you handle a URL; each code reference gets called with $stream
(L<Mojo::IOLoop::Stream>), the first line of the request (a Gemini URL, a Gopher
selector, a finger user, a HTTP request line), a hash reference for the headers
(in the case of HTTP requests), and a buffer of bytes (e.g. for Titan or HTTP
PUT or POST requests)

C<@main_menu> adds more lines to the main menu, possibly links that aren't
simply links to existing pages

C<@footer> is a list of code references allowing you to add things like licenses
or contact information to every page; each code reference gets called with
$stream (L<Mojo::IOLoop::Stream>), $host, $space, $id, $revision, and $format
('gemini' or 'html') used to serve the page; return a gemtext string to append
at the end; the alternative is to overwrite the C<footer> or C<html_footer> subs
– the default implementation for Gemini adds History, Raw text and HTML link,
and C<@footer> to the bottom of every page; the default implementation for HTTP
just adds C<@footer> to the bottom of every page

If you do hook into Phoebe's code, you probably want to make use of the
following variables:

C<$server> stores the command line options provided by the user.

C<$log> is how you log things.

A very simple example to add a contact mail at the bottom of every page; this
works for both Gemini and the web:

    package App::Phoebe;
    use Modern::Perl;
    our (@footer);
    push(@footer, sub { '=> mailto:alex@alexschroeder.ch Mail' });

This prints a very simply footer instead of the usual footer for Gemini, as the
C<footer> function is redefined. At the same time, the C<@footer> array is still
used for the web:

    package App::Phoebe;
    use Modern::Perl;
    our (@footer); # HTML only
    push(@footer, sub { '=> https://alexschroeder.ch/wiki/Contact Contact' });
    # footer sub is Gemini only
    no warnings qw(redefine);
    sub footer {
      return '—' x 10 . "\n" . '=> mailto:alex@alexschroeder.ch Mail';
    }

This example also shows how to redefine existing code in your config file
without the warning "Subroutine … redefined".

Here's a more elaborate example to add a new action the main menu and a handler
for it:

    package App::Phoebe;
    use Modern::Perl;
    our (@extensions, @main_menu);
    push(@main_menu, "=> gemini://localhost/do/test Test");
    push(@extensions, \&serve_test);
    sub serve_test {
      my $stream = shift;
      my $url = shift;
      my $headers = shift;
      my $host = host_regex();
      my $port = port($stream);
      if ($url =~ m!^gemini://($host)(?::$port)?/do/test$!) {
	$stream->write("20 text/plain\r\n");
	$stream->write("Test\n");
	return 1;
      }
      return;
    }
    1;

=head2 Wiki Spaces

Wiki spaces are separate wikis managed by the same Phoebe server, on the
same machine, but with data stored in a different directory. If you used
C<--wiki_space=alex> and C<--wiki_space=berta>, for example, then you'd have
three wikis in total:

=over

=item C<gemini://localhost/> is the main space that continues to be available

=item C<gemini://localhost/alex/> is the wiki space for Alex

=item C<gemini://localhost/berta/> is the wiki space for Berta

=back

Note that all three spaces are still editable by anybody who knows any of the
L<tokens|/Security>.

=head2 Tokens per Wiki Space

Per default, there is simply one set of tokens which allows the editing of the
wiki, and all the wiki spaces you defined. If you want to give users a token
just for their space, you can do that, too. Doing this is starting to strain the
command line interface, however, and therefore the following illustrates how to
do more advanced configuration using the config file:

    package App::Phoebe;
    use Modern::Perl;
    our ($server);
    $server->{wiki_space_token}->{alex} = ["*secret*"];

The code above sets up the C<wiki_space_token> property. It's a hash reference
where keys are existing wiki spaces and values are array references listing the
valid tokens for that space (in addition to the global tokens that you can set
up using C<--wiki_token> which defaults to the token "hello"). Thus, the above
code sets up the token C<*secret*> for the C<alex> wiki space.

You can use the config file to change the values of other properties as well,
even if these properties are set via the command line.

    package App::Phoebe;
    use Modern::Perl;
    our ($server);
    $server->{wiki_token} = [];

This code simply deactivates the token list. No more tokens!

=head2 Client Certificates

Phoebe serves a public wiki by default. Limiting editing to known users (that
is, known client certificates) is possible. Here's a config file using client
certificates to limit writing to a single, known fingerprint:

    package App::Phoebe;
    use Modern::Perl;
    our ($server, @extensions, $log);
    my @fingerprints = ('sha256$e4b871adf0d74d9ab61fbf0b6773d75a152594090916834278d416a769712570');
    push(@extensions, \&protected_wiki);
    sub protected_wiki {
      my $stream = shift;
      my $url = shift;
      my $hosts = host_regex();
      my $port = port($stream);
      my $spaces = space_regex($stream);
      my $fingerprint = $server->{client}->get_fingerprint();
      if (my ($host, $path) = $url =~ m!^titan://($hosts)(?::$port)?([^?#]*)!) {
	my ($space, $resource) = $path =~ m!^(?:/($spaces))?(?:/raw)?/([^/;=&]+(?:;\w+=[^;=&]+)+)!;
	if (not $resource) {
	  $log->debug("The Titan URL is malformed: $path $spaces");
	  $stream->write("59 The Titan URL is malformed\r\n");
	} elsif ($fingerprint and grep { $_ eq $fingerprint} @fingerprints) {
	  $log->info("Successfully identified client certificate");
	  my ($id, @params) = split(/[;=&]/, $resource);
	  save_page($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)),
			    {map {decode_utf8(uri_unescape($_))} @params});
	} elsif ($fingerprint) {
	  $log->info("Unknown client certificate $fingerprint");
	  $stream->write("61 Your client certificate is not authorized for editing\r\n");
	} else {
	  $log->info("Requested client certificate");
	  $stream->write("60 You need a client certificate to edit this wiki\r\n");
	}
	return 1;
      }
      return;
    }
    1;

C<@fingerprints> is a list, so you could add more fingerprints:

    my @fingerprints = qw(
      sha256$e4b871adf0d74d9ab61fbf0b6773d75a152594090916834278d416a769712570
      sha256$4a948f5a11f4a81d0a2e8b60b1e4b3c9d1e25f4d95694965d98b333a443a3b25);

Or you could read them from a file:

    use File::Slurper qw(read_lines);
    my @fingerprints = read_lines("fingerprints");

The important part is that this code matches the same Titan requests as the
default code, and it comes first. Thus, the old code can no longer be reached
and this code checks for a known client certificate fingerprint.

To be sure, it doesn't check anything else! It doesn't check whether the client
certificate has expired, for example.

You could, for example, install Phoebe, use the code above for your config
file, and replace the fingerprint with the fingerprint of your own client
certificate. The F<Makefile> allows you to easily create such a certificate:

    make client-cert

Answer at least one of the questions OpenSSL asks of you and you should now have
a F<client-cert.pem> and a F<client-key.pem> file. To get the fingerprint of
your client certificate:

    make client-fingerprint

The output is the fingerprint you need to put into your config file.

=head2 Virtual Hosting

Sometimes you want have a machine reachable under different domain names and you
want each domain name to have their own wiki space, automatically. You can do
this by using multiple C<--host> options.

Here's a simple, stand-alone setup that will work on your local machine. These
are usually reachable using the IPv4 C<127.0.0.1> or the name C<localhost>. The
following command tells Phoebe to serve both C<127.0.0.1> and C<localhost>
(the default is to just serve C<localhost>).

    perl phoebe --host=127.0.0.1 --host=localhost

Visit both at L<gemini://localhost/> and L<gemini://127.0.0.1/>, and create a
new page in each one, then examine the data directory F<wiki>. You'll see both
F<wiki/localhost> and F<wiki/127.0.0.1>.

If you're using more wiki spaces, you need to prefix them with the respective
hostname if you use more than one:

    perl phoebe --host=127.0.0.1 --host=localhost \
        --wiki_space=127.0.0.1/alex --wiki_space=localhost/berta

In this situation, you can visit L<gemini://127.0.0.1/>,
L<gemini://127.0.0.1/alex/>, L<gemini://localhost/>, and
L<gemini://localhost/berta/>, and they will all be different.

If this is confusing, remember that not using virtual hosting and not using
spaces is fine, too. 😀

=head2 Multiple Certificates

If you're using virtual hosting as discussed above, you have two options: you
can use one certificate for all your hostnames, or you can use different
certificates for the hosts. If you want to use just one certificate for all your
hosts, you don't need to do anything else. If you want to use different
certificates for different hosts, you have to specify them all on the command
line. Generally speaking, use C<--host> to specifiy one or more hosts, followed
by both C<--cert_file> and C<--key_file> to specifiy the certificate and key to
use for the hosts.

For example:

    perl phoebe --host=transjovian.org \
        --cert_file=/var/lib/dehydrated/certs/transjovian.org/cert.pem \
        --key_file=/var/lib/dehydrated/certs/transjovian.org/privkey.pem \
        --host=alexschroeder.ch \
        --cert_file=/var/lib/dehydrated/certs/alexschroeder.ch/cert.pem \
        --key_file=/var/lib/dehydrated/certs/alexschroeder.ch/privkey.pem

=head2 CSS for the Web

The wiki can also answer web requests. By default, it only does that on port
1965. The web pages refer to a CSS file at C</default.css>, and the response to
a request for this CSS is served by a function that you can override in your
config file. The following would be the beginning of a CSS that supports a dark
theme, for example. The Cache-Control header makes sure browsers don't keep
trying to revalidate the CSS more than once a day.
L<https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Cache-Control>

    our ($log);

    sub serve_css_via_http {
      my $stream = shift;
      $log->info("Serving CSS via HTTP");
      $stream->write("HTTP/1.1 200 OK\r\n");
      $stream->write("Content-Type: text/css\r\n");
      $stream->write("Cache-Control: public, max-age=86400, immutable\r\n"); # 24h
      $stream->write("\r\n");
      $stream->write(<<'EOT');
    html { max-width: 70ch; padding: 2ch; margin: auto; }
    body { color: #111111; background-color: #fffff8; }
    a:link { color: #0000ee }
    a:visited { color: #551a8b }
    a:hover { color: #7a67ee }
    @media (prefers-color-scheme: dark) {
       body { color: #eeeee8; background-color: #333333; }
       a:link { color: #1e90ff }
       a:hover { color: #63b8ff }
       a:visited { color: #7a67ee }
    }
    EOT
    }

=head2 Favicon for the Web

Here's an example where we a little Jupiter SVG is being served for the favicon,
for all hosts. You could, of course, accept the C<$headers> as an additional
argument to C<favicon>, match hostnames, pass the C<$host> to
C<serve_favicon_via_http>, and return different images depending on the host.
Let me know if you need this and you are stuck.

    our (@extensions, $log);

    push(@extensions, \&favicon);

    sub favicon {
      my $stream = shift;
      my $url = shift;
      if ($url =~ m!^GET /favicon.ico HTTP/1\.[01]$!) {
	serve_favicon_via_http($stream);
	return 1;
      }
      return 0;
    }

    sub serve_favicon_via_http {
      my $stream = shift;
      $log->info("Serving favicon via HTTP");
      $stream->write("HTTP/1.1 200 OK\r\n");
      $stream->write("Content-Type: image/svg+xml\r\n");
      $stream->write("Cache-Control: public, max-age=86400, immutable\r\n"); # 24h
      $stream->write("\r\n");
      $stream->write(<<'EOT');
    <?xml version="1.0" encoding="UTF-8" standalone="no"?>
    <svg xmlns="http://www.w3.org/2000/svg" width="100" height="100">
    <circle cx="50" cy="50" r="45" fill="white" stroke="black" stroke-width="5"/>
    <line x1="12" y1="25" x2="88" y2="25" stroke="black" stroke-width="4"/>
    <line x1="5" y1="45" x2="95" y2="45" stroke="black" stroke-width="7"/>
    <line x1="5" y1="60" x2="95" y2="60" stroke="black" stroke-width="4"/>
    <path d="M20,73 C30,65 40,63 60,70 C70,72 80,73 90,72
	     L90,74 C80,75 70,74 60,76 C40,83 30,81 20,73" fill="black"/>
    <ellipse cx="40" cy="73" rx="11.5" ry="4.5" fill="red"/>
    <line x1="22" y1="85" x2="78" y2="85" stroke="black" stroke-width="3"/>
    </svg>
    EOT
    }

=head1 SEE ALSO

As you might have guessed, the system is easy to tinker with, if you know some
Perl. The Transjovian Council has a wiki space dedicated to Phoebe, and it
includes a section with more configuration examples, including simple comments
(append-only via Gemini), complex comments (editing via Titan or the web),
wholesale page editing via the web, user-agent blocking, and so on.
L<gemini://transjovian.org/> L<https://transjovian.org:1965/>

=head1 LICENSE

GNU Affero General Public License

=cut

package App::Phoebe;
use File::Slurper qw(read_text read_binary read_lines read_dir write_text write_binary);
use Encode qw(encode_utf8 decode_utf8 decode);
use Net::IDN::Encode qw(domain_to_ascii);
use Socket qw(:addrinfo SOCK_RAW);
use List::Util qw(first min any);
use Modern::Perl '2018';
use File::ReadBackwards;
use IO::Socket::SSL;
use Algorithm::Diff;
use Encode::Locale;
use Mojo::IOLoop;
use Getopt::Long;
use URI::Escape;
use Pod::Text;
use Mojo::Log;
use utf8;
use B;

# Phoebe variables you can set in the config file
our (@extensions, @main_menu, @footer);
our $log ||= Mojo::Log->new(level => 'warn');
our $server = {host => {}};

# Some of these need to be decoded (hostnames, pagenames).
GetOptions(
  $server,
  'help' => \&help,
  'log_level=s' => sub { $log->level($_[1]), },
  'log_file=s' => sub { $log->path($_[1]) },
  'cert_file=s' => \&host_setup,
  'key_file=s' => \&host_setup,
  'host=s' => \&host_setup,
  'port=i@', # same ports for all hosts!
  'wiki_dir=s',
  'wiki_space=s@' => \&utf8_list_item,
  'wiki_token=s@' => \&utf8_list_item,
  'wiki_page=s@' => \&utf8_list_item,
  'wiki_main_page=s' => \&utf8_item,
  'wiki_mime_type=s@',
  'wiki_page_size_limit=i')
    or die("Error in command line arguments\n");

sub utf8_list_item { my ($key, $value) = @_; push(@{$server->{$key}}, decode(locale => $value)) };
sub utf8_item { my ($key, $value) = @_; $server->{$key} = decode(locale => $value) };

{
  # use a block so that these variables stay local
  my ($cert_file, $key_file, @host);

  sub host_setup {
    my ($opt, $val) = @_;
    if ($opt eq 'host') {
      push @host, decode(locale => $val);
      return;
    };
    die "$val does not exist\n" unless -f $val;
    if ($opt eq 'cert_file') { $cert_file = $val }
    elsif ($opt eq 'key_file') { $key_file = $val }
    if ($cert_file and $key_file) {
      if (not @host) {
	$server->{host}->{'localhost'} = 1;
	$server->{cert_file}->{'localhost'} = $cert_file;
	$server->{key_file}->{'localhost'} = $key_file;
      }
      for (@host) {
	$server->{host}->{$_} = 1;
	$server->{cert_file}->{$_} = $cert_file;
	$server->{key_file}->{$_} = $key_file;
      }
      $cert_file = $key_file = undef;
      @host = ();
    }
  }

  # if, at the end, there is a left-over
  if ($cert_file or $key_file) {
    die "I must have both --key_file and --cert_file\n";
  }

  # let's see if we need to generate certificates
  my $default_certs = 0;

  # if, at the end, we have some hosts but no certs and keys
  for (@host) {
    $default_certs = 1;
    $server->{host}->{$_} = 1;
    $server->{cert_file}->{$_} = 'cert.pem';
    $server->{key_file}->{$_} = 'key.pem';
  }

  # if, at the end, we had no hosts at all, the default still needs cert and key
  if (not keys %{$server->{host}}) {
    $default_certs = 1;
    $server->{host}->{localhost} = 1;
    $server->{cert_file}->{localhost} = 'cert.pem';
    $server->{key_file}->{localhost} = 'key.pem';
  }

  # if the certs don't exist, generate them
  if ($default_certs
      and (not -f 'cert.pem'
	   or not -f 'key.pem')) {
    generate_certificates();
  }
}

sub generate_certificates {
  say "The default certificate (and key) files are missing.";
  say "Do you want to create them right now?";
  say "The certificate uses eliptic curves and is valid for five years.";
  say "If so, please provide your hostname (e.g. localhost).";
  say "If not, just press Enter.";
  local $SIG{'ALRM'} = sub {
    die "Timed out!\n";
  };
  alarm(30); # timeout for the following prompt
  my $hostname = <STDIN>;
  alarm(0);  # done, no more alarm
  chomp $hostname;
  die "The hostname may not contain any whitespace\n" if $hostname =~ /\s/;
  my $cmd = qq(openssl req -new -x509 -newkey ec -subj "/CN=$hostname" )
      . qq(-pkeyopt ec_paramgen_curve:prime256v1 -days 1825 -nodes -out cert.pem -keyout key.pem);
  if ($hostname) {
    say $cmd;
    system($cmd) == 0
      or die "openssl failed: $?";
  }
}

sub help {
  my $parser = Pod::Text->new();
  $parser->parse_file($0);
  exit;
}

sub verify_fingerprint {
  my ($ok, $ctx_store, $certname, $error, $cert, $depth) = @_;
  return 1;
}

# defaults
$server->{port} ||= [1965];
$server->{wiki_token} ||= ['hello'];
$server->{wiki_space} ||= [];
$server->{wiki_mime_type} ||= [];
$server->{wiki_dir} ||= $ENV{PHOEBE_DATA_DIR} || './wiki';
$server->{wiki_page} ||= [];
$server->{wiki_main_page} ||= '';
$server->{wiki_page_size_limit} ||= 100000;

our $protocols = 'https?|ftp|afs|news|nntp|mid|cid|mailto|wais|prospero|telnet|gophers?|irc|feed|gemini|xmpp';
our $chars = '[-a-zA-Z0-9/@=+$_~*.,;:?!\'"()&#%]'; # see RFC 2396
our $full_url_regex = "((?:$protocols):$chars+)";

# Conventions:
# - a regular exression on the first line of the request
# - a handle_foo sub to do wait until you're ready (take $stream and $data,
#   where $data->{buffer} keeps growing with bytes)
# - a process_foo sub to finish the job and write stuff back to the $stream

our @request_handlers = (
  '^titan://' => \&handle_titan,
  '^gemini://' => \&handle_gemini,
  '^GET .* HTTP/1\.[01]$' => \&handle_http_header,
  '^[^:/?#]+://([^/?#]*)([^?#]*)(?:\?([^#]*))?(?:#(.*))?$' => \&handle_url,
);

configure();

# Reconfigure if we get SIGHUP (via kill -s SIGHUP $pid, for example)
$SIG{HUP} = sub { Mojo::IOLoop->next_tick(\&configure) };

# Figure out what IP numbers we need to listen to because we need to start
# servers for both IPv4 and IPv6…
for my $host (keys %{$server->{host}}) {
  for my $address (get_ip_numbers($host)) {
    $server->{address}->{$address} = $host;
    for my $port (@{$server->{port}}) {
      $log->info("$host: listening on $address:$port");
      Mojo::IOLoop->server({
	address => $address,
	port => $port,
	tls => 1,
	tls_cert => $server->{cert_file},
	tls_key  => $server->{key_file},
	tls_options => {
	  # request client certificates and accept them
	  SSL_verify_mode => SSL_VERIFY_PEER,
	  SSL_verify_callback => \&verify_fingerprint,
	  SSL_create_ctx_callback => sub {
	    my $ctx = shift;
	    Net::SSLeay::CTX_sess_set_cache_size($ctx, 64);
	  }
	}
      } => sub {
	my ($loop, $stream) = @_;
	my $data = { buffer => '', handler => \&handle_request };
	$stream->on(read => sub {
	  my ($stream, $bytes) = @_;
	  $log->debug("Received " . length($bytes) . " bytes");
	  $data->{buffer} .= $bytes;
	  $data->{handler}->($stream, $data) }) });
    }
  }
}

# Start event loop if necessary
Mojo::IOLoop->start unless Mojo::IOLoop->is_running;

sub configure {
  # config file with extra code; restart server if you change it
  my $dir = $server->{wiki_dir};
  my @config;
  push(@config, map { "$dir/conf.d/$_" } grep(/\.p[lm]$/, read_dir("$dir/conf.d"))) if -d "$dir/conf.d";
  # allow override of config files in conf.d
  push(@config, "$dir/config") if -f "$dir/config";
  for my $config (@config) {
    $log->info("Running $config");
    do $config if -r $config;
    $log->error("$@") if $@;
  }
  # summarize config results
  $log->info("PID: $$");
  $log->info("Host: " . join(" ", keys %{$server->{host}}));
  $log->info("Port: @{$server->{port}}");
    $log->info("Space: @{$server->{wiki_space}}");
  if (keys %{$server->{host}} > 1) {
    my $hosts = host_regex();
    for (grep(!/^$hosts\//, @{$server->{wiki_space}})) {
      $log->warn("Space $_ is not prefixed with a known host");
    }
  } else {
    for (grep(/\//, @{$server->{wiki_space}})) {
      $log->warn("Space $_ is prefixed with a host but we serve just one");
    }
  }
  $log->info("Token: @{$server->{wiki_token}}");
  $log->info("Main page: $server->{wiki_main_page}");
  $log->info("Pages: @{$server->{wiki_page}}");
  $log->info("MIME types: @{$server->{wiki_mime_type}}");
  $log->info("Wiki data directory: $server->{wiki_dir}");
}

sub get_ip_numbers {
  my $hostname = shift;
  my $punycode = domain_to_ascii($hostname);
  my @addresses;
  my ($err, @res) = getaddrinfo($punycode, "", {socktype => SOCK_RAW});
  $log->error("Cannot determine the IP number of $punycode: $err") if $err;
  for my $ai (@res) {
    my ($err, $ipaddr) = getnameinfo($ai->{addr}, NI_NUMERICHOST, NIx_NOSERV);
    $log->error("Cannot get a readable IP number of $punycode: $err") if $err;
    push(@addresses, $ipaddr) if $ipaddr;
  }
  return @addresses;
}

sub handle_request {
  my $stream = shift;
  my $data = shift;
  if ($data->{buffer} =~ /^(.*)\r\n/) {
    $data->{request} = $1;
    $data->{buffer} =~ s/.*\r\n//;
    $log->debug("Looking at $data->{request}");
    for (my $i = 0; $i < @request_handlers; $i += 2) {
      my $re = $request_handlers[$i];
      if ($data->{request} =~ m!$re!i) {
	$data->{handler} = $request_handlers[$i+1];
	# and call the handler
	$data->{handler}->($stream, $data);
	return;
      }
    }
    $log->debug("No handler found for $data->{request}");
    $stream->write("59 Cannot handle this request\r\n");
    $stream->close_gracefully();
  } else {
    $log->debug("Waiting for more bytes...");
  }
}

# special generic URL error handling to satisfy gemini-diagnostics
sub handle_url {
  my $stream = shift;
  my $data = shift;
  $log->debug("Unhandled proxy request");
  $log->debug("Discarding " . length($data->{buffer}) . " bytes")
      if $data->{buffer};
  $stream->write("53 No proxying for $data->{request}\r\n");
  $stream->close_gracefully();
}

sub handle_gemini {
  my $stream = shift;
  my $data = shift;
  $log->debug("Handle Gemini request");
  $log->debug("Discarding " . length($data->{buffer}) . " bytes")
      if $data->{buffer};
  process_gemini($stream, $data->{request});
}

sub handle_titan {
  my $stream = shift;
  my $data = shift;
  # extra processing of the request if we didn't do that, yet
  $data->{upload} ||= is_upload($stream, $data->{request}) or return;
  my $size = $data->{upload}->{params}->{size};
  my $actual = length($data->{buffer});
  if ($actual == $size) {
    $log->debug("Handle Titan request");
    process_titan($stream, $data->{request}, $data->{upload}, $data->{buffer}, $size);
    # do not close in case we're waiting for the lock
    return;
  } elsif ($actual > $size) {
    $log->debug("Received more than the promised $size bytes");
    $stream->write("59 Received more than the promised $size bytes\r\n");
    $stream->close_gracefully();
    return;
  }
  $log->debug("Waiting for " . ($size - $actual) . " more bytes");
}

sub handle_http_header {
  my $stream = shift;
  my $data = shift;
  $log->debug("Reading HTTP headers");
  my @lines = split(/\r\n/, $data->{buffer}, -1); # including the empty line at the end
  foreach (@lines) {
    if (/^(\S+?): (.+?)\s*$/) {
      my $key = lc($1);
      $data->{headers}->{$key} = $2;
      my $data->{header_size} += length($_);
      $log->debug("Header $key");
    } elsif ($_ eq "") {
      $data->{buffer} =~ s/^.*?\r\n\r\n//s; # possibly HTTP body
      $log->debug("Handle HTTP request");
      $data->{headers}->{host} .= ":" . port($stream) if $data->{headers}->{host} and $data->{headers}->{host} !~ /:\d+$/;
      $log->debug("HTTP headers: " . join(", ", map { "$_ => '$data->{headers}->{$_}'" } keys %{$data->{headers}}));
      my $length = $data->{headers}->{'content-length'} || 0;
      return http_error($stream, "Content length invalid") if $length !~ /^\d+$/;
      return http_error($stream, "Content too long") if $length > $server->{wiki_page_size_limit};
      my $actual = length($data->{buffer});
      return http_error($stream, "Content longer than what the header says") if $actual > $length;
      if ($length == $actual) {
	process_http($stream, $data->{request}, $data->{headers}, $data->{buffer});
	$stream->close_gracefully();
	return;
      } elsif ($length) {
	# read body
	$data->{handler} = \&handle_http_body;
	handle_http_body($stream, $data);
	return;
      }
      # otherwise wait for more header bytes
    }
    if ($data->{header_size} and $data->{header_size} > $server->{wiki_page_size_limit}) {
      $log->debug("This wiki does not allow more than $server->{wiki_page_size_limit} bytes of headers");
      $stream->write("400 Bad request: headers too long\r\n");
      $stream->close_gracefully();
      return;
    }
  }
  # if we came here, the last line didn't match and needs more bytes
  $data->{buffer} = $lines[$#lines];
  $log->debug("Waiting for more HTTP headers ('$data->{buffer}')");
  return;
}

sub handle_http_body {
  my $stream = shift;
  my $data = shift;
  $log->debug("Reading HTTP body");
  process_http($stream, $data->{request}, $data->{headers}, $data->{buffer});
  $stream->close_gracefully();
  return;
}

sub http_error {
  my $stream = shift;
  my $message = shift;
  $stream->write("HTTP/1.1 400 Bad Request\r\n");
  $stream->write("Content-Type: text/plain\r\n");
  $stream->write("\r\n");
  $stream->write("$message\n");
  $stream->close_gracefully();
  return 0;
}

sub success {
  my $stream = shift;
  my $type = shift || 'text/gemini; charset=UTF-8';
  my $lang = shift;
  if ($lang) {
    $stream->write("20 $type; lang=$lang\r\n");
  } else {
    $stream->write("20 $type\r\n");
  }
}

# We can't use C<flock> because this defaults to C<fcntl> which means they are
# I<per process>
sub with_lock {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $code = shift;
  my $count = shift || 0;
  my $dir = wiki_dir($host, $space);
  my $lock = "$dir/locked";
  # remove stale locks
  if (-e $lock) {
    my $age = time() - modified($lock);
    $log->debug("lock is ${age}s old");
    rmdir $lock if -e $lock and $age > 5;
  }
  if (mkdir($lock)) {
    $log->debug("Running code with lock $lock");
    eval { $code->() }; # protect against exceptions
    if ($@) {
      $log->error("Unable to run code with locked $lock: $@");
      $stream->write("40 An error occured, unfortunately\r\n");
    }
    rmdir($lock);
    $stream->close_gracefully();
  } elsif ($count > 25) {
    $log->error("Unable to unlock $lock");
    $stream->write("40 The wiki is locked; try again in a few seconds\r\n");
    $stream->close_gracefully();
  } else {
    $log->debug("Waiting $count...");
    Mojo::IOLoop->timer(0.2 => sub {
      with_lock($stream, $host, $space, $code, $count + 1)});
    # don't close the stream
  }
}

# The hostnames we know we want to serve because they were specified via --host
# options.
sub host_regex {
  my $stream = shift;
  return join("|", map { quotemeta domain_to_ascii $_ } keys %{$server->{host}});
}

sub port {
  my $stream = shift;
  return $stream->handle->sockport; # the actual port
}

# if you call this yourself, $id must look like "page/foo"
sub to_url {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $id = shift;
  my $scheme = shift || "gemini";
  my $port = port($stream);
  if ($space) {
    $space = "" if $space eq $host;
    $space =~ s/.*\///;
    $space = uri_escape_utf8($space);
  }
  # don't encode the slash
  return "$scheme://$host:$port/"
      . ($space ? "$space/" : "")
      . join("/", map { uri_escape_utf8($_) } split (/\//, $id));
}

sub link_html {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $title = shift;
  my $id = shift;
  if (not $id) {
    $id = "page/$title";
  }
  my $port = port($stream);
  # don't encode the slash
  return "<a href=\"https://$host:$port/"
      . ($space && $space ne $host ? uri_escape_utf8($space) . "/" : "")
      . join("/", map { uri_escape_utf8($_) } split (/\//, $id))
      . "\">"
      . quote_html($title)
      . "</a>";
}

sub gemini_link {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $title = shift;
  my $id = shift;
  if (not $id) {
    $id = "page/$title";
  }
  return "=> $id $title" if $id =~ /^$full_url_regex$/;
  my $url = to_url($stream, $host, $space, $id);
  return "=> $url $title";
}

sub print_link {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $title = shift;
  my $id = shift;
  $stream->write(encode_utf8 gemini_link($stream, $host, $space, $title, $id) . "\n");
}

sub pages {
  my $host = shift;
  my $space = shift;
  my $re = shift;
  my $dir = wiki_dir($host, $space);
  my $index = "$dir/index";
  if (not -f $index) {
    return if not -d "$dir/page";
    my @pages = map { s/\.gmi$//; $_ } read_dir("$dir/page");
    write_text($index, join("\n", @pages, ""));
    return @pages;
  }
  return grep /$re/i, read_lines $index if $re;
  return read_lines $index;
}

sub blog_pages {
  my $host = shift;
  my $space = shift;
  return sort { $b cmp $a } pages($host, $space, '^\d\d\d\d-\d\d-\d\d');
}

sub blog {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $n = shift || 10;
  my @blog = blog_pages($host, $space);
  return unless @blog;
  $stream->write("Blog:\n");
  # we should check for pages marked for deletion!
  for my $id (@blog[0 .. min($#blog, $n - 1)]) {
    print_link($stream, $host, $space, $id);
  }
  print_link($stream, $host, $space, "More...", "do/more/" . ($n * 10)) if @blog > $n;
  print_link($stream, $host, $space, "Atom Feed", "do/blog/atom") if $n == 10;
  print_link($stream, $host, $space, "RSS Feed", "do/blog/rss") if $n == 10;
  $stream->write("\n");
}

sub blog_html {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $n = shift || 10;
  my @blog = blog_pages($host, $space);
  return unless @blog;
  $stream->write("<p>Blog:\n");
  $stream->write("<ul>\n");
  # we should check for pages marked for deletion!
  for my $id (@blog[0 .. min($#blog, $n - 1)]) {
    $stream->write(encode_utf8 "<li>" . link_html($stream, $host, $space, $id) . "\n");
  }
  $stream->write("</ul>\n");
}

sub serve_main_menu {
  my $stream = shift;
  my $host = shift||"";
  my $space = shift||"";
  $log->info("Serving main menu");
  success($stream);
  my $page = $server->{wiki_main_page};
  if ($page) {
    $stream->write(encode_utf8 text($host, $space, $page) . "\n");
  } else {
    $stream->write("# Welcome to Phoebe!\n");
    $stream->write("\n");
  }
  blog($stream, $host, $space, 10);
  for my $id (@{$server->{wiki_page}}) {
    print_link($stream, $host, $space, $id);
  }
  for my $line (@main_menu) {
    $stream->write(encode_utf8 $line . "\n");
  }
  print_link($stream, $host, $space, "Changes", "do/changes");
  print_link($stream, $host, $space, "Search matching page names", "do/match");
  print_link($stream, $host, $space, "Search matching page content", "do/search");
  print_link($stream, $host, $space, "New page", "do/new");
  $stream->write("\n");
  print_link($stream, $host, $space, "Index of all pages", "do/index");
  print_link($stream, $host, $space, "Index of all files", "do/files");
  print_link($stream, $host, undef, "Index of all spaces", "do/spaces")
      if @{$server->{wiki_space}} or keys %{$server->{host}} > 1;
  print_link($stream, $host, $space, "Download data", "do/data");
  # a requirement of the GNU Affero General Public License
  print_link($stream, $host, undef, "Source code", "do/source");
  $stream->write("\n");
}

sub serve_main_menu_via_http {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  $log->info("Serving main menu via HTTP");
  my $page = $server->{wiki_main_page};
  $stream->write("HTTP/1.1 200 OK\r\n");
  $stream->write("Content-Type: text/html\r\n");
  $stream->write("\r\n");
  $stream->write("<!DOCTYPE html>\n");
  $stream->write("<html>\n");
  $stream->write("<head>\n");
  $stream->write("<meta charset=\"utf-8\">\n");
  if ($page) {
    $stream->write(encode_utf8 "<title>" . quote_html($page) . "</title>\n");
  } else {
    $stream->write("<title>Phoebe</title>\n");
  }
  $stream->write("<link type=\"text/css\" rel=\"stylesheet\" href=\"/default.css\"/>\n");
  $stream->write("<meta name=\"viewport\" content=\"width=device-width, initial-scale=1\">\n");
  $stream->write("</head>\n");
  $stream->write("<body>\n");
  if ($page) {
    $stream->write(encode_utf8 to_html(text($host, $space, $page)) . "\n");
  } else {
    $stream->write("<h1>Welcome to Phoebe!</h1>\n");
  }
  blog_html($stream, $host, $space);
  $stream->write("<p>Important links:\n");
  $stream->write("<ul>\n");
  my @pages = @{$server->{wiki_page}};
  for my $id (@pages) {
    $stream->write(encode_utf8 "<li>" . link_html($stream, $host, $space, $id) . "\n");
  }
  $stream->write(encode_utf8 "<li>" . link_html($stream, $host, $space, "Changes", "do/changes") . "\n");
  $stream->write(encode_utf8 "<li>" . link_html($stream, $host, $space, "Index of all pages", "do/index") . "\n");
  $stream->write(encode_utf8 "<li>" . link_html($stream, $host, $space, "Index of all files", "do/files") . "\n")
      if @{$server->{wiki_mime_type}};
  $stream->write(encode_utf8 "<li>" . link_html($stream, $host, undef, "Index of all spaces", "do/spaces") . "\n")
      if @{$server->{wiki_space}} or keys %{$server->{host}} > 1;
  # a requirement of the GNU Affero General Public License
  $stream->write(encode_utf8 "<li>" . link_html($stream, $host, undef, "Source", "do/source") . "\n");
  $stream->write("</ul>\n");
  $stream->write("</body>\n");
  $stream->write("</html>\n");
}

sub serve_css_via_http {
  my $stream = shift;
  $log->info("Serving CSS via HTTP");
  $stream->write("HTTP/1.1 200 OK\r\n");
  $stream->write("Content-Type: text/css\r\n");
  $stream->write("Cache-Control: public, max-age=86400, immutable\r\n"); # 24h
  $stream->write("\r\n");
  $stream->write("html { max-width: 70ch; padding: 2ch; margin: auto; color: #111; background: #ffe; }\n");
}

sub quote_html {
  my $html = shift;
  $html =~ s/&/&amp;/g;
  $html =~ s/</&lt;/g;
  $html =~ s/>/&gt;/g;
  $html =~ s/[\x00-\x08\x0b\x0c\x0e-\x1f]/ /g; # legal xml: #x9 | #xA | #xD | [#x20-#xD7FF] | [#xE000-#xFFFD] | [#x10000-#x10FFFF]
  return $html;
}

sub serve_blog {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $n = shift;
  success($stream);
  $log->info("Serving blog");
  $stream->write("# Blog\n");
  my @blog = blog_pages($host, $space);
  if (not @blog) {
    $stream->write("There are no blog pages.\n");
    return;
  }
  $stream->write("Serving up to $n entries.\n");
  for my $id (@blog[0 .. min($#blog, $n - 1)]) {
    print_link($stream, $host, $space, $id);
  }
  print_link($stream, $host, $space, "More...", "do/more/" . ($n * 10)) if @blog > $n;
}

sub serve_index {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  success($stream);
  $log->info("Serving index of all pages");
  $stream->write("# All Pages\n");
  my @pages = pages($host, $space);
  $stream->write("There are no pages.\n") unless @pages;
  for my $id (sort { newest_first($stream, $a, $b) } @pages) {
    print_link($stream, $host, $space, $id);
  }
}

sub serve_index_via_http {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  $log->info("Serving index of all pages via HTTP");
  $stream->write("HTTP/1.1 200 OK\r\n");
  $stream->write("Content-Type: text/html\r\n");
  $stream->write("\r\n");
  $stream->write("<!DOCTYPE html>\n");
  $stream->write("<html>\n");
  $stream->write("<head>\n");
  $stream->write("<meta charset=\"utf-8\">\n");
  $stream->write("<title>All Pages</title>\n");
  $stream->write("<link type=\"text/css\" rel=\"stylesheet\" href=\"/default.css\"/>\n");
  $stream->write("<meta name=\"viewport\" content=\"width=device-width, initial-scale=1\">\n");
  $stream->write("</head>\n");
  $stream->write("<body>\n");
  $stream->write("<h1>All Pages</h1>\n");
  my @pages = pages($host, $space);
  if (@pages) {
    $stream->write("<ul>\n");
    for my $id (sort { newest_first($stream, $a, $b) } @pages) {
      $stream->write(encode_utf8 "<li>" . link_html($stream, $host, $space, $id) . "\n");
    }
    $stream->write("</ul>\n");
  } else {
    $stream->write("<p>The are no pages.\n");
  }
}

sub files {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $re = shift;
  my $dir = wiki_dir($host, $space);
  $dir = "$dir/file";
  return if not -d $dir;
  my @files = map { decode_utf8($_) } read_dir($dir);
  return grep /$re/i, @files if $re;
  return @files;
}

sub serve_files {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  success($stream);
  $log->info("Serving index of all files");
  $stream->write("# All Files\n");
  my @files = files($stream, $host, $space);
  $stream->write("The are no files.\n") unless @files;
  for my $id (sort @files) {
    print_link($stream, $host, $space, $id, "file/$id");
  }
}

sub serve_files_via_http {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  $log->info("Serving all files via HTTP");
  $stream->write("HTTP/1.1 200 OK\r\n");
  $stream->write("Content-Type: text/html\r\n");
  $stream->write("\r\n");
  $stream->write("<!DOCTYPE html>\n");
  $stream->write("<html>\n");
  $stream->write("<head>\n");
  $stream->write("<meta charset=\"utf-8\">\n");
  $stream->write("<title>All Files</title>\n");
  $stream->write("<link type=\"text/css\" rel=\"stylesheet\" href=\"/default.css\"/>\n");
  $stream->write("<meta name=\"viewport\" content=\"width=device-width, initial-scale=1\">\n");
  $stream->write("</head>\n");
  $stream->write("<body>\n");
  $stream->write("<h1>All Files</h1>\n");
  my @files = files($stream, $host, $space);
  if (@files) {
    $stream->write("<ul>\n");
    for my $id (sort @files) {
      $stream->write(encode_utf8 "<li>" . link_html($stream, $host, $space, $id, "file/$id") . "\n");
    }
    $stream->write("</ul>\n");
  } else {
    $stream->write("<p>The are no files.\n");
  }
}

sub serve_spaces {
  my $stream = shift;
  my $host = shift;
  my $port = shift;
  success($stream);
  $log->info("Serving all spaces");
  $stream->write("# Spaces\n");
  my $spaces = space_links($stream, "gemini", $host, $port);
  for my $url (sort keys %$spaces) {
    $stream->write(encode_utf8 "=> $url $spaces->{$url}\n");
  }
}

sub serve_spaces_via_http {
  my $stream = shift;
  my $host = shift;
  my $port = shift;
  $log->info("Serving all spaces via HTTP");
  $stream->write("HTTP/1.1 200 OK\r\n");
  $stream->write("Content-Type: text/html\r\n");
  $stream->write("\r\n");
  $stream->write("<!DOCTYPE html>\n");
  $stream->write("<html>\n");
  $stream->write("<head>\n");
  $stream->write("<meta charset=\"utf-8\">\n");
  $stream->write("<title>All Spaces</title>\n");
  $stream->write("<link type=\"text/css\" rel=\"stylesheet\" href=\"/default.css\"/>\n");
  $stream->write("<meta name=\"viewport\" content=\"width=device-width, initial-scale=1\">\n");
  $stream->write("</head>\n");
  $stream->write("<body>\n");
  $stream->write("<h1>All Spaces</h1>\n");
  $stream->write("<ul>\n");
  my $spaces = space_links($stream, "https", $host, $port);
  for my $url (sort keys %$spaces) {
    $stream->write(encode_utf8 "<li><a href=\"$url\">$spaces->{$url}</a>\n");
  }
  $stream->write("</ul>\n");
}

sub serve_data {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  # use /bin/tar instead of Archive::Tar to save memory
  my $dir = wiki_dir($host, $space);
  my $file = "$dir/data.tar.gz";
  if (-e $file and time() - modified($file) <= 300) { # data is valid for 5 minutes
    $log->info("Serving cached data archive");
    success($stream, "application/tar");
    $stream->write(read_binary($file));
  } else {
    write_binary($file, ""); # truncate in order to avoid "file changed as we read it" warning
    my @command = ('/bin/tar', '--create', '--gzip',
		   '--file', $file,
		   '--exclude', $file,
		   '--directory', "$dir/..",
		   ((split(/\//,$dir))[-1]));
    $log->debug("@command");
    if (system(@command) == 0) {
      $log->info("Serving new data archive");
      success($stream, "application/tar");
      $stream->write(read_binary($file));
    } else {
      $log->error("Creation of data archive failed");
      $stream->write("59 Archive creation failed\r\n");
    }
  }
}

sub serve_match {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $match = shift;
  if (not $match) {
    $stream->write("59 Search term is missing\r\n");
    return;
  }
  success($stream);
  $log->info("Serving pages matching $match");
  $stream->write(encode_utf8 "# Search page titles for $match\n");
  $stream->write("Use a Perl regular expression to match page titles.\n");
  my @pages = pages($host, $space, $match);
  $stream->write("No matching page names found.\n") unless @pages;
  for my $id (sort { newest_first($stream, $a, $b) } @pages) {
    print_link($stream, $host, $space, $id);
  }
}

sub serve_search {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $str = shift;
  if (not $str) {
    $stream->write("59 Search term is missing\r\n");
    return;
  }
  success($stream);
  $log->info("Serving search result for $str");
  $stream->write(encode_utf8 "# Search page content for $str\n");
  $stream->write("Use a Perl regular expression to match page titles and page content.\n");
  if (not search($stream, $host, $space, $str, sub { highlight($stream, @_) })) {
    $stream->write("Search term not found.\n");
  }
}

sub search {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $str = shift;
  my $func = shift;
  my @pages = sort { newest_first($stream, $a, $b) } pages($host, $space);
  return unless @pages;
  my $found = 0;
  for my $id (@pages) {
    my $text = text($host, $space, $id);
    if ($id =~ /$str/ or $text =~ /$str/) {
      $func->($host, $space, $id, $text, $str);
      $found++;
    }
  }
  return $found;
}

sub highlight {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $id = shift;
  my $text = shift;
  my $str = shift;
  my ($snippetlen, $maxsnippets) = (100, 4); #  these seem nice.
  # show a snippet from the beginning of the document
  my $j = index($text, ' ', $snippetlen); # end on word boundary
  my $t = substr($text, 0, $j);
  my $result = "## $id\n$t … ";
  $text = substr($text, $j);  # to avoid rematching
  my $jsnippet = 0 ;
  while ($jsnippet < $maxsnippets and $text =~ m/($str)/i) {
    $jsnippet++;
    if (($j = index($text, $1)) > -1 ) {
      # get substr containing (start of) match, ending on word boundaries
      my $start = index($text, ' ', $j - $snippetlen / 2);
      $start = 0 if $start == -1;
      my $end = index($text, ' ', $j + $snippetlen / 2);
      $end = length($text) if $end == -1;
      $t = substr($text, $start, $end - $start);
      $result .= $t . ' … ';
      # truncate text to avoid rematching the same string.
      $text = substr($text, $end);
    }
  }
  $stream->write(encode_utf8 $result . "\n");
  print_link($stream, $host, $space, $id);
}

sub serve_changes {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $n = shift;
  my $style = shift;
  $log->info("Serving $n changes");
  success($stream);
  $stream->write("# Changes\n");
  if (not $style) { print_link($stream, $host, $space, "Colour changes", "do/changes/$n/colour") }
  elsif ($style eq "colour") { print_link($stream, $host, $space, "Fancy changes", "do/changes/$n/fancy") }
  elsif ($style eq "fancy") { print_link($stream, $host, $space, "Normal changes", "do/changes/$n") }
  print_link($stream, $host, undef, "Changes for all spaces", "do/all/changes")
      if @{$server->{wiki_space}};
  print_link($stream, $host, $space, "Atom Feed", "do/atom");
  print_link($stream, $host, $space, "RSS Feed", "do/rss");
  my $dir = wiki_dir($host, $space);
  my $log = "$dir/changes.log";
  if (not -e $log) {
    $stream->write("No changes.\n");
    return;
  }
  $stream->write("Showing up to $n changes.\n");
  my $fh = File::ReadBackwards->new($log);
  return unless changes($stream,
    $n,
    sub { $stream->write(encode_utf8 "## " . shift . "\n") },
    sub { $stream->write(shift . " by " . colourize($stream, shift, $style) . "\n") },
    sub { print_link($stream, @_) },
    sub { $stream->write(encode_utf8 join("\n", @_, "")) },
    sub {
      return unless $_ = decode_utf8($fh->readline);
      chomp;
      split(/\x1f/), $host, $space, 0 });
  $stream->write("\n");
  print_link($stream, $host, $space, "More...", "do/changes/" . 10 * $n . ($style ? "/$style" : ""));
}

sub serve_changes_via_http {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $n = shift;
  $log->info("Serving $n changes via HTTP");
  $stream->write("HTTP/1.1 200 OK\r\n");
  $stream->write("Content-Type: text/html\r\n");
  $stream->write("\r\n");
  $stream->write("<!DOCTYPE html>\n");
  $stream->write("<html>\n");
  $stream->write("<head>\n");
  $stream->write("<meta charset=\"utf-8\">\n");
  $stream->write("<title>Changes</title>\n");
  $stream->write("<link type=\"text/css\" rel=\"stylesheet\" href=\"/default.css\"/>\n");
  $stream->write("<meta name=\"viewport\" content=\"width=device-width, initial-scale=1\">\n");
  $stream->write("</head>\n");
  $stream->write("<body>\n");
  $stream->write("<h1>Changes</h1>\n");
  $stream->write("<ul>\n");
  $stream->write("<li>" . link_html($stream, $host, undef, "Changes for all spaces", "do/all/changes") . "\n")
      if @{$server->{wiki_space}};
  $stream->write("<li>" . link_html($stream, $host, $space, "Atom feed", "do/atom") . "\n");
  $stream->write("<li>" . link_html($stream, $host, $space, "RSS feed", "do/rss") . "\n");
  $stream->write("</ul>\n");
  my $dir = wiki_dir($host, $space);
  my $log = "$dir/changes.log";
  if (not -e $log) {
    $stream->write("<p>No changes.\n");
    return;
  }
  $stream->write("<p>Showing up to $n changes.\n");
  my $fh = File::ReadBackwards->new($log);
  my $more = changes($stream,
    $n,
    sub { $stream->write(encode_utf8 "<h2>" . shift . "</h2>\n") },
    sub { $stream->write("<p>" . shift . " by " . colourize_html($stream, shift) . "\n") },
    sub {
      my ($host, $space, $title, $id) = @_;
      $stream->write(encode_utf8 "<br> → " . link_html($stream, $host, $space, $title, $id) . "\n");
    },
    sub { $stream->write(encode_utf8 "<br> → $_[0]\n") },
    sub {
      return unless $_ = decode_utf8($fh->readline);
      chomp;
      split(/\x1f/), $host, $space, 0 });
  return unless $more;
  $stream->write("<p>" . link_html($stream, $host, $space, "More...", "do/changes/" . 10 * $n) . "\n");
}

sub serve_all_changes {
  my $stream = shift;
  my $host = shift;
  my $n = shift;
  my $style = shift;
  my $filter = shift;
  $log->info($filter ? "Serving $n all $filter changes" :  "Serving $n all changes");
  success($stream);
  $stream->write("# Changes for all spaces\n");
  # merge all logs
  my $log = all_logs($stream, $host, $n);
  if (not @$log) {
    $stream->write("No changes.\n");
    return;
  }
  my $filter_segment = $filter ? "/$filter" : "";
  my $style_segment = $style ? "/$style" : "";
  if (not $style) { print_link($stream, $host, undef, "Colour changes", "do/all$filter_segment/changes/$n/colour") }
  elsif ($style eq "colour") { print_link($stream, $host, undef, "Fancy changes", "do/all$filter_segment/changes/$n/fancy") }
  elsif ($style eq "fancy") { print_link($stream, $host, undef, "Normal changes", "do/all$filter_segment/changes/$n") }
  if ($filter) { print_link($stream, $host, undef, "All changes", "do/all/changes/$n$style_segment") }
  else { print_link($stream, $host, undef, "Latest changes", "do/all/latest/changes/$n$style_segment") }
  # taking the head of the @$log to get new log entries
  print_link($stream, $host, undef, "Atom Feed", "do/all/atom");
  my $filter_description = $filter ? " $filter" : "";
  $stream->write("Showing up to $n$filter_description changes.\n");
  return unless changes($stream,
    $n,
    sub { $stream->write("## " . shift . "\n") },
    sub { $stream->write(shift . " by " . colourize($stream, shift, $style) . "\n") },
    sub { print_link($stream, @_) },
    sub { $stream->write(encode_utf8 join("\n", @_, "")) },
    sub { @{shift(@$log) }, 1 if @$log },
    undef,
    $filter);
  $stream->write("\n");
  print_link($stream, $host, undef, "More...", "do/all/changes/" . 10 * $n . ($style ? "/$style" : ""));
}

sub serve_all_changes_via_http {
  my $stream = shift;
  my $host = shift;
  my $n = shift;
  my $filter = shift;
  $log->info($filter ? "Serving $n all $filter changes via HTTP" : "Serving $n all changes via HTTP");
  $stream->write("HTTP/1.1 200 OK\r\n");
  $stream->write("Content-Type: text/html\r\n");
  $stream->write("\r\n");
  $stream->write("<!DOCTYPE html>\n");
  $stream->write("<html>\n");
  $stream->write("<head>\n");
  $stream->write("<meta charset=\"utf-8\">\n");
  $stream->write("<title>Changes for all spaces</title>\n");
  $stream->write("<link type=\"text/css\" rel=\"stylesheet\" href=\"/default.css\"/>\n");
  $stream->write("<meta name=\"viewport\" content=\"width=device-width, initial-scale=1\">\n");
  $stream->write("</head>\n");
  $stream->write("<body>\n");
  $stream->write("<h1>Changes for all spaces</h1>\n");
  $stream->write("<ul>\n");
  $stream->write("<li>" . link_html($stream, $host, undef, "Atom feed", "do/all/atom") . "\n");
  if ($filter) { $stream->write("<li>" . link_html($stream, $host, undef, "All changes", "do/all/changes/$n") . "\n") }
  else { $stream->write("<li>" . link_html($stream, $host, undef, "Latest changes", "do/all/latest/changes/$n") . "\n") }
  $stream->write("</ul>\n");
  my $log = all_logs($stream, $host, $n);
  if (not @$log) {
    $stream->write("<p>No changes.\n");
    return;
  }
  # taking the head of the @$log to get new log entries
  $stream->write("<p>Showing up to $n $filter changes.\n");
  my $more = changes($stream,
    $n,
    sub { $stream->write("<h2>" . shift . "</h2>\n") },
    sub { $stream->write("<p>" . shift . " by " . colourize_html($stream, shift) . "\n") },
    sub { $stream->write(encode_utf8 "<br> → " . link_html($stream, @_) . "\n") },
    sub { $stream->write(encode_utf8 "<br> → $_[0]\n") },
    sub { @{shift(@$log) }, 1 if @$log },
    undef,
    $filter);
  return unless $more;
  $stream->write("<p>" . link_html($stream, $host, undef, "More...", "do/all/changes/" . 10 * $n) . "\n");
}

sub all_logs {
  my $stream = shift;
  my $host = shift;
  my $n = shift;
  my $filter = shift;
  # merge all logs
  my @log;
  my $dir = $server->{wiki_dir};
  my @spaces = space_dirs($stream);
  for my $space (@spaces) {
    my $changes = $dir;
    $changes .= "/$space" if $space;
    $changes .= "/changes.log";
    next unless -f $changes;
    $log->debug("Reading $changes");
    next unless my $fh = File::ReadBackwards->new($changes);
    if (keys %{$server->{host}} > 1) {
      push(@log, @{read_log($stream, $fh, $n, split(/\//, $space, 2), $filter)});
    } else {
      push(@log, @{read_log($stream, $fh, $n, $host, $space, $filter)});
    }
  }
  @log = sort { $b->[0] <=> $a->[0] } @log;
  return \@log;
 }

sub read_log {
  my $stream = shift;
  my $fh = shift; # File::ReadBackwards
  my $n = shift;
  my $host = shift;
  my $space = shift;
  my $filter = shift;
  my @changes;
  for (1 .. $n) {
    $_ = decode_utf8($fh->readline);
    # $_ can be undefined or a newline (which won't split)
    last unless $_ and $_ ne "\n";
    next if $filter and not /$filter/;
    chomp;
    push(@changes, [split(/\x1f/), $host, $space]);
  }
  $log->debug("Read changes: " . @changes);
  return \@changes;
}

# $n is the number of changes to show. $header is a code reference that prints a
# header for the date (one argument). $change is a code reference that prints
# the time and code of the person making the change (two arguments). $link is a
# code reference that prints a link (four arguments). $nolink is a code reference
# that prints a name that isn't linked (one argument). $next is a code reference
# that returns the list of attributes for the next change, these attributes
# being: the timestamp (as returned by time); the page or file name; the page
# revision or zero if a file; the code to represent the person that made the
# change, represented as a string of octal digits that will be fed to the
# colourize sub; the host, and the spaces, if any; and a boolean if space and
# page or file name should both be shown (up to seven arguments). Finally, the
# optional argument $kept is a code reference to say whether an old revision
# actually exists. If not, there's no point in showing a diff link. The default
# implementation checks for the existence of the keep file. $filter describes
# how changes are to be filtered: 'latest' means that only the latest change
# will be shown, i.e. a link to current revision. The default is to show all
# changes.
sub changes {
  my $stream = shift;
  my $n = shift;
  my $header = shift;
  my $change = shift;
  my $link = shift;
  my $nolink = shift;
  my $next = shift;
  my $kept = shift || sub {
    my ($host, $space, $id, $revision) = @_;
    -e wiki_dir($host, $space) . "/keep/$id/$revision.gmi";
  };
  my $filter = shift||'';
  my $last_day = '';
  my %seen;
  for (1 .. $n) {
    my ($ts, $id, $revision, $code, $host, $space, $show_space) = $next->();
    return unless $ts and $id;
    my $name = name($stream, $id, $host, $space, $show_space);
    next if $filter eq "latest" and $seen{$name};
    my $day = day($stream, $ts);
    if ($day ne $last_day) {
      $header->($day);
      $last_day = $day;
    }
    $change->(time_of_day($stream, $ts), $code);
    if ($revision eq "🖹") {
      # a deleted page
      $link->($host, $space, "$name (deleted)", "page/$id");
      $link->($host, $space, "History", "history/$id");
      $seen{$name} = 1;
    } elsif ($revision eq "🖻") {
      # a deleted file
      $nolink->("$name (deleted file)");
      $seen{$name . "\x1c"} = 1;
    } elsif ($revision > 0) {
      # a page
      if ($seen{$name}) {
	$link->($host, $space, "$name ($revision)", "page/$id/$revision");;
	$link->($host, $space, "Differences", "diff/$id/$revision") if $kept->($host, $space, $id, $revision);
      } elsif ($filter eq "latest") {
	$link->($host, $space, "$name", "page/$id");
	$link->($host, $space, "History", "history/$id");
	$seen{$name} = 1;
      } else {
	$link->($host, $space, "$name (current)", "page/$id");
	$link->($host, $space, "History", "history/$id");
	$seen{$name} = 1;
      }
    } else {
      # a file
      if ($seen{$name . "\x1c"}) {
	$nolink->("$name (file)");
      } else {
	$link->($host, $space, "$name (file)", "file/$id");
	$seen{$name . "\x1c"} = 1;
      }
    }
  }
  return () = $next->(); # return something, if there's more
}

sub name {
  my $stream = shift;
  my $id = shift;
  my $host = shift;
  my $space = shift;
  my $show_space = shift;
  if ($show_space) {
    if (keys %{$server->{host}} > 1) {
      if ($space) {
	return "[$host/$space] $id";
      } else {
	return "[$host] $id";
      }
    } elsif ($space) {
      return "[$space] $id";
    }
  }
  return $id;
}

sub colourize {
  my $stream = shift;
  my $code = shift;
  my $style = shift;
  my %rgb;
  return $code unless $style;
  if ($style eq "colour") {
    # 3/4 bit
    return join("", map { "\033[1;3${_};4${_}m${_}" } split //, $code) . "\033[0m ";
  } elsif ($style eq "fancy") {
    # 24 bit!
    %rgb = (
    0 => "0;0;0",
    1 => "222;56;43",
    2 => "57;181;74",
    3 => "255;199;6",
    4 => "0;111;184",
    5 => "118;38;113",
    6 => "44;181;233",
    7 => "204;204;204");
    return join("", map { "\033[38;2;$rgb{$_};48;2;$rgb{$_}m$_" } split //, $code) . "\033[0m ";
  }
  return $code;
}

# https://en.wikipedia.org/wiki/ANSI_escape_code#3/4_bit
sub colourize_html {
  my $stream = shift;
  my $code = shift;
  my %rgb = (
    0 => "0,0,0",
    1 => "222,56,43",
    2 => "57,181,74",
    3 => "255,199,6",
    4 => "0,111,184",
    5 => "118,38,113",
    6 => "44,181,233",
    7 => "204,204,204");
  $code = join("", map {
    "<span style=\"color: rgb($rgb{$_}); background-color: rgb($rgb{$_})\">$_</span>";
	       } split //, $code);
  return $code;
}

sub serve_rss {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  $log->info("Serving Gemini RSS");
  success($stream, "application/rss+xml");
  rss($stream, $host, $space, 'gemini');
}

sub serve_rss_via_http {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  $log->info("Serving RSS via HTTP");
  $stream->write("HTTP/1.1 200 OK\r\n");
  $stream->write("Content-Type: application/xml\r\n");
  $stream->write("\r\n");
  rss($stream, $host, $space, 'https');
}

sub rss {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $scheme = shift;
  my $name = $server->{wiki_main_page} || "Phoebe";
  my $port = port($stream);
  $stream->write("<rss version=\"2.0\" xmlns:atom=\"http://www.w3.org/2005/Atom\">\n");
  $stream->write("<channel>\n");
  $stream->write(encode_utf8 "<title>" . quote_html($name) . "</title>\n");
  $stream->write("<description>Changes on this wiki.</description>\n");
  $stream->write("<link>$scheme://$host:$port/</link>\n");
  $stream->write("<atom:link rel=\"self\" type=\"application/rss+xml\" href=\"$scheme://$host:$port/do/rss\" />\n");
  $stream->write("<generator>Phoebe</generator>\n");
  $stream->write("<docs>http://blogs.law.harvard.edu/tech/rss</docs>\n");
  my $dir = wiki_dir($host, $space);
  my $log = "$dir/changes.log";
  if (-e $log and my $fh = File::ReadBackwards->new($log)) {
    my %seen;
    for (1 .. 100) {
      last unless $_ = decode_utf8($fh->readline);
      chomp;
      my ($ts, $id, $revision, $code) = split(/\x1f/);
      next if $seen{$id};
      $seen{$id} = 1;
      $stream->write("<item>\n");
      $stream->write(encode_utf8 "<title>" . quote_html($id) . "</title>\n");
      my $link = to_url($stream, $host, $space, "page/$id", $scheme);
      $stream->write("<link>$link</link>\n");
      $stream->write("<guid>$link</guid>\n");
      $stream->write(encode_utf8 "<description>" . quote_html(text($host, $space, $id)) . "</description>\n");
      my ($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime($ts); # Sat, 07 Sep 2002 00:00:01 GMT
      $stream->write("<pubDate>"
		     . sprintf("%s, %02d %s %04d %02d:%02d:%02d GMT", qw(Sun Mon Tue Wed Thu Fri Sat)[$wday], $mday,
			       qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec)[$mon], $year + 1900, $hour, $min, $sec)
		     . "</pubDate>\n");
      $stream->write("</item>\n");
    }
  }
  $stream->write("</channel>\n");
  $stream->write("</rss>\n");
}

sub serve_blog_rss {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  $log->info("Serving Gemini Blog RSS");
  success($stream, "application/rss+xml");
  blog_rss($stream, $host, $space, 'gemini');
}

sub blog_rss {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $scheme = shift;
  my $name = $server->{wiki_main_page} || "Phoebe";
  my $port = port($stream);
  $stream->write("<rss version=\"2.0\" xmlns:atom=\"http://www.w3.org/2005/Atom\">\n");
  $stream->write("<channel>\n");
  $stream->write(encode_utf8 "<title>" . quote_html($name) . "</title>\n");
  $stream->write("<description>Blog pages on this wiki.</description>\n");
  $stream->write("<link>$scheme://$host:$port/</link>\n");
  $stream->write("<atom:link rel=\"self\" type=\"application/rss+xml\" href=\"$scheme://$host:$port/do/blog/rss\" />\n");
  $stream->write("<generator>Phoebe</generator>\n");
  $stream->write("<docs>http://blogs.law.harvard.edu/tech/rss</docs>\n");
  my $dir = wiki_dir($host, $space);
  my @blog = blog_pages($host, $space);
  my $ts = changes_for($host, $space, @blog);
  # hard coded: 10 pages blog RSS, no pagination
  for my $id (@blog[0 .. min($#blog, 9)]) {
    $stream->write("<item>\n");
    $stream->write(encode_utf8 "<title>" . quote_html($id) . "</title>\n");
    my $link = to_url($stream, $host, $space, "page/$id", $scheme);
    $stream->write("<link>$link</link>\n");
    $stream->write("<guid>$link</guid>\n");
    $stream->write(encode_utf8 "<description>" . quote_html(text($host, $space, $id)) . "</description>\n");
    my ($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime($ts->{$id}); # Sat, 07 Sep 2002 00:00:01 GMT
    $stream->write("<pubDate>"
		   . sprintf("%s, %02d %s %04d %02d:%02d:%02d GMT", qw(Sun Mon Tue Wed Thu Fri Sat)[$wday], $mday,
			     qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec)[$mon], $year + 1900, $hour, $min, $sec)
		   . "</pubDate>\n");
    $stream->write("</item>\n");
  }
  $stream->write("</channel>\n");
  $stream->write("</rss>\n");
}

sub changes_for {
  my $host = shift;
  my $space = shift;
  my @ids = @_;
  my %result;
  my $dir = wiki_dir($host, $space);
  my $log = "$dir/changes.log";
  if (-e $log and my $fh = File::ReadBackwards->new($log)) {
    while (@ids) {
      last unless $_ = decode_utf8($fh->readline);
      chomp;
      my ($ts, $id, $revision, $code) = split(/\x1f/);
      if (any { $_ eq $id } @ids) {
	@ids = grep { $_ ne $id } @ids;
	$result{$id} = $ts;
      }
    }
  }
  return \%result;
}

sub serve_atom {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  $log->info("Serving Gemini Atom");
  success($stream, "application/atom+xml");
  my $dir = wiki_dir($host, $space);
  my $log = "$dir/changes.log";
  my $fh = File::ReadBackwards->new($log);
  atom($stream, sub {
    return unless $_ = decode_utf8($fh->readline);
    chomp;
    split(/\x1f/), $host, $space, 0
  }, $host, $space, 'gemini');
}

sub serve_all_atom {
  my $stream = shift;
  my $host = shift;
  $log->info("Serving Gemini Atom");
  success($stream, "application/atom+xml");
  my $log = all_logs($stream, $host, 30);
  atom($stream, sub { @{shift(@$log) }, 1 if @$log }, $host, undef, 'gemini');
}

sub serve_atom_via_http {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  $log->info("Serving Atom via HTTP");
  $stream->write("HTTP/1.1 200 OK\r\n");
  $stream->write("Content-Type: application/xml\r\n");
  $stream->write("\r\n");
  my $dir = wiki_dir($host, $space);
  my $log = "$dir/changes.log";
  my $fh = File::ReadBackwards->new($log);
  atom($stream, sub {
    return unless $_ = decode_utf8($fh->readline);
    chomp;
    split(/\x1f/), $host, $space, 0
  }, $host, $space, 'https');
}

sub serve_all_atom_via_http {
  my $stream = shift;
  my $host = shift;
  $log->info("Serving Atom via HTTP");
  $stream->write("HTTP/1.1 200 OK\r\n");
  $stream->write("Content-Type: application/xml\r\n");
  $stream->write("\r\n");
  my $log = all_logs($stream, $host, 30);
  atom($stream, sub { @{shift(@$log) }, 1 if @$log }, $host, undef, 'https');
}

# $next is a code reference that returns the list of attributes for the next
# change, these attributes being: the timestamp (as returned by time); the page
# or file name; the page revision or zero if a file; the code to represent the
# person that made the change, represented as a string of octal digits that will
# be fed to the colourize sub; the host, and the spaces, if any; and a boolean
# if space and page or file name should both be shown (up to seven arguments).
# $scheme is either 'gemini' or 'https'.
sub atom {
  my $stream = shift;
  my $next = shift;
  my $host = shift;
  my $space = shift;
  my $scheme = shift;
  my $first_host = shift;
  my $name = $server->{wiki_main_page} || "Phoebe";
  my $port = port($stream);
  $stream->write("<?xml version=\"1.0\" encoding=\"utf-8\"?>\n");
  $stream->write("<feed xmlns=\"http://www.w3.org/2005/Atom\">\n");
  $stream->write(encode_utf8 "<title>" . quote_html($name) . "</title>\n");
  my $link = to_url($stream, $host, $space, "", $scheme);
  $stream->write("<link href=\"$link\"/>\n");
  $link = to_url($stream, $host, $space, "do/atom", $scheme);
  $stream->write("<link rel=\"self\" type=\"application/atom+xml\" href=\"$link\"/>\n");
  $stream->write("<id>$link</id>\n");
  my $feed_ts = "0001-01-01T00:00:00Z";
  $stream->write("<generator uri=\"https://alexschroeder.ch/cgit/phoebe/about/\" version=\"1.0\">Phoebe</generator>\n");
  my %seen;
  for (1 .. 100) {
    my ($ts, $id, $revision, $code, $host, $space, $show_space) = $next->();
    last unless $ts and $id;
    my $name = name($stream, $id, $host, $space, $show_space);
    if ($revision eq "🖹") {
      next if $seen{$name};
      # a deleted page
      $stream->write("<entry>\n");
      $stream->write(encode_utf8 "<title>" . quote_html($name) . " (deleted)</title>\n");
      $seen{$name} = 1;
    } elsif ($revision eq "🖻") {
      # a deleted file
      next if $seen{$name . "\x1c"};
      $stream->write("<entry>\n");
      $stream->write(encode_utf8 "<title>" . quote_html($name) . " (deleted file)</title>\n");
      $seen{$name . "\x1c"} = 1;
    } elsif ($revision > 0) {
      # a page
      next if $seen{$name};
      $stream->write("<entry>\n");
      $stream->write(encode_utf8 "<title>" . quote_html($name) . "</title>\n");
      my $link = to_url($stream, $host, $space, "page/$id", $scheme);
      $stream->write("<link href=\"$link\"/>\n");
      $stream->write("<id>$link</id>\n");
      $stream->write(encode_utf8 "<content type=\"text\">" . quote_html(text($host, $space, $id)) . "</content>\n");
      $seen{$name} = 1;
    } else {
      # a file
      next if $seen{$name . "\x1c"};
      $stream->write("<entry>\n");
      $stream->write(encode_utf8 "<title>" . quote_html($name) . " (file)</title>\n");
      my $link = to_url($stream, $host, $space, "file/$id", $scheme);
      $stream->write("<link href=\"$link\"/>\n");
      $stream->write("<id>$link</id>\n");
      $seen{$name . "\x1c"} = 1;
    }
    my ($sec, $min, $hour, $mday, $mon, $year) = gmtime($ts); # 2003-12-13T18:30:02Z
    $ts = sprintf("%04d-%02d-%02dT%02d:%02d:%02dZ", $year + 1900, $mon + 1, $mday, $hour, $min, $sec);
    $stream->write("<updated>$ts</updated>\n");
    $feed_ts = $ts if $ts gt $feed_ts;
    $stream->write("<author><name>$code</name></author>\n");
    $stream->write("</entry>\n");
  }
  $stream->write("<updated>$feed_ts</updated>\n");
  $stream->write("</feed>\n");
}

sub serve_blog_atom {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  $log->info("Serving Gemini Blog Atom");
  success($stream, "application/atom+xml");
  blog_atom($stream, $host, $space, 'gemini');
}

sub blog_atom {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $scheme = shift;
  my $name = $server->{wiki_main_page} || "Phoebe";
  my $port = port($stream);
  $stream->write("<?xml version=\"1.0\" encoding=\"utf-8\"?>\n");
  $stream->write("<feed xmlns=\"http://www.w3.org/2005/Atom\">\n");
  $stream->write(encode_utf8 "<title>" . quote_html($name) . "</title>\n");
  my $link = to_url($stream, $host, $space, "", $scheme);
  $stream->write("<link href=\"$link\"/>\n");
  $link = to_url($stream, $host, $space, "do/blog/atom", $scheme);
  $stream->write("<link rel=\"self\" type=\"application/atom+xml\" href=\"$link\"/>\n");
  $stream->write("<id>$link</id>\n");
  my $feed_ts = "0001-01-01T00:00:00Z";
  $stream->write("<generator uri=\"https://alexschroeder.ch/cgit/phoebe/about/\" version=\"1.0\">Phoebe</generator>\n");
  my $dir = wiki_dir($host, $space);
  my @blog = blog_pages($host, $space);
  my $changes = changes_for($host, $space, @blog);
  # hard coded: 10 pages blog ATOM, no pagination
  for my $id (@blog[0 .. min($#blog, 9)]) {
    $stream->write("<entry>\n");
    $stream->write(encode_utf8 "<title>" . quote_html($id) . "</title>\n");
    my $link = to_url($stream, $host, $space, "page/$id", $scheme);
    $stream->write("<link href=\"$link\"/>\n");
    $stream->write("<id>$link</id>\n");
    $stream->write(encode_utf8 "<content type=\"text\">" . quote_html(text($host, $space, $id)) . "</content>\n");
    my ($sec, $min, $hour, $mday, $mon, $year) = gmtime($changes->{$id}); # 2003-12-13T18:30:02Z
    my $ts = sprintf("%04d-%02d-%02dT%02d:%02d:%02dZ", $year + 1900, $mon + 1, $mday, $hour, $min, $sec);
    $stream->write("<updated>$ts</updated>\n");
    $feed_ts = $ts if $ts gt $feed_ts;
    $stream->write("</entry>\n");
  }
  $stream->write("<updated>$feed_ts</updated>\n");
  $stream->write("</feed>\n");
}

sub serve_raw {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $id = shift;
  my $revision = shift;
  $log->info("Serving raw $id");
  success($stream, 'text/plain; charset=UTF-8');
  $stream->write(encode_utf8 text($host, $space, $id, $revision));
}

sub serve_raw_via_http {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $id = shift;
  my $revision = shift;
  $log->info("Serving raw $id via HTTP");
  $stream->write("HTTP/1.1 200 OK\r\n");
  $stream->write("Content-Type: text/plain; charset=UTF-8\r\n");
  $stream->write("\r\n");
  $stream->write(encode_utf8 text($host, $space, $id, $revision));
}

sub serve_diff {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $id = shift;
  my $revision = shift;
  my $style = shift;
  $log->info("Serving the diff of $id");
  success($stream);
  $stream->write(encode_utf8 "# Differences for $id\n");
  if (not $style) { print_link($stream, $host, $space, "Colour diff", "diff/$id/$revision/colour") }
  else { print_link($stream, $host, $space, "Normal diff", "diff/$id/$revision") }
  $stream->write("Showing the differences between revision $revision and the current revision.\n");
  my $new = text($host, $space, $id);
  my $old = text($host, $space, $id, $revision);
  if (not $style) {
    diff($old, $new,
	 sub { $stream->write(encode_utf8 "$_\n") for @_ },
	 sub { $stream->write(encode_utf8 "> $_\n") for map { $_||"⏎" } @_ },
	 sub { $stream->write(encode_utf8 "> $_\n") for map { $_||"⏎" } @_ },
	 sub { "｢$_[0]｣" });
  } else {
    diff($old, $new,
	 sub { $stream->write(encode_utf8 "$_\n") for @_ },
	 sub { $stream->write(encode_utf8 "> \033[31m$_\033[0m\n") for map { $_||"⏎" } @_ },
	 sub { $stream->write(encode_utf8 "> \033[32m$_\033[0m\n") for map { $_||"⏎" } @_ },
	 sub { "\033[1m$_[0]\033[22m" });
  }
}

sub serve_diff_via_http {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $id = shift;
  my $revision = shift;
  $log->info("Serving the diff of $id via HTTP");
  $stream->write("HTTP/1.1 200 OK\r\n");
  $stream->write("Content-Type: text/html\r\n");
  $stream->write("\r\n");
  $stream->write("<!DOCTYPE html>\n");
  $stream->write("<html>\n");
  $stream->write("<head>\n");
  $stream->write("<meta charset=\"utf-8\">\n");
  $stream->write(encode_utf8 "<title>Differences for " . quote_html($id) . "</title>\n");
  $stream->write("<link type=\"text/css\" rel=\"stylesheet\" href=\"/default.css\"/>\n");
  $stream->write("<meta name=\"viewport\" content=\"width=device-width, initial-scale=1\">\n");
  $stream->write("</head>\n");
  $stream->write("<body>\n");
  $stream->write(encode_utf8 "<h1>Differences for " . quote_html($id) . "</h1>\n");
  $stream->write("<p>Showing the differences between revision $revision and the current revision.\n");
  my $new = text($host, $space, $id);
  my $old = text($host, $space, $id, $revision);
  diff($old, $new,
       sub { $stream->write(encode_utf8 "<p>$_\n") for @_ },
       sub { $stream->write(encode_utf8 "<p style=\"color: rgb(222,56,43)\">" . join("<br>", map { $_||"⏎" } @_) . "\n") },
       sub { $stream->write(encode_utf8 "<p style=\"color: rgb(57,181,74)\">" . join("<br>", map { $_||"⏎" } @_) . "\n") },
       sub { "<strong>$_</strong>" });
}

# old text, new text, code reference to print a paragraph, print deleted text,
# print added text
sub diff {
  my @old = split(/\n/, shift);
  my @new = split(/\n/, shift);
  my $paragraph = shift;
  my $deleted = shift;
  my $added = shift;
  my $highlight = shift;
  $log->debug("Preparing a diff");
  my $diff = Algorithm::Diff->new(\@old, \@new);
  $diff->Base(1); # line numbers, not indices
  while($diff->Next()) {
    next if $diff->Same();
    my $sep = '';
    my ($min1, $max1, $min2, $max2) = $diff->Get(qw(min1 max1 min2 max2));
    if ($diff->Diff == 3) {
      my ($from, $to) = refine([$diff->Items(1)], [$diff->Items(2)], $highlight);
      $paragraph->($min1 == $max1 ? "Changed line $min1 from:" : "Changed lines $min1–$max1 from:");
      $deleted->(@$from);
      $paragraph->($min2 == $max2 ? "to:" : "to lines $min2–$max2:");
      $added->(@$to);
    } elsif ($diff->Diff == 2) {
      $paragraph->($min2 == $max2 ? "Added line $min2:" : "Added lines $min2–$max2:");
      $added->($diff->Items(2));
    } elsif ($diff->Diff == 1) {
      $paragraph->($min1 == $max1 ? "Deleted line $min1:" : "Deleted lines $min1–$max1:");
      $deleted->($diff->Items(1));
    }
  }
}

# $from_lines and $to_lines are references to lists of lines. The lines are
# concatenated and split by words.
sub refine {
  my $from_lines = shift;
  my $to_lines = shift;
  my $highlight = shift;
  my @from_words = split(/\b(?=\w)/, join("\n", @$from_lines));
  my @to_words = split(/\b(?=\w)/, join("\n", @$to_lines));
  my $diff = Algorithm::Diff->new(\@from_words, \@to_words);
  my ($from, $to);
  while($diff->Next()) {
    if (my @list = $diff->Same()) {
      $from .= join('', @list);
      $to .= join('', @list);
    } else {
      # reassemble the chunks, and highlight them per line, don't strip trailing newlines!
      $from .= join("\n", map { $_ ? $highlight->($_) : $_ } (split(/\n/, join('', $diff->Items(1)), -1)));
      $to   .= join("\n", map { $_ ? $highlight->($_) : $_ } (split(/\n/, join('', $diff->Items(2)), -1)));
    }
  }
  # return lines
  return [split(/\n/, $from)], [split(/\n/, $to)];
}

sub serve_html {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $id = shift;
  my $revision = shift;
  success($stream, 'text/html');
  $log->info("Serving $id as HTML");
  html_page($stream, $host, $space, $id, $revision);
}

sub serve_page_via_http {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $id = shift;
  my $revision = shift;
  $log->info("Serving $id as HTML via HTTP");
  $stream->write("HTTP/1.1 200 OK\r\n");
  $stream->write("Content-Type: text/html\r\n");
  $stream->write("\r\n");
  html_page($stream, $host, $space, $id, $revision);
}

sub html_page {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $id = shift;
  my $revision = shift;
  $stream->write("<!DOCTYPE html>\n");
  $stream->write("<html>\n");
  $stream->write("<head>\n");
  $stream->write("<meta charset=\"utf-8\">\n");
  $stream->write(encode_utf8 "<title>" . quote_html($id) . "</title>\n");
  $stream->write("<link type=\"text/css\" rel=\"stylesheet\" href=\"/default.css\"/>\n");
  $stream->write("<meta name=\"viewport\" content=\"width=device-width, initial-scale=1\">\n");
  $stream->write("</head>\n");
  $stream->write("<body>\n");
  $stream->write(encode_utf8 "<h1>" . quote_html($id) . "</h1>\n");
  $stream->write(encode_utf8 to_html(text($host, $space, $id, $revision)) . "\n");
  $stream->write(encode_utf8 to_html(html_footer($stream, $host, $space, $id, $revision)) . "\n");
  $stream->write("</body>\n");
  $stream->write("</html>\n");
}

# returns lines!
sub to_html {
  my $text = shift;
  my @lines;
  my $list;
  my $code;
  for (split /\n/, quote_html($text)) {
    if (/^```(?:type=([a-z]+))?/) {
      my $type = $1||"default";
      if ($code) {
	push @lines, "</pre>";
	$code = 0;
      } else {
	push @lines, "</ul>" if $list;
	$list = 0;
	push @lines, "<pre class=\"$type\">";
	$code = 1;
      }
    } elsif ($code) {
      push @lines, $_;
    } elsif (/^\* +(.*)/) {
      push @lines, "<ul>" unless $list;
      push @lines, "<li>$1";
      $list = 1;
    } elsif (my ($url, $text) = /^=&gt;\s*(\S+)\s*(.*)/) { # quoted HTML!
      push @lines, "<ul>" unless $list;
      $text ||= $url;
      push @lines, "<li><a href=\"$url\">$text</a>";
      $list = 1;
    } elsif (/^(#{1,6})\s*(.*)/) {
      push @lines, "</ul>" if $list;
      $list = 0;
      my $level = length($1);
      push @lines, "<h$level>$2</h$level>";
    } elsif (/^&gt;\s*(.*)/) { # quoted HTML!
      push @lines, "</ul>" if $list;
      $list = 0;
      push @lines, "<blockquote>$1</blockquote>";
    } else {
      push @lines, "</ul>" if $list;
      $list = 0;
      push @lines, "<p>$_";
    }
  }
  push @lines, "</pre>" if $code;
  push @lines, "</ul>" if $list;
  return join("\n", @lines);
}

sub html_footer {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $id = shift;
  my $revision = shift||"";
  my @links;
  push(@links, $_->($stream, $host, $space, $id, $revision, "html")) for @footer;
  my $html = join("\n", grep /\S/, @links);
  return "\n\nMore:\n$html" if $html =~ /\S/;
  return "";
}

sub day {
  my $stream = shift;
  my ($sec, $min, $hour, $mday, $mon, $year) = gmtime(shift);
  return sprintf('%4d-%02d-%02d', $year + 1900, $mon + 1, $mday);
}

sub time_of_day {
  my $stream = shift;
  my ($sec, $min, $hour, $mday, $mon, $year) = gmtime(shift);
  return sprintf('%02d:%02d UTC', $hour, $min);
}

sub modified {
  my $ts = (stat(shift))[9];
  return $ts;
}

sub serve_history {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $id = shift;
  my $n = shift;
  my $style = shift;
  success($stream);
  $log->info("Serve history for $id");
  $stream->write("# Page history for $id\n");
  if (not $style) { print_link($stream, $host, $space, "Colour history", "history/$id/$n/colour") }
  elsif ($style eq "colour") { print_link($stream, $host, $space, "Fancy history", "history/$id/$n/fancy") }
  elsif ($style eq "fancy") { print_link($stream, $host, $space, "Normal history", "history/$id/$n") }
  my $dir = wiki_dir($host, $space);
  my $log = "$dir/changes.log";
  if (not -e $log) {
    $stream->write("No changes.\n");
    return;
  }
  $stream->write("Showing up to $n changes.\n");
  my $fh = File::ReadBackwards->new($log);
  return unless changes($stream,
    $n,
    sub { $stream->write("## " . shift . "\n") },
    sub { $stream->write(shift . " by " . colourize($stream, shift, $style) . "\n") },
    sub { print_link($stream, @_) },
    sub { $stream->write(join("\n", @_, "")) },
    sub {
    READ:
      return unless $_ = decode_utf8($fh->readline);
      chomp;
      my ($ts, $id_log, $revision, $code) = split(/\x1f/);
      goto READ if $id_log ne $id;
      $ts, $id_log, $revision, $code, $host, $space, 0 });
  $stream->write("\n");
  print_link($stream, $host, $space, "More...", "history/" . uri_escape_utf8($id) . "/" . 10 * $n . ($style ? "/$style" : ""));
}

sub serve_history_via_http {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $id = shift;
  my $n = shift;
  $log->info("Serve history for $id via HTTP");
  $stream->write("HTTP/1.1 200 OK\r\n");
  $stream->write("Content-Type: text/html\r\n");
  $stream->write("\r\n");
  $stream->write("<!DOCTYPE html>\n");
  $stream->write("<html>\n");
  $stream->write("<head>\n");
  $stream->write("<meta charset=\"utf-8\">\n");
  $stream->write(encode_utf8 "<title>Page history for " . quote_html($id) . "</title>\n");
  $stream->write("<link type=\"text/css\" rel=\"stylesheet\" href=\"/default.css\"/>\n");
  $stream->write("<meta name=\"viewport\" content=\"width=device-width, initial-scale=1\">\n");
  $stream->write("</head>\n");
  $stream->write("<body>\n");
  $stream->write(encode_utf8 "<h1>Page history for " . quote_html($id) . "</h1>\n");
  my $dir = wiki_dir($host, $space);
  my $log = "$dir/changes.log";
  if (not -e $log) {
    $stream->write("<p>No changes.\n");
    return;
  }
  $stream->write("<p>Showing up to $n changes.\n");
  my $fh = File::ReadBackwards->new($log);
  my $first = 1;
  my $more = changes($stream,
    $n,
    sub { $stream->write(encode_utf8 "<h2>" . shift . "</h2>\n") },
    sub { $stream->write(encode_utf8 "<p>" . shift . " by " . colourize_html($stream, shift) . "\n") },
    sub {
      my ($host, $space, $title, $id) = @_;
      $stream->write(encode_utf8 "<br> → " . link_html($stream, $host, $space, $title, $id) . "\n");
    },
    sub { "<br> → $_[0]" },
    sub {
    READ:
      return unless $_ = decode_utf8($fh->readline);
      chomp;
      my ($ts, $id_log, $revision, $code) = split(/\x1f/);
      goto READ if $id_log ne $id;
      $ts, $id_log, $revision, $code, $host, $space, 0 });
  return unless $more;
  $stream->write("<p>" . link_html($stream, $host, $space, "More...", "history/" . uri_escape_utf8($id) . "/" . 10 * $n) . "\n");
}

sub footer {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $id = shift;
  my $revision = shift||"";
  my @links;
  push(@links, gemini_link($stream, $host, $space, "History", "history/$id"));
  push(@links, gemini_link($stream, $host, $space, "Raw text", "raw/$id/$revision"));
  push(@links, gemini_link($stream, $host, $space, "HTML", "html/$id/$revision"));
  push(@links, $_->($stream, $host, $space, $id, $revision, "gemini")) for @footer;
  return join("\n", "\n\nMore:", (grep /\S/, @links), ""); # includes a trailing newline
}

sub serve_page {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $id = shift;
  my $revision = shift;
  $log->info("Serve Gemini page $id");
  success($stream);
  $stream->write(encode_utf8 "# $id\n");
  $stream->write(encode_utf8 text($host, $space, $id, $revision));
  $stream->write(encode_utf8 footer($stream, $host, $space, $id, $revision));
}

sub text {
  my $host = shift;
  my $space = shift;
  my $id = shift;
  my $revision = shift;
  my $dir = wiki_dir($host, $space);
  return read_text "$dir/keep/$id/$revision.gmi" if $revision and -f "$dir/keep/$id/$revision.gmi";
  return read_text "$dir/page/$id.gmi" if -f "$dir/page/$id.gmi";
  return robots() if $id eq "robots" and not $space;
  return "This this revision is no longer available." if $revision;
  return "This page does not yet exist.";
}

sub robots () {
  my $ban = << 'EOT';
User-agent: *
Disallow: /raw
Disallow: /html
Disallow: /diff
Disallow: /history
Disallow: /do/comment
Disallow: /do/changes
Disallow: /do/all/changes
Disallow: /do/all/latest/changes
Disallow: /do/rss
Disallow: /do/blog/rss
Disallow: /do/atom
Disallow: /do/blog/atom
Disallow: /do/all/atom
Disallow: /do/new
Disallow: /do/more
Disallow: /do/match
Disallow: /do/search
# allowing do/index!
Crawl-delay: 10
EOT
  my @disallows = $ban =~ /Disallow: (.*)/g;
  return $ban
      . join("\n",
	     map {
	       my $space = (split /\//)[-1];
	       join("\n", "# $space", map { "Disallow: /$space$_" } @disallows)
	     } @{$server->{wiki_space}}) . "\n";
}

sub serve_file {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $id = shift;
  my $revision = shift;
  $log->info("Serve file $id");
  my $dir = wiki_dir($host, $space);
  my $file = "$dir/file/$id";
  my $meta = "$dir/meta/$id";
  if (not -f $file) {
    $stream->write("40 File not found\r\n");
    return;
  } elsif (not -f $meta) {
    $stream->write("40 Metadata not found\r\n");
    return;
  }
  my %meta = (map { split(/: /, $_, 2) } read_lines($meta));
  if (not $meta{'content-type'}) {
    $stream->write("59 Metadata corrupt\r\n");
    return;
  }
  success($stream, $meta{'content-type'});
  $stream->write(read_binary($file));
}

sub serve_file_via_http {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $id = shift;
  my $revision = shift;
  $log->info("Serve file $id");
  my $dir = wiki_dir($host, $space);
  my $file = "$dir/file/$id";
  my $meta = "$dir/meta/$id";
  if (not -f $file) {
    $stream->write("HTTP/1.1 404 Error\r\n");
    $stream->write("Content-Type: text/plain\r\n");
    $stream->write("\r\n");
    $stream->write("File not found\r\n");
    return;
  } elsif (not -f $meta) {
    $stream->write("HTTP/1.1 500 Error\r\n");
    $stream->write("Content-Type: text/plain\r\n");
    $stream->write("\r\n");
    $stream->write("Metadata not found\r\n");
    return;
  }
  my %meta = (map { split(/: /, $_, 2) } read_lines($meta));
  if (not $meta{'content-type'}) {
    $stream->write("HTTP/1.1 500 Error\r\n");
    $stream->write("Content-Type: text/plain\r\n");
    $stream->write("\r\n");
    $stream->write("Metadata corrupt\r\n");
    return;
  }
  $stream->write("HTTP/1.1 200 OK\r\n");
  $stream->write("Content-Type: " . $meta{'content-type'} ."\r\n");
  $stream->write("\r\n");
  $stream->write(read_binary($file));
}

sub newest_first {
  my $stream = shift;
  my ($date_a, $article_a) = $a =~ /^(\d\d\d\d-\d\d(?:-\d\d)? ?)?(.*)/;
  my ($date_b, $article_b) = $b =~ /^(\d\d\d\d-\d\d(?:-\d\d)? ?)?(.*)/;
  return (($date_b and $date_a and $date_b cmp $date_a)
	  || ($article_a cmp $article_b)
	  # this last one should be unnecessary
	  || ($a cmp $b));
}

sub bogus_hash {
  my $str = shift;
  return "0000" unless $str;
  my $num = unpack("L",B::hash($str)); # 32-bit integer
  my $code = sprintf("%o", $num); # octal is 0-7
  return substr($code, 0, 4); # four numbers
}

sub write_file {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $id = shift;
  my $data = shift;
  my $type = shift;
  $log->info("Writing file $id");
  my $dir = wiki_dir($host, $space);
  my $file = "$dir/file/$id";
  my $meta = "$dir/meta/$id";
  if (-e $file) {
    my $old = read_binary($file);
    if ($old eq $data) {
      $log->info("$id is unchanged");
      $stream->write("30 " . to_url($stream, $host, $space, "page/$id") . "\r\n");
      return;
    }
  }
  my $changes = "$dir/changes.log";
  if (not open(my $fh, ">>:encoding(UTF-8)", $changes)) {
    $log->error("Cannot log $changes: $!");
    $stream->write("59 Unable to write log\r\n");
    return;
  } else {
    my $peerhost = $stream->handle->peerhost;
    say $fh join("\x1f", scalar(time), $id, 0, bogus_hash($peerhost));
    close($fh);
  }
  mkdir "$dir/file" unless -d "$dir/file";
  eval { write_binary($file, $data) };
  if ($@) {
    $stream->write("59 Unable to save $id\r\n");
    return;
  }
  mkdir "$dir/meta" unless -d "$dir/meta";
  eval { write_text($meta, "content-type: $type\n") };
  if ($@) {
    $stream->write("59 Unable to save metadata for $id\r\n");
    return;
  }
  $log->info("Wrote $id");
  $stream->write("30 " . to_url($stream, $host, $space, "file/$id") . "\r\n");
}

sub delete_file {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $id = shift;
  $log->info("Deleting file $id");
  my $dir = wiki_dir($host, $space);
  unlink("$dir/file/$id", "$dir/meta/$id");
  my $changes = "$dir/changes.log";
  if (not open(my $fh, ">>:encoding(UTF-8)", $changes)) {
    $log->error("Cannot write log $changes: $!");
    $stream->write("59 Unable to write log\r\n");
    return;
  } else {
    my $peerhost = $stream->handle->peerhost;
    say $fh join("\x1f", scalar(time), $id, "🖻", bogus_hash($peerhost));
    close($fh);
  }
  success($stream);
  $stream->write("# $id\n");
  $stream->write("The file was deleted.\n");
}

sub write_page {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $id = shift;
  my $text = shift;
  $log->info("Writing page $id");
  my $dir = wiki_dir($host, $space);
  my $file = "$dir/page/$id.gmi";
  my $revision = 0;
  if (-e $file) {
    my $old = read_text($file);
    if ($old eq $text) {
      $log->info("$id is unchanged");
      $stream->write("30 " . to_url($stream, $host, $space, "page/$id") . "\r\n");
      return;
    }
    mkdir "$dir/keep" unless -d "$dir/keep";
    if (-d "$dir/keep/$id") {
      foreach (read_dir("$dir/keep/$id")) {
	$revision = $1 if m/^(\d+)\.gmi$/ and $1 > $revision;
      }
      $revision++;
    } else {
      mkdir "$dir/keep/$id";
      $revision = 1;
    }
    rename $file, "$dir/keep/$id/$revision.gmi";
  } else {
    my $index = "$dir/index";
    if (not open(my $fh, ">>:encoding(UTF-8)", $index)) {
      $log->error("Cannot write index $index: $!");
      $stream->write("59 Unable to write index\r\n");
      return;
    } else {
      say $fh $id;
      close($fh);
    }
  }
  my $changes = "$dir/changes.log";
  if (not open(my $fh, ">>:encoding(UTF-8)", $changes)) {
    $log->error("Cannot write log $changes: $!");
    $stream->write("59 Unable to write log\r\n");
    return;
  } else {
    my $peerhost = $stream->handle->peerhost;
    say $fh join("\x1f", scalar(time), $id, $revision + 1, bogus_hash($peerhost));
    close($fh);
  }
  mkdir "$dir/page" unless -d "$dir/page";
  eval { write_text($file, $text) };
  if ($@) {
    $log->error("Unable to save $id: $@");
    $stream->write("59 Unable to save $id\r\n");
  } else {
    $log->info("Wrote $id");
    $stream->write("30 " . to_url($stream, $host, $space, "page/$id") . "\r\n");
  }
}

sub delete_page {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $id = shift;
  $log->info("Deleting page $id");
  my $dir = wiki_dir($host, $space);
  my $file = "$dir/page/$id.gmi";
  if (-e $file) {
    my $revision = 0;
    mkdir "$dir/keep" unless -d "$dir/keep";
    if (-d "$dir/keep/$id") {
      foreach (read_dir("$dir/keep/$id")) {
	$revision = $1 if m/^(\d+)\.gmi$/ and $1 > $revision;
      }
      $revision++;
    } else {
      mkdir "$dir/keep/$id";
      $revision = 1;
    }
    # effectively deleting the file
    rename $file, "$dir/keep/$id/$revision.gmi";
  }
  my $index = "$dir/index";
  if (-f $index) {
    # remove $id from the index
    my @pages = grep { $_ ne $id } read_lines $index;
    write_text($index, join("\n", @pages, ""));
  }
  my $changes = "$dir/changes.log";
  if (not open(my $fh, ">>:encoding(UTF-8)", $changes)) {
    $log->error("Cannot write log $changes: $!");
    $stream->write("59 Unable to write log\r\n");
    return;
  } else {
    my $peerhost = $stream->handle->peerhost;
    say $fh join("\x1f", scalar(time), $id, "🖹", bogus_hash($peerhost));
    close($fh);
  }
  $log->info("Deleted page $id");
  $stream->write("30 " . to_url($stream, $host, $space, "page/$id") . "\r\n");
}

sub process_titan {
  my ($stream, $request, $upload, $buffer, $size) = @_;
  eval {
    local $SIG{'ALRM'} = sub { $log->error("Timeout processing upload $request") };
    alarm(10); # timeout
    save_page($stream, $upload->{host}, $upload->{space}, $upload->{id},
	      $upload->{params}->{mime}, $buffer, $size);
    alarm(0);
  };
  return unless $@;
  $log->error("Error: $@");
  $stream->close_gracefully();
}

sub save_page {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $id = shift;
  my $type = shift;
  my $data = shift;
  my $length = shift;
  if ($type ne "text/plain") {
    if ($length == 0) {
      with_lock($stream, $host, $space, sub { delete_file($stream, $host, $space, $id) } );
    } else {
      with_lock($stream, $host, $space, sub { write_file($stream, $host, $space, $id, $data, $type) } );
    }
  } elsif ($length == 0) {
    with_lock($stream, $host, $space, sub { delete_page($stream, $host, $space, $id) } );
  } elsif (utf8::decode($data)) { # decodes in-place and returns success
    with_lock($stream, $host, $space, sub { write_page($stream, $host, $space, $id, $data) } );
  } else {
    $log->debug("The text is invalid UTF-8");
    $stream->write("59 The text is invalid UTF-8\r\n");
    $stream->close_gracefully();
  }
}

sub allow_deny_hook {
  my $stream = shift;
  my $client = shift;
  # consider adding rate limiting?
  return 1;
}

sub run_extensions {
  foreach my $sub (@extensions) {
    return 1 if $sub->(@_);
  }
  return;
}

sub wiki_dir {
  my $host = shift;
  my $space = shift;
  my $dir = $server->{wiki_dir};
  if (keys %{$server->{host}} > 1) {
    $dir .= "/$host";
    mkdir($dir) unless -d $dir;
  }
  $dir .= "/$space" if $space;
  mkdir($dir) unless -d $dir;
  return $dir;
}

# If we are serving multiple hostnames, we need to check whether the space
# supplied in the URL matches a known hostname/space combo.
sub space {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  $space = decode_utf8(uri_unescape($space)) if $space;
  if (keys %{$server->{host}} > 1) {
    return undef unless $space;
    return $space if grep { $_ eq "$host/$space" } @{$server->{wiki_space}};
    # else it's an error and we jump out to the eval {} in handle_url
    $stream->write("40 $host doesn't know about $space\r\n");
    die "unknown space: $host/$space\n"; # is caught in the eval
  }
  # Without wildcards, just return the space. We already know that the space
  # matched the regular expression of spaces.
  return $space;
}

sub space_dirs {
  my $stream = shift;
  my @spaces;
  if (keys %{$server->{host}} > 1) {
    push @spaces, keys %{$server->{host}};
  } else {
    push @spaces, undef;
  }
  push @spaces, @{$server->{wiki_space}};
  return @spaces;
}

# A list of links to all the spaces we have. The tricky part here is that we
# want to create appropriate links if we're virtual hosting. Keys are URLs,
# values are names.
sub space_links {
  my $stream = shift;
  my $scheme = shift;
  my $host = shift;
  my $port = shift;
  my %spaces;
  if (keys %{$server->{host}} > 1) {
    for (keys %{$server->{host}}) {
      $spaces{"$scheme://$_:$port/"} = $_;
    }
    for my $space (@{$server->{wiki_space}}) {
      my ($ahost, $aspace) = split(/\//m, $space, 2);
      $spaces{"$scheme://$ahost:$port/$aspace/"} = $space;
    }
  } elsif (@{$server->{wiki_space}}) {
    $spaces{"$scheme://$host:$port/"} = "Main space";
    for (sort @{$server->{wiki_space}}) {
      $spaces{"$scheme://$host:$port/$_/"} = $_;
    }
  }
  return \%spaces;
}

# A regular expression matching wiki spaces in URLs. The tricky part is that we
# must strip the hostnames, as these aren't repeated: for a URL like
# gemini://localhost:1965/alex/ the regular expression must just match 'alex'
# and it's space($stream, 'localhost', 'alex') that will check whether 'alex' is a
# legal space for localhost.
sub space_regex {
  my @spaces;
  if (keys %{$server->{host}} > 1) {
    for (@{$server->{wiki_space}}) {
      my ($space) = /\/(.*)/;
      push(@spaces, $space);
    }
  } elsif (@{$server->{wiki_space}}) {
    @spaces = @{$server->{wiki_space}};
  }
  return join("|", map { quotemeta } @spaces);
}

# A regular expression matching parts of reserved paths in URLs. When looking at
# gemini://localhost:1965/page/test or gemini://localhost:1965/do/index and
# using a client that has an "up" command, you'd end up at
# gemini://localhost:1965/page – but what should happen in this case? We should
# redirect these requests to gemini://localhost:1965/, I think.
sub reserved_regex {
  return join("|", qw(do page raw file html history diff));
}

sub process_http {
  my $stream = shift;
  my $request = shift;
  my $headers = shift;
  my $buffer = shift;
  eval {
    local $SIG{'ALRM'} = sub {
      $log->error("Timeout processing $request");
    };
    alarm(10); # timeout
    my $hosts = host_regex();
    my $port = port($stream);
    my $spaces = space_regex();
    $log->info("Looking at $request");
    my ($host, $space, $id, $n, $filter);
    if (run_extensions($stream, $request, $headers, $buffer)) {
      # config file goes first
    } elsif ($request =~ m!^GET /default.css HTTP/1\.[01]$!
	and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
      serve_css_via_http($stream, $host);
    } elsif (($space) = $request =~ m!^GET (?:(?:/($spaces)/?)?|/) HTTP/1\.[01]$!
	     and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
      serve_main_menu_via_http($stream, $host, space($stream, $host, $space));
    } elsif (($space, $id, $n) = $request =~ m!^GET (?:/($spaces))?/page/([^/]*)(?:/(\d+))? HTTP/1\.[01]$!
	     and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
      serve_page_via_http($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)), $n);
    } elsif (($space, $id, $n) = $request =~ m!^GET (?:/($spaces))?/file/([^/]*)(?:/(\d+))? HTTP/1\.[01]$!
	     and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
      serve_file_via_http($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)), $n);
    } elsif (($space, $id, $n) = $request =~ m!^GET (?:/($spaces))?/history/([^/]*)(?:/(\d+))? HTTP/1\.[01]$!
	     and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
      serve_history_via_http($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)), $n||10);
    } elsif (($space, $id, $n) = $request =~ m!^GET (?:/($spaces))?/diff/([^/]*)(?:/(\d+))? HTTP/1\.[01]$!
	     and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
      serve_diff_via_http($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)), $n||10);
    } elsif (($space, $id, $n) = $request =~ m!^GET (?:/($spaces))?/raw/([^/]*)(?:/(\d+))? HTTP/1\.[01]$!
	     and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
      serve_raw_via_http($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)), $n);
    } elsif ($request =~ m!^GET /robots.txt(?:[#?].*)? HTTP/1\.[01]$!
	     and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
      serve_raw_via_http($stream, $host, undef, 'robots');
    } elsif (($space, $id, $n) = $request =~ m!^GET (?:/($spaces))?/do/changes(?:/(\d+))? HTTP/1\.[01]$!
	     and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
      serve_changes_via_http($stream, $host, space($stream, $host, $space), $n||100);
    } elsif (($filter, $n) = $request =~ m!^GET /do/all(?:/(latest))?/changes(?:/(\d+))? HTTP/1\.[01]$!
	     and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
      serve_all_changes_via_http($stream, $host, $n||100, $filter||"");
    } elsif (($space, $id, $n) = $request =~ m!^GET (?:/($spaces))?/do/index HTTP/1\.[01]$!
	     and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
      serve_index_via_http($stream, $host, space($stream, $host, $space));
    } elsif (($space, $id, $n) = $request =~ m!^GET (?:/($spaces))?/do/files HTTP/1\.[01]$!
	     and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
      serve_files_via_http($stream, $host, space($stream, $host, $space));
    } elsif (($space, $id, $n) = $request =~ m!^GET (?:/($spaces))?/do/spaces HTTP/1\.[01]$!
	     and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
      serve_spaces_via_http($stream, $host, $port);
    } elsif (($space, $id, $n) = $request =~ m!^GET (?:/($spaces))?/do/rss HTTP/1\.[01]$!
	     and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
      serve_rss_via_http($stream, $host, space($stream, $host, $space));
    } elsif (($space, $id, $n) = $request =~ m!^GET (?:/($spaces))?/do/atom HTTP/1\.[01]$!
	     and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
      serve_atom_via_http($stream, $host, space($stream, $host, $space));
    } elsif (($space, $n) = $request =~ m!^GET /do/all/atom HTTP/1\.[01]$!
	     and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
      serve_all_atom_via_http($stream, $host);
    } elsif ($request =~ m!^GET (?:/($spaces))?/do/source HTTP/1\.[01]$!
	     and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
      $stream->write("HTTP/1.1 200 OK\r\n");
      $stream->write("Content-Type: text/plain; charset=UTF-8\r\n");
      $stream->write("\r\n");
      seek DATA, 0, 0;
      local $/ = undef; # slurp
      $stream->write(encode_utf8 <DATA>);
    } else {
      $log->debug("No http handler for $request");
      http_error($stream, "Don't know how to handle $request");
    }
    $log->debug("Done");
  };
  $log->error("Error: $@") if $@;
  alarm(0);
  $stream->close_gracefully();
}

sub is_upload {
  my $stream = shift;
  my $request = shift;
  $log->info("Looking at $request");
  my $hosts = host_regex();
  my $spaces_regex = space_regex();
  my $port = port($stream);
  if ($request =~ m!^titan://($hosts)(?::$port)?!) {
    my $host = $1;
    my($scheme, $authority, $path, $query, $fragment) =
	$request =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?|;
    if ($path =~ m!^(?:/($spaces_regex))?(?:/raw)?/([^/;=&]+(?:;\w+=[^;=&]+)+)!) {
      my $space = $1;
      my ($id, @params) = split(/[;=&]/, $2);
      my $params = { map {decode_utf8(uri_unescape($_))} @params };
      if (valid_params($stream, $host, $space, $id, $params)) {
	return {
	  host => $host,
	  space => space($stream, $host, $space),
	  id => decode_utf8(uri_unescape($id)),
	  params => $params,
	}
      }
    } else {
      $log->debug("The path $path is malformed");
      $stream->write("59 The path $path is malformed\r\n");
      $stream->close_gracefully();
    }
  }
  return 0;
}

sub valid_params {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $id = shift;
  my $params = shift;
  return unless valid_id($stream, $host, $space, $id, $params);
  return unless valid_token($stream, $host, $space, $id, $params);
  return unless valid_mime_type($stream, $host, $space, $id, $params);
  return unless valid_size($stream, $host, $space, $id, $params);
  return 1;
}

sub valid_id {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $id = shift;
  if (not $id) {
    $log->debug("The URL lacks a page name");
    $stream->write("59 The URL lacks a page name\r\n");
    $stream->close_gracefully();
    return;
  } elsif ($id =~ /[[:cntrl:]]/) {
    $log->debug("Page names must not control characters");
    $stream->write("59 Page names must not control characters\r\n");
    $stream->close_gracefully();
    return;
  }
  return 1;
}

sub valid_token {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $id = shift;
  my $params = shift;
  my $token = quotemeta($params->{token}||"");
  my @tokens = @{$server->{wiki_token}};
  push(@tokens, @{$server->{wiki_space_token}->{$space}})
      if $space and $server->{wiki_space_token}->{$space};
  $log->debug("Valid tokens: @tokens");
  $log->debug("Spaces: " . join(", ", keys %{$server->{wiki_space_token}}));
  if (not $token and @tokens) {
    $log->debug("Uploads require a token");
    $stream->write("59 Uploads require a token\r\n");
    $stream->close_gracefully();
    return;
  } elsif (not grep(/^$token$/, @tokens)) {
    $log->debug("Your token is the wrong token");
    $stream->write("59 Your token is the wrong token\r\n");
    $stream->close_gracefully();
    return;
  }
  return 1;
}

sub valid_mime_type {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $id = shift;
  my $params = shift;
  my $type = $params->{mime};
  my ($main_type) = split(/\//, $type, 1);
  my @types = @{$server->{wiki_mime_type}};
  if (not $type) {
    $log->debug("Uploads require a MIME type");
    $stream->write("59 Uploads require a MIME type\r\n");
    $stream->close_gracefully();
    return;
  } elsif ($type ne "text/plain" and not grep(/^$type$/, @types) and not grep(/^$main_type$/, @types)) {
    $log->debug("This wiki does not allow $type");
    $stream->write("59 This wiki does not allow $type\r\n");
    $stream->close_gracefully();
    return;
  }
  return 1;
}

sub valid_size {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $id = shift;
  my $params = shift;
  my $size = $params->{size};
  if ($size !~ /^\d+$/) {
    $log->debug("You need to send along the number of bytes, not '$size'");
    $stream->write("59 You need to send along the number of bytes, not '$size'\r\n");
    $stream->close_gracefully();
    return;
  } elsif ($size > $server->{wiki_page_size_limit}) {
    $log->debug("This wiki does not allow more than $server->{wiki_page_size_limit} bytes per page");
    $stream->write("59 This wiki does not allow more than $server->{wiki_page_size_limit} bytes per page\r\n");
    $stream->close_gracefully();
    return;
  }
  return 1;
}

sub process_gemini {
  my ($stream, $url) = @_;
  eval {
    local $SIG{'ALRM'} = sub {
      $log->error("Timeout processing $url");
    };
    alarm(10); # timeout
    my $hosts = host_regex();
    my $port = port($stream);
    my $spaces = space_regex();
    my $reserved = reserved_regex($stream);
    $log->debug("Serving ($hosts)(?::$port)?");
    $log->debug("Spaces $spaces");
    my($scheme, $authority, $path, $query, $fragment) =
	$url =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?|;
    $log->info("Looking at $url");
    my ($host, $space, $id, $n, $style, $filter);
    if (run_extensions($stream, $url)) {
      # config file goes first
    } elsif (not $url) {
      $log->debug("The URL is empty");
      $stream->write("59 URL expected\r\n");
    } elsif (length($url) > 1024) {
      $log->debug("The URL is too long");
      $stream->write("59 The URL is too long\r\n");
    } elsif (($host, $n, $space) = $url =~ m!^(?:gemini:)?//($hosts)(:$port)?(?:/($spaces))?/(?:$reserved)$!) {
      # redirect gemini://localhost:2020/do to gemini://localhost:2020/
      # redirect gemini://localhost:2020/space/do to gemini://localhost:2020/space
      $space = space($stream, $host, $space) || "";
      $stream->write("31 gemini://$host" . ($n ? ":$port" : "") . "/$space\r\n"); # this supports "up"
    } elsif (($host, $space) = $url =~ m!^(?:gemini:)?//($hosts)(?::$port)?(?:/($spaces))?/?$!) {
      serve_main_menu($stream, $host, space($stream, $host, $space));
    } elsif (($host, $space, $n) = $url =~ m!^(?:gemini:)?//($hosts)(?::$port)?(?:/($spaces))?/do/more(?:/(\d+))?$!) {
      serve_blog($stream, $host, space($stream, $host, $space), $n);
    } elsif (($host, $space) = $url =~ m!^(?:gemini:)?//($hosts)(?::$port)?(?:/($spaces))?/do/index$!) {
      serve_index($stream, $host, space($stream, $host, $space));
    } elsif (($host, $space) = $url =~ m!^(?:gemini:)?//($hosts)(?::$port)?(?:/($spaces))?/do/files$!) {
      serve_files($stream, $host, space($stream, $host, $space));
    } elsif (($host) = $url =~ m!^(?:gemini:)?//($hosts)(?::$port)?(?:/($spaces))?/do/spaces$!) {
      serve_spaces($stream, $host, $port);
    } elsif (($host, $space) = $url =~ m!^(?:gemini:)?//($hosts)(?::$port)?(?:/($spaces))?/do/data$!) {
      serve_data($stream, $host, space($stream, $host, $space));
    } elsif ($url =~ m!^(?:gemini:)?//($hosts)(?::$port)?/do/source$!) {
      success($stream, 'text/plain; charset=UTF-8');
      seek DATA, 0, 0;
      local $/ = undef; # slurp
      $stream->write(encode_utf8 <DATA>);
    } elsif ($url =~ m!^(?:gemini:)?//($hosts)(?::$port)?(?:/($spaces))?/do/match$!) {
      $stream->write("10 Find page by name (Perl regex)\r\n");
    } elsif ($query and ($host, $space) = $url =~ m!^(?:gemini:)?//($hosts)(?::$port)?(?:/($spaces))?/do/match\?!) {
      serve_match($stream, $host, map {decode_utf8(uri_unescape($_))} $space, $query);
    } elsif ($url =~ m!^(?:gemini:)?//($hosts)(?::$port)?(?:/($spaces))?/do/search$!) {
      $stream->write("10 Find page by content (Perl regex)\r\n");
    } elsif ($query and ($host, $space) = $url =~ m!^(?:gemini:)?//($hosts)(?::$port)?(?:/($spaces))?/do/search\?!) {
      serve_search($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($query))); # search terms include spaces
    } elsif ($url =~ m!^(?:gemini:)?//($hosts)(?::$port)?(?:/($spaces))?/do/new$!) {
      $stream->write("10 New page\r\n");
      # no URI escaping required
    } elsif ($query and ($host, $space) = $url =~ m!^(?:gemini:)?//($hosts)(?::$port)?(?:/($spaces))?/do/new\?!) {
      if ($space) {
	$stream->write("30 gemini://$host:$port/$space/raw/$query\r\n");
      } else {
	$stream->write("30 gemini://$host:$port/raw/$query\r\n");
      }
    } elsif (($host, $space, $n, $style) = $url =~ m!^(?:gemini:)?//($hosts)(?::$port)?(?:/($spaces))?/do/changes(?:/(\d+))?(?:/(colour|fancy))?$!) {
      serve_changes($stream, $host, space($stream, $host, $space), $n||100, $style);
    } elsif (($host, $filter, $n, $style) = $url =~ m!^(?:gemini:)?//($hosts)(?::$port)?/do/all(?:/(latest))?/changes(?:/(\d+))?(?:/(colour|fancy))?$!) {
      serve_all_changes($stream, $host, $n||100, $style||"", $filter||"");
    } elsif (($host, $space) = $url =~ m!^(?:gemini:)?//($hosts)(?::$port)?(?:/($spaces))?/do/rss$!) {
      serve_rss($stream, $host, space($stream, $host, $space));
    } elsif (($host, $space) = $url =~ m!^(?:gemini:)?//($hosts)(?::$port)?(?:/($spaces))?/do/blog/rss$!) {
      serve_blog_rss($stream, $host, space($stream, $host, $space));
    } elsif (($host, $space) = $url =~ m!^(?:gemini:)?//($hosts)(?::$port)?(?:/($spaces))?/do/atom$!) {
      serve_atom($stream, $host, space($stream, $host, $space));
    } elsif (($host, $space) = $url =~ m!^(?:gemini:)?//($hosts)(?::$port)?(?:/($spaces))?/do/blog/atom$!) {
      serve_blog_atom($stream, $host);
    } elsif (($host, $space) = $url =~ m!^(?:gemini:)?//($hosts)(?::$port)?(?:/($spaces))?/do/all/atom$!) {
      serve_all_atom($stream, $host);
    } elsif (($host) = $url =~ m!^(?:gemini:)?//($hosts)(?::$port)?/robots.txt(?:[#?].*)?$!) {
      serve_raw($stream, $host, undef, "robots");
    } elsif (($host, $space, $id, $n, $style) = $url =~ m!^(?:gemini:)?//($hosts)(?::$port)?(?:/($spaces))?/history/([^/]*)(?:/(\d+))?(?:/(colour|fancy))?$!) {
      serve_history($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)), $n||10, $style);
    } elsif (($host, $space, $id, $n, $style) = $url =~ m!^(?:gemini:)?//($hosts)(?::$port)?(?:/($spaces))?/diff/([^/]*)(?:/(\d+))?(?:/(colour))?$!) {
      serve_diff($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)), $n, $style);
    } elsif (($host, $space, $id, $n) = $url =~ m!^(?:gemini:)?//($hosts)(?::$port)?(?:/($spaces))?/raw/([^/]*)(?:/(\d+))?$!) {
      serve_raw($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)), $n);
    } elsif (($host, $space, $id, $n) = $url =~ m!^(?:gemini:)?//($hosts)(?::$port)?(?:/($spaces))?/html/([^/]*)(?:/(\d+))?$!) {
      serve_html($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)), $n);
    } elsif (($host, $space, $id, $n) = $url =~ m!^(?:gemini:)?//($hosts)(?::$port)?(?:/($spaces))?/page/([^/]+)(?:/(\d+))?$!) {
      serve_page($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)), $n);
    } elsif (($host, $space, $id) = $url =~ m!^(?:gemini:)?//($hosts)(?::$port)?(?:/($spaces))?/file/([^/]+)?$!) {
      serve_file($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)));
    } elsif (($host) = $url =~ m!^(?:gemini:)?//($hosts)(?::$port)?(/|$)!) {
      $log->info("Unknown path for $url\r");
      $stream->write("51 Path not found for $url\r\n");
    } elsif ($authority) {
      $log->info("Unsupported proxy request for $url");
      $stream->write("53 Unsupported proxy request for $url\r\n");
    } else {
      $log->info("No handler for $url");
      $stream->write("59 Don't know how to handle $url\r\n");
    }
    $log->debug("Done");
  };
  $log->error("Error: $@") if $@;
  alarm(0);
  $stream->close_gracefully();
}

__DATA__
