http_open.pl

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)).
  53
  54/** <module> HTTP client library
  55
  56This library defines http_open/3, which opens a  URL as a Prolog stream.
  57The functionality of the  library  can   be  extended  by  loading two
  58additional modules that act as plugins:
  59
  60    * library(http/http_ssl_plugin)
  61    Loading this library causes http_open/3 to handle HTTPS connections.
  62    Relevant options for SSL certificate handling are handed to
  63    ssl_context/3. This plugin is loaded automatically if the scheme
  64    `https` is requested using a default SSL context. See the plugin for
  65    additional information regarding security.
  66
  67    * library(http/http_cookie)
  68    Loading this library adds tracking cookies to http_open/3. Returned
  69    cookies are collected in the Prolog database and supplied for
  70    subsequent requests.
  71
  72Here is a simple example to fetch a web-page:
  73
  74  ==
  75  ?- http_open('http://www.google.com/search?q=prolog', In, []),
  76     copy_stream_data(In, user_output),
  77     close(In).
  78  <!doctype html><head><title>prolog - Google Search</title><script>
  79  ...
  80  ==
  81
  82The example below fetches the modification time of a web-page. Note that
  83Modified is '' (the empty atom)  if   the  web-server does not provide a
  84time-stamp for the resource. See also parse_time/2.
  85
  86  ==
  87  modified(URL, Stamp) :-
  88          http_open(URL, In,
  89                    [ method(head),
  90                      header(last_modified, Modified)
  91                    ]),
  92          close(In),
  93          Modified \== '',
  94          parse_time(Modified, Stamp).
  95  ==
  96
  97Then next example uses Google search. It exploits library(uri) to manage
  98URIs, library(sgml) to load  an  HTML   document  and  library(xpath) to
  99navigate the parsed HTML. Note that  you   may  need to adjust the XPath
 100queries if the data returned by Google changes.
 101
 102  ==
 103  :- use_module(library(http/http_open)).
 104  :- use_module(library(xpath)).
 105  :- use_module(library(sgml)).
 106  :- use_module(library(uri)).
 107
 108  google(For, Title, HREF) :-
 109          uri_encoded(query_value, For, Encoded),
 110          atom_concat('http://www.google.com/search?q=', Encoded, URL),
 111          http_open(URL, In, []),
 112          call_cleanup(
 113              load_html(In, DOM, []),
 114              close(In)),
 115          xpath(DOM, //h3(@class=r), Result),
 116          xpath(Result, //a(@href=HREF0, text), Title),
 117          uri_components(HREF0, Components),
 118          uri_data(search, Components, Query),
 119          uri_query_components(Query, Parts),
 120          memberchk(q=HREF, Parts).
 121  ==
 122
 123An example query is below:
 124
 125==
 126?- google(prolog, Title, HREF).
 127Title = 'SWI-Prolog',
 128HREF = 'http://www.swi-prolog.org/' ;
 129Title = 'Prolog - Wikipedia',
 130HREF = 'https://nl.wikipedia.org/wiki/Prolog' ;
 131Title = 'Prolog - Wikipedia, the free encyclopedia',
 132HREF = 'https://en.wikipedia.org/wiki/Prolog' ;
 133Title = 'Pro-Log is logistiek dienstverlener m.b.t. vervoer over water.',
 134HREF = 'http://www.pro-log.nl/' ;
 135Title = 'Learn Prolog Now!',
 136HREF = 'http://www.learnprolognow.org/' ;
 137Title = 'Free Online Version - Learn Prolog
 138...
 139==
 140
 141@see load_html/3 and xpath/3 can be used to parse and navigate HTML
 142     documents.
 143@see http_get/3 and http_post/4 provide an alternative interface that
 144     convert the reply depending on the =|Content-Type|= header.
 145*/
 146
 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                     ]).
 186
 187%!  user_agent(-Agent) is det.
 188%
 189%   Default value for =|User-Agent|=,  can   be  overruled using the
 190%   option user_agent(Agent) of http_open/3.
 191
 192user_agent('SWI-Prolog').
 193
 194%!  http_open(+URL, -Stream, +Options) is det.
 195%
 196%   Open the data at the HTTP  server   as  a  Prolog stream. URL is
 197%   either an atom  specifying  a  URL   or  a  list  representing a
 198%   broken-down  URL  as  specified  below.   After  this  predicate
 199%   succeeds the data can be read from Stream. After completion this
 200%   stream must be  closed  using   the  built-in  Prolog  predicate
 201%   close/1. Options provides additional options:
 202%
 203%     * authenticate(+Boolean)
 204%     If `false` (default `true`), do _not_ try to automatically
 205%     authenticate the client if a 401 (Unauthorized) status code
 206%     is received.
 207%
 208%     * authorization(+Term)
 209%     Send authorization. See also http_set_authorization/2. Supported
 210%     schemes:
 211%
 212%       - basic(+User, +Password)
 213%       HTTP Basic authentication.
 214%       - bearer(+Token)
 215%       HTTP Bearer authentication.
 216%       - digest(+User, +Password)
 217%       HTTP Digest authentication.  This option is only provided
 218%       if the plugin library(http/http_digest) is also loaded.
 219%
 220%     * connection(+Connection)
 221%     Specify the =Connection= header.  Default is =close=.  The
 222%     alternative is =|Keep-alive|=.  This maintains a pool of
 223%     available connections as determined by keep_connection/1.
 224%     The library(http/websockets) uses =|Keep-alive, Upgrade|=.
 225%     Keep-alive connections can be closed explicitly using
 226%     http_close_keep_alive/1. Keep-alive connections may
 227%     significantly improve repetitive requests on the same server,
 228%     especially if the IP route is long, HTTPS is used or the
 229%     connection uses a proxy.
 230%
 231%     * final_url(-FinalURL)
 232%     Unify FinalURL with the final   destination. This differs from
 233%     the  original  URL  if  the  returned  head  of  the  original
 234%     indicates an HTTP redirect (codes 301,  302 or 303). Without a
 235%     redirect, FinalURL is the same as URL if  URL is an atom, or a
 236%     URL constructed from the parts.
 237%
 238%     * header(Name, -AtomValue)
 239%     If provided, AtomValue is  unified  with   the  value  of  the
 240%     indicated  field  in  the  reply    header.  Name  is  matched
 241%     case-insensitive and the underscore  (_)   matches  the hyphen
 242%     (-). Multiple of these options  may   be  provided  to extract
 243%     multiple  header  fields.  If  the  header  is  not  available
 244%     AtomValue is unified to the empty atom ('').
 245%
 246%     * headers(-List)
 247%     If provided, List is unified with  a list of Name(Value) pairs
 248%     corresponding to fields in the reply   header.  Name and Value
 249%     follow the same conventions  used   by  the header(Name,Value)
 250%     option.
 251%
 252%     * method(+Method)
 253%     One of =get= (default), =head=, =delete=, =post=,   =put=   or
 254%     =patch=.
 255%     The  =head= message can be
 256%     used in combination with  the   header(Name,  Value) option to
 257%     access information on the resource   without actually fetching
 258%     the resource itself.  The  returned   stream  must  be  closed
 259%     immediately.
 260%
 261%     If post(Data) is provided, the default is =post=.
 262%
 263%     * size(-Size)
 264%     Size is unified with the   integer value of =|Content-Length|=
 265%     in the reply header.
 266%
 267%     * version(-Version)
 268%     Version is a _pair_ `Major-Minor`, where `Major` and `Minor`
 269%     are integers representing the HTTP version in the reply header.
 270%
 271%     * range(+Range)
 272%     Ask for partial content. Range   is  a term _|Unit(From,To)|_,
 273%     where `From` is an integer and `To`   is  either an integer or
 274%     the atom `end`. HTTP 1.1 only   supports Unit = `bytes`. E.g.,
 275%     to   ask   for    bytes    1000-1999,     use    the    option
 276%     range(bytes(1000,1999))
 277%
 278%     * redirect(+Boolean)
 279%     If `false` (default `true`), do _not_ automatically redirect
 280%     if a 3XX code is received.  Must be combined with
 281%     status_code(Code) and one of the header options to read the
 282%     redirect reply. In particular, without status_code(Code) a
 283%     redirect is mapped to an exception.
 284%
 285%     * status_code(-Code)
 286%     If this option is  present  and   Code  unifies  with the HTTP
 287%     status code, do *not* translate errors (4xx, 5xx) into an
 288%     exception. Instead, http_open/3 behaves as if 200 (success) is
 289%     returned, providing the application to read the error document
 290%     from the returned stream.
 291%
 292%     * output(-Out)
 293%     Unify the output stream with Out and do not close it. This can
 294%     be used to upgrade a connection.
 295%
 296%     * timeout(+Timeout)
 297%     If provided, set a timeout on   the stream using set_stream/2.
 298%     With this option if no new data arrives within Timeout seconds
 299%     the stream raises an exception.  Default   is  to wait forever
 300%     (=infinite=).
 301%
 302%     * post(+Data)
 303%     Issue a =POST= request on the HTTP server.  Data is
 304%     handed to http_post_data/3.
 305%
 306%     * proxy(+Host:Port)
 307%     Use an HTTP proxy to connect to the outside world.  See also
 308%     socket:proxy_for_url/3.  This option overrules the proxy
 309%     specification defined by socket:proxy_for_url/3.
 310%
 311%     * proxy(+Host, +Port)
 312%     Synonym for proxy(+Host:Port).  Deprecated.
 313%
 314%     * proxy_authorization(+Authorization)
 315%     Send authorization to the proxy.  Otherwise   the  same as the
 316%     =authorization= option.
 317%
 318%     * bypass_proxy(+Boolean)
 319%     If =true=, bypass proxy hooks.  Default is =false=.
 320%
 321%     * request_header(Name = Value)
 322%     Additional  name-value  parts  are  added   in  the  order  of
 323%     appearance to the HTTP request   header.  No interpretation is
 324%     done.
 325%
 326%     * max_redirect(+Max)
 327%     Sets the maximum length of a redirection chain.  This is needed
 328%     for some IRIs that redirect indefinitely to other IRIs without
 329%     looping (e.g., redirecting to IRIs with a random element in them).
 330%     Max must be either a non-negative integer or the atom `infinite`.
 331%     The default value is `10`.
 332%
 333%     * user_agent(+Agent)
 334%     Defines the value of the  =|User-Agent|=   field  of  the HTTP
 335%     header. Default is =SWI-Prolog=.
 336%
 337%   The hook http:open_options/2 can  be   used  to  provide default
 338%   options   based   on   the   broken-down     URL.   The   option
 339%   status_code(-Code)  is  particularly  useful   to  query  *REST*
 340%   interfaces that commonly return status   codes  other than `200`
 341%   that need to be be processed by the client code.
 342%
 343%   @param URL is either an atom or string (url) or a list of _parts_.
 344
 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).
 495
 496%!  autoload_https(+Parts) is det.
 497%
 498%   If the requested scheme is https or wss, load the HTTPS plugin.
 499
 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).
 511
 512%!  send_rec_header(+StreamPair, -Stream,
 513%!                  +Host, +RequestURI, +Parts, +Options) is det.
 514%
 515%   Send header to Out and process reply.  If there is an error or
 516%   failure, close In and Out and return the error or failure.
 517
 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).
 562
 563
 564%!  http_version(-Version:atom) is det.
 565%
 566%   HTTP version we publish. We  can  only   use  1.1  if we support
 567%   chunked encoding.
 568
 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').
 598
 599%!  x_headers(+Options, +URI, +Out) is det.
 600%
 601%   Emit extra headers from   request_header(Name=Value)  options in
 602%   Options.
 603%
 604%   @tbd Use user/password fields
 605
 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(_, _, _).
 635
 636%!  auth_header(+AuthOption, +Options, +HeaderName, +Out)
 637
 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]).
 671
 672
 673%!  do_open(+HTTPVersion, +HTTPStatusCode, +HTTPStatusComment, +Header,
 674%!          +Options, +Parts, +Host, +In, -FinalIn) is det.
 675%
 676%   Handle the HTTP status. If 200, we   are ok. If a redirect, redo
 677%   the open, returning a new stream. Else issue an error.
 678%
 679%   @error  existence_error(url, URL)
 680
 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)))).
 747
 748
 749%!  redirect_limit_exceeded(+Options:list(compound), -Max:nonneg) is semidet.
 750%
 751%   True if we have exceeded the maximum redirection length (default 10).
 752
 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).
 758
 759
 760%!  redirect_loop(+Parts, +Options) is semidet.
 761%
 762%   True if we are in  a  redirection   loop.  Note  that some sites
 763%   redirect once to the same place using  cookies or similar, so we
 764%   allow for two tries. In fact,   we  should probably test whether
 765%   authorization or cookie headers have changed.
 766
 767redirect_loop(Parts, Options) :-
 768    option(visited(Visited), Options, []),
 769    include(==(Parts), Visited, Same),
 770    length(Same, Count),
 771    Count > 2.
 772
 773
 774%!  redirect_options(+Options0, -Options) is det.
 775%
 776%   A redirect from a POST should do a GET on the returned URI. This
 777%   means we must remove  the   method(post)  and post(Data) options
 778%   from the original option-list.
 779
 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).
 794
 795
 796%!  map_error_code(+HTTPCode, -PrologError) is semidet.
 797%
 798%   Map HTTP error codes to Prolog errors.
 799%
 800%   @tbd    Many more maps. Unfortunately many have no sensible Prolog
 801%           counterpart.
 802
 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).
 815
 816%!  open_socket(+Address, -StreamPair, +Options) is det.
 817%
 818%   Create and connect a client socket to Address.  Options
 819%
 820%       * timeout(+Timeout)
 821%       Sets timeout on the stream, *after* connecting the
 822%       socket.
 823%
 824%   @tbd    Make timeout also work on tcp_connect/4.
 825%   @tbd    This is the same as do_connect/4 in http_client.pl
 826
 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, _).
 862
 863%!  parse_headers(+Lines, -Headers:list(compound)) is det.
 864%
 865%   Parse the header lines for   the  headers(-List) option. Invalid
 866%   header   lines   are   skipped,   printing   a   warning   using
 867%   pring_message/2.
 868
 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).
 878
 879
 880%!  return_final_url(+Options) is semidet.
 881%
 882%   If Options contains final_url(URL), unify URL with the final
 883%   URL after redirections.
 884
 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(_).
 892
 893
 894%!  transfer_encoding_filter(+Lines, +In0, -In) is det.
 895%
 896%   Install filters depending on the transfer  encoding. If In0 is a
 897%   stream-pair, we close the output   side. If transfer-encoding is
 898%   not specified, the content-encoding is  interpreted as a synonym
 899%   for transfer-encoding, because many   servers incorrectly depend
 900%   on  this.  Exceptions  to  this   are  content-types  for  which
 901%   disable_encoding_filter/1 holds.
 902
 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).
 931
 932%!  http:disable_encoding_filter(+ContentType) is semidet.
 933%
 934%   Do not use  the   =|Content-encoding|=  as =|Transfer-encoding|=
 935%   encoding for specific values of   ContentType. This predicate is
 936%   multifile and can thus be extended by the user.
 937
 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').
 947
 948%!  transfer_encoding(+Lines, -Encoding) is semidet.
 949%
 950%   True if Encoding  is  the   value  of  the =|Transfer-encoding|=
 951%   header.
 952
 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').
 967
 968%!  content_encoding(+Lines, -Encoding) is semidet.
 969%
 970%   True if Encoding is the value of the =|Content-encoding|=
 971%   header.
 972
 973content_encoding(Lines, Encoding) :-
 974    what_encoding(content_encoding, Lines, Encoding).
 975
 976%!  read_header(+In:stream, +Parts, -Version, -Code:int,
 977%!  -Comment:atom, -Lines:list) is det.
 978%
 979%   Read the HTTP reply-header.  If the reply is completely empty
 980%   an existence error is thrown.  If the replied header is
 981%   otherwise invalid a 500 HTTP error is simulated, having the
 982%   comment =|Invalid reply header|=.
 983%
 984%   @param Parts    A list of compound terms that describe the
 985%                   parsed request URI.
 986%   @param Version  HTTP reply version as Major-Minor pair
 987%   @param Code     Numeric HTTP reply-code
 988%   @param Comment  Comment of reply-code as atom
 989%   @param Lines    Remaining header lines as code-lists.
 990%
 991%   @error existence_error(http_reply, Uri)
 992
 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).
