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%     * string(+String)
 1005%     * string(+Type, +String)
 1006%     Similar to atom(Atom) and atom(Type,Atom), accepting a SWI-Prolog
 1007%     string.
 1008%
 1009%     * cgi_stream(+Stream, +Len) Read the input from Stream which,
 1010%     like CGI data starts with a partial HTTP header. The fields of
 1011%     this header are merged with the provided HdrExtra fields. The
 1012%     first Len characters of Stream are used.
 1013%
 1014%     * form(+ListOfParameter)
 1015%     Send data of the MIME type application/x-www-form-urlencoded as
 1016%     produced by browsers issuing a POST request from an HTML form.
 1017%     ListOfParameter is a list of Name=Value or Name(Value).
 1018%
 1019%     * form_data(+ListOfData)
 1020%     Send data of the MIME type =|multipart/form-data|= as produced
 1021%     by browsers issuing a POST request from an HTML form using
 1022%     enctype =|multipart/form-data|=. ListOfData is the same as for
 1023%     the List alternative described below. Below is an example.
 1024%     Repository, etc. are atoms providing the value, while the last
 1025%     argument provides a value from a file.
 1026%
 1027%       ==
 1028%       ...,
 1029%       http_post([ protocol(http),
 1030%                   host(Host),
 1031%                   port(Port),
 1032%                   path(ActionPath)
 1033%                 ],
 1034%                 form_data([ repository = Repository,
 1035%                             dataFormat = DataFormat,
 1036%                             baseURI    = BaseURI,
 1037%                             verifyData = Verify,
 1038%                             data       = file(File)
 1039%                           ]),
 1040%                 _Reply,
 1041%                 []),
 1042%       ...,
 1043%       ==
 1044%
 1045%     * List
 1046%     If the argument is a plain list, it is sent using the MIME type
 1047%     multipart/mixed and packed using mime_pack/3. See mime_pack/3
 1048%     for details on the argument format.
 1049
 1050http_post_data(Data, Out, HdrExtra) :-
 1051    http:post_data_hook(Data, Out, HdrExtra),
 1052    !.
 1053http_post_data(html(HTML), Out, HdrExtra) :-
 1054    !,
 1055    phrase(post_header(html(HTML), HdrExtra), Header),
 1056    send_request_header(Out, Header),
 1057    print_html(Out, HTML).
 1058http_post_data(xml(XML), Out, HdrExtra) :-
 1059    !,
 1060    http_post_data(xml(text/xml, XML, []), Out, HdrExtra).
 1061http_post_data(xml(Type, XML), Out, HdrExtra) :-
 1062    !,
 1063    http_post_data(xml(Type, XML, []), Out, HdrExtra).
 1064http_post_data(xml(Type, XML, Options), Out, HdrExtra) :-
 1065    !,
 1066    setup_call_cleanup(
 1067        new_memory_file(MemFile),
 1068        (   setup_call_cleanup(
 1069                open_memory_file(MemFile, write, MemOut),
 1070                xml_write(MemOut, XML, Options),
 1071                close(MemOut)),
 1072            http_post_data(memory_file(Type, MemFile), Out, HdrExtra)
 1073        ),
 1074        free_memory_file(MemFile)).
 1075http_post_data(file(File), Out, HdrExtra) :-
 1076    !,
 1077    (   file_mime_type(File, Type)
 1078    ->  true
 1079    ;   Type = text/plain
 1080    ),
 1081    http_post_data(file(Type, File), Out, HdrExtra).
 1082http_post_data(file(Type, File), Out, HdrExtra) :-
 1083    !,
 1084    phrase(post_header(file(Type, File), HdrExtra), Header),
 1085    send_request_header(Out, Header),
 1086    setup_call_cleanup(
 1087        open(File, read, In, [type(binary)]),
 1088        copy_stream_data(In, Out),
 1089        close(In)).
 1090http_post_data(memory_file(Type, Handle), Out, HdrExtra) :-
 1091    !,
 1092    phrase(post_header(memory_file(Type, Handle), HdrExtra), Header),
 1093    send_request_header(Out, Header),
 1094    setup_call_cleanup(
 1095        open_memory_file(Handle, read, In, [encoding(octet)]),
 1096        copy_stream_data(In, Out),
 1097        close(In)).
 1098http_post_data(codes(Codes), Out, HdrExtra) :-
 1099    !,
 1100    http_post_data(codes(text/plain, Codes), Out, HdrExtra).
 1101http_post_data(codes(Type, Codes), Out, HdrExtra) :-
 1102    !,
 1103    phrase(post_header(codes(Type, Codes), HdrExtra), Header),
 1104    send_request_header(Out, Header),
 1105    setup_call_cleanup(
 1106        set_stream(Out, encoding(utf8)),
 1107        format(Out, '~s', [Codes]),
 1108        set_stream(Out, encoding(octet))).
 1109http_post_data(bytes(Type, Bytes), Out, HdrExtra) :-
 1110    !,
 1111    phrase(post_header(bytes(Type, Bytes), HdrExtra), Header),
 1112    send_request_header(Out, Header),
 1113    format(Out, '~s', [Bytes]).
 1114http_post_data(atom(Atom), Out, HdrExtra) :-
 1115    !,
 1116    http_post_data(atom(text/plain, Atom), Out, HdrExtra).
 1117http_post_data(atom(Type, Atom), Out, HdrExtra) :-
 1118    !,
 1119    phrase(post_header(atom(Type, Atom), HdrExtra), Header),
 1120    send_request_header(Out, Header),
 1121    setup_call_cleanup(
 1122        set_stream(Out, encoding(utf8)),
 1123        write(Out, Atom),
 1124        set_stream(Out, encoding(octet))).
 1125http_post_data(string(String), Out, HdrExtra) :-
 1126    !,
 1127    http_post_data(atom(text/plain, String), Out, HdrExtra).
 1128http_post_data(string(Type, String), Out, HdrExtra) :-
 1129    !,
 1130    phrase(post_header(string(Type, String), HdrExtra), Header),
 1131    send_request_header(Out, Header),
 1132    setup_call_cleanup(
 1133        set_stream(Out, encoding(utf8)),
 1134        write(Out, String),
 1135        set_stream(Out, encoding(octet))).
 1136http_post_data(cgi_stream(In, _Len), Out, HdrExtra) :-
 1137    !,
 1138    debug(obsolete, 'Obsolete 2nd argument in cgi_stream(In,Len)', []),
 1139    http_post_data(cgi_stream(In), Out, HdrExtra).
 1140http_post_data(cgi_stream(In), Out, HdrExtra) :-
 1141    !,
 1142    http_read_header(In, Header0),
 1143    http_update_encoding(Header0, Encoding, Header),
 1144    content_length_in_encoding(Encoding, In, Size),
 1145    http_join_headers(HdrExtra, Header, Hdr2),
 1146    phrase(post_header(cgi_data(Size), Hdr2), HeaderText),
 1147    send_request_header(Out, HeaderText),
 1148    setup_call_cleanup(
 1149        set_stream(Out, encoding(Encoding)),
 1150        copy_stream_data(In, Out),
 1151        set_stream(Out, encoding(octet))).
 1152http_post_data(form(Fields), Out, HdrExtra) :-
 1153    !,
 1154    parse_url_search(Codes, Fields),
 1155    length(Codes, Size),
 1156    http_join_headers(HdrExtra,
 1157                      [ content_type('application/x-www-form-urlencoded')
 1158                      ], Header),
 1159    phrase(post_header(cgi_data(Size), Header), HeaderChars),
 1160    send_request_header(Out, HeaderChars),
 1161    format(Out, '~s', [Codes]).
 1162http_post_data(form_data(Data), Out, HdrExtra) :-
 1163    !,
 1164    setup_call_cleanup(
 1165        new_memory_file(MemFile),
 1166        ( setup_call_cleanup(
 1167              open_memory_file(MemFile, write, MimeOut),
 1168              mime_pack(Data, MimeOut, Boundary),
 1169              close(MimeOut)),
 1170          size_memory_file(MemFile, Size, octet),
 1171          format(string(ContentType),
 1172                 'multipart/form-data; boundary=~w', [Boundary]),
 1173          http_join_headers(HdrExtra,
 1174                            [ mime_version('1.0'),
 1175                              content_type(ContentType)
 1176                            ], Header),
 1177          phrase(post_header(cgi_data(Size), Header), HeaderChars),
 1178          send_request_header(Out, HeaderChars),
 1179          setup_call_cleanup(
 1180              open_memory_file(MemFile, read, In, [encoding(octet)]),
 1181              copy_stream_data(In, Out),
 1182              close(In))
 1183        ),
 1184        free_memory_file(MemFile)).
 1185http_post_data(List, Out, HdrExtra) :-          % multipart-mixed
 1186    is_list(List),
 1187    !,
 1188    setup_call_cleanup(
 1189        new_memory_file(MemFile),
 1190        ( setup_call_cleanup(
 1191              open_memory_file(MemFile, write, MimeOut),
 1192              mime_pack(List, MimeOut, Boundary),
 1193              close(MimeOut)),
 1194          size_memory_file(MemFile, Size, octet),
 1195          format(string(ContentType),
 1196                 'multipart/mixed; boundary=~w', [Boundary]),
 1197          http_join_headers(HdrExtra,
 1198                            [ mime_version('1.0'),
 1199                              content_type(ContentType)
 1200                            ], Header),
 1201          phrase(post_header(cgi_data(Size), Header), HeaderChars),
 1202          send_request_header(Out, HeaderChars),
 1203          setup_call_cleanup(
 1204              open_memory_file(MemFile, read, In, [encoding(octet)]),
 1205              copy_stream_data(In, Out),
 1206              close(In))
 1207        ),
 1208        free_memory_file(MemFile)).
 1209
 1210%!  post_header(+Data, +HeaderExtra)//
 1211%
 1212%   Generate the POST header, emitting HeaderExtra, followed by the
 1213%   HTTP Content-length and Content-type fields.
 1214
 1215post_header(html(Tokens), HdrExtra) -->
 1216    header_fields(HdrExtra, Len),
 1217    content_length(html(Tokens), Len),
 1218    content_type(text/html),
 1219    "\r\n".
 1220post_header(file(Type, File), HdrExtra) -->
 1221    header_fields(HdrExtra, Len),
 1222    content_length(file(File), Len),
 1223    content_type(Type),
 1224    "\r\n".
 1225post_header(memory_file(Type, File), HdrExtra) -->
 1226    header_fields(HdrExtra, Len),
 1227    content_length(memory_file(File), Len),
 1228    content_type(Type),
 1229    "\r\n".
 1230post_header(cgi_data(Size), HdrExtra) -->
 1231    header_fields(HdrExtra, Len),
 1232    content_length(Size, Len),
 1233    "\r\n".
 1234post_header(codes(Type, Codes), HdrExtra) -->
 1235    header_fields(HdrExtra, Len),
 1236    content_length(codes(Codes, utf8), Len),
 1237    content_type(Type, utf8),
 1238    "\r\n".
 1239post_header(bytes(Type, Bytes), HdrExtra) -->
 1240    header_fields(HdrExtra, Len),
 1241    content_length(bytes(Bytes), Len),
 1242    content_type(Type),
 1243    "\r\n".
 1244post_header(atom(Type, Atom), HdrExtra) -->
 1245    header_fields(HdrExtra, Len),
 1246    content_length(atom(Atom, utf8), Len),
 1247    content_type(Type, utf8),
 1248    "\r\n".
 1249post_header(string(Type, String), HdrExtra) -->
 1250    header_fields(HdrExtra, Len),
 1251    content_length(string(String, utf8), Len),
 1252    content_type(Type, utf8),
 1253    "\r\n".
 1254
 1255
 1256                 /*******************************
 1257                 *       OUTPUT HEADER DCG      *
 1258                 *******************************/
 1259
 1260%!  http_reply_header(+Out:stream, +What, +HdrExtra) is det.
 1261%
 1262%   Create a reply header  using  reply_header//3   and  send  it to
 1263%   Stream.
 1264
 1265http_reply_header(Out, What, HdrExtra) :-
 1266    phrase(reply_header(What, HdrExtra, _Code), String),
 1267    !,
 1268    send_reply_header(Out, String).
 1269
 1270%!  reply_header(+Data, +HdrExtra, -Code)// is det.
 1271%
 1272%   Grammar that realises the HTTP handler for sending Data. Data is
 1273%   a  real  data  object  as  described   with  http_reply/2  or  a
 1274%   not-200-ok HTTP status reply. The   following status replies are
 1275%   defined.
 1276%
 1277%     * created(+URL, +HTMLTokens)
 1278%     * moved(+URL, +HTMLTokens)
 1279%     * moved_temporary(+URL, +HTMLTokens)
 1280%     * see_other(+URL, +HTMLTokens)
 1281%     * status(+Status)
 1282%     * status(+Status, +HTMLTokens)
 1283%     * authorise(+Method, +Realm, +Tokens)
 1284%     * authorise(+Method, +Tokens)
 1285%     * not_found(+URL, +HTMLTokens)
 1286%     * server_error(+Error, +Tokens)
 1287%     * resource_error(+Error, +Tokens)
 1288%     * service_unavailable(+Why, +Tokens)
 1289%
 1290%   @see http_status_reply/4 formulates the not-200-ok HTTP replies.
 1291
 1292reply_header(Data, Dict) -->
 1293    { _{header:HdrExtra, code:Code} :< Dict },
 1294    reply_header(Data, HdrExtra, Code).
 1295
 1296reply_header(string(String), HdrExtra, Code) -->
 1297    reply_header(string(text/plain, String), HdrExtra, Code).
 1298reply_header(string(Type, String), HdrExtra, Code) -->
 1299    vstatus(ok, Code, HdrExtra),
 1300    date(now),
 1301    header_fields(HdrExtra, CLen),
 1302    content_length(codes(String, utf8), CLen),
 1303    content_type(Type, utf8),
 1304    "\r\n".
 1305reply_header(bytes(Type, Bytes), HdrExtra, Code) -->
 1306    vstatus(ok, Code, HdrExtra),
 1307    date(now),
 1308    header_fields(HdrExtra, CLen),
 1309    content_length(bytes(Bytes), CLen),
 1310    content_type(Type),
 1311    "\r\n".
 1312reply_header(html(Tokens), HdrExtra, Code) -->
 1313    vstatus(ok, Code, HdrExtra),
 1314    date(now),
 1315    header_fields(HdrExtra, CLen),
 1316    content_length(html(Tokens), CLen),
 1317    content_type(text/html),
 1318    "\r\n".
 1319reply_header(file(Type, File), HdrExtra, Code) -->
 1320    vstatus(ok, Code, HdrExtra),
 1321    date(now),
 1322    modified(file(File)),
 1323    header_fields(HdrExtra, CLen),
 1324    content_length(file(File), CLen),
 1325    content_type(Type),
 1326    "\r\n".
 1327reply_header(gzip_file(Type, File), HdrExtra, Code) -->
 1328    vstatus(ok, Code, HdrExtra),
 1329    date(now),
 1330    modified(file(File)),
 1331    header_fields(HdrExtra, CLen),
 1332    content_length(file(File), CLen),
 1333    content_type(Type),
 1334    content_encoding(gzip),
 1335    "\r\n".
 1336reply_header(file(Type, File, Range), HdrExtra, Code) -->
 1337    vstatus(partial_content, Code, HdrExtra),
 1338    date(now),
 1339    modified(file(File)),
 1340    header_fields(HdrExtra, CLen),
 1341    content_length(file(File, Range), CLen),
 1342    content_type(Type),
 1343    "\r\n".
 1344reply_header(tmp_file(Type, File), HdrExtra, Code) -->
 1345    vstatus(ok, Code, HdrExtra),
 1346    date(now),
 1347    header_fields(HdrExtra, CLen),
 1348    content_length(file(File), CLen),
 1349    content_type(Type),
 1350    "\r\n".
 1351reply_header(cgi_data(Size), HdrExtra, Code) -->
 1352    vstatus(ok, Code, HdrExtra),
 1353    date(now),
 1354    header_fields(HdrExtra, CLen),
 1355    content_length(Size, CLen),
 1356    "\r\n".
 1357reply_header(chunked_data, HdrExtra, Code) -->
 1358    vstatus(ok, Code, HdrExtra),
 1359    date(now),
 1360    header_fields(HdrExtra, _),
 1361    (   {memberchk(transfer_encoding(_), HdrExtra)}
 1362    ->  ""
 1363    ;   transfer_encoding(chunked)
 1364    ),
 1365    "\r\n".
 1366% non-200 replies without a body (e.g., 1xx, 204, 304)
 1367reply_header(status(Status), HdrExtra, Code) -->
 1368    vstatus(Status, Code),
 1369    header_fields(HdrExtra, Clen),
 1370    { Clen = 0 },
 1371    "\r\n".
 1372% non-200 replies with a body
 1373reply_header(Data, HdrExtra, Code) -->
 1374    { status_reply_headers(Data,
 1375                           body(Type, Encoding, Content),
 1376                           ReplyHeaders),
 1377      http_join_headers(ReplyHeaders, HdrExtra, Headers),
 1378      functor(Data, CodeName, _)
 1379    },
 1380    vstatus(CodeName, Code, Headers),
 1381    date(now),
 1382    header_fields(Headers, CLen),
 1383    content_length(codes(Content, Encoding), CLen),
 1384    content_type(Type, Encoding),
 1385    "\r\n".
 1386
 1387status_reply_headers(created(Location, Body), Body,
 1388                     [ location(Location) ]).
 1389status_reply_headers(moved(To, Body), Body,
 1390                     [ location(To) ]).
 1391status_reply_headers(moved_temporary(To, Body), Body,
 1392                     [ location(To) ]).
 1393status_reply_headers(gone(_URL, Body), Body, []).
 1394status_reply_headers(see_other(To, Body), Body,
 1395                     [ location(To) ]).
 1396status_reply_headers(authorise(Method, Body), Body,
 1397                     [ www_authenticate(Method) ]).
 1398status_reply_headers(not_found(_URL, Body), Body, []).
 1399status_reply_headers(forbidden(_URL, Body), Body, []).
 1400status_reply_headers(method_not_allowed(_Method, _URL, Body), Body, []).
 1401status_reply_headers(server_error(_Error, Body), Body, []).
 1402status_reply_headers(service_unavailable(_Why, Body), Body, []).
 1403status_reply_headers(not_acceptable(_Why, Body), Body, []).
 1404status_reply_headers(bad_request(_Error, Body), Body, []).
 1405
 1406
 1407%!  vstatus(+Status, -Code)// is det.
 1408%!  vstatus(+Status, -Code, +HdrExtra)// is det.
 1409%
 1410%   Emit the HTTP header for Status
 1411
 1412vstatus(_Status, Code, HdrExtra) -->
 1413    {memberchk(status(Code), HdrExtra)},
 1414    !,
 1415    vstatus(_NewStatus, Code).
 1416vstatus(Status, Code, _) -->
 1417    vstatus(Status, Code).
 1418
 1419vstatus(Status, Code) -->
 1420    "HTTP/1.1 ",
 1421    status_number(Status, Code),
 1422    " ",
 1423    status_comment(Status),
 1424    "\r\n".
 1425
 1426%!  status_number(?Status, ?Code)// is semidet.
 1427%
 1428%   Parse/generate the HTTP status  numbers  and   map  them  to the
 1429%   proper name.
 1430%
 1431%   @see See the source code for supported status names and codes.
 1432
 1433status_number(Status, Code) -->
 1434    { var(Status) },
 1435    !,
 1436    integer(Code),
 1437    { status_number(Status, Code) },
 1438    !.
 1439status_number(Status, Code) -->
 1440    { status_number(Status, Code) },
 1441    integer(Code).
 1442
 1443%!  status_number(+Status:atom, -Code:nonneg) is det.
 1444%!  status_number(-Status:atom, +Code:nonneg) is det.
 1445%
 1446%   Relates a symbolic  HTTP   status  names to their integer Code.
 1447%   Each code also needs a rule for status_comment//1.
 1448%
 1449%   @throws type_error    If Code is instantiated with something other than
 1450%                         an integer.
 1451%   @throws domain_error  If Code is instantiated with an integer
 1452%                         outside of the range [100-599] of defined
 1453%                         HTTP status codes.
 1454
 1455% Unrecognized status codes that are within a defined code class.
 1456% RFC 7231 states:
 1457%   "[...] a client MUST understand the class of any status code,
 1458%    as indicated by the first digit, and treat an unrecognized status code
 1459%    as being equivalent to the `x00` status code of that class [...]
 1460%   "
 1461% @see http://tools.ietf.org/html/rfc7231#section-6
 1462
 1463status_number(Status, Code) :-
 1464    nonvar(Status),
 1465    !,
 1466    status_number_fact(Status, Code).
 1467status_number(Status, Code) :-
 1468    nonvar(Code),
 1469    !,
 1470    (   between(100, 599, Code)
 1471    ->  (   status_number_fact(Status, Code)
 1472        ->  true
 1473        ;   ClassCode is Code // 100 * 100,
 1474            status_number_fact(Status, ClassCode)
 1475        )
 1476    ;   domain_error(http_code, Code)
 1477    ).
 1478
 1479status_number_fact(continue,                   100).
 1480status_number_fact(switching_protocols,        101).
 1481status_number_fact(ok,                         200).
 1482status_number_fact(created,                    201).
 1483status_number_fact(accepted,                   202).
 1484status_number_fact(non_authoritative_info,     203).
 1485status_number_fact(no_content,                 204).
 1486status_number_fact(reset_content,              205).
 1487status_number_fact(partial_content,            206).
 1488status_number_fact(multiple_choices,           300).
 1489status_number_fact(moved,                      301).
 1490status_number_fact(moved_temporary,            302).
 1491status_number_fact(see_other,                  303).
 1492status_number_fact(not_modified,               304).
 1493status_number_fact(use_proxy,                  305).
 1494status_number_fact(unused,                     306).
 1495status_number_fact(temporary_redirect,         307).
 1496status_number_fact(bad_request,                400).
 1497status_number_fact(authorise,                  401).
 1498status_number_fact(payment_required,           402).
 1499status_number_fact(forbidden,                  403).
 1500status_number_fact(not_found,                  404).
 1501status_number_fact(method_not_allowed,         405).
 1502status_number_fact(not_acceptable,             406).
 1503status_number_fact(request_timeout,            408).
 1504status_number_fact(conflict,                   409).
 1505status_number_fact(gone,                       410).
 1506status_number_fact(length_required,            411).
 1507status_number_fact(payload_too_large,          413).
 1508status_number_fact(uri_too_long,               414).
 1509status_number_fact(unsupported_media_type,     415).
 1510status_number_fact(expectation_failed,         417).
 1511status_number_fact(upgrade_required,           426).
 1512status_number_fact(server_error,               500).
 1513status_number_fact(not_implemented,            501).
 1514status_number_fact(bad_gateway,                502).
 1515status_number_fact(service_unavailable,        503).
 1516status_number_fact(gateway_timeout,            504).
 1517status_number_fact(http_version_not_supported, 505).
 1518
 1519
 1520%!  status_comment(+Code:atom)// is det.
 1521%
 1522%   Emit standard HTTP human-readable comment on the reply-status.
 1523
 1524status_comment(continue) -->
 1525    "Continue".
 1526status_comment(switching_protocols) -->
 1527    "Switching Protocols".
 1528status_comment(ok) -->
 1529    "OK".
 1530status_comment(created) -->
 1531    "Created".
 1532status_comment(accepted) -->
 1533    "Accepted".
 1534status_comment(non_authoritative_info) -->
 1535    "Non-Authoritative Information".
 1536status_comment(no_content) -->
 1537    "No Content".
 1538status_comment(reset_content) -->
 1539    "Reset Content".
 1540status_comment(created) -->
 1541    "Created".
 1542status_comment(partial_content) -->
 1543    "Partial content".
 1544status_comment(multiple_choices) -->
 1545    "Multiple Choices".
 1546status_comment(moved) -->
 1547    "Moved Permanently".
 1548status_comment(moved_temporary) -->
 1549    "Moved Temporary".
 1550status_comment(see_other) -->
 1551    "See Other".
 1552status_comment(not_modified) -->
 1553    "Not Modified".
 1554status_comment(use_proxy) -->
 1555    "Use Proxy".
 1556status_comment(unused) -->
 1557    "Unused".
 1558status_comment(temporary_redirect) -->
 1559    "Temporary Redirect".
 1560status_comment(bad_request) -->
 1561    "Bad Request".
 1562status_comment(authorise) -->
 1563    "Authorization Required".
 1564status_comment(payment_required) -->
 1565    "Payment Required".
 1566status_comment(forbidden) -->
 1567    "Forbidden".
 1568status_comment(not_found) -->
 1569    "Not Found".
 1570status_comment(method_not_allowed) -->
 1571    "Method Not Allowed".
 1572status_comment(not_acceptable) -->
 1573    "Not Acceptable".
 1574status_comment(request_timeout) -->
 1575    "Request Timeout".
 1576status_comment(conflict) -->
 1577    "Conflict".
 1578status_comment(gone) -->
 1579    "Gone".
 1580status_comment(length_required) -->
 1581    "Length Required".
 1582status_comment(payload_too_large) -->
 1583    "Payload Too Large".
 1584status_comment(uri_too_long) -->
 1585    "URI Too Long".
 1586status_comment(unsupported_media_type) -->
 1587    "Unsupported Media Type".
 1588status_comment(expectation_failed) -->
 1589    "Expectation Failed".
 1590status_comment(upgrade_required) -->
 1591    "Upgrade Required".
 1592status_comment(server_error) -->
 1593    "Internal Server Error".
 1594status_comment(not_implemented) -->
 1595    "Not Implemented".
 1596status_comment(bad_gateway) -->
 1597    "Bad Gateway".
 1598status_comment(service_unavailable) -->
 1599    "Service Unavailable".
 1600status_comment(gateway_timeout) -->
 1601    "Gateway Timeout".
 1602status_comment(http_version_not_supported) -->
 1603    "HTTP Version Not Supported".
 1604
 1605date(Time) -->
 1606    "Date: ",
 1607    (   { Time == now }
 1608    ->  now
 1609    ;   rfc_date(Time)
 1610    ),
 1611    "\r\n".
 1612
 1613modified(file(File)) -->
 1614    !,
 1615    { time_file(File, Time)
 1616    },
 1617    modified(Time).
 1618modified(Time) -->
 1619    "Last-modified: ",
 1620    (   { Time == now }
 1621    ->  now
 1622    ;   rfc_date(Time)
 1623    ),
 1624    "\r\n".
 1625
 1626
 1627%!  content_length(+Object, ?Len)// is det.
 1628%
 1629%   Emit the content-length field and (optionally) the content-range
 1630%   field.
 1631%
 1632%   @param Len Number of bytes specified
 1633
 1634content_length(file(File, bytes(From, To)), Len) -->
 1635    !,
 1636    { size_file(File, Size),
 1637      (   To == end
 1638      ->  Len is Size - From,
 1639          RangeEnd is Size - 1
 1640      ;   Len is To+1 - From,       % To is index of last byte
 1641          RangeEnd = To
 1642      )
 1643    },
 1644    content_range(bytes, From, RangeEnd, Size),
 1645    content_length(Len, Len).
 1646content_length(Reply, Len) -->
 1647    { length_of(Reply, Len)
 1648    },
 1649    "Content-Length: ", integer(Len),
 1650    "\r\n".
 1651
 1652
 1653length_of(_, Len) :-
 1654    nonvar(Len),
 1655    !.
 1656length_of(string(String, Encoding), Len) :-
 1657    length_of(codes(String, Encoding), Len).
 1658length_of(codes(String, Encoding), Len) :-
 1659    !,
 1660    setup_call_cleanup(
 1661        open_null_stream(Out),
 1662        ( set_stream(Out, encoding(Encoding)),
 1663          format(Out, '~s', [String]),
 1664          byte_count(Out, Len)
 1665        ),
 1666        close(Out)).
 1667length_of(atom(Atom, Encoding), Len) :-
 1668    !,
 1669    setup_call_cleanup(
 1670        open_null_stream(Out),
 1671        ( set_stream(Out, encoding(Encoding)),
 1672          format(Out, '~a', [Atom]),
 1673          byte_count(Out, Len)
 1674        ),
 1675        close(Out)).
 1676length_of(file(File), Len) :-
 1677    !,
 1678    size_file(File, Len).
 1679length_of(memory_file(Handle), Len) :-
 1680    !,
 1681    size_memory_file(Handle, Len, octet).
 1682length_of(html_tokens(Tokens), Len) :-
 1683    !,
 1684    html_print_length(Tokens, Len).
 1685length_of(html(Tokens), Len) :-     % deprecated
 1686    !,
 1687    html_print_length(Tokens, Len).
 1688length_of(bytes(Bytes), Len) :-
 1689    !,
 1690    (   string(Bytes)
 1691    ->  string_length(Bytes, Len)
 1692    ;   length(Bytes, Len)          % assuming a list of 0..255
 1693    ).
 1694length_of(Len, Len).
 1695
 1696
 1697%!  content_range(+Unit:atom, +From:int, +RangeEnd:int, +Size:int)// is det
 1698%
 1699%   Emit the =|Content-Range|= header  for   partial  content  (206)
 1700%   replies.
 1701
 1702content_range(Unit, From, RangeEnd, Size) -->
 1703    "Content-Range: ", atom(Unit), " ",
 1704    integer(From), "-", integer(RangeEnd), "/", integer(Size),
 1705    "\r\n".
 1706
 1707content_encoding(Encoding) -->
 1708    "Content-Encoding: ", atom(Encoding), "\r\n".
 1709
 1710transfer_encoding(Encoding) -->
 1711    "Transfer-Encoding: ", atom(Encoding), "\r\n".
 1712
 1713content_type(Type) -->
 1714    content_type(Type, _).
 1715
 1716content_type(Type, Charset) -->
 1717    ctype(Type),
 1718    charset(Charset),
 1719    "\r\n".
 1720
 1721ctype(Main/Sub) -->
 1722    !,
 1723    "Content-Type: ",
 1724    atom(Main),
 1725    "/",
 1726    atom(Sub).
 1727ctype(Type) -->
 1728    !,
 1729    "Content-Type: ",
 1730    atom(Type).
 1731
 1732charset(Var) -->
 1733    { var(Var) },
 1734    !.
 1735charset(utf8) -->
 1736    !,
 1737    "; charset=UTF-8".
 1738charset(CharSet) -->
 1739    "; charset=",
 1740    atom(CharSet).
 1741
 1742%!  header_field(-Name, -Value)// is det.
 1743%!  header_field(+Name, +Value) is det.
 1744%
 1745%   Process an HTTP request property. Request properties appear as a
 1746%   single line in an HTTP header.
 1747
 1748header_field(Name, Value) -->
 1749    { var(Name) },                 % parsing
 1750    !,
 1751    field_name(Name),
 1752    ":",
 1753    whites,
 1754    read_field_value(ValueChars),
 1755    blanks_to_nl,
 1756    !,
 1757    {   field_to_prolog(Name, ValueChars, Value)
 1758    ->  true
 1759    ;   atom_codes(Value, ValueChars),
 1760        domain_error(Name, Value)
 1761    }.
 1762header_field(Name, Value) -->
 1763    field_name(Name),
 1764    ": ",
 1765    field_value(Name, Value),
 1766    "\r\n".
 1767
 1768%!  read_field_value(-Codes)//
 1769%
 1770%   Read a field eagerly upto the next whitespace
 1771
 1772read_field_value([H|T]) -->
 1773    [H],
 1774    { \+ code_type(H, space) },
 1775    !,
 1776    read_field_value(T).
 1777read_field_value([]) -->
 1778    "".
 1779read_field_value([H|T]) -->
 1780    [H],
 1781    read_field_value(T).
 1782
 1783%!  send_reply_header(+Out, +String) is det.
 1784%!  send_request_header(+Out, +String) is det.
 1785%
 1786%   Low level routines to send a single HTTP request or reply line.
 1787
 1788send_reply_header(Out, String) :-
 1789    debug(http(send_reply), "< ~s", [String]),
 1790    format(Out, '~s', [String]).
 1791
 1792send_request_header(Out, String) :-
 1793    debug(http(send_request), "> ~s", [String]),
 1794    format(Out, '~s', [String]).
 1795
 1796%!  http_parse_header_value(+Field, +Value, -Prolog) is semidet.
 1797%
 1798%   Translate Value in a meaningful Prolog   term. Field denotes the
 1799%   HTTP request field for which we   do  the translation. Supported
 1800%   fields are:
 1801%
 1802%     * content_length
 1803%     Converted into an integer
 1804%     * status
 1805%     Converted into an integer
 1806%     * cookie
 1807%     Converted into a list with Name=Value by cookies//1.
 1808%     * set_cookie
 1809%     Converted into a term set_cookie(Name, Value, Options).
 1810%     Options is a list consisting of Name=Value or a single
 1811%     atom (e.g., =secure=)
 1812%     * host
 1813%     Converted to HostName:Port if applicable.
 1814%     * range
 1815%     Converted into bytes(From, To), where From is an integer
 1816%     and To is either an integer or the atom =end=.
 1817%     * accept
 1818%     Parsed to a list of media descriptions.  Each media is a term
 1819%     media(Type, TypeParams, Quality, AcceptExts). The list is
 1820%     sorted according to preference.
 1821%     * content_disposition
 1822%     Parsed into disposition(Name, Attributes), where Attributes is
 1823%     a list of Name=Value pairs.
 1824%     * content_type
 1825%     Parsed into media(Type/SubType, Attributes), where Attributes
 1826%     is a list of Name=Value pairs.
 1827%
 1828%   As some fields are already parsed in the `Request`, this predicate
 1829%   is a no-op when called on an already parsed field.
 1830%
 1831%   @arg Value is either an atom, a list of codes or an already parsed
 1832%   header value.
 1833
 1834http_parse_header_value(Field, Value, Prolog) :-
 1835    known_field(Field, _, Type),
 1836    (   already_parsed(Type, Value)
 1837    ->  Prolog = Value
 1838    ;   to_codes(Value, Codes),
 1839        parse_header_value(Field, Codes, Prolog)
 1840    ).
 1841
 1842already_parsed(integer, V)    :- !, integer(V).
 1843already_parsed(list(Type), L) :- !, is_list(L), maplist(already_parsed(Type), L).
 1844already_parsed(Term, V)       :- subsumes_term(Term, V).
 1845
 1846
 1847%!  known_field(?FieldName, ?AutoConvert, -Type)
 1848%
 1849%   True if the value of FieldName is   by default translated into a
 1850%   Prolog data structure.
 1851
 1852known_field(content_length,      true,  integer).
 1853known_field(status,              true,  integer).
 1854known_field(cookie,              true,  list(_=_)).
 1855known_field(set_cookie,          true,  list(set_cookie(_Name,_Value,_Options))).
 1856known_field(host,                true,  _Host:_Port).
 1857known_field(range,               maybe, bytes(_,_)).
 1858known_field(accept,              maybe, list(media(_Type, _Parms, _Q, _Exts))).
 1859known_field(content_disposition, maybe, disposition(_Name, _Attributes)).
 1860known_field(content_type,        false, media(_Type/_Sub, _Attributes)).
 1861
 1862to_codes(In, Codes) :-
 1863    (   is_list(In)
 1864    ->  Codes = In
 1865    ;   atom_codes(In, Codes)
 1866    ).
 1867
 1868%!  field_to_prolog(+Field, +ValueCodes, -Prolog) is semidet.
 1869%
 1870%   Translate the value string into  a   sensible  Prolog  term. For
 1871%   known_fields(_,true), this must succeed. For   =maybe=,  we just
 1872%   return the atom if the translation fails.
 1873
 1874field_to_prolog(Field, Codes, Prolog) :-
 1875    known_field(Field, true, _Type),
 1876    !,
 1877    (   parse_header_value(Field, Codes, Prolog0)
 1878    ->  Prolog = Prolog0
 1879    ).
 1880field_to_prolog(Field, Codes, Prolog) :-
 1881    known_field(Field, maybe, _Type),
 1882    parse_header_value(Field, Codes, Prolog0),
 1883    !,
 1884    Prolog = Prolog0.
 1885field_to_prolog(_, Codes, Atom) :-
 1886    atom_codes(Atom, Codes).
 1887
 1888%!  parse_header_value(+Field, +ValueCodes, -Value) is semidet.
 1889%
 1890%   Parse the value text of an HTTP   field into a meaningful Prolog
 1891%   representation.
 1892
 1893parse_header_value(content_length, ValueChars, ContentLength) :-
 1894    number_codes(ContentLength, ValueChars).
 1895parse_header_value(status, ValueChars, Code) :-
 1896    (   phrase(" ", L, _),
 1897        append(Pre, L, ValueChars)
 1898    ->  number_codes(Code, Pre)
 1899    ;   number_codes(Code, ValueChars)
 1900    ).
 1901parse_header_value(cookie, ValueChars, Cookies) :-
 1902    debug(cookie, 'Cookie: ~s', [ValueChars]),
 1903    phrase(cookies(Cookies), ValueChars).
 1904parse_header_value(set_cookie, ValueChars, SetCookie) :-
 1905    debug(cookie, 'SetCookie: ~s', [ValueChars]),
 1906    phrase(set_cookie(SetCookie), ValueChars).
 1907parse_header_value(host, ValueChars, Host) :-
 1908    (   append(HostChars, [0':|PortChars], ValueChars),
 1909        catch(number_codes(Port, PortChars), _, fail)
 1910    ->  atom_codes(HostName, HostChars),
 1911        Host = HostName:Port
 1912    ;   atom_codes(Host, ValueChars)
 1913    ).
 1914parse_header_value(range, ValueChars, Range) :-
 1915    phrase(range(Range), ValueChars).
 1916parse_header_value(accept, ValueChars, Media) :-
 1917    parse_accept(ValueChars, Media).
 1918parse_header_value(content_disposition, ValueChars, Disposition) :-
 1919    phrase(content_disposition(Disposition), ValueChars).
 1920parse_header_value(content_type, ValueChars, Type) :-
 1921    phrase(parse_content_type(Type), ValueChars).
 1922
 1923%!  field_value(+Name, +Value)//
 1924
 1925field_value(_, set_cookie(Name, Value, Options)) -->
 1926    !,
 1927    atom(Name), "=", atom(Value),
 1928    value_options(Options, cookie).
 1929field_value(_, disposition(Disposition, Options)) -->
 1930    !,
 1931    atom(Disposition), value_options(Options, disposition).
 1932field_value(www_authenticate, Auth) -->
 1933    auth_field_value(Auth).
 1934field_value(_, Atomic) -->
 1935    atom(Atomic).
 1936
 1937%!  auth_field_value(+AuthValue)//
 1938%
 1939%   Emit the authentication requirements (WWW-Authenticate field).
 1940
 1941auth_field_value(negotiate(Data)) -->
 1942    "Negotiate ",
 1943    { base64(Data, DataBase64),
 1944      atom_codes(DataBase64, Codes)
 1945    },
 1946    string(Codes).
 1947auth_field_value(negotiate) -->
 1948    "Negotiate".
 1949auth_field_value(basic) -->
 1950    !,
 1951    "Basic".
 1952auth_field_value(basic(Realm)) -->
 1953    "Basic Realm=\"", atom(Realm), "\"".
 1954auth_field_value(digest) -->
 1955    !,
 1956    "Digest".
 1957auth_field_value(digest(Details)) -->
 1958    "Digest ", atom(Details).
 1959
 1960%!  value_options(+List, +Field)//
 1961%
 1962%   Emit field parameters such as =|; charset=UTF-8|=.  There
 1963%   are three versions: a plain _key_ (`secure`), _token_ values
 1964%   and _quoted string_ values.  Seems we cannot deduce that from
 1965%   the actual value.
 1966
 1967value_options([], _) --> [].
 1968value_options([H|T], Field) -->
 1969    "; ", value_option(H, Field),
 1970    value_options(T, Field).
 1971
 1972value_option(secure=true, cookie) -->
 1973    !,
 1974    "secure".
 1975value_option(Name=Value, Type) -->
 1976    { string_option(Name, Type) },
 1977    !,
 1978    atom(Name), "=",
 1979    qstring(Value).
 1980value_option(Name=Value, Type) -->
 1981    { token_option(Name, Type) },
 1982    !,
 1983    atom(Name), "=", atom(Value).
 1984value_option(Name=Value, _Type) -->
 1985    atom(Name), "=",
 1986    option_value(Value).
 1987
 1988string_option(filename, disposition).
 1989
 1990token_option(path, cookie).
 1991
 1992option_value(Value) -->
 1993    { number(Value) },
 1994    !,
 1995    number(Value).
 1996option_value(Value) -->
 1997    { (   atom(Value)
 1998      ->  true
 1999      ;   string(Value)
 2000      ),
 2001      forall(string_code(_, Value, C),
 2002             token_char(C))
 2003    },
 2004    !,
 2005    atom(Value).
 2006option_value(Atomic) -->
 2007    qstring(Atomic).
 2008
 2009qstring(Atomic) -->
 2010    { string_codes(Atomic, Codes) },
 2011    "\"",
 2012    qstring_codes(Codes),
 2013    "\"".
 2014
 2015qstring_codes([]) --> [].
 2016qstring_codes([H|T]) --> qstring_code(H), qstring_codes(T).
 2017
 2018qstring_code(C) --> {qstring_esc(C)}, !, "\\", [C].
 2019qstring_code(C) --> [C].
 2020
 2021qstring_esc(0'").
 2022qstring_esc(C) :- ctl(C).
 2023
 2024
 2025                 /*******************************
 2026                 *        ACCEPT HEADERS        *
 2027                 *******************************/
 2028
 2029:- dynamic accept_cache/2. 2030:- volatile accept_cache/2. 2031
 2032parse_accept(Codes, Media) :-
 2033    atom_codes(Atom, Codes),
 2034    (   accept_cache(Atom, Media0)
 2035    ->  Media = Media0
 2036    ;   phrase(accept(Media0), Codes),
 2037        keysort(Media0, Media1),
 2038        pairs_values(Media1, Media2),
 2039        assertz(accept_cache(Atom, Media2)),
 2040        Media = Media2
 2041    ).
 2042
 2043%!  accept(-Media)// is semidet.
 2044%
 2045%   Parse an HTTP Accept: header
 2046
 2047accept([H|T]) -->
 2048    blanks,
 2049    media_range(H),
 2050    blanks,
 2051    (   ","
 2052    ->  accept(T)
 2053    ;   {T=[]}
 2054    ).
 2055
 2056media_range(s(SortQuality,Spec)-media(Type, TypeParams, Quality, AcceptExts)) -->
 2057    media_type(Type),
 2058    blanks,
 2059    (   ";"
 2060    ->  blanks,
 2061        parameters_and_quality(TypeParams, Quality, AcceptExts)
 2062    ;   { TypeParams = [],
 2063          Quality = 1.0,
 2064          AcceptExts = []
 2065        }
 2066    ),
 2067    { SortQuality is float(-Quality),
 2068      rank_specialised(Type, TypeParams, Spec)
 2069    }.
 2070
 2071
 2072%!  content_disposition(-Disposition)//
 2073%
 2074%   Parse Content-Disposition value
 2075
 2076content_disposition(disposition(Disposition, Options)) -->
 2077    token(Disposition), blanks,
 2078    value_parameters(Options).
 2079
 2080%!  parse_content_type(-Type)//
 2081%
 2082%   Parse  Content-Type  value  into    a  term  media(Type/SubType,
 2083%   Parameters).
 2084
 2085parse_content_type(media(Type, Parameters)) -->
 2086    media_type(Type), blanks,
 2087    value_parameters(Parameters).
 2088
 2089
 2090%!  rank_specialised(+Type, +TypeParam, -Key) is det.
 2091%
 2092%   Although the specification linked  above   is  unclear, it seems
 2093%   that  more  specialised  types  must   be  preferred  over  less
 2094%   specialized ones.
 2095%
 2096%   @tbd    Is there an official specification of this?
 2097
 2098rank_specialised(Type/SubType, TypeParams, v(VT, VS, SortVP)) :-
 2099    var_or_given(Type, VT),
 2100    var_or_given(SubType, VS),
 2101    length(TypeParams, VP),
 2102    SortVP is -VP.
 2103
 2104var_or_given(V, Val) :-
 2105    (   var(V)
 2106    ->  Val = 0
 2107    ;   Val = -1
 2108    ).
 2109
 2110media_type(Type/SubType) -->
 2111    type(Type), "/", type(SubType).
 2112
 2113type(_) -->
 2114    "*",
 2115    !.
 2116type(Type) -->
 2117    token(Type).
 2118
 2119parameters_and_quality(Params, Quality, AcceptExts) -->
 2120    token(Name),
 2121    blanks, "=", blanks,
 2122    (   { Name == q }
 2123    ->  float(Quality), blanks,
 2124        value_parameters(AcceptExts),
 2125        { Params = [] }
 2126    ;   { Params = [Name=Value|T] },
 2127        parameter_value(Value),
 2128        blanks,
 2129        (   ";"
 2130        ->  blanks,
 2131            parameters_and_quality(T, Quality, AcceptExts)
 2132        ;   { T = [],
 2133              Quality = 1.0,
 2134              AcceptExts = []
 2135            }
 2136        )
 2137    ).
 2138
 2139%!  value_parameters(-Params:list) is det.
 2140%
 2141%   Accept (";" <parameter>)*, returning a list of Name=Value, where
 2142%   both Name and Value are atoms.
 2143
 2144value_parameters([H|T]) -->
 2145    ";",
 2146    !,
 2147    blanks, token(Name), blanks,
 2148    (   "="
 2149    ->  blanks,
 2150        (   token(Value)
 2151        ->  []
 2152        ;   quoted_string(Value)
 2153        ),
 2154        { H = (Name=Value) }
 2155    ;   { H = Name }
 2156    ),
 2157    blanks,
 2158    value_parameters(T).
 2159value_parameters([]) -->
 2160    [].
 2161
 2162parameter_value(Value) --> token(Value), !.
 2163parameter_value(Value) --> quoted_string(Value).
 2164
 2165
 2166%!  token(-Name)// is semidet.
 2167%
 2168%   Process an HTTP header token from the input.
 2169
 2170token(Name) -->
 2171    token_char(C1),
 2172    token_chars(Cs),
 2173    { atom_codes(Name, [C1|Cs]) }.
 2174
 2175token_chars([H|T]) -->
 2176    token_char(H),
 2177    !,
 2178    token_chars(T).
 2179token_chars([]) --> [].
 2180
 2181token_char(C) :-
 2182    \+ ctl(C),
 2183    \+ separator_code(C).
 2184
 2185ctl(C) :- between(0,31,C), !.
 2186ctl(127).
 2187
 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']).
 2201separator_code(0'?).
 2202separator_code(0'=).
 2203separator_code(0'{).
 2204separator_code(0'}).
 2205separator_code(0'\s).
 2206separator_code(0'\t).
 2207
 2208term_expansion(token_char(x) --> [x], Clauses) :-
 2209    findall((token_char(C)-->[C]),
 2210            (   between(0, 255, C),
 2211                token_char(C)
 2212            ),
 2213            Clauses).
 2214
 2215token_char(x) --> [x].
 2216
 2217%!  quoted_string(-Text)// is semidet.
 2218%
 2219%   True if input starts with a quoted string representing Text.
 2220
 2221quoted_string(Text) -->
 2222    "\"",
 2223    quoted_text(Codes),
 2224    { atom_codes(Text, Codes) }.
 2225
 2226quoted_text([]) -->
 2227    "\"",
 2228    !.
 2229quoted_text([H|T]) -->
 2230    "\\", !, [H],
 2231    quoted_text(T).
 2232quoted_text([H|T]) -->
 2233    [H],
 2234    !,
 2235    quoted_text(T).
 2236
 2237
 2238%!  header_fields(+Fields, ?ContentLength)// is det.
 2239%
 2240%   Process a sequence of  [Name(Value),   ...]  attributes  for the
 2241%   header. A term content_length(Len) is   special. If instantiated
 2242%   it emits the header. If not   it just unifies ContentLength with
 2243%   the argument of the content_length(Len)   term.  This allows for
 2244%   both sending and retrieving the content-length.
 2245
 2246header_fields([], _) --> [].
 2247header_fields([content_length(CLen)|T], CLen) -->
 2248    !,
 2249    (   { var(CLen) }
 2250    ->  ""
 2251    ;   header_field(content_length, CLen)
 2252    ),
 2253    header_fields(T, CLen).           % Continue or return first only?
 2254header_fields([status(_)|T], CLen) -->   % handled by vstatus//3.
 2255    !,
 2256    header_fields(T, CLen).
 2257header_fields([H|T], CLen) -->
 2258    { H =.. [Name, Value] },
 2259    header_field(Name, Value),
 2260    header_fields(T, CLen).
 2261
 2262
 2263%!  field_name(?PrologName)
 2264%
 2265%   Convert between prolog_name  and  HttpName.   Field  names  are,
 2266%   according to RFC 2616, considered  tokens   and  covered  by the
 2267%   following definition:
 2268%
 2269%   ==
 2270%   token          = 1*<any CHAR except CTLs or separators>
 2271%   separators     = "(" | ")" | "<" | ">" | "@"
 2272%                  | "," | ";" | ":" | "\" | <">
 2273%                  | "/" | "[" | "]" | "?" | "="
 2274%                  | "{" | "}" | SP | HT
 2275%   ==
 2276
 2277:- public
 2278    field_name//1. 2279
 2280field_name(Name) -->
 2281    { var(Name) },
 2282    !,
 2283    rd_field_chars(Chars),
 2284    { atom_codes(Name, Chars) }.
 2285field_name(mime_version) -->
 2286    !,
 2287    "MIME-Version".
 2288field_name(www_authenticate) -->
 2289    !,
 2290    "WWW-Authenticate".
 2291field_name(Name) -->
 2292    { atom_codes(Name, Chars) },
 2293    wr_field_chars(Chars).
 2294
 2295rd_field_chars_no_fold([C|T]) -->
 2296    [C],
 2297    { rd_field_char(C, _) },
 2298    !,
 2299    rd_field_chars_no_fold(T).
 2300rd_field_chars_no_fold([]) -->
 2301    [].
 2302
 2303rd_field_chars([C0|T]) -->
 2304    [C],
 2305    { rd_field_char(C, C0) },
 2306    !,
 2307    rd_field_chars(T).
 2308rd_field_chars([]) -->
 2309    [].
 2310
 2311%!  separators(-CharCodes) is det.
 2312%
 2313%   CharCodes is a list of separators according to RFC2616
 2314
 2315separators("()<>@,;:\\\"/[]?={} \t").
 2316
 2317term_expansion(rd_field_char('expand me',_), Clauses) :-
 2318
 2319    Clauses = [ rd_field_char(0'-, 0'_)
 2320              | Cls
 2321              ],
 2322    separators(SepString),
 2323    string_codes(SepString, Seps),
 2324    findall(rd_field_char(In, Out),
 2325            (   between(32, 127, In),
 2326                \+ memberchk(In, Seps),
 2327                In \== 0'-,         % 0'
 2328                code_type(Out, to_lower(In))),
 2329            Cls).
 2330
 2331rd_field_char('expand me', _).                  % avoid recursion
 2332
 2333wr_field_chars([C|T]) -->
 2334    !,
 2335    { code_type(C, to_lower(U)) },
 2336    [U],
 2337    wr_field_chars2(T).
 2338wr_field_chars([]) -->
 2339    [].
 2340
 2341wr_field_chars2([]) --> [].
 2342wr_field_chars2([C|T]) -->              % 0'
 2343    (   { C == 0'_ }
 2344    ->  "-",
 2345        wr_field_chars(T)
 2346    ;   [C],
 2347        wr_field_chars2(T)
 2348    ).
 2349
 2350%!  now//
 2351%
 2352%   Current time using rfc_date//1.
 2353
 2354now -->
 2355    { get_time(Time)
 2356    },
 2357    rfc_date(Time).
 2358
 2359%!  rfc_date(+Time)// is det.
 2360%
 2361%   Write time according to RFC1123 specification as required by the
 2362%   RFC2616 HTTP protocol specs.
 2363
 2364rfc_date(Time, String, Tail) :-
 2365    stamp_date_time(Time, Date, 'UTC'),
 2366    format_time(codes(String, Tail),
 2367                '%a, %d %b %Y %T GMT',
 2368                Date, posix).
 2369
 2370%!  http_timestamp(+Time:timestamp, -Text:atom) is det.
 2371%
 2372%   Generate a description of a Time in HTTP format (RFC1123)
 2373
 2374http_timestamp(Time, Atom) :-
 2375    stamp_date_time(Time, Date, 'UTC'),
 2376    format_time(atom(Atom),
 2377                '%a, %d %b %Y %T GMT',
 2378                Date, posix).
 2379
 2380
 2381                 /*******************************
 2382                 *         REQUEST DCG          *
 2383                 *******************************/
 2384
 2385request(Fd, [method(Method),request_uri(ReqURI)|Header]) -->
 2386    method(Method),
 2387    blanks,
 2388    nonblanks(Query),
 2389    { atom_codes(ReqURI, Query),
 2390      request_uri_parts(ReqURI, Header, Rest)
 2391    },
 2392    request_header(Fd, Rest),
 2393    !.
 2394request(Fd, [unknown(What)|Header]) -->
 2395    string(What),
 2396    eos,
 2397    !,
 2398    {   http_read_header(Fd, Header)
 2399    ->  true
 2400    ;   Header = []
 2401    }.
 2402
 2403method(get)     --> "GET", !.
 2404method(put)     --> "PUT", !.
 2405method(head)    --> "HEAD", !.
 2406method(post)    --> "POST", !.
 2407method(delete)  --> "DELETE", !.
 2408method(patch)   --> "PATCH", !.
 2409method(options) --> "OPTIONS", !.
 2410method(trace)   --> "TRACE", !.
 2411
 2412%!  request_uri_parts(+RequestURI, -Parts, ?Tail) is det.
 2413%
 2414%   Process the request-uri, producing the following parts:
 2415%
 2416%     * path(-Path)
 2417%     Decode path information (always present)
 2418%     * search(-QueryParams)
 2419%     Present if there is a ?name=value&... part of the request uri.
 2420%     QueryParams is a Name=Value list.
 2421%     * fragment(-Fragment)
 2422%     Present if there is a #Fragment.
 2423
 2424request_uri_parts(ReqURI, [path(Path)|Parts], Rest) :-
 2425    uri_components(ReqURI, Components),
 2426    uri_data(path, Components, PathText),
 2427    uri_encoded(path, Path, PathText),
 2428    phrase(uri_parts(Components), Parts, Rest).
 2429
 2430uri_parts(Components) -->
 2431    uri_search(Components),
 2432    uri_fragment(Components).
 2433
 2434uri_search(Components) -->
 2435    { uri_data(search, Components, Search),
 2436      nonvar(Search),
 2437      catch(uri_query_components(Search, Query),
 2438            error(syntax_error(_),_),
 2439            fail)
 2440    },
 2441    !,
 2442    [ search(Query) ].
 2443uri_search(_) --> [].
 2444
 2445uri_fragment(Components) -->
 2446    { uri_data(fragment, Components, String),
 2447      nonvar(String),
 2448      !,
 2449      uri_encoded(fragment, Fragment, String)
 2450    },
 2451    [ fragment(Fragment) ].
 2452uri_fragment(_) --> [].
 2453
 2454%!  request_header(+In:stream, -Header:list) is det.
 2455%
 2456%   Read the remainder (after the request-uri)   of  the HTTP header
 2457%   and return it as a Name(Value) list.
 2458
 2459request_header(_, []) -->               % Old-style non-version header
 2460    blanks,
 2461    eos,
 2462    !.
 2463request_header(Fd, [http_version(Version)|Header]) -->
 2464    http_version(Version),
 2465    blanks,
 2466    eos,
 2467    !,
 2468    {   Version = 1-_
 2469    ->  http_read_header(Fd, Header)
 2470    ;   Header = []
 2471    }.
 2472
 2473http_version(Version) -->
 2474    blanks,
 2475    "HTTP/",
 2476    http_version_number(Version).
 2477
 2478http_version_number(Major-Minor) -->
 2479    integer(Major),
 2480    ".",
 2481    integer(Minor).
 2482
 2483
 2484                 /*******************************
 2485                 *            COOKIES           *
 2486                 *******************************/
 2487
 2488%!  cookies(-List)// is semidet.
 2489%
 2490%   Translate a cookie description into a list Name=Value.
 2491
 2492cookies([Name=Value|T]) -->
 2493    blanks,
 2494    cookie(Name, Value),
 2495    !,
 2496    blanks,
 2497    (   ";"
 2498    ->  cookies(T)
 2499    ;   { T = [] }
 2500    ).
 2501cookies(List) -->
 2502    string(Skipped),
 2503    ";",
 2504    !,
 2505    { print_message(warning, http(skipped_cookie(Skipped))) },
 2506    cookies(List).
 2507cookies([]) -->
 2508    blanks.
 2509
 2510cookie(Name, Value) -->
 2511    cookie_name(Name),
 2512    blanks, "=", blanks,
 2513    cookie_value(Value).
 2514
 2515cookie_name(Name) -->
 2516    { var(Name) },
 2517    !,
 2518    rd_field_chars_no_fold(Chars),
 2519    { atom_codes(Name, Chars) }.
 2520
 2521cookie_value(Value) -->
 2522    quoted_string(Value),
 2523    !.
 2524cookie_value(Value) -->
 2525    chars_to_semicolon_or_blank(Chars),
 2526    { atom_codes(Value, Chars)
 2527    }.
 2528
 2529chars_to_semicolon_or_blank([]), ";" -->
 2530    ";",
 2531    !.
 2532chars_to_semicolon_or_blank([]) -->
 2533    " ",
 2534    blanks,
 2535    eos,
 2536    !.
 2537chars_to_semicolon_or_blank([H|T]) -->
 2538    [H],
 2539    !,
 2540    chars_to_semicolon_or_blank(T).
 2541chars_to_semicolon_or_blank([]) -->
 2542    [].
 2543
 2544set_cookie(set_cookie(Name, Value, Options)) -->
 2545    ws,
 2546    cookie(Name, Value),
 2547    cookie_options(Options).
 2548
 2549cookie_options([H|T]) -->
 2550    ws,
 2551    ";",
 2552    ws,
 2553    cookie_option(H),
 2554    !,
 2555    cookie_options(T).
 2556cookie_options([]) -->
 2557    ws.
 2558
 2559ws --> " ", !, ws.
 2560ws --> [].
 2561
 2562
 2563%!  cookie_option(-Option)// is semidet.
 2564%
 2565%   True if input represents a valid  Cookie option. Officially, all
 2566%   cookie  options  use  the  syntax   <name>=<value>,  except  for
 2567%   =Secure= and =HttpOnly=.
 2568%
 2569%   @param  Option  Term of the form Name=Value
 2570%   @bug    Incorrectly accepts options without = for M$ compatibility.
 2571
 2572cookie_option(Name=Value) -->
 2573    rd_field_chars(NameChars), ws,
 2574    { atom_codes(Name, NameChars) },
 2575    (   "="
 2576    ->  ws,
 2577        chars_to_semicolon(ValueChars),
 2578        { atom_codes(Value, ValueChars)
 2579        }
 2580    ;   { Value = true }
 2581    ).
 2582
 2583chars_to_semicolon([H|T]) -->
 2584    [H],
 2585    { H \== 32, H \== 0'; },
 2586    !,
 2587    chars_to_semicolon(T).
 2588chars_to_semicolon([]), ";" -->
 2589    ws, ";",
 2590    !.
 2591chars_to_semicolon([H|T]) -->
 2592    [H],
 2593    chars_to_semicolon(T).
 2594chars_to_semicolon([]) -->
 2595    [].
 2596
 2597%!  range(-Range)// is semidet.
 2598%
 2599%   Process the range header value. Range is currently defined as:
 2600%
 2601%       * bytes(From, To)
 2602%       Where From is an integer and To is either an integer or
 2603%       the atom =end=.
 2604
 2605range(bytes(From, To)) -->
 2606    "bytes", whites, "=", whites, integer(From), "-",
 2607    (   integer(To)
 2608    ->  ""
 2609    ;   { To = end }
 2610    ).
 2611
 2612
 2613                 /*******************************
 2614                 *           REPLY DCG          *
 2615                 *******************************/
 2616
 2617%!  reply(+In, -Reply:list)// is semidet.
 2618%
 2619%   Process the first line of an HTTP   reply.  After that, read the
 2620%   remainder  of  the  header  and    parse  it.  After  successful
 2621%   completion, Reply contains the following fields, followed by the
 2622%   fields produced by http_read_header/2.
 2623%
 2624%       * http_version(Major-Minor)
 2625%       * status(Code, Status, Comment)
 2626%         `Code` is an integer between 100 and 599.
 2627%         `Status` is a Prolog internal name.
 2628%         `Comment` is the comment following the code
 2629%         as it appears in the reply's HTTP status line.
 2630%         @see status_number//2.
 2631
 2632reply(Fd, [http_version(HttpVersion), status(Code, Status, Comment)|Header]) -->
 2633    http_version(HttpVersion),
 2634    blanks,
 2635    (   status_number(Status, Code)
 2636    ->  []
 2637    ;   integer(Status)
 2638    ),
 2639    blanks,
 2640    string(CommentCodes),
 2641    blanks_to_nl,
 2642    !,
 2643    blanks,
 2644    { atom_codes(Comment, CommentCodes),
 2645      http_read_header(Fd, Header)
 2646    }.
 2647
 2648
 2649                 /*******************************
 2650                 *            READ HEADER       *
 2651                 *******************************/
 2652
 2653%!  http_read_header(+Fd, -Header) is det.
 2654%
 2655%   Read Name: Value lines from FD until an empty line is encountered.
 2656%   Field-name are converted to Prolog conventions (all lower, _ instead
 2657%   of -): Content-Type: text/html --> content_type(text/html)
 2658
 2659http_read_header(Fd, Header) :-
 2660    read_header_data(Fd, Text),
 2661    http_parse_header(Text, Header).
 2662
 2663read_header_data(Fd, Header) :-
 2664    read_line_to_codes(Fd, Header, Tail),
 2665    read_header_data(Header, Fd, Tail),
 2666    debug(http(header), 'Header = ~n~s~n', [Header]).
 2667
 2668read_header_data([0'\r,0'\n], _, _) :- !.
 2669read_header_data([0'\n], _, _) :- !.
 2670read_header_data([], _, _) :- !.
 2671read_header_data(_, Fd, Tail) :-
 2672    read_line_to_codes(Fd, Tail, NewTail),
 2673    read_header_data(Tail, Fd, NewTail).
 2674
 2675%!  http_parse_header(+Text:codes, -Header:list) is det.
 2676%
 2677%   Header is a list of Name(Value)-terms representing the structure
 2678%   of the HTTP header in Text.
 2679%
 2680%   @error domain_error(http_request_line, Line)
 2681
 2682http_parse_header(Text, Header) :-
 2683    phrase(header(Header), Text),
 2684    debug(http(header), 'Field: ~p', [Header]).
 2685
 2686header(List) -->
 2687    header_field(Name, Value),
 2688    !,
 2689    { mkfield(Name, Value, List, Tail)
 2690    },
 2691    blanks,
 2692    header(Tail).
 2693header([]) -->
 2694    blanks,
 2695    eos,
 2696    !.
 2697header(_) -->
 2698    string(S), blanks_to_nl,
 2699    !,
 2700    { string_codes(Line, S),
 2701      syntax_error(http_parameter(Line))
 2702    }.
 2703
 2704%!  address//
 2705%
 2706%   Emit the HTML for the server address on behalve of error and
 2707%   status messages (non-200 replies).  Default is
 2708%
 2709%       ==
 2710%       SWI-Prolog httpd at <hostname>
 2711%       ==
 2712%
 2713%   The address can be modified by   providing  a definition for the
 2714%   multifile predicate http:http_address//0.
 2715
 2716:- multifile
 2717    http:http_address//0. 2718
 2719address -->
 2720    http:http_address,
 2721    !.
 2722address -->
 2723    { gethostname(Host) },
 2724    html(address([ a(href('http://www.swi-prolog.org'), 'SWI-Prolog'),
 2725                   ' httpd at ', Host
 2726                 ])).
 2727
 2728mkfield(host, Host:Port, [host(Host),port(Port)|Tail], Tail) :- !.
 2729mkfield(Name, Value, [Att|Tail], Tail) :-
 2730    Att =.. [Name, Value].
 2731
 2732%!  http:http_address// is det.
 2733%
 2734%   HTML-rule that emits the location of  the HTTP server. This hook
 2735%   is called from address//0 to customise   the server address. The
 2736%   server address is emitted on non-200-ok replies.
 2737
 2738%!  http:status_page(+Status, +Context, -HTMLTokens) is semidet.
 2739%
 2740%   Hook called by http_status_reply/4  and http_status_reply/5 that
 2741%   allows for emitting custom error pages   for  the following HTTP
 2742%   page types:
 2743%
 2744%     - 201 - created(Location)
 2745%     - 301 - moved(To)
 2746%     - 302 - moved_temporary(To)
 2747%     - 303 - see_other(To)
 2748%     - 400 - bad_request(ErrorTerm)
 2749%     - 401 - authorise(AuthMethod)
 2750%     - 403 - forbidden(URL)
 2751%     - 404 - not_found(URL)
 2752%     - 405 - method_not_allowed(Method,URL)
 2753%     - 406 - not_acceptable(Why)
 2754%     - 500 - server_error(ErrorTerm)
 2755%     - 503 - unavailable(Why)
 2756%
 2757%   The hook is tried twice,  first   using  the  status term, e.g.,
 2758%   not_found(URL) and than with the code,   e.g.  `404`. The second
 2759%   call is deprecated and only exists for compatibility.
 2760%
 2761%   @arg    Context is the 4th argument of http_status_reply/5, which
 2762%           is invoked after raising an exception of the format
 2763%           http_reply(Status, HeaderExtra, Context).  The default
 2764%           context is `[]` (the empty list).
 2765%   @arg    HTMLTokens is a list of tokens as produced by html//1.
 2766%           It is passed to print_html/2.
 2767
 2768
 2769                 /*******************************
 2770                 *            MESSAGES          *
 2771                 *******************************/
 2772
 2773:- multifile
 2774    prolog:message//1,
 2775    prolog:error_message//1. 2776
 2777prolog:error_message(http_write_short(Data, Sent)) -->
 2778    data(Data),
 2779    [ ': remote hangup after ~D bytes'-[Sent] ].
 2780prolog:error_message(syntax_error(http_request(Request))) -->
 2781    [ 'Illegal HTTP request: ~s'-[Request] ].
 2782prolog:error_message(syntax_error(http_parameter(Line))) -->
 2783    [ 'Illegal HTTP parameter: ~s'-[Line] ].
 2784
 2785prolog:message(http(skipped_cookie(S))) -->
 2786    [ 'Skipped illegal cookie: ~s'-[S] ].
 2787
 2788data(bytes(MimeType, _Bytes)) -->
 2789    !,
 2790    [ 'bytes(~p, ...)'-[MimeType] ].
 2791data(Data) -->
 2792    [ '~p'-[Data] ]