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) 2011, VU University Amsterdam 7 All rights reserved. 8 9 Redistribution and use in source and binary forms, with or without 10 modification, are permitted provided that the following conditions 11 are met: 12 13 1. Redistributions of source code must retain the above copyright 14 notice, this list of conditions and the following disclaimer. 15 16 2. Redistributions in binary form must reproduce the above copyright 17 notice, this list of conditions and the following disclaimer in 18 the documentation and/or other materials provided with the 19 distribution. 20 21 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 POSSIBILITY OF SUCH DAMAGE. 33*/ 34 35:- module(http_cookie, 36 [ cookie_remove_client/1, % +ClientId 37 cookie_remove_all_clients/0, 38 cookie_current_cookie/4 % ?ClientId, ?Name, ?Value, ?Options 39 ]). 40:- autoload(library(debug),[debug/3]). 41:- autoload(library(option),[option/3]). 42:- autoload(library(http/http_header),[http_parse_header_value/3]). 43 44/** <module> HTTP client cookie handling 45 46This module implements the cookie hooks called from http_open/3, adding 47cookie handling to the client. 48 49This library supports a notion of _clients_. A client is a (ground) term 50to which a cookie database is connected. This allows a single Prolog 51process to act as multiple clients. The default client is called 52=default=. Use the option client(+ClientId) to select another client. 53 54The client and cookie database can be inspected and cleared using these 55predicates. 56 57 * cookie_remove_client/1 58 * cookie_remove_all_clients/0 59 * cookie_current_cookie/4 60 61@tbd add hooks to http_get/3 and http_post/4 62*/ 63 64:- multifile 65 http:write_cookies/3, % +Out, +Parts, +Options 66 http:update_cookies/3. % +CookieData, +Parts, +Options 67 68:- dynamic 69 client_cookie/5. % Id, CanName, Name, Value, Options 70 71%! http:write_cookies(+Out, +Parts, +Options) is det. 72% 73% Emit a cookie header for the current request. 74 75http:write_cookies(Out, Parts, Options) :- 76 option(client(ClientId), Options, default), 77 cookie(ClientId, Parts, Cookie), 78 format(Out, 'Cookie: ~s\r\n', [Cookie]). 79 80%! cookie(+ClientId, +Parts, -Cookie) is semidet. 81% 82% Cookie is the cookie for Parts for the given ClientId 83 84cookie(ClientId, Parts, Cookie) :- 85 request_host(Parts, Host), 86 request_path(Parts, Path), 87 findall(N=V, current_cookie(ClientId, Host, Path, N, V), Cookies), 88 Cookies \== [], 89 !, 90 debug(http(cookie), 'Cookies for ~w at ~w~w: ~p', 91 [ClientId, Host, Path, Cookies]), 92 cookie_value(Cookies, Cookie). 93 94request_host(Parts, Host) :- 95 memberchk(host(Host), Parts). 96 97request_path(Parts, Path) :- 98 ( memberchk(path(Path), Parts) 99 -> true 100 ; Path = (/) 101 ). 102 103%! cookie_value(+NameValueList, -CookieString) is det. 104% 105% Create a cookie value string with name=value, separated by ";". 106 107cookie_value(List, Cookie) :- 108 with_output_to(string(Cookie), 109 write_cookies(List)). 110 111write_cookies([]). 112write_cookies([Name=Value|T]) :- 113 format('~w=~w', [Name, Value]), 114 ( T == [] 115 -> true 116 ; format('; ', []), 117 write_cookies(T) 118 ). 119 120%! http:update_cookies(+CookieData, +Parts, +Options) is semidet. 121% 122% Update the client cookie database. 123 124http:update_cookies(CookieData, Parts, Options) :- 125 http_parse_header_value(set_cookie, CookieData, 126 set_cookie(Name, Value, COptions)), 127 !, 128 option(client(ClientId), Options, default), 129 request_host(Parts, Host), 130 request_path(Parts, Path), 131 with_mutex(http_cookie, 132 update_cookie(ClientId, Host, Path, Name, Value, COptions)). 133 134update_cookie(ClientId, Host, Path, Name, Value, Options) :- 135 downcase_atom(Name, CName), 136 remove_cookies(ClientId, Host, Path, CName, Options), 137 debug(http(cookie), 'New for ~w: ~w=~p', [ClientId, Name, Value]), 138 assert(client_cookie(ClientId, CName, Name, Value, [host=Host|Options])). 139 140%! remove_cookies(+ClientId, +Host, +Path, +Name, +SetOptions) is det. 141% 142% Remove all cookies that conflict with the new set-cookie 143% command. 144 145remove_cookies(ClientId, Host, Path, CName, SetOptions) :- 146 ( client_cookie(ClientId, CName, Name, Value, OldOptions), 147 cookie_match_host(Host, SetOptions, OldOptions), 148 cookie_match_path(Path, SetOptions, OldOptions), 149 debug(cookie, 'Del for ~w: ~w=~p', [ClientId, Name, Value]), 150 retract(client_cookie(ClientId, CName, Name, Value, OldOptions)), 151 fail 152 ; true 153 ). 154 155cookie_match_host(Host, SetOptions, OldOptions) :- 156 ( memberchk(domain=Domain, SetOptions) 157 -> cookie_match_host(Domain, OldOptions) 158 ; cookie_match_host(Host, OldOptions) 159 ). 160 161cookie_match_path(Path, SetOptions, OldOptions) :- 162 ( memberchk(path=PathO, SetOptions) 163 -> cookie_match_path(PathO, OldOptions) 164 ; cookie_match_path(Path, OldOptions) 165 ). 166 167%! current_cookie(+ClientId, +Host, +Path, -Name, -Value) is nondet. 168% 169% Find cookies that match the given request. 170 171current_cookie(ClientId, Host, Path, Name, Value) :- 172 client_cookie(ClientId, _CName, Name, Value, Options), 173 cookie_match_host(Host, Options), 174 cookie_match_path(Path, Options), 175 cookie_match_expire(Options). 176 177cookie_match_host(Host, Options) :- 178 ( memberchk(domain=Domain, Options) 179 -> downcase_atom(Host, LHost), 180 downcase_atom(Domain, LDomain), 181 sub_atom(LHost, _, _, 0, LDomain) % TBD: check '.'? 182 ; memberchk(host=CHost, Options), 183 downcase_atom(Host, LHost), 184 downcase_atom(CHost, LHost) 185 ). 186 187cookie_match_path(Path, Options) :- 188 ( memberchk(path=Root, Options) 189 -> sub_atom(Path, 0, _, _, Root) % TBD: check '/'? 190 ; true 191 ). 192 193cookie_match_expire(Options) :- 194 ( memberchk(expire=Expire, Options) 195 -> get_time(Now), 196 Now =< Expire 197 ; true 198 ). 199 200%! cookie_remove_client(+ClientId) is det. 201% 202% Fake user quitting a browser. Removes all cookies that do 203% not have an expire date. 204 205cookie_remove_client(ClientId) :- 206 var(ClientId), 207 !, 208 throw(error(instantiation_error, _)). 209cookie_remove_client(ClientId) :- 210 ( client_cookie(ClientId, CName, Name, Value, Options), 211 \+ memberchk(expire=_, Options), 212 retract(client_cookie(ClientId, CName, Name, Value, Options)), 213 fail 214 ; true 215 ). 216 217%! cookie_remove_all_clients is det. 218% 219% Simply logout all clients. See http_remove_client/1. 220 221cookie_remove_all_clients :- 222 forall(current_client(ClientId), 223 cookie_remove_client(ClientId)). 224 225%! current_client(?ClientId) is nondet. 226% 227% True if ClientId is the identifier of a client. 228 229current_client(ClientId) :- 230 client_cookie(ClientId, _CName, _Name, _Value, _Options). 231 232%! http_current_cookie(?ClientId, ?Name, ?Value, ?Options) is nondet. 233% 234% Query current cookie database. If Name is given, it is matched 235% case insensitive against the known cookies. If it is unbound, 236% the cookie name is returned in its oiginal case (case 237% preserving). 238 239cookie_current_cookie(ClientId, Name, Value, Options) :- 240 nonvar(Name), 241 !, 242 downcase_atom(Name, CName), 243 client_cookie(ClientId, CName, Name, Value, Options). 244cookie_current_cookie(ClientId, Name, Value, Options) :- 245 client_cookie(ClientId, _CName, Name, Value, Options). 246