645 lines
18 KiB
Perl
645 lines
18 KiB
Perl
|
/* $Id$
|
||
|
|
|
||
|
|
Part of SWI-Prolog
|
||
|
|
|
||
|
|
Author: Jan Wielemaker
|
||
|
|
E-mail: J.Wielemaker@uva.nl
|
||
|
|
WWW: http://www.swi-prolog.org
|
||
|
|
Copyright (C): 2008, University of Amsterdam
|
||
|
|
|
||
|
|
This program is free software; you can redistribute it and/or
|
||
|
|
modify it under the terms of the GNU General Public License
|
||
|
|
as published by the Free Software Foundation; either version 2
|
||
|
|
of the License, or (at your option) any later version.
|
||
|
|
|
||
|
|
This program is distributed in the hope that it will be useful,
|
||
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
|
|
GNU General Public License for more details.
|
||
|
|
|
||
|
|
You should have received a copy of the GNU Lesser General Public
|
||
|
|
License along with this library; if not, write to the Free Software
|
||
|
|
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
||
|
|
|
||
|
|
As a special exception, if you link this library with other files,
|
||
|
|
compiled with a Free Software compiler, to produce an executable, this
|
||
|
|
library does not by itself cause the resulting executable to be covered
|
||
|
|
by the GNU General Public License. This exception does not however
|
||
|
|
invalidate any other reasons why the executable file might be covered by
|
||
|
|
the GNU General Public License.
|
||
|
|
*/
|
||
|
|
|
||
|
|
|
||
|
|
:- module(http_open,
|
||
|
|
[ http_open/3, % +URL, -Stream, +Options
|
||
|
|
http_set_authorization/2 % +URL, +Authorization
|
||
|
|
]).
|
||
|
|
|
||
|
|
:- use_module(library(url)).
|
||
|
|
:- use_module(library(readutil)).
|
||
|
|
:- use_module(library(socket)).
|
||
|
|
:- use_module(library(lists)).
|
||
|
|
:- use_module(library(option)).
|
||
|
|
:- use_module(library(error)).
|
||
|
|
:- use_module(library(base64)).
|
||
|
|
:- use_module(library(debug)).
|
||
|
|
|
||
|
|
:- expects_dialect(swi).
|
||
|
|
:- assert(system:swi_io).
|
||
|
|
|
||
|
|
user_agent('SWI-Prolog <http://www.swi-prolog.org>').
|
||
|
|
|
||
|
|
/** <module> Simple HTTP client
|
||
|
|
|
||
|
|
This library provides a light-weight HTTP client library to get the data
|
||
|
|
from a URL. The functionality of the library can be extended by loading
|
||
|
|
two additional modules that acts as plugins:
|
||
|
|
|
||
|
|
* library(http/http_chunked)
|
||
|
|
Loading this library causes http_open/3 to support chunked
|
||
|
|
transfer encoding.
|
||
|
|
|
||
|
|
* library(http/http_header)
|
||
|
|
Loading this library causes http_open/3 to support the =POST= method
|
||
|
|
in addition to =GET= and =HEAD=.
|
||
|
|
|
||
|
|
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 '' 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).
|
||
|
|
close(In).
|
||
|
|
==
|
||
|
|
|
||
|
|
@see xpath/3
|
||
|
|
@see http_get/3
|
||
|
|
@see http_post/4
|
||
|
|
*/
|
||
|
|
|
||
|
|
:- multifile
|
||
|
|
http:encoding_filter/3, % +Encoding, +In0, -In
|
||
|
|
http:current_transfer_encoding/1, % ?Encoding
|
||
|
|
http:http_protocol_hook/7. % +Protocol, +Parts, +In, +Out,
|
||
|
|
% -NewIn, -NewOut, +Options
|
||
|
|
|
||
|
|
|
||
|
|
%% 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 compatible to parse_url/2. 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:
|
||
|
|
%
|
||
|
|
% * authorization(+Term)
|
||
|
|
% Send authorization. Currently only supports basic(User,Password).
|
||
|
|
% See also http_set_authorization/2.
|
||
|
|
%
|
||
|
|
% * 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 unified with the canonical version of
|
||
|
|
% URL using:
|
||
|
|
%
|
||
|
|
% ==
|
||
|
|
% parse_url(URL, Parts),
|
||
|
|
% parse_url(FinalURL, 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 ('').
|
||
|
|
%
|
||
|
|
% * method(+Method)
|
||
|
|
% One of =get= (default) or =head=. 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 library(http/http_header) is loaded,
|
||
|
|
% http_open/3 also supports =post=. See the post(Data) option.
|
||
|
|
%
|
||
|
|
% * size(-Size)
|
||
|
|
% Size is unified with the integer value of =|Content-Length|=
|
||
|
|
% in the reply header.
|
||
|
|
%
|
||
|
|
% * 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)
|
||
|
|
% Provided if library(http/http_header) is also loaded. Data is
|
||
|
|
% handed to http_post_data/3.
|
||
|
|
%
|
||
|
|
% * proxy(+Host, +Port)
|
||
|
|
% Use an HTTP proxy to connect to the outside world.
|
||
|
|
%
|
||
|
|
% * proxy_authorization(+Authorization)
|
||
|
|
% Send authorization to the proxy. Otherwise the same as the
|
||
|
|
% =authorization= option.
|
||
|
|
%
|
||
|
|
% * request_header(Name = Value)
|
||
|
|
% Additional name-value parts are added in the order of
|
||
|
|
% appearance to the HTTP request header. No interpretation is
|
||
|
|
% done.
|
||
|
|
%
|
||
|
|
% * user_agent(+Agent)
|
||
|
|
% Defines the value of the =|User-Agent|= field of the HTTP
|
||
|
|
% header. Default is =|SWI-Prolog (http://www.swi-prolog.org)|=.
|
||
|
|
%
|
||
|
|
% @error existence_error(url, Id)
|
||
|
|
|
||
|
|
http_open(URL, Stream, Options) :-
|
||
|
|
atom(URL), !,
|
||
|
|
parse_url_ex(URL, Parts),
|
||
|
|
add_authorization(URL, Options, Options1),
|
||
|
|
http_open(Parts, Stream, Options1).
|
||
|
|
http_open(Parts, Stream, Options0) :-
|
||
|
|
memberchk(proxy(Host, ProxyPort), Options0), !,
|
||
|
|
parse_url_ex(Location, Parts),
|
||
|
|
Options = [visited(Parts)|Options0],
|
||
|
|
open_socket(Host:ProxyPort, In, Out, Options),
|
||
|
|
option(protocol(Protocol), Parts, http),
|
||
|
|
default_port(Protocol, DefPort),
|
||
|
|
option(port(Port), Parts, DefPort),
|
||
|
|
host_and_port(Host, DefPort, Port, HostPort),
|
||
|
|
add_authorization(Parts, Options, Options1),
|
||
|
|
send_rec_header(Out, In, Stream, HostPort, Location, Parts, Options1),
|
||
|
|
return_final_url(Options).
|
||
|
|
http_open(Parts, Stream, Options0) :-
|
||
|
|
memberchk(host(Host), Parts),
|
||
|
|
option(protocol(Protocol), Parts, http),
|
||
|
|
default_port(Protocol, DefPort),
|
||
|
|
option(port(Port), Parts, DefPort),
|
||
|
|
http_location(Parts, Location),
|
||
|
|
Options = [visited(Parts)|Options0],
|
||
|
|
open_socket(Host:Port, SocketIn, SocketOut, Options),
|
||
|
|
( http:http_protocol_hook(Protocol, Parts,
|
||
|
|
SocketIn, SocketOut,
|
||
|
|
In, Out, Options)
|
||
|
|
-> true
|
||
|
|
; In = SocketIn,
|
||
|
|
Out = SocketOut
|
||
|
|
),
|
||
|
|
host_and_port(Host, DefPort, Port, HostPort),
|
||
|
|
add_authorization(Parts, Options, Options1),
|
||
|
|
send_rec_header(Out, In, Stream, HostPort, Location, Parts, Options1),
|
||
|
|
return_final_url(Options).
|
||
|
|
|
||
|
|
http:http_protocol_hook(http, _, In, Out, In, Out, _).
|
||
|
|
|
||
|
|
default_port(https, 443) :- !.
|
||
|
|
default_port(_, 80).
|
||
|
|
|
||
|
|
host_and_port(Host, DefPort, DefPort, Host) :- !.
|
||
|
|
host_and_port(Host, _, Port, Host:Port).
|
||
|
|
|
||
|
|
%% send_rec_header(+Out, +In, -InStream,
|
||
|
|
%% +Host, +Location, +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.
|
||
|
|
|
||
|
|
send_rec_header(Out, In, Stream, Host, Location, Parts, Options) :-
|
||
|
|
( catch(guarded_send_rec_header(Out, In, Stream,
|
||
|
|
Host, Location, Parts, Options),
|
||
|
|
E, true)
|
||
|
|
-> ( var(E)
|
||
|
|
-> close(Out)
|
||
|
|
; force_close(In, Out),
|
||
|
|
throw(E)
|
||
|
|
)
|
||
|
|
; force_close(In, Out),
|
||
|
|
fail
|
||
|
|
).
|
||
|
|
|
||
|
|
guarded_send_rec_header(Out, In, Stream, Host, Location, Parts, Options) :-
|
||
|
|
user_agent(Agent, Options),
|
||
|
|
method(Options, MNAME),
|
||
|
|
http_version(Version),
|
||
|
|
format(Out,
|
||
|
|
'~w ~w HTTP/~w\r\n\
|
||
|
|
Host: ~w\r\n\
|
||
|
|
User-Agent: ~w\r\n\
|
||
|
|
Connection: close\r\n',
|
||
|
|
[MNAME, Location, Version, Host, Agent]),
|
||
|
|
x_headers(Options, Out),
|
||
|
|
( option(post(PostData), Options)
|
||
|
|
-> http_header:http_post_data(PostData, Out, [])
|
||
|
|
; format(Out, '\r\n', [])
|
||
|
|
),
|
||
|
|
flush_output(Out),
|
||
|
|
% read the reply header
|
||
|
|
read_header(In, Code, Comment, Lines),
|
||
|
|
do_open(Code, Comment, Lines, Options, Parts, In, Stream).
|
||
|
|
|
||
|
|
|
||
|
|
%% http_version(-Version:atom) is det.
|
||
|
|
%
|
||
|
|
% HTTP version we publish. We can only use 1.1 if we support
|
||
|
|
% chunked encoding, which means http_chunked.pl must be loaded.
|
||
|
|
|
||
|
|
http_version('1.1') :-
|
||
|
|
http:current_transfer_encoding(chunked), !.
|
||
|
|
http_version('1.0').
|
||
|
|
|
||
|
|
force_close(S1, S2) :-
|
||
|
|
close(S1, [force(true)]),
|
||
|
|
close(S2, [force(true)]).
|
||
|
|
|
||
|
|
method(Options, MNAME) :-
|
||
|
|
option(post(_), Options), !,
|
||
|
|
option(method(M), Options, post),
|
||
|
|
( map_method(M, MNAME0)
|
||
|
|
-> MNAME = MNAME0
|
||
|
|
; domain_error(method, M)
|
||
|
|
).
|
||
|
|
method(Options, MNAME) :-
|
||
|
|
option(method(M), Options, get),
|
||
|
|
( map_method(M, MNAME0)
|
||
|
|
-> MNAME = MNAME0
|
||
|
|
; domain_error(method, M)
|
||
|
|
).
|
||
|
|
|
||
|
|
map_method(get, 'GET').
|
||
|
|
map_method(head, 'HEAD').
|
||
|
|
map_method(post, 'POST') :-
|
||
|
|
current_predicate(http_header:http_post_data/3).
|
||
|
|
|
||
|
|
|
||
|
|
%% x_headers(+Options, +Out) is det.
|
||
|
|
%
|
||
|
|
% Emit extra headers from request_header(Name=Value) options in
|
||
|
|
% Options.
|
||
|
|
|
||
|
|
x_headers([], _).
|
||
|
|
x_headers([H|T], Out) :- !,
|
||
|
|
x_header(H, Out),
|
||
|
|
x_headers(T, Out).
|
||
|
|
|
||
|
|
x_header(request_header(Name=Value), Out) :- !,
|
||
|
|
format(Out, '~w: ~w\r\n', [Name, Value]).
|
||
|
|
x_header(proxy_authorization(ProxyAuthorization), Out) :- !,
|
||
|
|
auth_header(ProxyAuthorization, 'Proxy-Authorization', Out).
|
||
|
|
x_header(authorization(Authorization), Out) :- !,
|
||
|
|
auth_header(Authorization, 'Authorization', Out).
|
||
|
|
x_header(_, _).
|
||
|
|
|
||
|
|
auth_header(basic(User, Password), Header, Out) :- !,
|
||
|
|
format(codes(Codes), '~w:~w', [User, Password]),
|
||
|
|
phrase(base64(Codes), Base64Codes),
|
||
|
|
format(Out, '~w: basic ~s\r\n', [Header, Base64Codes]).
|
||
|
|
auth_header(Auth, _, _) :-
|
||
|
|
domain_error(authorization, Auth).
|
||
|
|
|
||
|
|
user_agent(Agent, Options) :-
|
||
|
|
( option(user_agent(Agent), Options)
|
||
|
|
-> true
|
||
|
|
; user_agent(Agent)
|
||
|
|
).
|
||
|
|
|
||
|
|
%% do_open(+HTTPStatusCode, +HTTPStatusComment, +Header,
|
||
|
|
%% +Options, +Parts, +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.
|
||
|
|
%
|
||
|
|
% @error existence_error(url, URL)
|
||
|
|
|
||
|
|
do_open(200, _, Lines, Options, Parts, In0, In) :- !,
|
||
|
|
return_size(Options, Lines),
|
||
|
|
return_fields(Options, Lines),
|
||
|
|
transfer_encoding_filter(Lines, In0, In),
|
||
|
|
% properly re-initialise the stream
|
||
|
|
parse_url_ex(Id, Parts),
|
||
|
|
set_stream(In, file_name(Id)),
|
||
|
|
set_stream(In, record_position(true)).
|
||
|
|
% Handle redirections
|
||
|
|
do_open(Code, _, Lines, Options, Parts, In, Stream) :-
|
||
|
|
redirect_code(Code),
|
||
|
|
location(Lines, Location), !,
|
||
|
|
debug(http(redirect), 'http_open: redirecting to ~w', [Location]),
|
||
|
|
parse_url_ex(Location, Parts, Redirected),
|
||
|
|
close(In),
|
||
|
|
http_open(Redirected, Stream, [visited(Redirected)|Options]).
|
||
|
|
% report anything else as error
|
||
|
|
do_open(Code, Comment, _, _, Parts, _, _) :-
|
||
|
|
parse_url_ex(Id, Parts),
|
||
|
|
( map_error_code(Code, Error)
|
||
|
|
-> Formal =.. [Error, url, Id]
|
||
|
|
; Formal = existence_error(url, Id)
|
||
|
|
),
|
||
|
|
throw(error(Formal, context(_, status(Code, Comment)))).
|
||
|
|
|
||
|
|
%% map_error_code(+HTTPCode, -PrologError) is semidet.
|
||
|
|
%
|
||
|
|
% Map HTTP error codes to Prolog errors.
|
||
|
|
%
|
||
|
|
% @tbd Many more maps. Unfortunately many have no sensible Prolog
|
||
|
|
% counterpart.
|
||
|
|
|
||
|
|
map_error_code(401, permission_error).
|
||
|
|
map_error_code(403, permission_error).
|
||
|
|
map_error_code(404, existence_error).
|
||
|
|
map_error_code(405, permission_error).
|
||
|
|
map_error_code(407, permission_error).
|
||
|
|
map_error_code(410, existence_error).
|
||
|
|
|
||
|
|
redirect_code(301). % moved permanently
|
||
|
|
redirect_code(302). % moved temporary
|
||
|
|
redirect_code(303). % see also
|
||
|
|
|
||
|
|
%% open_socket(+Address, -In, -Out, +Options) is det.
|
||
|
|
%
|
||
|
|
% Create and connect a client socket to Address. Options
|
||
|
|
%
|
||
|
|
% * timeout(+Timeout)
|
||
|
|
% Sets timeout on the stream, *after* connecting the
|
||
|
|
% socket.
|
||
|
|
%
|
||
|
|
% @tbd Make timeout also work on tcp_connect/4.
|
||
|
|
% @tbd This is the same as do_connect/4 in http_client.pl
|
||
|
|
|
||
|
|
open_socket(Address, In, Out, Options) :-
|
||
|
|
debug(http(open), 'http_open: Connecting to ~p ...', [Address]),
|
||
|
|
tcp_socket(Socket),
|
||
|
|
catch(tcp_connect(Socket, Address, In, Out),
|
||
|
|
E,
|
||
|
|
( tcp_close_socket(Socket),
|
||
|
|
throw(E)
|
||
|
|
)),
|
||
|
|
debug(http(open), '\tok ~p --> ~p', [In, Out]),
|
||
|
|
set_stream(In, record_position(false)),
|
||
|
|
( memberchk(Options, timeout(Timeout))
|
||
|
|
-> set_stream(In, timeout(Timeout))
|
||
|
|
; true
|
||
|
|
).
|
||
|
|
|
||
|
|
|
||
|
|
return_size(Options, Lines) :-
|
||
|
|
memberchk(size(Size), Options), !,
|
||
|
|
content_length(Lines, Size).
|
||
|
|
return_size(_, _).
|
||
|
|
|
||
|
|
return_fields([], _).
|
||
|
|
return_fields([header(Name, Value)|T], Lines) :- !,
|
||
|
|
atom_codes(Name, Codes),
|
||
|
|
( member(Line, Lines),
|
||
|
|
phrase(atom_field(Codes, Value), Line)
|
||
|
|
-> true
|
||
|
|
; Value = ''
|
||
|
|
),
|
||
|
|
return_fields(T, Lines).
|
||
|
|
return_fields([_|T], Lines) :-
|
||
|
|
return_fields(T, Lines).
|
||
|
|
|
||
|
|
|
||
|
|
%% return_final_url(+Options) is semidet.
|
||
|
|
%
|
||
|
|
% If Options contains final_url(URL), unify URL with the final
|
||
|
|
% URL after redirections.
|
||
|
|
|
||
|
|
return_final_url(Options) :-
|
||
|
|
memberchk(final_url(URL), Options),
|
||
|
|
var(URL), !,
|
||
|
|
memberchk(visited(Parts), Options),
|
||
|
|
parse_url_ex(URL, Parts).
|
||
|
|
return_final_url(_).
|
||
|
|
|
||
|
|
|
||
|
|
%% transfer_encoding_filter(+Lines, +In0, -In) is det.
|
||
|
|
%
|
||
|
|
% Install filters depending on the encoding.
|
||
|
|
|
||
|
|
transfer_encoding_filter(Lines, In0, In) :-
|
||
|
|
transfer_encoding(Lines, Encoding), !,
|
||
|
|
( http:encoding_filter(Encoding, In0, In)
|
||
|
|
-> true
|
||
|
|
; domain_error(http_encoding, Encoding)
|
||
|
|
).
|
||
|
|
transfer_encoding_filter(_, In, In).
|
||
|
|
|
||
|
|
|
||
|
|
%% transfer_encoding(+Lines, -Encoding) is semidet.
|
||
|
|
%
|
||
|
|
% True if Encoding is the value of the =|Transfer-encoding|=
|
||
|
|
% header.
|
||
|
|
|
||
|
|
transfer_encoding(Lines, Encoding) :-
|
||
|
|
member(Line, Lines),
|
||
|
|
phrase(transfer_encoding(Encoding0), Line), !,
|
||
|
|
debug(http(transfer_encoding), 'Transfer-encoding: ~w', [Encoding0]),
|
||
|
|
Encoding = Encoding0.
|
||
|
|
|
||
|
|
transfer_encoding(Encoding) -->
|
||
|
|
field("transfer-encoding"),
|
||
|
|
rest(Encoding).
|
||
|
|
|
||
|
|
%% read_header(+In:stream, -Code:int, -Comment:atom, -Lines:list)
|
||
|
|
%
|
||
|
|
% Read the HTTP reply-header.
|
||
|
|
%
|
||
|
|
% @param Code Numeric HTTP reply-code
|
||
|
|
% @param Comment Comment of reply-code as atom
|
||
|
|
% @param Lines Remaining header lines as code-lists.
|
||
|
|
|
||
|
|
read_header(In, Code, Comment, Lines) :-
|
||
|
|
read_line_to_codes(In, Line),
|
||
|
|
phrase(first_line(Code, Comment), Line),
|
||
|
|
read_line_to_codes(In, Line2),
|
||
|
|
rest_header(Line2, In, Lines).
|
||
|
|
|
||
|
|
rest_header("", _, []) :- !. % blank line: end of header
|
||
|
|
rest_header(L0, In, [L0|L]) :-
|
||
|
|
read_line_to_codes(In, L1),
|
||
|
|
rest_header(L1, In, L).
|
||
|
|
|
||
|
|
%% content_length(+Header, -Length:int) is semidet.
|
||
|
|
%
|
||
|
|
% Find the Content-Length in an HTTP reply-header.
|
||
|
|
|
||
|
|
content_length(Lines, Length) :-
|
||
|
|
member(Line, Lines),
|
||
|
|
phrase(content_length(Length0), Line), !,
|
||
|
|
Length = Length0.
|
||
|
|
|
||
|
|
location(Lines, Location) :-
|
||
|
|
member(Line, Lines),
|
||
|
|
phrase(atom_field("location", Location), Line), !.
|
||
|
|
|
||
|
|
first_line(Code, Comment) -->
|
||
|
|
"HTTP/", [_], ".", [_],
|
||
|
|
skip_blanks,
|
||
|
|
integer(Code),
|
||
|
|
skip_blanks,
|
||
|
|
rest(Comment).
|
||
|
|
|
||
|
|
atom_field(Name, Value) -->
|
||
|
|
field(Name),
|
||
|
|
rest(Value).
|
||
|
|
|
||
|
|
content_length(Len) -->
|
||
|
|
field("content-length"),
|
||
|
|
integer(Len).
|
||
|
|
|
||
|
|
field([]) -->
|
||
|
|
":",
|
||
|
|
skip_blanks.
|
||
|
|
field([H|T]) -->
|
||
|
|
[C],
|
||
|
|
{ match_header_char(H, C)
|
||
|
|
},
|
||
|
|
field(T).
|
||
|
|
|
||
|
|
match_header_char(C, C) :- !.
|
||
|
|
match_header_char(C, U) :-
|
||
|
|
code_type(C, to_lower(U)), !.
|
||
|
|
match_header_char(0'_, 0'-).
|
||
|
|
|
||
|
|
|
||
|
|
skip_blanks -->
|
||
|
|
[C],
|
||
|
|
{ code_type(C, white)
|
||
|
|
}, !,
|
||
|
|
skip_blanks.
|
||
|
|
skip_blanks -->
|
||
|
|
[].
|
||
|
|
|
||
|
|
%% integer(-Int)//
|
||
|
|
%
|
||
|
|
% Read 1 or more digits and return as integer.
|
||
|
|
|
||
|
|
integer(Code) -->
|
||
|
|
digit(D0),
|
||
|
|
digits(D),
|
||
|
|
{ number_codes(Code, [D0|D])
|
||
|
|
}.
|
||
|
|
|
||
|
|
digit(C) -->
|
||
|
|
[C],
|
||
|
|
{ code_type(C, digit)
|
||
|
|
}.
|
||
|
|
|
||
|
|
digits([D0|D]) -->
|
||
|
|
digit(D0), !,
|
||
|
|
digits(D).
|
||
|
|
digits([]) -->
|
||
|
|
[].
|
||
|
|
|
||
|
|
%% rest(-Atom:atom)//
|
||
|
|
%
|
||
|
|
% Get rest of input as an atom.
|
||
|
|
|
||
|
|
rest(A,L,[]) :-
|
||
|
|
atom_codes(A, L).
|
||
|
|
|
||
|
|
|
||
|
|
/*******************************
|
||
|
|
* AUTHORIZATION MANAGEMENT *
|
||
|
|
*******************************/
|
||
|
|
|
||
|
|
%% 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'))
|
||
|
|
% ==
|
||
|
|
%
|
||
|
|
% @tbd Move to a separate module, so http_get/3, etc. can use this
|
||
|
|
% too.
|
||
|
|
|
||
|
|
:- dynamic
|
||
|
|
stored_authorization/2,
|
||
|
|
cached_authorization/2.
|
||
|
|
|
||
|
|
http_set_authorization(URL, Authorization) :-
|
||
|
|
must_be(atom, URL),
|
||
|
|
retractall(stored_authorization(URL, _)),
|
||
|
|
( Authorization = (-)
|
||
|
|
-> true
|
||
|
|
; check_authorization(Authorization),
|
||
|
|
assert(stored_authorization(URL, Authorization))
|
||
|
|
),
|
||
|
|
retractall(cached_authorization(_,_)).
|
||
|
|
|
||
|
|
check_authorization(Var) :-
|
||
|
|
var(Var), !,
|
||
|
|
instantiation_error(Var).
|
||
|
|
check_authorization(basic(User, Password)) :-
|
||
|
|
must_be(atom, User),
|
||
|
|
must_be(atom, Password).
|
||
|
|
|
||
|
|
%% authorization(+URL, -Authorization) is semdet.
|
||
|
|
%
|
||
|
|
% True if Authorization must be supplied for URL.
|
||
|
|
%
|
||
|
|
% @tbd Cleanup cache if it gets too big.
|
||
|
|
|
||
|
|
authorization(_, _) :-
|
||
|
|
\+ stored_authorization(_, _), !,
|
||
|
|
fail.
|
||
|
|
authorization(URL, Authorization) :-
|
||
|
|
cached_authorization(URL, Authorization), !,
|
||
|
|
Authorization \== (-).
|
||
|
|
authorization(URL, Authorization) :-
|
||
|
|
( stored_authorization(Prefix, Authorization),
|
||
|
|
sub_atom(URL, 0, _, _, Prefix)
|
||
|
|
-> assert(cached_authorization(URL, Authorization))
|
||
|
|
; assert(cached_authorization(URL, -)),
|
||
|
|
fail
|
||
|
|
).
|
||
|
|
|
||
|
|
add_authorization(_, Options, Options) :-
|
||
|
|
option(authorization(_), Options), !.
|
||
|
|
add_authorization(For, Options0, Options) :-
|
||
|
|
stored_authorization(_, _) -> % quick test to avoid work
|
||
|
|
( atom(For)
|
||
|
|
-> URL = For
|
||
|
|
; parse_url_ex(URL, For)
|
||
|
|
),
|
||
|
|
authorization(URL, Auth), !,
|
||
|
|
Options = [authorization(Auth)|Options0].
|
||
|
|
add_authorization(_, Options, Options).
|
||
|
|
|
||
|
|
|
||
|
|
parse_url_ex(URL, Parts) :-
|
||
|
|
parse_url(URL, Parts), !.
|
||
|
|
parse_url_ex(URL, _) :-
|
||
|
|
domain_error(url, URL). % Syntax error?
|
||
|
|
|
||
|
|
parse_url_ex(URL, RelativeTo, Parts) :-
|
||
|
|
parse_url(URL, RelativeTo, Parts), !.
|
||
|
|
parse_url_ex(URL, _, _) :-
|
||
|
|
domain_error(url, URL). % Syntax error?
|
||
|
|
|
||
|
|
:- retract(system:swi_io).
|