;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; portfs.scm - open/read/write/release with file ports.
;;;
;;; Serves the current working directory from <mountpoint>.
;;;
;;;     $ csc portfs.scm
;;;     $ ./portfs <mountpoint>
;;;
;;; Ctrl-C or `fusermount -u <mountpoint>` will exit the filesystem loop.
;;;

(use fuse posix srfi-13)

(let ((mountpoint ; strip CWD if present
       (let ((arg (car (command-line-arguments))))
         (cond ((string-prefix? (current-directory) arg)
                (substring arg (add1 (string-length (current-directory)))))
               (else arg)))))
  (start-filesystem
   mountpoint
   (make-filesystem
    getattr: (lambda (path)
               (let ((path (substring path 1))) ; leading "/"
                 (cond ((string=? path mountpoint) #f) ; avoid loop
                       ((string=? path "")
                        (subvector (file-stat ".") 1 9))
                       ((file-exists? path)
                        (subvector (file-stat path) 1 9))
                       (else #f))))
    readdir: (lambda (path)
               (let ((path (substring path 1)))
                 (cond ((string=? path mountpoint) #f)
                       ((string=? path "")
                        (directory "." #t))
                       ((directory-exists? path)
                        (directory path #t))
                       (else #f))))
    open:    (lambda (path mode)
               (let ((path (substring path 1)))
                  (and (regular-file? path)
                       (open-input-file path))))
    read:    (lambda (port size _) ; XXX offset ignored
               (read-string size port))
    release: (lambda (port)
               (close-input-port port)))))