View source with raw comments or as raw

    1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2002-2017, University of Amsterdam
    7                              VU University Amsterdam
    8    All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions
   12    are met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15       notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18       notice, this list of conditions and the following disclaimer in
   19       the documentation and/or other materials provided with the
   20       distribution.
   21
   22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   33    POSSIBILITY OF SUCH DAMAGE.
   34*/
   35
   36:- module(httpd_wrapper,
   37          [ http_wrapper/5,             % :Goal, +In, +Out, -Conn, +Options
   38            http_current_request/1,     % -Request
   39            http_peer/2,                % +Request, -PeerIP
   40            http_send_header/1,         % +Term
   41            http_relative_path/2,       % +AbsPath, -RelPath
   42                                        % Internal API
   43            http_wrap_spawned/3,        % :Goal, -Request, -Connection
   44            http_spawned/1              % +ThreadId
   45          ]).   46:- use_module(http_header).   47:- use_module(http_stream).   48:- use_module(http_exception).   49:- use_module(library(lists)).   50:- use_module(library(debug)).   51:- use_module(library(broadcast)).   52
   53:- meta_predicate
   54    http_wrapper(0, +, +, -, +).   55:- multifile
   56    http:request_expansion/2.

Server processing of an HTTP request

This library provides the core of the implementation of the HTTP protocol at the server side and is mainly intended for internal use. It is used by library(thread_httpd) and library(inet_httpd) (deprecated).

Still, it provides a few predicates that are occasinally useful for applications:

http_current_request/1 finds the current request for occasional usage in places where it is not avaialable otherwise.
http_peer/2 finds the (IP4) peer address, getting the original address if we are behind a proxy (X-Forwarded-For)
http_relative_path/2 can be used to find a relative path from the current request. */

http_wrapper(:Goal, +In, +Out, -Close, +Options) is det

Simple wrapper to read and decode an HTTP header from `In', call :Goal while watching for exceptions and send the result to the stream `Out'.

The goal is assumed to write the reply to current_output preceeded by an HTTP header, closed by a blank line. The header must contain a Content-type: <type> line. It may optionally contain a line Transfer-encoding: chunked to request chunked encoding.

Options:

request(-Request): Return the full request to the caller
peer(+Peer): IP address of client

Arguments:

Close - Unified to one of close, Keep-Alive or spawned(ThreadId).

   98http_wrapper(Goal, In, Out, Close, Options) :-
   99    status(Id, State0),
  100    catch(http_read_request(In, Request0), ReqError, true),
  101    (   Request0 == end_of_file
  102    ->  Close = close,
  103        extend_request(Options, [], _) % return request
  104    ;   var(ReqError)
  105    ->  extend_request(Options, Request0, Request1),
  106        cgi_open(Out, CGI, cgi_hook, [request(Request1)]),
  107        cgi_property(CGI, id(Id)),
  108        (   debugging(http(request))
  109        ->  memberchk(method(Method), Request1),
  110            memberchk(path(Location), Request1),
  111            debug(http(request), "[~D] ~w ~w ...", [Id,Method,Location])
  112        ;   true
  113        ),
  114        handler_with_output_to(Goal, Id, Request1, CGI, Error),
  115        cgi_close(CGI, Request1, State0, Error, Close)
  116    ;   Id = 0,
  117        add_header_context(ReqError),
  118        (   debugging(http(request))
  119        ->  print_message(warning, ReqError)
  120        ;   true
  121        ),
  122        send_error(Out, [], State0, ReqError, Close),
  123        extend_request(Options, [], _)
  124    ).
  125
  126add_header_context(error(_,context(_,in_http_request))) :- !.
  127add_header_context(_).
  128
  129status(Id, state0(Thread, CPU, Id)) :-
  130    thread_self(Thread),
  131    thread_cputime(CPU).

http_wrap_spawned(:Goal, -Request, -Close) is det

Internal use only. Helper for wrapping the handler for http_spawn/2.

See also: - http_spawned/1, http_spawn/2.

  141http_wrap_spawned(Goal, Request, Close) :-
  142    current_output(CGI),
  143    cgi_property(CGI, id(Id)),
  144    handler_with_output_to(Goal, Id, -, current_output, Error),
  145    (   retract(spawned(ThreadId))
  146    ->  Close = spawned(ThreadId),
  147        Request = []
  148    ;   cgi_property(CGI, request(Request)),
  149        status(Id, State0),
  150        catch(cgi_close(CGI, Request, State0, Error, Close),
  151              _,
  152              Close = close)
  153    ).
  154
  155
  156:- thread_local
  157    spawned/1.

http_spawned(+ThreadId): Internal use only. Indicate that the request is handed to thread ThreadId.

  164http_spawned(ThreadId) :-
  165    assert(spawned(ThreadId)).

