From: Javier Sagredo Date: Thu, 25 Jun 2026 23:34:01 +0000 (+0200) Subject: Proper parsing of redirects and cgi from config X-Git-Url: https://git.sagredo.dev/?a=commitdiff_plain;p=sula.git Proper parsing of redirects and cgi from config --- diff --git a/README.md b/README.md index 13f4e3c..af86d1c 100644 --- a/README.md +++ b/README.md @@ -111,8 +111,8 @@ banner.pl Reads banner.txt and emits it line-by-line via display_banner/1. - [x] Client certificates - [x] Load configuration from a configuration file - [x] Save and load users -- [ ] Run CGI scripts -- [ ] All status codes +- [x] Run CGI scripts (almost done) +- [-] All status codes - [ ] Rate limiting - [ ] Virtual hosting - [ ] File logging diff --git a/a.sh b/a.sh deleted file mode 100755 index 772052e..0000000 --- a/a.sh +++ /dev/null @@ -1,23 +0,0 @@ -#!/bin/bash - -printf "20 text/gemini\r\nHello from CGI\n" - -echo "GATEWAY_INTERFACE=$GATEWAY_INTERFACE" -echo "SCRIPT_NAME=$SCRIPT_NAME" -echo "SERVER_SOFTWARE=$SERVER_SOFTWARE" -echo "SERVER_PROTOCOL=$SERVER_PROTOCOL" -echo "PATH_INFO=$PATH_INFO" -echo "SERVER_NAME=$SERVER_NAME" -echo "SERVER_PORT=$SERVER_PORT" -echo "GEMINI_URL=$GEMINI_URL" -echo "GEMINI_URL_PATH=$GEMINI_URL_PATH" -echo "REMOTE_ADDR=$REMOTE_ADDR" -echo "REMOTE_HOST=$REMOTE_HOST" -echo "REMOTE_PORT=$REMOTE_PORT" -echo "QUERY_STRING=" -echo "$QUERY_STRING" | tr '&' '\n' | sed 's/^/- /' | sed 's/=/ → /g' -echo "GEMINI_QUERY_STRING=" -echo "$GEMINI_QUERY_STRING" | tr '&' '\n' | sed 's/^/- /' | sed 's/=/ → /g' -echo "AUTH_TYPE=$AUTH_TYPE" -echo "REMOTE_USER=$REMOTE_USER" -echo "REMOTE_IDENT=$REMOTE_IDENT" diff --git a/cgi.pl b/cgi.pl index 17100a4..83e341f 100644 --- a/cgi.pl +++ b/cgi.pl @@ -69,6 +69,7 @@ tls_env(none, Env) :- "REMOTE_IDENT"="" ], !. +% TODO: Need this from rustls tls_env(_, Env) :- Env = [ "AUTH_TYPE"="Certificate", "REMOTE_USER"="TODO", diff --git a/clients.pl b/clients.pl index 071af20..429a792 100644 --- a/clients.pl +++ b/clients.pl @@ -1,6 +1,7 @@ :- module(clients, [save_client/1, load_clients/0]). :- use_module(library(files)). +:- use_module(library(crypto)). :- use_module(library(iso_ext)). :- use_module(library(pio)). :- use_module(ui/log). @@ -29,17 +30,18 @@ read_clients(Stream) :- save_client(none) :- !. save_client(ClientCert) :- - known_client(ClientCert), - !, - log_msg("clients", "Known client ~q", [ClientCert]) - ; - log_msg("clients", "Registering new client with cert ~q", [ClientCert]), - setup_call_cleanup( - open("clients_db.pl", append, S), - (write(S, known_client(ClientCert)), - put_char(S, (.)), - put_char(S, '\n') - ), - close(S) - ), - assertz(known_client(ClientCert)). + hex_bytes(Hex, ClientCert), + ( known_client(ClientCert), + !, + log_msg("clients", "Known client ~s", [Hex]) + ; log_msg("clients", "Registering new client with cert ~s", [Hex]), + setup_call_cleanup( + open("clients_db.pl", append, S), + (write(S, known_client(ClientCert)), + put_char(S, (.)), + put_char(S, '\n') + ), + close(S) + ), + assertz(known_client(ClientCert)) + ). diff --git a/config.pl b/config.pl index c493d61..f0a38ca 100644 --- a/config.pl +++ b/config.pl @@ -4,10 +4,14 @@ addr/1, port/1, content/1, - hostname/1 + hostname/1, + redirect/4, + cgi/2 ]). +:- use_module(library(charsio)). :- use_module(library(dcgs)). +:- use_module(library(clpz)). :- use_module(library(files)). :- use_module(library(iso_ext)). :- use_module(library(lists)). @@ -17,14 +21,6 @@ :- dynamic(cfg/2). -%% Defaults — applied first, then overridden by any CLI args. -default(cert, "./cert.pem"). -default(key, "./key.pem"). -default(addr, '127.0.0.1'). -default(port, "1965"). -default(content, "./site"). -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). @@ -33,6 +29,8 @@ addr(V) :- cfg(addr, V). port(V) :- cfg(port, V). content(V) :- cfg(content, V). hostname(V) :- cfg(hostname, V). +redirect(From, To, Mode, KeepQuery) :- cfg(redirect, redirect(From, To, Mode, KeepQuery)). +cgi(Path, Script) :- cfg(cgi, cgi(Path, Script)). %% load_config. % @@ -40,10 +38,11 @@ hostname(V) :- cfg(hostname, V). % (everything after `--`) via os:argv/1 and updates the config facts. Recognised % options, accepted in any order: % -% --addr HOST:PORT bind address and port +% --addr HOST bind address +% --port PORT bind port % --hostname NAME server hostname % --content DIR content root directory -% --certs DIR certificate directory (expects DIR/identity.p12) +% --certs DIR certificate directory (expects DIR/{cert.pem, key.pem}) % % Unrecognised arguments are ignored. load_config :- @@ -51,10 +50,19 @@ load_config :- once(load_config_file), once(load_cli_args). +%% Defaults — applied first, then overridden by any CLI or file args. install_defaults :- retractall(cfg(_, _)), forall(default(K, V), assertz(cfg(K, V))). +default(cert, "./cert.pem"). +default(key, "./key.pem"). +default(addr, '127.0.0.1'). +default(port, "1965"). +default(content, "./site"). +default(hostname, "localhost"). + +% Parse CLI options load_cli_args :- argv(Args), phrase(options(Opts), Args), @@ -70,6 +78,7 @@ option(content(C)) --> ["--content", C]. option(certs(D)) --> ["--certs", D]. option(unknown(X)) --> [X]. +% Applying options apply_opts([]). apply_opts([Opt|Opts]) :- apply_opt(Opt), apply_opts(Opts). @@ -79,20 +88,42 @@ apply_opt(hostname(H)) :- set_cfg(hostname, H). apply_opt(content(C)) :- set_cfg(content, C). apply_opt(certs(D)) :- append(D, "/cert.pem", Cert), set_cfg(cert, Cert), append(D, "/key.pem", Key), set_cfg(key, Key) . +apply_opt(cgi(Path, Script)) :- assertz(cfg(cgi, cgi(Path, Script))). +apply_opt(Term) :- + Term =.. [redirect, From, To, Opts], + ( permutation(Opts, [Mode, keep_query]) -> + ( mode_to_response(Mode, Mode1), + assertz(cfg(redirect, redirect(From, To, Mode1, keep_query))) + ) + ; Opts = [keep_query] -> + assertz(cfg(redirect, redirect(From, To, temporary_redirection, keep_query))) + ; Opts = [Mode] -> + mode_to_response(Mode, Mode1), + assertz(cfg(redirect, redirect(From, To, Mode1, drop_query))) + ; Opts = [] -> + assertz(cfg(redirect, redirect(From, To, temporary_redirection, drop_query))) + ). apply_opt(unknown(_)). set_cfg(Key, Value) :- retractall(cfg(Key, _)), assertz(cfg(Key, Value)). -parse_addr_port(Chars, Addr, Port) :- - append(AddrChars, [':'|PortChars], Chars), - !, - atom_chars(Addr, AddrChars), - number_chars(Port, PortChars). - -%% Loading the configuration file - +%% load_config_file +% +% Loading the configuration file +% +% Configuration file can contain multiple options +% +% ``` +% hostname("XXXXX"). +% port("NNNN"). +% addr("XXXXX"). +% content("XXXXX"). +% certs("XXXXX"). +% cgi("/XXXX", "/XXXX"). +% redirect("/XXXX", "/XXXX", Opts). % where opts can contain permanent|temporary and keep_query +% ``` load_config_file :- ( file_exists("site.pl") -> log_msg("conf", "Reading config from ~s", ["site.pl"]), @@ -114,10 +145,48 @@ read_config_terms(Stream) :- ). valid_cfg_opt(Term) :- - Term =.. [Functor, Value], + Term =.. [Functor, Value] -> ( Functor = addr, atom_si(Value) ; Functor = port, chars_si(Value) ; Functor = hostname, chars_si(Value) ; Functor = content, chars_si(Value) ; Functor = certs, chars_si(Value) - ). + ) + ; Term =.. [cgi, Path, Script] -> + maplist(chars_si, [Path, Script]), + maplist(is_path, [Path, Script]) + ; Term =.. [redirect, From, To, Opts] -> + maplist(chars_si, [From, To]), + maplist(is_path, [From, To]), + list_si(Opts), + maplist(atom_si, Opts), + maplist(mode_or_keep_query, Opts), + \+ permutation(Opts, [permanent, temporary]), + length(Opts, L), + L #< 3. + +%% Helpers +mode_to_response(Mode, Mode1) :- + atom_chars(Mode, ModeS), + append(ModeS, "_redirection", ModeS1), + atom_chars(Mode1, ModeS1). + +parse_addr_port(Chars, Addr, Port) :- + append(AddrChars, [':'|PortChars], Chars), + !, + atom_chars(Addr, AddrChars), + number_chars(Port, PortChars). + +mode_or_keep_query(permanent). +mode_or_keep_query(temporary). +mode_or_keep_query(keep_query). + +is_path(P) :- + P = ['/'|Ps], + maplist(char_or_slash, Ps). + +char_or_slash(C) :- + char_type(C, alpha). +char_or_slash('/'). +char_or_slash('-'). +char_or_slash('.'). diff --git a/routing.pl b/routing.pl index e286b16..449fdb9 100644 --- a/routing.pl +++ b/routing.pl @@ -24,9 +24,6 @@ routing(S, TcpClient, TlsClientCert) :- ) ). -redirect("/a", "/cgi-bin/a", temporary_redirection, keep_query). % TODO: parse from file -route_cgi("/cgi-bin/a", "./a.sh"). % TODO: (also should probably be relative to the root of the site?) - routing_(S, TcpClient, TlsClientCert, Uri) :- Uri = uri(_, _, Path, Query), catch(( redirect(Path, PathNew0, Mode, KeepQuery) -> @@ -36,8 +33,10 @@ routing_(S, TcpClient, TlsClientCert, Uri) :- log_msg("routing", "Redirect (~a, ~a) ~s -> ~s", [Mode, KeepQuery, Path, PathNew]), phrase(response(Mode, PathNew), Output), format(S, "~s", [Output]) - ; route_cgi(Path, Script) -> - run_cgi(Script, Uri, TcpClient, TlsClientCert, Output), + ; cgi(Path, Script) -> + content(Root), + append(Root, Script, Script1), + run_cgi(Script1, Uri, TcpClient, TlsClientCert, Output), format(S, "~s", [Output]) ; content(Root), serve(S, Root, Uri) diff --git a/sys/tls_certs.pl b/sys/tls_certs.pl index dc65e04..3617bdc 100644 --- a/sys/tls_certs.pl +++ b/sys/tls_certs.pl @@ -5,6 +5,7 @@ :- use_module(library(files)). :- use_module(library(iso_ext)). :- use_module(library(lists)). +:- use_module(library(crypto)). :- use_module(library(pio)). :- use_module(library(process)). :- use_module(library(tls)). @@ -68,7 +69,7 @@ with_tls_connection(S0, Context, TcpClient, Kont) :- setup_call_cleanup( ( log_msg("tls-conn", "Handshaking TLS", []), tls_server_negotiate(Context, S0, S, [client_certificate(ClientCert)]), - ( \+ ClientCert = none, log_msg("tls-conn", "Client cert ~q", [ClientCert]) + ( \+ ClientCert = none, hex_bytes(Hex, ClientCert), log_msg("tls-conn", "Client cert ~s", [Hex]) ; true ) ),