View source with raw comments or as raw
    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-2016, 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_open,
   37          [ http_open/3,                % +URL, -Stream, +Options
   38            http_set_authorization/2,   % +URL, +Authorization
   39            http_close_keep_alive/1     % +Address
   40          ]).   41:- use_module(library(uri)).   42:- use_module(library(readutil)).   43:- use_module(library(socket)).   44:- use_module(library(lists)).   45:- use_module(library(option)).   46:- use_module(library(error)).   47:- use_module(library(base64)).   48:- use_module(library(debug)).   49:- use_module(library(aggregate)).   50:- use_module(library(apply)).   51:- use_module(library(http/http_header), [http_parse_header/2]).   52:- use_module(library(http/http_stream)).

HTTP client library

This library defines http_open/3, which opens a URL as a Prolog stream. The functionality of the library can be extended by loading two additional modules that act as plugins:

library(http/http_ssl_plugin)
Loading this library causes http_open/3 to handle HTTPS connections. Relevant options for SSL certificate handling are handed to ssl_context/3. This plugin is loaded automatically if the scheme https is requested using a default SSL context. See the plugin for additional information regarding security.
library(http/http_cookie)
Loading this library adds tracking cookies to http_open/3. Returned cookies are collected in the Prolog database and supplied for subsequent requests.

Here is a simple example to fetch a web-page:

?- http_open('http://www.google.com/search?q=prolog', In, []),
   copy_stream_data(In, user_output),
   close(In).
<!doctype html><head><title>prolog - Google Search</title><script>
...

The example below fetches the modification time of a web-page. Note that Modified is '' (the empty atom) if the web-server does not provide a time-stamp for the resource. See also parse_time/2.

modified(URL, Stamp) :-
        http_open(URL, In,
                  [ method(head),
                    header(last_modified, Modified)
                  ]),
        close(In),
        Modified \== '',
        parse_time(Modified, Stamp).

Then next example uses Google search. It exploits library(uri) to manage URIs, library(sgml) to load an HTML document and library(xpath) to navigate the parsed HTML. Note that you may need to adjust the XPath queries if the data returned by Google changes.

:- use_module(library(http/http_open)).
:- use_module(library(xpath)).
:- use_module(library(sgml)).
:- use_module(library(uri)).