cgi_close(+CGI, +Request, +State0, +Error, -Close) is det

The wrapper has completed. Finish the CGI output. We have three cases:

The wrapper delegated the request to a new thread
The wrapper succeeded
The wrapper threw an error, non-200 status reply (e.g., not_modified, moved) or a request to reply with the content of a file.

Errors: - socket I/O errors.

  181cgi_close(_, _, _, _, Close) :-
  182    retract(spawned(ThreadId)),
  183    !,
  184    Close = spawned(ThreadId).
  185cgi_close(CGI, _, State0, ok, Close) :-
  186    !,
  187    catch(cgi_finish(CGI, Close, Bytes), E, true),
  188    (   var(E)
  189    ->  http_done(200, ok, Bytes, State0)
  190    ;   http_done(500, E, 0, State0),       % TBD: amount written?
  191        throw(E)
  192    ).
  193cgi_close(CGI, Request, Id, http_reply(Status), Close) :-
  194    !,
  195    cgi_close(CGI, Request, Id, http_reply(Status, []), Close).
  196cgi_close(CGI, Request, Id, http_reply(Status, ExtraHdrOpts), Close) :-
  197    cgi_property(CGI, header_codes(Text)),
  198    Text \== [],
  199    !,
  200    http_parse_header(Text, ExtraHdrCGI),
  201    cgi_property(CGI, client(Out)),
  202    cgi_discard(CGI),
  203    close(CGI),
  204    append(ExtraHdrCGI, ExtraHdrOpts, ExtraHdr),
  205    send_error(Out, Request, Id, http_reply(Status, ExtraHdr), Close).
  206cgi_close(CGI, Request, Id, Error, Close) :-
  207    cgi_property(CGI, client(Out)),
  208    cgi_discard(CGI),
  209    close(CGI),
  210    send_error(Out, Request, Id, Error, Close).
  211
  212cgi_finish(CGI, Close, Bytes) :-
  213    flush_output(CGI),                      % update the content-length
  214    cgi_property(CGI, connection(Close)),
  215    cgi_property(CGI, content_length(Bytes)),
  216    close(CGI).

send_error(+Out, +Request, +State0, +Error, -Close)

Send status replies and reply files. The current_output no longer points to the CGI stream, but simply to the socket that connects us to the client.

Arguments:

State0

- is start-status as returned by status/1. Used to find CPU usage, etc.

  227send_error(Out, Request, State0, Error, Close) :-
  228    map_exception_to_http_status(Error, Reply, HdrExtra0, Context),
  229    update_keep_alive(HdrExtra0, HdrExtra, Request),
  230    catch(http_reply(Reply,
  231                     Out,
  232                     [ content_length(CLen)
  233                     | HdrExtra
  234                     ],
  235                     Context,
  236                     Request,
  237                     Code),
  238          E, true),
  239    (   var(E)
  240    ->  http_done(Code, Error, CLen, State0)
  241    ;   http_done(500,  E, 0, State0),
  242        throw(E)                    % is that wise?
  243    ),
  244    (   Error = http_reply(switching_protocols(Goal, SwitchOptions), _)
  245    ->  Close = switch_protocol(Goal, SwitchOptions)
  246    ;   memberchk(connection(Close), HdrExtra)
  247    ->  true
  248    ;   Close = close
  249    ).
  250
  251update_keep_alive(Header0, Header, Request) :-
  252    memberchk(connection(C), Header0),
  253    !,
  254    (   C == close
  255    ->  Header = Header0
  256    ;   client_wants_close(Request)
  257    ->  selectchk(connection(C),     Header0,
  258                  connection(close), Header)
  259    ;   Header = Header0
  260    ).
  261update_keep_alive(Header, Header, _).
  262
  263client_wants_close(Request) :-
  264    memberchk(connection(C), Request),
  265    !,
  266    C == close.
  267client_wants_close(Request) :-
  268    \+ ( memberchk(http_version(Major-_Minor), Request),
  269         Major >= 1
  270       ).

http_done(+Code, +Status, +BytesSent, +State0) is det: Provide feedback for logging and debugging on how the request has been completed.

  278http_done(Code, Status, Bytes, state0(_Thread, CPU0, Id)) :-
  279    thread_cputime(CPU1),
  280    CPU is CPU1 - CPU0,
  281    (   debugging(http(request))
  282    ->  debug_request(Code, Status, Id, CPU, Bytes)
  283    ;   true
  284    ),
  285    broadcast(http(request_finished(Id, Code, Status, CPU, Bytes))).

handler_with_output_to(:Goal, +Id, +Request, +Output, -Status) is det

Run Goal with output redirected to Output. Unifies Status with ok, the error from catch/3 or a term

