first commit

diff --git a/url.pl b/url.pl
new file mode 100644 (file)
index 0000000..305b90c
--- /dev/null
+++ b/url.pl
@@ -0,0 +1,172 @@
+:- module(url, [main/0]).
+
+:- use_module(library(charsio)).
+:- use_module(library(dcgs)).
+:- use_module(library(sockets)).
+:- use_module(library(tls)).
+:- use_module(library(pio)).
+:- use_module(library(lists)).
+:- use_module(library(iso_ext)).
+
+request(url(Scheme, Host, Port, Path, Query, Fragment)) -->
+    url(Scheme, Host, Port, Path, Query, Fragment),
+    crlf.
+
+url(Scheme, Host, Port, Path, Query, Fragment) -->
+    scheme(Scheme),
+    "://",
+    host(Host),
+    port_opt(Port),
+    path(Path),
+    query(Query),
+    fragment(Fragment).
+
+scheme(Scheme) -->
+    alpha_word(Chars),
+    { atom_chars(Scheme, Chars) }.
+
+host(Host) -->
+    chars_host(Chars),
+    { atom_chars(Host, Chars) }.
+
+port_opt(Port) -->
+    ":",
+    digits(Chars),
+    { number_chars(Port, Chars) }.
+port_opt(none) --> [].
+
+path(Path) -->
+    "/",
+    chars_path(Chars),
+    { atom_chars(Path, ['/'|Chars]) }.
+path('/') --> [].
+
+query(Query) -->
+    "?",
+    chars_query(Chars),
+    { atom_chars(Query, ['?'|Chars]) }.
+query(none) --> [].
+
+fragment(Fragment) -->
+    "#",
+    chars_fragment(Chars),
+    { atom_chars(Fragment, ['#'|Chars]) }.
+fragment(none) --> [].
+
+alpha_word([C|Cs]) --> [C], { char_type(C, alpha) }, !, alpha_word(Cs).
+alpha_word([])     --> [].
+
+digits([C|Cs]) --> [C], { char_type(C, decimal_digit) }, !, digits(Cs).
+digits([])     --> [].
+
+chars_host([C|Cs]) --> [C], { C \= (/), C \= (:) }, !, chars_host(Cs).
+chars_host([])     --> [].
+
+chars_path([C|Cs]) --> [C], { C \= (#), C \= (?), C \= '\r' }, !, chars_path(Cs).
+chars_path([])     --> [].
+
+chars_query([C|Cs]) --> [C], { C \= (#), C \= (?), C \= '\r' }, !, chars_query(Cs).
+chars_query([])     --> [].
+
+chars_fragment([C|Cs]) --> [C], { C \= (#), C \= (?), C \= '\r' }, !, chars_fragment(Cs).
+chars_fragment([])     --> [].
+
+% ------------------------------------------------------------------------------
+
+crlf --> "\r\n".
+sp --> " ".
+
+response(X) -->
+    { X \= input, X \= sensitive_input, X \= temporary_redirection, X \= permanent_redirection, X \= success },
+    response_(X), crlf.
+response(X, Msg)              --> response_(X), sp, Msg, crlf.
+
+response_(success) --> "20".
+response_(input)                 --> "10".
+response_(sensitive_input)       --> "11".
+response_(temporary_redirection) --> "30".
+response_(permanent_redirection) --> "31".
+response_(temporary_failure)     --> "40".
+response_(server_unavailable)    --> "41".
+response_(cgi_error)             --> "42".
+response_(proxy_error)           --> "43".
+response_(slow_down)             --> "44".
+response_(permanent_failure)     --> "50".
+response_(not_found)             --> "51".
+response_(gone)                  --> "52".
+response_(proxy_request_refused) --> "53".
+response_(bad_request)           --> "59".
+response_(auth)                  --> "60".
+response_(cert_not_auth)         --> "61".
+response_(cert_not_valid)        --> "62".
+
+main :-
+    phrase_from_file(seq(Chars), "identity.p12", [type(binary)]),
+    tls_server_context(Context, [pcks12(Chars)]),
+    setup_call_cleanup(
+        socket_server_open('127.0.0.1':1965, Socket),
+        loop(Socket, Context),
+        socket_server_close(Socket)
+        ).
+
+loop(Socket, Context) :-
+    format("Starting server~n", []),
+    socket_server_accept(Socket, Client, S0, []),
+    handle_connection(S0, Context),
+    loop(Socket, Context).
+
+handle_connection(S0, Context) :-
+    format("Waiting for connection~n", []),
+    tls_server_negotiate(Context, S0, S),
+    format("Negotiated tls~n", []),
+    read_gemini_line(S, RequestChars),
+    format("Received raw request: ~s~n", [RequestChars]),
+    phrase(request(url(Scheme, Host, Port, Path, Query, Fragment)), RequestChars),
+    format("Requested file ~a~n", [Path]),
+    serve(S, Path),
+    close(S).
+
+serve(S, Path) :-
+    get_gem_file(Path, File),
+    phrase_from_file(seq(Chars1), File),
+    phrase(response(success, "text/gemini"), Response0),
+    format(S, "~s\r\n", [Response0]),
+    format(S, "~s", [Chars1]).
+serve(S, Path) :-
+    atom_chars(Path, Chars),
+    append(_, ".tar.xz", Chars),
+    append("site", Chars, File),
+    setup_call_cleanup(
+        open(File, read, FileStream, [type(binary)]),
+        (phrase(response(success, "application/x-tar"), Response0),
+        format(S, "~s\r\n", [Response0]),
+        stream_bytes(FileStream, S)
+        ),
+        close(FileStream)
+    ).
+
+stream_bytes(FileStream, Socket) :-
+    get_byte(FileStream, Byte),
+    ( Byte = -1;
+      Byte \= -1,
+      char_code(C, Byte),
+      put_char(Socket, C),
+      stream_bytes(FileStream, Socket)
+    ).
+
+get_gem_file(/, "site/index.gmi").
+get_gem_file(Atom, File) :-
+    atom_chars(Atom, Chars),
+    append(_, ".gmi", Chars),
+    append("site", Chars, File).
+
+read_gemini_line(Stream, Chars) :-
+    get_char(Stream, C),
+    read_gemini_line_(C, Stream, Chars).
+
+read_gemini_line_('\n', _, ['\n']) :- !. % End of the request reached
+read_gemini_line_(C, Stream, [C|Cs]) :-
+    get_char(Stream, Cnext),
+    read_gemini_line_(Cnext, Stream, Cs).
+
+:- initialization(main).