diff options
| author | Jan (janneke) Nieuwenhuizen <janneke@gnu.org> | 2020-05-14 00:30:57 +0200 |
|---|---|---|
| committer | Jan Nieuwenhuizen <janneke@gnu.org> | 2020-05-14 00:48:12 +0200 |
| commit | df05842332be80ed7f53022402b95cf711163b41 (patch) | |
| tree | 8626f5f1eb82a74369cd1269f75dc13603d84c39 | |
| parent | 1a044e3936ac4c1ba1575fe791bf59577b039cf9 (diff) | |
syscalls: Add 'getxattr'.
* guix/build/syscalls.scm (getxattr): New procedure.
* tests/syscalls.scm ("getxattr, setxattr"): Test it, together with setxattr.
| -rw-r--r-- | guix/build/syscalls.scm | 27 | ||||
| -rw-r--r-- | tests/syscalls.scm | 8 |
2 files changed, 35 insertions, 0 deletions
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 3bb4545c04f..ff008c5b78d 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm | |||
| @@ -79,6 +79,7 @@ | |||
| 79 | fdatasync | 79 | fdatasync |
| 80 | pivot-root | 80 | pivot-root |
| 81 | scandir* | 81 | scandir* |
| 82 | getxattr | ||
| 82 | setxattr | 83 | setxattr |
| 83 | 84 | ||
| 84 | fcntl-flock | 85 | fcntl-flock |
| @@ -724,6 +725,32 @@ backend device." | |||
| 724 | (list (strerror err)) | 725 | (list (strerror err)) |
| 725 | (list err)))))) | 726 | (list err)))))) |
| 726 | 727 | ||
| 728 | (define getxattr | ||
| 729 | (let ((proc (syscall->procedure ssize_t "getxattr" | ||
| 730 | `(* * * ,size_t)))) | ||
| 731 | (lambda (file key) | ||
| 732 | "Get the extended attribute value for KEY on FILE." | ||
| 733 | (let-values (((size err) | ||
| 734 | ;; Get size of VALUE for buffer. | ||
| 735 | (proc (string->pointer/utf-8 file) | ||
| 736 | (string->pointer key) | ||
| 737 | (string->pointer "") | ||
| 738 | 0))) | ||
| 739 | (cond ((< size 0) #f) | ||
| 740 | ((zero? size) "") | ||
| 741 | ;; Get VALUE in buffer of SIZE. XXX actual size can race. | ||
| 742 | (else (let*-values (((buf) (make-bytevector size)) | ||
| 743 | ((size err) | ||
| 744 | (proc (string->pointer/utf-8 file) | ||
| 745 | (string->pointer key) | ||
| 746 | (bytevector->pointer buf) | ||
| 747 | size))) | ||
| 748 | (if (>= size 0) | ||
| 749 | (utf8->string buf) | ||
| 750 | (throw 'system-error "getxattr" "~S: ~A" | ||
| 751 | (list file key (strerror err)) | ||
| 752 | (list err)))))))))) | ||
| 753 | |||
| 727 | (define setxattr | 754 | (define setxattr |
| 728 | (let ((proc (syscall->procedure int "setxattr" | 755 | (let ((proc (syscall->procedure int "setxattr" |
| 729 | `(* * * ,size_t ,int)))) | 756 | `(* * * ,size_t ,int)))) |
diff --git a/tests/syscalls.scm b/tests/syscalls.scm index 7fe0cd15456..3823de7c1e0 100644 --- a/tests/syscalls.scm +++ b/tests/syscalls.scm | |||
| @@ -271,6 +271,14 @@ | |||
| 271 | (scandir directory (const #t) string<?)))) | 271 | (scandir directory (const #t) string<?)))) |
| 272 | 272 | ||
| 273 | (false-if-exception (delete-file temp-file)) | 273 | (false-if-exception (delete-file temp-file)) |
| 274 | (test-assert "getxattr, setxattr" | ||
| 275 | (let ((key "user.translator") | ||
| 276 | (value "/hurd/pfinet\0") | ||
| 277 | (file (open-file temp-file "w0"))) | ||
| 278 | (setxattr temp-file key value) | ||
| 279 | (string=? (getxattr temp-file key) value))) | ||
| 280 | |||
| 281 | (false-if-exception (delete-file temp-file)) | ||
| 274 | (test-equal "fcntl-flock wait" | 282 | (test-equal "fcntl-flock wait" |
| 275 | 42 ; the child's exit status | 283 | 42 ; the child's exit status |
| 276 | (let ((file (open-file temp-file "w0b"))) | 284 | (let ((file (open-file temp-file "w0b"))) |