error(goal_failed(Goal),
_)

Arguments:

Request

- The HTTP request read or '-' for a continuation using http_spawn/2.

  297handler_with_output_to(Goal, Id, Request, current_output, Status) :-
  298    !,
  299    (   catch(call_handler(Goal, Id, Request), Status, true)
  300    ->  (   var(Status)
  301        ->  Status = ok
  302        ;   true
  303        )
  304    ;   Status = error(goal_failed(Goal),_)
  305    ).
  306handler_with_output_to(Goal, Id, Request, Output, Error) :-
  307    current_output(OldOut),
  308    set_output(Output),
  309    handler_with_output_to(Goal, Id, Request, current_output, Error),
  310    set_output(OldOut).
  311
  312call_handler(Goal, _, -) :-            % continuation through http_spawn/2
  313    !,
  314    call(Goal).
  315call_handler(Goal, Id, Request0) :-
  316    expand_request(Request0, Request),
  317    current_output(CGI),
  318    cgi_set(CGI, request(Request)),
  319    broadcast(http(request_start(Id, Request))),
  320    call(Goal, Request).

thread_cputime(-CPU) is det: CPU is the CPU time used by the calling thread.

  326:- if(current_prolog_flag(threads, true)).  327thread_cputime(CPU) :-
  328    thread_self(Me),
  329    thread_statistics(Me, cputime, CPU).
  330:- else.  331thread_cputime(CPU) :-
  332    statistics(cputime, CPU).
  333:- endif.

cgi_hook(+Event, +CGI) is det: Hook called from the CGI processing stream. See http_stream.pl for details.

  341:- public cgi_hook/2.  342
  343cgi_hook(What, _CGI) :-
  344    debug(http(hook), 'Running hook: ~q', [What]),
  345    fail.
  346cgi_hook(header, CGI) :-
  347    cgi_property(CGI, header_codes(HeadText)),
  348    cgi_property(CGI, header(Header0)), % see http_send_header/1
  349    http_parse_header(HeadText, CgiHeader0),
  350    append(Header0, CgiHeader0, CgiHeader),
  351    cgi_property(CGI, request(Request)),
  352    http_update_connection(CgiHeader, Request, Connection, Header1),
  353    http_update_transfer(Request, Header1, Transfer, Header2),
  354    http_update_encoding(Header2, Encoding, Header),
  355    set_stream(CGI, encoding(Encoding)),
  356    cgi_set(CGI, connection(Connection)),
  357    cgi_set(CGI, header(Header)),
  358    debug(http(transfer_encoding), 'Transfer-encoding: ~w', [Transfer]),
  359    cgi_set(CGI, transfer_encoding(Transfer)). % must be LAST
  360cgi_hook(send_header, CGI) :-
  361    cgi_property(CGI, header(Header)),
  362    debug(http(cgi), 'Header: ~q', [Header]),
  363    cgi_property(CGI, client(Out)),
  364    (   redirect(Header, Action, RedirectHeader)
  365    ->  http_status_reply(Action, Out, RedirectHeader, _),
  366        cgi_discard(CGI)
  367    ;   cgi_property(CGI, transfer_encoding(chunked))
  368    ->  http_reply_header(Out, chunked_data, Header)
  369    ;   cgi_property(CGI, content_length(Len))
  370    ->  http_reply_header(Out, cgi_data(Len), Header)
  371    ).
  372cgi_hook(close, _).

redirect(+Header, -Action, -RestHeader) is semidet: Detect the CGI Location and optional Status headers for formulating a HTTP redirect. Redirection is only established if no Status is provided, or Status is 3XX.

  380redirect(Header, Action, RestHeader) :-
  381    selectchk(location(To), Header, Header1),
  382    (   selectchk(status(Status), Header1, RestHeader)
  383    ->  between(300, 399, Status)
  384    ;   RestHeader = Header1,
  385        Status = 302
  386    ),
  387    redirect_action(Status, To, Action).
  388
  389redirect_action(301, To, moved(To)).
  390redirect_action(302, To, moved_temporary(To)).
  391redirect_action(303, To, see_other(To)).

http_send_header(+Header)

This API provides an alternative for writing the header field as a CGI header. Header has the format Name(Value), as produced by http_read_header/2.

deprecated: - Use CGI lines instead

  402http_send_header(Header) :-
  403    current_output(CGI),
  404    cgi_property(CGI, header(Header0)),
  405    cgi_set(CGI, header([Header|Header0])).

expand_request(+Request0, -Request): Allow for general rewrites of a request by calling request_expansion/2.

  413expand_request(R0, R) :-
  414    http:request_expansion(R0, R1),         % Hook
  415    R1 \== R0,
  416    !,
  417    expand_request(R1, R).
  418expand_request(R, R).

