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