:- 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).
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))
+ ).
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(clpz)).
:- use_module(library(files)).
:- use_module(library(iso_ext)).
:- use_module(library(lists)).
:- 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).
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.
%
% (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
-% --certs DIR certificate directory (expects DIR/identity.p12)
+% --certs DIR certificate directory (expects DIR/{cert.pem, key.pem})
%
% Unrecognised arguments are ignored.
load_config :-
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))).
+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),
option(certs(D)) --> ["--certs", D].
option(unknown(X)) --> [X].
+% Applying options
apply_opts([]).
apply_opts([Opt|Opts]) :- apply_opt(Opt), apply_opts(Opts).
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)).
-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"]),
).
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)
- ).
+ )
+ ; 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('.').
)
).
-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) ->
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)
projects / sula.git / commitdiff