Proper parsing of redirects and cgi from config

diff --git a/README.md b/README.md
index 13f4e3c93bc33662b92bd33525b093d0d78e1560..af86d1cca161d7be48fba7c42f0b5b0cd7b88610 100644 (file)
--- a/README.md
+++ b/README.md
@@ -111,8 +111,8 @@ banner.pl      Reads banner.txt and emits it line-by-line via display_banner/1.
 - [x] Client certificates
 - [x] Load configuration from a configuration file
 - [x] Save and load users
 - [x] Client certificates
 - [x] Load configuration from a configuration file
 - [x] Save and load users

-- [ ] Run CGI scripts
-- [ ] All status codes
+- [x] Run CGI scripts (almost done)
+- [-] All status codes

 - [ ] Rate limiting
 - [ ] Virtual hosting
 - [ ] File logging
 - [ ] Rate limiting
 - [ ] Virtual hosting
 - [ ] File logging

diff --git a/a.sh b/a.sh
deleted file mode 100755 (executable)
index 772052e..0000000
--- a/a.sh
+++ /dev/null
@@ -1,23 +0,0 @@
-#!/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="
-echo "$QUERY_STRING" | tr '&' '\n' | sed 's/^/- /' | sed 's/=/ → /g'
-echo "GEMINI_QUERY_STRING="
-echo "$GEMINI_QUERY_STRING" | tr '&' '\n' | sed 's/^/- /' | sed 's/=/ → /g'
-echo "AUTH_TYPE=$AUTH_TYPE"
-echo "REMOTE_USER=$REMOTE_USER"
-echo "REMOTE_IDENT=$REMOTE_IDENT"

diff --git a/cgi.pl b/cgi.pl
index 17100a4020602790f8bd5102b5dedf09fa0a68f9..83e341f02ddd97e100c5d9429eeaaea298be197b 100644 (file)
--- a/cgi.pl
+++ b/cgi.pl
@@ -69,6 +69,7 @@ tls_env(none, Env) :-
             "REMOTE_IDENT"=""
           ],
     !.
             "REMOTE_IDENT"=""
           ],
     !.

+% TODO: Need this from rustls

 tls_env(_, Env) :-
     Env = [ "AUTH_TYPE"="Certificate",
             "REMOTE_USER"="TODO",
 tls_env(_, Env) :-
     Env = [ "AUTH_TYPE"="Certificate",
             "REMOTE_USER"="TODO",

diff --git a/clients.pl b/clients.pl
index 071af201d8d1c9da460aec3cbaeb4ca4bdd1666d..429a7927e4f6372be1be64b08ac685fc52d1f6d0 100644 (file)
--- a/clients.pl
+++ b/clients.pl
@@ -1,6 +1,7 @@
 :- module(clients, [save_client/1, load_clients/0]).
 
 :- use_module(library(files)).
 :- module(clients, [save_client/1, load_clients/0]).
 
 :- use_module(library(files)).

+:- use_module(library(crypto)).

 :- use_module(library(iso_ext)).
 :- use_module(library(pio)).
 :- use_module(ui/log).
 :- use_module(library(iso_ext)).
 :- use_module(library(pio)).
 :- use_module(ui/log).


@@ -29,17 +30,18 @@ read_clients(Stream) :-
 
 save_client(none) :- !.
 save_client(ClientCert) :-
 
 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]),
-    setup_call_cleanup(
-        open("clients_db.pl", append, S),
-        (write(S, known_client(ClientCert)),
-         put_char(S, (.)),
-         put_char(S, '\n')
-        ),
-        close(S)
-    ),
-    assertz(known_client(ClientCert)).
+    hex_bytes(Hex, ClientCert),
+    ( known_client(ClientCert),
+      !,
+      log_msg("clients", "Known client ~s", [Hex])
+    ; log_msg("clients", "Registering new client with cert ~s", [Hex]),
+      setup_call_cleanup(
+          open("clients_db.pl", append, S),
+          (write(S, known_client(ClientCert)),
+           put_char(S, (.)),
+           put_char(S, '\n')
+          ),
+          close(S)
+      ),
+      assertz(known_client(ClientCert))
+    ).

