| Message ID | 20190314220823.30769-1-dannym@scratchpost.org |
|---|---|
| State | Accepted |
| Headers | show |
| Series | [bug#34863,WIP] syscalls: Add loop device interface. | expand |
| Context | Check | Description |
|---|---|---|
| cbaines/applying patch | success | Successfully applied |
> +(define (set-loop-device-status loop-file status) > + (let ((buf (make-bytevector sizeof-loop-info64))) > + (apply write-loop-info64! buf status) ; TODO: Be more user-friendly. I don't know how instantiate a C structure given an assoc list. Help?
Hi! Danny Milosavljevic <dannym@scratchpost.org> skribis: >> +(define (set-loop-device-status loop-file status) >> + (let ((buf (make-bytevector sizeof-loop-info64))) >> + (apply write-loop-info64! buf status) ; TODO: Be more user-friendly. > > I don't know how instantiate a C structure given an assoc list. Help? You have to extract the fields from STATUS and then pass them in the right order to ‘write-loop-info64!’: (let-syntax ((field (syntax-rules () ((_ field) (assoc-ref status 'field))))) (write-loop-info64! buf (field lo-device) (field lo-inode) (field lo-rdevice) …)) However, given the number of fields, you might want to define a Scheme record type, as is done for ‘%statfs’ and <file-system>. HTH! Ludo’.
Hallo! Danny Milosavljevic <dannym@scratchpost.org> skribis: > * guix/build/syscalls.scm (%ioctl-unsigned-long): New procedure. > (LOOP_CTL_GET_FREE): New macro. > (LOOP_SET_FD): New macro. > (LOOP_SET_STATUS64): New macro. > (LOOP_GET_STATUS64): New macro. > (lo-flags): New bits. > (lo-flags->symbols): New procedure. > (LO_NAME_SIZE): New variable. > (LO_KEY_SIZE): New variable. > (%struct-loop-info64): New C structure. > (allocate-new-loop-device): New procedure. > (set-loop-device-backing-file): New procedure. > (get-loop-device-status): New procedure. > * tests/syscalls.scm: Add test. What will be the use for this? I prefer to make sure we only add code that is actually going to be used. :-) > +(define-c-struct %struct-loop-info64 > + sizeof-loop-info64 > + (lambda (lo-device lo-inode lo-rdevice lo-offset lo-sizelimit lo-number > + lo-encrypt-type lo-encrypt-key-size lo-flags lo-file-name > + lo-crypt-name lo-encrypt-key lo-init) > + `((lo-device . ,lo-device) > + (lo-inode . ,lo-inode) Like I wrote, a record may be more appropriate than an alist here. Also, no need to repeat ‘lo-’ in the parameter names. > +(define (allocate-new-loop-device control-file) > + "Allocates a new loop device and returns an FD for it. > +CONTROL-FILE should be an open file \"/dev/loop-control\". Nitpick: s/an FD/a file descriptor/ s/an open file/an open port for/ > + (open-io-file (string-append "/dev/loop" (number->string ret)))) I didn’t know about ‘open-io-file’ and indeed, it’s undocumented. So I’d suggest using ‘open-file’ instead to be on the safe side. > +(define (set-loop-device-backing-file loop-file backing-file) > + "Sets up the loop device LOOP-FILE for BACKING-FILE." Maybe the docstring should be: “Set BACKING-FILE, a port, as the backing file of LOOP-FILE, an open port to a loopback device.”? > + (let-values (((ret err) > + (%ioctl-unsigned-long (fileno loop-file) LOOP_SET_FD > + (fileno backing-file)))) Note that BACKING-FILE, the port, can be closed when it’s GC’d, which as a side effect would close its associated file descriptor. Is this OK or does the FD have to remain open for the lifetime of the loopback device? In the latter case you’d have to use ‘port->fdes’ instead of ‘fileno’ to increase the “revealed count” of the port. > +(define (get-loop-device-status loop-file) Please add a docstring. Also I’d remove ‘get-’. > +(define (set-loop-device-status loop-file status) Docstring! :-) > --- a/tests/syscalls.scm > +++ b/tests/syscalls.scm > @@ -564,6 +564,10 @@ > (let ((result (call-with-input-file "/var/run/utmpx" read-utmpx))) > (or (utmpx? result) (eof-object? result)))) > > +(let ((loop-device (allocate-new-loop-device (open-io-file "/dev/loop-control")))) > + (set-loop-device-backing-file loop-device (open-input-file "tests/syscalls.scm")) > + (set-loop-device-status loop-device (get-loop-device-status loop-device))) You’re missing a ‘test-assert’ or similar. Also, isn’t ‘loop-device’ a number? Then the ‘set-loop-device-*’ calls fail with wrong-type-arg, no? Thank you! Ludo’.
Hi Ludo :) On Sat, 16 Mar 2019 11:29:17 +0100 Ludovic Courtès <ludo@gnu.org> wrote: > What will be the use for this? I prefer to make sure we only add code > that is actually going to be used. :-) See "boot multiple Gnu/Linux Distributions from one USB key" on the guix-devel list. This would make it possible to loop-mount stuff at boot. > Like I wrote, a record may be more appropriate than an alist here. > Also, no need to repeat ‘lo-’ in the parameter names. Sure. > > +(define (allocate-new-loop-device control-file) > > + "Allocates a new loop device and returns an FD for it. > > +CONTROL-FILE should be an open file \"/dev/loop-control\". > > Nitpick: s/an FD/a file descriptor/ > s/an open file/an open port for/ > > > + (open-io-file (string-append "/dev/loop" (number->string ret)))) > > I didn’t know about ‘open-io-file’ and indeed, it’s undocumented. So > I’d suggest using ‘open-file’ instead to be on the safe side. Do you mean open-file ... "r+" ? >Note that BACKING-FILE, the port, can be closed when it’s GC’d, which as >a side effect would close its associated file descriptor. Is this OK or >does the FD have to remain open for the lifetime of the loopback device? I don't know, but guess it's okay for it to be closed again (the "losetup" process doesn't keep running for long either and the loop device is fine). > > +(let ((loop-device (allocate-new-loop-device (open-io-file "/dev/loop-control")))) > > + (set-loop-device-backing-file loop-device (open-input-file "tests/syscalls.scm")) > > + (set-loop-device-status loop-device (get-loop-device-status loop-device))) > > You’re missing a ‘test-assert’ or similar. What would I be asserting? I found no function to test whether an exception was raised or not (or to just assert that no exception was raised). So I resorted to that. >Also, isn’t ‘loop-device’ a > number? Then the ‘set-loop-device-*’ calls fail with wrong-type-arg, > no? It's actually a port now and the comment in allocate-new-loop-device is outdated.
Hello, Danny Milosavljevic <dannym@scratchpost.org> skribis: > On Sat, 16 Mar 2019 11:29:17 +0100 > Ludovic Courtès <ludo@gnu.org> wrote: > >> What will be the use for this? I prefer to make sure we only add code >> that is actually going to be used. :-) > > See "boot multiple Gnu/Linux Distributions from one USB key" on the guix-devel > list. This would make it possible to loop-mount stuff at boot. Oh OK (too much mail!). >> > + (open-io-file (string-append "/dev/loop" (number->string ret)))) >> >> I didn’t know about ‘open-io-file’ and indeed, it’s undocumented. So >> I’d suggest using ‘open-file’ instead to be on the safe side. > > Do you mean > > open-file ... "r+" > > ? Exactly. >>Note that BACKING-FILE, the port, can be closed when it’s GC’d, which as >>a side effect would close its associated file descriptor. Is this OK or >>does the FD have to remain open for the lifetime of the loopback device? > > I don't know, but guess it's okay for it to be closed again (the > "losetup" process doesn't keep running for long either and the loop device > is fine). It’d be good to double-check. :-) >> > +(let ((loop-device (allocate-new-loop-device (open-io-file "/dev/loop-control")))) >> > + (set-loop-device-backing-file loop-device (open-input-file "tests/syscalls.scm")) >> > + (set-loop-device-status loop-device (get-loop-device-status loop-device))) >> >> You’re missing a ‘test-assert’ or similar. > > What would I be asserting? I found no function to test whether an > exception was raised or not (or to just assert that no exception was > raised). So I resorted to that. Tests always need to be enclosed in a ‘test-XYZ’ form. Otherwise it’s code that’s evaluated as the top level and that’s not listed in the test log. So in this case, to check for a 'system-error exception, you could do, say: (test-equal "foo" ENOENT (catch 'system-error (lambda () … #f) (lambda args (system-error-errno args)))) There are examples of that in ‘tests/syscalls.scm’. HTH! Ludo’.
Ping! :-) Ludovic Courtès <ludo@gnu.org> skribis: > Hello, > > Danny Milosavljevic <dannym@scratchpost.org> skribis: > >> On Sat, 16 Mar 2019 11:29:17 +0100 >> Ludovic Courtès <ludo@gnu.org> wrote: >> >>> What will be the use for this? I prefer to make sure we only add code >>> that is actually going to be used. :-) >> >> See "boot multiple Gnu/Linux Distributions from one USB key" on the guix-devel >> list. This would make it possible to loop-mount stuff at boot. > > Oh OK (too much mail!). > >>> > + (open-io-file (string-append "/dev/loop" (number->string ret)))) >>> >>> I didn’t know about ‘open-io-file’ and indeed, it’s undocumented. So >>> I’d suggest using ‘open-file’ instead to be on the safe side. >> >> Do you mean >> >> open-file ... "r+" >> >> ? > > Exactly. > >>>Note that BACKING-FILE, the port, can be closed when it’s GC’d, which as >>>a side effect would close its associated file descriptor. Is this OK or >>>does the FD have to remain open for the lifetime of the loopback device? >> >> I don't know, but guess it's okay for it to be closed again (the >> "losetup" process doesn't keep running for long either and the loop device >> is fine). > > It’d be good to double-check. :-) > >>> > +(let ((loop-device (allocate-new-loop-device (open-io-file "/dev/loop-control")))) >>> > + (set-loop-device-backing-file loop-device (open-input-file "tests/syscalls.scm")) >>> > + (set-loop-device-status loop-device (get-loop-device-status loop-device))) >>> >>> You’re missing a ‘test-assert’ or similar. >> >> What would I be asserting? I found no function to test whether an >> exception was raised or not (or to just assert that no exception was >> raised). So I resorted to that. > > Tests always need to be enclosed in a ‘test-XYZ’ form. Otherwise it’s > code that’s evaluated as the top level and that’s not listed in the test > log. > > So in this case, to check for a 'system-error exception, you could do, say: > > (test-equal "foo" > ENOENT > (catch 'system-error > (lambda () … #f) > (lambda args > (system-error-errno args)))) > > There are examples of that in ‘tests/syscalls.scm’. > > HTH! > > Ludo’.
Ping! :-) Ludovic Courtès <ludo@gnu.org> skribis: > Hello, > > Danny Milosavljevic <dannym@scratchpost.org> skribis: > >> On Sat, 16 Mar 2019 11:29:17 +0100 >> Ludovic Courtès <ludo@gnu.org> wrote: >> >>> What will be the use for this? I prefer to make sure we only add code >>> that is actually going to be used. :-) >> >> See "boot multiple Gnu/Linux Distributions from one USB key" on the guix-devel >> list. This would make it possible to loop-mount stuff at boot. > > Oh OK (too much mail!). > >>> > + (open-io-file (string-append "/dev/loop" (number->string ret)))) >>> >>> I didn’t know about ‘open-io-file’ and indeed, it’s undocumented. So >>> I’d suggest using ‘open-file’ instead to be on the safe side. >> >> Do you mean >> >> open-file ... "r+" >> >> ? > > Exactly. > >>>Note that BACKING-FILE, the port, can be closed when it’s GC’d, which as >>>a side effect would close its associated file descriptor. Is this OK or >>>does the FD have to remain open for the lifetime of the loopback device? >> >> I don't know, but guess it's okay for it to be closed again (the >> "losetup" process doesn't keep running for long either and the loop device >> is fine). > > It’d be good to double-check. :-) > >>> > +(let ((loop-device (allocate-new-loop-device (open-io-file "/dev/loop-control")))) >>> > + (set-loop-device-backing-file loop-device (open-input-file "tests/syscalls.scm")) >>> > + (set-loop-device-status loop-device (get-loop-device-status loop-device))) >>> >>> You’re missing a ‘test-assert’ or similar. >> >> What would I be asserting? I found no function to test whether an >> exception was raised or not (or to just assert that no exception was >> raised). So I resorted to that. > > Tests always need to be enclosed in a ‘test-XYZ’ form. Otherwise it’s > code that’s evaluated as the top level and that’s not listed in the test > log. > > So in this case, to check for a 'system-error exception, you could do, say: > > (test-equal "foo" > ENOENT > (catch 'system-error > (lambda () … #f) > (lambda args > (system-error-errno args)))) > > There are examples of that in ‘tests/syscalls.scm’. > > HTH! > > Ludo’.
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 66d63a2931..a828aa18e2 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -155,7 +155,12 @@ utmpx-address login-type utmpx-entries - (read-utmpx-from-port . read-utmpx))) + (read-utmpx-from-port . read-utmpx) + + allocate-new-loop-device + set-loop-device-backing-file + get-loop-device-status + set-loop-device-status)) ;;; Commentary: ;;; @@ -1237,6 +1242,10 @@ bytevector BV at INDEX." ;; The most terrible interface, live from Scheme. (syscall->procedure int "ioctl" (list int unsigned-long '*))) +(define %ioctl-unsigned-long + ;; The most terrible interface, live from Scheme. + (syscall->procedure int "ioctl" (list int unsigned-long unsigned-long))) + (define (bytes->string bytes) "Read BYTES, a list of bytes, and return the null-terminated string decoded from there, or #f if that would be an empty string." @@ -1953,4 +1962,123 @@ entry." ((? bytevector? bv) (read-utmpx bv)))) +;;; Loopback device setup. + +;;; /dev/loop-control + +(define-syntax LOOP_CTL_GET_FREE ;<uapi/linux/loop.h> + (identifier-syntax #x4C82)) + +;;; /dev/loopN + +(define-syntax LOOP_SET_FD ;<uapi/linux/loop.h> + (identifier-syntax #x4C00)) + +(define-syntax LOOP_SET_STATUS64 ;<uapi/linux/loop.h> + (identifier-syntax #x4C04)) + +(define-syntax LOOP_GET_STATUS64 ;<uapi/linux/loop.h> + (identifier-syntax #x4C05)) + +(define-bits lo-flags ;<uapi/linux/loop.h> + lo-flags->symbols + (define LO_FLAGS_READ_ONLY 1) + (define LO_FLAGS_AUTOCLEAR 4) + (define LO_FLAGS_PARTSCAN 8) + (define LO_FLAGS_DIRECT_IO 16)) + +(define LO_NAME_SIZE 64) +(define LO_KEY_SIZE 32) + +;; 'struct loop_info64' for GNU/Linux. ;<uapi/linux/loop.h> +(define-c-struct %struct-loop-info64 + sizeof-loop-info64 + (lambda (lo-device lo-inode lo-rdevice lo-offset lo-sizelimit lo-number + lo-encrypt-type lo-encrypt-key-size lo-flags lo-file-name + lo-crypt-name lo-encrypt-key lo-init) + `((lo-device . ,lo-device) + (lo-inode . ,lo-inode) + (lo-rdevice . ,lo-rdevice) + (lo-offset . ,lo-offset) + (lo-sizelimit . ,lo-sizelimit) + (lo-number . ,lo-number) + (lo-encrypt-type . ,lo-encrypt-type) + (lo-encrypt-key-size . ,lo-encrypt-key-size) + (lo-flags . ,(lo-flags->symbols lo-flags)) + (lo-file-name . ,(bytes->string lo-file-name)) + (lo-crypt-name . ,(bytes->string lo-crypt-name)) + (lo-encrypt-key . ,(bytes->string lo-encrypt-key)) + (lo-init . ,lo-init))) + read-loop-info64 + write-loop-info64! + (lo-device uint64) ; ioctl r/o + (lo-inode uint64) ; ioctl r/o + (lo-rdevice uint64) ; ioctl r/o + (lo-offset uint64) + (lo-sizelimit uint64) ; Bytes; 0 == max available. + (lo-number uint32) ; ioctl r/o + (lo-encrypt-type uint32) + (lo-encrypt-key-size uint32) ; ioctl w/o + (lo-flags uint32) + (lo-file-name (array uint8 LO_NAME_SIZE)) + (lo-crypt-name (array uint8 LO_NAME_SIZE)) + (lo-encrypt-key (array uint8 LO_KEY_SIZE)) + (lo-init (array uint64 2))) + +(define (allocate-new-loop-device control-file) + "Allocates a new loop device and returns an FD for it. +CONTROL-FILE should be an open file \"/dev/loop-control\". +The result is a number to be appended to the name \"/dev/loop\" in order to +find the loop device." + (let-values (((ret err) + (%ioctl (fileno control-file) + LOOP_CTL_GET_FREE %null-pointer))) + (cond + ((>= ret 0) + (open-io-file (string-append "/dev/loop" (number->string ret)))) + (else + (throw 'system-error "ioctl" "~A" + (list (strerror err)) + (list err)))))) + +(define (set-loop-device-backing-file loop-file backing-file) + "Sets up the loop device LOOP-FILE for BACKING-FILE." + (let-values (((ret err) + (%ioctl-unsigned-long (fileno loop-file) LOOP_SET_FD + (fileno backing-file)))) + (cond + ((>= ret 0) + #t) + (else + (throw 'system-error "ioctl" "~A" + (list (strerror err)) + (list err)))))) + +(define (get-loop-device-status loop-file) + (let*-values (((buf) (make-bytevector sizeof-loop-info64)) + ((ret err) + (%ioctl (fileno loop-file) + LOOP_GET_STATUS64 (bytevector->pointer buf)))) + (cond + ((= ret 0) + (read-loop-info64 buf)) + (else + (throw 'system-error "ioctl" "~A" + (list (strerror err)) + (list err)))))) + +(define (set-loop-device-status loop-file status) + (let ((buf (make-bytevector sizeof-loop-info64))) + (apply write-loop-info64! buf status) ; TODO: Be more user-friendly. + (let-values (((ret err) (%ioctl (fileno loop-file) + LOOP_SET_STATUS64 + (bytevector->pointer buf)))) + (cond + ((= ret 0) + #t) + (else + (throw 'system-error "ioctl" "~A" + (list (strerror err)) + (list err))))))) + ;;; syscalls.scm ends here diff --git a/tests/syscalls.scm b/tests/syscalls.scm index 3e267c9f01..57b63421b0 100644 --- a/tests/syscalls.scm +++ b/tests/syscalls.scm @@ -564,6 +564,10 @@ (let ((result (call-with-input-file "/var/run/utmpx" read-utmpx))) (or (utmpx? result) (eof-object? result)))) +(let ((loop-device (allocate-new-loop-device (open-io-file "/dev/loop-control")))) + (set-loop-device-backing-file loop-device (open-input-file "tests/syscalls.scm")) + (set-loop-device-status loop-device (get-loop-device-status loop-device))) + (test-end) (false-if-exception (delete-file temp-file))