Commits

evhan committed f5cf915

Refine shutdown process, run shutdown handlers in their own threads

This moves shutdown handlers into dedicated threads and refines mount
status transitions during unmount by moving mounts into the "stopping"
and "stopped" states as their destroy and shutdown handlers are fired,
respectively.

It also ensures destroy callbacks are executed on OpenBSD regardless
of how filesystems are stopped.

Comments (0)

Files changed (2)

 It has also been installed successfully on FreeBSD and Mac OS X, but
 tested far less thoroughly on those platforms.
 
-On OpenBSD, each filesystem's main loop is single-threaded.
+On OpenBSD, each filesystem's main loop is single-threaded, and stopping
+a filesystem via {{filesystem-stop!}} is significantly slower than
+stopping it via {{umount(2)}}.
 
 ==== Runtime Structure
 
 Each filesystem is executed in a separate native thread that
 communicates with the (single, shared) CHICKEN runtime via Unix pipe,
 per [[/egg/concurrent-native-callbacks|concurrent-native-callbacks]].
-More than one filesystem run at once, but FUSE operations are
+More than one filesystem can be run at once, but FUSE operations are
 synchronous across all filesystems so long-running callbacks should be
 avoided.
 
 More importantly, care must be taken not to deadlock the Scheme runtime
 by requesting a filesystem operation from within CHICKEN that itself
 requires a response from CHICKEN, for example by accessing a file that's
-part of a running filesystem. The easiest way to do this is to run each
-filesystem in a more-or-less dedicated OS-level process whose sole
-responsibility is to service FUSE requests.
+part of a running filesystem. The easiest way to avoid this situation is
+to run each filesystem in a more-or-less dedicated OS-level process
+whose sole responsibility is to service FUSE requests.
 
 === API
 
 {{path}} should be a pathname string indicating an empty directory.
 
 On successful startup, the filesystem is mounted, its '''{{init:}}'''
