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

Rework the cookie management to remove dependencies on weblet-parameters in notepad management, and to remove dependencies on stored-objects in notepad pages.

This commit is contained in:
Feufochmar 2021-05-14 17:21:45 +02:00
parent ae6c9b553e
commit 69e1ed968f
3 changed files with 74 additions and 79 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/notepad/notepad.rkt
View File

@ -42,18 +42,16 @@
(struct notepad
(directory ; notepad directory
repository ; repository for stored objects
dev? ; development mode, to disable security features requiring https
))
; Create/open a notepad
(define (make-notepad dir #:dev? [dev? #f])
(define (make-notepad dir)
(define repo-path (string-append dir "/notepad.db"))
(define repo (open-repository 'sqlite3 repo-path))
(user-init-repository repo)
(notepad
dir
repo
dev?))
repo))
; Note directory
(define (notepad-notes-dir np)

71
src/notepad/user.rkt
View File

@ -7,17 +7,17 @@
"stored-objects.rkt"
file/sha1
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 user-check-password
new-cookie update-cookie remove-cookie remove-expired-cookies
get-user-from-weblet-parameter
same-user?
new-usercookie update-usercookie-by-value remove-usercookie-by-value remove-expired-usercookies
usercookie-value usercookie-expires
get-user-by-usercookie-value
)
; User definition
@ -104,18 +104,25 @@
(equal? (hash-password (user-name usr) password)
(user-hashpw usr))))
; Same user?
(define (same-user? usr1 usr2)
(and
usr1 usr2
(eq? (instance-identifier usr1)
(instance-identifier usr2))))
; 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 (new-usercookie usr)
(define value (base64-encode (crypto-random-bytes 128) #""))
; TODO: race condition ?
(cond
((get-cookie-by-value value)
((get-usercookie-by-value value)
; A cookie with the same value already exist: try again
(new-cookie usr domain dev?))
(new-usercookie usr))
(#t
; Create the cookie
(define expires (new-cookie-expiration-date))
@ -125,60 +132,35 @@
(set-usercookie-expires! instance expires)
(set-usercookie-user! instance (instance-identifier usr))
(save-instance instance)
(cookie->set-cookie-header
(make-cookie
*cookie-key*
value
#:expires (seconds->date expires)
#:domain domain
#:path "/"
#:secure? (not dev?)
#:http-only? #t))))))
instance))))
; Get cookie by value
(define (get-cookie-by-value value)
(define (get-usercookie-by-value value)
(define instances (find-instances usercookie `((value . ,value))))
(and (not (null? instances)) (car instances)))
; Update the expiration date of a cookie and return the cookie
(define (update-cookie value domain [dev? #f])
(define (update-usercookie-by-value value)
(within-transaction (class-repository usercookie)
(define cookie (get-cookie-by-value value))
(define cookie (get-usercookie-by-value value))
(cond
(cookie
(define expires (new-cookie-expiration-date))
(set-usercookie-expires! cookie expires)
(save-instance cookie)
(cookie->set-cookie-header
(make-cookie
*cookie-key*
value
#:expires (seconds->date expires)
#:domain domain
#:path "/"
#:secure? (not dev?)
#:http-only? #t)))
cookie)
(#t
#f))))
; Remove a cookie from its value
(define (remove-cookie-by-value value)
(define (remove-usercookie-by-value value)
(within-transaction (class-repository usercookie)
(define cookie (get-cookie-by-value value))
(define cookie (get-usercookie-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)
(define (remove-expired-usercookies)
(within-transaction (class-repository usercookie)
(for-each
delete-instance
@ -188,9 +170,9 @@
(list-instances usercookie)))))
; Get user by cookie
(define (get-user-by-cookie value)
(define (get-user-by-usercookie-value value)
(within-transaction (class-repository usercookie)
(define cookie (get-cookie-by-value value))
(define cookie (get-usercookie-by-value value))
(cond
((and cookie (not (< (usercookie-expires cookie) (current-seconds))))
; Cookie exists and has not expired => return associated user
@ -202,8 +184,3 @@
(#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))))

76
src/pages/notepad.rkt
View File

@ -7,12 +7,9 @@
"../webcontainer/weblet-parameter.rkt"
"../notepad/notepad.rkt"
"../notepad/user.rkt"
"../notepad/stored-objects.rkt"
web-server/http/redirect
web-server/http/cookie
web-server/http/request-structs
racket/port
racket/string
net/cookies/server
)
(provide
@ -37,7 +34,16 @@
; Dev mode
(define dev? #t)
; Notepad
(define notepad (make-notepad notepad-dir #:dev? dev?))
(define notepad (make-notepad notepad-dir))
; Cookie management
; Cookie key
(define *cookie-key* "notepad")
; User from weblet parameter
(define (get-user param)
(define cookie (weblet-parameter-cookie-ref param *cookie-key*))
(and cookie (get-user-by-usercookie-value (string->bytes/utf-8 cookie))))
; Secured : either protocol is https or dev mode is active
(define (check-secured? param)
@ -81,7 +87,7 @@
#:author "feuforeve.fr"
#:content
(lambda (param)
(define connected-usr (get-user-from-weblet-parameter param))
(define connected-usr (get-user param))
(define secured? (check-secured? param))
(define can-edit? (and connected-usr secured?))
(define notes (notepad-list-notes notepad))
@ -103,7 +109,7 @@
; Show a given page of the notepad. A page is stored under a scribble-like format.
; If the page does not exists and user is logged in, redirect to the /notes/edit/xxx page.
(define (pages:notepad:page-show param)
(define connected-usr (get-user-from-weblet-parameter param))
(define connected-usr (get-user param))
(define secured? (check-secured? param))
(define can-edit? (and connected-usr secured?))
(define page (weblet-parameter-ref param 'page #f))
@ -136,7 +142,7 @@
; Get => Form to edit page
; Post => Save page
(define (pages:notepad:page-edit param)
(define connected-usr (get-user-from-weblet-parameter param))
(define connected-usr (get-user param))
(define secured? (check-secured? param))
(define method (weblet-parameter-method param))
(define page (weblet-parameter-ref param 'page #f))
@ -189,7 +195,7 @@
; Get => ask confirmation
; Post => remove
(define (pages:notepad:page-delete param)
(define connected-usr (get-user-from-weblet-parameter param))
(define connected-usr (get-user param))
(define secured? (check-secured? param))
(define method (weblet-parameter-method param))
(define page (weblet-parameter-ref param 'page #f))
@ -234,7 +240,7 @@
#:author "feuforeve.fr"
#:content
(lambda (param)
(define connected-usr (get-user-from-weblet-parameter param))
(define connected-usr (get-user param))
(define secured? (check-secured? param))
(define can-edit? (and connected-usr secured?))
(define files (notepad-list-media notepad))
@ -255,7 +261,7 @@
; /media/show/xxx
; Show a given media of the notepad.
(define (pages:notepad:media-show param)
(define connected-usr (get-user-from-weblet-parameter param))
(define connected-usr (get-user param))
(define secured? (check-secured? param))
(define can-edit? (and connected-usr secured?))
(define media (weblet-parameter-ref param 'media #f))
@ -292,7 +298,7 @@
; Get => Form to add a media
; Post => Process the upload, and show the media
(define (pages:notepad:media-new param)
(define connected-usr (get-user-from-weblet-parameter param))
(define connected-usr (get-user param))
(define secured? (check-secured? param))
(define method (weblet-parameter-method param))
(define failed? (equal? "t" (weblet-parameter-ref param 'error #f)))
@ -342,7 +348,7 @@
; Get => Form to edit a media
; Post => Process the upload, and show the media
(define (pages:notepad:media-edit param)
(define connected-usr (get-user-from-weblet-parameter param))
(define connected-usr (get-user param))
(define secured? (check-secured? param))
(define method (weblet-parameter-method param))
(define media (weblet-parameter-ref param 'media #f))
@ -374,7 +380,7 @@
( (and filename (not (equal? filename "")) (not (equal? filename media)))
; Move file
(notepad-move-media notepad media filename)
; Redirect
; Redirectuser-check-password
(redirect-to
(string-append "/media/show/" filename)
see-other))
@ -396,7 +402,7 @@
; Get => ask confirmation
; Post => remove
(define (pages:notepad:media-delete param)
(define connected-usr (get-user-from-weblet-parameter param))
(define connected-usr (get-user param))
(define secured? (check-secured? param))
(define method (weblet-parameter-method param))
(define media (weblet-parameter-ref param 'media #f))
@ -456,11 +462,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 edition-possible?
(and usr connected-usr
(eq? (instance-identifier usr)
(instance-identifier connected-usr))))
(define connected-usr (get-user param))
(define edition-possible? (same-user? usr connected-usr))
(define secured? (check-secured? param))
(cond
(usr
@ -502,7 +505,7 @@
; 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 usr (get-user param))
(define method (weblet-parameter-method param))
(define secured? (check-secured? param))
(cond
@ -558,10 +561,22 @@
(cond
( (user-check-password usr pass)
; Password OK, set cookie and redirect to /user/show/xxx
(define usercookie (new-usercookie usr))
(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?)))
#:headers (list
(make-header
#"Set-Cookie"
(cookie->set-cookie-header
(make-cookie
*cookie-key*
(usercookie-value usercookie)
#:expires (seconds->date (usercookie-expires usercookie))
#:domain (weblet-parameter-host param)
#:path "/"
#:secure? (not dev?)
#:http-only? #t))))
))
( usr
; KO, redirect to /user/login/xxx?incorrect=t
@ -576,11 +591,8 @@
; Post only, as it is used to update the /user/show/xxx
(define (pages:notepad:user-edit param)
(define usr (get-user-by-name (weblet-parameter-ref param 'name #f)))
(define connected-usr (get-user-from-weblet-parameter param))
(define edition-possible?
(and usr connected-usr
(eq? (instance-identifier usr)
(instance-identifier connected-usr))))
(define connected-usr (get-user param))
(define edition-possible? (same-user? usr connected-usr))
(define secured? (check-secured? param))
(define method (weblet-parameter-method param))
(cond
@ -599,8 +611,16 @@
; /user/logout
; Logout page.
(define (pages:notepad:user-logout param)
(define cookie (weblet-parameter-cookie-ref param *cookie-key*))
(and cookie (remove-usercookie-by-value (string->bytes/utf-8 cookie)))
(redirect-to
"/user/list"
see-other
#:headers (list (make-header #"Set-Cookie" (remove-cookie param)))
#:headers (list
(make-header
#"Set-Cookie"
(clear-cookie-header
*cookie-key*
#:domain (weblet-parameter-host param)
#:path "/")))
))