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