-# gemyer
+# sula
+
+> `/'su.la/` for the suffix of capsule in Spanish, Cápsula.
<center>
<img src="logo.png" alt="logo" width="300"/>
</center>
-
A [Gemini](https://geminiprotocol.net/) protocol server written in
[Scryer Prolog](https://www.scryer.pl).
## Requirements
-gemyer depends on a patched Scryer Prolog (see `scryer-prolog/`, included as a
-submodule/symlink). The required patches are:
+sula depends on a patched Scryer Prolog which can be found
+[here](https://gitea.sagredo.dev/javier/scryer-prolog). The required patches
+are:
- A native `'$copy_stream'/2` builtin used for streaming binary file bodies to
TLS clients without materialising the contents on the Prolog heap.
- A non-blocking poll loop in `socket_server_accept/4` that checks Scryer's
`INTERRUPT` flag, so `SIGINT` becomes a catchable `'$interrupt_thrown'`
exception instead of being trapped behind a blocking syscall.
+- A port to `rustls`.
+- A modification of `tls_server_negotiate` to include the optional client
+certificate.
Build and install the patched Scryer:
```
cd scryer-prolog
cargo install --path .
```
## Running
```
-./gemyer.pl --addr HOST:PORT --hostname NAME --content DIR --certs DIR
+./sula.pl --addr HOST:PORT --hostname NAME --content DIR --certs DIR
```
-`gemyer.pl` is a polyglot script: bash detects `scryer-prolog` on `PATH` and
-execs it with `gemyer:run, halt` as the entry goal.
+`sula.pl` is a polyglot script: bash detects `scryer-prolog` on `PATH` and
+execs it with `sula:run, halt` as the entry goal.
Example:
```
-./gemyer.pl \
+./sula.pl \
--addr 127.0.0.1:1965 \
--hostname gmi.example.dev \
--content ./site \
All options accept any order. Anything unrecognised is silently dropped.
-| Option | Meaning | Default |
-| ------------------- | ----------------------------------------------------------------------- | ------------------ |
-| `--addr HOST:PORT` | Bind address and port for the listening socket | `127.0.0.1:1965` |
-| `--hostname NAME` | Expected `CN` of the certificate. Startup aborts on mismatch | `localhost` |
-| `--content DIR` | Root directory for served files | `./site` |
-| `--certs DIR` | Directory containing `identity.p12` (PKCS#12 with cert + key) | `.` |
-
-The cert file is expected at `<--certs>/identity.p12`. Generate one with:
-
-```
-openssl req -x509 -newkey rsa:2048 -keyout key.pem -out cert.pem -days 365 \
- -nodes -subj "/CN=gmi.example.dev"
-openssl pkcs12 -export -out identity.p12 -inkey key.pem -in cert.pem -passout pass:
-```
+| Option | Meaning | Default |
+|--------------------|--------------------------------------------------------------|------------------|
+| `--addr HOST:PORT` | Bind address and port for the listening socket | `127.0.0.1:1965` |
+| `--hostname NAME` | Expected `CN` of the certificate. Startup aborts on mismatch | `localhost` |
+| `--content DIR` | Root directory for served files | `./site` |
+| `--certs DIR` | Directory containing `cert.pem` and `key.pem` | `.` |
### Stopping the server
## Features
-- TLS via `native-tls`, PKCS#12 identity files.
+- TLS via `rustls`, PKCS#12 identity files.
- Hostname verification: at startup, `cert_is_for_hostname/2` shells out to
- `openssl pkcs12` and asserts the cert's `CN` matches `--hostname`.
+ `openssl x509` and asserts the cert's `CN` matches `--hostname`.
- Content negotiation by extension via `mime/2`, populated at startup from
`/etc/mime.types` (parsed by a DCG in `mime.pl`). `text/gemini` is added
for `.gmi`.
## Layout
```
-gemyer.pl Polyglot launcher + main gemyer module (run/0, request loop).
+sula.pl Polyglot launcher + main sula module (run/0, request loop).
config.pl CLI parsing (DCG) and config accessors (cert/1, addr/1, ...).
cert.pl Certificate loading + hostname-vs-CN check.
mime.pl /etc/mime.types parser (DCG) and mime/2 facts.
response.pl Response status code DCG.
log.pl Tagged log_msg/3.
banner.pl Reads banner.txt and emits it line-by-line via display_banner/1.
-banner.txt ASCII-art banner printed at startup.
```
+
+## Planned features
+
+- [x] Use key and cert instead of identity.p12
+- [x] Client certificates
+- [ ] Load configuration from a configuration file
+- [ ] Run CGI scripts
- ░▒▓██████▓▒░░▒▓████████▓▒░▒▓██████████████▓▒░░▒▓█▓▒░░▒▓█▓▒░▒▓████████▓▒░▒▓███████▓▒░
-░▒▓█▓▒░░▒▓█▓▒░▒▓█▓▒░ ░▒▓█▓▒░░▒▓█▓▒░░▒▓█▓▒░▒▓█▓▒░░▒▓█▓▒░▒▓█▓▒░ ░▒▓█▓▒░░▒▓█▓▒░
-░▒▓█▓▒░ ░▒▓█▓▒░ ░▒▓█▓▒░░▒▓█▓▒░░▒▓█▓▒░▒▓█▓▒░░▒▓█▓▒░▒▓█▓▒░ ░▒▓█▓▒░░▒▓█▓▒░
-░▒▓█▓▒▒▓███▓▒░▒▓██████▓▒░ ░▒▓█▓▒░░▒▓█▓▒░░▒▓█▓▒░░▒▓██████▓▒░░▒▓██████▓▒░ ░▒▓███████▓▒░
-░▒▓█▓▒░░▒▓█▓▒░▒▓█▓▒░ ░▒▓█▓▒░░▒▓█▓▒░░▒▓█▓▒░ ░▒▓█▓▒░ ░▒▓█▓▒░ ░▒▓█▓▒░░▒▓█▓▒░
-░▒▓█▓▒░░▒▓█▓▒░▒▓█▓▒░ ░▒▓█▓▒░░▒▓█▓▒░░▒▓█▓▒░ ░▒▓█▓▒░ ░▒▓█▓▒░ ░▒▓█▓▒░░▒▓█▓▒░
- ░▒▓██████▓▒░░▒▓████████▓▒░▒▓█▓▒░░▒▓█▓▒░░▒▓█▓▒░ ░▒▓█▓▒░ ░▒▓████████▓▒░▒▓█▓▒░░▒▓█▓▒░
+ ░▒▓███████▓▒░▒▓█▓▒░░▒▓█▓▒░▒▓█▓▒░ ░▒▓██████▓▒░
+░▒▓█▓▒░ ░▒▓█▓▒░░▒▓█▓▒░▒▓█▓▒░ ░▒▓█▓▒░░▒▓█▓▒░
+░▒▓█▓▒░ ░▒▓█▓▒░░▒▓█▓▒░▒▓█▓▒░ ░▒▓█▓▒░░▒▓█▓▒░
+ ░▒▓██████▓▒░░▒▓█▓▒░░▒▓█▓▒░▒▓█▓▒░ ░▒▓████████▓▒░
+ ░▒▓█▓▒░▒▓█▓▒░░▒▓█▓▒░▒▓█▓▒░ ░▒▓█▓▒░░▒▓█▓▒░
+ ░▒▓█▓▒░▒▓█▓▒░░▒▓█▓▒░▒▓█▓▒░ ░▒▓█▓▒░░▒▓█▓▒░
+░▒▓███████▓▒░ ░▒▓██████▓▒░░▒▓████████▓▒░▒▓█▓▒░░▒▓█▓▒░
+
load_existing_certificate(Context) :-
cert(Cert),
+ key(Key),
hostname(Hostname),
- log_msg("tls", "Loading certificate from `~s`~n", [Cert]),
+ log_msg("tls", "Loading certificate `~s` and key `~s`~n", [Cert, Key]),
file_exists(Cert),
( cert_is_for_hostname(Cert, Hostname) ;
append(Cert, ".bak", Cert1),
- log_msg("error", "Certificate `~s` is not for hostname `~s`. Renaming it to `~s`~n", [Cert, Hostname, Cert1]),
+ append(Key, ".bak", Key1),
+ log_msg("error", "Certificate `~s` is not for hostname `~s`. Renaming it to `~s` (also `~s` to `~s`)~n", [Cert, Hostname, Cert1, Key, Key1]),
rename_file(Cert, Cert1),
+ rename_file(Key, Key1),
fail
),
- phrase_from_file(seq(Chars), Cert, [type(binary)]),
- tls_server_context(Context, [pcks12(Chars)]),
+ phrase_from_file(seq(CharsCert), Cert, [type(binary)]),
+ phrase_from_file(seq(CharsKey), Key, [type(binary)]),
+ tls_server_context(Context, [certificate(CharsCert), key(CharsKey)]),
log_msg("tls", "Loaded certificate~n", []).
cert_is_for_hostname(Cert, Hostname) :-
process_create("openssl",
- ["pkcs12", "-in", Cert, "-nokeys", "-passin", "pass:"],
- [stdin(null), stdout(pipe(S)), stderr(null), process(P)]
- ),
+ ["x509", "-in", Cert, "-noout", "-subject"],
+ [stdin(null), stdout(pipe(S)), stderr(null), process(P)]
+ ),
process_wait(P, _),
phrase_from_stream(cn(Hostname), S).
log_msg("tls", "Generating new certificate for host `~s`~n", [Hostname]),
append("/CN=", Hostname, Hostname1),
process_create("openssl",
- ["req", "-x509", "-newkey", "rsa:4096", "-nodes", "-keyout", "key.pem", "-out", "cert.pem", "-days", "365", "-subj", Hostname1],
+ ["req", "-x509", "-newkey", "rsa:4096", "-nodes", "-keyout", "key.pem", "-out", "cert.pem", "-days", "2900000", "-subj", Hostname1],
[stdin(null), stdout(null), stderr(null), process(P0)]
),
process_wait(P0, _),
cert(Cert),
- process_create("openssl",
- ["pkcs12", "-export", "-out", Cert, "-inkey", "key.pem", "-in", "cert.pem", "-passout", "pass:"],
- [stdin(null), stdout(null), stderr(null), process(P1)]
- ),
- process_wait(P1, _),
- delete_file("key.pem"),
- delete_file("cert.pem"),
- log_msg("tls", "Generated new certificate: `~s`~n", [Cert]),
+ cert(Key),
+ log_msg("tls", "Generated new certificate `~s` and key `~s`~n", [Cert, Key]),
load_existing_certificate(Context).
:- meta_predicate(with_tls_connection(?, ?, 1)).
-%% with_tls_connection(+Stream, +Context, +F_1)
+%% with_tls_connection(+Stream, +Context, +F_2)
%
-% Open a TLS connection on Stream with Context and pass it to F_1
+% Open a TLS connection on Stream with Context and pass it to F_2
with_tls_connection(S0, Context, Kont) :-
setup_call_cleanup(
( log_msg("tls-conn", "Received connection, authenticating TLS~n", []),
- tls_server_negotiate(Context, S0, S)
+ tls_server_negotiate(Context, S0, S, ClientCert),
+ log_msg("tls-conn", "Client cert ~q~n", [ClientCert])
),
- call(Kont, S),
+ call(Kont, S, ClientCert),
( log_msg("tls-conn", "Closing TLS stream~n", []),
close(S)
)
-:- module(config, [cert/1, addr/1, port/1, content/1, hostname/1]).
+:- module(config, [cert/1, key/1, addr/1, port/1, content/1, hostname/1]).
:- use_module(library(os)).
:- use_module(library(iso_ext)).
:- initialization(load_config).
%% Defaults — applied first, then overridden by any CLI args.
-default(cert, "./identity.p12").
+default(cert, "./cert.pem").
+default(key, "./key.pem").
default(addr, '127.0.0.1').
default(port, 1965).
default(content, "./site").
% Public accessors are static rules over the dynamic cfg/2, so they remain
% importable via use_module/1 even as values get retracted/asserted.
cert(V) :- cfg(cert, V).
+key(V) :- cfg(key, V).
addr(V) :- cfg(addr, V).
port(V) :- cfg(port, V).
content(V) :- cfg(content, V).
apply_opt(port(P)) :- set_cfg(port, P).
apply_opt(hostname(H)) :- set_cfg(hostname, H).
apply_opt(content(C)) :- set_cfg(content, C).
-apply_opt(certs(D)) :- append(D, "/identity.p12", Cert), set_cfg(cert, Cert).
+apply_opt(certs(D)) :- append(D, "/cert.pem", Cert), set_cfg(cert, Cert),
+ append(D, "/key.pem", Key), set_cfg(key, Key) .
apply_opt(unknown(_)).
set_cfg(Key, Value) :-
set -eu
type scryer-prolog > /dev/null 2> /dev/null \
- && exec scryer-prolog -f -g "gemyer:run, halt" "$0" -- "$@"
+ && exec scryer-prolog -f -g "sula:run, halt" "$0" -- "$@"
echo "No known supported Prolog implementation available in PATH."
echo "Try to install Scryer Prolog."
exit 1
#*/
-:- module(gemyer, [run/0]).
+:- module(sula, [run/0]).
:- use_module(cert).
:- use_module(banner).
% log_msg("debug", "Re-throwing from conn loop: ~q~n", [Error]),
throw(Error).
-req_serve(S) :-
+req_serve(S, ClientCert) :-
read_request(S, Path, Query),
serve(S, Path, Query),
!.
projects / sula.git / commitdiff