1:-module(login_box, [login_box//1]). 2
3:- use_module(library(http/http_parameters)). 4:- use_module(library(http/http_client)). 5:- use_module(library(http/html_write)). 6:- use_module(library(http/http_session)). 7:- use_module(library(http/http_dispatch)). 8
9/** <module> Login Box Weblog Pattern
10
11 This module implements predicates related to the login pattern.
12 Closely related to user_database, register_box, logout_box.
13
14 @see http://www.welie.com/patterns/showPattern.php?patternID=login
15 @tbd https support
16 @tbd openid support (check openid swipl library)
17*/
18
19%% login_box(+Options) is det
20%
21% A DCG producing a login box and implementing the basic functionality.
22% Options is a list of options that modify the default behavior.
23% The provided options are:
24%
25% * after_login(+Atom)
26% logout_box: Displays a logout_box instead of a login_box when a user is logged in. Default.
27% logout_box(+Logout_Options): As logout_box but the logout_box is modified based on Logout_Options
28% destroy: Nothing will be displayed when a user is logged in
29%
30% * register(+RegisterPage)
31% Give the option to register by redirecting the user to the register page.
32% Deactivated by default
33%
34% * db_handler(+Database_Handler)
35% Provide a database of users (as described in the user_database module).
36% If not given, login_box will assume an empty database
37%
38% * return(+SuccessPage, +FailPage)
39% After a succesful/failed login the user will be redirected to SuccessPage/FailPage
40% If the atom 'referer' is given, login_box will attempt to return the user to the previous page using the HTTP_REFERER information (default behavior)
41%
42% * referer_check(+Check_Options)
43% A check to perform on the URL retrieved by HTTP_REFERER info before redirecting to it.
44%
45% +Check_Option has the form of {+Atom, +Mode}
46% Atom can be 'success', 'fail' or 'all'
47% Mode can be:
48% 'false': no check will be performed
49% 'empty': if the HTTP_REFERER field is empty the user is redirected to the root
50% empty(+ReturnPage): as 'empty' but the user is redirected to ReturnPage
51% 'valid': the URL should appear to be a valid URL otherwise the user is redirected to the root (default)
52% valid(+ReturnPage): as 'valid' but the user is redirected to ReturnPage
53% predicate(:Check): a predicate to be called given the URL as an argument. If it fails, the user is redirected to the root
54% predicate(:Check, +ReturnPage): as predicate(:Check) but the user is redirected to ReturnPage
55%
56
57login_box(_Options) -->
58 {http_set_session_options([create(noauto)]),
59 http_handler('/user_login', login_request,[])},
60 html([
61 form([action='/user_login',method='POST'],
62 [
63 p([], [
64 label([for=name],'Username:'),
65 input([name=name, type=textarea])
66 ]),
67 p([], [
68 label([for=pass],'Password:'),
69 input([name=pass, type=password])
70 ]),
71 p([], input([name=submit, type=submit, value='Submit'], []))
72 ])]).
73
74login_request(Request) :-
75 member(referer(Referer),Request),
76 http_read_data(Request, [name=Name,pass=Password|_], []),
77 check_login(Name, Password, Details) ->
78 succesful_login(Name, Referer, Request)
79 ; failed_login(Details, Referer, Request).
80
81succesful_login(Name, Return, Request) :-
82 http_open_session(_SessionID, _),
83 http_session_assert(user(Name)),
84 http_redirect(see_other, Return, Request).
95
96failed_login(_Details, _Return, _Request) :-
97 phrase(
98 html(html(
99 [head(title(':(')),
100 body([p('The username or password you entered is incorrect.')])])),
101 TokenizedHtml,
102 []),
103 format('Content-type: text/html~n~n'),
104 print_html(TokenizedHtml).
105
106check_login(Name, Password, true) :-
107 108 sleep(1),
109 110 user_db(Name, UserPassword, Salt),
111 112 sha_hash(Password, Hash1, [algorithm(sha512)]),
113 hash_atom(Hash1, HashAtom1),
114 115 atom_concat(HashAtom1, Salt, Salted),
116 sha_hash(Salted, Hash, [algorithm(sha512)]),
117 hash_atom(Hash, UserPassword).
118
119user_db(thanosqr, '766286d68e742b693e7d712a434cab5b9775cb11bde8a7285a09642a220d269029c75df7d624c76bc76a972afce92e7427876cee650273ad9a02a04ff0d061a0', random).
120user_db(annie, '94db72db39580e0559ad6224358e58791b4eeb2511750e759c8b1f24de79a52b2e8abda02ac43097587bee3a5b63f42f41beb236dad4193e7bb40f45259aa04a', iswear).
121