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_cp,
   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(library(http/html_write),
   64	    [ print_html/2, print_html/1, page/4, html/3,
   65	      html_print_length/2
   66	    ]).   67:- autoload(library(http/http_exception),[map_exception_to_http_status/4]).   68:- autoload(library(http/mimepack),[mime_pack/3]).   69:- autoload(library(http/mimetype),[file_mime_type/2]).   70:- autoload(library(apply),[maplist/2]).   71:- autoload(library(base64),[base64/2]).   72:- autoload(library(debug),[debug/3,debugging/1]).   73:- autoload(library(error),[syntax_error/1,domain_error/2]).   74:- autoload(library(lists),[append/3,member/2,select/3,delete/3]).   75:- autoload(library(memfile),
   76	    [ new_memory_file/1, open_memory_file/3,
   77	      free_memory_file/1, open_memory_file/4,
   78	      size_memory_file/3
   79	    ]).   80:- autoload(library(option),[option/3,option/2]).   81:- autoload(library(pairs),[pairs_values/2]).   82:- autoload(library(readutil),
   83	    [read_line_to_codes/2,read_line_to_codes/3]).   84:- autoload(library(sgml_write),[xml_write/3]).   85:- autoload(library(socket),[gethostname/1]).   86:- autoload(library(uri),
   87	    [ uri_components/2, uri_data/3, uri_encoded/3, uri_query_components/2
   88	    ]).   89:- autoload(library(url),[parse_url_search/2]).   90:- autoload(library(dcg/basics),
   91	    [ integer/3, atom/3, whites/2, blanks_to_nl/2, string/3,
   92	      number/3, blanks/2, float/3, nonblanks/3, eos/2
   93	    ]).   94:- use_module(library(settings),[setting/4,setting/2]).   95
   96:- use_module(library(media_type), []).   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
  104% see http_update_transfer/4.
  105
  106:- setting(http:chunked_transfer, oneof([never,on_request,if_possible]),
  107           on_request, 'When to use Transfer-Encoding: Chunked').

Handling HTTP headers

The library library(http/http_header) provides primitives for parsing and composing HTTP headers. Its functionality is normally hidden by the other parts of the HTTP server and client libraries. */

  117:- discontiguous
  118    term_expansion/2.  119
  120
  121                 /*******************************
  122                 *          READ REQUEST        *
  123                 *******************************/
 http_read_request(+FdIn:istream, -Request) is det
Read an HTTP request-header from FdIn and return the broken-down request fields as +Name(+Value) pairs in a list. Request is unified to end_of_file if FdIn is at the end of input.
  131http_read_request(In, Request) :-
  132    catch(read_line_to_codes(In, Codes), E, true),
  133    (   var(E)
  134    ->  (   Codes == end_of_file
  135        ->  debug(http(header), 'end-of-file', []),
  136            Request = end_of_file
  137        ;   debug(http(header), 'First line: ~s', [Codes]),
  138            Request =  [input(In)|Request1],
  139            phrase(request(In, Request1), Codes),
  140            (   Request1 = [unknown(Text)|_]
  141            ->  string_codes(S, Text),
  142                syntax_error(http_request(S))
  143            ;   true
  144            )
  145        )
  146    ;   (   debugging(http(request))
  147        ->  message_to_string(E, Msg),
  148            debug(http(request), "Exception reading 1st line: ~s", [Msg])
  149        ;   true
  150        ),
  151        Request = end_of_file
  152    ).
 http_read_reply_header(+FdIn, -Reply)
Read the HTTP reply header. Throws an exception if the current input does not contain a valid reply header.
  160http_read_reply_header(In, [input(In)|Reply]) :-
  161    read_line_to_codes(In, Codes),
  162    (   Codes == end_of_file
  163    ->  debug(http(header), 'end-of-file', []),
  164        throw(error(syntax(http_reply_header, end_of_file), _))
  165    ;   debug(http(header), 'First line: ~s~n', [Codes]),
  166        (   phrase(reply(In, Reply), Codes)
  167        ->  true
  168        ;   atom_codes(Header, Codes),
  169            syntax_error(http_reply_header(Header))
  170        )
  171    ).
  172
  173
  174                 /*******************************
  175                 *        FORMULATE REPLY       *
  176                 *******************************/
 http_reply(+Data, +Out:ostream) is det
 http_reply(+Data, +Out:ostream, +HdrExtra) is det
 http_reply(+Data, +Out:ostream, +HdrExtra, -Code) is det
 http_reply(+Data, +Out:ostream, +HdrExtra, +Context, -Code) is det
 http_reply(+Data, +Out:ostream, +HdrExtra, +Context, +Request, -Code) is det
Compose a complete HTTP reply from the term Data using additional headers from HdrExtra to the output stream Out. ExtraHeader is a list of Field(Value). Data is one of:
html(HTML)
HTML tokens as produced by html//1 from html_write.pl
file(+MimeType, +FileName)
Reply content of FileName using MimeType
file(+MimeType, +FileName, +Range)
Reply partial content of FileName with given MimeType
tmp_file(+MimeType, +FileName)
Same as file, but do not include modification time
bytes(+MimeType, +Bytes)
Send a sequence of Bytes with the indicated MimeType. Bytes is either a string of character codes 0..255 or list of integers in the range 0..255. Out-of-bound codes result in a representation error exception.
stream(+In, +Len)
Reply content of stream.
cgi_stream(+In, +Len)
Reply content of stream, which should start with an HTTP header, followed by a blank line. This is the typical output from a CGI script.
Status
HTTP status report as defined by http_status_reply/4.
Arguments:
HdrExtra- provides additional reply-header fields, encoded as Name(Value). It can also contain a field content_length(-Len) to retrieve the value of the Content-length header that is replied.
Code- is the numeric HTTP status code sent
To be done
- Complete documentation
  225http_reply(What, Out) :-
  226    http_reply(What, Out, [connection(close)], _).
  227
  228http_reply(Data, Out, HdrExtra) :-
  229    http_reply(Data, Out, HdrExtra, _Code).
  230
  231http_reply(Data, Out, HdrExtra, Code) :-
  232    http_reply(Data, Out, HdrExtra, [], Code).
  233
  234http_reply(Data, Out, HdrExtra, Context, Code) :-
  235    http_reply(Data, Out, HdrExtra, Context, [method(get)], Code).
  236
  237http_reply(Data, Out, HdrExtra, _Context, Request, Code) :-
  238    byte_count(Out, C0),
  239    memberchk(method(Method), Request),
  240    catch(http_reply_data(Data, Out, HdrExtra, Method, Code), E, true),
  241    !,
  242    (   var(E)
  243    ->  true
  244    ;   (   E = error(io_error(write,_), _)
  245        ;   E = error(socket_error(_,_), _)
  246        )
  247    ->  byte_count(Out, C1),
  248        Sent is C1 - C0,
  249        throw(error(http_write_short(Data, Sent), _))
  250    ;   E = error(timeout_error(write, _), _)
  251    ->  throw(E)
  252    ;   map_exception_to_http_status(E, Status, NewHdr, NewContext),
  253        http_status_reply(Status, Out, NewHdr, NewContext, Request, Code)
  254    ).
  255http_reply(Status, Out, HdrExtra, Context, Request, Code) :-
  256    http_status_reply(Status, Out, HdrExtra, Context, Request, Code).
  257
  258:- meta_predicate
  259    if_no_head(0, +).
 http_reply_data(+Data, +Out, +HdrExtra, +Method, -Code) is semidet
Fails if Data is not a defined reply-data format, but a status term. See http_reply/3 and http_status_reply/6.
Errors
- Various I/O errors.
  268http_reply_data(Data, Out, HdrExtra, Method, Code) :-
  269    http_reply_data_(Data, Out, HdrExtra, Method, Code),
  270    flush_output(Out).
  271
  272http_reply_data_(html(HTML), Out, HdrExtra, Method, Code) :-
  273    !,
  274    phrase(reply_header(html(HTML), HdrExtra, Code), Header),
  275    debug(http(send_reply), "< ~s", [Header]),
  276    format(Out, '~s', [Header]),
  277    if_no_head(print_html(Out, HTML), Method).
  278http_reply_data_(file(Type, File), Out, HdrExtra, Method, Code) :-
  279    !,
  280    phrase(reply_header(file(Type, File), HdrExtra, Code), Header),
  281    reply_file(Out, File, Header, Method).
  282http_reply_data_(gzip_file(Type, File), Out, HdrExtra, Method, Code) :-
  283    !,
  284    phrase(reply_header(gzip_file(Type, File), HdrExtra, Code), Header),
  285    reply_file(Out, File, Header, Method).
  286http_reply_data_(file(Type, File, Range), Out, HdrExtra, Method, Code) :-
  287    !,
  288    phrase(reply_header(file(Type, File, Range), HdrExtra, Code), Header),
  289    reply_file_range(Out, File, Header, Range, Method).
  290http_reply_data_(tmp_file(Type, File), Out, HdrExtra, Method, Code) :-
  291    !,
  292    phrase(reply_header(tmp_file(Type, File), HdrExtra, Code), Header),
  293    reply_file(Out, File, Header, Method).
  294http_reply_data_(bytes(Type, Bytes), Out, HdrExtra, Method, Code) :-
  295    !,
  296    phrase(reply_header(bytes(Type, Bytes), HdrExtra, Code), Header),
  297    debug(http(send_reply), "< ~s", [Header]),
  298    format(Out, '~s', [Header]),
  299    if_no_head(format(Out, '~s', [Bytes]), Method).
  300http_reply_data_(stream(In, Len), Out, HdrExtra, Method, Code) :-
  301    !,
  302    phrase(reply_header(cgi_data(Len), HdrExtra, Code), Header),
  303    copy_stream(Out, In, Header, Method, 0, end).
  304http_reply_data_(cgi_stream(In, Len), Out, HdrExtra, Method, Code) :-
  305    !,
  306    http_read_header(In, CgiHeader),
  307    seek(In, 0, current, Pos),
  308    Size is Len - Pos,
  309    http_join_headers(HdrExtra, CgiHeader, Hdr2),
  310    phrase(reply_header(cgi_data(Size), Hdr2, Code), Header),
  311    copy_stream(Out, In, Header, Method, 0, end).
  312
  313if_no_head(_, head) :-
  314    !.
  315if_no_head(Goal, _) :-
  316    call(Goal).
  317
  318reply_file(Out, _File, Header, head) :-
  319    !,
  320    debug(http(send_reply), "< ~s", [Header]),
  321    format(Out, '~s', [Header]).
  322reply_file(Out, File, Header, _) :-
  323    setup_call_cleanup(
  324        open(File, read, In, [type(binary)]),
  325        copy_stream(Out, In, Header, 0, end),
  326        close(In)).
  327
  328reply_file_range(Out, _File, Header, _Range, head) :-
  329    !,
  330    debug(http(send_reply), "< ~s", [Header]),
  331    format(Out, '~s', [Header]).
  332reply_file_range(Out, File, Header, bytes(From, To), _) :-
  333    setup_call_cleanup(
  334        open(File, read, In, [type(binary)]),
  335        copy_stream(Out, In, Header, From, To),
  336        close(In)).
  337
  338copy_stream(Out, _, Header, head, _, _) :-
  339    !,
  340    debug(http(send_reply), "< ~s", [Header]),
  341    format(Out, '~s', [Header]).
  342copy_stream(Out, In, Header, _, From, To) :-
  343    copy_stream(Out, In, Header, From, To).
  344
  345copy_stream(Out, In, Header, From, To) :-
  346    (   From == 0
  347    ->  true
  348    ;   seek(In, From, bof, _)
  349    ),
  350    peek_byte(In, _),
  351    debug(http(send_reply), "< ~s", [Header]),
  352    format(Out, '~s', [Header]),
  353    (   To == end
  354    ->  copy_stream_data(In, Out)
  355    ;   Len is To - From,
  356        copy_stream_data(In, Out, Len)
  357    ).
 http_status_reply(+Status, +Out, +HdrExtra, -Code) is det
 http_status_reply(+Status, +Out, +HdrExtra, +Context, -Code) is det
 http_status_reply(+Status, +Out, +HdrExtra, +Context, +Request, -Code) is det