1017
1018%!  content_length(+Header, -Length:int) is semidet.
1019%
1020%   Find the Content-Length in an HTTP reply-header.
1021
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    [].
1082
1083%!  integer(-Int)//
1084%
1085%   Read 1 or more digits and return as integer.
1086
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    [].
1104
1105%!  rest(-Atom:atom)//
1106%
1107%   Get rest of input as an atom.
1108
1109rest(Atom) --> call(rest_(Atom)).
1110
1111rest_(Atom, L, []) :-
1112    atom_codes(Atom, L).
1113
1114
1115                 /*******************************
1116                 *   AUTHORIZATION MANAGEMENT   *
1117                 *******************************/
1118
1119%!  http_set_authorization(+URL, +Authorization) is det.
1120%
1121%   Set user/password to supply with URLs   that have URL as prefix.
1122%   If  Authorization  is  the   atom    =|-|=,   possibly   defined
1123%   authorization is cleared.  For example:
1124%
1125%   ==
1126%   ?- http_set_authorization('http://www.example.com/private/',
1127%                             basic('John', 'Secret'))
1128%   ==
1129%
1130%   @tbd    Move to a separate module, so http_get/3, etc. can use this
1131%           too.
1132
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).
1157
1158%!  authorization(+URL, -Authorization) is semidet.
1159%
1160%   True if Authorization must be supplied for URL.
1161%
1162%   @tbd    Cleanup cache if it gets too big.
1163
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).
1194
1195
1196%!  parse_url_ex(+URL, -Parts)
1197%
1198%   Parts:  Scheme,  Host,  Port,    User:Password,  RequestURI  (no
1199%   fragment).
1200
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    ].
1258
1259%!  parts_scheme(+Parts, -Scheme) is det.
1260%!  parts_uri(+Parts, -URI) is det.
1261%!  parts_request_uri(+Parts, -RequestURI) is det.
1262%!  parts_search(+Parts, -Search) is det.
1263%!  parts_authority(+Parts, -Authority) is semidet.
1264
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.
1362
1363%!  iostream:open_hook(+Spec, +Mode, -Stream, -Close,
1364%!                     +Options0, -Options) is semidet.
1365%
1366%   Hook implementation that makes  open_any/5   support  =http= and
1367%   =https= URLs for `Mode == read`.
1368
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                 *******************************/
1387
1388%!  consider_keep_alive(+HeaderLines, +Parts, +Host,
1389%!                      +Stream0, -Stream,
1390%!                      +Options) is det.
1391
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)]).
1427
1428%!  read_incomplete(+In, +Left) is semidet.
1429%
1430%   If we have not all input from  a Keep-alive connection, read the
1431%   remainder if it is short. Else, we fail and close the stream.
1432
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, _)).
1457
1458%!  keep_connection(+Address) is semidet.
1459%
1460%   Succeeds if we want to keep   the  connection open. We currently
1461%   keep a maximum of 10 connections  waiting   and  a  maximum of 2
1462%   waiting for the same address. Connections   older than 2 seconds
1463%   are closed.
1464
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    ).
1491
1492
1493%!  http_close_keep_alive(+Address) is det.
1494%
1495%   Close all keep-alive connections matching Address. Address is of
1496%   the  form  Host:Port.  In  particular,  http_close_keep_alive(_)
1497%   closes all currently known keep-alive connections.
1498
1499http_close_keep_alive(Address) :-
1500    forall(get_from_pool(Address, StreamPair),
1501           close(StreamPair, [force(true)])).
1502
1503%!  keep_alive_error(+Error)
1504%
1505%   Deal with an error from reusing  a keep-alive connection. If the
1506%   error is due to an I/O error   or end-of-file, fail to backtrack
1507%   over get_from_pool/2. Otherwise it is a   real error and we thus
1508%   re-raise it.
1509
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                 *******************************/
1525
1526%!  http:open_options(+Parts, -Options) is nondet.
1527%
1528%   This hook is used by the HTTP   client library to define default
1529%   options based on the the broken-down request-URL.  The following
1530%   example redirects all trafic, except for localhost over a proxy:
1531%
1532%       ==
1533%       :- multifile
1534%           http:open_options/2.
1535%
1536%       http:open_options(Parts, Options) :-
1537%           option(host(Host), Parts),
1538%           Host \== localhost,
1539%           Options = [proxy('proxy.local', 3128)].
1540%       ==
1541%
1542%   This hook may return multiple   solutions.  The returned options
1543%   are  combined  using  merge_options/3  where  earlier  solutions
1544%   overrule later solutions.
1545
1546%!  http:write_cookies(+Out, +Parts, +Options) is semidet.
1547%
1548%   Emit a =|Cookie:|= header for the  current connection. Out is an
1549%   open stream to the HTTP server, Parts is the broken-down request
1550%   (see uri_components/2) and Options is the list of options passed
1551%   to http_open.  The predicate is called as if using ignore/1.
1552%
1553%   @see complements http:update_cookies/3.
1554%   @see library(http/http_cookie) implements cookie handling on
1555%   top of these hooks.
1556
1557%!  http:update_cookies(+CookieData, +Parts, +Options) is semidet.
1558%
1559%   Update the cookie database.  CookieData  is   the  value  of the
1560%   =|Set-Cookie|= field, Parts is  the   broken-down  request  (see
1561%   uri_components/2) and Options is the list   of options passed to
1562%   http_open.
1563%
1564%   @see complements http:write_cookies
1565%   @see library(http/http_cookies) implements cookie handling on
1566%   top of these hooks.