Redo function for creating message-files

bin/README.md

@@ -1,26 +0,0 @@
-# utils
-
-Some simple scripts that can make irc-chatdir a friendly option for a client.
-
-## chatdir-in.sh
-Messages are sent, in chatdir, via .in/ directories under each channel's dir.
-The file can be named whatever, it just has to be a text-file, and it'll be
-sent. But `$ echo "Hi there!" > #general/.in/msg` is annoying.
-
-This is a wrapper around that. It will send whatever you type to the selected
-channel; selecting a channel is done by just typing a channel name verbatim.
-There is auto-completion for nicks and channel-names.
-
-You might run it like, `$ chatdir-in.sh ~/chat/libera.chat/`
-
-
-## irc_file_notify.sh
-Sends a pretty notification (with icon, sender, and message text!) whenever a
-message is sent. You might run like, `$ irc_file_notify.sh ~/chat/libera.chat/*`
-
-
-## proc_notify.sh
-Displays a warning notifcation when irc-chatdir dies.  
-You might run like, `$ proc_notify.sh irc-chatd.scm.*leagueh`
-
-

bin/chatdir-in.sh

@@ -1,113 +0,0 @@
-#!/bin/sh
-#―――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
-# Name: chatdir-in
-# Desc: A simple wrapper for sending messages in a chatdir, w autocomplete
-#       and all that sweet stuff.
-# Reqs: rwlrap, shell
-# Date: 2023-02-14
-# Lisc: CC0; jadedctrl <jadedctrl@posteo.at>
-#―――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
-
-# Create the auto-complete file used by rlwrap, containing users anc channel-names
-prep_auto_complete() {
-	local file="$1"
-
-	ls "$CHATDIR" \
-	   > "$file"
-
-	if test -n "$CHANNEL"; then
-		ls "$CHATDIR/$CHANNEL/.users/online/" \
-		   >> "$file"
-	fi
-}
-
-
-# Take in user-input with the oh-so-pretty rlwrap
-# seriously, <3<3,3 rlwrap I love you marry me
-# have my babies rlwrap! have my babies!
-# we'll live in a secluded cottage, with nary a
-# bad piece of code. it'll be a very sugary life,
-# my dearest rlwrap. just you and I in the world,
-# no-one else
-get_input() {
-	prep_auto_complete "$AUTO_COMPLETE_FILE"
-
-	rlwrap --one-shot \
-		   --substitute-prompt='» ' \
-		   --break-chars "$(printf '\n')" \
-		   --extra-char-after-completion='' \
-		   --file "$AUTO_COMPLETE_FILE" \
-		   cat
-}
-
-
-# Find out if the user is selecting a channel, or sending a message; act appropriately.
-parse_input() {
-	local input="$1"
-
-	if test -d "$CHATDIR/$input" -a -d "$CHATDIR/$input/.in/"; then
-		set_channel "$input"
-	elif test -n "$input"; then
-		send_message "$input"
-	fi
-}
-
-
-# Send a message to the selected channel, and echo it
-send_message() {
-	local message="$1"
-
-	if test -z "$CHANNEL"; then
-		echo "No channel set; type in its name verbatim, first."
-	else
-		echo "$message" \
-			 > "$CHATDIR/$CHANNEL/.in/input"
-		echo "$CHATDIR/$CHANNEL ← $message"
-	fi
-}
-
-
-# Set the selected channel, and brag about it
-set_channel() {
-	local channel="$1"
-
-	if test -d "$CHATDIR/$channel" -a -d "$CHATDIR/$channel/.in/"; then
-		CHANNEL="$channel"
-		echo "— $CHANNEL —"
-	fi
-}
-
-
-help() {
-	echo "usage: $(basename "$0") CHATD_DIR"
-	echo ""
-	echo "Chatdir daemons send plain-text files placed in .in/ directories as messages."
-	echo "This script is a wrapper around that: Just type in a message and hit ENTER"
-	echo "to send it to the currently selected channel. To select a channel, type in"
-	echo "a line solely containing the verbatim channel name."
-	echo "TAB-completion is supported, for both channel-names and for online users."
-	echo "rlwrap is used for input."
-	exit 2
-}
-
-
-if test ! -d "$1"; then
-	help
-fi
-
-echo "~~ $(basename $0) ~~"
-echo "No channel selected."
-echo "Select a channel by typing in its name verbatim!"
-
-CHATDIR="$1"
-CHANNEL=""
-AUTO_COMPLETE_FILE="$(mktemp --suffix=.chatd-in)"
-
-
-INPUT=""
-while INPUT="$(get_input)"; do
-	parse_input "$INPUT"
-done
-
-
-rm "$AUTO_COMPLETE_FILE"

