jadedctrl/ chicken-chatdir
Archived
1
0
Disbranĉigi 0
Fontkodo Issues Tirpetoj Activity

Add global-user 'local' directory, with symlinks to joined channels

This commit is contained in:
Jaidyn Ann 2023-05-20 08:34:15 -05:00
parent aa4379eda4
commit 84ca2a0113
2 changed files with 22 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
chatdir.scm
View File

@ -79,7 +79,7 @@
;; Create a user's server-wide global-user directory. ;; Create a user's server-wide global-user directory.
;; Quite simple, compared to channel-user-add! ;; Quite simple, compared to channel-user-add!
(define (user-add! root username) (define (user-add! root username)
(create-directory (subpath root ".users" username) #t)) (create-directory (subpath root ".users" username "local") #t))
;; Add a user to a channel, creating their channel-user directory. ;; Add a user to a channel, creating their channel-user directory.
@ -97,25 +97,21 @@
(let* ([g-name (if global-name global-name username)] (let* ([g-name (if global-name global-name username)]
[user-path (subpath root channel ".users" "all" username)] [user-path (subpath root channel ".users" "all" username)]
[g-user-path (subpath root ".users" g-name)]) [g-user-path (subpath root ".users" g-name)])
(if (not (or (file-exists? user-path) (directory-exists? user-path))) (cond [(or (file-exists? user-path) (directory-exists? user-path))
(cond #f]
;; global+global-pairity means that we make a symlink between the global-user and ;; If global, we gotta do some symlink dancing.
;; channel-user; as such the “global” symlink's path is `./`. [global?
[(and global? global-pairity?) (user-add! root g-name)
(user-add! root g-name) (if global-pairity?
(create-symbolic-link (subpath "../../../.users" g-name) user-path) (create-symbolic-link (subpath "../../../.users" g-name) user-path)
(create-symbolic-link "./" ;;g-user-path (create-directory user-path #t))
(subpath user-path "global"))] (create-symbolic-link (subpath "../../../../.users" g-name)
;; Make a channel-user directory and a global-user directory, and link “global” (subpath user-path "global"))
;; property. (create-symbolic-link (subpath "../../../" channel ".users" "all" username)
[global? (subpath g-user-path "local" channel))]
(user-add! root g-name)
(create-directory user-path #t)
(create-symbolic-link (subpath "../../../../.users" g-name)
(subpath user-path "global"))]
;; This is a channel-only user, don't bother with symlink fanciness. ;; This is a channel-only user, don't bother with symlink fanciness.
[#t [#t
(create-directory user-path #t)])))) (create-directory user-path #t)])))
;; Sets a file in the user's directory to given value. ;; Sets a file in the user's directory to given value.

10
tests/tests.scm
View File

@ -159,9 +159,15 @@
;; /.users/birdo → /living room/.users/birdo ;; /.users/birdo → /living room/.users/birdo
(channel-user-add! *dir* *new-room* "birdo" #t #t) (channel-user-add! *dir* *new-room* "birdo" #t #t)
(channel-user-file-set! *dir* *new-room* "birdo" "nick" "rose") (channel-user-file-set! *dir* *new-room* "birdo" "nick" "rose")
(check (symbolic-link? (subpath *new-room-all* "birdo")) (check (read-symbolic-link (subpath *new-room-all* "birdo"))
=> =>
#t) "../../../.users/birdo")
(check (read-symbolic-link (subpath *new-room-all* "birdo" "global"))
=>
"../../../../.users/birdo")
(check (read-symbolic-link (subpath *users-dir* "birdo" "local" *new-room*))
=>
(subpath "../../../" *new-room* ".users" "all" "birdo"))
(check (user-file-get *dir* "birdo" "nick") (check (user-file-get *dir* "birdo" "nick")
=> =>
"rose") "rose")