diff --git a/config.pl b/config.pl
index c493d6181cbab3e2972986f0a98172b038c95b60..f0a38ca2ac98d709504a41ed52a102a1b08d76d4 100644 (file)
--- a/config.pl
+++ b/config.pl
@@ -4,10 +4,14 @@
                    addr/1,
                    port/1,
                    content/1,
                    addr/1,
                    port/1,
                    content/1,

-                   hostname/1
+                   hostname/1,
+                   redirect/4,
+                   cgi/2

                   ]).
 
                   ]).
 

+:- use_module(library(charsio)).

 :- use_module(library(dcgs)).
 :- use_module(library(dcgs)).

+:- use_module(library(clpz)).

 :- use_module(library(files)).
 :- use_module(library(iso_ext)).
 :- use_module(library(lists)).
 :- use_module(library(files)).
 :- use_module(library(iso_ext)).
 :- use_module(library(lists)).


@@ -17,14 +21,6 @@
 
 :- dynamic(cfg/2).
 
 
 :- dynamic(cfg/2).
 

-%% Defaults — applied first, then overridden by any CLI args.
-default(cert,     "./cert.pem").
-default(key,      "./key.pem").
-default(addr,     '127.0.0.1').
-default(port,     "1965").
-default(content,  "./site").
-default(hostname, "localhost").
-

 % Public accessors are static rules over the dynamic cfg/2, so they remain
 % importable via use_module/1 even as values get retracted/asserted.
 cert(V)     :- cfg(cert, V).
 % Public accessors are static rules over the dynamic cfg/2, so they remain
 % importable via use_module/1 even as values get retracted/asserted.
 cert(V)     :- cfg(cert, V).


@@ -33,6 +29,8 @@ addr(V)     :- cfg(addr, V).
 port(V)     :- cfg(port, V).
 content(V)  :- cfg(content, V).
 hostname(V) :- cfg(hostname, V).
 port(V)     :- cfg(port, V).
 content(V)  :- cfg(content, V).
 hostname(V) :- cfg(hostname, V).

+redirect(From, To, Mode, KeepQuery) :- cfg(redirect, redirect(From, To, Mode, KeepQuery)).
+cgi(Path, Script) :- cfg(cgi, cgi(Path, Script)).

 
 %% load_config.
 %
 
 %% load_config.
 %


@@ -40,10 +38,11 @@ hostname(V) :- cfg(hostname, V).
 % (everything after `--`) via os:argv/1 and updates the config facts. Recognised
 % options, accepted in any order:
 %
 % (everything after `--`) via os:argv/1 and updates the config facts. Recognised
 % options, accepted in any order:
 %

-%   --addr HOST:PORT       bind address and port
+%   --addr HOST            bind address
+%   --port PORT            bind port

 %   --hostname NAME        server hostname
 %   --content DIR          content root directory
 %   --hostname NAME        server hostname
 %   --content DIR          content root directory

-%   --certs DIR            certificate directory (expects DIR/identity.p12)
+%   --certs DIR            certificate directory (expects DIR/{cert.pem, key.pem})

 %
 % Unrecognised arguments are ignored.
 load_config :-
 %
 % Unrecognised arguments are ignored.
 load_config :-


@@ -51,10 +50,19 @@ load_config :-
     once(load_config_file),
     once(load_cli_args).
 
     once(load_config_file),
     once(load_cli_args).
 

+%% Defaults — applied first, then overridden by any CLI or file args.

 install_defaults :-
     retractall(cfg(_, _)),
     forall(default(K, V), assertz(cfg(K, V))).
 
 install_defaults :-
     retractall(cfg(_, _)),
     forall(default(K, V), assertz(cfg(K, V))).
 

+default(cert,     "./cert.pem").
+default(key,      "./key.pem").
+default(addr,     '127.0.0.1').
+default(port,     "1965").
+default(content,  "./site").
+default(hostname, "localhost").
+
+% Parse CLI options

 load_cli_args :-
     argv(Args),
     phrase(options(Opts), Args),
 load_cli_args :-
     argv(Args),
     phrase(options(Opts), Args),


