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

Add media pages for the notepad.

This commit is contained in:
Feufochmar 2021-05-11 18:23:20 +02:00
parent 5b3c80d2bc
commit 8a933e55b9
2 changed files with 180 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
main.rkt
View File

@ -84,6 +84,12 @@
("edit/{page}" matching-weblet pages:notepad:page-edit)
("delete/{page}" matching-weblet pages:notepad:page-delete)
)
("media" symlink "/media/list"
("list" weblet pages:notepad:media-list)
("show/{media}" matching-weblet pages:notepad:media-show)
("new" weblet pages:notepad:media-new)
("delete/{media}" matching-weblet pages:notepad:media-delete)
)
("user" symlink "/user/list"
("list" weblet pages:notepad:user-list)
("show/{name}" matching-weblet pages:notepad:user-show)
@ -126,17 +132,27 @@
("Vraie citation" "/ArnYtron3000/vraie" #t)
("À propos d'ArnYtron3000" "/ArnYtron3000/About" #t)
)
("Bloc-Note" "/notes/list" #t
("Notes" "/notes/list" #t
(#f "/notes/show" #f)
(#f "/notes/edit" #f)
(#f "/notes/delete" #f)
("Fichiers" "/media/list" #t)
(#f "/media/show" #f)
(#f "/media/new" #f)
(#f "/media/edit" #f)
(#f "/media/delete" #f)
("Utilisateurs" "/user/list" #t)
(#f "/user/show" #f)
(#f "/user/login" #f)
)
)
; Webcontainer
(define *webcontainer* (make-webcontainer))
(define *webcontainer*
(make-webcontainer
#:static
(make-immutable-hash
'(("" . "./static")
("/media/get" . "./notepad/media")))))
(webcontainer-add-website! *webcontainer* *website*)
(webcontainer-set-404-weblet! *webcontainer* pages:not-found)
(display "Starting server...")(newline)

170
src/pages/notepad.rkt
View File

@ -12,6 +12,7 @@
web-server/http/cookie
web-server/http/request-structs
racket/port
racket/string
)
(provide
@ -19,6 +20,10 @@
pages:notepad:page-show
pages:notepad:page-edit
pages:notepad:page-delete
pages:notepad:media-list
pages:notepad:media-show
pages:notepad:media-new
pages:notepad:media-delete
pages:notepad:user-list
pages:notepad:user-show
pages:notepad:user-login
@ -29,7 +34,11 @@
; Notepad directory
(define notepad-dir "notepad")
; Database path
(define notepad-repo-path "notepad.db")
(define notepad-repo-path (string-append notepad-dir "/notepad.db"))
; Notes directory
(define notes-dir (string-append notepad-dir "/notes"))
; Media directory
(define media-dir (string-append notepad-dir "/media"))
; Create / open database
(define notepad-repo (open-repository 'sqlite3 notepad-repo-path))
(user-init-repository notepad-repo)
@ -81,7 +90,7 @@
(define connected-usr (get-user-from-weblet-parameter param))
(define secured? (check-secured? param))
(define can-edit? (and connected-usr secured?))
(define notes (map path->string (directory-list notepad-dir)))
(define notes (map path->string (directory-list notes-dir)))
`(article
,@(if (null? notes)
'("Pas de notes.")
@ -91,7 +100,7 @@
notes))
,@(if can-edit?
'((hr)
(a ((href "/notes/edit")) "Nouvelle note"))
(a ((href "/notes/edit")) "Ajouter une note"))
'(""))
))
))
@ -104,7 +113,7 @@
(define secured? (check-secured? param))
(define can-edit? (and connected-usr secured?))
(define page (weblet-parameter-ref param 'page #f))
(define file (and page (string-append notepad-dir "/" page)))
(define file (and page (string-append notes-dir "/" page)))
(define has-page? (file-exists? file))
(cond
(has-page?
@ -217,7 +226,7 @@
(define secured? (check-secured? param))
(define method (weblet-parameter-method param))
(define page (weblet-parameter-ref param 'page #f))
(define file (and page (string-append notepad-dir "/" page)))
(define file (and page (string-append notes-dir "/" page)))
(define has-page? (and file (file-exists? file)))
(cond
( (and connected-usr secured? (eq? method 'get))
@ -249,7 +258,7 @@
(define new-page-content (weblet-parameter-ref param 'pagecontent #f))
(define new-page-name (or (and (not (equal? "" page-name)) page-name)
page))
(define new-file (string-append notepad-dir "/" new-page-name))
(define new-file (string-append notes-dir "/" new-page-name))
; Save page to file
(call-with-output-file
new-file
@ -279,7 +288,7 @@
(define secured? (check-secured? param))
(define method (weblet-parameter-method param))
(define page (weblet-parameter-ref param 'page #f))
(define file (and page (string-append notepad-dir "/" page)))
(define file (and page (string-append notes-dir "/" page)))
(define has-page? (file-exists? file))
(cond
( (and has-page? connected-usr secured? (eq? method 'get))
@ -314,18 +323,163 @@
; /media/list
; Lists all medias of the notepad.
(define pages:notepad:media-list
(pages:template
#:title "Fichiers du bloc-note."
#:author "feuforeve.fr"
#:content
(lambda (param)
(define connected-usr (get-user-from-weblet-parameter param))
(define secured? (check-secured? param))
(define can-edit? (and connected-usr secured?))
(define files (map path->string (directory-list media-dir)))
`(article
,@(if (null? files)
'("Pas de fichiers.")
(map
(lambda (x)
`(div (a ((href ,(string-append "/media/show/" x))) ,x)))
files))
,@(if can-edit?
'((hr)
(a ((href "/media/new")) "Ajouter un fichier"))
'(""))
))
))
; /media/show/xxx
; Show a given media of the notepad, with its metadata.
; Show a given media of the notepad.
(define (pages:notepad:media-show param)
(define connected-usr (get-user-from-weblet-parameter param))
(define secured? (check-secured? param))
(define can-edit? (and connected-usr secured?))
(define media (weblet-parameter-ref param 'media #f))
(define file (and media (string-append media-dir "/" media)))
(define has-media? (file-exists? file))
(define image? (ormap (lambda (x) (string-suffix? media x)) '(".png" ".jpg" ".gif" ".jpeg" ".svg")))
(define direct-link (string-append "/media/get/" media))
(cond
(has-media?
( (pages:template
#:title (string-append "Fichier: " media)
#:author "feuforeve.fr"
#:content
`(article
,@(if image?
`((img ((src ,direct-link)))(br))
'())
(a ((href ,direct-link)) "Lien vers le fichier")
,@(if can-edit?
`((hr)
(a ((href ,(string-append "/media/edit/" media))) "Éditer") " — "
(a ((href ,(string-append "/media/delete/" media))) "Supprimer"))
'())
))
param))
( #t
(pages:notepad:error param 'not-found))))
; /media/get/xxx
; Get a given media of the notepad. Direct link.
; Managed at the webcontainer level.
; /media/new
; Add a media. User must be logged in.
; 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 secured? (check-secured? param))
(define method (weblet-parameter-method param))
(cond
( (and connected-usr secured? (eq? method 'get))
; User connected, get method : new media form
( (pages:template
#:title "Ajouter un fichier"
#:author (user-name connected-usr)
#:content
; Display the page as a form
`(article
(form ((action ,(string-append "/media/new"))
(method "post")
(enctype "multipart/form-data"))
(label ((for "filename")) "Fichier à ajouter") (br)
(input ((id "filename")(name "filename")(type "file"))) (br)
(input ((type "submit")
(value "Ajouter le fichier")))
)))
param))
( (and connected-usr secured? (eq? method 'post))
(define filename (weblet-parameter-ref param 'filename #f))
(define in (and filename (weblet-parameter-file-port-ref param 'filename)))
(define filepath (and filename in (string-append media-dir "/" filename)))
; Save file
(cond
( filepath
(call-with-output-file
filepath
(lambda (out)
(copy-port in out)
(close-input-port in))
#:exists 'truncate/replace)
; Redirect
(redirect-to
(string-append "/media/show/" filename)
see-other))
( #t
; Redirect: upload failed
(redirect-to
(string-append "/media/new")
see-other))))
( #t
; Not allowed
(pages:notepad:error param 'unauthorized))))
; /media/edit/xxx
; Edit a media (move it). User must be logged in.
; TODO
; /media/delete/xxx
; Remove an existing media. User must be logged in.
; Get => ask confirmation
; Post => remove
(define (pages:notepad:media-delete param)
(define connected-usr (get-user-from-weblet-parameter param))
(define secured? (check-secured? param))
(define method (weblet-parameter-method param))
(define media (weblet-parameter-ref param 'media #f))
(define file (and media (string-append media-dir "/" media)))
(define has-media? (file-exists? file))
(cond
( (and has-media? connected-usr secured? (eq? method 'get))
; Method get => ask for confirmation
( (pages:template
#:title (string-append "Suppression du fichier " media)
#:author (user-name connected-usr)
#:content
`(article
(form ((action ,(string-append "/media/delete/" media))
(method "post"))
(h3 "Supprimer le fichier " ,media " ? ")
"Cette action est irréversible." (br)
(input ((type "submit")
(value "Oui, supprimer le fichier")))
(input ((type "submit")(formaction ,(string-append "/media/show/" media))
(formmethod "get")(value "Non, garder le fichier")))
)))
param))
( (and has-media? connected-usr secured? (eq? method 'post))
; Method post => remove
(delete-file file)
(redirect-to
"/media/list"
see-other))
( has-media?
; Unauthorized
(pages:notepad:error param 'unauthorized))
( #t
; No such page
(pages:notepad:error param 'not-found))))
; /user/list
; Lists all the users of the notepad.