Changeset 8073 in project


Ignore:
Timestamp:
02/02/08 20:41:10 (12 years ago)
Author:
sjamaan
Message:

Package up as an egg (add declarations, .setup and .meta file)

Location:
release/3/9p/trunk
Files:
2 added
2 edited

Legend:

Unmodified
Added
Removed
  • release/3/9p/trunk/9p-client.scm

    r8070 r8073  
    4646; TODO: Think about how to expose non-POSIX things from 9p properly
    4747
     48(declare
     49 (export 9p:connection? 9p:request 9p:client-connect 9p:client-disconnect
     50         9p:handle? 9p:alloc-handle 9p:release-handle 9p:normalize-path
     51         9p:path-walk 9p:file-open 9p:file-close 9p:with-handle-to
     52         9p:file-exists? 9p:file-create 9p:file-read 9p:file-write
     53         9p:file-stat 9p:file-permissions 9p:file-access-time
     54         9p:file-modification-time 9p:file-size 9p:file-owner 9p:file-group
     55         9p:file-last-modified-by 9p:directory? 9p:regular-file?
     56         9p:set-file-position! 9p:file-position 9p:directory 9p:delete-file
     57         9p:open-output-file 9p:call-with-output-file 9p:with-output-to-file
     58         9p:open-input-file 9p:call-with-input-file 9p:with-input-from-file)
     59 (unused 9p:connection-inport-set! 9p:connection-outport-set!))
     60
    4861(use 9p-lolevel srfi-13 iset)
    4962
     
    5164  inport outport message-size open-fids)
    5265
    53 (define (9p:server-error message-type error-message)
     66(define (server-error message-type error-message)
    5467  (signal
    5568   (make-composite-condition
     
    5770    (make-property-condition '9p-server-error 'message-type message-type))))
    5871
    59 (define (9p:response-error message-type response-type)
     72(define (response-error message-type response-type)
    6073  (signal
    6174   (make-composite-condition
     
    7487      response)
    7588     ((eq? (9p:message-type response) 'Rerror)
    76       (9p:server-error type (car (9p:message-contents response))))
     89      (server-error type (car (9p:message-contents response))))
    7790     (else
    78       (9p:response-error type (9p:message-type response))))))
     91      (response-error type (9p:message-type response))))))
    7992
    8093;; Initialize a connection to a 9p server ("mount"/"bind")
     
    112125  connection fid position iounit)
    113126
    114 (define (9p:initialize-iounit! h iounit)
     127(define (initialize-iounit! h iounit)
    115128  (9p:handle-iounit-set!
    116129   h
     
    157170        new-handle))))
    158171
     172(define (9p:file-open con name mode)
     173  (let ((h (9p:path-walk con name)))
     174    (handle-exceptions exn (begin (9p:file-close h) (signal exn))
     175     (let* ((response (9p:request con 'Topen (9p:handle-fid h) mode))
     176            (iounit (second (9p:message-contents response))))
     177       (initialize-iounit! h iounit)
     178       h))))
     179
    159180;; Clunk a fid
    160181(define (9p:file-close h)
     
    181202  (condition-case (9p:with-handle-to con path (constantly #t))
    182203    ((exn 9p-server-error) #f)))
    183 
    184 (define (9p:file-open con name mode)
    185   (let ((h (9p:path-walk con name)))
    186     (handle-exceptions exn (begin (9p:file-close h) (signal exn))
    187      (let* ((response (9p:request con 'Topen (9p:handle-fid h) mode))
    188             (iounit (second (9p:message-contents response))))
    189        (9p:initialize-iounit! h iounit)
    190        h))))
    191204
    192205;; This duplicates much of with-handle-to, but 9p isn't very consistent here: the
     
    203216     (let* ((response (9p:request con 'Tcreate (9p:handle-fid h) (pathname-strip-directory name) perm mode))
    204217            (iounit (second (9p:message-contents response))))
    205        (9p:initialize-iounit! h iounit)
     218       (initialize-iounit! h iounit)
    206219       h))))
    207220
     
    220233                  (u8vector-set! result result-pos (u8vector-ref (car vectors) vector-pos))
    221234                  (next-pos (add1 vector-pos) (add1 result-pos)))))))))
     235
     236(define (u8vector-slice v start length)
     237  (subu8vector v start (+ start length)))
    222238
    223239;; TODO: Find a way to use an optional buffer to write in, so we don't end up
     
    261277              (9p:handle-position-set! h (+ pos written))
    262278              (if (not (= written send-size))
    263                   (9p:server-error 'Twrite (sprintf "Unexpected bytecount ~A instead of ~A in Rwrite response (not a proper server error message)" written send-size)))
     279                  (server-error 'Twrite (sprintf "Unexpected bytecount ~A instead of ~A in Rwrite response (not a proper server error message)" written send-size)))
    264280              (loop (- bytes-left written) (+ total written))))))))
    265281
     
    343359(define 9p:file-position 9p:handle-position)
    344360
     361(define (read-directory h show-dotfiles?)
     362  (let loop ((result (list))
     363             (pos 0))
     364    (let* ((response (9p:request (9p:handle-connection h) 'Tread (9p:handle-fid h) pos (9p:handle-iounit h)))
     365           (data (car (9p:message-contents response)))
     366           (read (u8vector-length data)))
     367      (if (zero? read)
     368          (9p:data->directory-listing (apply u8vector-append! (reverse result)) show-dotfiles?)
     369          (loop (cons data result) (+ pos read))))))
     370
    345371(define (9p:directory con file . rest)
    346372  (let-optionals rest ((show-dotfiles? #f))
     
    357383              (let* ((response (9p:request con 'Topen (9p:handle-fid h) 9p:open/rdonly))
    358384                     (iounit (second (9p:message-contents response))))
    359                 (9p:initialize-iounit! h iounit)
    360                 (9p:read-directory h show-dotfiles?)))))))))
     385                (initialize-iounit! h iounit)
     386                (read-directory h show-dotfiles?)))))))))
    361387
    362388(define (9p:delete-file con path)
     
    364390    (handle-exceptions exn (begin (9p:release-handle h) (signal exn))
    365391      (9p:request con 'Tremove (9p:handle-fid h)) (9p:release-handle h))))
    366 
    367 (define (9p:read-directory h show-dotfiles?)
    368   (let loop ((result (list))
    369              (pos 0))
    370     (let* ((response (9p:request (9p:handle-connection h) 'Tread (9p:handle-fid h) pos (9p:handle-iounit h)))
    371            (data (car (9p:message-contents response)))
    372            (read (u8vector-length data)))
    373       (if (zero? read)
    374           (9p:data->directory-listing (apply u8vector-append! (reverse result)) show-dotfiles?)
    375           (loop (cons data result) (+ pos read))))))
    376392
    377393(define (9p:open-output-file con file . rest)
     
    418434                              (else (set! buffer (blob->u8vector/shared (string->blob (car result))))
    419435                                    (set! buffer-size (second result))
    420                                     (set! buffer-offet 1)
     436                                    (set! buffer-offset 1)
    421437                                    (integer->char (u8vector-ref buffer 0)))))))
    422438                     (constantly #t)
  • release/3/9p/trunk/9p-lolevel.scm

    r8070 r8073  
    3939;; Possibly this is more efficient.
    4040
     41(declare
     42 (export 9p:qid? make-9p:qid 9p:qid-type 9p:qid-version 9p:qid-path
     43         9p:qid-type-set! 9p:qid-version-set! 9p:qid-path-set!
     44         9p:open/rdonly 9p:open/wronly 9p:open/rdwr 9p:open/trunc 9p:open/rclose
     45         9p:perm/ixoth 9p:perm/iwoth 9p:perm/iroth
     46         9p:perm/ixusr 9p:perm/iwusr 9p:perm/irusr
     47         9p:perm/ixgrp 9p:perm/iwgrp 9p:perm/irgrp
     48         9p:dmdir 9p:dmappend 9p:dmexcl 9p:dmauth 9p:dmtmp
     49         9p:qtfile 9p:qtdir 9p:qtappend 9p:qtexcl 9p:qtauth 9p:qttmp
     50         9p:notag 9p:nofid 9p:stat-keep-number 9p:stat-keep-string
     51         9p:message? make-9p:message 9p:message-type 9p:message-tag 9p:message-contents
     52         9p:send-message 9p:receive-message 9p:data->directory-listing
     53         9p:message-type-set! 9p:message-contents-set! 9p:message-tag-set!))
     54
    4155(use srfi-1 srfi-4 srfi-8 srfi-18 posix)
    4256
     
    4559
    4660;; Open flags
    47 (define-constant 9p:open/rdonly #x00)
    48 (define-constant 9p:open/wronly #x01)
    49 (define-constant 9p:open/rdwr #x02)
    50 (define-constant 9p:open/trunc #x10)
    51 (define-constant 9p:open/rclose #x40) ;; Remove/unlink on clunk/close
     61(define 9p:open/rdonly #x00)
     62(define 9p:open/wronly #x01)
     63(define 9p:open/rdwr #x02)
     64(define 9p:open/trunc #x10)
     65(define 9p:open/rclose #x40) ;; Remove/unlink on clunk/close
    5266
    5367;; Note that for Unix systems these permissions are the same (?).
    5468;; For Windows system these may not be the same.  In any case, we don't
    5569;; want to make assumptions about these things.
    56 (define-constant 9p:perm/ixoth #o001)
    57 (define-constant 9p:perm/iwoth #o002)
    58 (define-constant 9p:perm/iroth #o004)
    59 (define-constant 9p:perm/ixgrp #o010)
    60 (define-constant 9p:perm/iwgrp #o020)
    61 (define-constant 9p:perm/irgrp #o040)
    62 (define-constant 9p:perm/ixusr #o100)
    63 (define-constant 9p:perm/iwusr #o200)
    64 (define-constant 9p:perm/irusr #o400)
    65 
    66 (define-constant 9p:dmdir    #x80000000) ; Is a directory
    67 (define-constant 9p:dmappend #x40000000) ; Append-only
    68 (define-constant 9p:dmexcl   #x20000000) ; Exclusive use
     70(define 9p:perm/ixoth #o001)
     71(define 9p:perm/iwoth #o002)
     72(define 9p:perm/iroth #o004)
     73(define 9p:perm/ixgrp #o010)
     74(define 9p:perm/iwgrp #o020)
     75(define 9p:perm/irgrp #o040)
     76(define 9p:perm/ixusr #o100)
     77(define 9p:perm/iwusr #o200)
     78(define 9p:perm/irusr #o400)
     79
     80(define 9p:dmdir    #x80000000) ; Is a directory
     81(define 9p:dmappend #x40000000) ; Append-only
     82(define 9p:dmexcl   #x20000000) ; Exclusive use
    6983; #x08000000 is skipped "for historical reasons"
    70 (define-constant 9p:dmauth   #x04000000) ; Authentication file (established by auth messages)
    71 (define-constant 9p:dmtmp    #x02000000) ; Temporary file
    72 
    73 (define-constant 9p:qtfile   #x00) ; Don't check for this!
    74 (define-constant 9p:qtdir    #x80)
    75 (define-constant 9p:qtappend #x40)
    76 (define-constant 9p:qtexcl   #x20)
     84(define 9p:dmauth   #x04000000) ; Authentication file (established by auth messages)
     85(define 9p:dmtmp    #x02000000) ; Temporary file
     86
     87(define 9p:qtfile   #x00) ; Don't check for this!
     88(define 9p:qtdir    #x80)
     89(define 9p:qtappend #x40)
     90(define 9p:qtexcl   #x20)
    7791; #x08 is skipped "for historical reasons"
    78 (define-constant 9p:qtauth   #x08)
    79 (define-constant 9p:qttmp    #x04)
    80 
    81 (define-constant 9p:notag #xffff)      ;; For Tversion
    82 (define-constant 9p:nofid #xffffffff)  ;; For Tattach
     92(define 9p:qtauth   #x08)
     93(define 9p:qttmp    #x04)
     94
     95(define 9p:notag #xffff)      ;; For Tversion
     96(define 9p:nofid #xffffffff)  ;; For Tattach
    8397
    8498;; For Twstat messages, when the server should keep the current value (aka "don't touch" in the manpage)
    85 (define-constant 9p:stat-keep-number #xffffffff)
    86 (define-constant 9p:stat-keep-string "")
     99(define 9p:stat-keep-number #xffffffff)
     100(define 9p:stat-keep-string "")
    87101
    88102(define message-types
     
    145159
    146160;; Raise an 'unknown message' exception
    147 (define (9p:unknown-message-error message-type)
     161(define (unknown-message-error message-type)
    148162  (signal
    149163   (make-composite-condition
     
    156170             (pos  0))
    157171    (cond
    158      ((null? msgs) (9p:unknown-message-error message-type))
     172     ((null? msgs) (unknown-message-error message-type))
    159173     ((eq? (caar msgs) message-type) (values (car msgs) (+ 100 pos)))
    160174     (else (loop (cdr msgs) (add1 pos))))))
     
    170184;; Create a 'message format error' condition.
    171185;; This condition signals a protocol violation
    172 (define (9p:message-format-error message-type expected actual . rest)
     186(define (message-format-error message-type expected actual . rest)
    173187  (let-optionals rest ((information #f))
    174188    (signal
     
    187201            (let ((result (apply append (map (lambda (entry) (pack-argument message-type (car type) entry)) arg))))
    188202              (cons (number->u8vector 2 (/ (length result) 2)) result))
    189             (9p:message-format-error message-type type arg)))
     203            (message-format-error message-type type arg)))
    190204      (case type
    191205        ((msize fid time permission-mode datasize access-mode)
     
    211225      (if (null? contents)
    212226          (cons (packet-size 4 data) data)
    213           (9p:message-format-error (car message-type) (cdr message-type) orig-contents "Too many arguments for message")))
     227          (message-format-error (car message-type) (cdr message-type) orig-contents "Too many arguments for message")))
    214228     ((null? contents)
    215       (9p:message-format-error (car message-type) (cdr message-type) orig-contents "Too few arguments for message"))
     229      (message-format-error (car message-type) (cdr message-type) orig-contents "Too few arguments for message"))
    216230     ((eq? (car template) 'statsize)  ;; Ugly exception.  Continue the loop with a new list and cons length onto it
    217231      (let* ((rest (loop (cdr template) contents '()))
     
    295309        (if (= offset (u8vector-length packet))
    296310            (make-9p:message (car message-type) tag data)
    297             (9p:message-format-error (car message-type) (cdr message-type) packet "Too large packet for message")))
     311            (message-format-error (car message-type) (cdr message-type) packet "Too large packet for message")))
    298312       ((= offset packet-length)
    299         (9p:message-format-error (car message-type) (cdr message-type) packet "Too small packet for message"))
     313        (message-format-error (car message-type) (cdr message-type) packet "Too small packet for message"))
    300314       (else
    301315        (receive (fragment-size contents) (unpack-argument (car template) packet offset)
Note: See TracChangeset for help on using the changeset viewer.