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.   57
   58/** <module> Server processing of an HTTP request
   59
   60This library provides  the  core  of   the  implementation  of  the HTTP
   61protocol at the server side and is   mainly intended for *internal use*.
   62It   is   used   by    library(thread_httpd)   and   library(inet_httpd)
   63(deprecated).
   64
   65Still, it provides a few  predicates   that  are  occasinally useful for
   66applications:
   67
   68  - http_current_request/1 finds the current request for occasional
   69    usage in places where it is not avaialable otherwise.
   70  - http_peer/2 finds the (IP4) peer address, getting the original
   71    address if we are behind a proxy (=X-Forwarded-For=)
   72  - http_relative_path/2 can be used to find a relative path from
   73    the current request.
   74*/
   75
   76%!  http_wrapper(:Goal, +In, +Out, -Close, +Options) is det.
   77%
   78%   Simple wrapper to read and decode an HTTP header from `In', call
   79%   :Goal while watching for exceptions and send the result to the
   80%   stream `Out'.
   81%
   82%   The goal is assumed  to  write   the  reply  to =current_output=
   83%   preceeded by an HTTP header, closed by  a blank line. The header
   84%   *must* contain a Content-type: <type>   line.  It may optionally
   85%   contain a line =|Transfer-encoding: chunked|= to request chunked
   86%   encoding.
   87%
   88%   Options:
   89%
   90%           * request(-Request)
   91%           Return the full request to the caller
   92%           * peer(+Peer)
   93%           IP address of client
   94%
   95%   @param Close    Unified to one of =close=, =|Keep-Alive|= or
   96%                   spawned(ThreadId).
   97
   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).
  132
  133
  134%!  http_wrap_spawned(:Goal, -Request, -Close) is det.
  135%
  136%   Internal  use  only.  Helper  for    wrapping  the  handler  for
  137%   http_spawn/2.
  138%
  139%   @see http_spawned/1, http_spawn/2.
  140
  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.  158
  159%!  http_spawned(+ThreadId)
  160%
  161%   Internal use only. Indicate that the request is handed to thread
  162%   ThreadId.
  163
  164http_spawned(ThreadId) :-
  165    assert(spawned(ThreadId)).
  166
  167
  168%!  cgi_close(+CGI, +Request, +State0, +Error, -Close) is det.
  169%
  170%   The wrapper has completed. Finish the  CGI output. We have three
  171%   cases:
  172%
  173%       * The wrapper delegated the request to a new thread
  174%       * The wrapper succeeded
  175%       * The wrapper threw an error, non-200 status reply
  176%       (e.g., =not_modified=, =moved=) or a request to reply with
  177%       the content of a file.
  178%
  179%   @error socket I/O errors.
  180
  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).
  217
  218%!  send_error(+Out, +Request, +State0, +Error, -Close)
  219%
  220%   Send status replies and  reply   files.  The =current_output= no
  221%   longer points to the CGI stream, but   simply to the socket that
  222%   connects us to the client.
  223%
  224%   @param  State0 is start-status as returned by status/1.  Used to
  225%           find CPU usage, etc.
  226
  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       ).
  271
  272
  273%!  http_done(+Code, +Status, +BytesSent, +State0) is det.
  274%
  275%   Provide feedback for logging and debugging   on  how the request
  276%   has been completed.
  277
  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))).
  286
  287
  288%!  handler_with_output_to(:Goal, +Id, +Request, +Output, -Status) is det.
  289%
  290%   Run Goal with output redirected to   Output. Unifies Status with
  291%   =ok=, the error from catch/3  or a term error(goal_failed(Goal),
  292%   _).
  293%
  294%   @param Request  The HTTP request read or '-' for a continuation
  295%                   using http_spawn/2.
  296
  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).
  321
  322%!  thread_cputime(-CPU) is det.
  323%
  324%   CPU is the CPU time used by the calling thread.
  325
  326thread_cputime(CPU) :-
  327    statistics(cputime, CPU).
  328
  329%!  cgi_hook(+Event, +CGI) is det.
  330%
  331%   Hook called from the CGI   processing stream. See http_stream.pl
  332%   for details.
  333
  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, _).
  366
  367%!  redirect(+Header, -Action, -RestHeader) is semidet.
  368%
  369%   Detect the CGI =Location=  and   optional  =Status=  headers for
  370%   formulating a HTTP redirect.  Redirection is only established if
  371%   no =Status= is provided, or =Status= is 3XX.
  372
  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)).
  385
  386
  387%!  http_send_header(+Header)
  388%
  389%   This API provides an alternative for writing the header field as
  390%   a CGI header. Header has the  format Name(Value), as produced by
  391%   http_read_header/2.
  392%
  393%   @deprecated     Use CGI lines instead
  394
  395http_send_header(Header) :-
  396    current_output(CGI),
  397    cgi_property(CGI, header(Header0)),
  398    cgi_set(CGI, header([Header|Header0])).
  399
  400
  401%!  expand_request(+Request0, -Request)
  402%
  403%   Allow  for  general   rewrites   of    a   request   by  calling
  404%   http:request_expansion/2.
  405
  406expand_request(R0, R) :-
  407    http:request_expansion(R0, R1),         % Hook
  408    R1 \== R0,
  409    !,
  410    expand_request(R1, R).
  411expand_request(R, R).
  412
  413
  414%!  extend_request(+Options, +RequestIn, -Request)
  415%
  416%   Merge options in the request.
  417
  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(_)).
  432
  433
  434%!  http_current_request(-Request) is semidet.
  435%
  436%   Returns  the  HTTP  request  currently  being  processed.  Fails
  437%   silently if there is no current  request. This typically happens
  438%   if a goal is run outside the HTTP server context.
  439
  440http_current_request(Request) :-
  441    current_output(CGI),
  442    is_cgi_stream(CGI),
  443    cgi_property(CGI, request(Request)).
  444
  445
  446%!  http_peer(+Request, -PeerIP:atom) is semidet.
  447%
  448%   True when PeerIP is the IP address   of  the connection peer. If the
  449%   connection is established via a proxy  or   CDN  we  try to find the
  450%   initiating peer.  Currently supports:
  451%
  452%     - =Fastly-client-ip=
  453%     - =X-real-ip=
  454%     - =X-forwarded-for=
  455%     - Direct connections
  456%
  457%   @bug The =X-forwarded-for=  header  is   problematic.  According  to
  458%   [Wikipedia](https://en.wikipedia.org/wiki/X-Forwarded-For),      the
  459%   original   client   is   the    _first_,     while    according   to
  460%   [AWS](http://docs.aws.amazon.com/elasticloadbalancing/latest/classic/x-forwarded-headers.html)
  461%   it is the _last_.
  462
  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).
  479
  480
  481%!  http_relative_path(+AbsPath, -RelPath) is det.
  482%
  483%   Convert an absolute path (without host, fragment or search) into
  484%   a path relative to the current page.   This  call is intended to
  485%   create reusable components returning relative   paths for easier
  486%   support of reverse proxies.
  487
  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                 *******************************/
  516
  517%!  debug_request(+Code, +Status, +Id, +CPU0, Bytes)
  518%
  519%   Emit debugging info after a request completed with Status.
  520
  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))