Changeset 15278 in project


Ignore:
Timestamp:
07/31/09 00:49:53 (10 years ago)
Author:
Jim Ursetto
Message:

hfs+: update to version 0.3 (copyfile)

Location:
release/4/hfs+/trunk
Files:
1 added
4 edited

Legend:

Unmodified
Added
Removed
  • release/4/hfs+/trunk/hfs+.meta

    r14881 r15278  
    77 (doc-from-wiki)
    88 (needs foreigners)
    9  (files "hfs+.scm" "hfs+.setup" "hfs+.html"))
     9 (files "hfs+.scm" "hfs+.setup" "hfs+.html" "copyfile.h"))
  • release/4/hfs+/trunk/hfs+.scm

    r15012 r15278  
    11;;; HFS+ extended attribute interface
    22
     3;; Copyright (c) 2009 Jim Ursetto.  All Rights Reserved.
     4;; License: BSD.  However, see copyfile.h, which is included
     5;; in this distribution, and is under the APSL.
     6
    37#> #include <sys/xattr.h>
     8   /* copyfile.h can be obtained from
     9    * http://www.opensource.apple.com/source/Libc/Libc-391.5.18/darwin/copyfile.h */
     10   #include "copyfile.h"
    411   #include <errno.h>
    512<#
     
    2128  remove-extended-attribute!
    2229  get-extended-attributes
    23   clear-extended-attributes!)
     30  clear-extended-attributes!
     31  copyfile copyfile-check
     32  pack-appledouble unpack-appledouble)
    2433
    2534(import scheme chicken foreign)
     
    5867  (foreign-lambda int fremovexattr int (const c-string) int))
    5968
     69(define _copyfile
     70  (foreign-lambda int copyfile (const c-string) (const c-string) c-pointer int))
     71
    6072(define-foreign-enum-type (xattr-options int)
    6173  (xattr-options->int int->xattr-options)
     
    6476  ((replace xattr/replace) XATTR_REPLACE)
    6577  ((silent xattr/silent) "0")  ; hack -- not a real API option :)
     78  )
     79
     80(define-foreign-enum-type (copyfile-options int)
     81  (copyfile-options->int int->copyfile-options)
     82  ((acl copyfile/acl) COPYFILE_ACL)
     83  ((stat copyfile/stat) COPYFILE_STAT)
     84  ((xattr copyfile/xattr) COPYFILE_XATTR)
     85  ((data copyfile/data) COPYFILE_DATA)
     86  ((security copyfile/security) COPYFILE_SECURITY)
     87  ((metadata copyfile/metadata) COPYFILE_METADATA)
     88  ((all copyfile/all) COPYFILE_ALL)
     89  ((check copyfile/check) COPYFILE_CHECK)
     90  ((pack copyfile/pack) COPYFILE_PACK)
     91  ((unpack copyfile/unpack) COPYFILE_UNPACK)
     92  ((exclusive copyfile/excl) COPYFILE_EXCL)
     93  ((no-follow-source copyfile/no-follow-source) COPYFILE_NOFOLLOW_SRC)
     94  ((no-follow-dest copyfile/no-follow-dest) COPYFILE_NOFOLLOW_DST)
     95  ((move copyfile/move) COPYFILE_MOVE)
     96  ((unlink copyfile/unlink) COPYFILE_UNLINK)
     97  ((no-follow copyfile/no-follow) COPYFILE_NOFOLLOW)
     98;;   ((silent copyfile/silent) "0")  ; hack -- not a real API option :)
    6699  )
    67100
     
    82115(define errno/exist (foreign-value "EEXIST" int))
    83116
    84 ;;; Base API
     117;;; Base API - Extended attributes
    85118
    86119;; Accepted options: #:no-follow (or 'no-follow) to prevent following symlink; if passing
     
    203236             (void))))))
    204237
     238;;; Base API - Copyfile
     239
     240;; [copyfile is not officially supported on Tiger and, although metadata pack/unpack
     241;;  to AppleDouble files seems to work fine, copying actual data via #:data or #:all
     242;;  will throw a spurious error or crash.  #:move doesn't seem to work, but #:excl does.
     243;;  #:no-follow is ignored for packing (critical) and unpacking (not).]
     244
     245;; Copies FROM file to TO file using OS X copyfile(3) API,
     246;; preserving HFS+ metadata as specified in copyfile OPTIONS.
     247(define (copyfile from to . options)
     248  (let ((c-options (copyfile-options->int options)))
     249    (let ((rv (_copyfile from to #f c-options)))
     250      (cond ((< rv 0)
     251             (xattr-error (update-errno) 'copyfile
     252                          from to))
     253            (else rv)))))
     254
    205255;;; Utilities
    206256
     
    223273;;   ...)
    224274
     275;; Pack/unpack all HFS+ metadata (xattrs, acls, POSIX stat).  If no
     276;; error occurs, pack returns #f when no metadata was present (and
     277;; does not write a file) or #t if metadata was present (and a file is
     278;; written).  Unpack always returns #t.  Extra options are passed into
     279;; copyfile; relevant ones might be #:excl, #:move and #:no-follow,
     280;; although #:move and #:no-follow do not work correctly under Tiger.
     281(define (pack-appledouble from to . options)
     282  (if (= 0 (apply copyfile from #f #:check #:metadata options))
     283      #f
     284      (and (apply copyfile from to #:pack #:metadata options) #t)))
     285(define (unpack-appledouble from to . options)
     286  (and (apply copyfile from to #:unpack #:metadata options) #t))
     287
     288;; Return a list of symbols denoting the attributes that WOULD be
     289;; copied from the FROM file, according to the OPTIONS provided.
     290;; Example call: (copyfile-check "foo.txt" #:metadata)
     291;; Example return: '(acl stat extended-attributes) meaning
     292;; COPYFILE_ACL, COPYFILE_STAT, COPYFILE_XATTR.
     293(define (copyfile-check from . options)
     294  (let ((options (cons 'check options)))
     295    (let ((rv (apply copyfile from #f options)))
     296      (cond ((= rv 0) '())
     297            ((> rv 0)
     298             ;; enumtypes won't decompose into their component bitfields
     299             ;; we could also case all 8 possibilities
     300             `(,@(if (= 0 (bitwise-and rv copyfile/acl)) '() '(acls))
     301               ,@(if (= 0 (bitwise-and rv copyfile/stat)) '() '(stat))
     302               ,@(if (= 0 (bitwise-and rv copyfile/xattr)) '() '(extended-attributes))))
     303            (else (error 'copyfile-check "unexpected copyfile return value" rv))))))
    225304
    226305)
  • release/4/hfs+/trunk/hfs+.setup

    r15012 r15278  
    44 'foreigners
    55 '("hfs+.so" "hfs+.import.so")
    6  '((version 0.2)))
     6 '((version 0.3)))
  • release/4/hfs+/trunk/test.scm

    r14881 r15278  
    44(use hfs+)
    55(use files)
     6(use posix)
    67
    78;; Assumes UNIX files are created with no attributes.
    8 ;; Untested: NOFOLLOW.  Setting resource forks.  Finder info.  Removing resource forks
    9 ;; (evidently must set to "").
     9;; Untested: Finder info.  Removing resource forks
     10;; (must set to "").
    1011
    11 (define file (create-temporary-file "hfs-test"))
     12(test-group
     13 "extended-attribute handling"
    1214
    13 (test "empty initial attribute set"
    14  '()
    15  (list-extended-attributes file))
     15 (define file (create-temporary-file "hfs-test"))
     16 (define link (string-append file ".link")) ; meh
     17
     18 (test "empty initial attribute set"
     19       '()
     20       (list-extended-attributes file))
    1621
    1722;; (set-extended-attribute! file "com.apple.FinderInfo" (make-string 32 #\x00))
    18 (set-extended-attribute! file "chicken.baz" "quux")
    19 (set-extended-attribute! file "chicken.zot" "erp")
    20 (set-extended-attribute! file "chicken.foo" "bar")
     23 (set-extended-attribute! file "chicken.baz" "quux")
     24 (set-extended-attribute! file "chicken.zot" "erp")
     25 (set-extended-attribute! file "chicken.foo" "bar")
    2126
    22 (test "list three attributes in chicken namespace"
    23       '("chicken.baz" "chicken.foo" "chicken.zot")
    24       (sort (list-extended-attributes file) string<?))
    25 (test "get three attributes in chicken namespace"
    26       '("quux" "erp" "bar")
    27       (list (get-extended-attribute file "chicken.baz")
    28             (get-extended-attribute file "chicken.zot")
    29             (get-extended-attribute file "chicken.foo")))
     27 (test "list three attributes in chicken namespace"
     28       '("chicken.baz" "chicken.foo" "chicken.zot")
     29       (sort (list-extended-attributes file) string<?))
     30 (test "get three attributes in chicken namespace"
     31       '("quux" "erp" "bar")
     32       (list (get-extended-attribute file "chicken.baz")
     33             (get-extended-attribute file "chicken.zot")
     34             (get-extended-attribute file "chicken.foo")))
    3035
    31 (test "replace existing attribute"
    32       #t
    33       (begin
    34         (set-extended-attribute! file "chicken.foo" "bar-updated" #:replace)
    35         #t))
    36 (test-error "replace non-existent attribute (error)"
    37             (set-extended-attribute! file "chicken.foo" "bar-updated" #:update))
    38 (test "create non-existent attribute ok"
    39       #t
    40       (begin
    41         (set-extended-attribute! file "chicken.new" "new" #:create)
    42         #t))
    43 (test-error "create existing attribute (error)"
    44             (set-extended-attribute! file "chicken.new" "new" #:create))
     36 (test "replace existing attribute"
     37       #t
     38       (begin
     39         (set-extended-attribute! file "chicken.foo" "bar-updated" #:replace)
     40         #t))
     41 (test-error "replace non-existent attribute (error)"
     42             (set-extended-attribute! file "chicken.foo" "bar-updated" #:update))
     43 (test "create non-existent attribute ok"
     44       #t
     45       (begin
     46         (set-extended-attribute! file "chicken.new" "new" #:create)
     47         #t))
     48 (test-error "create existing attribute (error)"
     49             (set-extended-attribute! file "chicken.new" "new" #:create))
    4550
    46 (remove-extended-attribute! file "chicken.foo")
    47 (test "three attributes after one removed"
    48       '("chicken.baz" "chicken.new" "chicken.zot")
    49       (sort (list-extended-attributes file) string<?))
     51 (remove-extended-attribute! file "chicken.foo")
     52 (test "three attributes after one removed"
     53       '("chicken.baz" "chicken.new" "chicken.zot")
     54       (sort (list-extended-attributes file) string<?))
    5055
    51 (for-each (lambda (x)
    52             (remove-extended-attribute! file x))
    53           (list-extended-attributes file))
    54 (test "remove remaining attributes"
    55       '()
    56       (sort (list-extended-attributes file) string<?))
     56 (create-symbolic-link file link)
     57 (set-extended-attribute! link "chicken.link" "nugget" #:no-follow)
     58 (test "get attributes, following link"
     59       (list "quux" #f)
     60       (list (get-extended-attribute link "chicken.baz")
     61             (get-extended-attribute link "chicken.link")))
     62 (test "get attributes, on link itself"
     63       (list #f "nugget")
     64       (list (get-extended-attribute link "chicken.baz"  #:no-follow)
     65             (get-extended-attribute link "chicken.link" #:no-follow)))
    5766
    58 (test-error "remove non-existent attribute (error)"
    59             (remove-extended-attribute! file "chicken.baz"))
     67 (for-each (lambda (x)
     68             (remove-extended-attribute! file x))
     69           (list-extended-attributes file))
     70 (test "remove remaining attributes"
     71       '()
     72       (sort (list-extended-attributes file) string<?))
     73
     74 (test-error "remove non-existent attribute (error)"
     75             (remove-extended-attribute! file "chicken.baz"))
     76
     77 (delete-file file)
     78 (delete-file link))
     79
     80;;; copyfile
     81
     82(test-group
     83 "copyfile"
     84
     85;; Untested: ACL preservation
     86;; Can't test on Tiger: copyfile data->data ; will segfault
     87
     88 (set! file (create-temporary-file "hfs-test"))
     89 (set! link (string-append file ".link")) ; meh
     90 (set! unpacked-file (create-temporary-file "hfs-test"))
     91 (define packed-file (string-append "._" file))
     92 (define packed-link (string-append "._" link))
     93 (set! unpacked-link-file (create-temporary-file "hfs-test"))
     94 (set! unpacked-link (string-append unpacked-link-file ".link"))
     95
     96 (test (string-append "set extended attributes on " file)
     97       #t
     98       (begin
     99         (set-extended-attribute! file "com.apple.ResourceFork" "spoon!")
     100         (set-extended-attribute! file "org.3e8.private" "eye")
     101         #t))
     102 (test (string-append "pack " file " to appledouble " packed-file)
     103       #t
     104       (pack-appledouble file packed-file))
     105 (test (string-append "unpack " file " to " unpacked-file)
     106       #t
     107       (unpack-appledouble packed-file unpacked-file))
     108 (test (string-append "recover resource fork from " unpacked-file)
     109       "spoon!"
     110       (get-extended-attribute unpacked-file "com.apple.ResourceFork"))
     111 (test (string-append "recover private attribute from " unpacked-file)
     112       "eye"
     113       (get-extended-attribute unpacked-file "org.3e8.private"))
     114
     115 (test (string-append "check attributes on " unpacked-file)
     116       '(xattr)
     117       (copyfile-check unpacked-file #:metadata))
     118
     119 ;; Attempt to copy attributes from a symbolic link to another symbolic link.
     120 ;; This will fail on 10.4, which does not honor no-follow on unpack/pack.
     121 ;; Set attributes on the links and backing files beforehand so we can
     122 ;; see what propagates through.
     123 (create-symbolic-link file link)
     124 (create-symbolic-link unpacked-link-file unpacked-link)
     125 (set-extended-attribute! link "org.3e8.private" "file")
     126 (set-extended-attribute! link "org.3e8.private" "link" #:no-follow)
     127 (set-extended-attribute! unpacked-link "org.3e8.private"
     128                          "unpacked-link" #:no-follow)
     129 (set-extended-attribute! unpacked-link-file "org.3e8.private"
     130                          "unpacked-link-file" #:no-follow)
     131 (pack-appledouble link packed-link #:no-follow)
     132 (unpack-appledouble packed-link unpacked-link #:no-follow)
     133 (test (string-append "recover private attribute from symlink (fails on 10.4)")
     134       "link"
     135       (get-extended-attribute unpacked-link "org.3e8.private" #:no-follow))
     136 (test (string-append "recover private attribute from backing file (fails on 10.4)")
     137       "unpacked-link-file"
     138       (get-extended-attribute link "org.3e8.private"))
     139 
     140 (delete-file file)
     141 (delete-file link)
     142 (delete-file unpacked-file)
     143 (delete-file unpacked-link)
     144 (delete-file unpacked-link-file)
     145 (delete-file packed-file)
     146 (delete-file packed-link))
     147
     148(test-group
     149 "unimplemented or untested"
     150 (test (string-append "copyfile #:data")
     151       0
     152       (error "cannot test data->data copyfile on Tiger, may segfault")))
    60153
    61154;;; further tests go here
    62 
    63 (delete-file file)
Note: See TracChangeset for help on using the changeset viewer.