bin/irc_file_notify.sh

@@ -1,60 +0,0 @@
-#!/bin/sh
-#―――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
-# Name: irc_file_notify
-# Desc: Watches a directory for any newly-created files, and then sends a
-#       notification!
-# Reqs: inotifywait, notify-send, shell
-# Date: 2022
-# Lisc: CC0; jadedctrl <jadedctrl@posteo.at>
-#―――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
-
-notification_title() {
-	local file="$1"
-	local sender="$(attr -qg chat.sender "$file")"
-	local channel="$(basename "$(dirname "$file")")"
-
-	echo "$sender [$channel]"
-}
-
-
-notification_message() {
-	local file="$1"
-	local message="$(head -1 "$file")"
-
-	echo "$message"
-}
-
-
-monitor_dirs() {
-	inotifywait --format "%w%f" \
-				--event MOVED_TO,CREATE \
-				$@
-}
-
-
-TARGET="$1"
-
-if test -z "$IRC_ICON"; then
-	# Set this variable, or you'll get my preferred icon. Suffer! c:<
-	IRC_ICON="$XDG_DATA_HOME/icons/retrosmart-icon-theme/scalable/chat.svg"
-fi
-
-
-if test -z "$TARGET"; then
-	echo "usage: $(basename "$0") CHAT_DIRECTORY"
-	echo ""
-	echo "Monitors a specific channel's directory for any new messages, sending"
-	echo "a notification when one is receieved."
-	exit 2
-fi
-
-
-while test 1 -eq 1; do
-	FILE="$(monitor_dirs $@)"
-	notify-send \
-		--app-name="$(basename "$0")" \
-		--icon "$IRC_ICON" \
-		"$(notification_title "$FILE")" \
-		"$(notification_message "$FILE")"
-
-done

bin/proc_notify.sh

@@ -1,45 +0,0 @@
-#!/bin/sh
-#―――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
-# Name: proc_notify
-# Desc: Bad script that checks over and over and over if a program is running,
-#       by greping `ps ax` w the passed arg. If the program isn't running,
-#       send an URGENT notification, telling the user.
-# Reqs: notify-send, shell
-# Date: 2023
-# Lisc: CC0; jadedctrl <jadedctrl@posteo.at>
-#―――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
-
-watch_loop() {
-	local program="$1"
-	local us="$2"
-	local last_id="$3"
-	if test -z "$last_id"; then
-		last_id=13375
-	fi
-
-	if test -z "$(ps ax | grep "$program" | grep -ve "grep" -e "$us")"; then
-		notify-send --replace-id="$last_id" \
-					--print-id \
-					--urgency=critical \
-					"$program not running!"
-	fi
-	sleep 30
-}
-
-
-PROGRAM="$1"
-LAST_ID=13375
-
-if test -z "$PROGRAM"; then
-	echo "usage: $(basename "$0") REGEX"
-	echo ""
-	echo "Monitors output of `ps ax` for the expect program, defined by regex."
-	echo "If said program isn't found, then an URGENT notification will be sent."
-	exit 2
-fi
-
-while test "life" = "life"; do
-	id="$(watch_loop "$PROGRAM" "$0" "$LAST_ID")"
-	last_id="$id"
-	echo "$last_id"
-done

