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