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
  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.  334
  335
  336%!  cgi_hook(+Event, +CGI) is det.
  337%
  338%   Hook called from the CGI   processing stream. See http_stream.pl
  339%   for details.
  340
  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, _).
  373
  374%!  redirect(+Header, -Action, -RestHeader) is semidet.
  375%
  376%   Detect the CGI =Location=  and   optional  =Status=  headers for
  377%   formulating a HTTP redirect.  Redirection is only established if
  378%   no =Status= is provided, or =Status= is 3XX.
  379
  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)).
  392
  393
  394%!  http_send_header(+Header)
  395%
  396%   This API provides an alternative for writing the header field as
  397%   a CGI header. Header has the  format Name(Value), as produced by
  398%   http_read_header/2.
  399%
  400%   @deprecated     Use CGI lines instead
  401
  402http_send_header(Header) :-
  403    current_output(CGI),
  404    cgi_property(CGI, header(Header0)),
  405    cgi_set(CGI, header([Header|Header0])).
  406
  407
  408%!  expand_request(+Request0, -Request)
  409%
  410%   Allow  for  general   rewrites   of    a   request   by  calling
  411%   http:request_expansion/2.
  412
  413expand_request(R0, R) :-
  414    http:request_expansion(R0, R1),         % Hook
  415    R1 \== R0,
  416    !,
  417    expand_request(R1, R).
  418expand_request(R, R).
  419
  420
  421%!  extend_request(+Options, +RequestIn, -Request)
  422%
  423%   Merge options in the request.
  424
  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(_)).
  439
  440
  441%!  http_current_request(-Request) is semidet.
  442%
  443%   Returns  the  HTTP  request  currently  being  processed.  Fails
  444%   silently if there is no current  request. This typically happens
  445%   if a goal is run outside the HTTP server context.
  446
  447http_current_request(Request) :-
  448    current_output(CGI),
  449    is_cgi_stream(CGI),
  450    cgi_property(CGI, request(Request)).
  451
  452
  453%!  http_peer(+Request, -PeerIP:atom) is semidet.
  454%
  455%   True when PeerIP is the IP address   of  the connection peer. If the
  456%   connection is established via a proxy  or   CDN  we  try to find the
  457%   initiating peer.  Currently supports:
  458%
  459%     - =Fastly-client-ip=
  460%     - =X-real-ip=
  461%     - =X-forwarded-for=
  462%     - Direct connections
  463%
  464%   @bug The =X-forwarded-for=  header  is   problematic.  According  to
  465%   [Wikipedia](https://en.wikipedia.org/wiki/X-Forwarded-For),      the
  466%   original   client   is   the    _first_,     while    according   to
  467%   [AWS](http://docs.aws.amazon.com/elasticloadbalancing/latest/classic/x-forwarded-headers.html)
  468%   it is the _last_.
  469
  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).
  486
  487
  488%!  http_relative_path(+AbsPath, -RelPath) is det.
  489%
  490%   Convert an absolute path (without host, fragment or search) into
  491%   a path relative to the current page.   This  call is intended to
  492%   create reusable components returning relative   paths for easier
  493%   support of reverse proxies.
  494
  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                 *******************************/
  523
  524%!  debug_request(+Code, +Status, +Id, +CPU0, Bytes)
  525%
  526%   Emit debugging info after a request completed with Status.
  527
  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))