Split inotify-daemon into seperate file
This commit is contained in:
parent
2ef1c47b83
commit
72f17d26a7
|
|
@ -0,0 +1,153 @@
|
|||
;; Copyright 2023, Jaidyn Levesque <jadedctrl@posteo.at>
|
||||
;; 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 <https://www.gnu.org/licenses/>.
|
||||
;;
|
||||
|
||||
(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. 🎶
|
||||
|
||||
133
chatdir.scm
133
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
|
||||
;; ——————————————————————————————————————————————————
|
||||
|
|
|
|||
Reference in New Issue