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(http_header,
   37          [ http_read_request/2,        % +Stream, -Request
   38            http_read_reply_header/2,   % +Stream, -Reply
   39            http_reply/2,               % +What, +Stream
   40            http_reply/3,               % +What, +Stream, +HdrExtra
   41            http_reply/4,               % +What, +Stream, +HdrExtra, -Code
   42            http_reply/5,               % +What, +Stream, +HdrExtra, +Context,
   43                                        % -Code
   44            http_reply/6,               % +What, +Stream, +HdrExtra, +Context,
   45                                        % +Request, -Code
   46            http_reply_header/3,        % +Stream, +What, +HdrExtra
   47            http_status_reply/4,        % +Status, +Out, +HdrExtra, -Code
   48            http_status_reply/5,        % +Status, +Out, +HdrExtra,
   49                                        % +Context, -Code
   50
   51            http_timestamp/2,           % +Time, -HTTP string
   52
   53            http_post_data/3,           % +Stream, +Data, +HdrExtra
   54
   55            http_read_header/2,         % +Fd, -Header
   56            http_parse_header/2,        % +Codes, -Header
   57            http_parse_header_value/3,  % +Header, +HeaderValue, -MediaTypes
   58            http_join_headers/3,        % +Default, +InHdr, -OutHdr
   59            http_update_encoding/3,     % +HeaderIn, -Encoding, -HeaderOut
   60            http_update_connection/4,   % +HeaderIn, +Request, -Connection, -HeaderOut
   61            http_update_transfer/4      % +HeaderIn, +Request, -Transfer, -HeaderOut
   62          ]).   63:- use_module(library(readutil)).   64:- use_module(library(debug)).   65:- use_module(library(error)).   66:- use_module(library(option)).   67:- use_module(library(lists)).   68:- use_module(library(url)).   69:- use_module(library(uri)).   70:- use_module(library(memfile)).   71:- use_module(library(settings)).   72:- use_module(library(error)).   73:- use_module(library(pairs)).   74:- use_module(library(socket)).   75:- use_module(library(dcg/basics)).   76:- use_module(html_write).   77:- use_module(http_exception).   78:- use_module(mimetype).   79:- use_module(mimepack).   80
   81:- multifile
   82    http:status_page/3,             % +Status, +Context, -HTML
   83    http:post_data_hook/3,          % +Data, +Out, +HdrExtra
   84    http:mime_type_encoding/2.       % +MimeType, -Encoding
   85
   86% see http_update_transfer/4.
   87
   88:- setting(http:chunked_transfer, oneof([never,on_request,if_possible]),
   89           on_request, 'When to use Transfer-Encoding: Chunked').   90
   91
   92/** <module> Handling HTTP headers
   93
   94The library library(http/http_header) provides   primitives  for parsing
   95and composing HTTP headers. Its functionality  is normally hidden by the
   96other parts of the HTTP server and client libraries.
   97*/
   98
   99
  100                 /*******************************
  101                 *          READ REQUEST        *
  102                 *******************************/
  103
  104%!  http_read_request(+FdIn:stream, -Request) is det.
  105%
  106%   Read an HTTP request-header from FdIn and return the broken-down
  107%   request fields as +Name(+Value) pairs  in   a  list.  Request is
  108%   unified to =end_of_file= if FdIn is at the end of input.
  109
  110http_read_request(In, Request) :-
  111    catch(read_line_to_codes(In, Codes), E, true),
  112    (   var(E)
  113    ->  (   Codes == end_of_file
  114        ->  debug(http(header), 'end-of-file', []),
  115            Request = end_of_file
  116        ;   debug(http(header), 'First line: ~s', [Codes]),
  117            Request =  [input(In)|Request1],
  118            phrase(request(In, Request1), Codes),
  119            (   Request1 = [unknown(Text)|_]
  120            ->  string_codes(S, Text),
  121                syntax_error(http_request(S))
  122            ;   true
  123            )
  124        )
  125    ;   (   debugging(http(request))
  126        ->  message_to_string(E, Msg),
  127            debug(http(request), "Exception reading 1st line: ~s", [Msg])
  128        ;   true
  129        ),
  130        Request = end_of_file
  131    ).
  132
  133
  134%!  http_read_reply_header(+FdIn, -Reply)
  135%
  136%   Read the HTTP reply header. Throws   an exception if the current
  137%   input does not contain a valid reply header.
  138
  139http_read_reply_header(In, [input(In)|Reply]) :-
  140    read_line_to_codes(In, Codes),
  141    (   Codes == end_of_file
  142    ->  debug(http(header), 'end-of-file', []),
  143        throw(error(syntax(http_reply_header, end_of_file), _))
  144    ;   debug(http(header), 'First line: ~s~n', [Codes]),
  145        (   phrase(reply(In, Reply), Codes)
  146        ->  true
  147        ;   atom_codes(Header, Codes),
  148            syntax_error(http_reply_header(Header))
  149        )
  150    ).
  151
  152
  153                 /*******************************
  154                 *        FORMULATE REPLY       *
  155                 *******************************/
  156
  157%!  http_reply(+Data, +Out:stream) is det.
  158%!  http_reply(+Data, +Out:stream, +HdrExtra) is det.
  159%!  http_reply(+Data, +Out:stream, +HdrExtra, -Code) is det.
  160%!  http_reply(+Data, +Out:stream, +HdrExtra, +Context, -Code) is det.
  161%!  http_reply(+Data, +Out:stream, +HdrExtra, +Context, +Request, -Code) is det.
  162%
  163%   Compose  a  complete  HTTP  reply  from   the  term  Data  using
  164%   additional headers from  HdrExtra  to   the  output  stream Out.
  165%   ExtraHeader is a list of Field(Value). Data is one of:
  166%
  167%           * html(HTML)
  168%           HTML tokens as produced by html//1 from html_write.pl
  169%
  170%           * file(+MimeType, +FileName)
  171%           Reply content of FileName using MimeType
  172%
  173%           * file(+MimeType, +FileName, +Range)
  174%           Reply partial content of FileName with given MimeType
  175%
  176%           * tmp_file(+MimeType, +FileName)
  177%           Same as =file=, but do not include modification time
  178%
  179%           * bytes(+MimeType, +Bytes)
  180%           Send a sequence of Bytes with the indicated MimeType.
  181%           Bytes is either a string of character codes 0..255 or
  182%           list of integers in the range 0..255. Out-of-bound codes
  183%           result in a representation error exception.
  184%
  185%           * stream(+In, +Len)
  186%           Reply content of stream.
  187%
  188%           * cgi_stream(+In, +Len)
  189%           Reply content of stream, which should start with an
  190%           HTTP header, followed by a blank line.  This is the
  191%           typical output from a CGI script.
  192%
  193%           * Status
  194%           HTTP status report as defined by http_status_reply/4.
  195%
  196%   @param HdrExtra provides additional reply-header fields, encoded
  197%          as Name(Value). It can also contain a field
  198%          content_length(-Len) to _retrieve_ the
  199%          value of the Content-length header that is replied.
  200%   @param Code is the numeric HTTP status code sent
  201%
  202%   @tbd    Complete documentation
  203
  204http_reply(What, Out) :-
  205    http_reply(What, Out, [connection(close)], _).
  206
  207http_reply(Data, Out, HdrExtra) :-
  208    http_reply(Data, Out, HdrExtra, _Code).
  209
  210http_reply(Data, Out, HdrExtra, Code) :-
  211    http_reply(Data, Out, HdrExtra, [], Code).
  212
  213http_reply(Data, Out, HdrExtra, Context, Code) :-
  214    http_reply(Data, Out, HdrExtra, Context, [method(get)], Code).
  215
  216http_reply(Data, Out, HdrExtra, _Context, Request, Code) :-
  217    byte_count(Out, C0),
  218    memberchk(method(Method), Request),
  219    catch(http_reply_data(Data, Out, HdrExtra, Method, Code), E, true),
  220    !,
  221    (   var(E)
  222    ->  true
  223    ;   E = error(io_error(write, _), _)
  224    ->  byte_count(Out, C1),
  225        Sent is C1 - C0,
  226        throw(error(http_write_short(Data, Sent), _))
  227    ;   E = error(timeout_error(write, _), _)
  228    ->  throw(E)
  229    ;   map_exception_to_http_status(E, Status, NewHdr, NewContext),
  230        http_status_reply(Status, Out, NewHdr, NewContext, Request, Code)
  231    ).
  232http_reply(Status, Out, HdrExtra, Context, Request, Code) :-
  233    http_status_reply(Status, Out, HdrExtra, Context, Request, Code).
  234
  235:- meta_predicate
  236    if_no_head(+, 0).  237
  238%!  http_reply_data(+Data, +Out, +HdrExtra, +Method, -Code) is semidet.
  239%
  240%   Fails if Data is not a defined   reply-data format, but a status
  241%   term. See http_reply/3 and http_status_reply/6.
  242%
  243%   @error Various I/O errors.
  244
  245http_reply_data(Data, Out, HdrExtra, Method, Code) :-
  246    http_reply_data_(Data, Out, HdrExtra, Method, Code),
  247    flush_output(Out).
  248
  249http_reply_data_(html(HTML), Out, HdrExtra, Method, Code) :-
  250    !,
  251    phrase(reply_header(html(HTML), HdrExtra, Code), Header),
  252    format(Out, '~s', [Header]),
  253    if_no_head(Method, print_html(Out, HTML)).
  254http_reply_data_(file(Type, File), Out, HdrExtra, Method, Code) :-
  255    !,
  256    phrase(reply_header(file(Type, File), HdrExtra, Code), Header),
  257    reply_file(Out, File, Header, Method).
  258http_reply_data_(gzip_file(Type, File), Out, HdrExtra, Method, Code) :-
  259    !,
  260    phrase(reply_header(gzip_file(Type, File), HdrExtra, Code), Header),
  261    reply_file(Out, File, Header, Method).
  262http_reply_data_(file(Type, File, Range), Out, HdrExtra, Method, Code) :-
  263    !,
  264    phrase(reply_header(file(Type, File, Range), HdrExtra, Code), Header),
  265    reply_file_range(Out, File, Header, Range, Method).
  266http_reply_data_(tmp_file(Type, File), Out, HdrExtra, Method, Code) :-
  267    !,
  268    phrase(reply_header(tmp_file(Type, File), HdrExtra, Code), Header),
  269    reply_file(Out, File, Header, Method).
  270http_reply_data_(bytes(Type, Bytes), Out, HdrExtra, Method, Code) :-
  271    !,
  272    phrase(reply_header(bytes(Type, Bytes), HdrExtra, Code), Header),
  273    format(Out, '~s', [Header]),
  274    if_no_head(Method, format(Out, '~s', [Bytes])).
  275http_reply_data_(stream(In, Len), Out, HdrExtra, Method, Code) :-
  276    !,
  277    phrase(reply_header(cgi_data(Len), HdrExtra, Code), Header),
  278    copy_stream(Out, In, Header, Method, 0, end).
  279http_reply_data_(cgi_stream(In, Len), Out, HdrExtra, Method, Code) :-
  280    !,
  281    http_read_header(In, CgiHeader),
  282    seek(In, 0, current, Pos),
  283    Size is Len - Pos,
  284    http_join_headers(HdrExtra, CgiHeader, Hdr2),
  285    phrase(reply_header(cgi_data(Size), Hdr2, Code), Header),
  286    copy_stream(Out, In, Header, Method, 0, end).
  287
  288if_no_head(head, _) :- !.
  289if_no_head(_, Goal) :-
  290    call(Goal).
  291
  292reply_file(Out, _File, Header, head) :-
  293    !,
  294    format(Out, '~s', [Header]).
  295reply_file(Out, File, Header, _) :-
  296    setup_call_cleanup(
  297        open(File, read, In, [type(binary)]),
  298        copy_stream(Out, In, Header, 0, end),
  299        close(In)).
  300
  301reply_file_range(Out, _File, Header, _Range, head) :-
  302    !,
  303    format(Out, '~s', [Header]).
  304reply_file_range(Out, File, Header, bytes(From, To), _) :-
  305    setup_call_cleanup(
  306        open(File, read, In, [type(binary)]),
  307        copy_stream(Out, In, Header, From, To),
  308        close(In)).
  309
  310copy_stream(Out, _, Header, head, _, _) :-
  311    !,
  312    format(Out, '~s', [Header]).
  313copy_stream(Out, In, Header, _, From, To) :-
  314    copy_stream(Out, In, Header, From, To).
  315
  316copy_stream(Out, In, Header, From, To) :-
  317    (   From == 0
  318    ->  true
  319    ;   seek(In, From, bof, _)
  320    ),
  321    peek_byte(In, _),
  322    format(Out, '~s', [Header]),
  323    (   To == end
  324    ->  copy_stream_data(In, Out)
  325    ;   Len is To - From,
  326        copy_stream_data(In, Out, Len)
  327    ).
  328
  329
  330%!  http_status_reply(+Status, +Out, +HdrExtra, -Code) is det.
  331%!  http_status_reply(+Status, +Out, +HdrExtra, +Context, -Code) is det.
  332%!  http_status_reply(+Status, +Out, +HdrExtra, +Context, +Request, -Code) is det.
  333%
  334%   Emit HTML non-200 status reports. Such  requests are always sent
  335%   as UTF-8 documents.
  336%
  337%   Status can be one of the following:
  338%      - authorise(Method)
  339%        Challenge authorization.  Method is one of
  340%        - basic(Realm)
  341%        - digest(Digest)
  342%      - authorise(basic,Realm)
  343%        Same as authorise(basic(Realm)).  Deprecated.
  344%      - bad_request(ErrorTerm)
  345%      - busy
  346%      - created(Location)
  347%      - forbidden(Url)
  348%      - moved(To)
  349%      - moved_temporary(To)
  350%      - no_content
  351%      - not_acceptable(WhyHtml)
  352%      - not_found(Path)
  353%      - method_not_allowed(Method, Path)
  354%      - not_modified
  355%      - resource_error(ErrorTerm)
  356%      - see_other(To)
  357%      - switching_protocols(Goal,Options)
  358%      - server_error(ErrorTerm)
  359%      - unavailable(WhyHtml)
  360
  361http_status_reply(Status, Out, HdrExtra, Code) :-
  362    http_status_reply(Status, Out, HdrExtra, [], Code).
  363
  364http_status_reply(Status, Out, HdrExtra, Context, Code) :-
  365    http_status_reply(Status, Out, HdrExtra, Context, [method(get)], Code).
  366
  367http_status_reply(Status, Out, HdrExtra, Context, Request, Code) :-
  368    option(method(Method), Request, get),
  369    setup_call_cleanup(
  370        set_stream(Out, encoding(utf8)),
  371        status_reply_flush(Status, Out, HdrExtra, Context, Method, Code),
  372        set_stream(Out, encoding(octet))),
  373    !.
  374
  375status_reply_flush(Status, Out, HdrExtra, Context, Method, Code) :-
  376    status_reply(Status, Out, HdrExtra, Context, Method, Code),
  377    flush_output(Out).
  378
  379status_reply(no_content, Out, HdrExtra, _Context, _Method, Code) :-
  380    !,
  381    phrase(reply_header(status(no_content), HdrExtra, Code), Header),
  382    format(Out, '~s', [Header]).
  383status_reply(switching_protocols(_Goal,Options), Out,
  384             HdrExtra0, _Context, _Method, Code) :-
  385    !,
  386    (   option(headers(Extra1), Options)
  387    ->  true
  388    ;   option(header(Extra1), Options, [])
  389    ),
  390    http_join_headers(HdrExtra0, Extra1, HdrExtra),
  391    phrase(reply_header(status(switching_protocols), HdrExtra, Code), Header),
  392    format(Out, '~s', [Header]).
  393status_reply(created(Location), Out, HdrExtra, _Context, Method, Code) :-
  394    !,
  395    phrase(page([ title('201 Created')
  396                ],
  397                [ h1('Created'),
  398                  p(['The document was created ',
  399                     a(href(Location), ' Here')
  400                    ]),
  401                  \address
  402                ]),
  403           HTML),
  404    phrase(reply_header(created(Location, HTML), HdrExtra, Code), Header),
  405    format(Out, '~s', [Header]),
  406    print_html_if_no_head(Method, Out, HTML).
  407status_reply(moved(To), Out, HdrExtra, _Context, Method, Code) :-
  408    !,
  409    phrase(page([ title('301 Moved Permanently')
  410                ],
  411                [ h1('Moved Permanently'),
  412                  p(['The document has moved ',
  413                     a(href(To), ' Here')
  414                    ]),
  415                  \address
  416                ]),
  417           HTML),
  418    phrase(reply_header(moved(To, HTML), HdrExtra, Code), Header),
  419    format(Out, '~s', [Header]),
  420    print_html_if_no_head(Method, Out, HTML).
  421status_reply(moved_temporary(To), Out, HdrExtra, _Context, Method, Code) :-
  422    !,
  423    phrase(page([ title('302 Moved Temporary')
  424                ],
  425                [ h1('Moved Temporary'),
  426                  p(['The document is currently ',
  427                     a(href(To), ' Here')
  428                    ]),
  429                  \address
  430                ]),
  431           HTML),
  432    phrase(reply_header(moved_temporary(To, HTML),
  433                        HdrExtra, Code), Header),
  434    format(Out, '~s', [Header]),
  435    print_html_if_no_head(Method, Out, HTML).
  436status_reply(see_other(To),Out,HdrExtra, _Context, Method, Code) :-
  437    !,
  438    phrase(page([ title('303 See Other')
  439                 ],
  440                 [ h1('See Other'),
  441                   p(['See other document ',
  442                      a(href(To), ' Here')
  443                     ]),
  444                   \address
  445                 ]),
  446            HTML),
  447     phrase(reply_header(see_other(To, HTML), HdrExtra, Code), Header),
  448     format(Out, '~s', [Header]),
  449     print_html_if_no_head(Method, Out, HTML).
  450status_reply(bad_request(ErrorTerm), Out, HdrExtra, _Context, Method, Code) :-
  451    !,
  452    '$messages':translate_message(ErrorTerm, Lines, []),
  453    phrase(page([ title('400 Bad Request')
  454                ],
  455                [ h1('Bad Request'),
  456                  p(\html_message_lines(Lines)),
  457                  \address
  458                ]),
  459           HTML),
  460    phrase(reply_header(status(bad_request, HTML),
  461                        HdrExtra, Code), Header),
  462    format(Out, '~s', [Header]),
  463    print_html_if_no_head(Method, Out, HTML).
  464status_reply(not_found(URL), Out, HdrExtra, Context, Method, Code) :-
  465    !,
  466    status_page_hook(not_found(URL), 404, Context, HTML),
  467    phrase(reply_header(status(not_found, HTML), HdrExtra, Code), Header),
  468    format(Out, '~s', [Header]),
  469    print_html_if_no_head(Method, Out, HTML).
  470status_reply(method_not_allowed(Method, URL), Out, HdrExtra, Context, QMethod, Code) :-
  471    !,
  472    upcase_atom(Method, UMethod),
  473    status_page_hook(method_not_allowed(UMethod,URL), 405, Context, HTML),
  474    phrase(reply_header(status(method_not_allowed, HTML),
  475                        HdrExtra, Code), Header),
  476    format(Out, '~s', [Header]),
  477    if_no_head(QMethod, print_html(Out, HTML)).
  478status_reply(forbidden(URL), Out, HdrExtra, Context, Method, Code) :-
  479    !,
  480    status_page_hook(forbidden(URL), 403, Context, HTML),
  481    phrase(reply_header(status(forbidden, HTML), HdrExtra, Code), Header),
  482    format(Out, '~s', [Header]),
  483    print_html_if_no_head(Method, Out, HTML).
  484status_reply(authorise(basic, ''), Out, HdrExtra, Context, Method, Code) :-
  485    !,
  486    status_reply(authorise(basic), Out, HdrExtra, Context, Method, Code).
  487status_reply(authorise(basic, Realm), Out, HdrExtra, Context, Method, Code) :-
  488    !,
  489    status_reply(authorise(basic(Realm)), Out, HdrExtra, Context,
  490                 Method, Code).
  491status_reply(authorise(Method), Out, HdrExtra, Context, QMethod, Code) :-
  492    !,
  493    status_page_hook(authorise(Method), 401, Context, HTML),
  494    phrase(reply_header(authorise(Method, HTML),
  495                        HdrExtra, Code), Header),
  496    format(Out, '~s', [Header]),
  497    print_html_if_no_head(QMethod, Out, HTML).
  498status_reply(not_modified, Out, HdrExtra, _Context, _Method, Code) :-
  499    !,
  500    phrase(reply_header(status(not_modified), HdrExtra, Code), Header),
  501    format(Out, '~s', [Header]).
  502status_reply(server_error(ErrorTerm), Out, HdrExtra, _Context, Method, Code) :-
  503    in_or_exclude_backtrace(ErrorTerm, ErrorTerm1),
  504    '$messages':translate_message(ErrorTerm1, Lines, []),
  505    phrase(page([ title('500 Internal server error')
  506                ],
  507                [ h1('Internal server error'),
  508                  p(\html_message_lines(Lines)),
  509                  \address
  510                ]),
  511           HTML),
  512    phrase(reply_header(status(server_error, HTML),
  513                        HdrExtra, Code), Header),
  514    format(Out, '~s', [Header]),
  515    print_html_if_no_head(Method, Out, HTML).
  516status_reply(not_acceptable(WhyHTML), Out, HdrExtra, _Context,
  517             Method, Code) :-
  518    !,
  519    phrase(page([ title('406 Not Acceptable')
  520                ],
  521                [ h1('Not Acceptable'),
  522                  WhyHTML,
  523                  \address
  524                ]),
  525           HTML),
  526    phrase(reply_header(status(not_acceptable, HTML), HdrExtra, Code), Header),
  527    format(Out, '~s', [Header]),
  528    print_html_if_no_head(Method, Out, HTML).
  529status_reply(unavailable(WhyHTML), Out, HdrExtra, _Context, Method, Code) :-
  530    !,
  531    phrase(page([ title('503 Service Unavailable')
  532                ],
  533                [ h1('Service Unavailable'),
  534                  WhyHTML,
  535                  \address
  536                ]),
  537           HTML),
  538    phrase(reply_header(status(service_unavailable, HTML), HdrExtra, Code),
  539           Header),
  540    format(Out, '~s', [Header]),
  541    print_html_if_no_head(Method, Out, HTML).
  542status_reply(resource_error(ErrorTerm), Out, HdrExtra, Context, Method, Code) :-
  543    !,
  544    '$messages':translate_message(ErrorTerm, Lines, []),
  545    status_reply(unavailable(p(\html_message_lines(Lines))),
  546                 Out, HdrExtra, Context, Method, Code).
  547status_reply(busy, Out, HdrExtra, Context, Method, Code) :-
  548    !,
  549    HTML = p(['The server is temporarily out of resources, ',
  550              'please try again later']),
  551    http_status_reply(unavailable(HTML), Out, HdrExtra, Context,
  552                      Method, Code).
  553
  554print_html_if_no_head(head, _, _) :- !.
  555print_html_if_no_head(_, Out, HTML) :-
  556    print_html(Out, HTML).
  557
  558%!  status_page_hook(+Term, +Code, +Context, -HTMLTokens) is det.
  559%
  560%   Calls the following two hooks to generate an HTML page from a
  561%   status reply.
  562%
  563%     - http:status_page(Term, Context, HTML)
  564%     - http:status_page(Status, Context, HTML)
  565
  566status_page_hook(Term, Status, Context, HTML) :-
  567    (   http:status_page(Term, Context, HTML)
  568    ;   http:status_page(Status, Context, HTML) % deprecated
  569    ),
  570    !.
  571
  572status_page_hook(authorise(_Method), 401, _Context, HTML):-
  573    phrase(page([ title('401 Authorization Required')
  574                ],
  575                [ h1('Authorization Required'),
  576                  p(['This server could not verify that you ',
  577                     'are authorized to access the document ',
  578                     'requested.  Either you supplied the wrong ',
  579                     'credentials (e.g., bad password), or your ',
  580                     'browser doesn\'t understand how to supply ',
  581                     'the credentials required.'
  582                    ]),
  583                  \address
  584                ]),
  585           HTML).
  586status_page_hook(forbidden(URL), 403, _Context, HTML) :-
  587    phrase(page([ title('403 Forbidden')
  588                ],
  589                [ h1('Forbidden'),
  590                  p(['You don\'t have permission to access ', URL,
  591                     ' on this server'
  592                    ]),
  593                  \address
  594                ]),
  595           HTML).
  596status_page_hook(not_found(URL), 404, _Context, HTML) :-
  597    phrase(page([ title('404 Not Found')
  598                ],
  599                [ h1('Not Found'),
  600                  p(['The requested URL ', tt(URL),
  601                     ' was not found on this server'
  602                    ]),
  603                  \address
  604                ]),
  605           HTML).
  606status_page_hook(method_not_allowed(UMethod,URL), 405, _Context, HTML) :-
  607    phrase(page([ title('405 Method not allowed')
  608                ],
  609                [ h1('Method not allowed'),
  610                  p(['The requested URL ', tt(URL),
  611                     ' does not support method ', tt(UMethod), '.'
  612                    ]),
  613                  \address
  614                ]),
  615           HTML).
  616
  617
  618html_message_lines([]) -->
  619    [].
  620html_message_lines([nl|T]) -->
  621    !,
  622    html([br([])]),
  623    html_message_lines(T).
  624html_message_lines([flush]) -->
  625    [].
  626html_message_lines([Fmt-Args|T]) -->
  627    !,
  628    { format(string(S), Fmt, Args)
  629    },
  630    html([S]),
  631    html_message_lines(T).
  632html_message_lines([Fmt|T]) -->
  633    !,
  634    { format(string(S), Fmt, [])
  635    },
  636    html([S]),
  637    html_message_lines(T).
  638
  639%!  http_join_headers(+Default, +Header, -Out)
  640%
  641%   Append headers from Default to Header if they are not
  642%   already part of it.
  643
  644http_join_headers([], H, H).
  645http_join_headers([H|T], Hdr0, Hdr) :-
  646    functor(H, N, A),
  647    functor(H2, N, A),
  648    member(H2, Hdr0),
  649    !,
  650    http_join_headers(T, Hdr0, Hdr).
  651http_join_headers([H|T], Hdr0, [H|Hdr]) :-
  652    http_join_headers(T, Hdr0, Hdr).
  653
  654
  655%!  http_update_encoding(+HeaderIn, -Encoding, -HeaderOut)
  656%
  657%   Allow for rewrite of the  header,   adjusting  the  encoding. We
  658%   distinguish three options. If  the   user  announces  `text', we
  659%   always use UTF-8 encoding. If   the user announces charset=utf-8
  660%   we  use  UTF-8  and  otherwise  we  use  octet  (raw)  encoding.
  661%   Alternatively we could dynamically choose for ASCII, ISO-Latin-1
  662%   or UTF-8.
  663
  664http_update_encoding(Header0, utf8, [content_type(Type)|Header]) :-
  665    select(content_type(Type0), Header0, Header),
  666    sub_atom(Type0, 0, _, _, 'text/'),
  667    !,
  668    (   sub_atom(Type0, S, _, _, ';')
  669    ->  sub_atom(Type0, 0, S, _, B)
  670    ;   B = Type0
  671    ),
  672    atom_concat(B, '; charset=UTF-8', Type).
  673http_update_encoding(Header, Encoding, Header) :-
  674    memberchk(content_type(Type), Header),
  675    (   (   sub_atom(Type, _, _, _, 'UTF-8')
  676        ;   sub_atom(Type, _, _, _, 'utf-8')
  677        )
  678    ->  Encoding = utf8
  679    ;   http:mime_type_encoding(Type, Encoding)
  680    ->  true
  681    ;   mime_type_encoding(Type, Encoding)
  682    ).
  683http_update_encoding(Header, octet, Header).
  684
  685%!  mime_type_encoding(+MimeType, -Encoding) is semidet.
  686%
  687%   Encoding is the (default) character encoding for MimeType. Hooked by
  688%   http:mime_type_encoding/2.
  689
  690mime_type_encoding('application/json',         utf8).
  691mime_type_encoding('application/jsonrequest',  utf8).
  692mime_type_encoding('application/x-prolog',     utf8).
  693mime_type_encoding('application/n-quads',      utf8).
  694mime_type_encoding('application/n-triples',    utf8).
  695mime_type_encoding('application/sparql-query', utf8).
  696mime_type_encoding('application/trig',         utf8).
  697
  698%!  http:mime_type_encoding(+MimeType, -Encoding) is semidet.
  699%
  700%   Encoding is the (default) character encoding   for MimeType. This is
  701%   used for setting the encoding for HTTP  replies after the user calls
  702%   format('Content-type: <MIME type>~n'). This hook   is  called before
  703%   mime_type_encoding/2. This default  defines  `utf8`   for  JSON  and
  704%   Turtle derived =|application/|= MIME types.
  705
  706
  707%!  http_update_connection(+CGIHeader, +Request, -Connection, -Header)
  708%
  709%   Merge keep-alive information from  Request   and  CGIHeader into
  710%   Header.
  711
  712http_update_connection(CgiHeader, Request, Connect,
  713                       [connection(Connect)|Rest]) :-
  714    select(connection(CgiConn), CgiHeader, Rest),
  715    !,
  716    connection(Request, ReqConnection),
  717    join_connection(ReqConnection, CgiConn, Connect).
  718http_update_connection(CgiHeader, Request, Connect,
  719                       [connection(Connect)|CgiHeader]) :-
  720    connection(Request, Connect).
  721
  722join_connection(Keep1, Keep2, Connection) :-
  723    (   downcase_atom(Keep1, 'keep-alive'),
  724        downcase_atom(Keep2, 'keep-alive')
  725    ->  Connection = 'Keep-Alive'
  726    ;   Connection = close
  727    ).
  728
  729
  730%!  connection(+Header, -Connection)
  731%
  732%   Extract the desired connection from a header.
  733
  734connection(Header, Close) :-
  735    (   memberchk(connection(Connection), Header)
  736    ->  Close = Connection
  737    ;   memberchk(http_version(1-X), Header),
  738        X >= 1
  739    ->  Close = 'Keep-Alive'
  740    ;   Close = close
  741    ).
  742
  743
  744%!  http_update_transfer(+Request, +CGIHeader, -Transfer, -Header)
  745%
  746%   Decide on the transfer encoding  from   the  Request and the CGI
  747%   header.    The    behaviour    depends      on    the    setting
  748%   http:chunked_transfer. If =never=, even   explitic  requests are
  749%   ignored. If =on_request=, chunked encoding  is used if requested
  750%   through  the  CGI  header  and  allowed    by   the  client.  If
  751%   =if_possible=, chunked encoding is  used   whenever  the  client
  752%   allows for it, which is  interpreted   as  the client supporting
  753%   HTTP 1.1 or higher.
  754%
  755%   Chunked encoding is more space efficient   and allows the client
  756%   to start processing partial results. The drawback is that errors
  757%   lead to incomplete pages instead of  a nicely formatted complete
  758%   page.
  759
  760http_update_transfer(Request, CgiHeader, Transfer, Header) :-
  761    setting(http:chunked_transfer, When),
  762    http_update_transfer(When, Request, CgiHeader, Transfer, Header).
  763
  764http_update_transfer(never, _, CgiHeader, none, Header) :-
  765    !,
  766    delete(CgiHeader, transfer_encoding(_), Header).
  767http_update_transfer(_, _, CgiHeader, none, Header) :-
  768    memberchk(location(_), CgiHeader),
  769    !,
  770    delete(CgiHeader, transfer_encoding(_), Header).
  771http_update_transfer(_, Request, CgiHeader, Transfer, Header) :-
  772    select(transfer_encoding(CgiTransfer), CgiHeader, Rest),
  773    !,
  774    transfer(Request, ReqConnection),
  775    join_transfer(ReqConnection, CgiTransfer, Transfer),
  776    (   Transfer == none
  777    ->  Header = Rest
  778    ;   Header = [transfer_encoding(Transfer)|Rest]
  779    ).
  780http_update_transfer(if_possible, Request, CgiHeader, Transfer, Header) :-
  781    transfer(Request, Transfer),
  782    Transfer \== none,
  783    !,
  784    Header = [transfer_encoding(Transfer)|CgiHeader].
  785http_update_transfer(_, _, CgiHeader, none, CgiHeader).
  786
  787join_transfer(chunked, chunked, chunked) :- !.
  788join_transfer(_, _, none).
  789
  790
  791%!  transfer(+Header, -Connection)
  792%
  793%   Extract the desired connection from a header.
  794
  795transfer(Header, Transfer) :-
  796    (   memberchk(transfer_encoding(Transfer0), Header)
  797    ->  Transfer = Transfer0
  798    ;   memberchk(http_version(1-X), Header),
  799        X >= 1
  800    ->  Transfer = chunked
  801    ;   Transfer = none
  802    ).
  803
  804
  805%!  content_length_in_encoding(+Encoding, +In, -Bytes)
  806%
  807%   Determine hom many bytes are required to represent the data from
  808%   stream In using the given encoding.  Fails if the data cannot be
  809%   represented with the given encoding.
  810
  811content_length_in_encoding(Enc, Stream, Bytes) :-
  812    stream_property(Stream, position(Here)),
  813    setup_call_cleanup(
  814        open_null_stream(Out),
  815        ( set_stream(Out, encoding(Enc)),
  816          catch(copy_stream_data(Stream, Out), _, fail),
  817          flush_output(Out),
  818          byte_count(Out, Bytes)
  819        ),
  820        ( close(Out, [force(true)]),
  821          set_stream_position(Stream, Here)
  822        )).
  823
  824
  825                 /*******************************
  826                 *          POST SUPPORT        *
  827                 *******************************/
  828
  829%!  http_post_data(+Data, +Out:stream, +HdrExtra) is det.
  830%
  831%   Send data on behalf on an HTTP   POST request. This predicate is
  832%   normally called by http_post/4 from   http_client.pl to send the
  833%   POST data to the server.  Data is one of:
  834%
  835%     * html(+Tokens)
  836%     Result of html//1 from html_write.pl
  837%
  838%     * xml(+Term)
  839%     Post the result of xml_write/3 using the Mime-type
  840%     =|text/xml|=
  841%
  842%     * xml(+Type, +Term)
  843%     Post the result of xml_write/3 using the given Mime-type
  844%     and an empty option list to xml_write/3.
  845%
  846%     * xml(+Type, +Term, +Options)
  847%     Post the result of xml_write/3 using the given Mime-type
  848%     and option list for xml_write/3.
  849%
  850%     * file(+File)
  851%     Send contents of a file. Mime-type is determined by
  852%     file_mime_type/2.
  853%
  854%     * file(+Type, +File)
  855%     Send file with content of indicated mime-type.
  856%
  857%     * memory_file(+Type, +Handle)
  858%     Similar to file(+Type, +File), but using a memory file
  859%     instead of a real file.  See new_memory_file/1.
  860%
  861%     * codes(+Codes)
  862%     As codes(text/plain, Codes).
  863%
  864%     * codes(+Type, +Codes)
  865%     Send Codes using the indicated MIME-type.
  866%
  867%     * bytes(+Type, +Bytes)
  868%     Send Bytes using the indicated MIME-type.  Bytes is either a
  869%     string of character codes 0..255 or list of integers in the
  870%     range 0..255.  Out-of-bound codes result in a representation
  871%     error exception.
  872%
  873%     * atom(+Atom)
  874%     As atom(text/plain, Atom).
  875%
  876%     * atom(+Type, +Atom)
  877%     Send Atom using the indicated MIME-type.
  878%
  879%     * cgi_stream(+Stream, +Len) Read the input from Stream which,
  880%     like CGI data starts with a partial HTTP header. The fields of
  881%     this header are merged with the provided HdrExtra fields. The
  882%     first Len characters of Stream are used.
  883%
  884%     * form(+ListOfParameter)
  885%     Send data of the MIME type application/x-www-form-urlencoded as
  886%     produced by browsers issuing a POST request from an HTML form.
  887%     ListOfParameter is a list of Name=Value or Name(Value).
  888%
  889%     * form_data(+ListOfData)
  890%     Send data of the MIME type =|multipart/form-data|= as produced
  891%     by browsers issuing a POST request from an HTML form using
  892%     enctype =|multipart/form-data|=. ListOfData is the same as for
  893%     the List alternative described below. Below is an example.
  894%     Repository, etc. are atoms providing the value, while the last
  895%     argument provides a value from a file.
  896%
  897%       ==
  898%       ...,
  899%       http_post([ protocol(http),
  900%                   host(Host),
  901%                   port(Port),
  902%                   path(ActionPath)
  903%                 ],
  904%                 form_data([ repository = Repository,
  905%                             dataFormat = DataFormat,
  906%                             baseURI    = BaseURI,
  907%                             verifyData = Verify,
  908%                             data       = file(File)
  909%                           ]),
  910%                 _Reply,
  911%                 []),
  912%       ...,
  913%       ==
  914%
  915%     * List
  916%     If the argument is a plain list, it is sent using the MIME type
  917%     multipart/mixed and packed using mime_pack/3. See mime_pack/3
  918%     for details on the argument format.
  919
  920http_post_data(Data, Out, HdrExtra) :-
  921    http:post_data_hook(Data, Out, HdrExtra),
  922    !.
  923http_post_data(html(HTML), Out, HdrExtra) :-
  924    !,
  925    phrase(post_header(html(HTML), HdrExtra), Header),
  926    format(Out, '~s', [Header]),
  927    print_html(Out, HTML).
  928http_post_data(xml(XML), Out, HdrExtra) :-
  929    !,
  930    http_post_data(xml(text/xml, XML, []), Out, HdrExtra).
  931http_post_data(xml(Type, XML), Out, HdrExtra) :-
  932    !,
  933    http_post_data(xml(Type, XML, []), Out, HdrExtra).
  934http_post_data(xml(Type, XML, Options), Out, HdrExtra) :-
  935    !,
  936    setup_call_cleanup(
  937        new_memory_file(MemFile),
  938        (   setup_call_cleanup(
  939                open_memory_file(MemFile, write, MemOut),
  940                xml_write(MemOut, XML, Options),
  941                close(MemOut)),
  942            http_post_data(memory_file(Type, MemFile), Out, HdrExtra)
  943        ),
  944        free_memory_file(MemFile)).
  945http_post_data(file(File), Out, HdrExtra) :-
  946    !,
  947    (   file_mime_type(File, Type)
  948    ->  true
  949    ;   Type = text/plain
  950    ),
  951    http_post_data(file(Type, File), Out, HdrExtra).
  952http_post_data(file(Type, File), Out, HdrExtra) :-
  953    !,
  954    phrase(post_header(file(Type, File), HdrExtra), Header),
  955    format(Out, '~s', [Header]),
  956    setup_call_cleanup(
  957        open(File, read, In, [type(binary)]),
  958        copy_stream_data(In, Out),
  959        close(In)).
  960http_post_data(memory_file(Type, Handle), Out, HdrExtra) :-
  961    !,
  962    phrase(post_header(memory_file(Type, Handle), HdrExtra), Header),
  963    format(Out, '~s', [Header]),
  964    setup_call_cleanup(
  965        open_memory_file(Handle, read, In, [encoding(octet)]),
  966        copy_stream_data(In, Out),
  967        close(In)).
  968http_post_data(codes(Codes), Out, HdrExtra) :-
  969    !,
  970    http_post_data(codes(text/plain, Codes), Out, HdrExtra).
  971http_post_data(codes(Type, Codes), Out, HdrExtra) :-
  972    !,
  973    phrase(post_header(codes(Type, Codes), HdrExtra), Header),
  974    format(Out, '~s', [Header]),
  975    setup_call_cleanup(
  976        set_stream(Out, encoding(utf8)),
  977        format(Out, '~s', [Codes]),
  978        set_stream(Out, encoding(octet))).
  979http_post_data(bytes(Type, Bytes), Out, HdrExtra) :-
  980    !,
  981    phrase(post_header(bytes(Type, Bytes), HdrExtra), Header),
  982    format(Out, '~s~s', [Header, Bytes]).
  983http_post_data(atom(Atom), Out, HdrExtra) :-
  984    !,
  985    http_post_data(atom(text/plain, Atom), Out, HdrExtra).
  986http_post_data(atom(Type, Atom), Out, HdrExtra) :-
  987    !,
  988    phrase(post_header(atom(Type, Atom), HdrExtra), Header),
  989    format(Out, '~s', [Header]),
  990    setup_call_cleanup(
  991        set_stream(Out, encoding(utf8)),
  992        write(Out, Atom),
  993        set_stream(Out, encoding(octet))).
  994http_post_data(cgi_stream(In, _Len), Out, HdrExtra) :-
  995    !,
  996    debug(obsolete, 'Obsolete 2nd argument in cgi_stream(In,Len)', []),
  997    http_post_data(cgi_stream(In), Out, HdrExtra).
  998http_post_data(cgi_stream(In), Out, HdrExtra) :-
  999    !,
 1000    http_read_header(In, Header0),
 1001    http_update_encoding(Header0, Encoding, Header),
 1002    content_length_in_encoding(Encoding, In, Size),
 1003    http_join_headers(HdrExtra, Header, Hdr2),
 1004    phrase(post_header(cgi_data(Size), Hdr2), HeaderText),
 1005    format(Out, '~s', [HeaderText]),
 1006    setup_call_cleanup(
 1007        set_stream(Out, encoding(Encoding)),
 1008        copy_stream_data(In, Out),
 1009        set_stream(Out, encoding(octet))).
 1010http_post_data(form(Fields), Out, HdrExtra) :-
 1011    !,
 1012    parse_url_search(Codes, Fields),
 1013    length(Codes, Size),
 1014    http_join_headers(HdrExtra,
 1015                      [ content_type('application/x-www-form-urlencoded')
 1016                      ], Header),
 1017    phrase(post_header(cgi_data(Size), Header), HeaderChars),
 1018    format(Out, '~s', [HeaderChars]),
 1019    format(Out, '~s', [Codes]).
 1020http_post_data(form_data(Data), Out, HdrExtra) :-
 1021    !,
 1022    setup_call_cleanup(
 1023        new_memory_file(MemFile),
 1024        ( setup_call_cleanup(
 1025              open_memory_file(MemFile, write, MimeOut),
 1026              mime_pack(Data, MimeOut, Boundary),
 1027              close(MimeOut)),
 1028          size_memory_file(MemFile, Size, octet),
 1029          format(string(ContentType),
 1030                 'multipart/form-data; boundary=~w', [Boundary]),
 1031          http_join_headers(HdrExtra,
 1032                            [ mime_version('1.0'),
 1033                              content_type(ContentType)
 1034                            ], Header),
 1035          phrase(post_header(cgi_data(Size), Header), HeaderChars),
 1036          format(Out, '~s', [HeaderChars]),
 1037          setup_call_cleanup(
 1038              open_memory_file(MemFile, read, In, [encoding(octet)]),
 1039              copy_stream_data(In, Out),
 1040              close(In))
 1041        ),
 1042        free_memory_file(MemFile)).
 1043http_post_data(List, Out, HdrExtra) :-          % multipart-mixed
 1044    is_list(List),
 1045    !,
 1046    setup_call_cleanup(
 1047        new_memory_file(MemFile),
 1048        ( setup_call_cleanup(
 1049              open_memory_file(MemFile, write, MimeOut),
 1050              mime_pack(List, MimeOut, Boundary),
 1051              close(MimeOut)),
 1052          size_memory_file(MemFile, Size, octet),
 1053          format(string(ContentType),
 1054                 'multipart/mixed; boundary=~w', [Boundary]),
 1055          http_join_headers(HdrExtra,
 1056                            [ mime_version('1.0'),
 1057                              content_type(ContentType)
 1058                            ], Header),
 1059          phrase(post_header(cgi_data(Size), Header), HeaderChars),
 1060          format(Out, '~s', [HeaderChars]),
 1061          setup_call_cleanup(
 1062              open_memory_file(MemFile, read, In, [encoding(octet)]),
 1063              copy_stream_data(In, Out),
 1064              close(In))
 1065        ),
 1066        free_memory_file(MemFile)).
 1067
 1068%!  post_header(+Data, +HeaderExtra)//
 1069%
 1070%   Generate the POST header, emitting HeaderExtra, followed by the
 1071%   HTTP Content-length and Content-type fields.
 1072
 1073post_header(html(Tokens), HdrExtra) -->
 1074    header_fields(HdrExtra, Len),
 1075    content_length(html(Tokens), Len),
 1076    content_type(text/html),
 1077    "\r\n".
 1078post_header(file(Type, File), HdrExtra) -->
 1079    header_fields(HdrExtra, Len),
 1080    content_length(file(File), Len),
 1081    content_type(Type),
 1082    "\r\n".
 1083post_header(memory_file(Type, File), HdrExtra) -->
 1084    header_fields(HdrExtra, Len),
 1085    content_length(memory_file(File), Len),
 1086    content_type(Type),
 1087    "\r\n".
 1088post_header(cgi_data(Size), HdrExtra) -->
 1089    header_fields(HdrExtra, Len),
 1090    content_length(Size, Len),
 1091    "\r\n".
 1092post_header(codes(Type, Codes), HdrExtra) -->
 1093    header_fields(HdrExtra, Len),
 1094    content_length(codes(Codes, utf8), Len),
 1095    content_type(Type, utf8),
 1096    "\r\n".
 1097post_header(bytes(Type, Bytes), HdrExtra) -->
 1098    header_fields(HdrExtra, Len),
 1099    content_length(bytes(Bytes), Len),
 1100    content_type(Type),
 1101    "\r\n".
 1102post_header(atom(Type, Atom), HdrExtra) -->
 1103    header_fields(HdrExtra, Len),
 1104    content_length(atom(Atom, utf8), Len),
 1105    content_type(Type, utf8),
 1106    "\r\n".
 1107
 1108
 1109                 /*******************************
 1110                 *       OUTPUT HEADER DCG      *
 1111                 *******************************/
 1112
 1113%!  http_reply_header(+Out:stream, +What, +HdrExtra) is det.
 1114%
 1115%   Create a reply header  using  reply_header//3   and  send  it to
 1116%   Stream.
 1117
 1118http_reply_header(Out, What, HdrExtra) :-
 1119    phrase(reply_header(What, HdrExtra, _Code), String),
 1120    !,
 1121    format(Out, '~s', [String]).
 1122
 1123%!  reply_header(+Data, +HdrExtra, -Code)// is det.
 1124%
 1125%   Grammar that realises the HTTP handler for sending Data. Data is
 1126%   a  real  data  object  as  described   with  http_reply/2  or  a
 1127%   not-200-ok HTTP status reply. The   following status replies are
 1128%   defined.
 1129%
 1130%     * moved(+URL, +HTMLTokens)
 1131%     * created(+URL, +HTMLTokens)
 1132%     * moved_temporary(+URL, +HTMLTokens)
 1133%     * see_other(+URL, +HTMLTokens)
 1134%     * status(+Status)
 1135%     * status(+Status, +HTMLTokens)
 1136%     * authorise(+Method, +Realm, +Tokens)
 1137%     * authorise(+Method, +Tokens)
 1138%
 1139%   @see http_status_reply/4 formulates the not-200-ok HTTP replies.
 1140
 1141reply_header(string(String), HdrExtra, Code) -->
 1142    reply_header(string(text/plain, String), HdrExtra, Code).
 1143reply_header(string(Type, String), HdrExtra, Code) -->
 1144    vstatus(ok, Code, HdrExtra),
 1145    date(now),
 1146    header_fields(HdrExtra, CLen),
 1147    content_length(codes(String, utf8), CLen),
 1148    content_type(Type, utf8),
 1149    "\r\n".
 1150reply_header(bytes(Type, Bytes), HdrExtra, Code) -->
 1151    vstatus(ok, Code, HdrExtra),
 1152    date(now),
 1153    header_fields(HdrExtra, CLen),
 1154    content_length(bytes(Bytes), CLen),
 1155    content_type(Type),
 1156    "\r\n".
 1157reply_header(html(Tokens), HdrExtra, Code) -->
 1158    vstatus(ok, Code, HdrExtra),
 1159    date(now),
 1160    header_fields(HdrExtra, CLen),
 1161    content_length(html(Tokens), CLen),
 1162    content_type(text/html),
 1163    "\r\n".
 1164reply_header(file(Type, File), HdrExtra, Code) -->
 1165    vstatus(ok, Code, HdrExtra),
 1166    date(now),
 1167    modified(file(File)),
 1168    header_fields(HdrExtra, CLen),
 1169    content_length(file(File), CLen),
 1170    content_type(Type),
 1171    "\r\n".
 1172reply_header(gzip_file(Type, File), HdrExtra, Code) -->
 1173    vstatus(ok, Code, HdrExtra),
 1174    date(now),
 1175    modified(file(File)),
 1176    header_fields(HdrExtra, CLen),
 1177    content_length(file(File), CLen),
 1178    content_type(Type),
 1179    content_encoding(gzip),
 1180    "\r\n".
 1181reply_header(file(Type, File, Range), HdrExtra, Code) -->
 1182    vstatus(partial_content, Code, HdrExtra),
 1183    date(now),
 1184    modified(file(File)),
 1185    header_fields(HdrExtra, CLen),
 1186    content_length(file(File, Range), CLen),
 1187    content_type(Type),
 1188    "\r\n".
 1189reply_header(tmp_file(Type, File), HdrExtra, Code) -->
 1190    vstatus(ok, Code, HdrExtra),
 1191    date(now),
 1192    header_fields(HdrExtra, CLen),
 1193    content_length(file(File), CLen),
 1194    content_type(Type),
 1195    "\r\n".
 1196reply_header(cgi_data(Size), HdrExtra, Code) -->
 1197    vstatus(ok, Code, HdrExtra),
 1198    date(now),
 1199    header_fields(HdrExtra, CLen),
 1200    content_length(Size, CLen),
 1201    "\r\n".
 1202reply_header(chunked_data, HdrExtra, Code) -->
 1203    vstatus(ok, Code, HdrExtra),
 1204    date(now),
 1205    header_fields(HdrExtra, _),
 1206    (   {memberchk(transfer_encoding(_), HdrExtra)}
 1207    ->  ""
 1208    ;   transfer_encoding(chunked)
 1209    ),
 1210    "\r\n".
 1211reply_header(moved(To, Tokens), HdrExtra, Code) -->
 1212    vstatus(moved, Code, HdrExtra),
 1213    date(now),
 1214    header_field('Location', To),
 1215    header_fields(HdrExtra, CLen),
 1216    content_length(html(Tokens), CLen),
 1217    content_type(text/html, utf8),
 1218    "\r\n".
 1219reply_header(created(Location, Tokens), HdrExtra, Code) -->
 1220    vstatus(created, Code, HdrExtra),
 1221    date(now),
 1222    header_field('Location', Location),
 1223    header_fields(HdrExtra, CLen),
 1224    content_length(html(Tokens), CLen),
 1225    content_type(text/html, utf8),
 1226    "\r\n".
 1227reply_header(moved_temporary(To, Tokens), HdrExtra, Code) -->
 1228    vstatus(moved_temporary, Code, HdrExtra),
 1229    date(now),
 1230    header_field('Location', To),
 1231    header_fields(HdrExtra, CLen),
 1232    content_length(html(Tokens), CLen),
 1233    content_type(text/html, utf8),
 1234    "\r\n".
 1235reply_header(see_other(To,Tokens),HdrExtra, Code) -->
 1236    vstatus(see_other, Code, HdrExtra),
 1237    date(now),
 1238    header_field('Location',To),
 1239    header_fields(HdrExtra, CLen),
 1240    content_length(html(Tokens), CLen),
 1241    content_type(text/html, utf8),
 1242    "\r\n".
 1243reply_header(status(Status), HdrExtra, Code) --> % Empty messages: 1xx, 204 and 304
 1244    vstatus(Status, Code),
 1245    header_fields(HdrExtra, Clen),
 1246    { Clen = 0 },
 1247    "\r\n".
 1248reply_header(status(Status, Tokens), HdrExtra, Code) -->
 1249    vstatus(Status, Code),
 1250    date(now),
 1251    header_fields(HdrExtra, CLen),
 1252    content_length(html(Tokens), CLen),
 1253    content_type(text/html, utf8),
 1254    "\r\n".
 1255reply_header(authorise(Method, Tokens), HdrExtra, Code) -->
 1256    vstatus(authorise, Code),
 1257    date(now),
 1258    authenticate(Method),
 1259    header_fields(HdrExtra, CLen),
 1260    content_length(html(Tokens), CLen),
 1261    content_type(text/html, utf8),
 1262    "\r\n".
 1263
 1264%!  vstatus(+Status, -Code)// is det.
 1265%!  vstatus(+Status, -Code, +HdrExtra)// is det.
 1266%
 1267%   Emit the HTTP header for Status
 1268
 1269vstatus(_Status, Code, HdrExtra) -->
 1270    {memberchk(status(Code), HdrExtra)},
 1271    !,
 1272    vstatus(_NewStatus, Code).
 1273vstatus(Status, Code, _) -->
 1274    vstatus(Status, Code).
 1275
 1276vstatus(Status, Code) -->
 1277    "HTTP/1.1 ",
 1278    status_number(Status, Code),
 1279    " ",
 1280    status_comment(Status),
 1281    "\r\n".
 1282
 1283%!  status_number(?Status, ?Code)// is semidet.
 1284%
 1285%   Parse/generate the HTTP status  numbers  and   map  them  to the
 1286%   proper name.
 1287%
 1288%   @see See the source code for supported status names and codes.
 1289
 1290status_number(Status, Code) -->
 1291    { var(Status) },
 1292    !,
 1293    integer(Code),
 1294    { status_number(Status, Code) },
 1295    !.
 1296status_number(Status, Code) -->
 1297    { status_number(Status, Code) },
 1298    integer(Code).
 1299
 1300%!  status_number(+Status:atom, -Code:nonneg) is det.
 1301%!  status_number(-Status:atom, +Code:nonneg) is det.
 1302%
 1303%   Relates a symbolic  HTTP   status  names to their integer Code.
 1304%   Each code also needs a rule for status_comment//1.
 1305%
 1306%   @throws type_error    If Code is instantiated with something other than
 1307%                         an integer.
 1308%   @throws domain_error  If Code is instantiated with an integer
 1309%                         outside of the range [100-599] of defined
 1310%                         HTTP status codes.
 1311
 1312% Unrecognized status codes that are within a defined code class.
 1313% RFC 7231 states:
 1314%   "[...] a client MUST understand the class of any status code,
 1315%    as indicated by the first digit, and treat an unrecognized status code
 1316%    as being equivalent to the `x00` status code of that class [...]
 1317%   "
 1318% @see http://tools.ietf.org/html/rfc7231#section-6
 1319
 1320status_number(Status, Code):-
 1321    nonvar(Status),
 1322    !,
 1323    status_number_fact(Status, Code).
 1324status_number(Status, Code):-
 1325    nonvar(Code),
 1326    !,
 1327    (   between(100, 599, Code)
 1328    ->  (   status_number_fact(Status, Code)
 1329        ->  true
 1330        ;   ClassCode is Code // 100 * 100,
 1331            status_number_fact(Status, ClassCode)
 1332        )
 1333    ;   domain_error(http_code, Code)
 1334    ).
 1335
 1336status_number_fact(continue,                   100).
 1337status_number_fact(switching_protocols,        101).
 1338status_number_fact(ok,                         200).
 1339status_number_fact(created,                    201).
 1340status_number_fact(accepted,                   202).
 1341status_number_fact(non_authoritative_info,     203).
 1342status_number_fact(no_content,                 204).
 1343status_number_fact(reset_content,              205).
 1344status_number_fact(partial_content,            206).
 1345status_number_fact(multiple_choices,           300).
 1346status_number_fact(moved,                      301).
 1347status_number_fact(moved_temporary,            302).
 1348status_number_fact(see_other,                  303).
 1349status_number_fact(not_modified,               304).
 1350status_number_fact(use_proxy,                  305).
 1351status_number_fact(unused,                     306).
 1352status_number_fact(temporary_redirect,         307).
 1353status_number_fact(bad_request,                400).
 1354status_number_fact(authorise,                  401).
 1355status_number_fact(payment_required,           402).
 1356status_number_fact(forbidden,                  403).
 1357status_number_fact(not_found,                  404).
 1358status_number_fact(method_not_allowed,         405).
 1359status_number_fact(not_acceptable,             406).
 1360status_number_fact(request_timeout,            408).
 1361status_number_fact(conflict,                   409).
 1362status_number_fact(gone,                       410).
 1363status_number_fact(length_required,            411).
 1364status_number_fact(payload_too_large,          413).
 1365status_number_fact(uri_too_long,               414).
 1366status_number_fact(unsupported_media_type,     415).
 1367status_number_fact(expectation_failed,         417).
 1368status_number_fact(upgrade_required,           426).
 1369status_number_fact(server_error,               500).
 1370status_number_fact(not_implemented,            501).
 1371status_number_fact(bad_gateway,                502).
 1372status_number_fact(service_unavailable,        503).
 1373status_number_fact(gateway_timeout,            504).
 1374status_number_fact(http_version_not_supported, 505).
 1375
 1376
 1377%!  status_comment(+Code:atom)// is det.
 1378%
 1379%   Emit standard HTTP human-readable comment on the reply-status.
 1380
 1381status_comment(continue) -->
 1382    "Continue".
 1383status_comment(switching_protocols) -->
 1384    "Switching Protocols".
 1385status_comment(ok) -->
 1386    "OK".
 1387status_comment(created) -->
 1388    "Created".
 1389status_comment(accepted) -->
 1390    "Accepted".
 1391status_comment(non_authoritative_info) -->
 1392    "Non-Authoritative Information".
 1393status_comment(no_content) -->
 1394    "No Content".
 1395status_comment(reset_content) -->
 1396    "Reset Content".
 1397status_comment(created) -->
 1398    "Created".
 1399status_comment(partial_content) -->
 1400    "Partial content".
 1401status_comment(multiple_choices) -->
 1402    "Multiple Choices".
 1403status_comment(moved) -->
 1404    "Moved Permanently".
 1405status_comment(moved_temporary) -->
 1406    "Moved Temporary".
 1407status_comment(see_other) -->
 1408    "See Other".
 1409status_comment(not_modified) -->
 1410    "Not Modified".
 1411status_comment(use_proxy) -->
 1412    "Use Proxy".
 1413status_comment(unused) -->
 1414    "Unused".
 1415status_comment(temporary_redirect) -->
 1416    "Temporary Redirect".
 1417status_comment(bad_request) -->
 1418    "Bad Request".
 1419status_comment(authorise) -->
 1420    "Authorization Required".
 1421status_comment(payment_required) -->
 1422    "Payment Required".
 1423status_comment(forbidden) -->
 1424    "Forbidden".
 1425status_comment(not_found) -->
 1426    "Not Found".
 1427status_comment(method_not_allowed) -->
 1428    "Method Not Allowed".
 1429status_comment(not_acceptable) -->
 1430    "Not Acceptable".
 1431status_comment(request_timeout) -->
 1432    "Request Timeout".
 1433status_comment(conflict) -->
 1434    "Conflict".
 1435status_comment(gone) -->
 1436    "Gone".
 1437status_comment(length_required) -->
 1438    "Length Required".
 1439status_comment(payload_too_large) -->
 1440    "Payload Too Large".
 1441status_comment(uri_too_long) -->
 1442    "URI Too Long".
 1443status_comment(unsupported_media_type) -->
 1444    "Unsupported Media Type".
 1445status_comment(expectation_failed) -->
 1446    "Expectation Failed".
 1447status_comment(upgrade_required) -->
 1448    "Upgrade Required".
 1449status_comment(server_error) -->
 1450    "Internal Server Error".
 1451status_comment(not_implemented) -->
 1452    "Not Implemented".
 1453status_comment(bad_gateway) -->
 1454    "Bad Gateway".
 1455status_comment(service_unavailable) -->
 1456    "Service Unavailable".
 1457status_comment(gateway_timeout) -->
 1458    "Gateway Timeout".
 1459status_comment(http_version_not_supported) -->
 1460    "HTTP Version Not Supported".
 1461
 1462authenticate(negotiate(Data)) -->
 1463    "WWW-Authenticate: Negotiate ",
 1464    { base64(Data, DataBase64),
 1465      atom_codes(DataBase64, Codes)
 1466    },
 1467    string(Codes), "\r\n".
 1468authenticate(negotiate) -->
 1469    "WWW-Authenticate: Negotiate\r\n".
 1470
 1471authenticate(basic) -->
 1472    !,
 1473    "WWW-Authenticate: Basic\r\n".
 1474authenticate(basic(Realm)) -->
 1475    "WWW-Authenticate: Basic Realm=\"", atom(Realm), "\"\r\n".
 1476
 1477authenticate(digest) -->
 1478    !,
 1479    "WWW-Authenticate: Digest\r\n".
 1480authenticate(digest(Details)) -->
 1481    "WWW-Authenticate: Digest ", atom(Details), "\r\n".
 1482
 1483
 1484date(Time) -->
 1485    "Date: ",
 1486    (   { Time == now }
 1487    ->  now
 1488    ;   rfc_date(Time)
 1489    ),
 1490    "\r\n".
 1491
 1492modified(file(File)) -->
 1493    !,
 1494    { time_file(File, Time)
 1495    },
 1496    modified(Time).
 1497modified(Time) -->
 1498    "Last-modified: ",
 1499    (   { Time == now }
 1500    ->  now
 1501    ;   rfc_date(Time)
 1502    ),
 1503    "\r\n".
 1504
 1505
 1506%!  content_length(+Object, ?Len)// is det.
 1507%
 1508%   Emit the content-length field and (optionally) the content-range
 1509%   field.
 1510%
 1511%   @param Len Number of bytes specified
 1512
 1513content_length(file(File, bytes(From, To)), Len) -->
 1514    !,
 1515    { size_file(File, Size),
 1516      (   To == end
 1517      ->  Len is Size - From,
 1518          RangeEnd is Size - 1
 1519      ;   Len is To+1 - From,       % To is index of last byte
 1520          RangeEnd = To
 1521      )
 1522    },
 1523    content_range(bytes, From, RangeEnd, Size),
 1524    content_length(Len, Len).
 1525content_length(Reply, Len) -->
 1526    { length_of(Reply, Len)
 1527    },
 1528    "Content-Length: ", integer(Len),
 1529    "\r\n".
 1530
 1531
 1532length_of(_, Len) :-
 1533    nonvar(Len),
 1534    !.
 1535length_of(codes(String, Encoding), Len) :-
 1536    !,
 1537    setup_call_cleanup(
 1538        open_null_stream(Out),
 1539        ( set_stream(Out, encoding(Encoding)),
 1540          format(Out, '~s', [String]),
 1541          byte_count(Out, Len)
 1542        ),
 1543        close(Out)).
 1544length_of(atom(Atom, Encoding), Len) :-
 1545    !,
 1546    setup_call_cleanup(
 1547        open_null_stream(Out),
 1548        ( set_stream(Out, encoding(Encoding)),
 1549          format(Out, '~a', [Atom]),
 1550          byte_count(Out, Len)
 1551        ),
 1552        close(Out)).
 1553length_of(file(File), Len) :-
 1554    !,
 1555    size_file(File, Len).
 1556length_of(memory_file(Handle), Len) :-
 1557    !,
 1558    size_memory_file(Handle, Len, octet).
 1559length_of(html(Tokens), Len) :-
 1560    !,
 1561    html_print_length(Tokens, Len).
 1562length_of(bytes(Bytes), Len) :-
 1563    !,
 1564    (   string(Bytes)
 1565    ->  string_length(Bytes, Len)
 1566    ;   length(Bytes, Len)          % assuming a list of 0..255
 1567    ).
 1568length_of(Len, Len).
 1569
 1570
 1571%!  content_range(+Unit:atom, +From:int, +RangeEnd:int, +Size:int)// is det
 1572%
 1573%   Emit the =|Content-Range|= header  for   partial  content  (206)
 1574%   replies.
 1575
 1576content_range(Unit, From, RangeEnd, Size) -->
 1577    "Content-Range: ", atom(Unit), " ",
 1578    integer(From), "-", integer(RangeEnd), "/", integer(Size),
 1579    "\r\n".
 1580
 1581content_encoding(Encoding) -->
 1582    "Content-Encoding: ", atom(Encoding), "\r\n".
 1583
 1584transfer_encoding(Encoding) -->
 1585    "Transfer-Encoding: ", atom(Encoding), "\r\n".
 1586
 1587content_type(Type) -->
 1588    content_type(Type, _).
 1589
 1590content_type(Type, Charset) -->
 1591    ctype(Type),
 1592    charset(Charset),
 1593    "\r\n".
 1594
 1595ctype(Main/Sub) -->
 1596    !,
 1597    "Content-Type: ",
 1598    atom(Main),
 1599    "/",
 1600    atom(Sub).
 1601ctype(Type) -->
 1602    !,
 1603    "Content-Type: ",
 1604    atom(Type).
 1605
 1606charset(Var) -->
 1607    { var(Var) },
 1608    !.
 1609charset(utf8) -->
 1610    !,
 1611    "; charset=UTF-8".
 1612charset(CharSet) -->
 1613    "; charset=",
 1614    atom(CharSet).
 1615
 1616%!  header_field(-Name, -Value)// is det.
 1617%!  header_field(+Name, +Value) is det.
 1618%
 1619%   Process an HTTP request property. Request properties appear as a
 1620%   single line in an HTTP header.
 1621
 1622header_field(Name, Value) -->
 1623    { var(Name) },                 % parsing
 1624    !,
 1625    field_name(Name),
 1626    ":",
 1627    whites,
 1628    read_field_value(ValueChars),
 1629    blanks_to_nl,
 1630    !,
 1631    {   field_to_prolog(Name, ValueChars, Value)
 1632    ->  true
 1633    ;   atom_codes(Value, ValueChars),
 1634        domain_error(Name, Value)
 1635    }.
 1636header_field(Name, Value) -->
 1637    field_name(Name),
 1638    ": ",
 1639    field_value(Value),
 1640    "\r\n".
 1641
 1642%!  read_field_value(-Codes)//
 1643%
 1644%   Read a field eagerly upto the next whitespace
 1645
 1646read_field_value([H|T]) -->
 1647    [H],
 1648    { \+ code_type(H, space) },
 1649    !,
 1650    read_field_value(T).
 1651read_field_value([]) -->
 1652    "".
 1653read_field_value([H|T]) -->
 1654    [H],
 1655    read_field_value(T).
 1656
 1657
 1658%!  http_parse_header_value(+Field, +Value, -Prolog) is semidet.
 1659%
 1660%   Translate Value in a meaningful Prolog   term. Field denotes the
 1661%   HTTP request field for which we   do  the translation. Supported
 1662%   fields are:
 1663%
 1664%     * content_length
 1665%     Converted into an integer
 1666%     * cookie
 1667%     Converted into a list with Name=Value by cookies//1.
 1668%     * set_cookie
 1669%     Converted into a term set_cookie(Name, Value, Options).
 1670%     Options is a list consisting of Name=Value or a single
 1671%     atom (e.g., =secure=)
 1672%     * host
 1673%     Converted to HostName:Port if applicable.
 1674%     * range
 1675%     Converted into bytes(From, To), where From is an integer
 1676%     and To is either an integer or the atom =end=.
 1677%     * accept
 1678%     Parsed to a list of media descriptions.  Each media is a term
 1679%     media(Type, TypeParams, Quality, AcceptExts). The list is
 1680%     sorted according to preference.
 1681%     * content_disposition
 1682%     Parsed into disposition(Name, Attributes), where Attributes is
 1683%     a list of Name=Value pairs.
 1684%     * content_type
 1685%     Parsed into media(Type/SubType, Attributes), where Attributes
 1686%     is a list of Name=Value pairs.
 1687
 1688http_parse_header_value(Field, Value, Prolog) :-
 1689    known_field(Field, _),
 1690    to_codes(Value, Codes),
 1691    parse_header_value(Field, Codes, Prolog).
 1692
 1693%!  known_field(?FieldName, ?AutoConvert)
 1694%
 1695%   True if the value of FieldName is   by default translated into a
 1696%   Prolog data structure.
 1697
 1698known_field(content_length,      true).
 1699known_field(status,              true).
 1700known_field(cookie,              true).
 1701known_field(set_cookie,          true).
 1702known_field(host,                true).
 1703known_field(range,               maybe).
 1704known_field(accept,              maybe).
 1705known_field(content_disposition, maybe).
 1706known_field(content_type,        false).
 1707
 1708to_codes(In, Codes) :-
 1709    (   is_list(In)
 1710    ->  Codes = In
 1711    ;   atom_codes(In, Codes)
 1712    ).
 1713
 1714%!  field_to_prolog(+Field, +ValueCodes, -Prolog) is semidet.
 1715%
 1716%   Translate the value string into  a   sensible  Prolog  term. For
 1717%   known_fields(_,true), this must succeed. For   =maybe=,  we just
 1718%   return the atom if the translation fails.
 1719
 1720field_to_prolog(Field, Codes, Prolog) :-
 1721    known_field(Field, true),
 1722    !,
 1723    (   parse_header_value(Field, Codes, Prolog0)
 1724    ->  Prolog = Prolog0
 1725    ).
 1726field_to_prolog(Field, Codes, Prolog) :-
 1727    known_field(Field, maybe),
 1728    parse_header_value(Field, Codes, Prolog0),
 1729    !,
 1730    Prolog = Prolog0.
 1731field_to_prolog(_, Codes, Atom) :-
 1732    atom_codes(Atom, Codes).
 1733
 1734%!  parse_header_value(+Field, +ValueCodes, -Value) is semidet.
 1735%
 1736%   Parse the value text of an HTTP   field into a meaningful Prolog
 1737%   representation.
 1738
 1739parse_header_value(content_length, ValueChars, ContentLength) :-
 1740    number_codes(ContentLength, ValueChars).
 1741parse_header_value(status, ValueChars, Code) :-
 1742    (   phrase(" ", L, _),
 1743        append(Pre, L, ValueChars)
 1744    ->  number_codes(Code, Pre)
 1745    ;   number_codes(Code, ValueChars)
 1746    ).
 1747parse_header_value(cookie, ValueChars, Cookies) :-
 1748    debug(cookie, 'Cookie: ~s', [ValueChars]),
 1749    phrase(cookies(Cookies), ValueChars).
 1750parse_header_value(set_cookie, ValueChars, SetCookie) :-
 1751    debug(cookie, 'SetCookie: ~s', [ValueChars]),
 1752    phrase(set_cookie(SetCookie), ValueChars).
 1753parse_header_value(host, ValueChars, Host) :-
 1754    (   append(HostChars, [0':|PortChars], ValueChars),
 1755        catch(number_codes(Port, PortChars), _, fail)
 1756    ->  atom_codes(HostName, HostChars),
 1757        Host = HostName:Port
 1758    ;   atom_codes(Host, ValueChars)
 1759    ).
 1760parse_header_value(range, ValueChars, Range) :-
 1761    phrase(range(Range), ValueChars).
 1762parse_header_value(accept, ValueChars, Media) :-
 1763    parse_accept(ValueChars, Media).
 1764parse_header_value(content_disposition, ValueChars, Disposition) :-
 1765    phrase(content_disposition(Disposition), ValueChars).
 1766parse_header_value(content_type, ValueChars, Type) :-
 1767    phrase(parse_content_type(Type), ValueChars).
 1768
 1769field_value(set_cookie(Name, Value, Options)) -->
 1770    !,
 1771    atom(Name), "=", atom(Value),
 1772    value_options(Options, cookie).
 1773field_value(disposition(Disposition, Options)) -->
 1774    !,
 1775    atom(Disposition), value_options(Options, disposition).
 1776field_value(Atomic) -->
 1777    atom(Atomic).
 1778
 1779%!  value_options(+List, +Field)//
 1780%
 1781%   Emit field parameters such as =|; charset=UTF-8|=.  There
 1782%   are three versions: a plain _key_ (`secure`), _token_ values
 1783%   and _quoted string_ values.  Seems we cannot deduce that from
 1784%   the actual value.
 1785
 1786value_options([], _) --> [].
 1787value_options([H|T], Field) -->
 1788    "; ", value_option(H, Field),
 1789    value_options(T, Field).
 1790
 1791value_option(secure=true, cookie) -->
 1792    !,
 1793    "secure".
 1794value_option(Name=Value, Type) -->
 1795    { string_option(Name, Type) },
 1796    !,
 1797    atom(Name), "=",
 1798    qstring(Value).
 1799value_option(Name=Value, Type) -->
 1800    { token_option(Name, Type) },
 1801    !,
 1802    atom(Name), "=", atom(Value).
 1803value_option(Name=Value, _Type) -->
 1804    atom(Name), "=",
 1805    option_value(Value).
 1806
 1807string_option(filename, disposition).
 1808
 1809token_option(path, cookie).
 1810
 1811option_value(Value) -->
 1812    { number(Value) },
 1813    !,
 1814    number(Value).
 1815option_value(Value) -->
 1816    { (   atom(Value)
 1817      ->  true
 1818      ;   string(Value)
 1819      ),
 1820      forall(string_code(_, Value, C),
 1821             token_char(C))
 1822    },
 1823    !,
 1824    atom(Value).
 1825option_value(Atomic) -->
 1826    qstring(Atomic).
 1827
 1828qstring(Atomic) -->
 1829    { string_codes(Atomic, Codes) },
 1830    "\"",
 1831    qstring_codes(Codes),
 1832    "\"".
 1833
 1834qstring_codes([]) --> [].
 1835qstring_codes([H|T]) --> qstring_code(H), qstring_codes(T).
 1836
 1837qstring_code(C) --> {qstring_esc(C)}, !, "\\", [C].
 1838qstring_code(C) --> [C].
 1839
 1840qstring_esc(0'").
 1841qstring_esc(C) :- ctl(C).
 1842
 1843
 1844                 /*******************************
 1845                 *        ACCEPT HEADERS        *
 1846                 *******************************/
 1847
 1848:- dynamic accept_cache/2. 1849:- volatile accept_cache/2. 1850
 1851parse_accept(Codes, Media) :-
 1852    atom_codes(Atom, Codes),
 1853    (   accept_cache(Atom, Media0)
 1854    ->  Media = Media0
 1855    ;   phrase(accept(Media0), Codes),
 1856        keysort(Media0, Media1),
 1857        pairs_values(Media1, Media2),
 1858        assertz(accept_cache(Atom, Media2)),
 1859        Media = Media2
 1860    ).
 1861
 1862%!  accept(-Media)// is semidet.
 1863%
 1864%   Parse an HTTP Accept: header
 1865
 1866accept([H|T]) -->
 1867    blanks,
 1868    media_range(H),
 1869    blanks,
 1870    (   ","
 1871    ->  accept(T)
 1872    ;   {T=[]}
 1873    ).
 1874
 1875media_range(s(SortQuality,Spec)-media(Type, TypeParams, Quality, AcceptExts)) -->
 1876    media_type(Type),
 1877    blanks,
 1878    (   ";"
 1879    ->  blanks,
 1880        parameters_and_quality(TypeParams, Quality, AcceptExts)
 1881    ;   { TypeParams = [],
 1882          Quality = 1.0,
 1883          AcceptExts = []
 1884        }
 1885    ),
 1886    { SortQuality is float(-Quality),
 1887      rank_specialised(Type, TypeParams, Spec)
 1888    }.
 1889
 1890
 1891%!  content_disposition(-Disposition)//
 1892%
 1893%   Parse Content-Disposition value
 1894
 1895content_disposition(disposition(Disposition, Options)) -->
 1896    token(Disposition), blanks,
 1897    value_parameters(Options).
 1898
 1899%!  parse_content_type(-Type)//
 1900%
 1901%   Parse  Content-Type  value  into    a  term  media(Type/SubType,
 1902%   Parameters).
 1903
 1904parse_content_type(media(Type, Parameters)) -->
 1905    media_type(Type), blanks,
 1906    value_parameters(Parameters).
 1907
 1908
 1909%!  rank_specialised(+Type, +TypeParam, -Key) is det.
 1910%
 1911%   Although the specification linked  above   is  unclear, it seems
 1912%   that  more  specialised  types  must   be  preferred  over  less
 1913%   specialized ones.
 1914%
 1915%   @tbd    Is there an official specification of this?
 1916
 1917rank_specialised(Type/SubType, TypeParams, v(VT, VS, SortVP)) :-
 1918    var_or_given(Type, VT),
 1919    var_or_given(SubType, VS),
 1920    length(TypeParams, VP),
 1921    SortVP is -VP.
 1922
 1923var_or_given(V, Val) :-
 1924    (   var(V)
 1925    ->  Val = 0
 1926    ;   Val = -1
 1927    ).
 1928
 1929media_type(Type/SubType) -->
 1930    type(Type), "/", type(SubType).
 1931
 1932type(_) -->
 1933    "*",
 1934    !.
 1935type(Type) -->
 1936    token(Type).
 1937
 1938parameters_and_quality(Params, Quality, AcceptExts) -->
 1939    token(Name),
 1940    blanks, "=", blanks,
 1941    (   { Name == q }
 1942    ->  float(Quality), blanks,
 1943        value_parameters(AcceptExts),
 1944        { Params = [] }
 1945    ;   { Params = [Name=Value|T] },
 1946        parameter_value(Value),
 1947        blanks,
 1948        (   ";"
 1949        ->  blanks,
 1950            parameters_and_quality(T, Quality, AcceptExts)
 1951        ;   { T = [],
 1952              Quality = 1.0,
 1953              AcceptExts = []
 1954            }
 1955        )
 1956    ).
 1957
 1958%!  value_parameters(-Params:list) is det.
 1959%
 1960%   Accept (";" <parameter>)*, returning a list of Name=Value, where
 1961%   both Name and Value are atoms.
 1962
 1963value_parameters([H|T]) -->
 1964    ";",
 1965    !,
 1966    blanks, token(Name), blanks,
 1967    (   "="
 1968    ->  blanks,
 1969        (   token(Value)
 1970        ->  []
 1971        ;   quoted_string(Value)
 1972        ),
 1973        { H = (Name=Value) }
 1974    ;   { H = Name }
 1975    ),
 1976    blanks,
 1977    value_parameters(T).
 1978value_parameters([]) -->
 1979    [].
 1980
 1981parameter_value(Value) --> token(Value), !.
 1982parameter_value(Value) --> quoted_string(Value).
 1983
 1984
 1985%!  token(-Name)// is semidet.
 1986%
 1987%   Process an HTTP header token from the input.
 1988
 1989token(Name) -->
 1990    token_char(C1),
 1991    token_chars(Cs),
 1992    { atom_codes(Name, [C1|Cs]) }.
 1993
 1994token_chars([H|T]) -->
 1995    token_char(H),
 1996    !,
 1997    token_chars(T).
 1998token_chars([]) --> [].
 1999
 2000token_char(C) --> [C], { token_char(C) }.
 2001
 2002token_char(C) :-
 2003    \+ ctl(C),
 2004    \+ separator_code(C).
 2005
 2006ctl(C) :- between(0,31,C), !.
 2007ctl(127).
 2008
 2009separator_code(0'().
 2010separator_code(0')).
 2011separator_code(0'<).
 2012separator_code(0'>).
 2013separator_code(0'@).
 2014separator_code(0',).
 2015separator_code(0';).
 2016separator_code(0':).
 2017separator_code(0'\\).
 2018separator_code(0'").
 2019separator_code(0'/).
 2020separator_code(0'[).
 2021separator_code(0']).
 2022separator_code(0'?).
 2023separator_code(0'=).
 2024separator_code(0'{).
 2025separator_code(0'}).
 2026separator_code(0'\s).
 2027separator_code(0'\t).
 2028
 2029
 2030%!  quoted_string(-Text)// is semidet.
 2031%
 2032%   True if input starts with a quoted string representing Text.
 2033
 2034quoted_string(Text) -->
 2035    "\"",
 2036    quoted_text(Codes),
 2037    { atom_codes(Text, Codes) }.
 2038
 2039quoted_text([]) -->
 2040    "\"",
 2041    !.
 2042quoted_text([H|T]) -->
 2043    "\\", !, [H],
 2044    quoted_text(T).
 2045quoted_text([H|T]) -->
 2046    [H],
 2047    !,
 2048    quoted_text(T).
 2049
 2050
 2051%!  header_fields(+Fields, ?ContentLength)// is det.
 2052%
 2053%   Process a sequence of  [Name(Value),   ...]  attributes  for the
 2054%   header. A term content_length(Len) is   special. If instantiated
 2055%   it emits the header. If not   it just unifies ContentLength with
 2056%   the argument of the content_length(Len)   term.  This allows for
 2057%   both sending and retrieving the content-length.
 2058
 2059header_fields([], _) --> [].
 2060header_fields([content_length(CLen)|T], CLen) -->
 2061    !,
 2062    (   { var(CLen) }
 2063    ->  ""
 2064    ;   header_field(content_length, CLen)
 2065    ),
 2066    header_fields(T, CLen).           % Continue or return first only?
 2067header_fields([status(_)|T], CLen) -->   % handled by vstatus//3.
 2068    !,
 2069    header_fields(T, CLen).
 2070header_fields([H|T], CLen) -->
 2071    { H =.. [Name, Value] },
 2072    header_field(Name, Value),
 2073    header_fields(T, CLen).
 2074
 2075
 2076%!  field_name(?PrologName)
 2077%
 2078%   Convert between prolog_name  and  HttpName.   Field  names  are,
 2079%   according to RFC 2616, considered  tokens   and  covered  by the
 2080%   following definition:
 2081%
 2082%   ==
 2083%   token          = 1*<any CHAR except CTLs or separators>
 2084%   separators     = "(" | ")" | "<" | ">" | "@"
 2085%                  | "," | ";" | ":" | "\" | <">
 2086%                  | "/" | "[" | "]" | "?" | "="
 2087%                  | "{" | "}" | SP | HT
 2088%   ==
 2089
 2090:- public
 2091    field_name//1. 2092
 2093field_name(Name) -->
 2094    { var(Name) },
 2095    !,
 2096    rd_field_chars(Chars),
 2097    { atom_codes(Name, Chars) }.
 2098field_name(mime_version) -->
 2099    !,
 2100    "MIME-Version".
 2101field_name(Name) -->
 2102    { atom_codes(Name, Chars) },
 2103    wr_field_chars(Chars).
 2104
 2105rd_field_chars_no_fold([C|T]) -->
 2106    [C],
 2107    { rd_field_char(C, _) },
 2108    !,
 2109    rd_field_chars_no_fold(T).
 2110rd_field_chars_no_fold([]) -->
 2111    [].
 2112
 2113rd_field_chars([C0|T]) -->
 2114    [C],
 2115    { rd_field_char(C, C0) },
 2116    !,
 2117    rd_field_chars(T).
 2118rd_field_chars([]) -->
 2119    [].
 2120
 2121%!  separators(-CharCodes) is det.
 2122%
 2123%   CharCodes is a list of separators according to RFC2616
 2124
 2125separators("()<>@,;:\\\"/[]?={} \t").
 2126
 2127term_expansion(rd_field_char('expand me',_), Clauses) :-
 2128
 2129    Clauses = [ rd_field_char(0'-, 0'_)
 2130              | Cls
 2131              ],
 2132    separators(SepString),
 2133    string_codes(SepString, Seps),
 2134    findall(rd_field_char(In, Out),
 2135            (   between(32, 127, In),
 2136                \+ memberchk(In, Seps),
 2137                In \== 0'-,         % 0'
 2138                code_type(Out, to_lower(In))),
 2139            Cls).
 2140
 2141rd_field_char('expand me', _).                  % avoid recursion
 2142
 2143wr_field_chars([C|T]) -->
 2144    !,
 2145    { code_type(C, to_lower(U)) },
 2146    [U],
 2147    wr_field_chars2(T).
 2148wr_field_chars([]) -->
 2149    [].
 2150
 2151wr_field_chars2([]) --> [].
 2152wr_field_chars2([C|T]) -->              % 0'
 2153    (   { C == 0'_ }
 2154    ->  "-",
 2155        wr_field_chars(T)
 2156    ;   [C],
 2157        wr_field_chars2(T)
 2158    ).
 2159
 2160%!  now//
 2161%
 2162%   Current time using rfc_date//1.
 2163
 2164now -->
 2165    { get_time(Time)
 2166    },
 2167    rfc_date(Time).
 2168
 2169%!  rfc_date(+Time)// is det.
 2170%
 2171%   Write time according to RFC1123 specification as required by the
 2172%   RFC2616 HTTP protocol specs.
 2173
 2174rfc_date(Time, String, Tail) :-
 2175    stamp_date_time(Time, Date, 'UTC'),
 2176    format_time(codes(String, Tail),
 2177                '%a, %d %b %Y %T GMT',
 2178                Date, posix).
 2179
 2180%!  http_timestamp(+Time:timestamp, -Text:atom) is det.
 2181%
 2182%   Generate a description of a Time in HTTP format (RFC1123)
 2183
 2184http_timestamp(Time, Atom) :-
 2185    stamp_date_time(Time, Date, 'UTC'),
 2186    format_time(atom(Atom),
 2187                '%a, %d %b %Y %T GMT',
 2188                Date, posix).
 2189
 2190
 2191                 /*******************************
 2192                 *         REQUEST DCG          *
 2193                 *******************************/
 2194
 2195request(Fd, [method(Method),request_uri(ReqURI)|Header]) -->
 2196    method(Method),
 2197    blanks,
 2198    nonblanks(Query),
 2199    { atom_codes(ReqURI, Query),
 2200      request_uri_parts(ReqURI, Header, Rest)
 2201    },
 2202    request_header(Fd, Rest),
 2203    !.
 2204request(Fd, [unknown(What)|Header]) -->
 2205    string(What),
 2206    eos,
 2207    !,
 2208    {   http_read_header(Fd, Header)
 2209    ->  true
 2210    ;   Header = []
 2211    }.
 2212
 2213method(get)     --> "GET", !.
 2214method(put)     --> "PUT", !.
 2215method(head)    --> "HEAD", !.
 2216method(post)    --> "POST", !.
 2217method(delete)  --> "DELETE", !.
 2218method(patch)   --> "PATCH", !.
 2219method(options) --> "OPTIONS", !.
 2220method(trace)   --> "TRACE", !.
 2221
 2222%!  request_uri_parts(+RequestURI, -Parts, ?Tail) is det.
 2223%
 2224%   Process the request-uri, producing the following parts:
 2225%
 2226%     * path(-Path)
 2227%     Decode path information (always present)
 2228%     * search(-QueryParams)
 2229%     Present if there is a ?name=value&... part of the request uri.
 2230%     QueryParams is a Name=Value list.
 2231%     * fragment(-Fragment)
 2232%     Present if there is a #Fragment.
 2233
 2234request_uri_parts(ReqURI, [path(Path)|Parts], Rest) :-
 2235    uri_components(ReqURI, Components),
 2236    uri_data(path, Components, PathText),
 2237    uri_encoded(path, Path, PathText),
 2238    phrase(uri_parts(Components), Parts, Rest).
 2239
 2240uri_parts(Components) -->
 2241    uri_search(Components),
 2242    uri_fragment(Components).
 2243
 2244uri_search(Components) -->
 2245    { uri_data(search, Components, Search),
 2246      nonvar(Search),
 2247      catch(uri_query_components(Search, Query),
 2248            error(syntax_error(_),_),
 2249            fail)
 2250    },
 2251    !,
 2252    [ search(Query) ].
 2253uri_search(_) --> [].
 2254
 2255uri_fragment(Components) -->
 2256    { uri_data(fragment, Components, String),
 2257      nonvar(String),
 2258      !,
 2259      uri_encoded(fragment, Fragment, String)
 2260    },
 2261    [ fragment(Fragment) ].
 2262uri_fragment(_) --> [].
 2263
 2264%!  request_header(+In:stream, -Header:list) is det.
 2265%
 2266%   Read the remainder (after the request-uri)   of  the HTTP header
 2267%   and return it as a Name(Value) list.
 2268
 2269request_header(_, []) -->               % Old-style non-version header
 2270    blanks,
 2271    eos,
 2272    !.
 2273request_header(Fd, [http_version(Version)|Header]) -->
 2274    http_version(Version),
 2275    blanks,
 2276    eos,
 2277    !,
 2278    {   Version = 1-_
 2279    ->  http_read_header(Fd, Header)
 2280    ;   Header = []
 2281    }.
 2282
 2283http_version(Version) -->
 2284    blanks,
 2285    "HTTP/",
 2286    http_version_number(Version).
 2287
 2288http_version_number(Major-Minor) -->
 2289    integer(Major),
 2290    ".",
 2291    integer(Minor).
 2292
 2293
 2294                 /*******************************
 2295                 *            COOKIES           *
 2296                 *******************************/
 2297
 2298%!  cookies(-List)// is semidet.
 2299%
 2300%   Translate a cookie description into a list Name=Value.
 2301
 2302cookies([Name=Value|T]) -->
 2303    blanks,
 2304    cookie(Name, Value),
 2305    !,
 2306    blanks,
 2307    (   ";"
 2308    ->  cookies(T)
 2309    ;   { T = [] }
 2310    ).
 2311cookies(List) -->
 2312    string(Skipped),
 2313    ";",
 2314    !,
 2315    { print_message(warning, http(skipped_cookie(Skipped))) },
 2316    cookies(List).
 2317cookies([]) -->
 2318    blanks.
 2319
 2320cookie(Name, Value) -->
 2321    cookie_name(Name),
 2322    blanks, "=", blanks,
 2323    cookie_value(Value).
 2324
 2325cookie_name(Name) -->
 2326    { var(Name) },
 2327    !,
 2328    rd_field_chars_no_fold(Chars),
 2329    { atom_codes(Name, Chars) }.
 2330
 2331cookie_value(Value) -->
 2332    quoted_string(Value),
 2333    !.
 2334cookie_value(Value) -->
 2335    chars_to_semicolon_or_blank(Chars),
 2336    { atom_codes(Value, Chars)
 2337    }.
 2338
 2339chars_to_semicolon_or_blank([H|T]) -->
 2340    [H],
 2341    { H \== 32, H \== 0'; },
 2342    !,
 2343    chars_to_semicolon_or_blank(T).
 2344chars_to_semicolon_or_blank([]) -->
 2345    [].
 2346
 2347set_cookie(set_cookie(Name, Value, Options)) -->
 2348    ws,
 2349    cookie(Name, Value),
 2350    cookie_options(Options).
 2351
 2352cookie_options([H|T]) -->
 2353    ws,
 2354    ";",
 2355    ws,
 2356    cookie_option(H),
 2357    !,
 2358    cookie_options(T).
 2359cookie_options([]) -->
 2360    ws.
 2361
 2362ws --> " ", !, ws.
 2363ws --> [].
 2364
 2365
 2366%!  cookie_option(-Option)// is semidet.
 2367%
 2368%   True if input represents a valid  Cookie option. Officially, all
 2369%   cookie  options  use  the  syntax   <name>=<value>,  except  for
 2370%   =secure=.  M$  decided  to  extend  this  to  include  at  least
 2371%   =httponly= (only the Gods know what it means).
 2372%
 2373%   @param  Option  Term of the form Name=Value
 2374%   @bug    Incorrectly accepts options without = for M$ compatibility.
 2375
 2376cookie_option(Name=Value) -->
 2377    rd_field_chars(NameChars), ws,
 2378    { atom_codes(Name, NameChars) },
 2379    (   "="
 2380    ->  ws,
 2381        chars_to_semicolon(ValueChars),
 2382        { atom_codes(Value, ValueChars)
 2383        }
 2384    ;   { Value = true }
 2385    ).
 2386
 2387chars_to_semicolon([H|T]) -->
 2388    [H],
 2389    { H \== 32, H \== 0'; },
 2390    !,
 2391    chars_to_semicolon(T).
 2392chars_to_semicolon([]), ";" -->
 2393    ws, ";",
 2394    !.
 2395chars_to_semicolon([H|T]) -->
 2396    [H],
 2397    chars_to_semicolon(T).
 2398chars_to_semicolon([]) -->
 2399    [].
 2400
 2401%!  range(-Range)// is semidet.
 2402%
 2403%   Process the range header value. Range is currently defined as:
 2404%
 2405%       * bytes(From, To)
 2406%       Where From is an integer and To is either an integer or
 2407%       the atom =end=.
 2408
 2409range(bytes(From, To)) -->
 2410    "bytes", whites, "=", whites, integer(From), "-",
 2411    (   integer(To)
 2412    ->  ""
 2413    ;   { To = end }
 2414    ).
 2415
 2416
 2417                 /*******************************
 2418                 *           REPLY DCG          *
 2419                 *******************************/
 2420
 2421%!  reply(+In, -Reply:list)// is semidet.
 2422%
 2423%   Process the first line of an HTTP   reply.  After that, read the
 2424%   remainder  of  the  header  and    parse  it.  After  successful
 2425%   completion, Reply contains the following fields, followed by the
 2426%   fields produced by http_read_header/2.
 2427%
 2428%       * http_version(Major-Minor)
 2429%       * status(Code, Status, Comment)
 2430%         `Code` is an integer between 100 and 599.
 2431%         `Status` is a Prolog internal name.
 2432%         `Comment` is the comment following the code
 2433%         as it appears in the reply's HTTP status line.
 2434%         @see status_number//2.
 2435
 2436reply(Fd, [http_version(HttpVersion), status(Code, Status, Comment)|Header]) -->
 2437    http_version(HttpVersion),
 2438    blanks,
 2439    (   status_number(Status, Code)
 2440    ->  []
 2441    ;   integer(Status)
 2442    ),
 2443    blanks,
 2444    string(CommentCodes),
 2445    blanks_to_nl,
 2446    !,
 2447    blanks,
 2448    { atom_codes(Comment, CommentCodes),
 2449      http_read_header(Fd, Header)
 2450    }.
 2451
 2452
 2453                 /*******************************
 2454                 *            READ HEADER       *
 2455                 *******************************/
 2456
 2457%!  http_read_header(+Fd, -Header) is det.
 2458%
 2459%   Read Name: Value lines from FD until an empty line is encountered.
 2460%   Field-name are converted to Prolog conventions (all lower, _ instead
 2461%   of -): Content-Type: text/html --> content_type(text/html)
 2462
 2463http_read_header(Fd, Header) :-
 2464    read_header_data(Fd, Text),
 2465    http_parse_header(Text, Header).
 2466
 2467read_header_data(Fd, Header) :-
 2468    read_line_to_codes(Fd, Header, Tail),
 2469    read_header_data(Header, Fd, Tail),
 2470    debug(http(header), 'Header = ~n~s~n', [Header]).
 2471
 2472read_header_data([0'\r,0'\n], _, _) :- !.
 2473read_header_data([0'\n], _, _) :- !.
 2474read_header_data([], _, _) :- !.
 2475read_header_data(_, Fd, Tail) :-
 2476    read_line_to_codes(Fd, Tail, NewTail),
 2477    read_header_data(Tail, Fd, NewTail).
 2478
 2479%!  http_parse_header(+Text:codes, -Header:list) is det.
 2480%
 2481%   Header is a list of Name(Value)-terms representing the structure
 2482%   of the HTTP header in Text.
 2483%
 2484%   @error domain_error(http_request_line, Line)
 2485
 2486http_parse_header(Text, Header) :-
 2487    phrase(header(Header), Text),
 2488    debug(http(header), 'Field: ~p', [Header]).
 2489
 2490header(List) -->
 2491    header_field(Name, Value),
 2492    !,
 2493    { mkfield(Name, Value, List, Tail)
 2494    },
 2495    blanks,
 2496    header(Tail).
 2497header([]) -->
 2498    blanks,
 2499    eos,
 2500    !.
 2501header(_) -->
 2502    string(S), blanks_to_nl,
 2503    !,
 2504    { string_codes(Line, S),
 2505      syntax_error(http_parameter(Line))
 2506    }.
 2507
 2508%!  address//
 2509%
 2510%   Emit the HTML for the server address on behalve of error and
 2511%   status messages (non-200 replies).  Default is
 2512%
 2513%       ==
 2514%       SWI-Prolog httpd at <hostname>
 2515%       ==
 2516%
 2517%   The address can be modified by   providing  a definition for the
 2518%   multifile predicate http:http_address//0.
 2519
 2520:- multifile
 2521    http:http_address//0. 2522
 2523address -->
 2524    http:http_address,
 2525    !.
 2526address -->
 2527    { gethostname(Host) },
 2528    html(address([ a(href('http://www.swi-prolog.org'), 'SWI-Prolog'),
 2529                   ' httpd at ', Host
 2530                 ])).
 2531
 2532mkfield(host, Host:Port, [host(Host),port(Port)|Tail], Tail) :- !.
 2533mkfield(Name, Value, [Att|Tail], Tail) :-
 2534    Att =.. [Name, Value].
 2535
 2536%!  http:http_address// is det.
 2537%
 2538%   HTML-rule that emits the location of  the HTTP server. This hook
 2539%   is called from address//0 to customise   the server address. The
 2540%   server address is emitted on non-200-ok replies.
 2541
 2542%!  http:status_page(+Status, +Context, -HTMLTokens) is semidet.
 2543%
 2544%   Hook called by http_status_reply/4  and http_status_reply/5 that
 2545%   allows for emitting custom error pages   for  the following HTTP
 2546%   page types:
 2547%
 2548%     - 401 - authorise(AuthMethod)
 2549%     - 403 - forbidden(URL)
 2550%     - 404 - not_found(URL)
 2551%     - 405 - method_not_allowed(Method,URL)
 2552%
 2553%   The hook is tried twice,  first   using  the  status term, e.g.,
 2554%   not_found(URL) and than with the code,   e.g.  `404`. The second
 2555%   call is deprecated and only exists for compatibility.
 2556%
 2557%   @arg    Context is the 4th argument of http_status_reply/5, which
 2558%           is invoked after raising an exception of the format
 2559%           http_reply(Status, HeaderExtra, Context).  The default
 2560%           context is `[]` (the empty list).
 2561%   @arg    HTMLTokens is a list of tokens as produced by html//1.
 2562%           It is passed to print_html/2.
 2563
 2564
 2565                 /*******************************
 2566                 *            MESSAGES          *
 2567                 *******************************/
 2568
 2569:- multifile
 2570    prolog:message//1,
 2571    prolog:error_message//1. 2572
 2573prolog:error_message(http_write_short(Data, Sent)) -->
 2574    data(Data),
 2575    [ ': remote hangup after ~D bytes'-[Sent] ].
 2576prolog:error_message(syntax_error(http_request(Request))) -->
 2577    [ 'Illegal HTTP request: ~s'-[Request] ].
 2578prolog:error_message(syntax_error(http_parameter(Line))) -->
 2579    [ 'Illegal HTTP parameter: ~s'-[Line] ].
 2580
 2581prolog:message(http(skipped_cookie(S))) -->
 2582    [ 'Skipped illegal cookie: ~s'-[S] ].
 2583
 2584data(bytes(MimeType, _Bytes)) -->
 2585    !,
 2586    [ 'bytes(~p, ...)'-[MimeType] ].
 2587data(Data) -->
 2588    [ '~p'-[Data] ]