Emit HTML non-200 status reports. Such requests are always sent as UTF-8 documents.

Status can be one of the following:

authorise(Method)
Challenge authorization. Method is one of
  • basic(Realm)
  • digest(Digest)
authorise(basic,Realm)
Same as authorise(basic(Realm)). Deprecated.
bad_request(ErrorTerm)
busy
created(Location)
forbidden(Url)
moved(To)
moved_temporary(To)
no_content
not_acceptable(WhyHtml)
not_found(Path)
method_not_allowed(Method, Path)
not_modified
resource_error(ErrorTerm)
see_other(To)
switching_protocols(Goal, Options)
server_error(ErrorTerm)
unavailable(WhyHtml)
  391http_status_reply(Status, Out, Options) :-
  392    _{header:HdrExtra, context:Context, code:Code, method:Method} :< Options,
  393    http_status_reply(Status, Out, HdrExtra, Context, [method(Method)], Code).
  394
  395http_status_reply(Status, Out, HdrExtra, Code) :-
  396    http_status_reply(Status, Out, HdrExtra, [], Code).
  397
  398http_status_reply(Status, Out, HdrExtra, Context, Code) :-
  399    http_status_reply(Status, Out, HdrExtra, Context, [method(get)], Code).
  400
  401http_status_reply(Status, Out, HdrExtra, Context, Request, Code) :-
  402    option(method(Method), Request, get),
  403    parsed_accept(Request, Accept),
  404    status_reply_flush(Status, Out,
  405                       _{ context: Context,
  406                          method:  Method,
  407                          code:    Code,
  408                          accept:  Accept,
  409                          header:  HdrExtra
  410                        }).
  411
  412parsed_accept(Request, Accept) :-
  413    memberchk(accept(Accept0), Request),
  414    http_parse_header_value(accept, Accept0, Accept1),
  415    !,
  416    Accept = Accept1.
  417parsed_accept(_, [ media(text/html, [], 0.1,  []),
  418                   media(_,         [], 0.01, [])
  419                 ]).
  420
  421status_reply_flush(Status, Out, Options) :-
  422    status_reply(Status, Out, Options),
  423    !,
  424    flush_output(Out).
 status_reply(+Status, +Out, +Options:options)
