client/filesystem.ss
#lang scheme
(require
 srfi/31
 "../main.ss"
 "../network.ss"
 "../errno.ss"
 "handle.ss")

(define client-filesystem%
  (class* object% (filesystem<%>)
    
    (super-new)
    
    (init hostname [port-no 564] [local-hostname #f] [local-port-no #f])
    
    (define-values (send-request flush-fid! custodian)
      (start-client hostname port-no local-hostname local-port-no))
    
    (define file-executor
      (make-will-executor))
    
    (parameterize ([current-custodian custodian])
      (thread
       (rec (loop)
         (will-execute file-executor)
         (loop))))
    
    (define/public-final (call-with-tag proc)
      (proc (box #f)))
    
    (define/public-final (call-with-tag+fid proc)
      (let ([tag (box #f)] [fid (box #f)])
        (call-with-exception-handler
         (λ (exn)
           (cond
             [(and flush-fid! (unbox fid)) => flush-fid!])
           exn)
         (λ ()
           (proc tag fid)))))
    
    (define/public-final (request message)
      (if send-request
          (send-request message)
          (raise-9p-error ENOLINK)))
    
    (define/private (wrap-fid fid qid offset)
      (cond
        [(not (zero? (bitwise-and (qid-type qid) (type-flag dir))))
         (new client-directory-handle% [fs this] [fid fid])]
        [else
         (new client-file-handle% [fs this] [fid fid] [current-offset offset])]))
    
    (define/pubment (fid->file fid qid [offset #f])
      (let ([file (inner (wrap-fid fid qid offset) fid->file fid qid offset)])
        (will-register file-executor file (λ (file) (send file clunk)))
        file))
    
    (define/public-final (authenticate [root ""] #:user [user (or (getenv "USER") "nobody")])
      (call-with-tag+fid
       (λ (tag fid)
         (match (request (make-message:t:auth tag fid user root))
           [(struct message:r:auth (_ qid))
            (fid->file (unbox fid) qid)]
           [_
            (raise-9p-error EPROTO)]))))
    
    (define/public-final (attach [root ""] #:user [user (or (getenv "USER") "nobody")] #:token [auth #f])
      (call-with-tag+fid
       (λ (tag fid)
         (let ([afid (if auth (send auth ->fid) #xffffffff)])
           (match (request (make-message:t:attach tag fid afid user root))
             [(struct message:r:attach (_ qid))
              (fid->file (unbox fid) qid)]
             [_
              (raise-9p-error EPROTO)])))))
    
    (define/pubment (clunk)
      (let ([old-custodian custodian])
        (when old-custodian
          (dynamic-wind
           void
           (λ ()
             (inner (void) clunk))
           (λ ()
             (set!-values (send-request flush-fid! custodian)
               (values #f #f #f))
             (custodian-shutdown-all old-custodian))))))
    
    ))

(provide
 client-filesystem%)