chatdir.scm

@@ -131,21 +131,6 @@
   (user-enable-state conn channel hostmask enabled-state))
 
 
-
-
-
-;; Create a message file; putting metadata in xattrs, and text directly in the file
-(define (make-message-file conn channel sender message)
-  (if (and message (string? message) channel (string? channel))
-	  (let ([file (message-file-path conn channel)])
-		(call-with-output-file file
-		  (lambda (out-port) (write-string message #f out-port)))
-		(set-xattr file "user.chat.sender" sender)
-		(set-xattr file "user.chat.date" (date->string (current-date) "~1T~2"))
-		(set-xattr file "user.chat.channel" channel)
-		(set-xattr file "user.chat.mime" "text/plain"))))
-
-
 ;; Sets a channel's .topic file
 (define (set-channel-topic conn channel topic #!optional (username #f) (date #f))
   (let ([topic-path (string-append (channel-directory-path conn channel)
@@ -250,19 +235,20 @@
 
 (define (directory-file-set! directory key value #!optional (xattr-alist '()))
   (let ([path (subpath directory key)])
-	;; Write the xattrs (if applicable)
-	(map (lambda (xattr-cons)
-		   (set-xattr path (symbol->string (car xattr-cons))
-					  (cdr xattr-cons)))
-		 xattr-alist)
-
 	;; Write the contents (value)
 	(cond [(string? value)
 		   (write-string-to-file path value)]
 		  [(input-port? value)
 		   (write-port-to-file path value)]
 		  [(list? value)
-		   (write-byte-list-to-file path value)])))
+		   (write-byte-list-to-file path value)])
+
+	;; Write the xattrs (if applicable)
+	(map (lambda (xattr-cons)
+		   (set-xattr path (symbol->string (car xattr-cons))
+					  (cdr xattr-cons)))
+		 xattr-alist)))
+
 
 
 (define (directory-file-get directory key)
@@ -307,19 +293,43 @@
 				 "" children)))
 
 
-;; Returns the appropriate, non-colliding file path of a hypothetical message
+;; Given a directory and a filename, return a unique filename by appending
-(define (message-file-path parent date #!optional (suffix ""))
+;; a number to the end of the name, as necessary.
-  (let ([path
+(define (directory-unique-file directory name #!optional (suffix ""))
-		 (string-append (channel-directory-path conn channel)
+  (let* ([leaf
-						(date->string (current-date) "[~m-~d] ~H:~M:~S")
+		  (string-append name suffix)]
-						suffix)])
+		 [path
+		  (subpath directory leaf)])
 	(if (file-exists? path)
-		(message-file-path conn channel
+		(directory-unique-file
-						   (number->string (+ (or (string->number suffix) 0) .1)))
+		 directory
-		path)))
+		 leaf
+		 (number->string (+ (or (string->number suffix) 0)
+							.1)))
+		leaf)))
 
-(define (channel-add-message root channel contents #!optional (sender #f) (date #f))
+
-  (directory-file-set! (message-file-path (subpath root channel))))
+;; Finds an appropriate (non-colliding, non-in-use) name for a message file,
+;; based on its date.
+(define (message-file-leaf root channel date)
+  (directory-unique-file (subpath root channel)
+						(date->string date "[~m-~d] ~H:~M:~S")))
+
+
+;; Create a message file for the given channel, contents, sender, etc.
+(define (channel-message-add! root channel contents
+							  #!optional (sender #f) (date (current-date))
+							  (additional-xattrs '()))
+  (let* ([attrs-sans-sender (append
+							 `((user.chat.date . ,(date->string date "~1T~2"))
+							   (user.chat.channel . ,channel))
+							 additional-xattrs)]
+		 [attrs (if sender
+					(append attrs-sans-sender `((user.chat.sender . ,sender)))
+					attrs-sans-sender)])
+	(directory-file-set! (subpath root channel)
+						 (message-file-leaf root channel date)
+						 contents attrs)))
 
 
 ;; Initialization for the input loop
@@ -418,3 +428,4 @@
 	   (next-events!))
 
   (input-loop root-dir callbacks-alist))
+

tests/tests.scm

@@ -0,0 +1,87 @@
+(import srfi-78)
+(load "../chatdir.scm")
+
+(define *dir* "test chatdir")
+
+;; ——————————————————————————————————————————————————
+;; Helper functions for making tests
+;; ——————————————————————————————————————————————————
+;; Appends six random chars
+(define (randomize-string str)
+  (string-append str " "
+				 (random-bytes "ABC123" 6)))
+
+
+
+;; ——————————————————————————————————————————————————
+;; General-pupose functions
+;; ——————————————————————————————————————————————————
+(check (subpath "/etc" "systemd/" "user" "momma")
+	   =>
+	   "/etc/systemd/user/momma")
+
+
+;; ——————————————————————————————————————————————————
+;; File sets/gets [rooms, users, general]
+;; ——————————————————————————————————————————————————
+(define *room* "dining room")
+(define *room-path* "test chatdir/dining room")
+(define *room-meta-path* "test chatdir/dining room/.meta")
+(define *room-topic* "Here we can discuss everything relating to food.\nCooking, dining, etc!\nThe only limit is your palette!\n")
+(define *room-topic-xattrs* (list (cons 'user.chat.user "admin-tan")
+								  (cons 'user.chat.date (number->string (pseudo-random-integer 9999)))))
+
+(directory-file-set! *room-meta-path* "topic" *room-topic* *room-topic-xattrs*)
+(check (directory-file-get *room-meta-path* "topic")
+	   =>
+	   *room-topic*)
+
+(check (directory-file-get* *room-meta-path* "topic")
+	   =>
+	   (cons *room-topic* *room-topic-xattrs*))
+
+
+(define *room-topic-2* (randomize-string *room-topic*))
+(define *room-topic-xattrs-2* (alist-update 'user.chat.user "admin-mom" *room-topic-xattrs*))
+(channel-metadata-set! *dir* *room* "topic"
+					   *room-topic-2*
+					   *room-topic-xattrs-2*)
+(check (channel-metadata-get *dir* *room* "topic")
+	   =>
+	   *room-topic-2*)
+
+(check (channel-metadata-get* *dir* *room* "topic")
+	   =>
+	   (cons *room-topic-2* *room-topic-xattrs-2*))
+
+
+(define *msg-sender* "maya")
+(define *msg-text* "eee… hiya, papaya!")
+(define *msg-date* (current-date))
+(define *msg-xattr* '(user.bovo . "muuuu"))
+(define *msg-name* (message-file-leaf *dir* *room* *msg-date*))
+(channel-message-add! *dir* *room* *msg-text* *msg-sender* *msg-date* `(,*msg-xattr*))
+(check (directory-file-get* (subpath *dir* *room*) *msg-name*)
+	   =>
+	   (list *msg-text*
+			 (cons 'user.chat.date (date->string *msg-date* "~1T~2"))
+			 *msg-xattr*
+			 (cons 'user.chat.sender *msg-sender*)
+			 (cons 'user.chat.channel *room*)))
+
+(define *msg-sender-2* "bildinto")
+(define *msg-text-2* "he? ĉu vi bonsanas?")
+(define *msg-date-2* *msg-date*)
+(print "uwu")
+(define *msg-name-2* (message-file-leaf *dir* *room* *msg-date-2*))
+(print "YAY")
+(channel-message-add! *dir* *room* *msg-text-2* *msg-sender-2* *msg-date-2*)
+
+(check (directory-file-get* (subpath *dir* *room*) *msg-name-2*)
+	   =>
+	   (list *msg-text-2*
+			 (cons 'user.chat.date (date->string *msg-date-2* "~1T~2"))
+			 (cons 'user.chat.sender *msg-sender-2*)
+			 (cons 'user.chat.channel *room*)))
+
+(check-report)