From: Javier Sagredo Date: Wed, 24 Jun 2026 21:15:50 +0000 (+0200) Subject: Some cleanup X-Git-Url: https://git.sagredo.dev/?a=commitdiff_plain;h=d3b5cb0d9908a483a4371a5438537ac4c9f43e25;p=sula.git Some cleanup --- diff --git a/clients.pl b/clients.pl index 9ace249..f285d54 100644 --- a/clients.pl +++ b/clients.pl @@ -8,7 +8,7 @@ :- dynamic(known_client/1). load_clients :- - log_msg("clients", "Loading client database~n", []), + log_msg("clients", "Loading client database", []), catch( setup_call_cleanup( open("clients_db.pl", read, S), @@ -30,9 +30,9 @@ read_clients(Stream) :- save_client(none). save_client(ClientCert) :- known_client(ClientCert), - log_msg("clients", "Known client ~q~n", [ClientCert]) + log_msg("clients", "Known client ~q", [ClientCert]) ; - log_msg("clients", "Registering new client with cert ~q~n", [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)), diff --git a/config.pl b/config.pl index e8c7372..8ae3808 100644 --- a/config.pl +++ b/config.pl @@ -95,7 +95,7 @@ parse_addr_port(Chars, Addr, Port) :- load_config_file :- ( file_exists("site.pl") - -> log_msg("conf", "Reading config from ~s~n", ["site.pl"]), + -> log_msg("conf", "Reading config from ~s", ["site.pl"]), open("site.pl", read, Stream), read_config_terms(Stream), close(Stream) diff --git a/constants.pl b/constants.pl new file mode 100644 index 0000000..3122aa6 --- /dev/null +++ b/constants.pl @@ -0,0 +1,3 @@ +:- module(constants, [version/1]). + +version(v(0, 1, 0)). diff --git a/dcgs/gemini_uri.pl b/dcgs/gemini_uri.pl index 2121d55..17dae0e 100644 --- a/dcgs/gemini_uri.pl +++ b/dcgs/gemini_uri.pl @@ -14,11 +14,10 @@ gemini_uri(Host, Port, Path, Query) --> query(Query). host(Host) --> - reg_name(Chars), + reg_name(Host), { % IP addresses are disallowed on the host - \+ phrase(ip_address, Chars), - atom_chars(Host, Chars) + \+ phrase(ip_address, Host) }. % reg-name = *( unreserved / pct-encoded / sub-delims ) @@ -33,7 +32,7 @@ port_opt(Port) --> ":", digits(Chars), { number_chars_(Port, Chars) }. -port_opt(none) --> []. +port_opt(1965) --> []. digits([C|Cs]) --> [C], { char_type(C, decimal_digit) }, !, digits(Cs). digits([]) --> []. diff --git a/request.pl b/request.pl index eaefdec..da6d9f1 100644 --- a/request.pl +++ b/request.pl @@ -1,4 +1,4 @@ -:- module(request, [read_request/3]). +:- module(request, [read_request/2]). :- use_module(config). :- use_module(dcgs/gemini_uri). @@ -12,21 +12,22 @@ %% read_request(+Stream, -Path, -Query) % % Read a request from Stream and get the Path and Query parts -read_request(Stream, Path, Query) :- +read_request(Stream, uri(Hostname, Port, Path, Query)) :- read_request_(Stream, Chars), log_msg("request", "Received raw request: ~s", [Chars]), once( ( phrase(request(uri(Hostname, Port, Path, Query)), Chars) - ; throw(gemini_error(bad_request, "Malformed request")) + ; log_msg("error", "Malformed request", []), + throw(gemini_error(bad_request, "Malformed request")) ) ), once( ( is_absolute(Path) - ; log_msg("error", "Non-absolute path requested~n", []), + ; log_msg("error", "Non-absolute path requested", []), throw(gemini_error(bad_request, "Non-absolute paths are forbidden")) ) ), ( hostname(Hostname), port(Port) - ; log_msg("error", "Received request for an unknown hostname!~n", []), + ; log_msg("error", "Received request for an unknown hostname!", []), throw(gemini_error(bad_request, "This request is not for me!")) ). diff --git a/serve.pl b/serve.pl index 80bbbb2..3a7d14e 100644 --- a/serve.pl +++ b/serve.pl @@ -1,4 +1,4 @@ -:- module(serve, [serve/4]). +:- module(serve, [serve/3]). :- use_module(config). :- use_module(dcgs/response). @@ -12,20 +12,20 @@ :- use_module(sys/mime). :- use_module(ui/log). -%% serve(+Stream, +Root, +Path, -Query) +%% serve(+Stream, +Root, +Path, +Query) % % Serve the file at Path to Stream -serve(S, Root, "/", Q) :- - serve(S, Root, "/index.gmi", Q). -serve(S, Root, Path, _) :- +serve(S, Root, uri(Hostname, Port, "/", Query)) :- + serve(S, Root, uri(Hostname, Port, "/index.gmi", Query)). +serve(S, Root, uri(_, _, Path, _)) :- guess_mime(Path, Mime), append(Root, Path, File), once( ( file_exists(File) - ; log_msg("error", "File not found~n", []), + ; log_msg("error", "File not found", []), throw(gemini_error(not_found, "File not found!")) ) ), - log_msg("response", "File does exist~n", []), + log_msg("response", "File does exist", []), once( ( serve_text(S, Mime, File) ; serve_binary(S, Mime, File) ) @@ -34,24 +34,24 @@ serve(S, Root, Path, _) :- serve_text(S, Mime, File) :- append("text/", _, Mime), phrase_from_file(seq(Body), File), - log_msg("response", "Sending text response~n", []), + log_msg("response", "Sending text response", []), phrase(response(success, Mime), Response0), format(S, "~s", [Response0]), format(S, "~s", [Body]), - log_msg("response", "Sent text response~n", []). + log_msg("response", "Sent text response", []). serve_binary(S, Mime, File) :- setup_call_cleanup( open(File, read, FileStream, [type(binary)]), ( - log_msg("response", "Sending binary response~n", []), + log_msg("response", "Sending binary response", []), phrase(response(success, Mime), Response0), format(S, "~s", [Response0]), open(stream(S), write, _, [type(binary)]), catch(copy_stream(FileStream, S), error(existence_error(stream, _), _), - log_msg("response", "Client disconnected mid-stream~n", [])), - log_msg("response", "Sent binary response~n", []) + log_msg("response", "Client disconnected mid-stream", [])), + log_msg("response", "Sent binary response", []) ), close(FileStream) ). diff --git a/sula.pl b/sula.pl index 93b52a1..27275d4 100755 --- a/sula.pl +++ b/sula.pl @@ -31,57 +31,61 @@ exit 1 :- use_module(ui/banner). :- use_module(ui/log). +version(0, 1). + run :- once(display_banner), + version(Major, Minor), + log_msg("system", "Version ~d.~d", [Major, Minor]), once(load_config), once(load_clients), content(Site), - log_msg("system", "Serving capsule at `~s`~n", [Site]), + log_msg("system", "Serving capsule at `~s`", [Site]), hostname(Hostname), - log_msg("system", "Listening on hostname `~s`~n", [Hostname]), - once(load_certificate(Context)), + log_msg("system", "Listening on hostname `~s`", [Hostname]), + once(load_certificate(TlsContext)), catch( - with_socket(Context, with_connection_loop, req_serve), + with_socket(TlsContext, with_connection_loop, req_serve), Error, handle_top_level_error(Error) ). handle_top_level_error(error('$interrupt_thrown', _)) :- !, - log_msg("system", "Shutting down~n", []), - log_msg("system", "Adios!~n", []), + log_msg("system", "Shutting down", []), + log_msg("system", "Adios!", []), halt(0). handle_top_level_error(Error) :- - log_msg("error", "Unhandled top-level: ~q~n", [Error]), + log_msg("error", "Unhandled top-level: ~q", [Error]), halt(1). -with_socket(Context, Kont, Kont2) :- +with_socket(TlsContext, Kont, Kont2) :- addr(Addr), port(Port), ( setup_call_cleanup( - (log_msg("socket", "Opening socket ~q~n", [Addr:Port]), + (log_msg("socket", "Opening socket ~q", [Addr:Port]), socket_server_open(Addr:Port, Socket) ), - call(Kont, Context, Socket, Kont2), - (log_msg("socket", "Closing socket~n", []), + call(Kont, TlsContext, Socket, Kont2), + (log_msg("socket", "Closing socket", []), socket_server_close(Socket) ) ) ; - log_msg("error", "Can't bind socket ~q~n", [Addr:Port]) + log_msg("error", "Can't bind socket ~q", [Addr:Port]) ). -with_connection_loop(Context, Socket, Kont) :- +with_connection_loop(TlsContext, Socket, Kont) :- repeat, catch( setup_call_cleanup( ( - log_msg("tcp", "Accepting connections...~n", []), - socket_server_accept(Socket, Client, S0, []), - log_msg("tcp", "Connected client ~q~n", [Client]) + log_msg("tcp", "Accepting connections...", []), + socket_server_accept(Socket, TcpClient, S0, []), + log_msg("tcp", "Connected client ~q", [TcpClient]) ), - with_tls_connection(S0, Context, Kont), + with_tls_connection(S0, TlsContext, TcpClient, Kont), ( close(S0), - log_msg("tcp", "Closed connection for client ~q~n", [Client]) + log_msg("tcp", "Closed connection for client ~q", [Client]) ) ), Error, @@ -90,19 +94,19 @@ with_connection_loop(Context, Socket, Kont) :- fail. handle_conn_error(error(permission_error(open, source_sink, _), tls_server_negotiate/3)) :- !, - log_msg("error", "TLS handshake failed~n", []). + log_msg("error", "TLS handshake failed", []). handle_conn_error(error(existence_error(stream, _), _)) :- !, - log_msg("error", "Client disconnected~n", []). + log_msg("error", "Client disconnected", []). handle_conn_error(Error) :- - % log_msg("debug", "Re-throwing from conn loop: ~q~n", [Error]), + % log_msg("debug", "Re-throwing from conn loop: ~q", [Error]), throw(Error). -req_serve(S, ClientCert) :- +req_serve(S, TcpClient, ClientCert) :- once(catch( - ( read_request(S, Path, Query), + ( read_request(S, Uri), save_client(ClientCert), content(Root), - serve(S, Root, Path, Query) + serve(S, Root, Uri) ), gemini_error(DCG, Msg), ( phrase(response(DCG, Msg), Response0), diff --git a/sys/mime.pl b/sys/mime.pl index 37935a6..675edd7 100644 --- a/sys/mime.pl +++ b/sys/mime.pl @@ -82,4 +82,4 @@ guess_mime(Chars, Mime) :- mime(Ext, Mime) ; Mime = "application/octet-stream" ), - log_msg("response", "Mime identified as ~s~n", [Mime]). + log_msg("response", "Mime identified as ~s", [Mime]). diff --git a/sys/tls_certs.pl b/sys/tls_certs.pl index 84e64d2..e4f280f 100644 --- a/sys/tls_certs.pl +++ b/sys/tls_certs.pl @@ -1,4 +1,4 @@ -:- module(tls_certs, [load_certificate/1, with_tls_connection/3]). +:- module(tls_certs, [load_certificate/1, with_tls_connection/4]). :- use_module('../config'). :- use_module(library(dcgs)). @@ -20,12 +20,12 @@ load_existing_certificate(Context) :- cert(Cert), key(Key), hostname(Hostname), - log_msg("tls", "Loading certificate `~s` and key `~s`~n", [Cert, Key]), + log_msg("tls", "Loading certificate `~s` and key `~s`", [Cert, Key]), file_exists(Cert), ( cert_is_for_hostname(Cert, Hostname) ; append(Cert, ".bak", 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]), + log_msg("error", "Certificate `~s` is not for hostname `~s`. Renaming it to `~s` (also `~s` to `~s`)", [Cert, Hostname, Cert1, Key, Key1]), rename_file(Cert, Cert1), rename_file(Key, Key1), fail @@ -33,7 +33,7 @@ load_existing_certificate(Context) :- 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", []). + log_msg("tls", "Loaded certificate", []). cert_is_for_hostname(Cert, Hostname) :- process_create("openssl", @@ -47,7 +47,7 @@ cn(Hostname) --> ... , "CN=", seq(Hostname), ... . create_new_certificate(Context) :- hostname(Hostname), - log_msg("tls", "Generating new certificate for host `~s`~n", [Hostname]), + log_msg("tls", "Generating new certificate for host `~s`", [Hostname]), append("/CN=", Hostname, Hostname1), process_create("openssl", ["req", "-x509", "-newkey", "rsa:4096", "-nodes", "-keyout", "key.pem", "-out", "cert.pem", "-days", "2900000", "-subj", Hostname1], @@ -57,25 +57,24 @@ create_new_certificate(Context) :- cert(Cert), key(Key), - log_msg("tls", "Generated new certificate `~s` and key `~s`~n", [Cert, Key]), + log_msg("tls", "Generated new certificate `~s` and key `~s`", [Cert, Key]), load_existing_certificate(Context). +:- meta_predicate(with_tls_connection(?, ?, ?, 3)). -:- meta_predicate(with_tls_connection(?, ?, 1)). - -%% with_tls_connection(+Stream, +Context, +F_2) +%% with_tls_connection(+Stream, +Context, +F_3) % -% Open a TLS connection on Stream with Context and pass it to F_2 -with_tls_connection(S0, Context, Kont) :- +% Open a TLS connection on Stream with Context and pass it to F_3 +with_tls_connection(S0, Context, TcpClient, Kont) :- setup_call_cleanup( - ( log_msg("tls-conn", "Handshaking TLS~n", []), + ( log_msg("tls-conn", "Handshaking TLS", []), tls_server_negotiate(Context, S0, S, [client_certificate(ClientCert)]), - ( \+ ClientCert = none, log_msg("tls-conn", "Client cert ~q~n", [ClientCert]) + ( \+ ClientCert = none, log_msg("tls-conn", "Client cert ~q", [ClientCert]) ; true ) ), - call(Kont, S, ClientCert), - ( log_msg("tls-conn", "Closing TLS stream~n", []), + call(Kont, S, TcpClient, ClientCert), + ( log_msg("tls-conn", "Closing TLS stream", []), close(S) ) ). diff --git a/ui/banner.pl b/ui/banner.pl index 6b718c6..565ad2b 100644 --- a/ui/banner.pl +++ b/ui/banner.pl @@ -8,7 +8,7 @@ display_banner :- phrase_from_file(lines(Ls), "ui/banner.txt"), - maplist(\S^log_msg("system", "~s~n", [S]), Ls). + maplist(\S^log_msg("system", "~s", [S]), Ls). lines([]) --> call(eos), !. lines([L|Ls]) --> line(L), lines(Ls). diff --git a/ui/log.pl b/ui/log.pl index 84eab5e..6795c5c 100644 --- a/ui/log.pl +++ b/ui/log.pl @@ -46,4 +46,5 @@ log_msg(Scope, Formato, Argumentos) :- scope_color(Scope, Color), Reset = "\x1b\[0m", format("~s[~s]~s ", [Color, Scope, Reset]), - format(Formato, Argumentos). + format(Formato, Argumentos), + format("~n", []).