mirror of
https://github.com/rabbibotton/clog.git
synced 2025-12-06 02:30:42 -08:00
184 lines
8.3 KiB
Common Lisp
184 lines
8.3 KiB
Common Lisp
;; In this tutorial we expand on the last using clog-web-content
|
|
;; to instantly create a site with user, authentication, and
|
|
;; content management including comments. We also use the option
|
|
;; :extended-routing to allow handlers to handle routes on the
|
|
;; same path.
|
|
|
|
|
|
(defpackage #:clog-tut-32
|
|
(:use #:cl #:clog #:clog-web #:clog-auth #:clog-web-dbi)
|
|
(:export start-tutorial))
|
|
|
|
(in-package #:clog-tut-32)
|
|
|
|
;;
|
|
;; Setup website structure, database and CLOG
|
|
;;
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defvar *sql-connection* nil)
|
|
|
|
;; Default user/pass is username: admin and password: admin
|
|
|
|
;; /content is our root content URL, if you are authorized as an
|
|
;; editor or admin you are able to add additional pages by going to
|
|
;; the url /content/whatever and then click to add page. If you want
|
|
;; it in the menu you would just need to add the url to the
|
|
;; menu. There is no need to add handlers for pages under /content as
|
|
;; when we initalized CLOG we used the option :extended-routing so
|
|
;; that a URL start with /content/ will be sent to the same handler as
|
|
;; /content in this case on-main. So our about page has no handler set
|
|
;; but functions as we added to out database.
|
|
|
|
; Menu Menu Item URL Handler Actions Auth
|
|
(defparameter *menu* `(("Features" (("Home" "/")
|
|
("Login" "/login" on-login :login)
|
|
("Signup" "/signup" on-signup :signup)
|
|
("Change Password" "/pass" on-new-pass :change-password)
|
|
("Content" "/content" on-main :content)
|
|
("Logout" "/logout" on-logout :logout)))
|
|
("Admin" (("User List" "/users" on-users :users)))
|
|
("Help" (("About" "/content/about"))))
|
|
"Setup website menu")
|
|
|
|
(defun start-tutorial ()
|
|
;; Here we add authorizations for content and editting content, not just
|
|
;; access to pages.
|
|
(add-authorization '(:guest :member) '(:content-show-comments))
|
|
(add-authorization '(:guest) '(:login :signup))
|
|
(add-authorization '(:member) '(:logout
|
|
:change-password
|
|
:content-comment))
|
|
(add-authorization '(:editor) '(:content-edit))
|
|
(add-authorization '(:admin) '(:users :content-admin))
|
|
;; Setup database connection
|
|
(when *sql-connection*
|
|
(dbi:disconnect *sql-connection*))
|
|
(let ((db-dir (format nil "~A~A" (asdf:system-source-directory :clog) "tut-32.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*)
|
|
;; A main page was added, but let's also add an about page:
|
|
(dbi:do-sql
|
|
*sql-connection*
|
|
(sql-insert* "content" `(:key "about"
|
|
:title "About Tutorial 32"
|
|
:value "All about me."
|
|
:createdate (,*sqlite-timestamp*))))))
|
|
;; Setup clog
|
|
(initialize 'on-main
|
|
:long-poll-first t
|
|
:extended-routing 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 32") ;; 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
|
|
;; We define the roles simply if logged out a :guest
|
|
;; if logged in a :member and if username is admin
|
|
;; a :member, :editor and :admin.
|
|
:roles (if profile
|
|
(if (equalp "admin"
|
|
(getf profile :|username|))
|
|
'(:member :editor :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 (location body) "/")
|
|
(clog-web-alert obj "Invalid" "The username and password are invalid."
|
|
:time-out 3
|
|
:place-top t))))
|
|
: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*)))
|
|
:authorize t))
|
|
|
|
(defun on-main (body)
|
|
(init-site body)
|
|
(create-web-page body :index `(:menu ,*menu*
|
|
:content ,(clog-web-content *sql-connection*
|
|
:comment-table "content"))))
|
|
|
|
(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)
|
|
(let* ((box (create-div body))
|
|
(suser (create-span box :content (getf user :|username|)))
|
|
(rbut (create-button box :content "Reset Password"
|
|
:class "w3-margin-left")))
|
|
(declare (ignore suser))
|
|
(set-on-click rbut (lambda (obj)
|
|
(declare (ignore obj))
|
|
(reset-password *sql-connection*
|
|
(getf user :|username|))
|
|
(setf (disabledp rbut) t)
|
|
(setf (text rbut) "Done"))))))))
|
|
:authorize t))
|
|
|
|
(defun on-new-pass (body)
|
|
(init-site body)
|
|
(create-web-page body
|
|
:change-password `(:menu ,*menu*
|
|
:content ,(lambda (body)
|
|
(change-password body *sql-connection*)))
|
|
:authorize t))
|