@@ -70,6 +78,7 @@ option(content(C))  --> ["--content", C].
 option(certs(D))    --> ["--certs", D].
 option(unknown(X))  --> [X].
 
 option(certs(D))    --> ["--certs", D].
 option(unknown(X))  --> [X].
 

+% Applying options

 apply_opts([]).
 apply_opts([Opt|Opts]) :- apply_opt(Opt), apply_opts(Opts).
 
 apply_opts([]).
 apply_opts([Opt|Opts]) :- apply_opt(Opt), apply_opts(Opts).
 


@@ -79,20 +88,42 @@ apply_opt(hostname(H)) :- set_cfg(hostname, H).
 apply_opt(content(C))  :- set_cfg(content, C).
 apply_opt(certs(D))    :- append(D, "/cert.pem", Cert), set_cfg(cert, Cert),
                           append(D, "/key.pem", Key), set_cfg(key, Key) .
 apply_opt(content(C))  :- set_cfg(content, C).
 apply_opt(certs(D))    :- append(D, "/cert.pem", Cert), set_cfg(cert, Cert),
                           append(D, "/key.pem", Key), set_cfg(key, Key) .

+apply_opt(cgi(Path, Script)) :- assertz(cfg(cgi, cgi(Path, Script))).
+apply_opt(Term) :-
+    Term =.. [redirect, From, To, Opts],
+    ( permutation(Opts, [Mode, keep_query]) ->
+      ( mode_to_response(Mode, Mode1),
+        assertz(cfg(redirect, redirect(From, To, Mode1, keep_query)))
+      )
+    ; Opts = [keep_query] ->
+      assertz(cfg(redirect, redirect(From, To, temporary_redirection, keep_query)))
+    ; Opts = [Mode] ->
+      mode_to_response(Mode, Mode1),
+      assertz(cfg(redirect, redirect(From, To, Mode1, drop_query)))
+    ; Opts = [] ->
+      assertz(cfg(redirect, redirect(From, To, temporary_redirection, drop_query)))
+    ).

 apply_opt(unknown(_)).
 
 set_cfg(Key, Value) :-
     retractall(cfg(Key, _)),
     assertz(cfg(Key, Value)).
 
 apply_opt(unknown(_)).
 
 set_cfg(Key, Value) :-
     retractall(cfg(Key, _)),
     assertz(cfg(Key, Value)).
 

-parse_addr_port(Chars, Addr, Port) :-
-    append(AddrChars, [':'|PortChars], Chars),
-    !,
-    atom_chars(Addr, AddrChars),
-    number_chars(Port, PortChars).
-
-%% Loading the configuration file
-
+%% load_config_file
+%
+% Loading the configuration file
+%
+% Configuration file can contain multiple options
+%
+% ```
+% hostname("XXXXX").
+% port("NNNN").
+% addr("XXXXX").
+% content("XXXXX").
+% certs("XXXXX").
+% cgi("/XXXX", "/XXXX").
+% redirect("/XXXX", "/XXXX", Opts).  % where opts can contain permanent|temporary and keep_query
+% ```

 load_config_file :-
     (   file_exists("site.pl")
     ->  log_msg("conf", "Reading config from ~s", ["site.pl"]),
 load_config_file :-
     (   file_exists("site.pl")
     ->  log_msg("conf", "Reading config from ~s", ["site.pl"]),


@@ -114,10 +145,48 @@ read_config_terms(Stream) :-
     ).
 
 valid_cfg_opt(Term) :-
     ).
 
 valid_cfg_opt(Term) :-

