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.

 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.

  326thread_cputime(CPU) :-
  327    statistics(cputime, CPU).

 cgi_hook(+Event, +CGI) is det

Hook called from the CGI processing stream. See http_stream.pl for details.

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

  373redirect(Header, Action, RestHeader) :-
  374    selectchk(location(To), Header, Header1),
  375    (   selectchk(status(Status), Header1, RestHeader)
  376    ->  between(300, 399, Status)
  377    ;   RestHeader = Header1,
  378        Status = 302
  379    ),
  380    redirect_action(Status, To, Action).
  381
  382redirect_action(301, To, moved(To)).
  383redirect_action(302, To, moved_temporary(To)).
  384redirect_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

  395http_send_header(Header) :-
  396    current_output(CGI),
  397    cgi_property(CGI, header(Header0)),
  398    cgi_set(CGI, header([Header|Header0])).

 expand_request(+Request0, -Request)

Allow for general rewrites of a request by calling request_expansion/2.

  406expand_request(R0, R) :-
  407    http:request_expansion(R0, R1),         % Hook
  408    R1 \== R0,
  409    !,
  410    expand_request(R1, R).
  411expand_request(R, R).

 extend_request(+Options, +RequestIn, -Request)

Merge options in the request.

  418extend_request([], R, R).
  419extend_request([request(R)|T], R0, R) :-
  420    !,
  421    extend_request(T, R0, R).
  422extend_request([H|T], R0, R) :-
  423    request_option(H),
  424    !,
  425    extend_request(T, [H|R0], R).
  426extend_request([_|T], R0, R) :-
  427    extend_request(T, R0, R).
  428
  429request_option(peer(_)).
  430request_option(protocol(_)).
  431request_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.

  440http_current_request(Request) :-
  441    current_output(CGI),
  442    is_cgi_stream(CGI),
  443    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.

  463http_peer(Request, Peer) :-
  464    memberchk(fastly_client_ip(Peer), Request), !.
  465http_peer(Request, Peer) :-
  466    memberchk(x_real_ip(Peer), Request), !.
  467http_peer(Request, IP) :-
  468    memberchk(x_forwarded_for(IP0), Request),
  469    !,
  470    atomic_list_concat(Parts, ', ', IP0),
  471    last(Parts, IP).
  472http_peer(Request, IP) :-
  473    memberchk(peer(Peer), Request),
  474    !,
  475    peer_to_ip(Peer, IP).
  476
  477peer_to_ip(ip(A,B,C,D), IP) :-
  478    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.

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

 debug_request(+Code, +Status, +Id, +CPU0, Bytes)

Emit debugging info after a request completed with Status.

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