Feufochmar
/
feuforeve.v4
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Add login and logout pages.

This commit is contained in:
Feufochmar 2021-05-05 15:05:09 +02:00
parent f8830635bf
commit 3ca823578c
3 changed files with 161 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
main.rkt
View File

@ -84,6 +84,8 @@
("user" symlink "/user/list"
("list" weblet pages:notepad:user-list)
("show/{name}" matching-weblet pages:notepad:user-show)
("login/{name}" matching-weblet pages:notepad:user-login)
("logout" weblet pages:notepad:user-logout)
)
))
; Sitemap
@ -124,6 +126,7 @@
(#f "/notes/show" #f)
("Utilisateurs" "/user/list" #t)
(#f "/user/show" #f)
(#f "/user/login" #f)
)
)
; Webcontainer

72
src/notepad/user.rkt
View File

@ -9,13 +9,15 @@
net/base64
net/cookies/server
racket/random
"../webcontainer/weblet-parameter.rkt"
)
(provide
user-init-repository
hash-password
new-user get-user-by-name update-user-info remove-user get-all-users
user-name user-pseudo user-about user-icon
new-cookie update-cookie remove-cookie get-user-by-cookie remove-expired-cookies
user-name user-pseudo user-about user-icon user-check-password
new-cookie update-cookie remove-cookie remove-expired-cookies
get-user-from-weblet-parameter
)
; User definition
@ -34,6 +36,9 @@
(user : integer?) ; (user?) Identifier of user
)
; Key used for cookie
(define *cookie-key* "notepad")
; Add the definitions to a repository
(define (user-init-repository repo)
(init-repository repo
@ -89,14 +94,20 @@
; Remove user
(delete-instance usr)))
; Expiration date in seconds, absolute
(define (new-cookie-expiration-date)
(+ (current-seconds) (* 10 24 60 60))) ; Cookie are valid for 10 days
; Get all users
(define (get-all-users)
(list-instances user))
; Check user password
(define (user-check-password usr password)
(and usr password
(equal? (hash-password (user-name usr) password)
(user-hashpw usr))))
; Expiration date in seconds, absolute
(define (new-cookie-expiration-date)
(+ (current-seconds) (* 10 24 60 60))) ; Cookie are valid for 10 days
; Create a cookie for a user
(define (new-cookie usr domain [dev? #f])
(define value (base64-encode (crypto-random-bytes 128) #""))
@ -112,14 +123,17 @@
(define instance (instanciate usercookie))
(set-usercookie-value! instance value)
(set-usercookie-expires! instance expires)
(set-usercookie-user! instance (instance-identifier usr))
(save-instance instance)
(make-cookie
"notepad"
value
#:expires (seconds->date expires)
#:domain domain
#:secure? (not dev?)
#:http-only? #t)))))
(cookie->set-cookie-header
(make-cookie
*cookie-key*
value
#:expires (seconds->date expires)
#:domain domain
#:path "/"
#:secure? (not dev?)
#:http-only? #t))))))
; Get cookie by value
(define (get-cookie-by-value value)
@ -135,23 +149,34 @@
(define expires (new-cookie-expiration-date))
(set-usercookie-expires! cookie expires)
(save-instance cookie)
(make-cookie
"notepad"
value
#:expires (seconds->date expires)
#:domain domain
#:secure? (not dev?)
#:http-only? #t))
(cookie->set-cookie-header
(make-cookie
*cookie-key*
value
#:expires (seconds->date expires)
#:domain domain
#:path "/"
#:secure? (not dev?)
#:http-only? #t)))
(#t
#f))))
; Remove a cookie from its value
(define (remove-cookie value)
(define (remove-cookie-by-value value)
(within-transaction (class-repository usercookie)
(define cookie (get-cookie-by-value value))
(when cookie
(delete-instance cookie))))
; Remove cookie from weblet-parameter and return a clear-cookie
(define (remove-cookie param)
(define cookie (weblet-parameter-cookie-ref param *cookie-key*))
(and cookie (remove-cookie-by-value (string->bytes/utf-8 cookie)))
(clear-cookie-header
*cookie-key*
#:domain (weblet-parameter-host param)
#:path "/"))
; Remove all expired cookies
(define (remove-expired-cookies)
(within-transaction (class-repository usercookie)
@ -177,3 +202,8 @@
(#t
; Cookie does not exists => user not found
#f))))
; Get user from weblet parameter
(define (get-user-from-weblet-parameter param)
(define cookie (weblet-parameter-cookie-ref param *cookie-key*))
(and cookie (get-user-by-cookie (string->bytes/utf-8 cookie))))

110
src/pages/notepad.rkt
View File

@ -8,6 +8,9 @@
(prefix-in scrib: scribble/reader)
"../notepad/user.rkt"
"../notepad/stored-objects.rkt"
web-server/http/redirect
web-server/http/cookie
web-server/http/request-structs
)
(provide
@ -15,6 +18,8 @@
pages:notepad:page-show
pages:notepad:user-list
pages:notepad:user-show
pages:notepad:user-login
pages:notepad:user-logout
)
; Notepad directory
@ -24,6 +29,13 @@
; Create / open database
(define notepad-repo (open-repository 'sqlite3 notepad-repo-path))
(user-init-repository notepad-repo)
; Dev mode
(define dev? #t)
; Secured : either protocol is https or dev mode is active
(define (check-secured? param)
(or dev?
(eq? 'https (weblet-parameter-protocol param))))
; Page not found
(define (not-found)
@ -34,6 +46,15 @@
(content . (article "Sorry, there is nothing here."))
)))
; Unallowed method (as page)
(define pages:notepad:method-not-allowed
(pages:template
#:error-code 405
#:author "405"
#:title "Not allowed"
#:content '(article "Sorry, this method is not allowed.")
))
; Notepad pages
; /notes/list
; Lists all the pages of the notepad.
@ -195,6 +216,8 @@
(pages:adaptable-template
(lambda (param)
(define usr (get-user-by-name (weblet-parameter-ref param 'name #f)))
(define connected-usr (get-user-from-weblet-parameter param))
(define protocol (weblet-parameter-protocol param))
(cond
(usr
(make-immutable-hash
@ -204,9 +227,15 @@
(hr)
,(user-about usr)
(hr)
(p
(a ((href ,(string-append "/user/login/" (user-name usr))))
"Se connecter en tant que " ,(user-pseudo usr)))
,(cond
( (and (or (eq? protocol 'https) dev?) (not connected-usr))
`(p (a ((href ,(string-append "/user/login/" (user-name usr))))
"Se connecter en tant que " ,(user-pseudo usr))))
( (and (or (eq? protocol 'https) dev?) connected-usr)
`(p (a ((href ,(string-append "/user/logout")))
"Se déconnecter")))
( #t
""))
)))))
(#t
(not-found))))))
@ -215,9 +244,84 @@
; Login page for user xxx.
; Method GET -> show the page, with a form if user is not logged in. Show an error and a link to the logout page if user is already logged in.
; Method POST -> redirect to the page in case of failure, redirect to user-show in case of success
(define (pages:notepad:user-login param)
; Because of the behaviour, we cannot directly use a template
(define usr (get-user-from-weblet-parameter param))
(define method (weblet-parameter-method param))
(define secured? (check-secured? param))
(cond
( (and secured? usr (eq? method 'get))
(pages:notepad:user-login:already-connected usr param))
( (and secured? (eq? method 'get))
(pages:notepad:user-login:login-form param))
( (and secured? (eq? method 'post))
(pages:notepad:user-login:sent-form param))
( (eq? method 'get)
; redirect to https
(redirect-to-https-weblet param))
(#t
(pages:notepad:method-not-allowed param))))
; Already connected
(define (pages:notepad:user-login:already-connected usr param)
((pages:template
#:title "Déjà connecté."
#:author (user-name usr)
#:content
`(article
"Déjà connecté en tant que " ,(user-name usr) ". " (br)
(a ((href "/user/logout")) "Se déconnecter")))
param))
; login form
(define pages:notepad:user-login:login-form
(pages:adaptable-template
(lambda (param)
(define usr (get-user-by-name (weblet-parameter-ref param 'name #f)))
(define incorrect (weblet-parameter-ref param 'incorrect))
(cond
(usr
(make-immutable-hash
`((author . ,(user-name usr))
(title . "Connexion")
(content . (article
,(if (equal? incorrect "t")
"Vous n'avez pas dit le mot magique."
"")
(form ((action ,(string-append "/user/login/" (user-name usr)))(method "post"))
(label ((for "pass")) "Mot de passe") " "
(input ((id "pass")(name "pass")(type "password")(required "true"))) (br)
(input ((type "submit")(value "Se connecter")))
)
)))))
(#t
(not-found))))))
; Process login
(define (pages:notepad:user-login:sent-form param)
(define usr (get-user-by-name (weblet-parameter-ref param 'name #f)))
(define pass (weblet-parameter-ref param 'pass #f))
(cond
( (user-check-password usr pass)
; Password OK, set cookie and redirect to /user/show/xxx
(redirect-to
(string-append "/user/show/" (user-name usr))
see-other
#:headers (list (make-header #"Set-Cookie" (new-cookie usr (weblet-parameter-host param) dev?)))
))
( usr
; KO, redirect to /user/login/xxx?incorrect=t
(redirect-to
(string-append "/user/login/" (user-name usr) "?incorrect=t")
see-other))
(#t
((pages:adaptable-template (not-found)) param))))
; /user/edit/xxx
; Edit page for the user xxx. Must be logged in as user xxx.
; /user/logout
; Logout page.
(define (pages:notepad:user-logout param)
(redirect-to
"/user/list"
see-other
#:headers (list (make-header #"Set-Cookie" (remove-cookie param)))
))