;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; hellofs.scm - CHICKEN fuse example (hello world).
;;;
;;; http://fuse.sourceforge.net/helloworld.html
;;;
;;; To run:
;;;
;;;     $ csc hellofs.scm
;;;     $ ./hellofs <mountpoint>
;;;

(import (chicken bitwise)
        (chicken file posix)
        (chicken process signal)
        (chicken process-context)
        (chicken process-context posix)
        (chicken time)
        (fuse))

(define hello-string "Hello world!\n")
(define hello-path "/hello")

(define hello-filesystem
  (make-filesystem
   getattr: (lambda (path)
              (let ((now (current-seconds)))
                (cond
                  ((string=? path "/")
                   (vector (bitwise-ior file/dir perm/irusr perm/iwusr perm/ixusr)
                           2
                           (current-user-id)
                           (current-group-id)
                           0
                           now
                           now
                           now))
                 ((string=? path hello-path)
                  (vector (bitwise-ior file/reg perm/irusr perm/iwusr perm/ixusr)
                          1
                          (current-user-id)
                          (current-group-id)
                          (string-length hello-string)
                          now
                          now
                          now))
                 (else #f))))

   readdir: (lambda (path)
              (and (string=? path "/")
                   (list "." ".." (substring hello-path 1))))

   open: (lambda (path mode)
           (string=? path hello-path))

   read: (let ((len (string-length hello-string)))
           (lambda (_ size offset)
             (if (>= offset len)
                 0
                 (substring hello-string offset (min size (- len offset))))))))

(for-each
 (lambda (path)
   (when (filesystem-start! path hello-filesystem)
     (set-signal-handler!
      signal/int
      (lambda (_)
        (filesystem-stop! path hello-filesystem)))
     (filesystem-wait! path hello-filesystem)))
 (command-line-arguments))