From c39321a73f4abe85673df3587ef46280cdfcc7ef Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Mon, 1 Jun 2026 00:56:03 +0200 Subject: [PATCH] Renaming, client certificates --- README.md | 56 ++++++++++++++++++++++++-------------------- banner.txt | 15 ++++++------ cert.pl | 39 +++++++++++++++--------------- config.pl | 9 ++++--- gemyer.pl => sula.pl | 6 ++--- 5 files changed, 66 insertions(+), 59 deletions(-) rename gemyer.pl => sula.pl (95%) diff --git a/README.md b/README.md index 4fd7c22..c288093 100644 --- a/README.md +++ b/README.md @@ -1,17 +1,19 @@ -# gemyer +# sula + +> `/'su.la/` for the suffix of capsule in Spanish, Cápsula.
logo
- 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. @@ -21,10 +23,14 @@ submodule/symlink). The required patches are: - 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: ``` +git clone git@gitea.sagredo.dev:javier/scryer-prolog -b js/fixes cd scryer-prolog cargo install --path . ``` @@ -36,16 +42,16 @@ configured hostname. ## 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 \ @@ -56,20 +62,12 @@ Example: 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 @@ -78,9 +76,9 @@ top-level catch logs `Shutting down`, and the process exits 0. ## 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`. @@ -95,7 +93,7 @@ top-level catch logs `Shutting down`, and the process exits 0. ## 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. @@ -105,5 +103,11 @@ ip.pl IP address recognition (rejected as Gemini hosts). 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 diff --git a/banner.txt b/banner.txt index b5d2019..1002ff0 100644 --- a/banner.txt +++ b/banner.txt @@ -1,7 +1,8 @@ - ░▒▓██████▓▒░░▒▓████████▓▒░▒▓██████████████▓▒░░▒▓█▓▒░░▒▓█▓▒░▒▓████████▓▒░▒▓███████▓▒░ -░▒▓█▓▒░░▒▓█▓▒░▒▓█▓▒░ ░▒▓█▓▒░░▒▓█▓▒░░▒▓█▓▒░▒▓█▓▒░░▒▓█▓▒░▒▓█▓▒░ ░▒▓█▓▒░░▒▓█▓▒░ -░▒▓█▓▒░ ░▒▓█▓▒░ ░▒▓█▓▒░░▒▓█▓▒░░▒▓█▓▒░▒▓█▓▒░░▒▓█▓▒░▒▓█▓▒░ ░▒▓█▓▒░░▒▓█▓▒░ -░▒▓█▓▒▒▓███▓▒░▒▓██████▓▒░ ░▒▓█▓▒░░▒▓█▓▒░░▒▓█▓▒░░▒▓██████▓▒░░▒▓██████▓▒░ ░▒▓███████▓▒░ -░▒▓█▓▒░░▒▓█▓▒░▒▓█▓▒░ ░▒▓█▓▒░░▒▓█▓▒░░▒▓█▓▒░ ░▒▓█▓▒░ ░▒▓█▓▒░ ░▒▓█▓▒░░▒▓█▓▒░ -░▒▓█▓▒░░▒▓█▓▒░▒▓█▓▒░ ░▒▓█▓▒░░▒▓█▓▒░░▒▓█▓▒░ ░▒▓█▓▒░ ░▒▓█▓▒░ ░▒▓█▓▒░░▒▓█▓▒░ - ░▒▓██████▓▒░░▒▓████████▓▒░▒▓█▓▒░░▒▓█▓▒░░▒▓█▓▒░ ░▒▓█▓▒░ ░▒▓████████▓▒░▒▓█▓▒░░▒▓█▓▒░ + ░▒▓███████▓▒░▒▓█▓▒░░▒▓█▓▒░▒▓█▓▒░ ░▒▓██████▓▒░ +░▒▓█▓▒░ ░▒▓█▓▒░░▒▓█▓▒░▒▓█▓▒░ ░▒▓█▓▒░░▒▓█▓▒░ +░▒▓█▓▒░ ░▒▓█▓▒░░▒▓█▓▒░▒▓█▓▒░ ░▒▓█▓▒░░▒▓█▓▒░ + ░▒▓██████▓▒░░▒▓█▓▒░░▒▓█▓▒░▒▓█▓▒░ ░▒▓████████▓▒░ + ░▒▓█▓▒░▒▓█▓▒░░▒▓█▓▒░▒▓█▓▒░ ░▒▓█▓▒░░▒▓█▓▒░ + ░▒▓█▓▒░▒▓█▓▒░░▒▓█▓▒░▒▓█▓▒░ ░▒▓█▓▒░░▒▓█▓▒░ +░▒▓███████▓▒░ ░▒▓██████▓▒░░▒▓████████▓▒░▒▓█▓▒░░▒▓█▓▒░ + diff --git a/cert.pl b/cert.pl index 082556b..f3d4d2c 100644 --- a/cert.pl +++ b/cert.pl @@ -18,24 +18,28 @@ load_certificate(Context) :- 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). @@ -46,34 +50,29 @@ create_new_certificate(Context) :- 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) ) diff --git a/config.pl b/config.pl index fe60a4d..8abbe1d 100644 --- a/config.pl +++ b/config.pl @@ -1,4 +1,4 @@ -:- 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)). @@ -10,7 +10,8 @@ :- 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"). @@ -19,6 +20,7 @@ default(hostname, "localhost"). % 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). @@ -63,7 +65,8 @@ apply_opt(addr(A)) :- set_cfg(addr, A). 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) :- diff --git a/gemyer.pl b/sula.pl similarity index 95% rename from gemyer.pl rename to sula.pl index 83165d2..17ab2bc 100755 --- a/gemyer.pl +++ b/sula.pl @@ -3,14 +3,14 @@ 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). @@ -88,7 +88,7 @@ handle_conn_error(Error) :- % 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), !. -- 2.54.0