-    Term =.. [Functor, Value],
+    Term =.. [Functor, Value] ->

     ( Functor = addr, atom_si(Value)
     ; Functor = port, chars_si(Value)
     ; Functor = hostname, chars_si(Value)
     ; Functor = content, chars_si(Value)
     ; Functor = certs, chars_si(Value)
     ( Functor = addr, atom_si(Value)
     ; Functor = port, chars_si(Value)
     ; Functor = hostname, chars_si(Value)
     ; Functor = content, chars_si(Value)
     ; Functor = certs, chars_si(Value)

-    ).
+    )
+    ; Term =.. [cgi, Path, Script] ->
+      maplist(chars_si, [Path, Script]),
+      maplist(is_path, [Path, Script])
+    ; Term =.. [redirect, From, To, Opts] ->
+      maplist(chars_si, [From, To]),
+      maplist(is_path, [From, To]),
+      list_si(Opts),
+      maplist(atom_si, Opts),
+      maplist(mode_or_keep_query, Opts),
+      \+ permutation(Opts, [permanent, temporary]),
+      length(Opts, L),
+      L #< 3.
+
+%% Helpers
+mode_to_response(Mode, Mode1) :-
+    atom_chars(Mode, ModeS),
+    append(ModeS, "_redirection", ModeS1),
+    atom_chars(Mode1, ModeS1).
+
+parse_addr_port(Chars, Addr, Port) :-
+    append(AddrChars, [':'|PortChars], Chars),
+    !,
+    atom_chars(Addr, AddrChars),
+    number_chars(Port, PortChars).
+
+mode_or_keep_query(permanent).
+mode_or_keep_query(temporary).
+mode_or_keep_query(keep_query).
+
+is_path(P) :-
+    P = ['/'|Ps],
+    maplist(char_or_slash, Ps).
+
+char_or_slash(C) :-
+    char_type(C, alpha).
+char_or_slash('/').
+char_or_slash('-').
+char_or_slash('.').

diff --git a/routing.pl b/routing.pl
index e286b160b3946f21b08ff42c8e13987dddfb3204..449fdb91f71ff5a07e858dd46be2678bdc782f5c 100644 (file)
--- a/routing.pl
+++ b/routing.pl
@@ -24,9 +24,6 @@ routing(S, TcpClient, TlsClientCert) :-
               )
         ).
 
               )
         ).
 

-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) ->
 routing_(S, TcpClient, TlsClientCert, Uri) :-
     Uri = uri(_, _, Path, Query),
     catch(( redirect(Path, PathNew0, Mode, KeepQuery) ->


@@ -36,8 +33,10 @@ routing_(S, TcpClient, TlsClientCert, Uri) :-
             log_msg("routing", "Redirect (~a, ~a) ~s -> ~s", [Mode, KeepQuery, Path, PathNew]),
             phrase(response(Mode, PathNew), Output),
             format(S, "~s", [Output])
             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),
+          ; cgi(Path, Script) ->
+            content(Root),
+            append(Root, Script, Script1),
+            run_cgi(Script1, Uri, TcpClient, TlsClientCert, Output),

             format(S, "~s", [Output])
           ; content(Root),
             serve(S, Root, Uri)
             format(S, "~s", [Output])
           ; content(Root),
             serve(S, Root, Uri)

diff --git a/sys/tls_certs.pl b/sys/tls_certs.pl
index dc65e04219861bc11d7b38f6d93f321e53638af0..3617bdcdd3d5bcb80bffd07f4bcfa14d51f66d22 100644 (file)
--- a/sys/tls_certs.pl
+++ b/sys/tls_certs.pl
@@ -5,6 +5,7 @@
 :- use_module(library(files)).
 :- use_module(library(iso_ext)).
 :- use_module(library(lists)).
 :- use_module(library(files)).
 :- use_module(library(iso_ext)).
 :- use_module(library(lists)).

+:- use_module(library(crypto)).

 :- use_module(library(pio)).
 :- use_module(library(process)).
 :- use_module(library(tls)).
 :- use_module(library(pio)).
 :- use_module(library(process)).
 :- use_module(library(tls)).


@@ -68,7 +69,7 @@ with_tls_connection(S0, Context, TcpClient, Kont) :-
     setup_call_cleanup(
         ( log_msg("tls-conn", "Handshaking TLS", []),
           tls_server_negotiate(Context, S0, S, [client_certificate(ClientCert)]),
     setup_call_cleanup(
         ( log_msg("tls-conn", "Handshaking TLS", []),
           tls_server_negotiate(Context, S0, S, [client_certificate(ClientCert)]),

-          ( \+ ClientCert = none, log_msg("tls-conn", "Client cert ~q", [ClientCert])
+          ( \+ ClientCert = none, hex_bytes(Hex, ClientCert), log_msg("tls-conn", "Client cert ~s", [Hex])

           ; true
           )
         ),
           ; true
           )
         ),