More features

diff --git a/.gitignore b/.gitignore
index 5efcf514adf8db38708c55c07a602dc03dc1be61..9a7264ba7a8ef241e98efefab2b0f0b0cdfdea34 100644 (file)
--- a/.gitignore
+++ b/.gitignore
@@ -1,3 +1,6 @@
 cert.pem
 key.pem
 cert.pem
 key.pem

-site
\ No newline at end of file
+site
+*.bak
+clients_db.pl
+site.pl
\ No newline at end of file

diff --git a/README.md b/README.md
index 0bb23e9034c5de95cdfe5657bea586762d4d54b1..13f4e3c93bc33662b92bd33525b093d0d78e1560 100644 (file)
--- a/README.md
+++ b/README.md
@@ -109,7 +109,8 @@ banner.pl      Reads banner.txt and emits it line-by-line via display_banner/1.
 
 - [x] Use key and cert instead of identity.p12
 - [x] Client certificates
 
 - [x] Use key and cert instead of identity.p12
 - [x] Client certificates

-- [ ] Load configuration from a configuration file
+- [x] Load configuration from a configuration file
+- [x] Save and load users

 - [ ] Run CGI scripts
 - [ ] All status codes
 - [ ] Rate limiting
 - [ ] Run CGI scripts
 - [ ] All status codes
 - [ ] Rate limiting

diff --git a/banner.pl b/banner.pl
index b9ae7a4459ef79a5895bb16630bffd1c2854b46c..2dd689bbeeac2c6ba0b34efde9a394600b8d9bbf 100644 (file)
--- a/banner.pl
+++ b/banner.pl
@@ -1,15 +1,14 @@
-:- module(banner, [display_banner/1]).
+:- module(banner, [display_banner/0]).

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

+:- use_module(library(lambda)).

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

+:- use_module(log).

 
 

-:- meta_predicate(display_banner(1)).
-
-display_banner(F_1) :-
+display_banner :-

     phrase_from_file(lines(Ls), "banner.txt"),
     phrase_from_file(lines(Ls), "banner.txt"),

-    maplist(F_1, Ls),
-    call(F_1, "").
+    maplist(\S^log_msg("system", "~s~n", [S]), Ls).

 
 lines([])     --> call(eos), !.
 lines([L|Ls]) --> line(L), lines(Ls).
 
 lines([])     --> call(eos), !.
 lines([L|Ls]) --> line(L), lines(Ls).

diff --git a/clients.pl b/clients.pl
new file mode 100644 (file)
index 0000000..df66a3f
--- /dev/null
+++ b/clients.pl
@@ -0,0 +1,45 @@
+:- module(clients, [save_client/1, load_clients/0]).
+
+:- use_module(log).
+:- use_module(library(files)).
+:- use_module(library(pio)).
+:- use_module(library(iso_ext)).
+
+:- dynamic(known_client/1).
+
+load_clients :-
+    log_msg("clients", "Loading client database~n", []),
+    catch(
+        setup_call_cleanup(
+            open("clients_db.pl", read, S),
+            read_clients(S),
+            close(S)
+        ),
+        error(existence_error(source_sink,"clients_db.pl"),open/4),
+        (open("clients_db.pl", write, S),
+         close(S))
+        ).
+
+read_clients(Stream) :-
+    read_term(Stream, Term, []),
+    (   Term == end_of_file
+    ->  true
+    ;   assertz(Term),
+        read_clients(Stream)
+    ).
+
+save_client(none).
+save_client(ClientCert) :-
+    known_client(ClientCert),
+    log_msg("clients", "Known client ~q~n", [ClientCert])
+    ;
+    log_msg("clients", "Registering new client with cert ~q~n", [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)).

diff --git a/config.pl b/config.pl
index 8abbe1d07c397ffe41041c21a76de5b79d6d559d..d11e13f0db17bafd0de09e216453b08525ef1400 100644 (file)
--- a/config.pl
+++ b/config.pl
@@ -1,14 +1,22 @@
-:- module(config, [cert/1, key/1, addr/1, port/1, content/1, hostname/1]).
+:- module(config, [load_config/0,
+                   cert/1,
+                   key/1,
+                   addr/1,
+                   port/1,
+                   content/1,
+                   hostname/1
+                  ]).

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

+:- use_module(library(files)).

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

+:- use_module(library(si)).
+:- use_module(log).

 
 :- dynamic(cfg/2).
 
 
 :- dynamic(cfg/2).
 

-:- initialization(load_config).
-

 %% Defaults — applied first, then overridden by any CLI args.
 default(cert,     "./cert.pem").
 default(key,      "./key.pem").
 %% Defaults — applied first, then overridden by any CLI args.
 default(cert,     "./cert.pem").
 default(key,      "./key.pem").


@@ -28,8 +36,9 @@ hostname(V) :- cfg(hostname, V).
 
 %% load_config.
 %
 
 %% load_config.
 %

