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
   60Most   code   doesn't   need  to   use  this   directly;  instead   use
   61library(http/http_server),  which  combines   this  library  with   the
   62typical HTTP libraries that most servers need.
   63
   64This library provides  the  core  of   the  implementation  of  the HTTP
   65protocol at the server side and is   mainly intended for *internal use*.
   66It   is   used   by    library(thread_httpd)   and   library(inet_httpd)
   67(deprecated).
   68
   69Still, it provides a few  predicates   that  are  occasinally useful for
   70applications:
   71
   72  - http_current_request/1 finds the current request for occasional
   73    usage in places where it is not avaialable otherwise.
   74  - http_peer/2 finds the (IP4) peer address, getting the original
   75    address if we are behind a proxy (=X-Forwarded-For=)
   76  - http_relative_path/2 can be used to find a relative path from
   77    the current request.
   78*/
   79
   80%!  http_wrapper(:Goal, +In, +Out, -Close, +Options) is det.
   81%
   82%   Simple wrapper to read and decode an HTTP header from `In', call
   83%   :Goal while watching for exceptions and send the result to the
   84%   stream `Out'.
   85%
   86%   The goal is assumed  to  write   the  reply  to =current_output=
   87%   preceeded by an HTTP header, closed by  a blank line. The header
   88%   *must* contain a Content-type: <type>   line.  It may optionally
   89%   contain a line =|Transfer-encoding: chunked|= to request chunked
   90%   encoding.
   91%
   92%   Options:
   93%
   94%           * request(-Request)
   95%           Return the full request to the caller
   96%           * peer(+Peer)
   97%           IP address of client
   98%
   99%   @param Close    Unified to one of =close=, =|Keep-Alive|= or
  100%                   spawned(ThreadId).
  101
  102http_wrapper(Goal, In, Out, Close, Options) :-
  103    status(Id, State0),
  104    catch(http_read_request(In, Request0), ReqError, true),
  105    (   Request0 == end_of_file
  106    ->  Close = close,
  107        extend_request(Options, [], _) % return request
  108    ;   var(ReqError)
  109    ->  extend_request(Options, Request0, Request1),
  110        cgi_open(Out, CGI, cgi_hook, [request(Request1)]),
  111        cgi_property(CGI, id(Id)),
  112        (   debugging(http(request))
  113        ->  memberchk(method(Method), Request1),
  114            memberchk(path(Location), Request1),
  115            debug(http(request), "[~D] ~w ~w ...", [Id,Method,Location])
  116        ;   true
  117        ),
  118        handler_with_output_to(Goal, Id, Request1, CGI, Error),
  119        cgi_close(CGI, Request1, State0, Error, Close)
  120    ;   Id = 0,
  121        add_header_context(ReqError),
  122        (   debugging(http(request))
  123        ->  print_message(warning, ReqError)
  124        ;   true
  125        ),
  126        send_error(Out, [], State0, ReqError, Close),
  127        extend_request(Options, [], _)
  128    ).
  129
  130add_header_context(error(_,context(_,in_http_request))) :- !.
  131add_header_context(_).
  132
  133status(Id, state0(Thread, CPU, Id)) :-
  134    thread_self(Thread),
  135    thread_cputime(CPU).
  136
  137
  138%!  http_wrap_spawned(:Goal, -Request, -Close) is det.
  139%
  140%   Internal  use  only.  Helper  for    wrapping  the  handler  for
  141%   http_spawn/2.
  142%
  143%   @see http_spawned/1, http_spawn/2.
  144
  145http_wrap_spawned(Goal, Request, Close) :-
  146    current_output(CGI),
  147    cgi_property(CGI, id(Id)),
  148    handler_with_output_to(Goal, Id, -, current_output, Error),
  149    (   retract(spawned(ThreadId))
  150    ->  Close = spawned(ThreadId),
  151        Request = []
  152    ;   cgi_property(CGI, request(Request)),
  153        status(Id, State0),
  154        catch(cgi_close(CGI, Request, State0, Error, Close),
  155              _,
  156              Close = close)
  157    ).
  158
  159
  160:- thread_local
  161    spawned/1.  162
  163%!  http_spawned(+ThreadId)
  164%
  165%   Internal use only. Indicate that the request is handed to thread
  166%   ThreadId.
  167
  168http_spawned(ThreadId) :-
  169    assert(spawned(ThreadId)).
  170
  171
  172%!  cgi_close(+CGI, +Request, +State0, +Error, -Close) is det.
  173%
  174%   The wrapper has completed. Finish the  CGI output. We have three
  175%   cases:
  176%
  177%       * The wrapper delegated the request to a new thread
  178%       * The wrapper succeeded
  179%       * The wrapper threw an error, non-200 status reply
  180%       (e.g., =not_modified=, =moved=) or a request to reply with
  181%       the content of a file.
  182%
  183%   @error socket I/O errors.
  184
  185cgi_close(_, _, _, _, Close) :-
  186    retract(spawned(ThreadId)),
  187    !,
  188    Close = spawned(ThreadId).
  189cgi_close(CGI, _, State0, ok, Close) :-
  190    !,
  191    catch(cgi_finish(CGI, Status, Close, Bytes), E, true),
  192    (   var(E)
  193    ->  http_done(Status, ok, Bytes, State0)
  194    ;   http_done(500, E, 0, State0),       % TBD: amount written?
  195        throw(E)
  196    ).
  197cgi_close(CGI, Request, Id, http_reply(Status), Close) :-
  198    !,
  199    cgi_close(CGI, Request, Id, http_reply(Status, []), Close).
  200cgi_close(CGI, Request, Id, http_reply(Status, ExtraHdrOpts), Close) :-
  201    cgi_property(CGI, header_codes(Text)),
  202    Text \== [],
  203    !,
  204    http_parse_header(Text, ExtraHdrCGI),
  205    cgi_property(CGI, client(Out)),
  206    cgi_discard(CGI),
  207    close(CGI),
  208    append(ExtraHdrCGI, ExtraHdrOpts, ExtraHdr),
  209    send_error(Out, Request, Id, http_reply(Status, ExtraHdr), Close).
  210cgi_close(CGI, Request, Id, Error, Close) :-
  211    cgi_property(CGI, client(Out)),
  212    cgi_discard(CGI),
  213    close(CGI),
  214    send_error(Out, Request, Id, Error, Close).
  215
  216cgi_finish(CGI, Status, Close, Bytes) :-
  217    flush_output(CGI),                      % update the content-length
  218    cgi_property(CGI, connection(Close)),
  219    cgi_property(CGI, content_length(Bytes)),
  220    (   cgi_property(CGI, header(Header)),
  221        memberchk(status(Status), Header)
  222    ->  true
  223    ;   Status = 200
  224    ),
  225    close(CGI).
  226
  227%!  send_error(+Out, +Request, +State0, +Error, -Close)
  228%
  229%   Send status replies and  reply   files.  The =current_output= no
  230%   longer points to the CGI stream, but   simply to the socket that
  231%   connects us to the client.
  232%
  233%   @param  State0 is start-status as returned by status/1.  Used to
  234%           find CPU usage, etc.
  235
  236send_error(Out, Request, State0, Error, Close) :-
  237    map_exception_to_http_status(Error, Reply, HdrExtra0, Context),
  238    update_keep_alive(HdrExtra0, HdrExtra, Request),
  239    catch(http_reply(Reply,
  240                     Out,
  241                     [ content_length(CLen)
  242                     | HdrExtra
  243                     ],
  244                     Context,
  245                     Request,
  246                     Code),
  247          E, true),
  248    (   var(E)
  249    ->  http_done(Code, Error, CLen, State0)
  250    ;   http_done(500,  E, 0, State0),
  251        throw(E)                    % is that wise?
  252    ),
  253    (   Error = http_reply(switching_protocols(Goal, SwitchOptions), _)
  254    ->  Close = switch_protocol(Goal, SwitchOptions)
  255    ;   memberchk(connection(Close), HdrExtra)
  256    ->  true
  257    ;   Close = close
  258    ).
  259
  260update_keep_alive(Header0, Header, Request) :-
  261    memberchk(connection(C), Header0),
  262    !,
  263    (   C == close
  264    ->  Header = Header0
  265    ;   client_wants_close(Request)
  266    ->  selectchk(connection(C),     Header0,
  267                  connection(close), Header)
  268    ;   Header = Header0
  269    ).
  270update_keep_alive(Header, Header, _).
  271
  272client_wants_close(Request) :-
  273    memberchk(connection(C), Request),
  274    !,
  275    C == close.
  276client_wants_close(Request) :-
  277    \+ ( memberchk(http_version(Major-_Minor), Request),
  278         Major >= 1
  279       ).
  280
  281
  282%!  http_done(+Code, +Status, +BytesSent, +State0) is det.
  283%
  284%   Provide feedback for logging and debugging   on  how the request
  285%   has been completed.
  286
  287http_done(Code, Status, Bytes, state0(_Thread, CPU0, Id)) :-
  288    thread_cputime(CPU1),
  289    CPU is CPU1 - CPU0,
  290    (   debugging(http(request))
  291    ->  debug_request(Code, Status, Id, CPU, Bytes)
  292    ;   true
  293    ),
  294    broadcast(http(request_finished(Id, Code, Status, CPU, Bytes))).
  295
  296
  297%!  handler_with_output_to(:Goal, +Id, +Request, +Output, -Status) is det.
  298%
  299%   Run Goal with output redirected to   Output. Unifies Status with
  300%   =ok=, the error from catch/3  or a term error(goal_failed(Goal),
  301%   _).
  302%
  303%   @param Request  The HTTP request read or '-' for a continuation
  304%                   using http_spawn/2.
  305
  306handler_with_output_to(Goal, Id, Request, current_output, Status) :-
  307    !,
  308    (   catch(call_handler(Goal, Id, Request), Status, true)
  309    ->  (   var(Status)
  310        ->  Status = ok
  311        ;   true
  312        )
  313    ;   Status = error(goal_failed(Goal),_)
  314    ).
  315handler_with_output_to(Goal, Id, Request, Output, Error) :-
  316    stream_property(OldOut, alias(current_output)),
  317    set_output(Output),
  318    handler_with_output_to(Goal, Id, Request, current_output, Error),
  319    set_output(OldOut).
  320
  321call_handler(Goal, _, -) :-            % continuation through http_spawn/2
  322    !,
  323    call(Goal).
  324call_handler(Goal, Id, Request0) :-
  325    expand_request(Request0, Request),
  326    current_output(CGI),
  327    cgi_set(CGI, request(Request)),
  328    broadcast(http(request_start(Id, Request))),
  329    call(Goal, Request).
  330
  331%!  thread_cputime(-CPU) is det.
  332%
  333%   CPU is the CPU time used by the calling thread.
  334
  335thread_cputime(CPU) :-
  336    statistics(cputime, CPU).
  337
  338%!  cgi_hook(+Event, +CGI) is det.
  339%
  340%   Hook called from the CGI   processing stream. See http_stream.pl
  341%   for details.
  342
  343:- public cgi_hook/2.  344
  345cgi_hook(What, _CGI) :-
  346    debug(http(hook), 'Running hook: ~q', [What]),
  347    fail.
  348cgi_hook(header, CGI) :-
  349    cgi_property(CGI, header_codes(HeadText)),
  350    cgi_property(CGI, header(Header0)), % see http_send_header/1
  351    http_parse_header(HeadText, CgiHeader0),
  352    append(Header0, CgiHeader0, CgiHeader),
  353    cgi_property(CGI, request(Request)),
  354    http_update_connection(CgiHeader, Request, Connection, Header1),
  355    http_update_transfer(Request, Header1, Transfer, Header2),
  356    http_update_encoding(Header2, Encoding, Header),
  357    set_stream(CGI, encoding(Encoding)),
  358    cgi_set(CGI, connection(Connection)),
  359    cgi_set(CGI, header(Header)),
  360    debug(http(transfer_encoding), 'Transfer-encoding: ~w', [Transfer]),
  361    cgi_set(CGI, transfer_encoding(Transfer)). % must be LAST
  362cgi_hook(send_header, CGI) :-
  363    cgi_property(CGI, header(Header)),
  364    debug(http(cgi), 'Header: ~q', [Header]),
  365    cgi_property(CGI, client(Out)),
  366    (   redirect(Header, Action, RedirectHeader)
  367    ->  http_status_reply(Action, Out, RedirectHeader, _),
  368        cgi_discard(CGI)
  369    ;   cgi_property(CGI, transfer_encoding(chunked))
  370    ->  http_reply_header(Out, chunked_data, Header)
  371    ;   cgi_property(CGI, content_length(Len))
  372    ->  http_reply_header(Out, cgi_data(Len), Header)
  373    ).
  374cgi_hook(close, _).
  375
  376%!  redirect(+Header, -Action, -RestHeader) is semidet.
  377%
  378%   Detect the CGI =Location=  and   optional  =Status=  headers for
  379%   formulating a HTTP redirect.  Redirection is only established if
  380%   no =Status= is provided, or =Status= is 3XX.
  381
  382redirect(Header, Action, RestHeader) :-
  383    selectchk(location(To), Header, Header1),
  384    (   selectchk(status(Status), Header1, RestHeader)
  385    ->  between(300, 399, Status)
  386    ;   RestHeader = Header1,
  387        Status = 302
  388    ),
  389    redirect_action(Status, To, Action).
  390
  391redirect_action(301, To, moved(To)).
  392redirect_action(302, To, moved_temporary(To)).
  393redirect_action(303, To, see_other(To)).
  394
  395
  396%!  http_send_header(+Header)
  397%
  398%   This API provides an alternative for writing the header field as
  399%   a CGI header. Header has the  format Name(Value), as produced by
  400%   http_read_header/2.
  401%
  402%   @deprecated     Use CGI lines instead
  403
  404http_send_header(Header) :-
  405    current_output(CGI),
  406    cgi_property(CGI, header(Header0)),
  407    cgi_set(CGI, header([Header|Header0])).
  408
  409
  410%!  expand_request(+Request0, -Request)
  411%
  412%   Allow  for  general   rewrites   of    a   request   by  calling
  413%   http:request_expansion/2.
  414
  415expand_request(R0, R) :-
  416    http:request_expansion(R0, R1),         % Hook
  417    R1 \== R0,
  418    !,
  419    expand_request(R1, R).
  420expand_request(R, R).
  421
  422
  423%!  extend_request(+Options, +RequestIn, -Request)
  424%
  425%   Merge options in the request.
  426
  427extend_request([], R, R).
  428extend_request([request(R)|T], R0, R) :-
  429    !,
  430    extend_request(T, R0, R).
  431extend_request([H|T], R0, R) :-
  432    request_option(H),
  433    !,
  434    extend_request(T, [H|R0], R).
  435extend_request([_|T], R0, R) :-
  436    extend_request(T, R0, R).
  437
  438request_option(peer(_)).
  439request_option(protocol(_)).
  440request_option(pool(_)).
  441
  442
  443%!  http_current_request(-Request) is semidet.
  444%
  445%   Returns  the  HTTP  request  currently  being  processed.  Fails
  446%   silently if there is no current  request. This typically happens
  447%   if a goal is run outside the HTTP server context.
  448
  449http_current_request(Request) :-
  450    current_output(CGI),
  451    is_cgi_stream(CGI),
  452    cgi_property(CGI, request(Request)).
  453
  454
  455%!  http_peer(+Request, -PeerIP:atom) is semidet.
  456%
  457%   True when PeerIP is the IP address   of  the connection peer. If the
  458%   connection is established via a proxy  or   CDN  we  try to find the
  459%   initiating peer.  Currently supports:
  460%
  461%     - =Fastly-client-ip=
  462%     - =X-real-ip=
  463%     - =X-forwarded-for=
  464%     - Direct connections
  465%
  466%   @bug The =X-forwarded-for=  header  is   problematic.  According  to
  467%   [Wikipedia](https://en.wikipedia.org/wiki/X-Forwarded-For),      the
  468%   original   client   is   the    _first_,     while    according   to
  469%   [AWS](http://docs.aws.amazon.com/elasticloadbalancing/latest/classic/x-forwarded-headers.html)
  470%   it is the _last_.
  471
  472http_peer(Request, Peer) :-
  473    memberchk(fastly_client_ip(Peer), Request), !.
  474http_peer(Request, Peer) :-
  475    memberchk(x_real_ip(Peer), Request), !.
  476http_peer(Request, IP) :-
  477    memberchk(x_forwarded_for(IP0), Request),
  478    !,
  479    atomic_list_concat(Parts, ', ', IP0),
  480    last(Parts, IP).
  481http_peer(Request, IP) :-
  482    memberchk(peer(Peer), Request),
  483    !,
  484    peer_to_ip(Peer, IP).
  485
  486peer_to_ip(ip(A,B,C,D), IP) :-
  487    atomic_list_concat([A,B,C,D], '.', IP).
  488
  489
  490%!  http_relative_path(+AbsPath, -RelPath) is det.
  491%
  492%   Convert an absolute path (without host, fragment or search) into
  493%   a path relative to the current page.   This  call is intended to
  494%   create reusable components returning relative   paths for easier
  495%   support of reverse proxies.
  496
  497http_relative_path(Path, RelPath) :-
  498    http_current_request(Request),
  499    memberchk(path(RelTo), Request),
  500    http_relative_path(Path, RelTo, RelPath),
  501    !.
  502http_relative_path(Path, Path).
  503
  504http_relative_path(Path, RelTo, RelPath) :-
  505    atomic_list_concat(PL, /, Path),
  506    atomic_list_concat(RL, /, RelTo),
  507    delete_common_prefix(PL, RL, PL1, PL2),
  508    to_dot_dot(PL2, DotDot, PL1),
  509    atomic_list_concat(DotDot, /, RelPath).
  510
  511delete_common_prefix([H|T01], [H|T02], T1, T2) :-
  512    !,
  513    delete_common_prefix(T01, T02, T1, T2).
  514delete_common_prefix(T1, T2, T1, T2).
  515
  516to_dot_dot([], Tail, Tail).
  517to_dot_dot([_], Tail, Tail) :- !.
  518to_dot_dot([_|T0], ['..'|T], Tail) :-
  519    to_dot_dot(T0, T, Tail).
  520
  521
  522                 /*******************************
  523                 *         DEBUG SUPPORT        *
  524                 *******************************/
  525
  526%!  debug_request(+Code, +Status, +Id, +CPU0, Bytes)
  527%
  528%   Emit debugging info after a request completed with Status.
  529
  530debug_request(Code, ok, Id, CPU, Bytes) :-
  531    !,
  532    debug(http(request), '[~D] ~w OK (~3f seconds; ~D bytes)',
  533          [Id, Code, CPU, Bytes]).
  534debug_request(Code, Status, Id, _, Bytes) :-
  535    map_exception(Status, Reply),
  536    !,
  537    debug(http(request), '[~D] ~w ~w; ~D bytes',
  538          [Id, Code, Reply, Bytes]).
  539debug_request(Code, Except, Id, _, _) :-
  540    Except = error(_,_),
  541    !,
  542    message_to_string(Except, Message),
  543    debug(http(request), '[~D] ~w ERROR: ~w',
  544          [Id, Code, Message]).
  545debug_request(Code, Status, Id, _, Bytes) :-
  546    debug(http(request), '[~D] ~w ~w; ~D bytes',
  547          [Id, Code, Status, Bytes]).
  548
  549map_exception(http_reply(Reply), Reply).
  550map_exception(http_reply(Reply, _), Reply).
  551map_exception(error(existence_error(http_location, Location), _Stack),
  552              error(404, Location))