Add user-add! and channel-user-add!

chatdir.scm

@@ -101,9 +101,39 @@
 	(channel-cleanup! root channel)))
 
 
-;; Creates a user's info files in the given channel, if need bee
-(define (make-user conn channel hostmask)
-  (create-directory (user-directory-path conn channel hostmask) #t))
+;; Create a global user's directory.
+(define (user-add! root username)
+  (create-directory (subpath root ".users" username) #t))
+
+
+;; Add a user to a channel, creating their channel's directory.
+;; There are three types of channel users:
+;; * Channel-only: We have no meaningful way of ever linking this user to a server-wide identity.
+;;                 (global? #f) (global-pairity #f)
+;; * Serverwide-1: The user has a server-wide identity, and data like nicknames/profile-pictures
+;;                 can NOT be changed on a per-channel basis.
+;;                 (global #t) (global-pairity #t)
+;; * Serverwide-2: The user has a server-wide identity, but their nickname/profile-picture/etc
+;;                 can vary by the channel.
+;;                 (global #t) (global-pairity #f)
+(define (channel-user-add! root channel username
+						   #!optional (global? #t) (global-pairity? #t) (global-name #f))
+  (let* ([g-name (if global-name global-name username)]
+		 [user-path (subpath root channel ".users" "all" username)]
+		 [g-user-path (subpath root ".users" g-name)])
+	(if (not (or (file-exists? user-path) (directory-exists? user-path)))
+		(cond [(and global? global-pairity?)
+			   (user-add! root g-name)
+			   (create-symbolic-link (subpath "../../../.users" g-name) user-path)
+			   (create-symbolic-link "./" ;;g-user-path
+									(subpath user-path "global"))]
+			  [global?
+			   (user-add! root g-name)
+			   (create-directory user-path #t)
+			   (create-symbolic-link (subpath "../../../../.users" g-name)
+									 (subpath user-path "global"))]
+			  [#t
+			   (create-directory user-path #t)]))))
 
 
 ;; Disables a user-state (that is, removes a symlink from a .users directory

tests/tests.scm

@@ -95,7 +95,8 @@
 ;; ——————————————————————————————————————————————————
 (define *new-room* "living room")
 (define *new-room-path* (subpath *dir* *new-room*))
-(define *new-room-all* (subpath *new-room-path* ".users" "all"))
+(define *new-room-users* (subpath *new-room-path* ".users"))
+(define *new-room-all* (subpath *new-room-users* "all"))
 (if (directory-exists? *new-room-path*)
 	(delete-directory (subpath *dir* *new-room*) #t))
 (channel-add! *dir* *new-room*)
@@ -120,5 +121,54 @@
 
 
 
+;; ——————————————————————————————————————————————————
+;; User management
+;; ——————————————————————————————————————————————————
+(define *users-dir* (subpath *dir* ".users"))
+(if (directory-exists? *users-dir*)
+	(delete-directory *users-dir* #t))
+(if (directory-exists? *new-room-users*)
+	(delete-directory *new-room-users* #t))
+
+;; Create a global user-directory.
+(user-add! *dir* "birdo")
+(check (string? (directory-exists? (subpath *dir* ".users" "birdo")))
+	   =>
+	   #t)
+
+
+;; Check a room-only account; it has no global directory.
+(channel-user-add! *dir* *new-room* "mondo" #f #f)
+(check (and (not (directory-exists? (subpath *users-dir* "mondo")))
+			(not (symbolic-link? (subpath *new-room-all* "mondo")))
+			(string? (directory-exists? (subpath *new-room-all* "mondo"))))
+	   =>
+	   #t)
+
+
+;; Check a room user-directory, that matches up one-to-one with a
+;; global user-directory. Pairity: That is, the channel user
+;; directory is just a link from the global user directory.
+;; /.users/birdo → /living room/.users/birdo
+(channel-user-add! *dir* *new-room* "birdo" #t #t)
+(check (symbolic-link? (subpath *new-room-all* "birdo"))
+	   =>
+	   #t)
+
+
+;; Check a room user-directory with corresponding global user-directory,
+;; but without the above link/pairity.
+(channel-user-add! *dir* *new-room* "mawa" #t #f)
+(print (subpath *users-dir* "mawa"))
+(check (and (not (symbolic-link? (subpath *new-room-all* "mawa")))
+			(symbolic-link? (subpath *new-room-all* "mawa" "global"))
+			(directory-exists? (subpath *new-room-all* "mawa"))
+			(string? (directory-exists? (subpath *users-dir* "mawa")))
+			)
+	   =>
+	   #t)
+
+
+
 ;; ——————————————————————————————————————————————————
 (check-report)