-% Reads command-line arguments (everything after `--`) via os:argv/1 and
-% updates the config facts. Recognised options, accepted in any order:
+% Reads configuration file `site.pl`. Then reads command-line arguments
+% (everything after `--`) via os:argv/1 and updates the config facts. Recognised
+% options, accepted in any order:

 %
 %   --addr HOST:PORT       bind address and port
 %   --hostname NAME        server hostname
 %
 %   --addr HOST:PORT       bind address and port
 %   --hostname NAME        server hostname


@@ -38,16 +47,19 @@ hostname(V) :- cfg(hostname, V).
 %
 % Unrecognised arguments are ignored.
 load_config :-
 %
 % Unrecognised arguments are ignored.
 load_config :-

-    install_defaults,
-    argv(Args),
-
-    phrase(options(Opts), Args),
-    apply_opts(Opts).
+    once(install_defaults),
+    once(load_config_file),
+    once(load_cli_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))).
 

+load_cli_args :-
+    argv(Args),
+    phrase(options(Opts), Args),
+    apply_opts(Opts).
+

 options([])         --> [].
 options([Opt|Opts]) --> option(Opt), options(Opts).
 
 options([])         --> [].
 options([Opt|Opts]) --> option(Opt), options(Opts).
 


@@ -78,3 +90,34 @@ parse_addr_port(Chars, Addr, Port) :-
     !,
     atom_chars(Addr, AddrChars),
     number_chars(Port, PortChars).
     !,
     atom_chars(Addr, AddrChars),
     number_chars(Port, PortChars).

+
+%% Loading the configuration file
+
+load_config_file :-
+    (   file_exists("site.pl")
+    ->  log_msg("conf", "Reading config from ~s~n", ["site.pl"]),
+        open("site.pl", read, Stream),
+        read_config_terms(Stream),
+        close(Stream)
+    ;   true
+    ).
+
+read_config_terms(Stream) :-
+    read_term(Stream, Term, []),
+    (   Term == end_of_file
+    ->  true
+    ;   (  valid_cfg_opt(Term)
+        -> apply_opt(Term)
+        ;  true
+        ),
+        read_config_terms(Stream)
+    ).
+
+valid_cfg_opt(Term) :-
+    Term =.. [Functor, Value],
+    ( Functor = addr, atom_si(Value)
+    ; Functor = port, integer_si(Value)
+    ; Functor = hostname, chars_si(Value)
+    ; Functor = content, chars_si(Value)
+    ; Functor = certs, chars_si(Value)
+    ).

