Changeset 15278 in project
- Timestamp:
- 07/31/09 00:49:53 (12 years ago)
- Location:
- release/4/hfs+/trunk
- Files:
-
- 1 added
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
release/4/hfs+/trunk/hfs+.meta
r14881 r15278 7 7 (doc-from-wiki) 8 8 (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 1 1 ;;; HFS+ extended attribute interface 2 2 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 3 7 #> #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" 4 11 #include <errno.h> 5 12 <# … … 21 28 remove-extended-attribute! 22 29 get-extended-attributes 23 clear-extended-attributes!) 30 clear-extended-attributes! 31 copyfile copyfile-check 32 pack-appledouble unpack-appledouble) 24 33 25 34 (import scheme chicken foreign) … … 58 67 (foreign-lambda int fremovexattr int (const c-string) int)) 59 68 69 (define _copyfile 70 (foreign-lambda int copyfile (const c-string) (const c-string) c-pointer int)) 71 60 72 (define-foreign-enum-type (xattr-options int) 61 73 (xattr-options->int int->xattr-options) … … 64 76 ((replace xattr/replace) XATTR_REPLACE) 65 77 ((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 :) 66 99 ) 67 100 … … 82 115 (define errno/exist (foreign-value "EEXIST" int)) 83 116 84 ;;; Base API 117 ;;; Base API - Extended attributes 85 118 86 119 ;; Accepted options: #:no-follow (or 'no-follow) to prevent following symlink; if passing … … 203 236 (void)))))) 204 237 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 205 255 ;;; Utilities 206 256 … … 223 273 ;; ...) 224 274 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)))))) 225 304 226 305 ) -
release/4/hfs+/trunk/hfs+.setup
r15012 r15278 4 4 'foreigners 5 5 '("hfs+.so" "hfs+.import.so") 6 '((version 0. 2)))6 '((version 0.3))) -
release/4/hfs+/trunk/test.scm
r14881 r15278 4 4 (use hfs+) 5 5 (use files) 6 (use posix) 6 7 7 8 ;; Assumes UNIX files are created with no attributes. 8 ;; Untested: NOFOLLOW. Setting resource forks.Finder info. Removing resource forks9 ;; ( evidentlymust set to "").9 ;; Untested: Finder info. Removing resource forks 10 ;; (must set to ""). 10 11 11 (define file (create-temporary-file "hfs-test")) 12 (test-group 13 "extended-attribute handling" 12 14 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)) 16 21 17 22 ;; (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") 21 26 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"))) 30 35 31 (test "replace existing attribute"32 #t33 (begin34 (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 #t40 (begin41 (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)) 45 50 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<?)) 50 55 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))) 57 66 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"))) 60 153 61 154 ;;; further tests go here 62 63 (delete-file file)
Note: See TracChangeset
for help on using the changeset viewer.