Home Page
Site Map
Login/out
Message Board
Download(c) 2005-2025 XLOG Technologies AG
/**
* Warranty & Liability
* To the extent permitted by applicable law and unless explicitly
* otherwise agreed upon, XLOG Technologies AG makes no warranties
* regarding the provided information. XLOG Technologies AG assumes
* no liability that any problems might be solved with the information
* provided by XLOG Technologies AG.
*
* Rights & License
* All industrial property rights regarding the information - copyright
* and patent rights in particular - are the sole property of XLOG
* Technologies AG. If the company was not the originator of some
* excerpts, XLOG Technologies AG has at least obtained the right to
* reproduce, change and translate the information.
*
* Reproduction is restricted to the whole unaltered document. Reproduction
* of the information is only allowed for non-commercial uses. Selling,
* giving away or letting of the execution of the library is prohibited.
* The library can be distributed as part of your applications and libraries
* for execution provided this comment remains unchanged.
*
* Restrictions
* Only to be distributed with programs that add significant and primary
* functionality to the library. Not to be distributed with additional
* software intended to replace any components of the library.
*
* Trademarks
* Jekejeke is a registered trademark of XLOG Technologies AG.
*/
runner_file(common, server, 'XLOG 2.5 http server').
/* http_server_close(X) */
runner_pred(http_server_close, 1, common, server, 'XLOG 2.5.1').
runner_case(http_server_close, 1, common, server, 'XLOG 2.5.1, XLOG 1') :-
http_server_new(S),
http_server_close(S).
runner_case(http_server_close, 1, common, server, 'XLOG 2.5.1, XLOG 2') :-
http_server_new(S),
http_server_listen(S, 8080),
http_server_close(S).
runner_case(http_server_close, 1, common, server, 'XLOG 2.5.1, XLOG 3') :-
http_server_new(S),
http_server_listen(S, 8080),
http_server_close(S),
catch(http_server_close(S), error(E,_), true),
E == resource_error(state_error).
/* http_server_listen(X, Y) */
runner_pred(http_server_listen, 2, common, server, 'XLOG 2.5.2').
runner_case(http_server_listen, 2, common, server, 'XLOG 2.5.2, XLOG 1') :-
http_server_new(S),
http_server_listen(S, 8080),
catch(http_server_listen(S, 8080), error(E,_), true),
http_server_close(S),
E == resource_error(state_error).
runner_case(http_server_listen, 2, common, server, 'XLOG 2.5.2, XLOG 2') :-
http_server_new(S1),
http_server_new(S2),
http_server_listen(S1, 8080),
catch(http_server_listen(S2, 8080), error(E,_), true),
http_server_close(S1),
http_server_close(S2),
E == resource_error(port_error).
/* http_server_on(X, Y, Z, T) */
% server(-Server)
:- dynamic server/1.
% request_dispatch(+Request, +Response)
request_dispatch(Req, Res) :-
http_current_method(Req, 'GET'), !,
http_write_head(Res, 200, ['content-type'-'text/html; charset=utf-8']),
http_output_new(Res, S),
put_atom(S, 'Hello World! øùúûüý'),
close(S).
request_dispatch(Req, Res) :-
http_current_method(Req, 'HEAD'), !,
http_write_head(Res, 200, ['content-type'-'text/html; charset=utf-8']),
http_output_new(Res, S),
close(S).
request_dispatch(Req, Res) :-
http_current_method(Req, 'POST'), !,
http_input_new(Req, T),
get_atom(T, A, [stop(-1)]),
close(T),
http_write_head(Res, 200, ['content-type'-'text/plain; charset=utf-8']),
http_output_new(Res, S),
put_atom(S, A),
close(S).
request_dispatch(_, Res) :-
http_write_head(Res, 405, ['content-type'-'text/plain;charset=utf-8']),
http_output_new(Res, S),
put_atom(S, '405 Method Not Allowed'),
close(S).
runner_pred(http_server_on, 4, common, server, 'XLOG 2.5.3').
runner_case(http_server_on, 4, common, server, 'XLOG 2.5.3, XLOG 1') :-
http_server_new(S),
http_server_on(S, 'request', [P,Q], request_dispatch(P,Q)),
http_server_listen(S, 8080),
assertz(server(S)).
runner_case(http_server_on, 4, common, server, 'XLOG 2.5.3, XLOG 2') :-
open('http://localhost:8080/', read, Stream),
get_atom(Stream, A, [stop(-1)]),
close(Stream),
A == 'Hello World! øùúûüý'.
runner_case(http_server_on, 4, common, server, 'XLOG 2.5.3, XLOG 3') :-
open('http://localhost:8080/', read, Stream, [method('HEAD')]),
get_atom(Stream, A, [stop(-1)]),
close(Stream),
A == ''.
runner_case(http_server_on, 4, common, server, 'XLOG 2.5.3, XLOG 4') :-
open('http://localhost:8080/', read, Stream, [
headers(['Content-Type'-'text/plain;charset=utf-8']),
body('Hello World! øùúûüý')]),
get_atom(Stream, A, [stop(-1)]),
close(Stream),
A == 'Hello World! øùúûüý'.
runner_case(http_server_on, 4, common, server, 'XLOG 2.5.3, XLOG 5') :-
catch(open('http://localhost:8080/', read,
_, [method('DELETE')]), error(E,_), true),
E == resource_error(illegal_method).
runner_case(http_server_on, 4, common, server, 'XLOG 2.5.3, XLOG 6') :-
retract(server(S)),
http_server_close(S).
/* http_current_path(X, Y) */
% request_dispatch2(+Request, +Response)
request_dispatch2(Req, Res) :-
http_current_method(Req, 'GET'), !,
http_current_path(Req, Path),
http_write_head(Res, 200, ['content-type'-'text/html; charset=utf-8']),
http_output_new(Res, S),
put_atom(S, Path),
close(S).
request_dispatch2(_, Res) :-
http_write_head(Res, 405, ['content-type'-'text/plain;charset=utf-8']),
http_output_new(Res, S),
put_atom(S, '405 Method Not Allowed'),
close(S).
runner_pred(http_current_path, 2, common, server, 'XLOG 2.5.4').
runner_case(http_current_path, 2, common, server, 'XLOG 2.5.4, XLOG 1') :-
http_server_new(S),
http_server_on(S, 'request', [P,Q], request_dispatch2(P,Q)),
http_server_listen(S, 8081),
assertz(server(S)).
runner_case(http_current_path, 2, common, server, 'XLOG 2.5.4, XLOG 2') :-
open('http://localhost:8081/foo?bar=baz', read, Stream),
get_atom(Stream, A, [stop(-1)]),
close(Stream),
A == '/foo?bar=baz'.
runner_case(http_current_path, 2, common, server, 'XLOG 2.5.4, XLOG 3') :-
retract(server(S)),
http_server_close(S).
/* http_current_headers(X, Y) */
% request_dispatch3(+Request, +Response)
request_dispatch3(Req, Res) :-
http_current_method(Req, 'GET'), !,
http_current_headers(Req, Headers),
member(host-Host, Headers),
http_write_head(Res, 200, ['content-type'-'text/html; charset=utf-8']),
http_output_new(Res, S),
put_atom(S, Host),
close(S).
request_dispatch3(_, Res) :-
http_write_head(Res, 405, ['content-type'-'text/plain;charset=utf-8']),
http_output_new(Res, S),
put_atom(S, '405 Method Not Allowed'),
close(S).
runner_pred(http_current_headers, 2, common, server, 'XLOG 2.5.5').
runner_case(http_current_headers, 2, common, server, 'XLOG 2.5.5, XLOG 1') :-
http_server_new(S),
http_server_on(S, 'request', [P,Q], request_dispatch3(P,Q)),
http_server_listen(S, 8082),
assertz(server(S)).
runner_case(http_current_headers, 2, common, server, 'XLOG 2.5.5, XLOG 2') :-
open('http://localhost:8082/', read, Stream),
get_atom(Stream, A, [stop(-1)]),
close(Stream),
A == 'localhost:8082'.
runner_case(http_current_headers, 2, common, server, 'XLOG 2.5.5, XLOG 3') :-
retract(server(S)),
http_server_close(S).
/* http_write_head(X, Y, Z) */
% request_dispatch4(+Request, +Response)
request_dispatch4(Req, Res) :-
http_current_method(Req, 'GET'),
http_current_headers(Req, Headers),
member('if-modified-since'-_, Headers), !,
http_write_head(Res, 304, ['content-type'-'text/html; charset=utf-8']),
http_output_new(Res, S),
close(S).
request_dispatch4(Req, Res) :-
http_current_method(Req, 'GET'), !,
http_write_head(Res, 200, ['content-type'-'text/html; charset=utf-8']),
http_output_new(Res, S),
put_atom(S, 'Hello World! øùúûüý'),
close(S).
request_dispatch4(_, Res) :-
http_write_head(Res, 405, ['content-type'-'text/plain;charset=utf-8']),
http_output_new(Res, S),
put_atom(S, '405 Method Not Allowed'),
close(S).
runner_pred(http_write_head, 3, common, server, 'XLOG 2.5.6').
runner_case(http_write_head, 3, common, server, 'XLOG 2.5.6, XLOG 1') :-
http_server_new(S),
http_server_on(S, 'request', [P,Q], request_dispatch4(P,Q)),
http_server_listen(S, 8083),
assertz(server(S)).
runner_case(http_write_head, 3, common, server, 'XLOG 2.5.6, XLOG 2') :-
open('http://localhost:8083/', read, Stream, [status(Status)]),
get_atom(Stream, A, [stop(-1)]),
close(Stream),
A == 'Hello World! øùúûüý',
Status == 200.
runner_case(http_write_head, 3, common, server, 'XLOG 2.5.6, XLOG 3') :-
open('http://localhost:8083/', read, Stream, [headers(['if-modified-since'-
'Fri, 06 Sep 2024 15:05:01 GMT']), status(Status)]),
get_atom(Stream, A, [stop(-1)]),
close(Stream),
A == '',
Status == 304.
runner_case(http_write_head, 3, common, server, 'XLOG 2.5.6, XLOG 4') :-
retract(server(S)),
http_server_close(S).