First successful CGI execution

diff --git a/a.sh b/a.sh
new file mode 100755 (executable)
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 5c091c9a8feceb429011e89150c4a7bbe831e8ba..d8b99e0840c1c23764ea5b4119b74a88ce7fa75e 100644 (file)
--- 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 f285d54183bd61711ce6f770067b21adbb28e6e8..071af201d8d1c9da460aec3cbaeb4ca4bdd1666d 100644 (file)
--- 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 8ae3808eaae2aa941885634b8b5690c3c84c3635..c493d6181cbab3e2972986f0a98172b038c95b60 100644 (file)
--- 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 17dae0ee96ab3a0c4adf62e5d9afb7cb88e433b9..a64c7e990211d62bf9fc4ffa455ba3e6acfa254e 100644 (file)
--- 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 da6d9f17ebd20114589b28e1ffd5c2762c54706b..289034eee69c6127166a9cead0040863cd1f8165 100644 (file)
--- 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 (file)
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 27275d4946739fae4f2e8e5d8f4c5b5fce84979c..c6496388a601b7b81ddc3bc063b41ade1e3c83bc 100755 (executable)
--- 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 e4f280fee2c7876a839185176d6dbf66a2e2892e..dc65e04219861bc11d7b38f6d93f321e53638af0 100644 (file)
--- 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)).