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