1/* Part of SWI-Prolog 2 3 Author: Jan Wielemaker, Matt Lilley 4 E-mail: J.Wielemaker@cs.vu.nl 5 WWW: http://www.swi-prolog.org 6 Copyright (c) 2006-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_session, 37 [ http_set_session_options/1, % +Options 38 http_set_session/1, % +Option 39 http_set_session/2, % +SessionId, +Option 40 http_session_option/1, % ?Option 41 42 http_session_id/1, % -SessionId 43 http_in_session/1, % -SessionId 44 http_current_session/2, % ?SessionId, ?Data 45 http_close_session/1, % +SessionId 46 http_open_session/2, % -SessionId, +Options 47 48 http_session_cookie/1, % -Cookie 49 50 http_session_asserta/1, % +Data 51 http_session_assert/1, % +Data 52 http_session_retract/1, % ?Data 53 http_session_retractall/1, % +Data 54 http_session_data/1 % ?Data 55 ]). 56:- use_module(http_wrapper). 57:- use_module(http_stream). 58:- use_module(library(error)). 59:- use_module(library(debug)). 60:- use_module(library(socket)). 61:- use_module(library(broadcast)). 62:- use_module(library(lists)). 63 64:- predicate_options(http_open_session/2, 2, [renew(boolean)]). 65 66/** <module> HTTP Session management 67 68This library defines session management based on HTTP cookies. Session 69management is enabled simply by loading this module. Details can be 70modified using http_set_session_options/1. By default, this module 71creates a session whenever a request is processes that is inside the 72hierarchy defined for session handling (see path option in 73http_set_session_options/1. Automatic creation of a session can be 74stopped using the option create(noauto). The predicate 75http_open_session/2 must be used to create a session if =noauto= is 76enabled. Sessions can be closed using http_close_session/1. 77 78If a session is active, http_in_session/1 returns the current session 79and http_session_assert/1 and friends maintain data about the session. 80If the session is reclaimed, all associated data is reclaimed too. 81 82Begin and end of sessions can be monitored using library(broadcast). The 83broadcasted messages are: 84 85 * http_session(begin(SessionID, Peer)) 86 Broadcasted if a session is started 87 * http_session(end(SessionId, Peer)) 88 Broadcasted if a session is ended. See http_close_session/1. 89 90For example, the following calls end_session(SessionId) whenever a 91session terminates. Please note that sessions ends are not scheduled to 92happen at the actual timeout moment of the session. Instead, creating a 93new session scans the active list for timed-out sessions. This may 94change in future versions of this library. 95 96 == 97 :- listen(http_session(end(SessionId, Peer)), 98 end_session(SessionId)). 99 == 100*/ 101 102:- dynamic 103 session_setting/1, % Name(Value) 104 current_session/2, % SessionId, Peer 105 last_used/2, % SessionId, Time 106 session_data/2. % SessionId, Data 107 108session_setting(timeout(600)). % timeout in seconds 109session_setting(cookie('swipl_session')). 110session_setting(path(/)). 111session_setting(enabled(true)). 112session_setting(create(auto)). 113session_setting(proxy_enabled(false)). 114 115session_option(timeout, integer). 116session_option(cookie, atom). 117session_option(path, atom). 118session_option(create, oneof([auto,noauto])). 119session_option(route, atom). 120session_option(enabled, boolean). 121session_option(proxy_enabled, boolean). 122 123%! http_set_session_options(+Options) is det. 124% 125% Set options for the session library. Provided options are: 126% 127% * timeout(+Seconds) 128% Session timeout in seconds. Default is 600 (10 min). 129% A timeout of `0` (zero) disables timeout. 130% 131% * cookie(+Cookiekname) 132% Name to use for the cookie to identify the session. 133% Default =swipl_session=. 134% 135% * path(+Path) 136% Path to which the cookie is associated. Default is 137% =|/|=. Cookies are only sent if the HTTP request path 138% is a refinement of Path. 139% 140% * route(+Route) 141% Set the route name. Default is the unqualified 142% hostname. To cancel adding a route, use the empty 143% atom. See route/1. 144% 145% * enabled(+Boolean) 146% Enable/disable session management. Sesion management 147% is enabled by default after loading this file. 148% 149% * create(+Atom) 150% Defines when a session is created. This is one of =auto= 151% (default), which creates a session if there is a request 152% whose path matches the defined session path or =noauto=, 153% in which cases sessions are only created by calling 154% http_open_session/2 explicitely. 155% 156% * proxy_enabled(+Boolean) 157% Enable/disable proxy session management. Proxy session 158% management associates the _originating_ IP address of 159% the client to the session rather than the _proxy_ IP 160% address. Default is false. 161 162http_set_session_options([]). 163http_set_session_options([H|T]) :- 164 http_set_session_option(H), 165 http_set_session_options(T). 166 167http_set_session_option(Option) :- 168 functor(Option, Name, Arity), 169 arg(1, Option, Value), 170 ( session_option(Name, Type) 171 -> must_be(Type, Value) 172 ; domain_error(http_session_option, Option) 173 ), 174 functor(Free, Name, Arity), 175 retractall(session_setting(Free)), 176 assert(session_setting(Option)). 177 178%! http_session_option(?Option) is nondet. 179% 180% True if Option is a current option of the session system. 181 182http_session_option(Option) :- 183 session_setting(Option). 184 185%! session_setting(+SessionID, ?Setting) is semidet. 186% 187% Find setting for SessionID. It is possible to overrule some 188% session settings using http_session_set(Setting). 189 190session_setting(SessionId, Setting) :- 191 nonvar(Setting), 192 functor(Setting, Name, 1), 193 local_option(Name, Value, Term), 194 session_data(SessionId, '$setting'(Term)), 195 !, 196 arg(1, Setting, Value). 197session_setting(_, Setting) :- 198 session_setting(Setting). 199 200%! http_set_session(Setting) is det. 201%! http_set_session(SessionId, Setting) is det. 202% 203% Overrule a setting for the current or specified session. 204% Currently, the only setting that can be overruled is =timeout=. 205% 206% @error permission_error(set, http_session, Setting) if setting 207% a setting that is not supported on per-session basis. 208 209http_set_session(Setting) :- 210 http_session_id(SessionId), 211 http_set_session(SessionId, Setting). 212 213http_set_session(SessionId, Setting) :- 214 functor(Setting, Name, Arity), 215 ( local_option(Name, _, _) 216 -> true 217 ; permission_error(set, http_session, Setting) 218 ), 219 arg(1, Setting, Value), 220 ( session_option(Name, Type) 221 -> must_be(Type, Value) 222 ; domain_error(http_session_option, Setting) 223 ), 224 functor(Free, Name, Arity), 225 retractall(session_data(SessionId, '$setting'(Free))), 226 assert(session_data(SessionId, '$setting'(Setting))). 227 228local_option(timeout, X, timeout(X)). 229 230%! http_session_id(-SessionId) is det. 231% 232% True if SessionId is an identifier for the current session. 233% 234% @param SessionId is an atom. 235% @error existence_error(http_session, _) 236% @see http_in_session/1 for a version that fails if there is 237% no session. 238 239http_session_id(SessionID) :- 240 ( http_in_session(ID) 241 -> SessionID = ID 242 ; throw(error(existence_error(http_session, _), _)) 243 ). 244 245%! http_in_session(-SessionId) is semidet. 246% 247% True if SessionId is an identifier for the current session. The 248% current session is extracted from session(ID) from the current 249% HTTP request (see http_current_request/1). The value is cached 250% in a backtrackable global variable =http_session_id=. Using a 251% backtrackable global variable is safe because continuous worker 252% threads use a failure driven loop and spawned threads start 253% without any global variables. This variable can be set from the 254% commandline to fake running a goal from the commandline in the 255% context of a session. 256% 257% @see http_session_id/1 258 259http_in_session(SessionID) :- 260 nb_current(http_session_id, ID), 261 ID \== [], 262 !, 263 debug(http_session, 'Session id from global variable: ~q', [ID]), 264 ID \== no_session, 265 SessionID = ID. 266http_in_session(SessionID) :- 267 http_current_request(Request), 268 http_in_session(Request, SessionID). 269 270http_in_session(Request, SessionID) :- 271 memberchk(session(ID), Request), 272 !, 273 debug(http_session, 'Session id from request: ~q', [ID]), 274 b_setval(http_session_id, ID), 275 SessionID = ID. 276http_in_session(Request, SessionID) :- 277 memberchk(cookie(Cookies), Request), 278 session_setting(cookie(Cookie)), 279 member(Cookie=SessionID0, Cookies), 280 debug(http_session, 'Session id from cookie: ~q', [SessionID0]), 281 peer(Request, Peer), 282 valid_session_id(SessionID0, Peer), 283 !, 284 b_setval(http_session_id, SessionID0), 285 SessionID = SessionID0. 286 287 288%! http_session(+RequestIn, -RequestOut, -SessionID) is semidet. 289% 290% Maintain the notion of a session using a client-side cookie. 291% This must be called first when handling a request that wishes to 292% do session management, after which the possibly modified request 293% must be used for further processing. 294% 295% This predicate creates a session if the setting create is 296% =auto=. If create is =noauto=, the application must call 297% http_open_session/1 to create a session. 298 299http_session(Request, Request, SessionID) :- 300 memberchk(session(SessionID0), Request), 301 !, 302 SessionID = SessionID0. 303http_session(Request0, Request, SessionID) :- 304 memberchk(cookie(Cookies), Request0), 305 session_setting(cookie(Cookie)), 306 member(Cookie=SessionID0, Cookies), 307 peer(Request0, Peer), 308 valid_session_id(SessionID0, Peer), 309 !, 310 SessionID = SessionID0, 311 Request = [session(SessionID)|Request0], 312 b_setval(http_session_id, SessionID). 313http_session(Request0, Request, SessionID) :- 314 session_setting(create(auto)), 315 session_setting(path(Path)), 316 memberchk(path(ReqPath), Request0), 317 sub_atom(ReqPath, 0, _, _, Path), 318 !, 319 create_session(Request0, Request, SessionID). 320 321create_session(Request0, Request, SessionID) :- 322 http_gc_sessions, 323 http_session_cookie(SessionID), 324 session_setting(cookie(Cookie)), 325 session_setting(path(Path)), 326 debug(http_session, 'Created session ~q at path=~q', [SessionID, Path]), 327 format('Set-Cookie: ~w=~w; Path=~w; Version=1\r\n', 328 [Cookie, SessionID, Path]), 329 Request = [session(SessionID)|Request0], 330 peer(Request0, Peer), 331 open_session(SessionID, Peer), 332 b_setval(http_session_id, SessionID). 333 334 335%! http_open_session(-SessionID, +Options) is det. 336% 337% Establish a new session. This is normally used if the create 338% option is set to =noauto=. Options: 339% 340% * renew(+Boolean) 341% If =true= (default =false=) and the current request is part 342% of a session, generate a new session-id. By default, this 343% predicate returns the current session as obtained with 344% http_in_session/1. 345% 346% @see http_set_session_options/1 to control the =create= option. 347% @see http_close_session/1 for closing the session. 348% @error permission_error(open, http_session, CGI) if this call 349% is used after closing the CGI header. 350 351http_open_session(SessionID, Options) :- 352 http_in_session(SessionID0), 353 \+ option(renew(true), Options, false), 354 !, 355 SessionID = SessionID0. 356http_open_session(SessionID, _Options) :- 357 ( in_header_state 358 -> true 359 ; current_output(CGI), 360 permission_error(open, http_session, CGI) 361 ), 362 ( http_in_session(ActiveSession) 363 -> http_close_session(ActiveSession, false) 364 ; true 365 ), 366 http_current_request(Request), 367 create_session(Request, _, SessionID). 368 369 370:- multifile 371 http:request_expansion/2. 372 373http:request_expansion(Request0, Request) :- 374 session_setting(enabled(true)), 375 http_session(Request0, Request, _SessionID). 376 377%! peer(+Request, -Peer) is det. 378% 379% Find peer for current request. If unknown we leave it unbound. 380% Alternatively we should treat this as an error. 381 382peer(Request, Peer) :- 383 ( session_setting(proxy_enabled(true)), 384 http_peer(Request, Peer) 385 -> true 386 ; memberchk(peer(Peer), Request) 387 -> true 388 ; true 389 ). 390 391%! open_session(+SessionID, +Peer) 392% 393% Open a new session. Uses broadcast/1 with the term 394% http_session(begin(SessionID, Peer)). 395 396open_session(SessionID, Peer) :- 397 get_time(Now), 398 assert(current_session(SessionID, Peer)), 399 assert(last_used(SessionID, Now)), 400 broadcast(http_session(begin(SessionID, Peer))). 401 402 403%! valid_session_id(+SessionID, +Peer) is semidet. 404% 405% Check if this sessionID is known. If so, check the idle time and 406% update the last_used for this session. 407 408valid_session_id(SessionID, Peer) :- 409 current_session(SessionID, SessionPeer), 410 get_time(Now), 411 ( session_setting(SessionID, timeout(Timeout)), 412 Timeout > 0 413 -> get_last_used(SessionID, Last), 414 Idle is Now - Last, 415 ( Idle =< Timeout 416 -> true 417 ; http_close_session(SessionID), 418 fail 419 ) 420 ; Peer \== SessionPeer 421 -> http_close_session(SessionID), 422 fail 423 ; true 424 ), 425 set_last_used(SessionID, Now). 426 427get_last_used(SessionID, Last) :- 428 atom(SessionID), 429 !, 430 with_mutex(http_session, last_used(SessionID, Last)). 431get_last_used(SessionID, Last) :- 432 with_mutex(http_session, 433 findall(SessionID-Last, 434 last_used(SessionID, Last), 435 Pairs)), 436 member(SessionID-Last, Pairs). 437 438set_last_used(SessionID, Now) :- 439 with_mutex(http_session, 440 ( retractall(last_used(SessionID, _)), 441 assert(last_used(SessionID, Now)))). 442 443 444 445 /******************************* 446 * SESSION DATA * 447 *******************************/ 448 449%! http_session_asserta(+Data) is det. 450%! http_session_assert(+Data) is det. 451%! http_session_retract(?Data) is nondet. 452%! http_session_retractall(?Data) is det. 453% 454% Versions of assert/1, retract/1 and retractall/1 that associate 455% data with the current HTTP session. 456 457http_session_asserta(Data) :- 458 http_session_id(SessionId), 459 asserta(session_data(SessionId, Data)). 460 461http_session_assert(Data) :- 462 http_session_id(SessionId), 463 assert(session_data(SessionId, Data)). 464 465http_session_retract(Data) :- 466 http_session_id(SessionId), 467 retract(session_data(SessionId, Data)). 468 469http_session_retractall(Data) :- 470 http_session_id(SessionId), 471 retractall(session_data(SessionId, Data)). 472 473%! http_session_data(?Data) is nondet. 474% 475% True if Data is associated using http_session_assert/1 to the 476% current HTTP session. 477% 478% @error existence_error(http_session,_) 479 480http_session_data(Data) :- 481 http_session_id(SessionId), 482 session_data(SessionId, Data). 483 484 485 /******************************* 486 * ENUMERATE * 487 *******************************/ 488 489%! http_current_session(?SessionID, ?Data) is nondet. 490% 491% Enumerate the current sessions and associated data. There are 492% two _Pseudo_ data elements: 493% 494% * idle(Seconds) 495% Session has been idle for Seconds. 496% 497% * peer(Peer) 498% Peer of the connection. 499 500http_current_session(SessionID, Data) :- 501 get_time(Now), 502 get_last_used(SessionID, Last), % binds SessionID 503 Idle is Now - Last, 504 ( session_setting(SessionID, timeout(Timeout)), 505 Timeout > 0 506 -> Idle =< Timeout 507 ; true 508 ), 509 ( Data = idle(Idle) 510 ; Data = peer(Peer), 511 current_session(SessionID, Peer) 512 ; session_data(SessionID, Data) 513 ). 514 515 516 /******************************* 517 * GC SESSIONS * 518 *******************************/ 519 520%! http_close_session(+SessionID) is det. 521% 522% Closes an HTTP session. This predicate can be called from any 523% thread to terminate a session. It uses the broadcast/1 service 524% with the message below. 525% 526% http_session(end(SessionId, Peer)) 527% 528% The broadcast is done *before* the session data is destroyed and 529% the listen-handlers are executed in context of the session that 530% is being closed. Here is an example that destroys a Prolog 531% thread that is associated to a thread: 532% 533% == 534% :- listen(http_session(end(SessionId, _Peer)), 535% kill_session_thread(SessionID)). 536% 537% kill_session_thread(SessionID) :- 538% http_session_data(thread(ThreadID)), 539% thread_signal(ThreadID, throw(session_closed)). 540% == 541% 542% Succeed without any effect if SessionID does not refer to an 543% active session. 544% 545% If http_close_session/1 is called from a handler operating in 546% the current session and the CGI stream is still in state 547% =header=, this predicate emits a =|Set-Cookie|= to expire the 548% cookie. 549% 550% @error type_error(atom, SessionID) 551% @see listen/2 for acting upon closed sessions 552 553http_close_session(SessionId) :- 554 http_close_session(SessionId, true). 555 556http_close_session(SessionId, Expire) :- 557 must_be(atom, SessionId), 558 ( current_session(SessionId, Peer), 559 ( b_setval(http_session_id, SessionId), 560 broadcast(http_session(end(SessionId, Peer))), 561 fail 562 ; true 563 ), 564 ( Expire == true 565 -> expire_session_cookie 566 ; true 567 ), 568 retractall(current_session(SessionId, _)), 569 retractall(last_used(SessionId, _)), 570 retractall(session_data(SessionId, _)), 571 fail 572 ; true 573 ). 574 575 576%! expire_session_cookie(+SessionId) is det. 577% 578% Emit a request to delete a session cookie. This is only done if 579% http_close_session/1 is still in `header mode'. 580 :- 582 in_header_state, 583 session_setting(cookie(Cookie)), 584 session_setting(path(Path)), 585 !, 586 format('Set-Cookie: ~w=; \c 587 expires=Tue, 01-Jan-1970 00:00:00 GMT; \c 588 path=~w\r\n', 589 [Cookie, Path]). 590expire_session_cookie. 591 592in_header_state :- 593 current_output(CGI), 594 cgi_property(CGI, state(header)), 595 !. 596 597 598%! http_gc_sessions is det. 599% 600% Delete dead sessions. Currently runs session GC if a new session 601% is opened and the last session GC was more than a minute ago. 602 603:- dynamic 604 last_gc/1. 605 606http_gc_sessions :- 607 ( with_mutex(http_session_gc, need_sesion_gc) 608 -> do_http_gc_sessions 609 ; true 610 ). 611 612need_sesion_gc :- 613 get_time(Now), 614 ( last_gc(LastGC), 615 Now-LastGC < 60 616 -> true 617 ; retractall(last_gc(_)), 618 asserta(last_gc(Now)), 619 do_http_gc_sessions 620 ). 621 622do_http_gc_sessions :- 623 get_time(Now), 624 ( last_used(SessionID, Last), 625 session_setting(SessionID, timeout(Timeout)), 626 Timeout > 0, 627 Idle is Now - Last, 628 Idle > Timeout, 629 http_close_session(SessionID), 630 fail 631 ; true 632 ). 633 634 635 /******************************* 636 * UTIL * 637 *******************************/ 638 639%! http_session_cookie(-Cookie) is det. 640% 641% Generate a random cookie that can be used by a browser to 642% identify the current session. The cookie has the format 643% XXXX-XXXX-XXXX-XXXX[.<route>], where XXXX are random hexadecimal 644% numbers and [.<route>] is the optionally added routing 645% information. 646 (Cookie) :- 648 route(Route), 649 !, 650 random_4(R1,R2,R3,R4), 651 format(atom(Cookie), 652 '~`0t~16r~4|-~`0t~16r~9|-~`0t~16r~14|-~`0t~16r~19|.~w', 653 [R1,R2,R3,R4,Route]). 654http_session_cookie(Cookie) :- 655 random_4(R1,R2,R3,R4), 656 format(atom(Cookie), 657 '~`0t~16r~4|-~`0t~16r~9|-~`0t~16r~14|-~`0t~16r~19|', 658 [R1,R2,R3,R4]). 659 660:- thread_local 661 route_cache/1. 662 663%! route(-RouteID) is semidet. 664% 665% Fetch the route identifier. This value is added as .<route> to 666% the session cookie and used by -for example- the apache load 667% balanching module. The default route is the local name of the 668% host. Alternatives may be provided using 669% http_set_session_options/1. 670 671route(Route) :- 672 route_cache(Route), 673 !, 674 Route \== ''. 675route(Route) :- 676 route_no_cache(Route), 677 assert(route_cache(Route)), 678 Route \== ''. 679 680route_no_cache(Route) :- 681 session_setting(route(Route)), 682 !. 683route_no_cache(Route) :- 684 gethostname(Host), 685 ( sub_atom(Host, Before, _, _, '.') 686 -> sub_atom(Host, 0, Before, _, Route) 687 ; Route = Host 688 ). 689 690:- if(\+current_prolog_flag(windows, true)). 691%! urandom(-Handle) is semidet. 692% 693% Handle is a stream-handle for /dev/urandom. Originally, this 694% simply tried to open /dev/urandom, failing if this device does 695% not exist. It turns out that trying to open /dev/urandom can 696% block indefinitely on some Windows installations, so we no 697% longer try this on Windows. 698 699:- dynamic 700 urandom_handle/1. 701 702urandom(Handle) :- 703 urandom_handle(Handle), 704 !, 705 Handle \== []. 706urandom(Handle) :- 707 catch(open('/dev/urandom', read, In, [type(binary)]), _, fail), 708 !, 709 assert(urandom_handle(In)), 710 Handle = In. 711urandom(_) :- 712 assert(urandom_handle([])), 713 fail. 714 715get_pair(In, Value) :- 716 get_byte(In, B1), 717 get_byte(In, B2), 718 Value is B1<<8+B2. 719:- endif. 720 721%! random_4(-R1,-R2,-R3,-R4) is det. 722% 723% Generate 4 2-byte random numbers. Uses =|/dev/urandom|= when 724% available to make prediction of the session IDs hard. 725 726:- if(current_predicate(urandom/1)). 727random_4(R1,R2,R3,R4) :- 728 urandom(In), 729 !, 730 get_pair(In, R1), 731 get_pair(In, R2), 732 get_pair(In, R3), 733 get_pair(In, R4). 734:- endif. 735random_4(R1,R2,R3,R4) :- 736 R1 is random(65536), 737 R2 is random(65536), 738 R3 is random(65536), 739 R4 is random(65536).