google(For, Title, HREF) :-
        uri_encoded(query_value, For, Encoded),
        atom_concat('http://www.google.com/search?q=', Encoded, URL),
        http_open(URL, In, []),
        call_cleanup(
            load_html(In, DOM, []),
            close(In)),
        xpath(DOM, //h3(@class=r), Result),
        xpath(Result, //a(@href=HREF0, text), Title),
        uri_components(HREF0, Components),
        uri_data(search, Components, Query),
        uri_query_components(Query, Parts),
        memberchk(q=HREF, Parts).

An example query is below:

?- google(prolog, Title, HREF).
Title = 'SWI-Prolog',
HREF = 'http://www.swi-prolog.org/' ;
Title = 'Prolog - Wikipedia',
HREF = 'https://nl.wikipedia.org/wiki/Prolog' ;
Title = 'Prolog - Wikipedia, the free encyclopedia',
HREF = 'https://en.wikipedia.org/wiki/Prolog' ;
Title = 'Pro-Log is logistiek dienstverlener m.b.t. vervoer over water.',
HREF = 'http://www.pro-log.nl/' ;
Title = 'Learn Prolog Now!',
HREF = 'http://www.learnprolognow.org/' ;
Title = 'Free Online Version - Learn Prolog
...
See also
- load_html/3 and xpath/3 can be used to parse and navigate HTML documents.
-
http_get/3 and http_post/4 provide an alternative interface that convert the reply depending on the Content-Type header. */
  147:- multifile
  148    http:encoding_filter/3,           % +Encoding, +In0, -In
  149    http:current_transfer_encoding/1, % ?Encoding
  150    http:disable_encoding_filter/1,   % +ContentType
  151    http:http_protocol_hook/5,        % +Protocol, +Parts, +StreamPair,
  152                                      % -NewStreamPair, +Options
  153    http:open_options/2,              % +Parts, -Options
  154    http:write_cookies/3,             % +Out, +Parts, +Options
  155    http:update_cookies/3,            % +CookieLine, +Parts, +Options
  156    http:authenticate_client/2,       % +URL, +Action
  157    http:http_connection_over_proxy/6.  158
  159:- meta_predicate
  160    http_open(+,-,:).  161
  162:- predicate_options(http_open/3, 3,
  163                     [ authorization(compound),
  164                       final_url(-atom),
  165                       header(+atom, -atom),
  166                       headers(-list),
  167                       connection(+atom),
  168                       method(oneof([delete,get,put,head,post,patch,options])),
  169                       size(-integer),
  170                       status_code(-integer),
  171                       output(-stream),
  172                       timeout(number),
  173                       proxy(atom, integer),
  174                       proxy_authorization(compound),
  175                       bypass_proxy(boolean),
  176                       request_header(any),
  177                       user_agent(atom),
  178                       version(-compound),
  179        % The option below applies if library(http/http_header) is loaded
  180                       post(any),
  181        % The options below apply if library(http/http_ssl_plugin)) is loaded
  182                       pem_password_hook(callable),
  183                       cacert_file(atom),
  184                       cert_verify_hook(callable)
  185                     ]).
 user_agent(-Agent) is det
Default value for User-Agent, can be overruled using the option user_agent(Agent) of http_open/3.
  192user_agent('SWI-Prolog').
 http_open(+URL, -Stream, +Options) is det
Open the data at the HTTP server as a Prolog stream. URL is either an atom specifying a URL or a list representing a broken-down URL as specified below. After this predicate succeeds the data can be read from Stream. After completion this stream must be closed using the built-in Prolog predicate close/1. Options provides additional options:
authenticate(+Boolean)
If false (default true), do not try to automatically authenticate the client if a 401 (Unauthorized) status code is received.
authorization(+Term)
Send authorization. See also http_set_authorization/2. Supported schemes:
basic(+User, +Password)
HTTP Basic authentication.
bearer(+Token)
HTTP Bearer authentication.
digest(+User, +Password)
HTTP Digest authentication. This option is only provided if the plugin library(http/http_digest) is also loaded.
connection(+Connection)
Specify the Connection header. Default is close. The alternative is Keep-alive. This maintains a pool of available connections as determined by keep_connection/1. The library(http/websockets) uses Keep-alive, Upgrade. Keep-alive connections can be closed explicitly using http_close_keep_alive/1. Keep-alive connections may significantly improve repetitive requests on the same server, especially if the IP route is long, HTTPS is used or the connection uses a proxy.
final_url(-FinalURL)
Unify FinalURL with the final destination. This differs from the original URL if the returned head of the original indicates an HTTP redirect (codes 301, 302 or 303). Without a redirect, FinalURL is the same as URL if URL is an atom, or a URL constructed from the parts.
header(Name, -AtomValue)
If provided, AtomValue is unified with the value of the indicated field in the reply header. Name is matched case-insensitive and the underscore (_) matches the hyphen (-). Multiple of these options may be provided to extract multiple header fields. If the header is not available AtomValue is unified to the empty atom ('').
headers(-List)
If provided, List is unified with a list of Name(Value) pairs corresponding to fields in the reply header. Name and Value follow the same conventions used by the header(Name,Value) option.
method(+Method)
One of get (default), head, delete, post, put or patch. The head message can be used in combination with the header(Name, Value) option to access information on the resource without actually fetching the resource itself. The returned stream must be closed immediately.

If post(Data) is provided, the default is post.

size(-Size)
Size is unified with the integer value of Content-Length in the reply header.
version(-Version)
Version is a pair Major-Minor, where Major and Minor are integers representing the HTTP version in the reply header.
range(+Range)
Ask for partial content. Range is a term Unit(From,To), where From is an integer and To is either an integer or the atom end. HTTP 1.1 only supports Unit = bytes. E.g., to ask for bytes 1000-1999, use the option range(bytes(1000,1999))
redirect(+Boolean)
If false (default true), do not automatically redirect if a 3XX code is received. Must be combined with status_code(Code) and one of the header options to read the redirect reply. In particular, without status_code(Code) a redirect is mapped to an exception.
status_code(-Code)
If this option is present and Code unifies with the HTTP status code, do not translate errors (4xx, 5xx) into an exception. Instead, http_open/3 behaves as if 200 (success) is returned, providing the application to read the error document from the returned stream.
output(-Out)
Unify the output stream with Out and do not close it. This can be used to upgrade a connection.
timeout(+Timeout)
If provided, set a timeout on the stream using set_stream/2. With this option if no new data arrives within Timeout seconds the stream raises an exception. Default is to wait forever (infinite).
post(+Data)
Issue a POST request on the HTTP server. Data is handed to http_post_data/3.
proxy(+Host:Port)
Use an HTTP proxy to connect to the outside world. See also socket:proxy_for_url/3. This option overrules the proxy specification defined by socket:proxy_for_url/3.
proxy(+Host, +Port)
Synonym for proxy(+Host:Port). Deprecated.
proxy_authorization(+Authorization)
Send authorization to the proxy. Otherwise the same as the authorization option.
bypass_proxy(+Boolean)
If true, bypass proxy hooks. Default is false.
request_header(Name=Value)
Additional name-value parts are added in the order of appearance to the HTTP request header. No interpretation is done.
max_redirect(+Max)
Sets the maximum length of a redirection chain. This is needed for some IRIs that redirect indefinitely to other IRIs without looping (e.g., redirecting to IRIs with a random element in them). Max must be either a non-negative integer or the atom infinite. The default value is 10.
user_agent(+Agent)
Defines the value of the User-Agent field of the HTTP header. Default is SWI-Prolog.

The hook http:open_options/2 can be used to provide default options based on the broken-down URL. The option status_code(-Code) is particularly useful to query REST interfaces that commonly return status codes other than 200 that need to be be processed by the client code.

Arguments:
URL- is either an atom or string (url) or a list of parts.
  345%               When provided, this list may contain the fields
  346%               =scheme=, =user=, =password=, =host=, =port=, =path=
  347%               and either =query_string= (whose argument is an atom)
  348%               or =search= (whose argument is a list of
  349%               =|Name(Value)|= or =|Name=Value|= compound terms).
  350%               Only =host= is mandatory.  The example below opens the
  351%               URL =|http://www.example.com/my/path?q=Hello%20World&lang=en|=.
  352%               Note that values must *not* be quoted because the
  353%               library inserts the required quotes.
  354%
  355%               ==
  356%               http_open([ host('www.example.com'),
  357%                           path('/my/path'),
  358%                           search([ q='Hello world',
  359%                                    lang=en
  360%                                  ])
  361%                         ])
  362%               ==
  363%
  364%       @error existence_error(url, Id)
  365%       @see ssl_context/3 for SSL related options if
  366%       library(http/http_ssl_plugin) is loaded.
  367
  368:- multifile
  369    socket:proxy_for_url/3.           % +URL, +Host, -ProxyList
  370
  371http_open(URL, Stream, QOptions) :-
  372    meta_options(is_meta, QOptions, Options),
  373    (   atomic(URL)
  374    ->  parse_url_ex(URL, Parts)
  375    ;   Parts = URL
  376    ),
  377    autoload_https(Parts),
  378    add_authorization(Parts, Options, Options1),
  379    findall(HostOptions,
  380            http:open_options(Parts, HostOptions),
  381            AllHostOptions),
  382    foldl(merge_options_rev, AllHostOptions, Options1, Options2),
  383    (   option(bypass_proxy(true), Options)
  384    ->  try_http_proxy(direct, Parts, Stream, Options2)
  385    ;   term_variables(Options2, Vars2),
  386        findall(Result-Vars2,
  387                try_a_proxy(Parts, Result, Options2),
  388                ResultList),
  389        last(ResultList, Status-Vars2)
  390    ->  (   Status = true(_Proxy, Stream)
  391        ->  true
  392        ;   throw(error(proxy_error(tried(ResultList)), _))
  393        )
  394    ;   try_http_proxy(direct, Parts, Stream, Options2)
  395    ).
  396
  397try_a_proxy(Parts, Result, Options) :-
  398    parts_uri(Parts, AtomicURL),
  399    option(host(Host), Parts),
  400    (   (   option(proxy(ProxyHost:ProxyPort), Options)
  401        ;   is_list(Options),
  402            memberchk(proxy(ProxyHost,ProxyPort), Options)
  403        )
  404    ->  Proxy = proxy(ProxyHost, ProxyPort)
  405    ;   socket:proxy_for_url(AtomicURL, Host, Proxy)
  406    ),
  407    debug(http(proxy),
  408          'http_open: Connecting via ~w to ~w', [Proxy, AtomicURL]),
  409    (   catch(try_http_proxy(Proxy, Parts, Stream, Options), E, true)
  410    ->  (   var(E)
  411        ->  !, Result = true(Proxy, Stream)
  412        ;   Result = error(Proxy, E)
  413        )
  414    ;   Result = false(Proxy)
  415    ),
  416    debug(http(proxy), 'http_open: ~w: ~p', [Proxy, Result]).
  417
  418try_http_proxy(Method, Parts, Stream, Options0) :-
  419    option(host(Host), Parts),
  420    (   Method == direct
  421    ->  parts_request_uri(Parts, RequestURI)
  422    ;   parts_uri(Parts, RequestURI)
  423    ),
  424    select_option(visited(Visited0), Options0, OptionsV, []),
  425    Options = [visited([Parts|Visited0])|OptionsV],
  426    parts_scheme(Parts, Scheme),
  427    default_port(Scheme, DefPort),
  428    url_part(port(Port), Parts, DefPort),
  429    host_and_port(Host, DefPort, Port, HostPort),
  430    (   option(connection(Connection), Options0),
  431        keep_alive(Connection),
  432        get_from_pool(Host:Port, StreamPair),
  433        debug(http(connection), 'Trying Keep-alive to ~p using ~p',
  434              [ Host:Port, StreamPair ]),
  435        catch(send_rec_header(StreamPair, Stream, HostPort,
  436                              RequestURI, Parts, Options),
  437              error(E,_),
  438              keep_alive_error(E))
  439    ->  true
  440    ;   http:http_connection_over_proxy(Method, Parts, Host:Port,
  441                                        SocketStreamPair, Options, Options1),
  442        (   catch(http:http_protocol_hook(Scheme, Parts,
  443                                          SocketStreamPair,
  444                                          StreamPair, Options),
  445                  Error,
  446                  ( close(SocketStreamPair, [force(true)]),
  447                    throw(Error)))
  448        ->  true
  449        ;   StreamPair = SocketStreamPair
  450        ),
  451        send_rec_header(StreamPair, Stream, HostPort,
  452                        RequestURI, Parts, Options1)
  453    ),
  454    return_final_url(Options).
  455
  456http:http_connection_over_proxy(direct, _, Host:Port,
  457                                StreamPair, Options, Options) :-
  458    !,
  459    open_socket(Host:Port, StreamPair, Options).
  460http:http_connection_over_proxy(proxy(ProxyHost, ProxyPort), Parts, _,
  461                                StreamPair, Options, Options) :-
  462    \+ ( memberchk(scheme(Scheme), Parts),
  463         secure_scheme(Scheme)
  464       ),
  465    !,
  466    % We do not want any /more/ proxy after this
  467    open_socket(ProxyHost:ProxyPort, StreamPair,
  468                [bypass_proxy(true)|Options]).
  469http:http_connection_over_proxy(socks(SocksHost, SocksPort), _Parts, Host:Port,
  470                                StreamPair, Options, Options) :-
  471    !,
  472    tcp_connect(SocksHost:SocksPort, StreamPair, [bypass_proxy(true)]),
  473    catch(negotiate_socks_connection(Host:Port, StreamPair),
  474          Error,
  475          ( close(StreamPair, [force(true)]),
  476            throw(Error)
  477          )).
  478
  479
  480merge_options_rev(Old, New, Merged) :-
  481    merge_options(New, Old, Merged).
  482
  483is_meta(pem_password_hook).             % SSL plugin callbacks
  484is_meta(cert_verify_hook).
  485
  486
  487http:http_protocol_hook(http, _, StreamPair, StreamPair, _).
  488
  489default_port(https, 443) :- !.
  490default_port(wss,   443) :- !.
  491default_port(_,     80).
  492
  493host_and_port(Host, DefPort, DefPort, Host) :- !.
  494host_and_port(Host, _,       Port,    Host:Port).
 autoload_https(+Parts) is det
If the requested scheme is https or wss, load the HTTPS plugin.
  500autoload_https(Parts) :-
  501    memberchk(scheme(S), Parts),
  502    secure_scheme(S),
  503    \+ clause(http:http_protocol_hook(S, _, StreamPair, StreamPair, _),_),
  504    exists_source(library(http/http_ssl_plugin)),
  505    !,
  506    use_module(library(http/http_ssl_plugin)).
  507autoload_https(_).
  508
  509secure_scheme(https).
  510secure_scheme(wss).
 send_rec_header(+StreamPair, -Stream, +Host, +RequestURI, +Parts, +Options) is det
Send header to Out and process reply. If there is an error or failure, close In and Out and return the error or failure.
  518send_rec_header(StreamPair, Stream, Host, RequestURI, Parts, Options) :-
  519    (   catch(guarded_send_rec_header(StreamPair, Stream,
  520                                      Host, RequestURI, Parts, Options),
  521              E, true)
  522    ->  (   var(E)
  523        ->  (   option(output(StreamPair), Options)
  524            ->  true
  525            ;   true
  526            )
  527        ;   close(StreamPair, [force(true)]),
  528            throw(E)
  529        )
  530    ;   close(StreamPair, [force(true)]),
  531        fail
  532    ).
  533
  534guarded_send_rec_header(StreamPair, Stream, Host, RequestURI, Parts, Options) :-
  535    user_agent(Agent, Options),
  536    method(Options, MNAME),
  537    http_version(Version),
  538    option(connection(Connection), Options, close),
  539    debug(http(send_request), "> ~w ~w HTTP/~w", [MNAME, RequestURI, Version]),
  540    debug(http(send_request), "> Host: ~w", [Host]),
  541    debug(http(send_request), "> User-Agent: ~w", [Agent]),
  542    debug(http(send_request), "> Connection: ~w", [Connection]),
  543    format(StreamPair,
  544           '~w ~w HTTP/~w\r\n\c
  545               Host: ~w\r\n\c
  546               User-Agent: ~w\r\n\c
  547               Connection: ~w\r\n',
  548           [MNAME, RequestURI, Version, Host, Agent, Connection]),
  549    parts_uri(Parts, URI),
  550    x_headers(Options, URI, StreamPair),
  551    write_cookies(StreamPair, Parts, Options),
  552    (   option(post(PostData), Options)
  553    ->  http_header:http_post_data(PostData, StreamPair, [])
  554    ;   format(StreamPair, '\r\n', [])
  555    ),
  556    flush_output(StreamPair),
  557                                    % read the reply header
  558    read_header(StreamPair, Parts, ReplyVersion, Code, Comment, Lines),
  559    update_cookies(Lines, Parts, Options),
  560    do_open(ReplyVersion, Code, Comment, Lines, Options, Parts, Host,
  561            StreamPair, Stream).
 http_version(-Version:atom) is det
HTTP version we publish. We can only use 1.1 if we support chunked encoding.
  569http_version('1.1') :-
  570    http:current_transfer_encoding(chunked),
  571    !.
  572http_version('1.0').
  573
  574method(Options, MNAME) :-
  575    option(post(_), Options),
  576    !,
  577    option(method(M), Options, post),
  578    (   map_method(M, MNAME0)
  579    ->  MNAME = MNAME0
  580    ;   domain_error(method, M)
  581    ).
  582method(Options, MNAME) :-
  583    option(method(M), Options, get),
  584    (   map_method(M, MNAME0)
  585    ->  MNAME = MNAME0
  586    ;   map_method(_, M)
  587    ->  MNAME = M
  588    ;   domain_error(method, M)
  589    ).
  590
  591map_method(delete,  'DELETE').
  592map_method(get,     'GET').
  593map_method(head,    'HEAD').
  594map_method(post,    'POST').
  595map_method(put,     'PUT').
  596map_method(patch,   'PATCH').
  597map_method(options, 'OPTIONS').
 x_headers(+Options, +URI, +Out) is det
Emit extra headers from request_header(Name=Value) options in Options.
To be done
- Use user/password fields
  606x_headers(Options, URI, Out) :-
  607    x_headers_(Options, [url(URI)|Options], Out).
  608
  609x_headers_([], _, _).
  610x_headers_([H|T], Options, Out) :-
  611    x_header(H, Options, Out),
  612    x_headers_(T, Options, Out).
  613
  614x_header(request_header(Name=Value), _, Out) :-
  615    !,
  616    debug(http(send_request), "> ~w: ~w", [Name, Value]),
  617    format(Out, '~w: ~w\r\n', [Name, Value]).
  618x_header(proxy_authorization(ProxyAuthorization), Options, Out) :-
  619    !,
  620    auth_header(ProxyAuthorization, Options, 'Proxy-Authorization', Out).
  621x_header(authorization(Authorization), Options, Out) :-
  622    !,
  623    auth_header(Authorization, Options, 'Authorization', Out).
  624x_header(range(Spec), _, Out) :-
  625    !,
  626    Spec =.. [Unit, From, To],
  627    (   To == end
  628    ->  ToT = ''
  629    ;   must_be(integer, To),
  630        ToT = To
  631    ),
  632    debug(http(send_request), "> Range: ~w=~d-~w", [Unit, From, ToT]),
  633    format(Out, 'Range: ~w=~d-~w\r\n', [Unit, From, ToT]).
  634x_header(_, _, _).
 auth_header(+AuthOption, +Options, +HeaderName, +Out)
  638auth_header(basic(User, Password), _, Header, Out) :-
  639    !,
  640    format(codes(Codes), '~w:~w', [User, Password]),
  641    phrase(base64(Codes), Base64Codes),
  642    debug(http(send_request), "> ~w: Basic ~s", [Header, Base64Codes]),
  643    format(Out, '~w: Basic ~s\r\n', [Header, Base64Codes]).
  644auth_header(bearer(Token), _, Header, Out) :-
  645    !,
  646    debug(http(send_request), "> ~w: Bearer ~w", [Header,Token]),
  647    format(Out, '~w: Bearer ~w\r\n', [Header, Token]).
  648auth_header(Auth, Options, _, Out) :-
  649    option(url(URL), Options),
  650    add_method(Options, Options1),
  651    http:authenticate_client(URL, send_auth_header(Auth, Out, Options1)),
  652    !.
  653auth_header(Auth, _, _, _) :-
  654    domain_error(authorization, Auth).
  655
  656user_agent(Agent, Options) :-
  657    (   option(user_agent(Agent), Options)
  658    ->  true
  659    ;   user_agent(Agent)
  660    ).
  661
  662add_method(Options0, Options) :-
  663    option(method(_), Options0),
  664    !,
  665    Options = Options0.
  666add_method(Options0, Options) :-
  667    option(post(_), Options0),
  668    !,
  669    Options = [method(post)|Options0].
  670add_method(Options0, [method(get)|Options0]).
 do_open(+HTTPVersion, +HTTPStatusCode, +HTTPStatusComment, +Header, +Options, +Parts, +Host, +In, -FinalIn) is det
Handle the HTTP status. If 200, we are ok. If a redirect, redo the open, returning a new stream. Else issue an error.
Errors
- existence_error(url, URL)
  681                                        % Redirections
  682do_open(_, Code, _, Lines, Options0, Parts, _, In, Stream) :-
  683    redirect_code(Code),
  684    option(redirect(true), Options0, true),
  685    location(Lines, RequestURI),
  686    !,
  687    debug(http(redirect), 'http_open: redirecting to ~w', [RequestURI]),
  688    close(In),
  689    parts_uri(Parts, Base),
  690    uri_resolve(RequestURI, Base, Redirected),
  691    parse_url_ex(Redirected, RedirectedParts),
  692    (   redirect_limit_exceeded(Options0, Max)
  693    ->  format(atom(Comment), 'max_redirect (~w) limit exceeded', [Max]),
  694        throw(error(permission_error(redirect, http, Redirected),
  695                    context(_, Comment)))
  696    ;   redirect_loop(RedirectedParts, Options0)
  697    ->  throw(error(permission_error(redirect, http, Redirected),
  698                    context(_, 'Redirection loop')))
  699    ;   true
  700    ),
  701    redirect_options(Options0, Options),
  702    http_open(RedirectedParts, Stream, Options).
  703                                        % Need authentication
  704do_open(_Version, Code, _Comment, Lines, Options0, Parts, _Host, In0, Stream) :-
  705    authenticate_code(Code),
  706    option(authenticate(true), Options0, true),
  707    parts_uri(Parts, URI),
  708    parse_headers(Lines, Headers),
  709    http:authenticate_client(
  710             URI,
  711             auth_reponse(Headers, Options0, Options)),
  712    !,
  713    close(In0),
  714    http_open(Parts, Stream, Options).
  715                                        % Accepted codes
  716do_open(Version, Code, _, Lines, Options, Parts, Host, In0, In) :-
  717    (   option(status_code(Code), Options),
  718        Lines \== []
  719    ->  true
  720    ;   Code == 200
  721    ),
  722    !,
  723    parts_uri(Parts, URI),
  724    parse_headers(Lines, Headers),
  725    return_version(Options, Version),
  726    return_size(Options, Headers),
  727    return_fields(Options, Headers),
  728    return_headers(Options, Headers),
  729    consider_keep_alive(Lines, Parts, Host, In0, In1, Options),
  730    transfer_encoding_filter(Lines, In1, In),
  731                                    % properly re-initialise the stream
  732    set_stream(In, file_name(URI)),
  733    set_stream(In, record_position(true)).
  734do_open(_, _, _, [], Options, _, _, _, _) :-
  735    option(connection(Connection), Options),
  736    keep_alive(Connection),
  737    !,
  738    throw(error(keep_alive(closed),_)).
  739                                        % report anything else as error
  740do_open(_Version, Code, Comment, _,  _, Parts, _, _, _) :-
  741    parts_uri(Parts, URI),
  742    (   map_error_code(Code, Error)
  743    ->  Formal =.. [Error, url, URI]
  744    ;   Formal = existence_error(url, URI)
  745    ),
  746    throw(error(Formal, context(_, status(Code, Comment)))).
 redirect_limit_exceeded(+Options:list(compound), -Max:nonneg) is semidet
True if we have exceeded the maximum redirection length (default 10).
  753redirect_limit_exceeded(Options, Max) :-
  754    option(visited(Visited), Options, []),
  755    length(Visited, N),
  756    option(max_redirect(Max), Options, 10),
  757    (Max == infinite -> fail ; N > Max).
 redirect_loop(+Parts, +Options) is semidet
True if we are in a redirection loop. Note that some sites redirect once to the same place using cookies or similar, so we allow for two tries. In fact, we should probably test whether authorization or cookie headers have changed.
  767redirect_loop(Parts, Options) :-
  768    option(visited(Visited), Options, []),
  769    include(==(Parts), Visited, Same),
  770    length(Same, Count),
  771    Count > 2.
 redirect_options(+Options0, -Options) is det
A redirect from a POST should do a GET on the returned URI. This means we must remove the method(post) and post(Data) options from the original option-list.
  780redirect_options(Options0, Options) :-
  781    (   select_option(post(_), Options0, Options1)
  782    ->  true
  783    ;   Options1 = Options0
  784    ),
  785    (   select_option(method(Method), Options1, Options),
  786        \+ redirect_method(Method)
  787    ->  true
  788    ;   Options = Options1
  789    ).
  790
  791redirect_method(delete).
  792redirect_method(get).
  793redirect_method(head).
 map_error_code(+HTTPCode, -PrologError) is semidet
Map HTTP error codes to Prolog errors.
To be done
- Many more maps. Unfortunately many have no sensible Prolog counterpart.
  803map_error_code(401, permission_error).
  804map_error_code(403, permission_error).
  805map_error_code(404, existence_error).
  806map_error_code(405, permission_error).
  807map_error_code(407, permission_error).
  808map_error_code(410, existence_error).
  809
  810redirect_code(301).                     % moved permanently
  811redirect_code(302).                     % moved temporary
  812redirect_code(303).                     % see also
  813
  814authenticate_code(401).
 open_socket(+Address, -StreamPair, +Options) is det
Create and connect a client socket to Address. Options
timeout(+Timeout)
Sets timeout on the stream, after connecting the socket.
To be done
- Make timeout also work on tcp_connect/4.
- This is the same as do_connect/4 in http_client.pl
  827open_socket(Address, StreamPair, Options) :-
  828    debug(http(open), 'http_open: Connecting to ~p ...', [Address]),
  829    tcp_connect(Address, StreamPair, Options),
  830    stream_pair(StreamPair, In, Out),
  831    debug(http(open), '\tok ~p ---> ~p', [In, Out]),
  832    set_stream(In, record_position(false)),
  833    (   option(timeout(Timeout), Options)
  834    ->  set_stream(In, timeout(Timeout))
  835    ;   true
  836    ).
  837
  838
  839return_version(Options, Major-Minor) :-
  840    option(version(Major-Minor), Options, _).
  841
  842return_size(Options, Headers) :-
  843    (   memberchk(content_length(Size), Headers)
  844    ->  option(size(Size), Options, _)
  845    ;   true
  846    ).
  847
  848return_fields([], _).
  849return_fields([header(Name, Value)|T], Headers) :-
  850    !,
  851    (   Term =.. [Name,Value],
  852        memberchk(Term, Headers)
  853    ->  true
  854    ;   Value = ''
  855    ),
  856    return_fields(T, Headers).
  857return_fields([_|T], Lines) :-
  858    return_fields(T, Lines).
  859
  860return_headers(Options, Headers) :-
  861    option(headers(Headers), Options, _).
 parse_headers(+Lines, -Headers:list(compound)) is det
Parse the header lines for the headers(-List) option. Invalid header lines are skipped, printing a warning using pring_message/2.
  869parse_headers([], []) :- !.
  870parse_headers([Line|Lines], Headers) :-
  871    catch(http_parse_header(Line, [Header]), Error, true),
  872    (   var(Error)
  873    ->  Headers = [Header|More]
  874    ;   print_message(warning, Error),
  875        Headers = More
  876    ),
  877    parse_headers(Lines, More).
 return_final_url(+Options) is semidet
If Options contains final_url(URL), unify URL with the final URL after redirections.
  885return_final_url(Options) :-
  886    option(final_url(URL), Options),
  887    var(URL),
  888    !,
  889    option(visited([Parts|_]), Options),
  890    parts_uri(Parts, URL).
  891return_final_url(_).
 transfer_encoding_filter(+Lines, +In0, -In) is det
Install filters depending on the transfer encoding. If In0 is a stream-pair, we close the output side. If transfer-encoding is not specified, the content-encoding is interpreted as a synonym for transfer-encoding, because many servers incorrectly depend on this. Exceptions to this are content-types for which disable_encoding_filter/1 holds.
  903transfer_encoding_filter(Lines, In0, In) :-
  904    transfer_encoding(Lines, Encoding),
  905    !,
  906    transfer_encoding_filter_(Encoding, In0, In).
  907transfer_encoding_filter(Lines, In0, In) :-
  908    content_encoding(Lines, Encoding),
  909    content_type(Lines, Type),
  910    \+ http:disable_encoding_filter(Type),
  911    !,
  912    transfer_encoding_filter_(Encoding, In0, In).
  913transfer_encoding_filter(_, In, In).
  914
  915transfer_encoding_filter_(Encoding, In0, In) :-
  916    stream_pair(In0, In1, Out),
  917    (   nonvar(Out)
  918    ->  close(Out)
  919    ;   true
  920    ),
  921    (   http:encoding_filter(Encoding, In1, In)
  922    ->  true
  923    ;   domain_error(http_encoding, Encoding)
  924    ).
  925
  926content_type(Lines, Type) :-
  927    member(Line, Lines),
  928    phrase(field('content-type'), Line, Rest),
  929    !,
  930    atom_codes(Type, Rest).
 http:disable_encoding_filter(+ContentType) is semidet
Do not use the Content-encoding as Transfer-encoding encoding for specific values of ContentType. This predicate is multifile and can thus be extended by the user.
  938http:disable_encoding_filter('application/x-gzip').
  939http:disable_encoding_filter('application/x-tar').
  940http:disable_encoding_filter('x-world/x-vrml').
  941http:disable_encoding_filter('application/zip').
  942http:disable_encoding_filter('application/x-gzip').
  943http:disable_encoding_filter('application/x-zip-compressed').
  944http:disable_encoding_filter('application/x-compress').
  945http:disable_encoding_filter('application/x-compressed').
  946http:disable_encoding_filter('application/x-spoon').
 transfer_encoding(+Lines, -Encoding) is semidet
True if Encoding is the value of the Transfer-encoding header.
  953transfer_encoding(Lines, Encoding) :-
  954    what_encoding(transfer_encoding, Lines, Encoding).
  955
  956what_encoding(What, Lines, Encoding) :-
  957    member(Line, Lines),
  958    phrase(encoding_(What, Debug), Line, Rest),
  959    !,
  960    atom_codes(Encoding, Rest),
  961    debug(http(What), '~w: ~p', [Debug, Rest]).
  962
  963encoding_(content_encoding, 'Content-encoding') -->
  964    field('content-encoding').
  965encoding_(transfer_encoding, 'Transfer-encoding') -->
  966    field('transfer-encoding').
 content_encoding(+Lines, -Encoding) is semidet
True if Encoding is the value of the Content-encoding header.
  973content_encoding(Lines, Encoding) :-
  974    what_encoding(content_encoding, Lines, Encoding).
 read_header(+In:stream, +Parts, -Version, -Code:int, -Comment:atom, -Lines:list) is det
Read the HTTP reply-header. If the reply is completely empty an existence error is thrown. If the replied header is otherwise invalid a 500 HTTP error is simulated, having the comment Invalid reply header.
Arguments:
Parts- A list of compound terms that describe the parsed request URI.
Version- HTTP reply version as Major-Minor pair
Code- Numeric HTTP reply-code
Comment- Comment of reply-code as atom
Lines- Remaining header lines as code-lists.
Errors
- existence_error(http_reply, Uri)
  993read_header(In, Parts, Major-Minor, Code, Comment, Lines) :-
  994    read_line_to_codes(In, Line),
  995    (   Line == end_of_file
  996    ->  parts_uri(Parts, Uri),
  997        existence_error(http_reply,Uri)
  998    ;   true
  999    ),
 1000    Line \== end_of_file,
 1001    phrase(first_line(Major-Minor, Code, Comment), Line),
 1002    debug(http(open), 'HTTP/~d.~d ~w ~w', [Major, Minor, Code, Comment]),
 1003    read_line_to_codes(In, Line2),
 1004    rest_header(Line2, In, Lines),
 1005    !,
 1006    (   debugging(http(open))
 1007    ->  forall(member(HL, Lines),
 1008               debug(http(open), '~s', [HL]))
 1009    ;   true
 1010    ).
 1011read_header(_, _, 1-1, 500, 'Invalid reply header', []).
 1012
 1013rest_header([], _, []) :- !.            % blank line: end of header
 1014rest_header(L0, In, [L0|L]) :-
 1015    read_line_to_codes(In, L1),
 1016    rest_header(L1, In, L).
 content_length(+Header, -Length:int) is semidet
Find the Content-Length in an HTTP reply-header.
 1022content_length(Lines, Length) :-
 1023    member(Line, Lines),
 1024    phrase(content_length(Length0), Line),
 1025    !,
 1026    Length = Length0.
 1027
 1028location(Lines, RequestURI) :-
 1029    member(Line, Lines),
 1030    phrase(atom_field(location, RequestURI), Line),
 1031    !.
 1032
 1033connection(Lines, Connection) :-
 1034    member(Line, Lines),
 1035    phrase(atom_field(connection, Connection0), Line),
 1036    !,
 1037    Connection = Connection0.
 1038
 1039first_line(Major-Minor, Code, Comment) -->
 1040    "HTTP/", integer(Major), ".", integer(Minor),
 1041    skip_blanks,
 1042    integer(Code),
 1043    skip_blanks,
 1044    rest(Comment).
 1045
 1046atom_field(Name, Value) -->
 1047    field(Name),
 1048    rest(Value).
 1049
 1050content_length(Len) -->
 1051    field('content-length'),
 1052    integer(Len).
 1053
 1054field(Name) -->
 1055    { atom_codes(Name, Codes) },
 1056    field_codes(Codes).
 1057
 1058field_codes([]) -->
 1059    ":",
 1060    skip_blanks.
 1061field_codes([H|T]) -->
 1062    [C],
 1063    { match_header_char(H, C)
 1064    },
 1065    field_codes(T).
 1066
 1067match_header_char(C, C) :- !.
 1068match_header_char(C, U) :-
 1069    code_type(C, to_lower(U)),
 1070    !.
 1071match_header_char(0'_, 0'-).
 1072
 1073
 1074skip_blanks -->
 1075    [C],
 1076    { code_type(C, white)
 1077    },
 1078    !,
 1079    skip_blanks.
 1080skip_blanks -->
 1081    [].
 integer(-Int)//
Read 1 or more digits and return as integer.
 1087integer(Code) -->
 1088    digit(D0),
 1089    digits(D),
 1090    { number_codes(Code, [D0|D])
 1091    }.
 1092
 1093digit(C) -->
 1094    [C],
 1095    { code_type(C, digit)
 1096    }.
 1097
 1098digits([D0|D]) -->
 1099    digit(D0),
 1100    !,
 1101    digits(D).
 1102digits([]) -->
 1103    [].
 rest(-Atom:atom)//
Get rest of input as an atom.
 1109rest(Atom) --> call(rest_(Atom)).
 1110
 1111rest_(Atom, L, []) :-
 1112    atom_codes(Atom, L).
 1113
 1114
 1115                 /*******************************
 1116                 *   AUTHORIZATION MANAGEMENT   *
 1117                 *******************************/
 http_set_authorization(+URL, +Authorization) is det
Set user/password to supply with URLs that have URL as prefix. If Authorization is the atom -, possibly defined authorization is cleared. For example:
?- http_set_authorization('http://www.example.com/private/',
                          basic('John', 'Secret'))
To be done
- Move to a separate module, so http_get/3, etc. can use this too.
 1133:- dynamic
 1134    stored_authorization/2,
 1135    cached_authorization/2. 1136
 1137http_set_authorization(URL, Authorization) :-
 1138    must_be(atom, URL),
 1139    retractall(stored_authorization(URL, _)),
 1140    (   Authorization = (-)
 1141    ->  true
 1142    ;   check_authorization(Authorization),
 1143        assert(stored_authorization(URL, Authorization))
 1144    ),
 1145    retractall(cached_authorization(_,_)).
 1146
 1147check_authorization(Var) :-
 1148    var(Var),
 1149    !,
 1150    instantiation_error(Var).
 1151check_authorization(basic(User, Password)) :-
 1152    must_be(atom, User),
 1153    must_be(text, Password).
 1154check_authorization(digest(User, Password)) :-
 1155    must_be(atom, User),
 1156    must_be(text, Password).
 authorization(+URL, -Authorization) is semidet
True if Authorization must be supplied for URL.
To be done
- Cleanup cache if it gets too big.
 1164authorization(_, _) :-
 1165    \+ stored_authorization(_, _),
 1166    !,
 1167    fail.
 1168authorization(URL, Authorization) :-
 1169    cached_authorization(URL, Authorization),
 1170    !,
 1171    Authorization \== (-).
 1172authorization(URL, Authorization) :-
 1173    (   stored_authorization(Prefix, Authorization),
 1174        sub_atom(URL, 0, _, _, Prefix)
 1175    ->  assert(cached_authorization(URL, Authorization))
 1176    ;   assert(cached_authorization(URL, -)),
 1177        fail
 1178    ).
 1179
 1180add_authorization(_, Options, Options) :-
 1181    option(authorization(_), Options),
 1182    !.
 1183add_authorization(Parts, Options0, Options) :-
 1184    url_part(user(User), Parts),
 1185    url_part(password(Passwd), Parts),
 1186    Options = [authorization(basic(User,Passwd))|Options0].
 1187add_authorization(Parts, Options0, Options) :-
 1188    stored_authorization(_, _) ->   % quick test to avoid work
 1189    parts_uri(Parts, URL),
 1190    authorization(URL, Auth),
 1191    !,
 1192    Options = [authorization(Auth)|Options0].
 1193add_authorization(_, Options, Options).
 parse_url_ex(+URL, -Parts)
Parts: Scheme, Host, Port, User:Password, RequestURI (no fragment).
 1201parse_url_ex(URL, [uri(URL)|Parts]) :-
 1202    uri_components(URL, Components),
 1203    phrase(components(Components), Parts),
 1204    (   option(host(_), Parts)
 1205    ->  true
 1206    ;   domain_error(url, URL)
 1207    ).
 1208
 1209components(Components) -->
 1210    uri_scheme(Components),
 1211    uri_authority(Components),
 1212    uri_request_uri(Components).
 1213
 1214uri_scheme(Components) -->
 1215    { uri_data(scheme, Components, Scheme), nonvar(Scheme) },
 1216    !,
 1217    [ scheme(Scheme)
 1218    ].
 1219uri_scheme(_) --> [].
 1220
 1221uri_authority(Components) -->
 1222    { uri_data(authority, Components, Auth), nonvar(Auth),
 1223      !,
 1224      uri_authority_components(Auth, Data)
 1225    },
 1226    [ authority(Auth) ],
 1227    auth_field(user, Data),
 1228    auth_field(password, Data),
 1229    auth_field(host, Data),
 1230    auth_field(port, Data).
 1231uri_authority(_) --> [].
 1232
 1233auth_field(Field, Data) -->
 1234    { uri_authority_data(Field, Data, EncValue), nonvar(EncValue),
 1235      !,
 1236      (   atom(EncValue)
 1237      ->  uri_encoded(query_value, Value, EncValue)
 1238      ;   Value = EncValue
 1239      ),
 1240      Part =.. [Field,Value]
 1241    },
 1242    [ Part ].
 1243auth_field(_, _) --> [].
 1244
 1245uri_request_uri(Components) -->
 1246    { uri_data(path, Components, Path0),
 1247      uri_data(search, Components, Search),
 1248      (   Path0 == ''
 1249      ->  Path = (/)
 1250      ;   Path = Path0
 1251      ),
 1252      uri_data(path, Components2, Path),
 1253      uri_data(search, Components2, Search),
 1254      uri_components(RequestURI, Components2)
 1255    },
 1256    [ request_uri(RequestURI)
 1257    ].
 parts_scheme(+Parts, -Scheme) is det
 parts_uri(+Parts, -URI) is det
 parts_request_uri(+Parts, -RequestURI) is det
 parts_search(+Parts, -Search) is det
 parts_authority(+Parts, -Authority) is semidet
 1265parts_scheme(Parts, Scheme) :-
 1266    url_part(scheme(Scheme), Parts),
 1267    !.
 1268parts_scheme(Parts, Scheme) :-          % compatibility with library(url)
 1269    url_part(protocol(Scheme), Parts),
 1270    !.
 1271parts_scheme(_, http).
 1272
 1273parts_authority(Parts, Auth) :-
 1274    url_part(authority(Auth), Parts),
 1275    !.
 1276parts_authority(Parts, Auth) :-
 1277    url_part(host(Host), Parts, _),
 1278    url_part(port(Port), Parts, _),
 1279    url_part(user(User), Parts, _),
 1280    url_part(password(Password), Parts, _),
 1281    uri_authority_components(Auth,
 1282                             uri_authority(User, Password, Host, Port)).
 1283
 1284parts_request_uri(Parts, RequestURI) :-
 1285    option(request_uri(RequestURI), Parts),
 1286    !.
 1287parts_request_uri(Parts, RequestURI) :-
 1288    url_part(path(Path), Parts, /),
 1289    ignore(parts_search(Parts, Search)),
 1290    uri_data(path, Data, Path),
 1291    uri_data(search, Data, Search),
 1292    uri_components(RequestURI, Data).
 1293
 1294parts_search(Parts, Search) :-
 1295    option(query_string(Search), Parts),
 1296    !.
 1297parts_search(Parts, Search) :-
 1298    option(search(Fields), Parts),
 1299    !,
 1300    uri_query_components(Search, Fields).
 1301
 1302
 1303parts_uri(Parts, URI) :-
 1304    option(uri(URI), Parts),
 1305    !.
 1306parts_uri(Parts, URI) :-
 1307    parts_scheme(Parts, Scheme),
 1308    ignore(parts_authority(Parts, Auth)),
 1309    parts_request_uri(Parts, RequestURI),
 1310    uri_components(RequestURI, Data),
 1311    uri_data(scheme, Data, Scheme),
 1312    uri_data(authority, Data, Auth),
 1313    uri_components(URI, Data).
 1314
 1315parts_port(Parts, Port) :-
 1316    parts_scheme(Parts, Scheme),
 1317    default_port(Scheme, DefPort),
 1318    url_part(port(Port), Parts, DefPort).
 1319
 1320url_part(Part, Parts) :-
 1321    Part =.. [Name,Value],
 1322    Gen =.. [Name,RawValue],
 1323    option(Gen, Parts),
 1324    !,
 1325    Value = RawValue.
 1326
 1327url_part(Part, Parts, Default) :-
 1328    Part =.. [Name,Value],
 1329    Gen =.. [Name,RawValue],
 1330    (   option(Gen, Parts)
 1331    ->  Value = RawValue
 1332    ;   Value = Default
 1333    ).
 1334
 1335
 1336                 /*******************************
 1337                 *            COOKIES           *
 1338                 *******************************/
 1339
 1340write_cookies(Out, Parts, Options) :-
 1341    http:write_cookies(Out, Parts, Options),
 1342    !.
 1343write_cookies(_, _, _).
 1344
 1345update_cookies(_, _, _) :-
 1346    predicate_property(http:update_cookies(_,_,_), number_of_clauses(0)),
 1347    !.
 1348update_cookies(Lines, Parts, Options) :-
 1349    (   member(Line, Lines),
 1350        phrase(atom_field('set_cookie', CookieData), Line),
 1351        http:update_cookies(CookieData, Parts, Options),
 1352        fail
 1353    ;   true
 1354    ).
 1355
 1356
 1357                 /*******************************
 1358                 *           OPEN ANY           *
 1359                 *******************************/
 1360
 1361:- multifile iostream:open_hook/6.
 iostream:open_hook(+Spec, +Mode, -Stream, -Close, +Options0, -Options) is semidet
Hook implementation that makes open_any/5 support http and https URLs for Mode == read.
 1369iostream:open_hook(URL, read, Stream, Close, Options0, Options) :-
 1370    (atom(URL) -> true ; string(URL)),
 1371    uri_is_global(URL),
 1372    uri_components(URL, Components),
 1373    uri_data(scheme, Components, Scheme),
 1374    http_scheme(Scheme),
 1375    !,
 1376    Options = Options0,
 1377    Close = close(Stream),
 1378    http_open(URL, Stream, Options0).
 1379
 1380http_scheme(http).
 1381http_scheme(https).
 1382
 1383
 1384                 /*******************************
 1385                 *          KEEP-ALIVE          *
 1386                 *******************************/
 consider_keep_alive(+HeaderLines, +Parts, +Host, +Stream0, -Stream, +Options) is det
 1392consider_keep_alive(Lines, Parts, Host, StreamPair, In, Options) :-
 1393    option(connection(Asked), Options),
 1394    keep_alive(Asked),
 1395    connection(Lines, Given),
 1396    keep_alive(Given),
 1397    content_length(Lines, Bytes),
 1398    !,
 1399    stream_pair(StreamPair, In0, _),
 1400    connection_address(Host, Parts, HostPort),
 1401    debug(http(connection),
 1402          'Keep-alive to ~w (~D bytes)', [HostPort, Bytes]),
 1403    stream_range_open(In0, In,
 1404                      [ size(Bytes),
 1405                        onclose(keep_alive(StreamPair, HostPort))
 1406                      ]).
 1407consider_keep_alive(_, _, _, Stream, Stream, _).
 1408
 1409connection_address(Host, _, Host) :-
 1410    Host = _:_,
 1411    !.
 1412connection_address(Host, Parts, Host:Port) :-
 1413    parts_port(Parts, Port).
 1414
 1415keep_alive(keep_alive) :- !.
 1416keep_alive(Connection) :-
 1417    downcase_atom(Connection, 'keep-alive').
 1418
 1419:- public keep_alive/4. 1420
 1421keep_alive(StreamPair, Host, In, Left) :-
 1422    read_incomplete(In, Left),
 1423    add_to_pool(Host, StreamPair),
 1424    !.
 1425keep_alive(StreamPair, _, _, _) :-
 1426    close(StreamPair, [force(true)]).
 read_incomplete(+In, +Left) is semidet
If we have not all input from a Keep-alive connection, read the remainder if it is short. Else, we fail and close the stream.
 1433read_incomplete(_, 0) :- !.
 1434read_incomplete(In, Left) :-
 1435    Left < 100,
 1436    !,
 1437    catch(setup_call_cleanup(
 1438              open_null_stream(Null),
 1439              copy_stream_data(In, Null, Left),
 1440              close(Null)),
 1441          _,
 1442          fail).
 1443
 1444:- dynamic
 1445    connection_pool/4,              % Hash, Address, Stream, Time
 1446    connection_gc_time/1. 1447
 1448add_to_pool(Address, StreamPair) :-
 1449    keep_connection(Address),
 1450    get_time(Now),
 1451    term_hash(Address, Hash),
 1452    assertz(connection_pool(Hash, Address, StreamPair, Now)).
 1453
 1454get_from_pool(Address, StreamPair) :-
 1455    term_hash(Address, Hash),
 1456    retract(connection_pool(Hash, Address, StreamPair, _)).
 keep_connection(+Address) is semidet
Succeeds if we want to keep the connection open. We currently keep a maximum of 10 connections waiting and a maximum of 2 waiting for the same address. Connections older than 2 seconds are closed.
 1465keep_connection(Address) :-
 1466    close_old_connections(2),
 1467    predicate_property(connection_pool(_,_,_,_), number_of_clauses(C)),
 1468    C =< 10,
 1469    term_hash(Address, Hash),
 1470    aggregate_all(count, connection_pool(Hash, Address, _, _), Count),
 1471    Count =< 2.
 1472
 1473close_old_connections(Timeout) :-
 1474    get_time(Now),
 1475    Before is Now - Timeout,
 1476    (   connection_gc_time(GC),
 1477        GC > Before
 1478    ->  true
 1479    ;   (   retractall(connection_gc_time(_)),
 1480            asserta(connection_gc_time(Now)),
 1481            connection_pool(Hash, Address, StreamPair, Added),
 1482            Added < Before,
 1483            retract(connection_pool(Hash, Address, StreamPair, Added)),
 1484            debug(http(connection),
 1485                  'Closing inactive keep-alive to ~p', [Address]),
 1486            close(StreamPair, [force(true)]),
 1487            fail
 1488        ;   true
 1489        )
 1490    ).
 http_close_keep_alive(+Address) is det
Close all keep-alive connections matching Address. Address is of the form Host:Port. In particular, http_close_keep_alive(_) closes all currently known keep-alive connections.
 1499http_close_keep_alive(Address) :-
 1500    forall(get_from_pool(Address, StreamPair),
 1501           close(StreamPair, [force(true)])).
 keep_alive_error(+Error)
Deal with an error from reusing a keep-alive connection. If the error is due to an I/O error or end-of-file, fail to backtrack over get_from_pool/2. Otherwise it is a real error and we thus re-raise it.
 1510keep_alive_error(keep_alive(closed)) :-
 1511    !,
 1512    debug(http(connection), 'Keep-alive connection was closed', []),
 1513    fail.
 1514keep_alive_error(io_error(_,_)) :-
 1515    !,
 1516    debug(http(connection), 'IO error on Keep-alive connection', []),
 1517    fail.
 1518keep_alive_error(Error) :-
 1519    throw(Error).
 1520
 1521
 1522                 /*******************************
 1523                 *     HOOK DOCUMENTATION       *
 1524                 *******************************/
 http:open_options(+Parts, -Options) is nondet
This hook is used by the HTTP client library to define default options based on the the broken-down request-URL. The following example redirects all trafic, except for localhost over a proxy:
:- multifile
    http:open_options/2.

http:open_options(Parts, Options) :-
    option(host(Host), Parts),
    Host \== localhost,
    Options = [proxy('proxy.local', 3128)].

This hook may return multiple solutions. The returned options are combined using merge_options/3 where earlier solutions overrule later solutions.

 http:write_cookies(+Out, +Parts, +Options) is semidet
Emit a Cookie: header for the current connection. Out is an open stream to the HTTP server, Parts is the broken-down request (see uri_components/2) and Options is the list of options passed to http_open. The predicate is called as if using ignore/1.
See also
- complements http:update_cookies/3.
- library(http/http_cookie) implements cookie handling on top of these hooks.
 http:update_cookies(+CookieData, +Parts, +Options) is semidet
Update the cookie database. CookieData is the value of the Set-Cookie field, Parts is the broken-down request (see uri_components/2) and Options is the list of options passed to http_open.
See also
- complements http:write_cookies
- library(http/http_cookies) implements cookie handling on top of these hooks.