--- /dev/null
+:- 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('=') --> "=".
--- /dev/null
+:- 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 }.
--- /dev/null
+#!/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
--- /dev/null
+:- 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).
--- /dev/null
+
+:- 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).
--- /dev/null
+:- 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".
--- /dev/null
+:- 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".
+++ /dev/null
-:- 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).
projects / sula.git / commitdiff