From: Javier Sagredo <javier.sagredo@iohk.io>
Date: Thu, 28 May 2026 00:11:46 +0000 (+0200)
Subject: Improvements
X-Git-Url: https://git.sagredo.dev/?a=commitdiff_plain;h=94cafdbad711ef6913e8ab563cc55ab426cc46cd;p=sula.git

Improvements
---

diff --git a/gemini_uri.pl b/gemini_uri.pl
new file mode 100644
index 0000000..6a03fd1
--- /dev/null
+++ b/gemini_uri.pl
@@ -0,0 +1,95 @@
+:- module(gemini_uri, [gemini_uri//4]).
+
+:- use_module(library(clpz)).
+:- use_module(library(dcgs)).
+:- use_module(library(charsio)).
+:- use_module('./ip').
+
+gemini_uri(Host, Port, Path, Query) -->
+    % scheme MUST be gemini
+    "gemini://",
+    host(Host),
+    port_opt(Port),
+    path(Path),
+    query(Query).
+
+host(Host) -->
+    reg_name(Chars),
+    {
+        % IP addresses are disallowed on the host
+        \+ phrase(ip_address, Chars),
+        atom_chars(Host, Chars)
+    }.
+
+% reg-name = *( unreserved / pct-encoded / sub-delims )
+reg_name([C|Cs]) --> (unreserved(C); pct_encoded(C); sub_delims(C)), !, reg_name(Cs).
+reg_name([])     --> [].
+
+number_chars_(_, []) :- !, fail.
+number_chars_(N, C) :- number_chars(N, C).
+
+% port = *DIGIT
+port_opt(Port) -->
+    ":",
+    digits(Chars),
+    { number_chars_(Port, Chars) }.
+port_opt(none) --> [].
+
+digits([C|Cs]) --> [C], { char_type(C, decimal_digit) }, !, digits(Cs).
+digits([])     --> [].
+
+% path-abempty = *( "/" segment )
+% segment      = *pchar
+path(Path) -->
+    "/",
+    path_abempty(Chars),
+    { atom_chars(Path, ['/'|Chars]) }.
+path('/') --> [].
+
+path_abempty([C|Cs]) --> ( pchar(C) ; "/" , { C = (/)} ), !, path_abempty(Cs).
+path_abempty([])     --> [].
+
+query(Query) -->
+    "?",
+    query_(Chars),
+    { atom_chars(Query, ['?'|Chars]) }.
+query(none) --> [].
+
+% query = *( pchar / "/" / "?" )
+query_([C|Cs]) --> (pchar(C) ; "/" , { C = (/) }; "?", { C = (?) } ), !, query_(Cs).
+query_([])     --> [].
+
+% pchar = unreserved / pct-encoded / sub-delims / ":" / "@"
+pchar(C) --> unreserved(C) ; pct_encoded(C) ; sub_delims(C).
+pchar(':') --> ":".
+pchar('@') --> "@".
+
+unreserved('-') --> "-".
+unreserved('.') --> ".".
+unreserved('_') --> "_".
+unreserved('~') --> "~".
+unreserved(C) --> [C], { char_type(C, alnum) }.
+
+pct_encoded(Char) -->
+    "%",
+    [H1, H2],
+    { hex_value(H1, V1),
+      hex_value(H2, V2),
+      Code #= V1 * 16 + V2,
+      char_code(Char, Code)
+    }.
+
+hex_value(C, V) :- char_type(C, decimal_digit), char_code(C, Code), V #= Code - 48.
+hex_value(C, V) :- char_type(C, alpha), char_type(C, lower([D])), char_code(D, Code), V #= Code - 87, V #>= 0, V #< 16.
+
+sub_delims('!') --> "!".
+sub_delims('$') --> "$".
+sub_delims('&') --> "&".
+sub_delims('\'') --> "'".
+sub_delims('(') -->  "(".
+sub_delims(')') --> ")".
+sub_delims('*') --> "*".
+sub_delims('+') --> "+".
+sub_delims(',') --> ",".
+sub_delims(';') --> ";".
+sub_delims('=') --> "=".
diff --git a/ip.pl b/ip.pl
new file mode 100644
index 0000000..c02406a
--- /dev/null
+++ b/ip.pl
@@ -0,0 +1,55 @@
+:- module(ip, [ipv6_address//0, ipv4_address//0, ip_address//0]).
+
+:- use_module(library(dcgs)).
+:- use_module(library(charsio)).
+:- use_module(library(clpz)).
+
+ip_address --> ipv4_address ; ipv6_address.
+
+% =============================================================================
+% IPv6address
+% =============================================================================
+ipv6_address --> h16, ":", h16, ":", h16, ":", h16, ":", h16, ":", h16, ":", ls32.
+ipv6_address --> "::", h16, ":", h16, ":", h16, ":", h16, ":", h16, ":", ls32.
+ipv6_address --> opt_h16(0), "::", h16, ":", h16, ":", h16, ":", h16, ":", ls32.
+ipv6_address --> opt_h16(1), "::", h16, ":", h16, ":", h16, ":", ls32.
+ipv6_address --> opt_h16(2), "::", h16, ":", h16, ":", ls32.
+ipv6_address --> opt_h16(3), "::", h16, ":", ls32.
+ipv6_address --> opt_h16(4), "::", ls32.
+ipv6_address --> opt_h16(5), "::", h16.
+ipv6_address --> opt_h16(6), "::".
+
+opt_h16(Max) --> h16_loop(0, Max), h16.
+opt_h16(_) --> [].
+
+h16_loop(I, Max) --> { I #< Max }, h16, ":", h16_loop_next(I, Max).
+h16_loop(I, Max) --> { I #= Max }, h16, ":".
+
+h16_loop_next(I, Max) --> { NewI #= I + 1 }, h16_loop(NewI, Max).
+h16_loop_next(_, _) --> [].
+
+h16 --> m_n_hexdig(1, 4).
+
+ls32 --> h16, ":", h16.
+ls32 --> ipv4_address.
+
+% =============================================================================
+% IPv4address & dec-octet
+% =============================================================================
+ipv4_address --> dec_octet, ".", dec_octet, ".", dec_octet, ".", dec_octet.
+
+dec_octet --> digit.                                 % 0-9
+dec_octet --> [C], { char_type(C, decimal_digit), number_chars(N, [C]), N #\= 0 }, digit.  % 10-99
+dec_octet --> "1", digit, digit.                      % 100-199
+dec_octet --> "2", [C], { char_type(C, decimal_digit), number_chars(N, [C]), N #>= 0, N #< 5 }, digit. % 200-249
+dec_octet --> "25", [C], { char_type(C, decimal_digit), number_chars(N, [C]), N #>= 0, N #< 6 }.    % 250-255
+
+digit --> [C], { char_type(C, decimal_digit) }.
+
+hexdig --> digit.
+hexdig --> [C], { char_type(C, alpha), char_type(C, lower([D])), char_code(D, Code), Code #>= 87, Code #< 87 + 16 }.
+
+m_n_hexdig(M, N) --> count_hexdig(0, M, N).
+
+count_hexdig(Acc, M, N) --> { Acc #< N }, hexdig, { NewAcc #= Acc + 1 }, count_hexdig(NewAcc, M, N).
+count_hexdig(Acc, M, _) --> { Acc #>= M }.
diff --git a/launch b/launch
new file mode 100755
index 0000000..f680d18
--- /dev/null
+++ b/launch
@@ -0,0 +1,14 @@
+#!/bin/bash
+
+# 1. Al pulsar Ctrl+C, disparamos netcat para despertar al accept
+#    y luego matamos el proceso de Scryer que dejamos guardado en $SCRYER_PID
+trap 'echo " Deteniendo servidor Gemini..."; nc -z localhost 1965 > /dev/null 2>&1; kill $SCRYER_PID 2>/dev/null; exit 0' INT
+
+# 2. Lanzamos Scryer Prolog en SEGUNDO PLANO (&)
+scryer-prolog main.pl &
+
+# 3. Guardamos el ID del proceso (PID) de Scryer
+SCRYER_PID=$!
+
+# 4. Nos quedamos esperando a que Scryer termine (wait mantiene el trap activo)
+wait $SCRYER_PID
diff --git a/log.pl b/log.pl
new file mode 100644
index 0000000..42d3c24
--- /dev/null
+++ b/log.pl
@@ -0,0 +1,44 @@
+:- module(log, [log_msg/3]).
+
+:- use_module(library(crypto)).
+:- use_module(library(format)).
+:- use_module(library(clpz)).
+:- use_module(library(lists)).
+
+colors([
+    "\x1b\[31m", % Red
+    "\x1b\[32m", % Green
+    "\x1b\[33m", % Yellow
+    "\x1b\[34m", % Blue
+    "\x1b\[35m", % Magenta
+    "\x1b\[36m", % Cyan
+    "\x1b\[91m", % Light Red
+    "\x1b\[92m", % Light Green
+    "\x1b\[93m", % Light Yellow
+    "\x1b\[94m", % Light Blue
+    "\x1b\[95m", % Light Magenta
+    "\x1b\[96m"  % Light Cyan
+]).
+
+scope_color(ScopeName, ColorANSI) :-
+    crypto_data_hash(ScopeName, HashHex, [algorithm(sha256)]),
+
+    HashHex = [C1, C2, C3, C4 | _],
+    char_code(C1, Code1),
+    char_code(C2, Code2),
+    char_code(C3, Code3),
+    char_code(C4, Code4),
+
+    colors(ListaColores),
+    length(ListaColores, NumColores),
+
+    Suma #= Code1 + Code2 + Code3 + Code4,
+    Indice #= Suma mod NumColores,
+
+    nth0(Indice, ListaColores, ColorANSI).
+
+log_msg(Scope, Formato, Argumentos) :-
+    scope_color(Scope, Color),
+    Reset = "\x1b\[0m",
+    format("~s[~s]~s ", [Color, Scope, Reset]),
+    format(Formato, Argumentos).
diff --git a/main.pl b/main.pl
new file mode 100644
index 0000000..9bddfb9
--- /dev/null
+++ b/main.pl
@@ -0,0 +1,150 @@
+
+:- use_module(library(charsio)).
+:- use_module(library(dcgs)).
+:- use_module(library(sockets)).
+:- use_module(library(tls)).
+:- use_module(library(pio)).
+:- use_module(library(clpz)).
+:- use_module(library(lists)).
+:- use_module(library(files)).
+:- use_module(library(iso_ext)).
+
+:- use_module('./request').
+:- use_module('./response').
+:- use_module('./log').
+
+% ------------------------------------------------------------------------------
+
+
+cert("identity.p12").
+addr('127.0.0.1').
+port(1965).
+site("./site").
+
+load_certificate(Context) :-
+    cert(Cert),
+    log_msg("tls", "Loading certificate from ~s~n", [Cert]),
+    phrase_from_file(seq(Chars), Cert, [type(binary)]),
+    tls_server_context(Context, [pcks12(Chars)]),
+    log_msg("tls", "Loaded certificate~n", []).
+
+with_socket(Context, Kont) :-
+    addr(Addr),
+    port(Port),
+    setup_call_cleanup(
+        (log_msg("tcp", "Opening socket ~q~n", [Addr:Port]),
+         socket_server_open(Addr:Port, Socket)
+        ),
+        call(Kont, Context, Socket),
+        (log_msg("tcp", "Closing socket~n", []),
+         socket_server_close(Socket)
+        )
+    ).
+
+loop(Context, Socket) :-
+    setup_call_cleanup(
+        socket_server_accept(Socket, _, S0, []),
+        with_tls_connection(S0, Context, req_serve),
+        close(S0)
+    ),
+    loop(Context, Socket).
+
+with_tls_connection(S0, Context, Kont) :-
+    setup_call_cleanup(
+        ( log_msg("tls-conn", "Received connection, authenticating TLS~n", []),
+          tls_server_negotiate(Context, S0, S)
+        ),
+        call(Kont, S),
+        ( log_msg("tls-conn", "Closing TLS stream~n", []),
+          close(S)
+        )
+    ).
+
+req_serve(S) :-
+    read_request(S, RequestChars),
+    log_msg("request", "Received raw request: ~s", [RequestChars]),
+    phrase(request(uri(H, P, Path, Query)), RequestChars),
+    ( serve(S, Path, Query)
+    ; log_msg("error", "File not found~n", []),
+      phrase(response(not_found, "File not found, sorry"), Response0),
+      format(S, "~s\r\n", [Response0])
+    ),
+    !.
+
+load_mime :-
+    assertz(mime("gmi", "text/gemini")),
+    assertz(mime("xz", "application/x-xz")).
+
+main :-
+    log_msg("system", "Starting gemyer~n", []),
+    load_mime,
+    load_certificate(Context),
+    with_socket(Context, loop).
+
+serve(S, /, Q) :-
+    serve(S, '/index.gmi', Q).
+serve(S, Path, _) :-
+    atom_chars(Path, Chars),
+    reverse(Chars, Chars1),
+    ( append([Ext0, ".", _], Chars1),
+      reverse(Ext0, Ext),
+      mime(Ext, Mime) ;
+      Mime = "application/octet-stream"
+    ),
+    !,
+    log_msg("response", "Mime identified as ~s~n", [Mime]),
+    append("site", Chars, File),
+    file_exists(File),
+    log_msg("response", "File does exist~n", []),
+    ( append("text/", _, Mime) ->
+
+      phrase_from_file(seq(Body), File),
+      log_msg("response", "Sending text response~n", []),
+      phrase(response(success, Mime), Response0),
+      format(S, "~s\r\n", [Response0]),
+      format(S, "~s", [Body]),
+      log_msg("response", "Sent text response~n", [])
+    ;
+      setup_call_cleanup(
+        open(File, read, FileStream, [type(binary)]),
+        (
+            log_msg("response", "Sending binary response~n", []),
+            phrase(response(success, Mime), Response0),
+            format(S, "~s\r\n", [Response0]),
+            stream_bytes(FileStream, S),
+            log_msg("response", "Sent binary response~n", [])
+        ),
+        close(FileStream)
+      )
+    )
+    .
+
+stream_bytes(FileStream, Socket) :-
+    BlockSize = 4096,
+    get_n_chars(FileStream, BlockSize, Chars),
+    (   Chars == [] ->
+        true
+    ;   format(Socket, "~s", [Chars]),
+        stream_bytes(FileStream, Socket)
+    ).
+
+path_gemtext(/, File) :-
+    site(Site),
+    append(Site, "/index.gmi", File).
+path_gemtext(Atom, File) :-
+    atom_chars(Atom, Chars),
+    append(_, ".gmi", Chars),
+    append("site", Chars, File).
+
+read_request(Stream, Chars) :-
+    get_char(Stream, C),
+    read_request_(1023, C, Stream, Chars).
+
+read_request_(N, '\n', _, ['\n']) :- N #> 0, !. % End of the request reached
+read_request_(N, C, Stream, [C|Cs]) :-
+    N #> 0,
+    N1 #= N - 1,
+    get_char(Stream, Cnext),
+    read_request_(N1, Cnext, Stream, Cs).
+
+:- initialization(main).
diff --git a/request.pl b/request.pl
new file mode 100644
index 0000000..630a9dc
--- /dev/null
+++ b/request.pl
@@ -0,0 +1,10 @@
+:- module(request, [request//1]).
+
+:- use_module(library(dcgs)).
+:- use_module('./gemini_uri').
+
+request(uri(Host, Port, Path, Query)) -->
+    gemini_uri(Host, Port, Path, Query),
+    crlf.
+
+crlf --> "\r\n".
diff --git a/response.pl b/response.pl
new file mode 100644
index 0000000..7497785
--- /dev/null
+++ b/response.pl
@@ -0,0 +1,30 @@
+:- module(response, [response//1, response//2]).
+
+:- use_module(library(dcgs)).
+
+crlf --> "\r\n".
+sp --> " ".
+
+response(X) -->
+    { X \= input, X \= sensitive_input, X \= temporary_redirection, X \= permanent_redirection, X \= success },
+    response_(X), crlf.
+response(X, Msg)              --> response_(X), sp, Msg, crlf.
+
+response_(input)                 --> "10".
+response_(sensitive_input)       --> "11".
+response_(success)               --> "20".
+response_(temporary_redirection) --> "30".
+response_(permanent_redirection) --> "31".
+response_(temporary_failure)     --> "40".
+response_(server_unavailable)    --> "41".
+response_(cgi_error)             --> "42".
+response_(proxy_error)           --> "43".
+response_(slow_down)             --> "44".
+response_(permanent_failure)     --> "50".
+response_(not_found)             --> "51".
+response_(gone)                  --> "52".
+response_(proxy_request_refused) --> "53".
+response_(bad_request)           --> "59".
+response_(auth)                  --> "60".
+response_(cert_not_auth)         --> "61".
+response_(cert_not_valid)        --> "62".
diff --git a/url.pl b/url.pl
deleted file mode 100644
index 305b90c..0000000
--- a/url.pl
+++ /dev/null
@@ -1,172 +0,0 @@
-:- module(url, [main/0]).
-
-:- use_module(library(charsio)).
-:- use_module(library(dcgs)).
-:- use_module(library(sockets)).
-:- use_module(library(tls)).
-:- use_module(library(pio)).
-:- use_module(library(lists)).
-:- use_module(library(iso_ext)).
-
-request(url(Scheme, Host, Port, Path, Query, Fragment)) -->
-    url(Scheme, Host, Port, Path, Query, Fragment),
-    crlf.
-
-url(Scheme, Host, Port, Path, Query, Fragment) -->
-    scheme(Scheme),
-    "://",
-    host(Host),
-    port_opt(Port),
-    path(Path),
-    query(Query),
-    fragment(Fragment).
-
-scheme(Scheme) -->
-    alpha_word(Chars),
-    { atom_chars(Scheme, Chars) }.
-
-host(Host) -->
-    chars_host(Chars),
-    { atom_chars(Host, Chars) }.
-
-port_opt(Port) -->
-    ":",
-    digits(Chars),
-    { number_chars(Port, Chars) }.
-port_opt(none) --> [].
-
-path(Path) -->
-    "/",
-    chars_path(Chars),
-    { atom_chars(Path, ['/'|Chars]) }.
-path('/') --> [].
-
-query(Query) -->
-    "?",
-    chars_query(Chars),
-    { atom_chars(Query, ['?'|Chars]) }.
-query(none) --> [].
-
-fragment(Fragment) -->
-    "#",
-    chars_fragment(Chars),
-    { atom_chars(Fragment, ['#'|Chars]) }.
-fragment(none) --> [].
-
-alpha_word([C|Cs]) --> [C], { char_type(C, alpha) }, !, alpha_word(Cs).
-alpha_word([])     --> [].
-
-digits([C|Cs]) --> [C], { char_type(C, decimal_digit) }, !, digits(Cs).
-digits([])     --> [].
-
-chars_host([C|Cs]) --> [C], { C \= (/), C \= (:) }, !, chars_host(Cs).
-chars_host([])     --> [].
-
-chars_path([C|Cs]) --> [C], { C \= (#), C \= (?), C \= '\r' }, !, chars_path(Cs).
-chars_path([])     --> [].
-
-chars_query([C|Cs]) --> [C], { C \= (#), C \= (?), C \= '\r' }, !, chars_query(Cs).
-chars_query([])     --> [].
-
-chars_fragment([C|Cs]) --> [C], { C \= (#), C \= (?), C \= '\r' }, !, chars_fragment(Cs).
-chars_fragment([])     --> [].
-
-% ------------------------------------------------------------------------------
-
-crlf --> "\r\n".
-sp --> " ".
-
-response(X) -->
-    { X \= input, X \= sensitive_input, X \= temporary_redirection, X \= permanent_redirection, X \= success },
-    response_(X), crlf.
-response(X, Msg)              --> response_(X), sp, Msg, crlf.
-
-response_(success) --> "20".
-response_(input)                 --> "10".
-response_(sensitive_input)       --> "11".
-response_(temporary_redirection) --> "30".
-response_(permanent_redirection) --> "31".
-response_(temporary_failure)     --> "40".
-response_(server_unavailable)    --> "41".
-response_(cgi_error)             --> "42".
-response_(proxy_error)           --> "43".
-response_(slow_down)             --> "44".
-response_(permanent_failure)     --> "50".
-response_(not_found)             --> "51".
-response_(gone)                  --> "52".
-response_(proxy_request_refused) --> "53".
-response_(bad_request)           --> "59".
-response_(auth)                  --> "60".
-response_(cert_not_auth)         --> "61".
-response_(cert_not_valid)        --> "62".
-
-main :-
-    phrase_from_file(seq(Chars), "identity.p12", [type(binary)]),
-    tls_server_context(Context, [pcks12(Chars)]),
-    setup_call_cleanup(
-        socket_server_open('127.0.0.1':1965, Socket),
-        loop(Socket, Context),
-        socket_server_close(Socket)
-        ).
-
-loop(Socket, Context) :-
-    format("Starting server~n", []),
-    socket_server_accept(Socket, Client, S0, []),
-    handle_connection(S0, Context),
-    loop(Socket, Context).
-
-handle_connection(S0, Context) :-
-    format("Waiting for connection~n", []),
-    tls_server_negotiate(Context, S0, S),
-    format("Negotiated tls~n", []),
-    read_gemini_line(S, RequestChars),
-    format("Received raw request: ~s~n", [RequestChars]),
-    phrase(request(url(Scheme, Host, Port, Path, Query, Fragment)), RequestChars),
-    format("Requested file ~a~n", [Path]),
-    serve(S, Path),
-    close(S).
-
-serve(S, Path) :-
-    get_gem_file(Path, File),
-    phrase_from_file(seq(Chars1), File),
-    phrase(response(success, "text/gemini"), Response0),
-    format(S, "~s\r\n", [Response0]),
-    format(S, "~s", [Chars1]).
-serve(S, Path) :-
-    atom_chars(Path, Chars),
-    append(_, ".tar.xz", Chars),
-    append("site", Chars, File),
-    setup_call_cleanup(
-        open(File, read, FileStream, [type(binary)]),
-        (phrase(response(success, "application/x-tar"), Response0),
-        format(S, "~s\r\n", [Response0]),
-        stream_bytes(FileStream, S)
-        ),
-        close(FileStream)
-    ).
-
-stream_bytes(FileStream, Socket) :-
-    get_byte(FileStream, Byte),
-    ( Byte = -1;
-      Byte \= -1,
-      char_code(C, Byte),
-      put_char(Socket, C),
-      stream_bytes(FileStream, Socket)
-    ).
-
-get_gem_file(/, "site/index.gmi").
-get_gem_file(Atom, File) :-
-    atom_chars(Atom, Chars),
-    append(_, ".gmi", Chars),
-    append("site", Chars, File).
-
-read_gemini_line(Stream, Chars) :-
-    get_char(Stream, C),
-    read_gemini_line_(C, Stream, Chars).
-
-read_gemini_line_('\n', _, ['\n']) :- !. % End of the request reached
-read_gemini_line_(C, Stream, [C|Cs]) :-
-    get_char(Stream, Cnext),
-    read_gemini_line_(Cnext, Stream, Cs).
-
-:- initialization(main).