From 72f17d26a77aafbca2f18277c2e79afeda030366 Mon Sep 17 00:00:00 2001 From: Jaidyn Ann <10477760+JadedCtrl@users.noreply.github.com> Date: Sun, 21 May 2023 12:48:39 -0500 Subject: [PATCH] Split inotify-daemon into seperate file --- chatdir-inotify.scm | 153 ++++++++++++++++++++++++++ chatdir.scm | 133 ---------------------- tests/{tests.scm => test-chatdir.scm} | 0 3 files changed, 153 insertions(+), 133 deletions(-) create mode 100644 chatdir-inotify.scm rename tests/{tests.scm => test-chatdir.scm} (100%) diff --git a/chatdir-inotify.scm b/chatdir-inotify.scm new file mode 100644 index 0000000..06e9a61 --- /dev/null +++ b/chatdir-inotify.scm @@ -0,0 +1,153 @@ +;; Copyright 2023, Jaidyn Levesque +;; All rights reserved. Distributed under the terms of the MIT license. +;; +;; This program is free software: you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation, either version 3 of +;; the License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . +;; + +(load "chatdir.scm") + +(import scheme + (prefix inotify inotify:) + + +;; —————————————————————————————————————————————————— +;; Skeleton of a daemon +;; —————————————————————————————————————————————————— + +;; Initialization for the input loop +(define (input-loop-init root-dir callbacks-alist) + (let ([join-callback (alist-ref 'join-channel callbacks-alist)]) + (inotify:init!) + ;; Start watching the chatdir (for new channel joins, etc) + (inotify:add-watch! + root-dir '(onlydir moved-to moved-from delete delete-self create)) + + ;; Auto-join channels with all pre-existing channel directories + (map (lambda (path) + (let ([channel-dirname (pathname-file (pathname-directory (string-append path "/")))] + [join-callback (alist-ref 'join-channel callbacks-alist)]) + (if join-callback + (apply join-callback (list channel-dirname))) + + (inotify:add-watch! in-path '(moved-to close-write)) + (print "Joined and watching: " in-path))) + (filter directory-exists? (directory-rel irc-dir))))) + + +;; Handles all inotify-watched file events from the top-level IRC-directory. +;; Mainly, checking for newly-joined or left channels. +(define (handle-main-dir-event callbacks-alist event) + (let ([flags (inotify:event-flags event)] + [leave-callback (alist-ref 'leave-channel callbacks-alist)] + [join-callback (alist-ref 'join-channel callbacks-alist)]) + (cond + ;; If a channel dir's been moved or removed, stop watching (ofc) + ;; … Also quit that room! Heck them! + [(or (member 'moved-from flags) + (member 'delete flags) + (member 'delete-self flags)) + (let* ([channel (inotify:event-name event)] + [channel-inpath + (string-append (inotify:wd->path + (inotify:event-wd event)) + channel "/.in")] + [channel-wd (path->wd channel-inpath)]) + (print "Remove watch for " channel-inpath "…") + (if (and channel-wd (member channel-wd (wd-list))) + (attempt-remove-watch! channel-wd)) + (if leave-callback + (apply leave-callback (list channel))))] + + ;; If a dir's been created for a channel, maybe-join, then watch input! + [(or (member 'create flags) + (member 'moved-to flags)) + (let* ([channel (inotify:event->pathname event)]) + (print "Attempting to join channel " dirname "…") + (if join-callback + (apply join-callback (list path))))]))) + + +(define (channel-joined root-dir channel) + (let* ([in-path (normalize-pathname (string-append root-dir "/" channel "/.in"))]) + (inotify:add-watch! in-path '(moved-to close-write)) + (print "Began watching input " in-path "."))) + + +;; Handles an inotify event that pertains to a channel's .in/ directory +(define (handle-channel-dir-event callbacks-alist event) + (let* ([event-dir (pathname-directory (inotify:event->pathname event))] + [dirname (pathname-file event-dir)] + [channel (pathname-file (pathname-directory event-dir))] + [send-message-callback (alist-ref 'send-message callbacks-alist)]) + (cond + ;; If input is given to an `.in` dir… well, send that darn message! + ;; What're you wating for? + [(and (string=? dirname ".in") + send-message-callback) + (map (lambda (message) + (apply send-message (list channel message))) + (with-input-from-file (inotify:event->pathname event) + read-lines)) + (delete-file* (inotify:event->pathname event))]))) + + +;; Handle a single inotify file event, as part of the input loop +(define (handle-file-event root-dir callbacks-alist event) + (if (not (member 'ignored (event-flags event))) + (let* ([flags (inotify:event-flags event)] + [wd-path (inotify:wd->path (inotify:event-wd event))] + [main-dir? (string=? wd-path root-dir)]) + (if main-dir? + (handle-main-dir-event root-dir callbacks-alist event) + (handle-channel-dir-event root-dir callbacks-alist event))))) + + +;; The FS-backed input loop, to be run in a seperate thread (so as to not block) +;; This handles channel leaving/joining, and sending messages +;; Call-backs that should be provided: +;; (channel-joined channel) +;; (new-message channel text) +(define (input-loop root-dir callbacks-alist) + (map (lambda (event) + (handle-file-event root-dir callbacks-alist event)) + (inotify:next-events!)) + + (input-loop root-dir callbacks-alist)) + + + +;; —————————————————————————————————————————————————— +;; Utility +;; —————————————————————————————————————————————————— + +;; Returns an inotify watch-descriptor according the given path +(define (path->wd path) + (car + (filter (lambda (wd) + (string=? (normalize-pathname (inotify:wd->path wd)) + (normalize-pathname path))) + (inotify:wd-list)))) + + +;; Attempt to remove an inotify watch; if it's already been removed, no sweat +;; (This happens sometimes when inotify automatically deletes a watch) +(define (attempt-remove-watch! watch) + (handle-exceptions exn + #t + (inotify:remove-watch! watch))) + +;; Repeat after me: +;; 🎵 Symbolic links cannot have extended attributes, and that is a war-crime. 🎶 +;; 🎵 Directories cannot have extended attributes, and that is a war-crime. 🎶 + diff --git a/chatdir.scm b/chatdir.scm index e82dbe4..c987131 100644 --- a/chatdir.scm +++ b/chatdir.scm @@ -18,7 +18,6 @@ (chicken file) (chicken file posix) (chicken pathname) (chicken io) (chicken random) (chicken string) srfi-1 srfi-13 srfi-19 - (prefix inotify inotify:) (prefix xattr xattr:)) @@ -285,138 +284,6 @@ -;; —————————————————————————————————————————————————— -;; Skeleton of a daemon -;; —————————————————————————————————————————————————— - -;; Initialization for the input loop -(define (input-loop-init root-dir callbacks-alist) - (let ([join-callback (alist-ref 'join-channel callbacks-alist)]) - (inotify:init!) - ;; Start watching the chatdir (for new channel joins, etc) - (inotify:add-watch! - root-dir '(onlydir moved-to moved-from delete delete-self create)) - - ;; Auto-join channels with all pre-existing channel directories - (map (lambda (path) - (let ([channel-dirname (pathname-file (pathname-directory (string-append path "/")))] - [join-callback (alist-ref 'join-channel callbacks-alist)]) - (if join-callback - (apply join-callback (list channel-dirname))) - - (inotify:add-watch! in-path '(moved-to close-write)) - (print "Joined and watching: " in-path))) - (filter directory-exists? (directory-rel irc-dir))))) - - -;; Handles all inotify-watched file events from the top-level IRC-directory. -;; Mainly, checking for newly-joined or left channels. -(define (handle-main-dir-event callbacks-alist event) - (let ([flags (inotify:event-flags event)] - [leave-callback (alist-ref 'leave-channel callbacks-alist)] - [join-callback (alist-ref 'join-channel callbacks-alist)]) - (cond - ;; If a channel dir's been moved or removed, stop watching (ofc) - ;; … Also quit that room! Heck them! - [(or (member 'moved-from flags) - (member 'delete flags) - (member 'delete-self flags)) - (let* ([channel (inotify:event-name event)] - [channel-inpath - (string-append (inotify:wd->path - (inotify:event-wd event)) - channel "/.in")] - [channel-wd (path->wd channel-inpath)]) - (print "Remove watch for " channel-inpath "…") - (if (and channel-wd (member channel-wd (wd-list))) - (attempt-remove-watch! channel-wd)) - (if leave-callback - (apply leave-callback (list channel))))] - - ;; If a dir's been created for a channel, maybe-join, then watch input! - [(or (member 'create flags) - (member 'moved-to flags)) - (let* ([channel (inotify:event->pathname event)]) - (print "Attempting to join channel " dirname "…") - (if join-callback - (apply join-callback (list path))))]))) - - -(define (channel-joined root-dir channel) - (let* ([in-path (normalize-pathname (string-append root-dir "/" channel "/.in"))]) - (inotify:add-watch! in-path '(moved-to close-write)) - (print "Began watching input " in-path "."))) - - -;; Handles an inotify event that pertains to a channel's .in/ directory -(define (handle-channel-dir-event callbacks-alist event) - (let* ([event-dir (pathname-directory (inotify:event->pathname event))] - [dirname (pathname-file event-dir)] - [channel (pathname-file (pathname-directory event-dir))] - [send-message-callback (alist-ref 'send-message callbacks-alist)]) - (cond - ;; If input is given to an `.in` dir… well, send that darn message! - ;; What're you wating for? - [(and (string=? dirname ".in") - send-message-callback) - (map (lambda (message) - (apply send-message (list channel message))) - (with-input-from-file (inotify:event->pathname event) - read-lines)) - (delete-file* (inotify:event->pathname event))]))) - - -;; Handle a single inotify file event, as part of the input loop -(define (handle-file-event root-dir callbacks-alist event) - (if (not (member 'ignored (event-flags event))) - (let* ([flags (inotify:event-flags event)] - [wd-path (inotify:wd->path (inotify:event-wd event))] - [main-dir? (string=? wd-path root-dir)]) - (if main-dir? - (handle-main-dir-event root-dir callbacks-alist event) - (handle-channel-dir-event root-dir callbacks-alist event))))) - - -;; The FS-backed input loop, to be run in a seperate thread (so as to not block) -;; This handles channel leaving/joining, and sending messages -;; Call-backs that should be provided: -;; (channel-joined channel) -;; (new-message channel text) -(define (input-loop root-dir callbacks-alist) - (map (lambda (event) - (handle-file-event root-dir callbacks-alist event)) - (inotify:next-events!)) - - (input-loop root-dir callbacks-alist)) - - - -;; —————————————————————————————————————————————————— -;; inotify utility -;; —————————————————————————————————————————————————— - -;; Returns an inotify watch-descriptor according the given path -(define (path->wd path) - (car - (filter (lambda (wd) - (string=? (normalize-pathname (inotify:wd->path wd)) - (normalize-pathname path))) - (inotify:wd-list)))) - - -;; Attempt to remove an inotify watch; if it's already been removed, no sweat -;; (This happens sometimes when inotify automatically deletes a watch) -(define (attempt-remove-watch! watch) - (handle-exceptions exn - #t - (inotify:remove-watch! watch))) - -;; Repeat after me: -;; 🎵 Symbolic links cannot have extended attributes, and that is a war-crime. 🎶 -;; 🎵 Directories cannot have extended attributes, and that is a war-crime. 🎶 - - - ;; —————————————————————————————————————————————————— ;; Directory as key/value store ;; —————————————————————————————————————————————————— diff --git a/tests/tests.scm b/tests/test-chatdir.scm similarity index 100% rename from tests/tests.scm rename to tests/test-chatdir.scm