forked from rabbibotton/clog
-
Notifications
You must be signed in to change notification settings - Fork 0
/
31-tutorial.lisp
149 lines (132 loc) · 6.06 KB
/
31-tutorial.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
;; Demonstrates clog-web-site using a database oriented setup
;; using clog-web-dbi for users and clog-auth for authentication
;; and authorization
(defpackage #:clog-tut-31
(:use #:cl #:clog #:clog-web #:clog-auth #:clog-web-dbi)
(:export start-tutorial))
(in-package #:clog-tut-31)
;;
;; Setup website structure, database and CLOG
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar *sql-connection* nil)
;; Default user/pass is username: admin and password: admin
;; We use authorizations to control what menus appear if logged in or not.
;; We use the :authorize key on create-web-page to limit access as well
;; directly to a page when not using menus.
;; We use our menu with the convenient clog-web-routes-from-menu to
;; setup the routes from URLs to handlers:
; Menu Menu Item URL Handler Actions Auth
(defparameter *menu* `(("Features" (("Login" "/login" on-login :login)
("Signup" "/signup" on-signup :signup)
("Main" "/main" on-main :main)
("Logout" "/logout" on-logout :logout)))
("Admin" (("User List" "/users" on-users :users)))
("Help" (("About" "/about" on-about))))
"Setup website menu")
(defun start-tutorial ()
;; Setup authorizations between roles and actions
(add-authorization '(:guest) '(:login :signup :main))
(add-authorization '(:member) '(:logout :main))
(add-authorization '(:admin) '(:users))
;; Setup database connection
(when *sql-connection*
(dbi:disconnect *sql-connection*))
(let ((db-dir (format nil "~A~A" (asdf:system-source-directory :clog) "tut-31.db")))
(setf *sql-connection* (dbi:connect :sqlite3 :database-name db-dir))
(format t "Database location: ~A~%" db-dir))
;; Check if need to setup sample data
(handler-case
(dbi:fetch (dbi:execute (dbi:prepare *sql-connection* "select * from config")))
(error ()
(print "Create database and tables.")
(create-base-tables *sql-connection*)))
;; Setup clog, using long polling for web crawlers and some meta info
(initialize 'on-main
:long-poll-first t
:boot-function (clog-web-meta
"clogpower.com - CLOG - the common lisp omnificent gui"))
(clog-web-routes-from-menu *menu*)
(open-browser))
;;
;; Look and Feel
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun init-site (body)
"Setup the website, called on each url switch"
;; Initialize the clog-web environment
(clog-web-initialize body)
(setf (title (html-document body)) "Tutorial 31") ;; set the page title
;; Instantly reload other windows open on authentication change
(set-on-authentication-change body (lambda (body)
(url-replace (location body) "/")))
;; Initialzie the clog-web-site environment
(let ((profile (get-profile body *sql-connection*)))
(create-web-site body
:settings '(:color-class "w3-blue-gray"
:border-class ""
:signup-link "/signup"
:login-link "/login")
:profile profile
:roles (if profile
(if (equalp "admin"
(getf profile :|username|))
'(:member :admin)
'(:member))
'(:guest))
:title "CLOG - The Common Lisp Omnificent GUI"
:footer "(c) 2022 David Botton"
:logo "/img/clog-liz.png")))
;;
;; URL Path Handlers
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun on-login (body)
(init-site body)
(create-web-page
body
:login `(:menu ,*menu*
:on-submit ,(lambda (obj)
(if (login body *sql-connection*
(name-value obj "username")
(name-value obj "password"))
;; url-replace removes login from history stack
(url-replace (location body) "/main")
(clog-web-alert obj "Invalid" "The username and password are invalid."
:time-out 3
:place-top t))))
;; don't authorize use of page if logged in
:authorize t))
(defun on-logout (body)
(logout body)
(url-replace (location body) "/"))
(defun on-signup (body)
(init-site body)
(create-web-page body
:signup `(:menu ,*menu*
:content ,(lambda (body)
(sign-up body *sql-connection*)))
;; don't authorize use of page if logged in
:authorize t))
(defun on-main (body)
(init-site body)
(create-web-page body :main `(:menu ,*menu*
:content "I am the main page")))
(defun on-about (body)
(init-site body)
(create-web-page body :about `(:menu ,*menu*
:content "About Me")))
(defun on-users (body)
(init-site body)
(create-web-page body :users
`(:menu ,*menu*
:content ,(lambda (body)
(let ((users (dbi:fetch-all
(dbi:execute
(dbi:prepare
*sql-connection*
"select * from users")))))
(dolist (user users)
(create-div body :content (getf user :|username|))))))
;; don't authorize use of page unless you are the admin
:authorize t))