37
38:- module(http_session,
39 [ http_set_session_options/1, 40 http_set_session/1, 41 http_set_session/2, 42 http_session_option/1, 43
44 http_session_id/1, 45 http_in_session/1, 46 http_current_session/2, 47 http_close_session/1, 48 http_open_session/2, 49
50 http_session_cookie/1, 51
52 http_session_asserta/1, 53 http_session_assert/1, 54 http_session_retract/1, 55 http_session_retractall/1, 56 http_session_data/1, 57
58 http_session_asserta/2, 59 http_session_assert/2, 60 http_session_retract/2, 61 http_session_retractall/2, 62 http_session_data/2 63 ]). 64:- use_module(http_wrapper). 65:- use_module(http_stream). 66:- use_module(library(error)). 67:- use_module(library(debug)). 68:- use_module(library(socket)). 69:- use_module(library(broadcast)). 70:- use_module(library(lists)). 71:- use_module(library(time)). 72:- use_module(library(option)). 73
74:- predicate_options(http_open_session/2, 2, [renew(boolean)]). 75
111
112:- dynamic
113 session_setting/1, 114 current_session/2, 115 last_used/2, 116 session_data/2. 117
118:- multifile
119 hooked/0,
120 hook/1, 121 session_setting/1,
122 session_option/2. 123
124session_setting(timeout(600)). 125session_setting(granularity(60)). 126session_setting(cookie('swipl_session')).
127session_setting(path(/)).
128session_setting(enabled(true)).
129session_setting(create(auto)).
130session_setting(proxy_enabled(false)).
131session_setting(gc(passive)).
132session_setting(samesite(lax)).
133
134session_option(timeout, integer).
135session_option(granularity, integer).
136session_option(cookie, atom).
137session_option(path, atom).
138session_option(create, oneof([auto,noauto])).
139session_option(route, atom).
140session_option(enabled, boolean).
141session_option(proxy_enabled, boolean).
142session_option(gc, oneof([active,passive])).
143session_option(samesite, oneof([none,lax,strict])).
144
218
219http_set_session_options([]) => true.
220http_set_session_options([H|T]) =>
221 http_set_session_option(H),
222 http_set_session_options(T).
223
224http_set_session_option(Option), Option =.. [Name,Value] =>
225 ( session_option(Name, Type)
226 -> must_be(Type, Value)
227 ; domain_error(http_session_option, Option)
228 ),
229 functor(Free, Name, 1),
230 ( clause(session_setting(Free), _, Ref)
231 -> ( Free \== Value
232 -> asserta(session_setting(Option)),
233 erase(Ref),
234 updated_session_setting(Name, Free, Value)
235 ; true
236 )
237 ; asserta(session_setting(Option))
238 ).
239
243
244http_session_option(Option) :-
245 session_setting(Option).
246
251
252:- public session_setting/2. 253
254session_setting(SessionID, Setting) :-
255 nonvar(Setting),
256 get_session_option(SessionID, Setting),
257 !.
258session_setting(_, Setting) :-
259 session_setting(Setting).
260
261get_session_option(SessionID, Setting) :-
262 hooked,
263 !,
264 hook(get_session_option(SessionID, Setting)).
265get_session_option(SessionID, Setting) :-
266 functor(Setting, Name, 1),
267 local_option(Name, Value, Term),
268 session_data(SessionID, '$setting'(Term)),
269 !,
270 arg(1, Setting, Value).
271
272
273updated_session_setting(gc, _, passive) :-
274 stop_session_gc_thread, !.
275updated_session_setting(_, _, _). 276
277
286
287http_set_session(Setting) :-
288 http_session_id(SessionId),
289 http_set_session(SessionId, Setting).
290
291http_set_session(SessionId, Setting) :-
292 functor(Setting, Name, _),
293 ( local_option(Name, _, _)
294 -> true
295 ; permission_error(set, http_session, Setting)
296 ),
297 arg(1, Setting, Value),
298 ( session_option(Name, Type)
299 -> must_be(Type, Value)
300 ; domain_error(http_session_option, Setting)
301 ),
302 set_session_option(SessionId, Setting).
303
304set_session_option(SessionId, Setting) :-
305 hooked,
306 !,
307 hook(set_session_option(SessionId, Setting)).
308set_session_option(SessionId, Setting) :-
309 functor(Setting, Name, Arity),
310 functor(Free, Name, Arity),
311 retractall(session_data(SessionId, '$setting'(Free))),
312 assert(session_data(SessionId, '$setting'(Setting))).
313
314local_option(timeout, X, timeout(X)).
315
324
325http_session_id(SessionID) :-
326 ( http_in_session(ID)
327 -> SessionID = ID
328 ; throw(error(existence_error(http_session, _), _))
329 ).
330
344
345http_in_session(SessionID) :-
346 nb_current(http_session_id, ID),
347 ID \== [],
348 !,
349 debug(http_session, 'Session id from global variable: ~q', [ID]),
350 ID \== no_session,
351 SessionID = ID.
352http_in_session(SessionID) :-
353 http_current_request(Request),
354 http_in_session(Request, SessionID).
355
356http_in_session(Request, SessionID) :-
357 memberchk(session(ID), Request),
358 !,
359 debug(http_session, 'Session id from request: ~q', [ID]),
360 b_setval(http_session_id, ID),
361 SessionID = ID.
362http_in_session(Request, SessionID) :-
363 memberchk(cookie(Cookies), Request),
364 session_setting(cookie(Cookie)),
365 member(Cookie=SessionID0, Cookies),
366 debug(http_session, 'Session id from cookie: ~q', [SessionID0]),
367 peer(Request, Peer),
368 valid_session_id(SessionID0, Peer),
369 !,
370 b_setval(http_session_id, SessionID0),
371 SessionID = SessionID0.
372
373
384
385http_session(Request, Request, SessionID) :-
386 memberchk(session(SessionID0), Request),
387 !,
388 SessionID = SessionID0.
389http_session(Request0, Request, SessionID) :-
390 memberchk(cookie(Cookies), Request0),
391 session_setting(cookie(Cookie)),
392 member(Cookie=SessionID0, Cookies),
393 peer(Request0, Peer),
394 valid_session_id(SessionID0, Peer),
395 !,
396 SessionID = SessionID0,
397 Request = [session(SessionID)|Request0],
398 b_setval(http_session_id, SessionID).
399http_session(Request0, Request, SessionID) :-
400 session_setting(create(auto)),
401 session_setting(path(Path)),
402 memberchk(path(ReqPath), Request0),
403 sub_atom(ReqPath, 0, _, _, Path),
404 !,
405 create_session(Request0, Request, SessionID).
406
407create_session(Request0, Request, SessionID) :-
408 http_gc_sessions,
409 http_session_cookie(SessionID),
410 session_setting(cookie(Cookie)),
411 session_setting(path(Path)),
412 session_setting(samesite(SameSite)),
413 debug(http_session, 'Created session ~q at path=~q', [SessionID, Path]),
414 ( SameSite == none
415 -> format('Set-Cookie: ~w=~w; Path=~w; Version=1\r\n',
416 [Cookie, SessionID, Path])
417 ; format('Set-Cookie: ~w=~w; Path=~w; Version=1; SameSite=~w\r\n',
418 [Cookie, SessionID, Path, SameSite])
419 ),
420 Request = [session(SessionID)|Request0],
421 peer(Request0, Peer),
422 open_session(SessionID, Peer).
423
424
440
441http_open_session(SessionID, Options) :-
442 http_in_session(SessionID0),
443 \+ option(renew(true), Options, false),
444 !,
445 SessionID = SessionID0.
446http_open_session(SessionID, _Options) :-
447 ( in_header_state
448 -> true
449 ; current_output(CGI),
450 permission_error(open, http_session, CGI)
451 ),
452 ( http_in_session(ActiveSession)
453 -> http_close_session(ActiveSession, false)
454 ; true
455 ),
456 http_current_request(Request),
457 create_session(Request, _, SessionID).
458
459
460:- multifile
461 http:request_expansion/2. 462
463http:request_expansion(Request0, Request) :-
464 session_setting(enabled(true)),
465 http_session(Request0, Request, _SessionID).
466
471
472peer(Request, Peer) :-
473 ( session_setting(proxy_enabled(true)),
474 http_peer(Request, Peer)
475 -> true
476 ; memberchk(peer(Peer), Request)
477 -> true
478 ; true
479 ).
480
485
486open_session(SessionID, Peer) :-
487 assert_session(SessionID, Peer),
488 b_setval(http_session_id, SessionID),
489 broadcast(http_session(begin(SessionID, Peer))).
490
491assert_session(SessionID, Peer) :-
492 hooked,
493 !,
494 hook(assert_session(SessionID, Peer)).
495assert_session(SessionID, Peer) :-
496 get_time(Now),
497 assert(current_session(SessionID, Peer)),
498 assert(last_used(SessionID, Now)).
499
504
505valid_session_id(SessionID, Peer) :-
506 active_session(SessionID, SessionPeer, LastUsed),
507 get_time(Now),
508 ( session_setting(SessionID, timeout(Timeout)),
509 Timeout > 0
510 -> Idle is Now - LastUsed,
511 ( Idle =< Timeout
512 -> true
513 ; http_close_session(SessionID),
514 fail
515 )
516 ; Peer \== SessionPeer
517 -> http_close_session(SessionID),
518 fail
519 ; true
520 ),
521 set_last_used(SessionID, Now, Timeout).
522
523active_session(SessionID, Peer, LastUsed) :-
524 hooked,
525 !,
526 hook(active_session(SessionID, Peer, LastUsed)).
527active_session(SessionID, Peer, LastUsed) :-
528 current_session(SessionID, Peer),
529 get_last_used(SessionID, LastUsed).
530
531get_last_used(SessionID, Last) :-
532 atom(SessionID),
533 !,
534 once(last_used(SessionID, Last)).
535get_last_used(SessionID, Last) :-
536 last_used(SessionID, Last).
537
543
544set_last_used(SessionID, Now, TimeOut) :-
545 hooked,
546 !,
547 hook(set_last_used(SessionID, Now, TimeOut)).
548set_last_used(SessionID, Now, _TimeOut) :-
549 session_setting(granularity(TimeGranularity)),
550 LastUsed is floor(Now/TimeGranularity)*TimeGranularity,
551 ( clause(last_used(SessionID, CurrentLast), _, Ref)
552 -> ( CurrentLast == LastUsed
553 -> true
554 ; asserta(last_used(SessionID, LastUsed)),
555 erase(Ref)
556 )
557 ; asserta(last_used(SessionID, LastUsed))
558 ).
559
560
561 564
572
573http_session_asserta(Data) :-
574 http_session_id(SessionId),
575 ( hooked
576 -> hook(asserta(session_data(SessionId, Data)))
577 ; asserta(session_data(SessionId, Data))
578 ).
579
580http_session_assert(Data) :-
581 http_session_id(SessionId),
582 ( hooked
583 -> hook(assertz(session_data(SessionId, Data)))
584 ; assertz(session_data(SessionId, Data))
585 ).
586
587http_session_retract(Data) :-
588 http_session_id(SessionId),
589 ( hooked
590 -> hook(retract(session_data(SessionId, Data)))
591 ; retract(session_data(SessionId, Data))
592 ).
593
594http_session_retractall(Data) :-
595 http_session_id(SessionId),
596 ( hooked
597 -> hook(retractall(session_data(SessionId, Data)))
598 ; retractall(session_data(SessionId, Data))
599 ).
600
607
608http_session_data(Data) :-
609 http_session_id(SessionId),
610 ( hooked
611 -> hook(session_data(SessionId, Data))
612 ; session_data(SessionId, Data)
613 ).
614
625
626http_session_asserta(Data, SessionId) :-
627 must_be(atom, SessionId),
628 ( hooked
629 -> hook(asserta(session_data(SessionId, Data)))
630 ; asserta(session_data(SessionId, Data))
631 ).
632
633http_session_assert(Data, SessionId) :-
634 must_be(atom, SessionId),
635 ( hooked
636 -> hook(assertz(session_data(SessionId, Data)))
637 ; assertz(session_data(SessionId, Data))
638 ).
639
640http_session_retract(Data, SessionId) :-
641 must_be(atom, SessionId),
642 ( hooked
643 -> hook(retract(session_data(SessionId, Data)))
644 ; retract(session_data(SessionId, Data))
645 ).
646
647http_session_retractall(Data, SessionId) :-
648 must_be(atom, SessionId),
649 ( hooked
650 -> hook(retractall(session_data(SessionId, Data)))
651 ; retractall(session_data(SessionId, Data))
652 ).
653
654http_session_data(Data, SessionId) :-
655 must_be(atom, SessionId),
656 ( hooked
657 -> hook(session_data(SessionId, Data))
658 ; session_data(SessionId, Data)
659 ).
660
661
662 665
676
677http_current_session(SessionID, Data) :-
678 hooked,
679 !,
680 hook(current_session(SessionID, Data)).
681http_current_session(SessionID, Data) :-
682 get_time(Now),
683 get_last_used(SessionID, Last), 684 Idle is Now - Last,
685 ( session_setting(SessionID, timeout(Timeout)),
686 Timeout > 0
687 -> Idle =< Timeout
688 ; true
689 ),
690 ( Data = idle(Idle)
691 ; Data = peer(Peer),
692 current_session(SessionID, Peer)
693 ; session_data(SessionID, Data)
694 ).
695
696
697 700
733
734http_close_session(SessionId) :-
735 http_close_session(SessionId, true).
736
737http_close_session(SessionId, Expire) :-
738 hooked,
739 !,
740 forall(hook(close_session(SessionId)),
741 expire_session_cookie(Expire)).
742http_close_session(SessionId, Expire) :-
743 must_be(atom, SessionId),
744 ( current_session(SessionId, Peer),
745 ( b_setval(http_session_id, SessionId),
746 broadcast(http_session(end(SessionId, Peer))),
747 fail
748 ; true
749 ),
750 expire_session_cookie(Expire),
751 retractall(current_session(SessionId, _)),
752 retractall(last_used(SessionId, _)),
753 retractall(session_data(SessionId, _)),
754 fail
755 ; true
756 ).
757
758
763
764expire_session_cookie(true) :-
765 !,
766 expire_session_cookie.
767expire_session_cookie(_).
768
769expire_session_cookie :-
770 in_header_state,
771 session_setting(cookie(Cookie)),
772 session_setting(path(Path)),
773 !,
774 format('Set-Cookie: ~w=; \c
775 expires=Tue, 01-Jan-1970 00:00:00 GMT; \c
776 path=~w\r\n',
777 [Cookie, Path]).
778expire_session_cookie.
779
:-
781 current_output(CGI),
782 is_cgi_stream(CGI),
783 cgi_property(CGI, state(header)),
784 !.
785
786
797
798:- dynamic
799 last_gc/1. 800
801http_gc_sessions :-
802 session_setting(gc(active)),
803 !,
804 start_session_gc_thread.
805http_gc_sessions :-
806 session_setting(granularity(TimeGranularity)),
807 http_gc_sessions(TimeGranularity).
808
809http_gc_sessions(TimeOut) :-
810 ( with_mutex(http_session_gc, need_sesion_gc(TimeOut))
811 -> do_http_gc_sessions
812 ; true
813 ).
814
815need_sesion_gc(TimeOut) :-
816 get_time(Now),
817 ( last_gc(LastGC),
818 Now-LastGC < TimeOut
819 -> fail
820 ; retractall(last_gc(_)),
821 asserta(last_gc(Now))
822 ).
823
824do_http_gc_sessions :-
825 hooked,
826 !,
827 hook(gc_sessions).
828do_http_gc_sessions :-
829 debug(http_session(gc), 'Running HTTP session GC', []),
830 get_time(Now),
831 ( session_setting(SessionID, timeout(Timeout)),
832 last_used(SessionID, Last),
833 Timeout > 0,
834 Idle is Now - Last,
835 Idle > Timeout,
836 http_close_session(SessionID, false),
837 fail
838 ; true
839 ).
840
847
848:- dynamic
849 session_gc_queue/1. 850
851start_session_gc_thread :-
852 session_gc_queue(_),
853 !.
854start_session_gc_thread :-
855 session_setting(gc(active)),
856 !,
857 catch(thread_create(session_gc_loop, _,
858 [ alias('__http_session_gc'),
859 at_exit(retractall(session_gc_queue(_))),
860 inherit_from(main)
861 ]),
862 error(permission_error(create, thread, _),_),
863 true).
864start_session_gc_thread.
865
866stop_session_gc_thread :-
867 retract(session_gc_queue(Id)),
868 !,
869 thread_send_message(Id, done),
870 thread_join(Id, _).
871stop_session_gc_thread.
872
873session_gc_loop :-
874 thread_self(GcQueue),
875 asserta(session_gc_queue(GcQueue)),
876 session_gc_loop_.
877
878session_gc_loop_ :-
879 session_setting(gc(active)),
880 session_setting(granularity(TimeGranularity)),
881 get_time(Now),
882 At is Now+TimeGranularity,
883 thread_self(GcQueue),
884 repeat,
885 ( thread_get_message(GcQueue, Message, [deadline(At)])
886 -> ( Message == done
887 -> !
888 ; fail
889 )
890 ; !,
891 http_gc_sessions(10), 892 session_gc_loop_
893 ).
894
895
896 899
907
908http_session_cookie(Cookie) :-
909 route(Route),
910 !,
911 random_4(R1,R2,R3,R4),
912 format(atom(Cookie),
913 '~`0t~16r~4|-~`0t~16r~9|-~`0t~16r~14|-~`0t~16r~19|.~w',
914 [R1,R2,R3,R4,Route]).
915http_session_cookie(Cookie) :-
916 random_4(R1,R2,R3,R4),
917 format(atom(Cookie),
918 '~`0t~16r~4|-~`0t~16r~9|-~`0t~16r~14|-~`0t~16r~19|',
919 [R1,R2,R3,R4]).
920
921:- thread_local
922 route_cache/1. 923
931
932route(Route) :-
933 route_cache(Route),
934 !,
935 Route \== ''.
936route(Route) :-
937 route_no_cache(Route),
938 assert(route_cache(Route)),
939 Route \== ''.
940
941route_no_cache(Route) :-
942 session_setting(route(Route)),
943 !.
944route_no_cache(Route) :-
945 gethostname(Host),
946 ( sub_atom(Host, Before, _, _, '.')
947 -> sub_atom(Host, 0, Before, _, Route)
948 ; Route = Host
949 ).
950
951:- if(\+current_prolog_flag(windows, true)). 959
960:- dynamic
961 urandom_handle/1. 962
963urandom(Handle) :-
964 urandom_handle(Handle),
965 !,
966 Handle \== [].
967urandom(Handle) :-
968 catch(open('/dev/urandom', read, In, [type(binary)]), _, fail),
969 !,
970 assert(urandom_handle(In)),
971 Handle = In.
972urandom(_) :-
973 assert(urandom_handle([])),
974 fail.
975
976get_pair(In, Value) :-
977 get_byte(In, B1),
978 get_byte(In, B2),
979 Value is B1<<8+B2.
980:- endif. 981
986
987:- if(current_predicate(urandom/1)). 988random_4(R1,R2,R3,R4) :-
989 urandom(In),
990 !,
991 get_pair(In, R1),
992 get_pair(In, R2),
993 get_pair(In, R3),
994 get_pair(In, R4).
995:- endif. 996random_4(R1,R2,R3,R4) :-
997 R1 is random(65536),
998 R2 is random(65536),
999 R3 is random(65536),
1000 R4 is random(65536).
1001