From 0b3258be67aace80b5383cb04e8dfaa04926d22d Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Thu, 25 Jun 2026 02:27:06 +0200 Subject: [PATCH] First successful CGI execution --- a.sh | 21 +++++++++++++++ cgi.pl | 65 ++++++++++++++++++++++++++++++---------------- clients.pl | 3 ++- config.pl | 6 ++--- dcgs/gemini_uri.pl | 8 +++--- request.pl | 3 ++- routing.pl | 49 ++++++++++++++++++++++++++++++++++ sula.pl | 24 +++++------------ sys/tls_certs.pl | 1 - 9 files changed, 128 insertions(+), 52 deletions(-) create mode 100755 a.sh create mode 100644 routing.pl diff --git a/a.sh b/a.sh new file mode 100755 index 0000000..a74fd67 --- /dev/null +++ b/a.sh @@ -0,0 +1,21 @@ +#!/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=$QUERY_STRING" +echo "GEMINI_QUERY_STRING=$GEMINI_QUERY_STRING" +echo "AUTH_TYPE=$AUTH_TYPE" +echo "REMOTE_USER=$REMOTE_USER" +echo "REMOTE_IDENT=$REMOTE_IDENT" diff --git a/cgi.pl b/cgi.pl index 5c091c9..d8b99e0 100644 --- a/cgi.pl +++ b/cgi.pl @@ -1,43 +1,62 @@ -:- module(cgi, [run_cgi/3]). +:- module(cgi, [run_cgi/5]). +:- use_module(constants). +:- use_module(dcgs/gemini_uri). +:- use_module(dcgs/response). :- use_module(library(dcgs)). -:- use_module(library(process)). +:- use_module(library(lists)). :- use_module(library(pio)). -:- use_module(dcgs/response). -:- use_module(config). +:- use_module(library(process)). +:- use_module(ui/log). -run_cgi(Script, Query, Output) :- - once(run_cgi_(Script, Query, Output)). +run_cgi(Script, Uri, TcpClient, TlsClientCert, Output) :- + log_msg("cgi", "Invoking script ~s", [Script]), + once(run_cgi_(Script, Uri, TcpClient, TlsClientCert, Output)). -run_cgi_(Script, Query, Output) :- +run_cgi_(Script, Uri, TcpClient, TlsClientCert, Output) :- base_env(Script, Env0), - query_env(Query, Env1), - tls_env(Client, Env2), - append([Env0, Env1, Env2], Env), + tcp_env(TcpClient, Env1), + url_env(Uri, Env2), + query_env(Uri, Env3), + tls_env(TlsClientCert, Env4), + append([Env0, Env1, Env2, Env3, Env4], Env), process_create(Script, [], [stdout(pipe(P)), environment(Env), process(H)]), - process_wait(H, N), + process_wait(H, exit(N)), ( N #\= 0, throw(gemini_error(cgi_error, "CGI exited with non-zero exit code!")) ; phrase_from_stream(seq(Output), P) ). base_env(Script, Env) :- - hostname(Hostname), port(Port), + version(v(Maj, Min, Pat)), + maplist(number_chars, [Maj, Min, Pat], [CMaj, CMin, CPat]), + append(["SULA/", CMaj, ".", CMin, ".", CPat], ServerSoftware), Env = [ "GATEWAY_INTERFACE"="CGI/1.1", - "REMOTE_ADDR"="TODO", - "REMOTE_HOST"="TODO", - "REMOTE_PORT"="TODO", - "PATH_INFO"="TODO", "SCRIPT_NAME"=Script, - "SERVER_SOFTWARE"="SULA", - "SERVER_PROTOCOL"="GEMINI", + "SERVER_SOFTWARE"=ServerSoftware, + "SERVER_PROTOCOL"="GEMINI" + ]. + +url_env(uri(Hostname, Port, Path, Query), Env) :- + append(["gemini://", Hostname, ":", Port, Path], Url0), + ( Query = none, Url = Url0 + ; \+ Query = none, append([Url0, "?", Query], Url) ), + Env = [ "PATH_INFO"=Path, "SERVER_NAME"=Hostname, "SERVER_PORT"=Port, - "GEMINI_URL"="TODO", - "GEMINI_URL_PATH"="TODO" + "GEMINI_URL"=Url, + "GEMINI_URL_PATH"=Path + ]. + +tcp_env(TcpClient, Env) :- + atom_chars(TcpClient, TcpClientS), + append([TcpClientAddrS, ":", TcpClientPortS], TcpClientS), + Env = [ "REMOTE_ADDR"=TcpClientAddrS, + "REMOTE_HOST"=TcpClientAddrS, + "REMOTE_PORT"=TcpClientPortS ]. -query_env(none, [ "QUERY_STRING"="" ]) :- !. -query_env(Query, Env) :- +query_env(uri(_, _, _, none), [ "QUERY_STRING"="" ]) :- !. +query_env(uri(_, _, _, Query), Env) :- Env = [ "QUERY_STRING"=Query, "GEMINI_QUERY_STRING"=Query ]. @@ -48,7 +67,7 @@ tls_env(none, Env) :- "REMOTE_IDENT"="" ], !. -tls_env(Cert, Env) :- +tls_env(_, Env) :- Env = [ "AUTH_TYPE"="Certificate", "REMOTE_USER"="TODO", "TLS_CLIENT_HASH"="TODO", diff --git a/clients.pl b/clients.pl index f285d54..071af20 100644 --- a/clients.pl +++ b/clients.pl @@ -27,9 +27,10 @@ read_clients(Stream) :- read_clients(Stream) ). -save_client(none). +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]), diff --git a/config.pl b/config.pl index 8ae3808..c493d61 100644 --- a/config.pl +++ b/config.pl @@ -21,7 +21,7 @@ default(cert, "./cert.pem"). default(key, "./key.pem"). default(addr, '127.0.0.1'). -default(port, 1965). +default(port, "1965"). default(content, "./site"). default(hostname, "localhost"). @@ -64,7 +64,7 @@ options([]) --> []. options([Opt|Opts]) --> option(Opt), options(Opts). option(addr(Addr)) --> ["--addr", A], { atom_chars(Addr, A) }. -option(port(Port)) --> ["--port", P], { number_chars(Port, P) }. +option(port(P)) --> ["--port", P]. option(hostname(H)) --> ["--hostname", H]. option(content(C)) --> ["--content", C]. option(certs(D)) --> ["--certs", D]. @@ -116,7 +116,7 @@ read_config_terms(Stream) :- valid_cfg_opt(Term) :- Term =.. [Functor, Value], ( Functor = addr, atom_si(Value) - ; Functor = port, integer_si(Value) + ; Functor = port, chars_si(Value) ; Functor = hostname, chars_si(Value) ; Functor = content, chars_si(Value) ; Functor = certs, chars_si(Value) diff --git a/dcgs/gemini_uri.pl b/dcgs/gemini_uri.pl index 17dae0e..a64c7e9 100644 --- a/dcgs/gemini_uri.pl +++ b/dcgs/gemini_uri.pl @@ -30,9 +30,8 @@ number_chars_(N, C) :- number_chars(N, C). % port = *DIGIT port_opt(Port) --> ":", - digits(Chars), - { number_chars_(Port, Chars) }. -port_opt(1965) --> []. + digits(Port). +port_opt("1965") --> []. digits([C|Cs]) --> [C], { char_type(C, decimal_digit) }, !, digits(Cs). digits([]) --> []. @@ -50,8 +49,7 @@ path_abempty([]) --> []. query(Query) --> "?", - query_(Chars), - { atom_chars(Query, ['?'|Chars]) }. + query_(Query). query(none) --> []. % query = *( pchar / "/" / "?" ) diff --git a/request.pl b/request.pl index da6d9f1..289034e 100644 --- a/request.pl +++ b/request.pl @@ -26,7 +26,8 @@ read_request(Stream, uri(Hostname, Port, Path, Query)) :- ) ), ( hostname(Hostname), - port(Port) + port(Port), + ! ; log_msg("error", "Received request for an unknown hostname!", []), throw(gemini_error(bad_request, "This request is not for me!")) ). diff --git a/routing.pl b/routing.pl new file mode 100644 index 0000000..cff1cc0 --- /dev/null +++ b/routing.pl @@ -0,0 +1,49 @@ +:- module(routing, [routing/3]). + +:- use_module(cgi). +:- use_module(clients). +:- use_module(config). +:- use_module(dcgs/response). +:- use_module(library(dcgs)). +:- use_module(library(lists)). +:- use_module(request). +:- use_module(serve). +:- use_module(ui/log). + +routing(S, TcpClient, TlsClientCert) :- + once(catch( ( read_request(S, Uri), + save_client(TlsClientCert), + routing_(S, TcpClient, TlsClientCert, Uri) + ), + gemini_error(DCG, Msg), + ( + log_msg("error", "~s", [Msg]), + phrase(response(DCG, Msg), Output), + format(S, "~s", [Output]) + ) + ) + ). + +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) -> + ( KeepQuery = keep_query, \+ Query = none, append([PathNew0, "?", Query], PathNew) + ; (KeepQuery = drop_query ; Query = none), PathNew = PathNew0 + ), + 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), + format(S, "~s", [Output]) + ; content(Root), + serve(S, Root, Uri) + ), + Err, + ( log_msg("error", "Internal server error: ~q", [Err]), + throw(gemini_error(permanent_failure, "Internal server error")) + ) + ). diff --git a/sula.pl b/sula.pl index 27275d4..c649638 100755 --- a/sula.pl +++ b/sula.pl @@ -25,6 +25,7 @@ exit 1 :- use_module(library(sockets)). :- use_module(library(tls)). :- use_module(request). +:- use_module(routing). :- use_module(serve). :- use_module(sys/mime). :- use_module(sys/tls_certs). @@ -45,7 +46,7 @@ run :- log_msg("system", "Listening on hostname `~s`", [Hostname]), once(load_certificate(TlsContext)), catch( - with_socket(TlsContext, with_connection_loop, req_serve), + with_socket(TlsContext, with_connection_loop, routing), Error, handle_top_level_error(Error) ). @@ -61,9 +62,10 @@ handle_top_level_error(Error) :- with_socket(TlsContext, Kont, Kont2) :- addr(Addr), port(Port), + number_chars(Port1, Port), ( setup_call_cleanup( - (log_msg("socket", "Opening socket ~q", [Addr:Port]), - socket_server_open(Addr:Port, Socket) + (log_msg("socket", "Opening socket ~q", [Addr:Port1]), + socket_server_open(Addr:Port1, Socket) ), call(Kont, TlsContext, Socket, Kont2), (log_msg("socket", "Closing socket", []), @@ -85,7 +87,7 @@ with_connection_loop(TlsContext, Socket, Kont) :- ), with_tls_connection(S0, TlsContext, TcpClient, Kont), ( close(S0), - log_msg("tcp", "Closed connection for client ~q", [Client]) + log_msg("tcp", "Closed connection for client ~q", [TcpClient]) ) ), Error, @@ -100,17 +102,3 @@ handle_conn_error(error(existence_error(stream, _), _)) :- !, handle_conn_error(Error) :- % log_msg("debug", "Re-throwing from conn loop: ~q", [Error]), throw(Error). - -req_serve(S, TcpClient, ClientCert) :- - once(catch( - ( read_request(S, Uri), - save_client(ClientCert), - content(Root), - serve(S, Root, Uri) - ), - gemini_error(DCG, Msg), - ( phrase(response(DCG, Msg), Response0), - format(S, "~s", [Response0]) - ) - ) - ). diff --git a/sys/tls_certs.pl b/sys/tls_certs.pl index e4f280f..dc65e04 100644 --- a/sys/tls_certs.pl +++ b/sys/tls_certs.pl @@ -2,7 +2,6 @@ :- use_module('../config'). :- use_module(library(dcgs)). -:- use_module(library(debug)). :- use_module(library(files)). :- use_module(library(iso_ext)). :- use_module(library(lists)). -- 2.54.0