Formulate a non-200 reply and send it to the stream Out. Options is a dict containing:
  437% Replies without content
  438status_reply(no_content, Out, Options) :-
  439    !,
  440    phrase(reply_header(status(no_content), Options), Header),
  441    debug(http(send_reply), "< ~s", [Header]),
  442    format(Out, '~s', [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    debug(http(send_reply), "< ~s", [Header]),
  453    format(Out, '~s', [Header]).
  454status_reply(authorise(basic, ''), Out, Options) :-
  455    !,
  456    status_reply(authorise(basic), Out, Options).
  457status_reply(authorise(basic, Realm), Out, Options) :-
  458    !,
  459    status_reply(authorise(basic(Realm)), Out, Options).
  460status_reply(not_modified, Out, Options) :-
  461    !,
  462    phrase(reply_header(status(not_modified), Options), Header),
  463    debug(http(send_reply), "< ~s", [Header]),
  464    format(Out, '~s', [Header]).
  465% aliases (compatibility)
  466status_reply(busy, Out, Options) :-
  467    status_reply(service_unavailable(busy), Out, Options).
  468status_reply(unavailable(Why), Out, Options) :-
  469    status_reply(service_unavailable(Why), Out, Options).
  470status_reply(resource_error(Why), Out, Options) :-
  471    status_reply(service_unavailable(Why), Out, Options).
  472% replies with content
  473status_reply(Status, Out, Options) :-
  474    status_has_content(Status),
  475    status_page_hook(Status, Reply, Options),
  476    serialize_body(Reply, Body),
  477    Status =.. List,
  478    append(List, [Body], ExList),
  479    ExStatus =.. ExList,
  480    phrase(reply_header(ExStatus, Options), Header),
  481    debug(http(send_reply), "< ~s", [Header]),
  482    format(Out, '~s', [Header]),
  483    reply_status_body(Out, Body, Options).
 status_has_content(+StatusTerm, -HTTPCode)
True when StatusTerm is a status that usually comes with an expanatory content message.
  490status_has_content(created(_Location)).
  491status_has_content(moved(_To)).
  492status_has_content(moved_temporary(_To)).
  493status_has_content(gone(_URL)).
  494status_has_content(see_other(_To)).
  495status_has_content(bad_request(_ErrorTerm)).
  496status_has_content(authorise(_Method)).
  497status_has_content(forbidden(_URL)).
  498status_has_content(not_found(_URL)).
  499status_has_content(method_not_allowed(_Method, _URL)).
  500status_has_content(not_acceptable(_Why)).
  501status_has_content(server_error(_ErrorTerm)).
  502status_has_content(service_unavailable(_Why)).
 serialize_body(+Reply, -Body) is det
Serialize the reply as returned by status_page_hook/3 into a term:
body(Type, Encoding, Content)
In this term, Type is the media type, Encoding is the required wire encoding and Content a string representing the content.
  513serialize_body(Reply, Body) :-
  514    http:serialize_reply(Reply, Body),
  515    !.
  516serialize_body(html_tokens(Tokens), body(text/html, utf8, Content)) :-
  517    !,
  518    with_output_to(string(Content), print_html(Tokens)).
  519serialize_body(Reply, Reply) :-
  520    Reply = body(_,_,_),
  521    !.
  522serialize_body(Reply, _) :-
  523    domain_error(http_reply_body, Reply).
  524
  525reply_status_body(_, _, Options) :-
  526    Options.method == head,
  527    !.
  528reply_status_body(Out, body(_Type, Encoding, Content), _Options) :-
  529    (   Encoding == octet
  530    ->  format(Out, '~s', [Content])
  531    ;   setup_call_cleanup(
  532            set_stream(Out, encoding(Encoding)),
  533            format(Out, '~s', [Content]),
  534            set_stream(Out, encoding(octet)))
  535    ).
 http:serialize_reply(+Reply, -Body) is semidet
Multifile hook to serialize the result of status_reply/3 into a term
body(Type, Encoding, Content)
In this term, Type is the media type, Encoding is the required wire encoding and Content a string representing the content.
 status_page_hook(+Term, -Reply, +Options) is det
Calls the following two hooks to generate an HTML page from a status reply.
http:status_reply(+Term, -Reply, +Options)
Provide non-HTML description of the (non-200) reply. The term Reply is handed to serialize_body/2, calling the hook serialize_reply/2.
http:status_page(+Term, +Context, -HTML)
http:status_page(+Code, +Context, -HTML)
Arguments:
Term- is the status term, e.g., not_found(URL)
See also
- status_page/3
  562status_page_hook(Term, Reply, Options) :-
  563    Context = Options.context,
  564    functor(Term, Name, _),
  565    status_number_fact(Name, Code),
  566    (   Options.code = Code,
  567        http:status_reply(Term, Reply, Options)
  568    ;   http:status_page(Term, Context, HTML),
  569        Reply = html_tokens(HTML)
  570    ;   http:status_page(Code, Context, HTML), % deprecated
  571        Reply = html_tokens(HTML)
  572    ),
  573    !.
  574status_page_hook(created(Location), html_tokens(HTML), _Options) :-
  575    phrase(page([ title('201 Created')
  576                ],
  577                [ h1('Created'),
  578                  p(['The document was created ',
  579                     a(href(Location), ' Here')
  580                    ]),
  581                  \address
  582                ]),
  583           HTML).
  584status_page_hook(moved(To), html_tokens(HTML), _Options) :-
  585    phrase(page([ title('301 Moved Permanently')
  586                ],
  587                [ h1('Moved Permanently'),
  588                  p(['The document has moved ',
  589                     a(href(To), ' Here')
  590                    ]),
  591                  \address
  592                ]),
  593           HTML).
  594status_page_hook(moved_temporary(To), html_tokens(HTML), _Options) :-
  595    phrase(page([ title('302 Moved Temporary')
  596                ],
  597                [ h1('Moved Temporary'),
  598                  p(['The document is currently ',
  599                     a(href(To), ' Here')
  600                    ]),
  601                  \address
  602                ]),
  603           HTML).
  604status_page_hook(gone(URL), html_tokens(HTML), _Options) :-
  605    phrase(page([ title('410 Resource Gone')
  606                ],
  607                [ h1('Resource Gone'),
  608                  p(['The document has been removed ',
  609                     a(href(URL), ' from here')
  610                    ]),
  611                  \address
  612                ]),
  613           HTML).
  614status_page_hook(see_other(To), html_tokens(HTML), _Options) :-
  615    phrase(page([ title('303 See Other')
  616                 ],
  617                 [ h1('See Other'),
  618                   p(['See other document ',
  619                      a(href(To), ' Here')
  620                     ]),
  621                   \address
  622                 ]),
  623            HTML).
  624status_page_hook(bad_request(ErrorTerm), html_tokens(HTML), _Options) :-
  625    '$messages':translate_message(ErrorTerm, Lines, []),
  626    phrase(page([ title('400 Bad Request')
  627                ],
  628                [ h1('Bad Request'),
  629                  p(\html_message_lines(Lines)),
  630                  \address
  631                ]),
  632           HTML).
  633status_page_hook(authorise(_Method), html_tokens(HTML), _Options):-
  634    phrase(page([ title('401 Authorization Required')
  635                ],
  636                [ h1('Authorization Required'),
  637                  p(['This server could not verify that you ',
  638                     'are authorized to access the document ',
  639                     'requested.  Either you supplied the wrong ',
  640                     'credentials (e.g., bad password), or your ',
  641                     'browser doesn\'t understand how to supply ',
  642                     'the credentials required.'
  643                    ]),
  644                  \address
  645                ]),
  646           HTML).
  647status_page_hook(forbidden(URL), html_tokens(HTML), _Options) :-
  648    phrase(page([ title('403 Forbidden')
  649                ],
  650                [ h1('Forbidden'),
  651                  p(['You don\'t have permission to access ', URL,
  652                     ' on this server'
  653                    ]),
  654                  \address
  655                ]),
  656           HTML).
  657status_page_hook(not_found(URL), html_tokens(HTML), _Options) :-
  658    phrase(page([ title('404 Not Found')
  659                ],
  660                [ h1('Not Found'),
  661                  p(['The requested URL ', tt(URL),
  662                     ' was not found on this server'
  663                    ]),
  664                  \address
  665                ]),
  666           HTML).
  667status_page_hook(method_not_allowed(Method,URL), html_tokens(HTML), _Options) :-
  668    upcase_atom(Method, UMethod),
  669    phrase(page([ title('405 Method not allowed')
  670                ],
  671                [ h1('Method not allowed'),
  672                  p(['The requested URL ', tt(URL),
  673                     ' does not support method ', tt(UMethod), '.'
  674                    ]),
  675                  \address
  676                ]),
  677           HTML).
  678status_page_hook(not_acceptable(WhyHTML), html_tokens(HTML), _Options) :-
  679    phrase(page([ title('406 Not Acceptable')
  680                ],
  681                [ h1('Not Acceptable'),
  682                  WhyHTML,
  683                  \address
  684                ]),
  685           HTML).
  686status_page_hook(server_error(ErrorTerm), html_tokens(HTML), _Options) :-
  687    '$messages':translate_message(ErrorTerm, Lines, []),
  688    phrase(page([ title('500 Internal server error')
  689                ],
  690                [ h1('Internal server error'),
  691                  p(\html_message_lines(Lines)),
  692                  \address
  693                ]),
  694           HTML).
  695status_page_hook(service_unavailable(Why), html_tokens(HTML), _Options) :-
  696    phrase(page([ title('503 Service Unavailable')
  697                ],
  698                [ h1('Service Unavailable'),
  699                  \unavailable(Why),
  700                  \address
  701                ]),
  702           HTML).
  703
  704unavailable(busy) -->
  705    html(p(['The server is temporarily out of resources, ',
  706            'please try again later'])).
  707unavailable(error(Formal,Context)) -->
  708    { '$messages':translate_message(error(Formal,Context), Lines, []) },
  709    html_message_lines(Lines).
  710unavailable(HTML) -->
  711    html(HTML).
  712
  713html_message_lines([]) -->
  714    [].
  715html_message_lines([nl|T]) -->
  716    !,
  717    html([br([])]),
  718    html_message_lines(T).
  719html_message_lines([flush]) -->
  720    [].
  721html_message_lines([Fmt-Args|T]) -->
  722    !,
  723    { format(string(S), Fmt, Args)
  724    },
  725    html([S]),
  726    html_message_lines(T).
  727html_message_lines([Fmt|T]) -->
  728    !,
  729    { format(string(S), Fmt, [])
  730    },
  731    html([S]),
  732    html_message_lines(T).
 http_join_headers(+Default, +Header, -Out)
Append headers from Default to Header if they are not already part of it.
  739http_join_headers([], H, H).
  740http_join_headers([H|T], Hdr0, Hdr) :-
  741    functor(H, N, A),
  742    functor(H2, N, A),
  743    member(H2, Hdr0),
  744    !,
  745    http_join_headers(T, Hdr0, Hdr).
  746http_join_headers([H|T], Hdr0, [H|Hdr]) :-
  747    http_join_headers(T, Hdr0, Hdr).
 http_update_encoding(+HeaderIn, -Encoding, -HeaderOut)
Allow for rewrite of the header, adjusting the encoding. We distinguish three options. If the user announces `text', we always use UTF-8 encoding. If the user announces charset=utf-8 we use UTF-8 and otherwise we use octet (raw) encoding. Alternatively we could dynamically choose for ASCII, ISO-Latin-1 or UTF-8.
  759http_update_encoding(Header0, utf8, [content_type(Type)|Header]) :-
  760    select(content_type(Type0), Header0, Header),
  761    sub_atom(Type0, 0, _, _, 'text/'),
  762    !,
  763    (   sub_atom(Type0, S, _, _, ';')
  764    ->  sub_atom(Type0, 0, S, _, B)
  765    ;   B = Type0
  766    ),
  767    atom_concat(B, '; charset=UTF-8', Type).
  768http_update_encoding(Header, Encoding, Header) :-
  769    memberchk(content_type(Type), Header),
  770    (   (   sub_atom(Type, _, _, _, 'UTF-8')
  771        ;   sub_atom(Type, _, _, _, 'utf-8')
  772        )
  773    ->  Encoding = utf8
  774    ;   media_type:media_type_encoding(media(Type,[]), Encoding)
  775    ).
  776http_update_encoding(Header, octet, Header).
 http_update_connection(+CGIHeader, +Request, -Connection, -Header)
Merge keep-alive information from Request and CGIHeader into Header.
  783http_update_connection(CgiHeader, Request, Connect,
  784                       [connection(Connect)|Rest]) :-
  785    select(connection(CgiConn), CgiHeader, Rest),
  786    !,
  787    connection(Request, ReqConnection),
  788    join_connection(ReqConnection, CgiConn, Connect).
  789http_update_connection(CgiHeader, Request, Connect,
  790                       [connection(Connect)|CgiHeader]) :-
  791    connection(Request, Connect).
  792
  793join_connection(Keep1, Keep2, Connection) :-
  794    (   downcase_atom(Keep1, 'keep-alive'),
  795        downcase_atom(Keep2, 'keep-alive')
  796    ->  Connection = 'Keep-Alive'
  797    ;   Connection = close
  798    ).
 connection(+Header, -Connection)
Extract the desired connection from a header.
  805connection(Header, Close) :-
  806    (   memberchk(connection(Connection), Header)
  807    ->  Close = Connection
  808    ;   memberchk(http_version(1-X), Header),
  809        X >= 1
  810    ->  Close = 'Keep-Alive'
  811    ;   Close = close
  812    ).
 http_update_transfer(+Request, +CGIHeader, -Transfer, -Header)
Decide on the transfer encoding from the Request and the CGI header. The behaviour depends on the setting http:chunked_transfer. If never, even explitic requests are ignored. If on_request, chunked encoding is used if requested through the CGI header and allowed by the client. If if_possible, chunked encoding is used whenever the client allows for it, which is interpreted as the client supporting HTTP 1.1 or higher.

Chunked encoding is more space efficient and allows the client to start processing partial results. The drawback is that errors lead to incomplete pages instead of a nicely formatted complete page.

  831http_update_transfer(Request, CgiHeader, Transfer, Header) :-
  832    setting(http:chunked_transfer, When),
  833    http_update_transfer(When, Request, CgiHeader, Transfer, Header).
  834
  835http_update_transfer(never, _, CgiHeader, none, Header) :-
  836    !,
  837    delete(CgiHeader, transfer_encoding(_), Header).
  838http_update_transfer(_, _, CgiHeader, none, Header) :-
  839    memberchk(location(_), CgiHeader),
  840    !,
  841    delete(CgiHeader, transfer_encoding(_), Header).
  842http_update_transfer(_, Request, CgiHeader, Transfer, Header) :-
  843    select(transfer_encoding(CgiTransfer), CgiHeader, Rest),
  844    !,
  845    transfer(Request, ReqConnection),
  846    join_transfer(ReqConnection, CgiTransfer, Transfer),
  847    (   Transfer == none
  848    ->  Header = Rest
  849    ;   Header = [transfer_encoding(Transfer)|Rest]
  850    ).
  851http_update_transfer(if_possible, Request, CgiHeader, Transfer, Header) :-
  852    transfer(Request, Transfer),
  853    Transfer \== none,
  854    !,
  855    Header = [transfer_encoding(Transfer)|CgiHeader].
  856http_update_transfer(_, _, CgiHeader, none, CgiHeader).
  857
  858join_transfer(chunked, chunked, chunked) :- !.
  859join_transfer(_, _, none).
 transfer(+Header, -Connection)
Extract the desired connection from a header.
  866transfer(Header, Transfer) :-
  867    (   memberchk(transfer_encoding(Transfer0), Header)
  868    ->  Transfer = Transfer0
  869    ;   memberchk(http_version(1-X), Header),
  870        X >= 1
  871    ->  Transfer = chunked
  872    ;   Transfer = none
  873    ).
 content_length_in_encoding(+Encoding, +In, -Bytes)
Determine hom many bytes are required to represent the data from stream In using the given encoding. Fails if the data cannot be represented with the given encoding.
  882content_length_in_encoding(Enc, Stream, Bytes) :-
  883    stream_property(Stream, position(Here)),
  884    setup_call_cleanup(
  885        open_null_stream(Out),
  886        ( set_stream(Out, encoding(Enc)),
  887          catch(copy_stream_data(Stream, Out), _, fail),
  888          flush_output(Out),
  889          byte_count(Out, Bytes)
  890        ),
  891        ( close(Out, [force(true)]),
  892          set_stream_position(Stream, Here)
  893        )).
  894
  895
  896                 /*******************************
  897                 *          POST SUPPORT        *
  898                 *******************************/
 http_post_data(+Data, +Out:ostream, +HdrExtra) is det
Send data on behalf on an HTTP POST request. This predicate is normally called by http_post/4 from http_client.pl to send the POST data to the server. Data is one of:
  991http_post_data(Data, Out, HdrExtra) :-
  992    http:post_data_hook(Data, Out, HdrExtra),
  993    !.
  994http_post_data(html(HTML), Out, HdrExtra) :-
  995    !,
  996    phrase(post_header(html(HTML), HdrExtra), Header),
  997    debug(http(send_request), "> ~s", [Header]),
  998    format(Out, '~s', [Header]),
  999    print_html(Out, HTML).
 1000http_post_data(xml(XML), Out, HdrExtra) :-
 1001    !,
 1002    http_post_data(xml(text/xml, XML, []), Out, HdrExtra).
 1003http_post_data(xml(Type, XML), Out, HdrExtra) :-
 1004    !,
 1005    http_post_data(xml(Type, XML, []), Out, HdrExtra).
 1006http_post_data(xml(Type, XML, Options), Out, HdrExtra) :-
 1007    !,
 1008    setup_call_cleanup(
 1009        new_memory_file(MemFile),
 1010        (   setup_call_cleanup(
 1011                open_memory_file(MemFile, write, MemOut),
 1012                xml_write(MemOut, XML, Options),
 1013                close(MemOut)),
 1014            http_post_data(memory_file(Type, MemFile), Out, HdrExtra)
 1015        ),
 1016        free_memory_file(MemFile)).
 1017http_post_data(file(File), Out, HdrExtra) :-
 1018    !,
 1019    (   file_mime_type(File, Type)
 1020    ->  true
 1021    ;   Type = text/plain
 1022    ),
 1023    http_post_data(file(Type, File), Out, HdrExtra).
 1024http_post_data(file(Type, File), Out, HdrExtra) :-
 1025    !,
 1026    phrase(post_header(file(Type, File), HdrExtra), Header),
 1027    debug(http(send_request), "> ~s", [Header]),
 1028    format(Out, '~s', [Header]),
 1029    setup_call_cleanup(
 1030        open(File, read, In, [type(binary)]),
 1031        copy_stream_data(In, Out),
 1032        close(In)).
 1033http_post_data(memory_file(Type, Handle), Out, HdrExtra) :-
 1034    !,
 1035    phrase(post_header(memory_file(Type, Handle), HdrExtra), Header),
 1036    debug(http(send_request), "> ~s", [Header]),
 1037    format(Out, '~s', [Header]),
 1038    setup_call_cleanup(
 1039        open_memory_file(Handle, read, In, [encoding(octet)]),
 1040        copy_stream_data(In, Out),
 1041        close(In)).
 1042http_post_data(codes(Codes), Out, HdrExtra) :-
 1043    !,
 1044    http_post_data(codes(text/plain, Codes), Out, HdrExtra).
 1045http_post_data(codes(Type, Codes), Out, HdrExtra) :-
 1046    !,
 1047    phrase(post_header(codes(Type, Codes), HdrExtra), Header),
 1048    debug(http(send_request), "> ~s", [Header]),
 1049    format(Out, '~s', [Header]),
 1050    setup_call_cleanup(
 1051        set_stream(Out, encoding(utf8)),
 1052        format(Out, '~s', [Codes]),
 1053        set_stream(Out, encoding(octet))).
 1054http_post_data(bytes(Type, Bytes), Out, HdrExtra) :-
 1055    !,
 1056    phrase(post_header(bytes(Type, Bytes), HdrExtra), Header),
 1057    debug(http(send_request), "> ~s", [Header]),
 1058    format(Out, '~s~s', [Header, Bytes]).
 1059http_post_data(atom(Atom), Out, HdrExtra) :-
 1060    !,
 1061    http_post_data(atom(text/plain, Atom), Out, HdrExtra).
 1062http_post_data(atom(Type, Atom), Out, HdrExtra) :-
 1063    !,
 1064    phrase(post_header(atom(Type, Atom), HdrExtra), Header),
 1065    debug(http(send_request), "> ~s", [Header]),
 1066    format(Out, '~s', [Header]),
 1067    setup_call_cleanup(
 1068        set_stream(Out, encoding(utf8)),
 1069        write(Out, Atom),
 1070        set_stream(Out, encoding(octet))).
 1071http_post_data(cgi_stream(In, _Len), Out, HdrExtra) :-
 1072    !,
 1073    debug(obsolete, 'Obsolete 2nd argument in cgi_stream(In,Len)', []),
 1074    http_post_data(cgi_stream(In), Out, HdrExtra).
 1075http_post_data(cgi_stream(In), Out, HdrExtra) :-
 1076    !,
 1077    http_read_header(In, Header0),
 1078    http_update_encoding(Header0, Encoding, Header),
 1079    content_length_in_encoding(Encoding, In, Size),
 1080    http_join_headers(HdrExtra, Header, Hdr2),
 1081    phrase(post_header(cgi_data(Size), Hdr2), HeaderText),
 1082    debug(http(send_request), "> ~s", [HeaderText]),
 1083    format(Out, '~s', [HeaderText]),
 1084    setup_call_cleanup(
 1085        set_stream(Out, encoding(Encoding)),
 1086        copy_stream_data(In, Out),
 1087        set_stream(Out, encoding(octet))).
 1088http_post_data(form(Fields), Out, HdrExtra) :-
 1089    !,
 1090    parse_url_search(Codes, Fields),
 1091    length(Codes, Size),
 1092    http_join_headers(HdrExtra,
 1093                      [ content_type('application/x-www-form-urlencoded')
 1094                      ], Header),
 1095    phrase(post_header(cgi_data(Size), Header), HeaderChars),
 1096    debug(http(send_request), "> ~s", [HeaderChars]),
 1097    format(Out, '~s', [HeaderChars]),
 1098    format(Out, '~s', [Codes]).
 1099http_post_data(form_data(Data), Out, HdrExtra) :-
 1100    !,
 1101    setup_call_cleanup(
 1102        new_memory_file(MemFile),
 1103        ( setup_call_cleanup(
 1104              open_memory_file(MemFile, write, MimeOut),
 1105              mime_pack(Data, MimeOut, Boundary),
 1106              close(MimeOut)),
 1107          size_memory_file(MemFile, Size, octet),
 1108          format(string(ContentType),
 1109                 'multipart/form-data; boundary=~w', [Boundary]),
 1110          http_join_headers(HdrExtra,
 1111                            [ mime_version('1.0'),
 1112                              content_type(ContentType)
 1113                            ], Header),
 1114          phrase(post_header(cgi_data(Size), Header), HeaderChars),
 1115          debug(http(send_request), "> ~s", [HeaderChars]),
 1116          format(Out, '~s', [HeaderChars]),
 1117          setup_call_cleanup(
 1118              open_memory_file(MemFile, read, In, [encoding(octet)]),
 1119              copy_stream_data(In, Out),
 1120              close(In))
 1121        ),
 1122        free_memory_file(MemFile)).
 1123http_post_data(List, Out, HdrExtra) :-          % multipart-mixed
 1124    is_list(List),
 1125    !,
 1126    setup_call_cleanup(
 1127        new_memory_file(MemFile),
 1128        ( setup_call_cleanup(
 1129              open_memory_file(MemFile, write, MimeOut),
 1130              mime_pack(List, MimeOut, Boundary),
 1131              close(MimeOut)),
 1132          size_memory_file(MemFile, Size, octet),
 1133          format(string(ContentType),
 1134                 'multipart/mixed; boundary=~w', [Boundary]),
 1135          http_join_headers(HdrExtra,
 1136                            [ mime_version('1.0'),
 1137                              content_type(ContentType)
 1138                            ], Header),
 1139          phrase(post_header(cgi_data(Size), Header), HeaderChars),
 1140          debug(http(send_request), "> ~s", [HeaderChars]),
 1141          format(Out, '~s', [HeaderChars]),
 1142          setup_call_cleanup(
 1143              open_memory_file(MemFile, read, In, [encoding(octet)]),
 1144              copy_stream_data(In, Out),
 1145              close(In))
 1146        ),
 1147        free_memory_file(MemFile)).
 post_header(+Data, +HeaderExtra)//
Generate the POST header, emitting HeaderExtra, followed by the HTTP Content-length and Content-type fields.
 1154post_header(html(Tokens), HdrExtra) -->
 1155    header_fields(HdrExtra, Len),
 1156    content_length(html(Tokens), Len),
 1157    content_type(text/html),
 1158    "\r\n".
 1159post_header(file(Type, File), HdrExtra) -->
 1160    header_fields(HdrExtra, Len),
 1161    content_length(file(File), Len),
 1162    content_type(Type),
 1163    "\r\n".
 1164post_header(memory_file(Type, File), HdrExtra) -->
 1165    header_fields(HdrExtra, Len),
 1166    content_length(memory_file(File), Len),
 1167    content_type(Type),
 1168    "\r\n".
 1169post_header(cgi_data(Size), HdrExtra) -->
 1170    header_fields(HdrExtra, Len),
 1171    content_length(Size, Len),
 1172    "\r\n".
 1173post_header(codes(Type, Codes), HdrExtra) -->
 1174    header_fields(HdrExtra, Len),
 1175    content_length(codes(Codes, utf8), Len),
 1176    content_type(Type, utf8),
 1177    "\r\n".
 1178post_header(bytes(Type, Bytes), HdrExtra) -->
 1179    header_fields(HdrExtra, Len),
 1180    content_length(bytes(Bytes), Len),
 1181    content_type(Type),
 1182    "\r\n".
 1183post_header(atom(Type, Atom), HdrExtra) -->
 1184    header_fields(HdrExtra, Len),
 1185    content_length(atom(Atom, utf8), Len),
 1186    content_type(Type, utf8),
 1187    "\r\n".
 1188
 1189
 1190                 /*******************************
 1191                 *       OUTPUT HEADER DCG      *
 1192                 *******************************/
 http_reply_header(+Out:ostream, +What, +HdrExtra) is det
Create a reply header using reply_header//3 and send it to Stream.
 1199http_reply_header(Out, What, HdrExtra) :-
 1200    phrase(reply_header(What, HdrExtra, _Code), String),
 1201    !,
 1202    debug(http(send_reply), "< ~s", [String]),
 1203    format(Out, '~s', [String]).
 reply_header(+Data, +HdrExtra, -Code)// is det
Grammar that realises the HTTP handler for sending Data. Data is a real data object as described with http_reply/2 or a not-200-ok HTTP status reply. The following status replies are defined.
See also
- http_status_reply/4 formulates the not-200-ok HTTP replies.
 1227reply_header(Data, Dict) -->
 1228    { _{header:HdrExtra, code:Code} :< Dict },
 1229    reply_header(Data, HdrExtra, Code).
 1230
 1231reply_header(string(String), HdrExtra, Code) -->
 1232    reply_header(string(text/plain, String), HdrExtra, Code).
 1233reply_header(string(Type, String), HdrExtra, Code) -->
 1234    vstatus(ok, Code, HdrExtra),
 1235    date(now),
 1236    header_fields(HdrExtra, CLen),
 1237    content_length(codes(String, utf8), CLen),
 1238    content_type(Type, utf8),
 1239    "\r\n".
 1240reply_header(bytes(Type, Bytes), HdrExtra, Code) -->
 1241    vstatus(ok, Code, HdrExtra),
 1242    date(now),
 1243    header_fields(HdrExtra, CLen),
 1244    content_length(bytes(Bytes), CLen),
 1245    content_type(Type),
 1246    "\r\n".
 1247reply_header(html(Tokens), HdrExtra, Code) -->
 1248    vstatus(ok, Code, HdrExtra),
 1249    date(now),
 1250    header_fields(HdrExtra, CLen),
 1251    content_length(html(Tokens), CLen),
 1252    content_type(text/html),
 1253    "\r\n".
 1254reply_header(file(Type, File), HdrExtra, Code) -->
 1255    vstatus(ok, Code, HdrExtra),
 1256    date(now),
 1257    modified(file(File)),
 1258    header_fields(HdrExtra, CLen),
 1259    content_length(file(File), CLen),
 1260    content_type(Type),
 1261    "\r\n".
 1262reply_header(gzip_file(Type, File), HdrExtra, Code) -->
 1263    vstatus(ok, Code, HdrExtra),
 1264    date(now),
 1265    modified(file(File)),
 1266    header_fields(HdrExtra, CLen),
 1267    content_length(file(File), CLen),
 1268    content_type(Type),
 1269    content_encoding(gzip),
 1270    "\r\n".
 1271reply_header(file(Type, File, Range), HdrExtra, Code) -->
 1272    vstatus(partial_content, Code, HdrExtra),
 1273    date(now),
 1274    modified(file(File)),
 1275    header_fields(HdrExtra, CLen),
 1276    content_length(file(File, Range), CLen),
 1277    content_type(Type),
 1278    "\r\n".
 1279reply_header(tmp_file(Type, File), HdrExtra, Code) -->
 1280    vstatus(ok, Code, HdrExtra),
 1281    date(now),
 1282    header_fields(HdrExtra, CLen),
 1283    content_length(file(File), CLen),
 1284    content_type(Type),
 1285    "\r\n".
 1286reply_header(cgi_data(Size), HdrExtra, Code) -->
 1287    vstatus(ok, Code, HdrExtra),
 1288    date(now),
 1289    header_fields(HdrExtra, CLen),
 1290    content_length(Size, CLen),
 1291    "\r\n".
 1292reply_header(chunked_data, HdrExtra, Code) -->
 1293    vstatus(ok, Code, HdrExtra),
 1294    date(now),
 1295    header_fields(HdrExtra, _),
 1296    (   {memberchk(transfer_encoding(_), HdrExtra)}
 1297    ->  ""
 1298    ;   transfer_encoding(chunked)
 1299    ),
 1300    "\r\n".
 1301% non-200 replies without a body (e.g., 1xx, 204, 304)
 1302reply_header(status(Status), HdrExtra, Code) -->
 1303    vstatus(Status, Code),
 1304    header_fields(HdrExtra, Clen),
 1305    { Clen = 0 },
 1306    "\r\n".
 1307% non-200 replies with a body
 1308reply_header(Data, HdrExtra, Code) -->
 1309    { status_reply_headers(Data,
 1310                           body(Type, Encoding, Content),
 1311                           ReplyHeaders),
 1312      http_join_headers(ReplyHeaders, HdrExtra, Headers),
 1313      functor(Data, CodeName, _)
 1314    },
 1315    vstatus(CodeName, Code, Headers),
 1316    date(now),
 1317    header_fields(Headers, CLen),
 1318    content_length(codes(Content, Encoding), CLen),
 1319    content_type(Type, Encoding),
 1320    "\r\n".
 1321
 1322status_reply_headers(created(Location, Body), Body,
 1323                     [ location(Location) ]).
 1324status_reply_headers(moved(To, Body), Body,
 1325                     [ location(To) ]).
 1326status_reply_headers(moved_temporary(To, Body), Body,
 1327                     [ location(To) ]).
 1328status_reply_headers(gone(_URL, Body), Body, []).
 1329status_reply_headers(see_other(To, Body), Body,
 1330                     [ location(To) ]).
 1331status_reply_headers(authorise(Method, Body), Body,
 1332                     [ www_authenticate(Method) ]).
 1333status_reply_headers(not_found(_URL, Body), Body, []).
 1334status_reply_headers(forbidden(_URL, Body), Body, []).
 1335status_reply_headers(method_not_allowed(_Method, _URL, Body), Body, []).
 1336status_reply_headers(server_error(_Error, Body), Body, []).
 1337status_reply_headers(service_unavailable(_Why, Body), Body, []).
 1338status_reply_headers(not_acceptable(_Why, Body), Body, []).
 1339status_reply_headers(bad_request(_Error, Body), Body, []).
 vstatus(+Status, -Code)// is det
 vstatus(+Status, -Code, +HdrExtra)// is det
Emit the HTTP header for Status
 1347vstatus(_Status, Code, HdrExtra) -->
 1348    {memberchk(status(Code), HdrExtra)},
 1349    !,
 1350    vstatus(_NewStatus, Code).
 1351vstatus(Status, Code, _) -->
 1352    vstatus(Status, Code).
 1353
 1354vstatus(Status, Code) -->
 1355    "HTTP/1.1 ",
 1356    status_number(Status, Code),
 1357    " ",
 1358    status_comment(Status),
 1359    "\r\n".
 status_number(?Status, ?Code)// is semidet
Parse/generate the HTTP status numbers and map them to the proper name.
See also
- See the source code for supported status names and codes.
 1368status_number(Status, Code) -->
 1369    { var(Status) },
 1370    !,
 1371    integer(Code),
 1372    { status_number(Status, Code) },
 1373    !.
 1374status_number(Status, Code) -->
 1375    { status_number(Status, Code) },
 1376    integer(Code).
 status_number(+Status:atom, -Code:nonneg) is det
status_number(-Status:atom, +Code:nonneg) is det
Relates a symbolic HTTP status names to their integer Code. Each code also needs a rule for status_comment//1.
throws
- type_error If Code is instantiated with something other than an integer.
- domain_error If Code is instantiated with an integer outside of the range [100-599] of defined HTTP status codes.
 1390% Unrecognized status codes that are within a defined code class.
 1391% RFC 7231 states:
 1392%   "[...] a client MUST understand the class of any status code,
 1393%    as indicated by the first digit, and treat an unrecognized status code
 1394%    as being equivalent to the `x00` status code of that class [...]
 1395%   "
 1396% @see http://tools.ietf.org/html/rfc7231#section-6
 1397
 1398status_number(Status, Code) :-
 1399    nonvar(Status),
 1400    !,
 1401    status_number_fact(Status, Code).
 1402status_number(Status, Code) :-
 1403    nonvar(Code),
 1404    !,
 1405    (   between(100, 599, Code)
 1406    ->  (   status_number_fact(Status, Code)
 1407        ->  true
 1408        ;   ClassCode is Code // 100 * 100,
 1409            status_number_fact(Status, ClassCode)
 1410        )
 1411    ;   domain_error(http_code, Code)
 1412    ).
 1413
 1414status_number_fact(continue,                   100).
 1415status_number_fact(switching_protocols,        101).
 1416status_number_fact(ok,                         200).
 1417status_number_fact(created,                    201).
 1418status_number_fact(accepted,                   202).
 1419status_number_fact(non_authoritative_info,     203).
 1420status_number_fact(no_content,                 204).
 1421status_number_fact(reset_content,              205).
 1422status_number_fact(partial_content,            206).
 1423status_number_fact(multiple_choices,           300).
 1424status_number_fact(moved,                      301).
 1425status_number_fact(moved_temporary,            302).
 1426status_number_fact(see_other,                  303).
 1427status_number_fact(not_modified,               304).
 1428status_number_fact(use_proxy,                  305).
 1429status_number_fact(unused,                     306).
 1430status_number_fact(temporary_redirect,         307).
 1431status_number_fact(bad_request,                400).
 1432status_number_fact(authorise,                  401).
 1433status_number_fact(payment_required,           402).
 1434status_number_fact(forbidden,                  403).
 1435status_number_fact(not_found,                  404).
 1436status_number_fact(method_not_allowed,         405).
 1437status_number_fact(not_acceptable,             406).
 1438status_number_fact(request_timeout,            408).
 1439status_number_fact(conflict,                   409).
 1440status_number_fact(gone,                       410).
 1441status_number_fact(length_required,            411).
 1442status_number_fact(payload_too_large,          413).
 1443status_number_fact(uri_too_long,               414).
 1444status_number_fact(unsupported_media_type,     415).
 1445status_number_fact(expectation_failed,         417).
 1446status_number_fact(upgrade_required,           426).
 1447status_number_fact(server_error,               500).
 1448status_number_fact(not_implemented,            501).
 1449status_number_fact(bad_gateway,                502).
 1450status_number_fact(service_unavailable,        503).
 1451status_number_fact(gateway_timeout,            504).
 1452status_number_fact(http_version_not_supported, 505).
 status_comment(+Code:atom)// is det
Emit standard HTTP human-readable comment on the reply-status.
 1459status_comment(continue) -->
 1460    "Continue".
 1461status_comment(switching_protocols) -->
 1462    "Switching Protocols".
 1463status_comment(ok) -->
 1464    "OK".
 1465status_comment(created) -->
 1466    "Created".
 1467status_comment(accepted) -->
 1468    "Accepted".
 1469status_comment(non_authoritative_info) -->
 1470    "Non-Authoritative Information".
 1471status_comment(no_content) -->
 1472    "No Content".
 1473status_comment(reset_content) -->
 1474    "Reset Content".
 1475status_comment(created) -->
 1476    "Created".
 1477status_comment(partial_content) -->
 1478    "Partial content".
 1479status_comment(multiple_choices) -->
 1480    "Multiple Choices".
 1481status_comment(moved) -->
 1482    "Moved Permanently".
 1483status_comment(moved_temporary) -->
 1484    "Moved Temporary".
 1485status_comment(see_other) -->
 1486    "See Other".
 1487status_comment(not_modified) -->
 1488    "Not Modified".
 1489status_comment(use_proxy) -->
 1490    "Use Proxy".
 1491status_comment(unused) -->
 1492    "Unused".
 1493status_comment(temporary_redirect) -->
 1494    "Temporary Redirect".
 1495status_comment(bad_request) -->
 1496    "Bad Request".
 1497status_comment(authorise) -->
 1498    "Authorization Required".
 1499status_comment(payment_required) -->
 1500    "Payment Required".
 1501status_comment(forbidden) -->
 1502    "Forbidden".
 1503status_comment(not_found) -->
 1504    "Not Found".
 1505status_comment(method_not_allowed) -->
 1506    "Method Not Allowed".
 1507status_comment(not_acceptable) -->
 1508    "Not Acceptable".
 1509status_comment(request_timeout) -->
 1510    "Request Timeout".
 1511status_comment(conflict) -->
 1512    "Conflict".
 1513status_comment(gone) -->
 1514    "Gone".
 1515status_comment(length_required) -->
 1516    "Length Required".
 1517status_comment(payload_too_large) -->
 1518    "Payload Too Large".
 1519status_comment(uri_too_long) -->
 1520    "URI Too Long".
 1521status_comment(unsupported_media_type) -->
 1522    "Unsupported Media Type".
 1523status_comment(expectation_failed) -->
 1524    "Expectation Failed".
 1525status_comment(upgrade_required) -->
 1526    "Upgrade Required".
 1527status_comment(server_error) -->
 1528    "Internal Server Error".
 1529status_comment(not_implemented) -->
 1530    "Not Implemented".
 1531status_comment(bad_gateway) -->
 1532    "Bad Gateway".
 1533status_comment(service_unavailable) -->
 1534    "Service Unavailable".
 1535status_comment(gateway_timeout) -->
 1536    "Gateway Timeout".
 1537status_comment(http_version_not_supported) -->
 1538    "HTTP Version Not Supported".
 1539
 1540date(Time) -->
 1541    "Date: ",
 1542    (   { Time == now }
 1543    ->  now
 1544    ;   rfc_date(Time)
 1545    ),
 1546    "\r\n".
 1547
 1548modified(file(File)) -->
 1549    !,
 1550    { time_file(File, Time)
 1551    },
 1552    modified(Time).
 1553modified(Time) -->
 1554    "Last-modified: ",
 1555    (   { Time == now }
 1556    ->  now
 1557    ;   rfc_date(Time)
 1558    ),
 1559    "\r\n".
 content_length(+Object, ?Len)// is det
Emit the content-length field and (optionally) the content-range field.
Arguments:
Len- Number of bytes specified
 1569content_length(file(File, bytes(From, To)), Len) -->
 1570    !,
 1571    { size_file(File, Size),
 1572      (   To == end
 1573      ->  Len is Size - From,
 1574          RangeEnd is Size - 1
 1575      ;   Len is To+1 - From,       % To is index of last byte
 1576          RangeEnd = To
 1577      )
 1578    },
 1579    content_range(bytes, From, RangeEnd, Size),
 1580    content_length(Len, Len).
 1581content_length(Reply, Len) -->
 1582    { length_of(Reply, Len)
 1583    },
 1584    "Content-Length: ", integer(Len),
 1585    "\r\n".
 1586
 1587
 1588length_of(_, Len) :-
 1589    nonvar(Len),
 1590    !.
 1591length_of(codes(String, Encoding), Len) :-
 1592    !,
 1593    setup_call_cleanup(
 1594        open_null_stream(Out),
 1595        ( set_stream(Out, encoding(Encoding)),
 1596          format(Out, '~s', [String]),
 1597          byte_count(Out, Len)
 1598        ),
 1599        close(Out)).
 1600length_of(atom(Atom, Encoding), Len) :-
 1601    !,
 1602    setup_call_cleanup(
 1603        open_null_stream(Out),
 1604        ( set_stream(Out, encoding(Encoding)),
 1605          format(Out, '~a', [Atom]),
 1606          byte_count(Out, Len)
 1607        ),
 1608        close(Out)).
 1609length_of(file(File), Len) :-
 1610    !,
 1611    size_file(File, Len).
 1612length_of(memory_file(Handle), Len) :-
 1613    !,
 1614    size_memory_file(Handle, Len, octet).
 1615length_of(html_tokens(Tokens), Len) :-
 1616    !,
 1617    html_print_length(Tokens, Len).
 1618length_of(html(Tokens), Len) :-     % deprecated
 1619    !,
 1620    html_print_length(Tokens, Len).
 1621length_of(bytes(Bytes), Len) :-
 1622    !,
 1623    (   string(Bytes)
 1624    ->  string_length(Bytes, Len)
 1625    ;   length(Bytes, Len)          % assuming a list of 0..255
 1626    ).
 1627length_of(Len, Len).
 content_range(+Unit:atom, +From:int, +RangeEnd:int, +Size:int)// is det
Emit the Content-Range header for partial content (206) replies.
 1635content_range(Unit, From, RangeEnd, Size) -->
 1636    "Content-Range: ", atom(Unit), " ",
 1637    integer(From), "-", integer(RangeEnd), "/", integer(Size),
 1638    "\r\n".
 1639
 1640content_encoding(Encoding) -->
 1641    "Content-Encoding: ", atom(Encoding), "\r\n".
 1642
 1643transfer_encoding(Encoding) -->
 1644    "Transfer-Encoding: ", atom(Encoding), "\r\n".
 1645
 1646content_type(Type) -->
 1647    content_type(Type, _).
 1648
 1649content_type(Type, Charset) -->
 1650    ctype(Type),
 1651    charset(Charset),
 1652    "\r\n".
 1653
 1654ctype(Main/Sub) -->
 1655    !,
 1656    "Content-Type: ",
 1657    atom(Main),
 1658    "/",
 1659    atom(Sub).
 1660ctype(Type) -->
 1661    !,
 1662    "Content-Type: ",
 1663    atom(Type).
 1664
 1665charset(Var) -->
 1666    { var(Var) },
 1667    !.
 1668charset(utf8) -->
 1669    !,
 1670    "; charset=UTF-8".
 1671charset(CharSet) -->
 1672    "; charset=",
 1673    atom(CharSet).
 header_field(-Name, -Value)// is det
 header_field(+Name, +Value) is det
Process an HTTP request property. Request properties appear as a single line in an HTTP header.
 1681header_field(Name, Value) -->
 1682    { var(Name) },                 % parsing
 1683    !,
 1684    field_name(Name),
 1685    ":",
 1686    whites,
 1687    read_field_value(ValueChars),
 1688    blanks_to_nl,
 1689    !,
 1690    {   field_to_prolog(Name, ValueChars, Value)
 1691    ->  true
 1692    ;   atom_codes(Value, ValueChars),
 1693        domain_error(Name, Value)
 1694    }.
 1695header_field(Name, Value) -->
 1696    field_name(Name),
 1697    ": ",
 1698    field_value(Name, Value),
 1699    "\r\n".
 read_field_value(-Codes)//
Read a field eagerly upto the next whitespace
 1705read_field_value([H|T]) -->
 1706    [H],
 1707    { \+ code_type(H, space) },
 1708    !,
 1709    read_field_value(T).
 1710read_field_value([]) -->
 1711    "".
 1712read_field_value([H|T]) -->
 1713    [H],
 1714    read_field_value(T).
 http_parse_header_value(+Field, +Value, -Prolog) is semidet
Translate Value in a meaningful Prolog term. Field denotes the HTTP request field for which we do the translation. Supported fields are:
content_length
Converted into an integer
status
Converted into an integer
cookie
Converted into a list with Name=Value by cookies//1.
set_cookie
Converted into a term set_cookie(Name, Value, Options). Options is a list consisting of Name=Value or a single atom (e.g., secure)
host
Converted to HostName:Port if applicable.
range
Converted into bytes(From, To), where From is an integer and To is either an integer or the atom end.
accept
Parsed to a list of media descriptions. Each media is a term media(Type, TypeParams, Quality, AcceptExts). The list is sorted according to preference.
content_disposition
Parsed into disposition(Name, Attributes), where Attributes is a list of Name=Value pairs.
content_type
Parsed into media(Type/SubType, Attributes), where Attributes is a list of Name=Value pairs.

As some fields are already parsed in the Request, this predicate is a no-op when called on an already parsed field.

Arguments:
Value- is either an atom, a list of codes or an already parsed header value.
 1755http_parse_header_value(Field, Value, Prolog) :-
 1756    known_field(Field, _, Type),
 1757    (   already_parsed(Type, Value)
 1758    ->  Prolog = Value
 1759    ;   to_codes(Value, Codes),
 1760        parse_header_value(Field, Codes, Prolog)
 1761    ).
 1762
 1763already_parsed(integer, V)    :- !, integer(V).
 1764already_parsed(list(Type), L) :- !, is_list(L), maplist(already_parsed(Type), L).
 1765already_parsed(Term, V)       :- subsumes_term(Term, V).
 known_field(?FieldName, ?AutoConvert, -Type)
True if the value of FieldName is by default translated into a Prolog data structure.
 1773known_field(content_length,      true,  integer).
 1774known_field(status,              true,  integer).
 1775known_field(cookie,              true,  list(_=_)).
 1776known_field(set_cookie,          true,  list(set_cookie(_Name,_Value,_Options))).
 1777known_field(host,                true,  _Host:_Port).
 1778known_field(range,               maybe, bytes(_,_)).
 1779known_field(accept,              maybe, list(media(_Type, _Parms, _Q, _Exts))).
 1780known_field(content_disposition, maybe, disposition(_Name, _Attributes)).
 1781known_field(content_type,        false, media(_Type/_Sub, _Attributes)).
 1782
 1783to_codes(In, Codes) :-
 1784    (   is_list(In)
 1785    ->  Codes = In
 1786    ;   atom_codes(In, Codes)
 1787    ).
 field_to_prolog(+Field, +ValueCodes, -Prolog) is semidet
Translate the value string into a sensible Prolog term. For known_fields(_,true), this must succeed. For maybe, we just return the atom if the translation fails.
 1795field_to_prolog(Field, Codes, Prolog) :-
 1796    known_field(Field, true, _Type),
 1797    !,
 1798    (   parse_header_value(Field, Codes, Prolog0)
 1799    ->  Prolog = Prolog0
 1800    ).
 1801field_to_prolog(Field, Codes, Prolog) :-
 1802    known_field(Field, maybe, _Type),
 1803    parse_header_value(Field, Codes, Prolog0),
 1804    !,
 1805    Prolog = Prolog0.
 1806field_to_prolog(_, Codes, Atom) :-
 1807    atom_codes(Atom, Codes).
 parse_header_value(+Field, +ValueCodes, -Value) is semidet
Parse the value text of an HTTP field into a meaningful Prolog representation.
 1814parse_header_value(content_length, ValueChars, ContentLength) :-
 1815    number_codes(ContentLength, ValueChars).
 1816parse_header_value(status, ValueChars, Code) :-
 1817    (   phrase(" ", L, _),
 1818        append(Pre, L, ValueChars)
 1819    ->  number_codes(Code, Pre)
 1820    ;   number_codes(Code, ValueChars)
 1821    ).
 1822parse_header_value(cookie, ValueChars, Cookies) :-
 1823    debug(cookie, 'Cookie: ~s', [ValueChars]),
 1824    phrase(cookies(Cookies), ValueChars).
 1825parse_header_value(set_cookie, ValueChars, SetCookie) :-
 1826    debug(cookie, 'SetCookie: ~s', [ValueChars]),
 1827    phrase(set_cookie(SetCookie), ValueChars).
 1828parse_header_value(host, ValueChars, Host) :-
 1829    (   append(HostChars, [0':|PortChars], ValueChars),
 1830        catch(number_codes(Port, PortChars), _, fail)
 1831    ->  atom_codes(HostName, HostChars),
 1832        Host = HostName:Port
 1833    ;   atom_codes(Host, ValueChars)
 1834    ).
 1835parse_header_value(range, ValueChars, Range) :-
 1836    phrase(range(Range), ValueChars).
 1837parse_header_value(accept, ValueChars, Media) :-
 1838    parse_accept(ValueChars, Media).
 1839parse_header_value(content_disposition, ValueChars, Disposition) :-
 1840    phrase(content_disposition(Disposition), ValueChars).
 1841parse_header_value(content_type, ValueChars, Type) :-
 1842    phrase(parse_content_type(Type), ValueChars).
 field_value(+Name, +Value)//
 1846field_value(_, set_cookie(Name, Value, Options)) -->
 1847    !,
 1848    atom(Name), "=", atom(Value),
 1849    value_options(Options, cookie).
 1850field_value(_, disposition(Disposition, Options)) -->
 1851    !,
 1852    atom(Disposition), value_options(Options, disposition).
 1853field_value(www_authenticate, Auth) -->
 1854    auth_field_value(Auth).
 1855field_value(_, Atomic) -->
 1856    atom(Atomic).
 auth_field_value(+AuthValue)//
Emit the authentication requirements (WWW-Authenticate field).
 1862auth_field_value(negotiate(Data)) -->
 1863    "Negotiate ",
 1864    { base64(Data, DataBase64),
 1865      atom_codes(DataBase64, Codes)
 1866    },
 1867    string(Codes).
 1868auth_field_value(negotiate) -->
 1869    "Negotiate".
 1870auth_field_value(basic) -->
 1871    !,
 1872    "Basic".
 1873auth_field_value(basic(Realm)) -->
 1874    "Basic Realm=\"", atom(Realm), "\"".
 1875auth_field_value(digest) -->
 1876    !,
 1877    "Digest".
 1878auth_field_value(digest(Details)) -->
 1879    "Digest ", atom(Details).
 value_options(+List, +Field)//
Emit field parameters such as ; charset=UTF-8. There are three versions: a plain key (secure), token values and quoted string values. Seems we cannot deduce that from the actual value.
 1888value_options([], _) --> [].
 1889value_options([H|T], Field) -->
 1890    "; ", value_option(H, Field),
 1891    value_options(T, Field).
 1892
 1893value_option(secure=true, cookie) -->
 1894    !,
 1895    "secure".
 1896value_option(Name=Value, Type) -->
 1897    { string_option(Name, Type) },
 1898    !,
 1899    atom(Name), "=",
 1900    qstring(Value).
 1901value_option(Name=Value, Type) -->
 1902    { token_option(Name, Type) },
 1903    !,
 1904    atom(Name), "=", atom(Value).
 1905value_option(Name=Value, _Type) -->
 1906    atom(Name), "=",
 1907    option_value(Value).
 1908
 1909string_option(filename, disposition).
 1910
 1911token_option(path, cookie).
 1912
 1913option_value(Value) -->
 1914    { number(Value) },
 1915    !,
 1916    number(Value).
 1917option_value(Value) -->
 1918    { (   atom(Value)
 1919      ->  true
 1920      ;   string(Value)
 1921      ),
 1922      forall(string_code(_, Value, C),
 1923             token_char(C))
 1924    },
 1925    !,
 1926    atom(Value).
 1927option_value(Atomic) -->
 1928    qstring(Atomic).
 1929
 1930qstring(Atomic) -->
 1931    { string_codes(Atomic, Codes) },
 1932    "\"",
 1933    qstring_codes(Codes),
 1934    "\"".
 1935
 1936qstring_codes([]) --> [].
 1937qstring_codes([H|T]) --> qstring_code(H), qstring_codes(T).
 1938
 1939qstring_code(C) --> {qstring_esc(C)}, !, "\\", [C].
 1940qstring_code(C) --> [C].
 1941
 1942qstring_esc(0'").
 1943qstring_esc(C) :- ctl(C).
 1944
 1945
 1946                 /*******************************
 1947                 *        ACCEPT HEADERS        *
 1948                 *******************************/
 1949
 1950:- dynamic accept_cache/2. 1951:- volatile accept_cache/2. 1952
 1953parse_accept(Codes, Media) :-
 1954    atom_codes(Atom, Codes),
 1955    (   accept_cache(Atom, Media0)
 1956    ->  Media = Media0
 1957    ;   phrase(accept(Media0), Codes),
 1958        keysort(Media0, Media1),
 1959        pairs_values(Media1, Media2),
 1960        assertz(accept_cache(Atom, Media2)),
 1961        Media = Media2
 1962    ).
 accept(-Media)// is semidet
Parse an HTTP Accept: header
 1968accept([H|T]) -->
 1969    blanks,
 1970    media_range(H),
 1971    blanks,
 1972    (   ","
 1973    ->  accept(T)
 1974    ;   {T=[]}
 1975    ).
 1976
 1977media_range(s(SortQuality,Spec)-media(Type, TypeParams, Quality, AcceptExts)) -->
 1978    media_type(Type),
 1979    blanks,
 1980    (   ";"
 1981    ->  blanks,
 1982        parameters_and_quality(TypeParams, Quality, AcceptExts)
 1983    ;   { TypeParams = [],
 1984          Quality = 1.0,
 1985          AcceptExts = []
 1986        }
 1987    ),
 1988    { SortQuality is float(-Quality),
 1989      rank_specialised(Type, TypeParams, Spec)
 1990    }.
 content_disposition(-Disposition)//
Parse Content-Disposition value
 1997content_disposition(disposition(Disposition, Options)) -->
 1998    token(Disposition), blanks,
 1999    value_parameters(Options).
 parse_content_type(-Type)//
Parse Content-Type value into a term media(Type/SubType, Parameters).
 2006parse_content_type(media(Type, Parameters)) -->
 2007    media_type(Type), blanks,
 2008    value_parameters(Parameters).
 rank_specialised(+Type, +TypeParam, -Key) is det
Although the specification linked above is unclear, it seems that more specialised types must be preferred over less specialized ones.
To be done
- Is there an official specification of this?
 2019rank_specialised(Type/SubType, TypeParams, v(VT, VS, SortVP)) :-
 2020    var_or_given(Type, VT),
 2021    var_or_given(SubType, VS),
 2022    length(TypeParams, VP),
 2023    SortVP is -VP.
 2024
 2025var_or_given(V, Val) :-
 2026    (   var(V)
 2027    ->  Val = 0
 2028    ;   Val = -1
 2029    ).
 2030
 2031media_type(Type/SubType) -->
 2032    type(Type), "/", type(SubType).
 2033
 2034type(_) -->
 2035    "*",
 2036    !.
 2037type(Type) -->
 2038    token(Type).
 2039
 2040parameters_and_quality(Params, Quality, AcceptExts) -->
 2041    token(Name),
 2042    blanks, "=", blanks,
 2043    (   { Name == q }
 2044    ->  float(Quality), blanks,
 2045        value_parameters(AcceptExts),
 2046        { Params = [] }
 2047    ;   { Params = [Name=Value|T] },
 2048        parameter_value(Value),
 2049        blanks,
 2050        (   ";"
 2051        ->  blanks,
 2052            parameters_and_quality(T, Quality, AcceptExts)
 2053        ;   { T = [],
 2054              Quality = 1.0,
 2055              AcceptExts = []
 2056            }
 2057        )
 2058    ).
 value_parameters(-Params:list) is det
Accept (";" <parameter>)*, returning a list of Name=Value, where both Name and Value are atoms.
 2065value_parameters([H|T]) -->
 2066    ";",
 2067    !,
 2068    blanks, token(Name), blanks,
 2069    (   "="
 2070    ->  blanks,
 2071        (   token(Value)
 2072        ->  []
 2073        ;   quoted_string(Value)
 2074        ),
 2075        { H = (Name=Value) }
 2076    ;   { H = Name }
 2077    ),
 2078    blanks,
 2079    value_parameters(T).
 2080value_parameters([]) -->
 2081    [].
 2082
 2083parameter_value(Value) --> token(Value), !.
 2084parameter_value(Value) --> quoted_string(Value).
 token(-Name)// is semidet
Process an HTTP header token from the input.
 2091token(Name) -->
 2092    token_char(C1),
 2093    token_chars(Cs),
 2094    { atom_codes(Name, [C1|Cs]) }.
 2095
 2096token_chars([H|T]) -->
 2097    token_char(H),
 2098    !,
 2099    token_chars(T).
 2100token_chars([]) --> [].
 2101
 2102token_char(C) :-
 2103    \+ ctl(C),
 2104    \+ separator_code(C).
 2105
 2106ctl(C) :- between(0,31,C), !.
 2107ctl(127).
 2108
 2109separator_code(0'().
 2110separator_code(0')).
 2111separator_code(0'<).
 2112separator_code(0'>).
 2113separator_code(0'@).
 2114separator_code(0',).
 2115separator_code(0';).
 2116separator_code(0':).
 2117separator_code(0'\\).
 2118separator_code(0'").
 2119separator_code(0'/).
 2120separator_code(0'[).
 2121separator_code(0']).
 2122separator_code(0'?).
 2123separator_code(0'=).
 2124separator_code(0'{).
 2125separator_code(0'}).
 2126separator_code(0'\s).
 2127separator_code(0'\t).
 2128
 2129term_expansion(token_char(x) --> [x], Clauses) :-
 2130    findall((token_char(C)-->[C]),
 2131            (   between(0, 255, C),
 2132                token_char(C)
 2133            ),
 2134            Clauses).
 2135
 2136token_char(x) --> [x].
 quoted_string(-Text)// is semidet
True if input starts with a quoted string representing Text.
 2142quoted_string(Text) -->
 2143    "\"",
 2144    quoted_text(Codes),
 2145    { atom_codes(Text, Codes) }.
 2146
 2147quoted_text([]) -->
 2148    "\"",
 2149    !.
 2150quoted_text([H|T]) -->
 2151    "\\", !, [H],
 2152    quoted_text(T).
 2153quoted_text([H|T]) -->
 2154    [H],
 2155    !,
 2156    quoted_text(T).
 header_fields(+Fields, ?ContentLength)// is det
Process a sequence of [Name(Value), ...] attributes for the header. A term content_length(Len) is special. If instantiated it emits the header. If not it just unifies ContentLength with the argument of the content_length(Len) term. This allows for both sending and retrieving the content-length.
 2167header_fields([], _) --> [].
 2168header_fields([content_length(CLen)|T], CLen) -->
 2169    !,
 2170    (   { var(CLen) }
 2171    ->  ""
 2172    ;   header_field(content_length, CLen)
 2173    ),
 2174    header_fields(T, CLen).           % Continue or return first only?
 2175header_fields([status(_)|T], CLen) -->   % handled by vstatus//3.
 2176    !,
 2177    header_fields(T, CLen).
 2178header_fields([H|T], CLen) -->
 2179    { H =.. [Name, Value] },
 2180    header_field(Name, Value),
 2181    header_fields(T, CLen).
 field_name(?PrologName)
Convert between prolog_name and HttpName. Field names are, according to RFC 2616, considered tokens and covered by the following definition:
token          = 1*<any CHAR except CTLs or separators>
separators     = "(" | ")" | "<" | ">" | "@"
               | "," | ";" | ":" | "\" | <">
               | "/" | "[" | "]" | "?" | "="
               | "{" | "}" | SP | HT
 2198:- public
 2199    field_name//1. 2200
 2201field_name(Name) -->
 2202    { var(Name) },
 2203    !,
 2204    rd_field_chars(Chars),
 2205    { atom_codes(Name, Chars) }.
 2206field_name(mime_version) -->
 2207    !,
 2208    "MIME-Version".
 2209field_name(www_authenticate) -->
 2210    !,
 2211    "WWW-Authenticate".
 2212field_name(Name) -->
 2213    { atom_codes(Name, Chars) },
 2214    wr_field_chars(Chars).
 2215
 2216rd_field_chars_no_fold([C|T]) -->
 2217    [C],
 2218    { rd_field_char(C, _) },
 2219    !,
 2220    rd_field_chars_no_fold(T).
 2221rd_field_chars_no_fold([]) -->
 2222    [].
 2223
 2224rd_field_chars([C0|T]) -->
 2225    [C],
 2226    { rd_field_char(C, C0) },
 2227    !,
 2228    rd_field_chars(T).
 2229rd_field_chars([]) -->
 2230    [].
 separators(-CharCodes) is det
CharCodes is a list of separators according to RFC2616
 2236separators("()<>@,;:\\\"/[]?={} \t").
 2237
 2238term_expansion(rd_field_char('expand me',_), Clauses) :-
 2239
 2240    Clauses = [ rd_field_char(0'-, 0'_)
 2241              | Cls
 2242              ],
 2243    separators(SepString),
 2244    string_codes(SepString, Seps),
 2245    findall(rd_field_char(In, Out),
 2246            (   between(32, 127, In),
 2247                \+ memberchk(In, Seps),
 2248                In \== 0'-,         % 0'
 2249                code_type(Out, to_lower(In))),
 2250            Cls).
 2251
 2252rd_field_char('expand me', _).                  % avoid recursion
 2253
 2254wr_field_chars([C|T]) -->
 2255    !,
 2256    { code_type(C, to_lower(U)) },
 2257    [U],
 2258    wr_field_chars2(T).
 2259wr_field_chars([]) -->
 2260    [].
 2261
 2262wr_field_chars2([]) --> [].
 2263wr_field_chars2([C|T]) -->              % 0'
 2264    (   { C == 0'_ }
 2265    ->  "-",
 2266        wr_field_chars(T)
 2267    ;   [C],
 2268        wr_field_chars2(T)
 2269    ).
 now//
Current time using rfc_date//1.
 2275now -->
 2276    { get_time(Time)
 2277    },
 2278    rfc_date(Time).
 rfc_date(+Time)// is det
Write time according to RFC1123 specification as required by the RFC2616 HTTP protocol specs.
 2285rfc_date(Time, String, Tail) :-
 2286    stamp_date_time(Time, Date, 'UTC'),
 2287    format_time(codes(String, Tail),
 2288                '%a, %d %b %Y %T GMT',
 2289                Date, posix).
 http_timestamp(+Time:timestamp, -Text:atom) is det
Generate a description of a Time in HTTP format (RFC1123)
 2295http_timestamp(Time, Atom) :-
 2296    stamp_date_time(Time, Date, 'UTC'),
 2297    format_time(atom(Atom),
 2298                '%a, %d %b %Y %T GMT',
 2299                Date, posix).
 2300
 2301
 2302                 /*******************************
 2303                 *         REQUEST DCG          *
 2304                 *******************************/
 2305
 2306request(Fd, [method(Method),request_uri(ReqURI)|Header]) -->
 2307    method(Method),
 2308    blanks,
 2309    nonblanks(Query),
 2310    { atom_codes(ReqURI, Query),
 2311      request_uri_parts(ReqURI, Header, Rest)
 2312    },
 2313    request_header(Fd, Rest),
 2314    !.
 2315request(Fd, [unknown(What)|Header]) -->
 2316    string(What),
 2317    eos,
 2318    !,
 2319    {   http_read_header(Fd, Header)
 2320    ->  true
 2321    ;   Header = []
 2322    }.
 2323
 2324method(get)     --> "GET", !.
 2325method(put)     --> "PUT", !.
 2326method(head)    --> "HEAD", !.
 2327method(post)    --> "POST", !.
 2328method(delete)  --> "DELETE", !.
 2329method(patch)   --> "PATCH", !.
 2330method(options) --> "OPTIONS", !.
 2331method(trace)   --> "TRACE", !.
 request_uri_parts(+RequestURI, -Parts, ?Tail) is det
Process the request-uri, producing the following parts:
path(-Path)
Decode path information (always present)
search(-QueryParams)
Present if there is a ?name=value&... part of the request uri. QueryParams is a Name=Value list.
fragment(-Fragment)
Present if there is a #Fragment.
 2345request_uri_parts(ReqURI, [path(Path)|Parts], Rest) :-
 2346    uri_components(ReqURI, Components),
 2347    uri_data(path, Components, PathText),
 2348    uri_encoded(path, Path, PathText),
 2349    phrase(uri_parts(Components), Parts, Rest).
 2350
 2351uri_parts(Components) -->
 2352    uri_search(Components),
 2353    uri_fragment(Components).
 2354
 2355uri_search(Components) -->
 2356    { uri_data(search, Components, Search),
 2357      nonvar(Search),
 2358      catch(uri_query_components(Search, Query),
 2359            error(syntax_error(_),_),
 2360            fail)
 2361    },
 2362    !,
 2363    [ search(Query) ].
 2364uri_search(_) --> [].
 2365
 2366uri_fragment(Components) -->
 2367    { uri_data(fragment, Components, String),
 2368      nonvar(String),
 2369      !,
 2370      uri_encoded(fragment, Fragment, String)
 2371    },
 2372    [ fragment(Fragment) ].
 2373uri_fragment(_) --> [].
 request_header(+In:istream, -Header:list) is det
Read the remainder (after the request-uri) of the HTTP header and return it as a Name(Value) list.
 2380request_header(_, []) -->               % Old-style non-version header
 2381    blanks,
 2382    eos,
 2383    !.
 2384request_header(Fd, [http_version(Version)|Header]) -->
 2385    http_version(Version),
 2386    blanks,
 2387    eos,
 2388    !,
 2389    {   Version = 1-_
 2390    ->  http_read_header(Fd, Header)
 2391    ;   Header = []
 2392    }.
 2393
 2394http_version(Version) -->
 2395    blanks,
 2396    "HTTP/",
 2397    http_version_number(Version).
 2398
 2399http_version_number(Major-Minor) -->
 2400    integer(Major),
 2401    ".",
 2402    integer(Minor).
 2403
 2404
 2405                 /*******************************
 2406                 *            COOKIES           *
 2407                 *******************************/
 cookies(-List)// is semidet
Translate a cookie description into a list Name=Value.
 2413cookies([Name=Value|T]) -->
 2414    blanks,
 2415    cookie(Name, Value),
 2416    !,
 2417    blanks,
 2418    (   ";"
 2419    ->  cookies(T)
 2420    ;   { T = [] }
 2421    ).
 2422cookies(List) -->
 2423    string(Skipped),
 2424    ";",
 2425    !,
 2426    { print_message(warning, http(skipped_cookie(Skipped))) },
 2427    cookies(List).
 2428cookies([]) -->
 2429    blanks.
 2430
 2431cookie(Name, Value) -->
 2432    cookie_name(Name),
 2433    blanks, "=", blanks,
 2434    cookie_value(Value).
 2435
 2436cookie_name(Name) -->
 2437    { var(Name) },
 2438    !,
 2439    rd_field_chars_no_fold(Chars),
 2440    { atom_codes(Name, Chars) }.
 2441
 2442cookie_value(Value) -->
 2443    quoted_string(Value),
 2444    !.
 2445cookie_value(Value) -->
 2446    chars_to_semicolon_or_blank(Chars),
 2447    { atom_codes(Value, Chars)
 2448    }.
 2449
 2450chars_to_semicolon_or_blank([]), ";" -->
 2451    ";",
 2452    !.
 2453chars_to_semicolon_or_blank([]) -->
 2454    " ",
 2455    blanks,
 2456    eos,
 2457    !.
 2458chars_to_semicolon_or_blank([H|T]) -->
 2459    [H],
 2460    !,
 2461    chars_to_semicolon_or_blank(T).
 2462chars_to_semicolon_or_blank([]) -->
 2463    [].
 2464
 2465set_cookie(set_cookie(Name, Value, Options)) -->
 2466    ws,
 2467    cookie(Name, Value),
 2468    cookie_options(Options).
 2469
 2470cookie_options([H|T]) -->
 2471    ws,
 2472    ";",
 2473    ws,
 2474    cookie_option(H),
 2475    !,
 2476    cookie_options(T).
 2477cookie_options([]) -->
 2478    ws.
 2479
 2480ws --> " ", !, ws.
 2481ws --> [].
 cookie_option(-Option)// is semidet
True if input represents a valid Cookie option. Officially, all cookie options use the syntax <name>=<value>, except for Secure and HttpOnly.
Arguments:
Option- Term of the form Name=Value
bug
- Incorrectly accepts options without = for M$ compatibility.
 2493cookie_option(Name=Value) -->
 2494    rd_field_chars(NameChars), ws,
 2495    { atom_codes(Name, NameChars) },
 2496    (   "="
 2497    ->  ws,
 2498        chars_to_semicolon(ValueChars),
 2499        { atom_codes(Value, ValueChars)
 2500        }
 2501    ;   { Value = true }
 2502    ).
 2503
 2504chars_to_semicolon([H|T]) -->
 2505    [H],
 2506    { H \== 32, H \== 0'; },
 2507    !,
 2508    chars_to_semicolon(T).
 2509chars_to_semicolon([]), ";" -->
 2510    ws, ";",
 2511    !.
 2512chars_to_semicolon([H|T]) -->
 2513    [H],
 2514    chars_to_semicolon(T).
 2515chars_to_semicolon([]) -->
 2516    [].
 range(-Range)// is semidet
Process the range header value. Range is currently defined as:
bytes(From, To)
Where From is an integer and To is either an integer or the atom end.
 2526range(bytes(From, To)) -->
 2527    "bytes", whites, "=", whites, integer(From), "-",
 2528    (   integer(To)
 2529    ->  ""
 2530    ;   { To = end }
 2531    ).
 2532
 2533
 2534                 /*******************************
 2535                 *           REPLY DCG          *
 2536                 *******************************/
 reply(+In, -Reply:list)// is semidet
Process the first line of an HTTP reply. After that, read the remainder of the header and parse it. After successful completion, Reply contains the following fields, followed by the fields produced by http_read_header/2.
http_version(Major-Minor)
status(Code, Status, Comment)
Code is an integer between 100 and 599. Status is a Prolog internal name. Comment is the comment following the code as it appears in the reply's HTTP status line. @see status_number//2.
 2553reply(Fd, [http_version(HttpVersion), status(Code, Status, Comment)|Header]) -->
 2554    http_version(HttpVersion),
 2555    blanks,
 2556    (   status_number(Status, Code)
 2557    ->  []
 2558    ;   integer(Status)
 2559    ),
 2560    blanks,
 2561    string(CommentCodes),
 2562    blanks_to_nl,
 2563    !,
 2564    blanks,
 2565    { atom_codes(Comment, CommentCodes),
 2566      http_read_header(Fd, Header)
 2567    }.
 2568
 2569
 2570                 /*******************************
 2571                 *            READ HEADER       *
 2572                 *******************************/
 http_read_header(+Fd, -Header) is det
Read Name: Value lines from FD until an empty line is encountered. Field-name are converted to Prolog conventions (all lower, _ instead of -): Content-Type: text/html --> content_type(text/html)
 2580http_read_header(Fd, Header) :-
 2581    read_header_data(Fd, Text),
 2582    http_parse_header(Text, Header).
 2583
 2584read_header_data(Fd, Header) :-
 2585    read_line_to_codes(Fd, Header, Tail),
 2586    read_header_data(Header, Fd, Tail),
 2587    debug(http(header), 'Header = ~n~s~n', [Header]).
 2588
 2589read_header_data([0'\r,0'\n], _, _) :- !.
 2590read_header_data([0'\n], _, _) :- !.
 2591read_header_data([], _, _) :- !.
 2592read_header_data(_, Fd, Tail) :-
 2593    read_line_to_codes(Fd, Tail, NewTail),
 2594    read_header_data(Tail, Fd, NewTail).
 http_parse_header(+Text:codes, -Header:list) is det
Header is a list of Name(Value)-terms representing the structure of the HTTP header in Text.
Errors
- domain_error(http_request_line, Line)
 2603http_parse_header(Text, Header) :-
 2604    phrase(header(Header), Text),
 2605    debug(http(header), 'Field: ~p', [Header]).
 2606
 2607header(List) -->
 2608    header_field(Name, Value),
 2609    !,
 2610    { mkfield(Name, Value, List, Tail)
 2611    },
 2612    blanks,
 2613    header(Tail).
 2614header([]) -->
 2615    blanks,
 2616    eos,
 2617    !.
 2618header(_) -->
 2619    string(S), blanks_to_nl,
 2620    !,
 2621    { string_codes(Line, S),
 2622      syntax_error(http_parameter(Line))
 2623    }.
 address//
Emit the HTML for the server address on behalve of error and status messages (non-200 replies). Default is
SWI-Prolog httpd at <hostname>

The address can be modified by providing a definition for the multifile predicate http_address//0.

 2637:- multifile
 2638    http:http_address//0. 2639
 2640address -->
 2641    http:http_address,
 2642    !.
 2643address -->
 2644    { gethostname(Host) },
 2645    html(address([ a(href('http://www.swi-prolog.org'), 'SWI-Prolog'),
 2646                   ' httpd at ', Host
 2647                 ])).
 2648
 2649mkfield(host, Host:Port, [host(Host),port(Port)|Tail], Tail) :- !.
 2650mkfield(Name, Value, [Att|Tail], Tail) :-
 2651    Att =.. [Name, Value].
 http:http_address// is det
HTML-rule that emits the location of the HTTP server. This hook is called from address//0 to customise the server address. The server address is emitted on non-200-ok replies.
 http:status_page(+Status, +Context, -HTMLTokens) is semidet
Hook called by http_status_reply/4 and http_status_reply/5 that allows for emitting custom error pages for the following HTTP page types:

The hook is tried twice, first using the status term, e.g., not_found(URL) and than with the code, e.g. 404. The second call is deprecated and only exists for compatibility.

Arguments:
Context- is the 4th argument of http_status_reply/5, which is invoked after raising an exception of the format http_reply(Status, HeaderExtra, Context). The default context is [] (the empty list).
HTMLTokens- is a list of tokens as produced by html//1. It is passed to print_html/2.
 2690                 /*******************************
 2691                 *            MESSAGES          *
 2692                 *******************************/
 2693
 2694:- multifile
 2695    prolog:message//1,
 2696    prolog:error_message//1. 2697
 2698prolog:error_message(http_write_short(Data, Sent)) -->
 2699    data(Data),
 2700    [ ': remote hangup after ~D bytes'-[Sent] ].
 2701prolog:error_message(syntax_error(http_request(Request))) -->
 2702    [ 'Illegal HTTP request: ~s'-[Request] ].
 2703prolog:error_message(syntax_error(http_parameter(Line))) -->
 2704    [ 'Illegal HTTP parameter: ~s'-[Line] ].
 2705
 2706prolog:message(http(skipped_cookie(S))) -->
 2707    [ 'Skipped illegal cookie: ~s'-[S] ].
 2708
 2709data(bytes(MimeType, _Bytes)) -->
 2710    !,
 2711    [ 'bytes(~p, ...)'-[MimeType] ].
 2712data(Data) -->
 2713    [ '~p'-[Data] ]