#lang scheme (require scheme/generator (planet murphy/packed-io:1:0) "../main.ss" "../network.ss" "../errno.ss") (define client-file-handle% (class* object% (file-handle<%>) (super-new) (init-field fs fid [current-offset #f]) (define/public-final (call-with-tag proc) (send fs call-with-tag proc)) (define/public-final (call-with-tag+fid proc) (send fs call-with-tag+fid proc)) (define/public-final (request message) (send fs request message)) (define/public-final (fid->file fid qid [position #f]) (send fs fid->file fid qid position)) (define/public-final (->fid) (or fid (raise-9p-error ESTALE))) (define/public-final (walk . names) (call-with-tag+fid (λ (tag to-fid) (let ([names (list->vector names)]) (match (request (make-message:t:walk tag (->fid) to-fid names)) [(struct message:r:walk (_ qids)) (if (= (vector-length qids) (vector-length names)) (fid->file (unbox to-fid) (vector-ref qids (- (vector-length qids) 1))) (raise-9p-error ENOENT))] [_ (raise-9p-error EPROTO)]))))) (define/public-final (read-stat) (call-with-tag (λ (tag) (match (request (make-message:t:stat tag (->fid))) [(struct message:r:stat (_ stat)) stat] [_ (raise-9p-error EPROTO)])))) (define/public-final (write-stat stat) (call-with-tag (λ (tag) (match (request (make-message:t:wstat tag (->fid) stat)) [(? message:r:wstat?) (void)] [_ (raise-9p-error EPROTO)])))) (define/public-final offset (case-lambda [() current-offset] [(offset) (if current-offset (set! current-offset offset) (raise-9p-error ENOTCONN))])) (define/public-final (open mode) (call-with-tag (λ (tag) (match (request (make-message:t:open tag (->fid) mode)) [(struct message:r:open (_ _ i/o-unit)) (set! current-offset 0) i/o-unit] [_ (raise-9p-error EPROTO)])))) (define/public-final (read size [at-offset (offset)]) (if current-offset (call-with-tag (λ (tag) (match (request (make-message:t:read tag (->fid) at-offset size)) [(struct message:r:read (_ data)) (let ([size (bytes-length data)]) (offset (+ at-offset (bytes-length data))) (if (not (zero? size)) data eof))] [_ (raise-9p-error EPROTO)]))) (raise-9p-error ENOTCONN))) (define/public-final (write data [at-offset (offset)]) (if current-offset (call-with-tag (λ (tag) (match (request (make-message:t:write tag (->fid) at-offset data)) [(struct message:r:write (_ size)) (offset (+ at-offset size)) size] [_ (raise-9p-error EPROTO)]))) (raise-9p-error ENOTCONN))) (define/private (invalidate thunk) (when fid (let ([pending-exn #f]) (define (recording-exceptions thunk) (let/ec return (call-with-exception-handler (λ (exn) (set! pending-exn exn) (return)) thunk))) (recording-exceptions (λ () (inner (void) clunk))) (recording-exceptions thunk) (set!-values (fid current-offset) (values #f #f)) (when pending-exn (raise pending-exn))))) (define/pubment (clunk) (invalidate (λ () (call-with-tag (λ (tag) (match (request (make-message:t:clunk tag (->fid))) [(? message:r:clunk?) (void)] [_ (raise-9p-error EPROTO)])))))) (define/public-final (remove) (invalidate (λ () (call-with-tag (λ (tag) (match (request (make-message:t:remove tag (->fid))) [(? message:r:remove?) (void)] [_ (raise-9p-error EPROTO)])))))) )) (define client-directory-handle% (class* client-file-handle% (directory-handle<%>) (super-new) (inherit call-with-tag call-with-tag+fid request fid->file ->fid offset read) (define/public (in-entries) (define (read-some-entries offset) (let ([chunk (read (- (max-message-size) 24) offset)]) (if (not (eof-object? chunk)) (port->list (λ (in) (read-packed stat/p in)) (open-input-bytes chunk)) eof))) (in-generator (let loop ([entries (read-some-entries 0)]) (match entries [(cons entry rest) (yield entry) (loop rest)] [(list) (loop (read-some-entries (offset)))] [(? eof-object?) (void)])))) (define/public-final (create name perm mode) (call-with-tag+fid (λ (tag dup-fid) (match (request (make-message:t:walk tag (->fid) dup-fid '#())) [(? message:r:walk?) (call-with-exception-handler (λ (exn) (set-box! tag #f) (match (request (make-message:t:clunk tag (unbox dup-fid))) [(? message:r:clunk?) exn] [_ (raise-9p-error EPROTO)])) (λ () (set-box! tag #f) (match (request (make-message:t:create tag (unbox dup-fid) name perm mode)) [(struct message:r:create (_ qid i/o-unit)) (values (fid->file (unbox dup-fid) qid 0) i/o-unit)] [_ (raise-9p-error EPROTO)])))] [_ (raise-9p-error EPROTO)])))) )) (provide client-file-handle% client-directory-handle%)