rishi/scryer-prolog
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Redirections, default status code, rout matching 1.0

Browse Source
This commit is contained in:
Adrián Arroyo Calle
2020-12-27 12:16:46 +01:00
parent e1f4a50e65
commit 27e3dcea6c
1 changed files with 58 additions and 33 deletions
Download Patch File Download Diff File Expand all files Collapse all files

91
src/lib/http/http_server.pl
View File

@@ -1,4 +1,4 @@
:- module(http_server, [http_listen/2]). :- module(http_server, [http_listen/2, http_headers/2, http_status_code/2, http_body/2, http_redirect/2]).
:- use_module(library(sockets)). :- use_module(library(sockets)).
:- use_module(library(dcgs)). :- use_module(library(dcgs)).
@@ -9,27 +9,35 @@
:- use_module(library(iso_ext)). :- use_module(library(iso_ext)).
% TODO % TODO
% - Parse body % - Query Params
% - Improve route matching
% - Long-running socket_server_accept
% - Cookies? % - Cookies?
% - HTTP Error Codes % - HTTP Error Codes
% - Redirections
% - Improve code quality % - Improve code quality
% - Binary
% - Comments % - Comments
% - Test Suite
% - Keep-Alive % - Keep-Alive
% - Case insensitive headers % - Case insensitive headers
% - HTML
% - Response from file
:- dynamic(http_handler/3).
http_listen(Port, Handlers) :- http_listen(Port, Handlers) :-
must_be(integer, Port), must_be(integer, Port),
must_be(list, Handlers), must_be(list, Handlers),
once(socket_server_open(Port, Socket)), once(socket_server_open(Port, Socket)),
register_handlers(Handlers),
format("Listening at port ~d\n", [Port]), format("Listening at port ~d\n", [Port]),
accept_loop(Socket, Handlers). accept_loop(Socket).
accept_loop(Socket, Handlers) :- register_handlers([]).
register_handlers([get(Path, Handler)|Handlers]) :-
asserta(http_handler(get, Path, Handler)),
register_handlers(Handlers).
register_handlers([post(Path, Handler)|Handlers]) :-
asserta(http_handler(post, Path, Handler)),
register_handlers(Handlers).
accept_loop(Socket) :-
setup_call_cleanup(socket_server_accept(Socket, Client, Stream, [type(binary)]), setup_call_cleanup(socket_server_accept(Socket, Client, Stream, [type(binary)]),
( (
read_header_lines(Stream, Lines), read_header_lines(Stream, Lines),
@@ -38,13 +46,21 @@ accept_loop(Socket, Handlers) :-
(phrase(parse_request(Version, Method, Path), Request), maplist(map_parse_header, Headers, HeadersKV)) -> ( (phrase(parse_request(Version, Method, Path), Request), maplist(map_parse_header, Headers, HeadersKV)) -> (
( (
member("Content-Length"-ContentLength, HeadersKV) -> member("Content-Length"-ContentLength, HeadersKV) ->
(number_chars(ContentLengthN, ContentLength), get_bytes(Stream, ContentLengthN, RequestBody)) (number_chars(ContentLengthN, ContentLength), get_bytes(Stream, ContentLengthN, Body))
;true ;true
), ),
format("~w ~s\n", [Method, Path]), format("~w ~s\n", [Method, Path]),
( call_handler(Path, HeadersKV, RequestBody, Handlers, Response) -> (
send_response(Stream, Response) (http_handler(Method, Pattern, Handler), phrase(path(Pattern), Path)) ->
; format(Stream, "HTTP/1.0 500 Internal Server Error\r\n\r\n", []) (
HttpRequest = http_request(HeadersKV, binary(Body)),
HttpResponse = http_response(_, _, _),
(call(Handler, HttpRequest, HttpResponse) ->
send_response(Stream, HttpResponse)
; format(Stream, "HTTP/1.0 500 Internal Server Error\r\n\r\n")
)
)
; format(Stream, "HTTP/1.0 404 Not Found\r\n\r\n", [])
) )
);( );(
format(Stream, "HTTP/1.0 400 Bad Request\r\n\r\n", []) % bad format format(Stream, "HTTP/1.0 400 Bad Request\r\n\r\n", []) % bad format
@@ -52,46 +68,55 @@ accept_loop(Socket, Handlers) :-
), ),
! % Remove ! % Remove
), close(Stream)), ), close(Stream)),
accept_loop(Socket, Handlers). accept_loop(Socket).
call_handler(Path, Headers, _, Handlers, Response) :- % Helper and recommended predicates
member(get(Dcg, Handler), Handlers),
phrase(Dcg, Path),!,
Request = http_request(Headers, _),
call(Handler, Request, Response).
call_handler(Path, Headers, Body, Handlers, Response) :- % http_header(Response, HEaderName, Value)
member(post(Dcg, Handler), Handlers), http_headers(http_request(Headers, _), Headers).
phrase(Dcg, Path),!, http_headers(http_response(_, _, Headers), Headers).
build_response(Body, ResponseBody),
Request = http_request(Headers, ResponseBody),
call(Handler, Request, Response).
call_handler(_, _, _, http_response(404, "Not found")). http_body(http_request(_, binary(ByteBody)), text(TextBody)) :- chars_utf8bytes(TextBody, ByteBody).
http_body(http_request(_, Body), Body).
http_body(http_response(_, Body, _), Body).
build_response(ByteBody, text(TextBody)) :- http_status_code(http_response(StatusCode, _, _), StatusCode).
chars_utf8bytes(TextBody, ByteBody).
build_response(ByteBody, binary(ByteBody)).
send_response(Stream, http_response(StatusCode, text(TextResponse), Headers)) :- http_redirect(http_response(307, text("Moved Temporarily"), ["Location"-Uri]), Uri).
path([Part|Pattern]) -->
"/",
string_without("/", Part),
path(Pattern).
path([]) --> [].
send_response(Stream, http_response(StatusCode0, text(TextResponse), Headers)) :-
default(StatusCode0, 200, StatusCode),
format(Stream, "HTTP/1.0 ~d\r\n", [StatusCode]), format(Stream, "HTTP/1.0 ~d\r\n", [StatusCode]),
overwrite_header("Content-Type"-"text/plain", Headers, Headers0), overwrite_header("Content-Type"-"text/plain", Headers, Headers0),
overwrite_header("Connection"-"Close", Headers0, Headers1), overwrite_header("Connection"-"Close", Headers0, Headers1),
write_headers(Stream, Headers1), write_headers(Stream, Headers1),
format(Stream, "\r\n~s", [TextResponse]). format(Stream, "\r\n~s", [TextResponse]).
send_response(Stream, http_response(StatusCode, binary(BinaryResponse), Headers)) :- send_response(Stream, http_response(StatusCode0, binary(BinaryResponse), Headers)) :-
default(StatusCode0, 200, StatusCode),
format(Stream, "HTTP/1.0 ~d\r\n", [StatusCode]), format(Stream, "HTTP/1.0 ~d\r\n", [StatusCode]),
overwrite_header("Connection"-"Close", Headers, Headers0), overwrite_header("Connection"-"Close", Headers, Headers0),
write_headers(Stream, Headers0), write_headers(Stream, Headers0),
format(Stream, "\r\n", []), format(Stream, "\r\n", []),
put_bytes(Stream, BinaryResponse). put_bytes(Stream, BinaryResponse).
default(Var, Default, Out) :-
(var(Var) -> Out = Default
; Var = Out
).
write_headers(Stream, Headers) :- write_headers(Stream, Headers) :-
forall(member(Key-Value, Headers), format(Stream, "~s: ~s\r\n", [Key, Value])). forall(member(Key-Value, Headers), format(Stream, "~s: ~s\r\n", [Key, Value])).
overwrite_header(Key-Value, [], [Key-Value]). overwrite_header(Key-Value, [], [Key-Value]).
overwrite_header(Key-Value, [Header|Headers], HeadersOut) :- overwrite_header(Key-Value, [Header|Headers], [Header|HeadersOut]) :-
Header = Key0-_, Header = Key0-_,
Key0 \= Key, Key0 \= Key,
overwrite_header(Key-Value, Headers, HeadersOut). overwrite_header(Key-Value, Headers, HeadersOut).
@@ -171,4 +196,4 @@ get_bytes(Stream, Length, Acc, Res) :-
put_bytes(_, []). put_bytes(_, []).
put_bytes(Stream, [Byte|Bytes]) :- put_bytes(Stream, [Byte|Bytes]) :-
put_byte(Stream, Byte), put_byte(Stream, Byte),
put_bytes(Stream, Bytes). put_bytes(Stream, Bytes).