-callback is executed, any threads waiting on the filesystem (via
-{{filesystem-wait!}}) are unblocked, and a non-{{#f}} value is returned.
-On failure, {{#f}} is returned immediately.
+callback is executed, any threads waiting for the filesystem to start
+are unblocked, and a non-{{#f}} value is returned. On failure, {{#f}} is
+returned immediately.
 
 {{filesystem-start!}} does not wait for filesystem initialization before
 returning. To block until the filesystem is becomes available, use
 (according to {{string=?}}).
 
 If the given {{filesystem}} isn't currently mounted at {{path}}, this
-procedure is a noop. Otherwise, it is unmounted, its '''{{destroy:}}'''
-callback is executed, and any threads waiting on the filesystem (via
-{{filesystem-wait!}}) are unblocked.
+procedure is a noop. Otherwise, the filesystem is unmounted, any threads
+waiting for the filesystem to stop are unblocked, and its
+'''{{destroy:}}''' callback is executed.
+
+{{filesystem-stop!}} does not wait for filesystem shutdown before
+returning. To block until the filesystem is fully stopped, use
+{{filesystem-wait!}}.
 
 <procedure>(filesystem-wait! path filesystem [status]) -> undefined</procedure>
 
 
 (define (mount-status mount)
   ((mount-synchronization-handler mount)
-   (lambda (m _ poll-fuse-exit!)
-     (poll-fuse-exit!)
-     (mutex-specific m))))
+   (lambda (m _) (mutex-specific m))))
 
-(define (mount-status-set! mount v)
+(define (mount-status-set! mount status)
   ((mount-synchronization-handler mount)
-   (lambda (m c _)
-     (mutex-specific-set! m v)
-     (condition-variable-signal! c))))
+   (lambda (m c)
+     (mutex-lock! m)
+     (mutex-specific-set! m status)
+     (condition-variable-broadcast! c)
+     (mutex-unlock! m))))
 
 (define (mount-wait! mount status)
   ((mount-synchronization-handler mount)
-   (lambda (m c _)
-     (do ((s (mount-status mount)
-             (mount-status mount)))
-         ((eq? s status))
-       (mutex-unlock! m c 1)))))
+   (lambda (m c)
+     (do ((_ (mutex-lock! m)
+             (mutex-lock! m)))
+         ((eq? (mutex-specific m) status)
+          (mutex-unlock! m))
+       (mutex-unlock! m c)))))
 
 (define (mount-stop! mount)
-  ((mount-synchronization-handler mount)
-   (lambda (m c _)
-     (mutex-lock! m)
-     (let ((shutdown-handler (mount-shutdown-handler mount)))
-       (mount-shutdown-handler-set! mount void)
-       (mount-synchronization-handler-set! mount (cut <> m c void))
-       (call/cc (cut with-exception-handler <> shutdown-handler))
-       (mount-status-set! mount 'stopped)
-       (mutex-unlock! m)))))
+  (let ((shutdown-handler (mount-shutdown-handler mount)))
+    (mount-shutdown-handler-set! mount void)
+    (thread-start! shutdown-handler)))
+
+(define-inline (mount-running? mount)
+  (eq? (mount-status mount) 'started))
+
+(define-inline (mount-stopping? mount)
+  (eq? (mount-status mount) 'stopping))
 
 (define-constant operations ; NB order matters.
   '(getattr:
 
 (define current-fuse-context #f) ; XXX Dynamic variable.
 
-(define-inline (current-mount)
+(define (current-mount)
   (gc-root-ref (fuse_context_private_data current-fuse-context)))
 
 (define-inline (current-filesystem)
             (callback    (symbol-append 'fuse_ name '_callback)))
        `(begin
           (define-synchronous-concurrent-native-callback
-            (,handler (c-pointer context) ,@spec) ,return-type
+            ((,handler fuse) (c-pointer context) ,@spec) ,return-type
             (fluid-let ((current-fuse-context context))
               (callback-protect (lambda () ,@body))))
           (foreign-declare
       (else
        (callback-result v)))))
 
-(define-callback (init (c-pointer data)) c-pointer
+(define-callback (init (c-pointer conn)) c-pointer
   (callback-protect (current-filesystem-callback 21))
   (mount-status-set! (current-mount) 'started)
   (fuse_context_private_data current-fuse-context))
 
 (define-callback (destroy (c-pointer data)) void
-  (mount-status-set! (current-mount) 'stopping)
-  (mount-stop! (current-mount)))
+  ;; On Linux, destroy is called *after* the filesystem has been
+  ;; disconnected, so there's no active fuse_context through which
+  ;; current-mount can access the rooted mount record. However, we do
+  ;; have the root in private_data, so we use that instead.
+  (let ((mount (gc-root-ref data)))
+    (mount-status-set! mount 'stopping)
+    (mount-stop! mount)))
 
 (define make-gc-root
   (foreign-primitive c-pointer ((scheme-object obj))
 
 (cond-expand
   (openbsd
-   (foreign-declare "#define fuse_loop_mt fuse_loop")
-   (foreign-declare "#define fuse_exit(_)"))
+   (foreign-declare "#define fuse_loop_mt(f) fuse_loop(f)"))
   (else))
 
 #>
   sigaddset(&s, SIGTERM);
   pthread_sigmask(SIG_BLOCK, &s, NULL);
   fuse_loop_mt(fuse);
-  fuse_exit(fuse);
+  fuse_destroy(fuse);
   return NULL;
 }
 
 }
 
 int stop_fuse_thread(pthread_t *thread) {
-  int result = 0;
-  if (pthread_cancel(*thread))
-    goto out;
-  if (pthread_join(*thread, NULL))
-    goto out;
-  else
-    result = 1;
-out:
+  int result = pthread_join(*thread, NULL) == 0;
   free(thread);
   C_return(result);
 }
 (define stop-fuse-thread!
   (foreign-lambda bool stop_fuse_thread c-pointer))
 
+(cond-expand
+  (openbsd
+   ;; We can't use the destroy callback to coordinate shutdown events
+   ;; (since it's only triggered under certain circumstances), so
+   ;; instead we simply wait for the FUSE request dispatcher to empty
+   ;; its queue before stopping the worker thread. This is safe since
+   ;; only one filesystem can be mounted at a time anyway.
+   (define-inline (fd-ready? fd)
+     (fx= 1 ((foreign-lambda int "C_check_fd_ready" int) fd)))
+   (define (dispatcher-queue-empty! name)
+     (let ((fd (dispatcher-argument-input-fileno (dispatcher name))))
+       (do () ((not (fd-ready? fd))) (thread-yield!)))))
+  (else))
+
 (define filesystem-start!
   (let* ((opsize (foreign-type-size "struct fuse_operations"))
          (ops    (allocate opsize)))
     (fuse_operations_utimens_set!  ops (foreign-value "fuse_utimens_callback" c-pointer))
     (fuse_operations_statfs_set!   ops (foreign-value "fuse_statfs_callback" c-pointer))
     (fuse_operations_init_set!     ops (foreign-value "fuse_init_callback" c-pointer))
-    (cond-expand
-      (openbsd (fuse_operations_destroy_set! ops (foreign-value "fuse_destroy_callback" c-pointer)))
-      (else))
+    (fuse_operations_destroy_set!  ops (foreign-value "fuse_destroy_callback" c-pointer))
     (lambda (path fs)
       (and-let* ((chan   (fuse_mount path #f))
                  (mount  (make-mount fs void void (current-exception-handler)))
          (let ((m (make-mutex))
                (c (make-condition-variable)))
            (mutex-specific-set! m 'starting)
-           (lambda (f)
-             (f m c (lambda ()
-                      (when (fuse_exited fuse)
-                        (mount-stop! mount)))))))
+           (lambda (f) (f m c))))
         (mount-shutdown-handler-set!
          mount
          (lambda ()
-           (cond-expand
-             (openbsd
-              (fuse_destroy fuse)
-              (fuse_unmount path chan)
-              (unless (eq? (mount-status mount) 'stopping)
-                (stop-fuse-thread! thread)))
-             (else
-              (fuse_exit fuse)
-              (fuse_unmount path chan)
-              (fuse_destroy fuse)))
-           (gc-root-destroy! root)
+           (unless (mount-stopping? mount)
+             (cond-expand
+               (openbsd
+                (fuse_unmount path chan)
+                (dispatcher-queue-empty! 'fuse))
+               (else
+                (fuse_exit fuse)
+                (fuse_unmount path chan)
+                (mount-wait! mount 'stopping))))
+           (stop-fuse-thread! thread)
+           (mount-status-set! mount 'stopped)
            (filesystem-mount-delete! fs path)
-           (when-let* ((destroy-callback
-                        (##sys#vector-ref (filesystem-operations fs) 22)))
-             (destroy-callback))))
+           ;; On OpenBSD the destroy callback is only executed on an
+           ;; unmount request from the kernel, so to make sure destroy
+           ;; handlers are always run we invoke them manually on
+           ;; filesystem shutdown rather than in the destroy callback.
+           (fluid-let ((current-mount (lambda () mount)))
+             (callback-protect (current-filesystem-callback 22)))))
         (filesystem-mount-add! fs path mount)))))
 
 (define (filesystem-wait! path fs #!optional (status 'stopped))
 
 (define (filesystem-running? path fs)
   (and-let* ((mount (alist-ref path (filesystem-mounts fs) string=?)))
-    (eq? (mount-status mount) 'started))))
+    (mount-running? mount))))