filesystem driver
This commit is contained in:
parent
bc346ff38a
commit
08f1e7506b
|
@ -0,0 +1,63 @@
|
||||||
|
#lang syndicate/actor
|
||||||
|
;; Filesystem change monitor driver
|
||||||
|
|
||||||
|
(provide (struct-out file-content)
|
||||||
|
spawn-filesystem-driver)
|
||||||
|
|
||||||
|
(require syndicate/protocol/standard-relay)
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(struct file-content (name reader-proc content) #:prefab) ;; ASSERTION
|
||||||
|
|
||||||
|
(struct file-changed (name) #:prefab) ;; MESSAGE
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(define (spawn-filesystem-driver)
|
||||||
|
(actor #:name 'filesystem-driver
|
||||||
|
(during/actor (observe (file-content $name $reader-proc _))
|
||||||
|
#:name (list 'file-content name reader-proc)
|
||||||
|
(track-file name reader-proc))))
|
||||||
|
|
||||||
|
(define (read-file name reader-proc)
|
||||||
|
(and (file-exists? name)
|
||||||
|
(reader-proc name)))
|
||||||
|
|
||||||
|
(define (track-file name reader-proc)
|
||||||
|
(define control-ch (make-channel))
|
||||||
|
(thread (lambda () (track-file-changes name control-ch)))
|
||||||
|
|
||||||
|
(field [content (read-file name reader-proc)])
|
||||||
|
|
||||||
|
(assert (file-content name reader-proc (content)))
|
||||||
|
|
||||||
|
(on (message (inbound (file-changed name)))
|
||||||
|
(content (read-file name reader-proc)))
|
||||||
|
|
||||||
|
(on-stop (channel-put control-ch 'quit)))
|
||||||
|
|
||||||
|
(define (track-file-changes name control-ch)
|
||||||
|
(let loop ()
|
||||||
|
(sync (handle-evt control-ch
|
||||||
|
(lambda (msg)
|
||||||
|
;; (log-info "track-file-changes ~v: ~v" name msg)
|
||||||
|
(match msg
|
||||||
|
['quit (void)])))
|
||||||
|
(if (file-exists? name) ;; TODO: TOCTTOU :-(
|
||||||
|
(handle-evt (filesystem-change-evt name)
|
||||||
|
(lambda (_dummy)
|
||||||
|
;; (log-info "track-file-changes ~v: changed" name)
|
||||||
|
(send-ground-message (file-changed name))
|
||||||
|
(loop)))
|
||||||
|
(let-values (((parent-path _leaf _syntactically-dir?)
|
||||||
|
(split-path (path->complete-path name))))
|
||||||
|
(handle-evt (filesystem-change-evt parent-path)
|
||||||
|
(lambda (_dummy)
|
||||||
|
;; (log-info "track-file-changes ~v: directory changed" name)
|
||||||
|
(send-ground-message (file-changed name))
|
||||||
|
(loop))))))))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(spawn-filesystem-driver)
|
|
@ -0,0 +1,21 @@
|
||||||
|
#lang syndicate/actor
|
||||||
|
|
||||||
|
(require/activate syndicate/drivers/filesystem)
|
||||||
|
(require racket/file)
|
||||||
|
|
||||||
|
(require (only-in racket/port read-bytes-line-evt))
|
||||||
|
(require (only-in racket/string string-trim string-split))
|
||||||
|
|
||||||
|
(let ((e (read-bytes-line-evt (current-input-port) 'any)))
|
||||||
|
(actor #:name 'monitor-shell
|
||||||
|
(stop-when (message (inbound (external-event e (list (? eof-object? _)))))
|
||||||
|
(send! (list "close" ?)))
|
||||||
|
(on (message (inbound (external-event e (list (? bytes? $command-bytes)))))
|
||||||
|
(send! (string-split (string-trim (bytes->string/utf-8 command-bytes)))))))
|
||||||
|
|
||||||
|
(actor #:name 'monitor-opener
|
||||||
|
(on (message (list "open" $name))
|
||||||
|
(actor #:name (list 'monitor name)
|
||||||
|
(stop-when (message (list "close" name)))
|
||||||
|
(on (asserted (file-content name file->bytes $bs))
|
||||||
|
(log-info "~a: ~v" name bs)))))
|
Loading…
Reference in New Issue