ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

syscalls: Add 'getxattr'.

Browse source 
* guix/build/syscalls.scm (getxattr): New procedure.
* tests/syscalls.scm ("getxattr, setxattr"): Test it, together with setxattr.
This commit is contained in:
Jan (janneke) Nieuwenhuizen 2020-05-14 00:30:57 +02:00 committed by Jan Nieuwenhuizen
parent 1a044e3936
commit df05842332
No known key found for this signature in database
GPG key ID: F3C1A0D9C1D65273
2 changed files with 35 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

27
guix/build/syscalls.scm
View file

@ -79,6 +79,7 @@ (define-module (guix build syscalls)
fdatasync
pivot-root
scandir*
getxattr
setxattr
fcntl-flock
@ -724,6 +725,32 @@ (define* (device-in-use? device)
(list (strerror err))
(list err))))))
(define getxattr
(let ((proc (syscall->procedure ssize_t "getxattr"
`(* * * ,size_t))))
(lambda (file key)
"Get the extended attribute value for KEY on FILE."
(let-values (((size err)
;; Get size of VALUE for buffer.
(proc (string->pointer/utf-8 file)
(string->pointer key)
(string->pointer "")
0)))
(cond ((< size 0) #f)
((zero? size) "")
;; Get VALUE in buffer of SIZE. XXX actual size can race.
(else (let*-values (((buf) (make-bytevector size))
((size err)
(proc (string->pointer/utf-8 file)
(string->pointer key)
(bytevector->pointer buf)
size)))
(if (>= size 0)
(utf8->string buf)
(throw 'system-error "getxattr" "~S: ~A"
(list file key (strerror err))
(list err))))))))))
(define setxattr
(let ((proc (syscall->procedure int "setxattr"
`(* * * ,size_t ,int))))

8
tests/syscalls.scm
View file

@ -270,6 +270,14 @@ (define perform-container-tests?
(scandir* directory)
(scandir directory (const #t) string<?))))
(false-if-exception (delete-file temp-file))
(test-assert "getxattr, setxattr"
(let ((key "user.translator")
(value "/hurd/pfinet\0")
(file (open-file temp-file "w0")))
(setxattr temp-file key value)
(string=? (getxattr temp-file key) value)))
(false-if-exception (delete-file temp-file))
(test-equal "fcntl-flock wait"
42 ; the child's exit status