307 lines
9.0 KiB
Prolog
307 lines
9.0 KiB
Prolog
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
Written in December 2020 by Adrián Arroyo (adrian.arroyocalle@gmail.com)
|
|
Updated in March 2022 by Adrián Arroyo to use the Hyper backend
|
|
Part of Scryer Prolog
|
|
|
|
This library provides an starting point to build HTTP server based applications.
|
|
It is based on Hyper, which allows for HTTP/1.0, HTTP/1.1 and HTTP/2. However,
|
|
some advanced features that Hyper provides are still not accesible.
|
|
|
|
Usage
|
|
==========
|
|
The main predicate of the library is http_listen/2, which needs a port number
|
|
(usually 80) and a list of handlers. A handler is a compound term with the functor
|
|
as one HTTP method (in lowercase) and followed by a Route Match and a predicate
|
|
which will handle the call.
|
|
|
|
text_handler(Request, Response) :-
|
|
http_status_code(Response, 200),
|
|
http_body(Response, text("Welcome to Scryer Prolog!")).
|
|
|
|
parameter_handler(User, Request, Response) :-
|
|
http_body(Response, text(User)).
|
|
|
|
http_listen(7890, [
|
|
get(echo, text_handler), % GET /echo
|
|
post(user/User, parameter_handler(User)) % POST /user/<User>
|
|
]).
|
|
|
|
Every handler predicate will have at least 2-arity, with Request and Response.
|
|
Although you can work directly with http_request and http_response terms, it is
|
|
recommeded to use the helper predicates, which are easier to understand and cleaner:
|
|
- http_headers(Response/Request, Headers)
|
|
- http_status_code(Responde, StatusCode)
|
|
- http_body(Response/Request, text(Body))
|
|
- http_body(Response/Request, binary(Body))
|
|
- http_body(Request, form(Form))
|
|
- http_body(Response, file(Filename))
|
|
- http_redirect(Response, Url)
|
|
- http_query(Request, QueryName, QueryValue)
|
|
|
|
Some things that are still missing:
|
|
- Read forms in multipart format
|
|
- HTTP Basic Auth
|
|
- Session handling via cookies
|
|
- HTML Templating
|
|
|
|
I place this code in the public domain. Use it in any way you want.
|
|
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
|
|
|
|
|
:- module(http_server, [
|
|
http_listen/2,
|
|
http_headers/2,
|
|
http_status_code/2,
|
|
http_body/2,
|
|
http_redirect/2,
|
|
http_query/3
|
|
]).
|
|
|
|
:- meta_predicate http_listen(?, :).
|
|
|
|
:- use_module(library(charsio)).
|
|
:- use_module(library(crypto)).
|
|
:- use_module(library(error)).
|
|
:- use_module(library(format)).
|
|
:- use_module(library(iso_ext)).
|
|
:- use_module(library(lists)).
|
|
:- use_module(library(pio)).
|
|
:- use_module(library(time)).
|
|
|
|
http_listen(Port, Module:Handlers0) :-
|
|
must_be(integer, Port),
|
|
must_be(list, Handlers0),
|
|
maplist(module_qualification(Module), Handlers0, Handlers),
|
|
http_listen_(Port, Handlers).
|
|
|
|
module_qualification(M, H0, H) :-
|
|
H0 =.. [Method, Path, Goal],
|
|
H =.. [Method, Path, M:Goal].
|
|
|
|
http_listen_(Port, Handlers) :-
|
|
number_chars(Port, CPort),
|
|
append("0.0.0.0:", CPort, Addr),
|
|
'$http_listen'(Addr, HttpListener),!,
|
|
format("Listening at ~s\n", [Addr]),
|
|
http_loop(HttpListener, Handlers).
|
|
|
|
http_loop(HttpListener, Handlers) :-
|
|
'$http_accept'(HttpListener, RequestMethod, RequestPath, RequestHeaders, RequestQuery, RequestStream, ResponseHandle),
|
|
current_time(Time),
|
|
phrase(format_time("%Y-%m-%d (%H:%M:%S)", Time), TimeString),
|
|
format("~s ~w ~s\n", [TimeString, RequestMethod, RequestPath]),
|
|
maplist(map_header_kv, RequestHeaders, RequestHeadersKV),
|
|
phrase(parse_queries(RequestQueries), RequestQuery),
|
|
(
|
|
match_handler(Handlers, RequestMethod, RequestPath, Handler) ->
|
|
(
|
|
HttpRequest = http_request(RequestHeadersKV, stream(RequestStream), RequestQueries),
|
|
HttpResponse = http_response(_, _, _),
|
|
(call(Handler, HttpRequest, HttpResponse) ->
|
|
send_response(ResponseHandle, HttpResponse)
|
|
; '$http_answer'(ResponseHandle, 500, [], "Internal Server Error")
|
|
)
|
|
)
|
|
; '$http_answer'(ResponseHandle, 404, [], "Not Found")
|
|
),
|
|
http_loop(HttpListener, Handlers).
|
|
|
|
send_response(ResponseHandle, http_response(StatusCode0, text(ResponseText), ResponseHeaders0)) :-
|
|
default(StatusCode0, 200, StatusCode),
|
|
maplist(map_header_kv_2, ResponseHeaders, ResponseHeaders0),
|
|
'$http_answer'(ResponseHandle, StatusCode, ResponseHeaders, ResponseStream),
|
|
format(ResponseStream, "~s", [ResponseText]),
|
|
close(ResponseStream).
|
|
|
|
send_response(ResponseHandle, http_response(StatusCode0, bytes(ResponseBytes), ResponseHeaders0)) :-
|
|
default(StatusCode0, 200, StatusCode),
|
|
maplist(map_header_kv_2, ResponseHeaders, ResponseHeaders0),
|
|
'$http_answer'(ResponseHandle, StatusCode, ResponseHeaders, ResponseStream),
|
|
format(ResponseStream, "~s", [ResponseBytes]),
|
|
close(ResponseStream).
|
|
|
|
send_response(ResponseHandle, http_response(StatusCode0, file(Filename), ResponseHeaders0)) :-
|
|
default(StatusCode0, 200, StatusCode),
|
|
maplist(map_header_kv_2, ResponseHeaders, ResponseHeaders0),
|
|
'$http_answer'(ResponseHandle, StatusCode, ResponseHeaders, ResponseStream),
|
|
setup_call_cleanup(
|
|
open(Filename, read, FileStream, [type(binary)]),
|
|
(
|
|
get_n_chars(FileStream, _, FileCs),
|
|
format(ResponseStream, "~s", [FileCs])
|
|
),
|
|
close(FileStream)
|
|
),
|
|
close(ResponseStream).
|
|
|
|
|
|
default(Var, Default, Out) :-
|
|
(var(Var) -> Out = Default
|
|
; Var = Out
|
|
).
|
|
|
|
map_header_kv(T, K-V) :-
|
|
T =.. [K0, V],
|
|
atom_chars(K0, K).
|
|
|
|
map_header_kv_2(T, K-V) :-
|
|
atom_chars(K0, K),
|
|
T =.. [K0, V].
|
|
|
|
match_handler(Handlers, Method, "/", Handler) :-
|
|
member(H, Handlers),
|
|
H =.. [Method, /, Handler].
|
|
match_handler(Handlers, Method, Path, Handler) :-
|
|
member(H, Handlers),
|
|
copy_term(H, H1),
|
|
H1 =.. [Method, Pattern, Handler],
|
|
\+ var(Pattern),
|
|
phrase(path(Pattern), Path).
|
|
match_handler(Handlers, Method, Path, Handler) :-
|
|
member(H, Handlers),
|
|
copy_term(H, H1),
|
|
H1 =.. [Method, Var, Handler],
|
|
var(Var),
|
|
Var = Path.
|
|
|
|
path(Pattern) -->
|
|
{
|
|
Pattern =.. Parts,
|
|
length(Parts, 3),
|
|
nth0(1, Parts, Pattern0),
|
|
nth0(2, Parts, PartAtom),
|
|
(var(PartAtom) -> Part = PartAtom; atom_chars(PartAtom, Part))
|
|
},
|
|
path(Pattern0),
|
|
"/",
|
|
string_without("/", Part).
|
|
|
|
path(Pattern) -->
|
|
{
|
|
Pattern =.. Parts,
|
|
Parts = [PartAtom],
|
|
(var(PartAtom) -> Part = PartAtom; atom_chars(PartAtom, Part))
|
|
},
|
|
"/",
|
|
string_without("/", Part).
|
|
|
|
path([]) --> [].
|
|
|
|
string_without(Not, [Char|String]) -->
|
|
[Char],
|
|
{
|
|
\+ member(Char, Not)
|
|
},
|
|
string_without(Not, String).
|
|
|
|
string_without(_, []) -->
|
|
[].
|
|
|
|
http_headers(http_request(Headers, _, _), Headers).
|
|
http_headers(http_response(_, _, Headers), Headers).
|
|
|
|
http_body(http_request(_, stream(StreamBody), _), bytes(BytesBody)) :- get_n_chars(StreamBody, _, BytesBody).
|
|
http_body(http_request(_, stream(StreamBody), _), text(TextBody)) :- get_n_chars(StreamBody, _, TextBody).
|
|
http_body(http_request(Headers, stream(StreamBody), _), form(FormBody)) :-
|
|
member("content-type"-"application/x-www-form-urlencoded", Headers),
|
|
get_n_chars(StreamBody, _, TextBody),
|
|
phrase(parse_queries(FormBody), TextBody).
|
|
http_body(http_request(_, Body, _), Body).
|
|
http_body(http_response(_, Body, _), Body).
|
|
|
|
http_status_code(http_response(StatusCode, _, _), StatusCode).
|
|
http_redirect(http_response(307, text("Moved Temporarily"), ["Location"-Uri]), Uri).
|
|
http_query(http_request(_, _, Queries), Key, Value) :- member(Key-Value, Queries).
|
|
|
|
parse_queries([Key-Value|Queries]) -->
|
|
string_without("=", Key0),
|
|
{
|
|
phrase(url_decode(Key), Key0)
|
|
},
|
|
"=",
|
|
string_without("&", Value0),
|
|
{
|
|
phrase(url_decode(Value), Value0)
|
|
},
|
|
"&",
|
|
parse_queries(Queries).
|
|
|
|
parse_queries([Key-Value]) -->
|
|
string_without("=", Key0),
|
|
{
|
|
phrase(url_decode(Key), Key0)
|
|
},
|
|
"=",
|
|
string_without(" ", Value0),
|
|
{
|
|
phrase(url_decode(Value), Value0)
|
|
}.
|
|
|
|
parse_queries([]) -->
|
|
[].
|
|
|
|
% Decodes a UTF-8 URL Encoded string: RFC-1738
|
|
url_decode([Char|Chars]) -->
|
|
[Char],
|
|
{
|
|
Char \= '%'
|
|
},
|
|
url_decode(Chars).
|
|
url_decode([Char|Chars]) -->
|
|
"%",
|
|
[A],
|
|
[B],
|
|
{
|
|
hex_bytes([A,B], Bytes),
|
|
Bytes = [FirstByte|_],
|
|
FirstByte < 128,
|
|
chars_utf8bytes(Chars0, Bytes),
|
|
Chars0 = [Char]
|
|
},
|
|
url_decode(Chars).
|
|
url_decode([Char|Chars]) -->
|
|
"%",
|
|
[A, B],
|
|
"%",
|
|
[C, D],
|
|
{
|
|
hex_bytes([A,B,C,D], Bytes),
|
|
Bytes = [FirstByte|_],
|
|
FirstByte < 224,
|
|
chars_utf8bytes(Chars0, Bytes),
|
|
Chars0 = [Char]
|
|
},
|
|
url_decode(Chars).
|
|
url_decode([Char|Chars]) -->
|
|
"%",
|
|
[A, B],
|
|
"%",
|
|
[C, D],
|
|
"%",
|
|
[E, F],
|
|
{
|
|
hex_bytes([A,B,C,D,E,F], Bytes),
|
|
Bytes = [FirstByte|_],
|
|
FirstByte < 240,
|
|
chars_utf8bytes(Chars0, Bytes),
|
|
Chars0 = [Char]
|
|
},
|
|
url_decode(Chars).
|
|
url_decode([Char|Chars]) -->
|
|
"%",
|
|
[A, B],
|
|
"%",
|
|
[C, D],
|
|
"%",
|
|
[E, F],
|
|
"%",
|
|
[H, I],
|
|
{
|
|
hex_bytes([A,B,C,D,E,F,H,I], Bytes),
|
|
chars_utf8bytes(Chars0, Bytes),
|
|
Chars0 = [Char]
|
|
},
|
|
url_decode(Chars).
|
|
|
|
url_decode([]) --> [].
|