extend_request(+Options, +RequestIn, -Request): Merge options in the request.

  425extend_request([], R, R).
  426extend_request([request(R)|T], R0, R) :-
  427    !,
  428    extend_request(T, R0, R).
  429extend_request([H|T], R0, R) :-
  430    request_option(H),
  431    !,
  432    extend_request(T, [H|R0], R).
  433extend_request([_|T], R0, R) :-
  434    extend_request(T, R0, R).
  435
  436request_option(peer(_)).
  437request_option(protocol(_)).
  438request_option(pool(_)).

http_current_request(-Request) is semidet: Returns the HTTP request currently being processed. Fails silently if there is no current request. This typically happens if a goal is run outside the HTTP server context.

  447http_current_request(Request) :-
  448    current_output(CGI),
  449    is_cgi_stream(CGI),
  450    cgi_property(CGI, request(Request)).

http_peer(+Request, -PeerIP:atom) is semidet

True when PeerIP is the IP address of the connection peer. If the connection is established via a proxy or CDN we try to find the initiating peer. Currently supports:

Fastly-client-ip
X-real-ip
X-forwarded-for
Direct connections

bug: - The X-forwarded-for header is problematic. According to Wikipedia, the original client is the first, while according to AWS it is the last.

  470http_peer(Request, Peer) :-
  471    memberchk(fastly_client_ip(Peer), Request), !.
  472http_peer(Request, Peer) :-
  473    memberchk(x_real_ip(Peer), Request), !.
  474http_peer(Request, IP) :-
  475    memberchk(x_forwarded_for(IP0), Request),
  476    !,
  477    atomic_list_concat(Parts, ', ', IP0),
  478    last(Parts, IP).
  479http_peer(Request, IP) :-
  480    memberchk(peer(Peer), Request),
  481    !,
  482    peer_to_ip(Peer, IP).
  483
  484peer_to_ip(ip(A,B,C,D), IP) :-
  485    atomic_list_concat([A,B,C,D], '.', IP).

http_relative_path(+AbsPath, -RelPath) is det: Convert an absolute path (without host, fragment or search) into a path relative to the current page. This call is intended to create reusable components returning relative paths for easier support of reverse proxies.

  495http_relative_path(Path, RelPath) :-
  496    http_current_request(Request),
  497    memberchk(path(RelTo), Request),
  498    http_relative_path(Path, RelTo, RelPath),
  499    !.
  500http_relative_path(Path, Path).
  501
  502http_relative_path(Path, RelTo, RelPath) :-
  503    atomic_list_concat(PL, /, Path),
  504    atomic_list_concat(RL, /, RelTo),
  505    delete_common_prefix(PL, RL, PL1, PL2),
  506    to_dot_dot(PL2, DotDot, PL1),
  507    atomic_list_concat(DotDot, /, RelPath).
  508
  509delete_common_prefix([H|T01], [H|T02], T1, T2) :-
  510    !,
  511    delete_common_prefix(T01, T02, T1, T2).
  512delete_common_prefix(T1, T2, T1, T2).
  513
  514to_dot_dot([], Tail, Tail).
  515to_dot_dot([_], Tail, Tail) :- !.
  516to_dot_dot([_|T0], ['..'|T], Tail) :-
  517    to_dot_dot(T0, T, Tail).
  518
  519
  520                 /*******************************
  521                 *         DEBUG SUPPORT        *
  522                 *******************************/

debug_request(+Code, +Status, +Id, +CPU0, Bytes): Emit debugging info after a request completed with Status.

  528debug_request(Code, ok, Id, CPU, Bytes) :-
  529    !,
  530    debug(http(request), '[~D] ~w OK (~3f seconds; ~D bytes)',
  531          [Id, Code, CPU, Bytes]).
  532debug_request(Code, Status, Id, _, Bytes) :-
  533    map_exception(Status, Reply),
  534    !,
  535    debug(http(request), '[~D] ~w ~w; ~D bytes',
  536          [Id, Code, Reply, Bytes]).
  537debug_request(Code, Except, Id, _, _) :-
  538    Except = error(_,_),
  539    !,
  540    message_to_string(Except, Message),
  541    debug(http(request), '[~D] ~w ERROR: ~w',
  542          [Id, Code, Message]).
  543debug_request(Code, Status, Id, _, Bytes) :-
  544    debug(http(request), '[~D] ~w ~w; ~D bytes',
  545          [Id, Code, Status, Bytes]).
  546
  547map_exception(http_reply(Reply), Reply).
  548map_exception(http_reply(Reply, _), Reply).
  549map_exception(error(existence_error(http_location, Location), _Stack),
  550              error(404, Location))