diff --git a/response.pl b/response.pl
index a4acf3c2b506bf8273e71b6739915360ea69cea2..749778547ce3195ae983b54819ba7f1e0fd89baa 100644 (file)
--- a/response.pl
+++ b/response.pl
@@ -1,64 +1,6 @@
-:- module(response, [serve/3]).
+:- module(response, [response//1, response//2]).

 
 

-:- use_module(config).

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

-:- use_module(library(files)).
-:- use_module(library(iso_ext)).
-:- use_module(library(lists)).
-:- use_module(library(pio)).
-:- use_module(library(sockets)).
-:- use_module(log).
-:- use_module(mime).
-
-%% serve(+Stream, +Path, +Query)
-%
-% Serve the file at Path to Stream
-serve(S, /, Q) :-
-    serve(S, '/index.gmi', Q).
-serve(S, Path, _) :-
-    atom_chars(Path, Chars),
-    ( is_absolute(Chars),
-      guess_mime(Chars, Mime),
-      content(Root),
-      append(Root, Chars, File),
-      file_exists(File),
-      log_msg("response", "File does exist~n", []),
-      ( serve_text(S, Mime, File)
-      ; serve_binary(S, Mime, File)
-      )
-    ;
-    log_msg("error", "File not found~n", []),
-    phrase(response(not_found, "File not found, sorry"), Response0),
-    format(S, "~s", [Response0])
-    ).
-
-is_absolute(Path) :-
-    \+ append([_, "..", _], Path).
-
-serve_text(S, Mime, File) :-
-    append("text/", _, Mime),
-    phrase_from_file(seq(Body), File),
-    log_msg("response", "Sending text response~n", []),
-    phrase(response(success, Mime), Response0),
-    format(S, "~s", [Response0]),
-    format(S, "~s", [Body]),
-    log_msg("response", "Sent text response~n", []).
-
-serve_binary(S, Mime, File) :-
-    setup_call_cleanup(
-        open(File, read, FileStream, [type(binary)]),
-        (
-            log_msg("response", "Sending binary response~n", []),
-            phrase(response(success, Mime), Response0),
-            format(S, "~s", [Response0]),
-            open(stream(S), write, _, [type(binary)]),
-            catch(copy_stream(FileStream, S),
-                  error(existence_error(stream, _), _),
-                  log_msg("response", "Client disconnected mid-stream~n", [])),
-            log_msg("response", "Sent binary response~n", [])
-        ),
-        close(FileStream)
-      ).

 
 crlf --> "\r\n".
 sp --> " ".
 
 crlf --> "\r\n".
 sp --> " ".

diff --git a/serve.pl b/serve.pl
new file mode 100644 (file)
index 0000000..87f5329
--- /dev/null
+++ b/serve.pl
@@ -0,0 +1,67 @@
+:- module(serve, [serve/3]).
+
+:- use_module(library(dcgs)).
+:- use_module(config).
+:- use_module(library(files)).
+:- use_module(library(iso_ext)).
+:- use_module(library(lists)).
+:- use_module(library(pio)).
+:- use_module(library(sockets)).
+:- use_module(log).
+:- use_module(mime).
+:- use_module(response).
+
+%% serve(+Stream, +Path, +Query)
+%
+% Serve the file at Path to Stream
+serve(S, /, Q) :-
+    serve(S, '/index.gmi', Q).
+serve(S, Path, _) :-
+    atom_chars(Path, Chars),
+    (  is_absolute(Chars)
+    -> guess_mime(Chars, Mime),
+       content(Root),
+       append(Root, Chars, File),
+       (  file_exists(File)
+       -> log_msg("response", "File does exist~n", []),
+          ( serve_text(S, Mime, File)
+          ; serve_binary(S, Mime, File)
+          )
+       ;  log_msg("error", "File not found~n", []),
+          phrase(response(not_found, "File not found!"), Response0),
+          format(S, "~s", [Response0])
+       )
+    ; log_msg("error", "Non-absolute path requested~n", []),
+      phrase(response(bad_request, "Non-absolute paths are forbidden!"), Response0),
+      format(S, "~s", [Response0])
+    ).
+
+is_absolute(Path) :-
+    path_segments(Path, Segs),
+    \+ member("..", Segs),
+    \+ member(".", Segs).
+
+serve_text(S, Mime, File) :-
+    append("text/", _, Mime),
+    phrase_from_file(seq(Body), File),
+    log_msg("response", "Sending text response~n", []),
+    phrase(response(success, Mime), Response0),
+    format(S, "~s", [Response0]),
+    format(S, "~s", [Body]),
+    log_msg("response", "Sent text response~n", []).
+
+serve_binary(S, Mime, File) :-
+    setup_call_cleanup(
+        open(File, read, FileStream, [type(binary)]),
+        (
+            log_msg("response", "Sending binary response~n", []),
+            phrase(response(success, Mime), Response0),
+            format(S, "~s", [Response0]),
+            open(stream(S), write, _, [type(binary)]),
+            catch(copy_stream(FileStream, S),
+                  error(existence_error(stream, _), _),
+                  log_msg("response", "Client disconnected mid-stream~n", [])),
+            log_msg("response", "Sent binary response~n", [])
+        ),
+        close(FileStream)
+      ).

diff --git a/sula.pl b/sula.pl
index 14dcbbaf5870e33414ab4d3958f51094ea4bb705..7ce3d32a57a8e35723ad25672dbef74e8e9fcbc5 100755 (executable)
--- a/sula.pl
+++ b/sula.pl
@@ -13,6 +13,7 @@ exit 1
 :- module(sula, [run/0]).
 
 :- use_module(cert).
 :- module(sula, [run/0]).
 
 :- use_module(cert).

+:- use_module(clients).

 :- use_module(banner).
 :- use_module(config).
 :- use_module(library(charsio)).
 :- use_module(banner).
 :- use_module(config).
 :- use_module(library(charsio)).


@@ -23,21 +24,22 @@ exit 1
 :- use_module(library(lists)).
 :- use_module(library(pio)).
 :- use_module(library(sockets)).
 :- use_module(library(lists)).
 :- use_module(library(pio)).
 :- use_module(library(sockets)).

-:- use_module(library(lambda)).

 :- use_module(library(tls)).
 :- use_module(log).
 :- use_module(mime).
 :- use_module(library(tls)).
 :- use_module(log).
 :- use_module(mime).

+:- use_module(serve).

 :- use_module(request).
 :- use_module(response).
 
 run :-
 :- use_module(request).
 :- use_module(response).
 
 run :-

-    display_banner(\S^log_msg("system", "~s~n", [S])),
+    once(display_banner),
+    once(load_config),
+    once(load_clients),

     content(Site),
     log_msg("system", "Serving capsule at `~s`~n", [Site]),
     hostname(Hostname),
     log_msg("system", "Listening on hostname `~s`~n", [Hostname]),
     content(Site),
     log_msg("system", "Serving capsule at `~s`~n", [Site]),
     hostname(Hostname),
     log_msg("system", "Listening on hostname `~s`~n", [Hostname]),

-    load_certificate(Context),
-    !,
+    once(load_certificate(Context)),

     catch(
         with_socket(Context, with_connection_loop, req_serve),
         Error,
     catch(
         with_socket(Context, with_connection_loop, req_serve),
         Error,


@@ -113,7 +115,8 @@ handle_conn_error(Error) :-
       % log_msg("debug", "Re-throwing from conn loop: ~q~n", [Error]),
       throw(Error).
 
       % log_msg("debug", "Re-throwing from conn loop: ~q~n", [Error]),
       throw(Error).
 

-req_serve(S, _ClientCert) :-
+req_serve(S, ClientCert) :-

     read_request(S, Path, Query),
     read_request(S, Path, Query),

+    save_client(ClientCert),

     serve(S, Path, Query),
     !.
     serve(S, Path, Query),
     !.