From patchwork Thu Mar 14 22:08:23 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Danny Milosavljevic X-Patchwork-Id: 1457 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id C6EEA16DA6; Thu, 14 Mar 2019 22:09:15 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.0 (2014-02-07) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00 autolearn=ham autolearn_force=no version=3.4.0 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTP id 509CC16D94 for ; Thu, 14 Mar 2019 22:09:15 +0000 (GMT) Received: from localhost ([127.0.0.1]:45778 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1h4YXK-0001Wu-DK for patchwork@mira.cbaines.net; Thu, 14 Mar 2019 18:09:14 -0400 Received: from eggs.gnu.org ([209.51.188.92]:59711) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1h4YXF-0001VD-Rl for guix-patches@gnu.org; Thu, 14 Mar 2019 18:09:11 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1h4YXB-0004oM-Tz for guix-patches@gnu.org; Thu, 14 Mar 2019 18:09:08 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:58840) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1h4YX8-0004l4-BT for guix-patches@gnu.org; Thu, 14 Mar 2019 18:09:04 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1h4YX8-0003RX-2q for guix-patches@gnu.org; Thu, 14 Mar 2019 18:09:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#34863] [WIP] syscalls: Add loop device interface. Resent-From: Danny Milosavljevic Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 14 Mar 2019 22:09:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 34863 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 34863@debbugs.gnu.org X-Debbugs-Original-To: guix-patches@gnu.org Received: via spool by submit@debbugs.gnu.org id=B.155260131913202 (code B ref -1); Thu, 14 Mar 2019 22:09:01 +0000 Received: (at submit) by debbugs.gnu.org; 14 Mar 2019 22:08:39 +0000 Received: from localhost ([127.0.0.1]:44151 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1h4YWl-0003Qr-Dc for submit@debbugs.gnu.org; Thu, 14 Mar 2019 18:08:39 -0400 Received: from eggs.gnu.org ([209.51.188.92]:45246) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1h4YWj-0003Qe-JZ for submit@debbugs.gnu.org; Thu, 14 Mar 2019 18:08:38 -0400 Received: from lists.gnu.org ([209.51.188.17]:53751) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1h4YWe-00049t-FE for submit@debbugs.gnu.org; Thu, 14 Mar 2019 18:08:32 -0400 Received: from eggs.gnu.org ([209.51.188.92]:59626) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1h4YWd-000177-1H for guix-patches@gnu.org; Thu, 14 Mar 2019 18:08:32 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1h4YWb-00044T-Pr for guix-patches@gnu.org; Thu, 14 Mar 2019 18:08:30 -0400 Received: from dd26836.kasserver.com ([85.13.145.193]:52142) by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1h4YWb-00041o-E7 for guix-patches@gnu.org; Thu, 14 Mar 2019 18:08:29 -0400 Received: from dayas.3.home (178.112.254.29.wireless.dyn.drei.com [178.112.254.29]) by dd26836.kasserver.com (Postfix) with ESMTPSA id 005F633606A9; Thu, 14 Mar 2019 23:08:26 +0100 (CET) From: Danny Milosavljevic Date: Thu, 14 Mar 2019 23:08:23 +0100 Message-Id: <20190314220823.30769-1-dannym@scratchpost.org> X-Mailer: git-send-email 2.20.1 MIME-Version: 1.0 Tags: patch X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6.x X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 209.51.188.43 X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * 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. --- guix/build/syscalls.scm | 130 +++++++++++++++++++++++++++++++++++++++- tests/syscalls.scm | 4 ++ 2 files changed, 133 insertions(+), 1 deletion(-) 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 ; + (identifier-syntax #x4C82)) + +;;; /dev/loopN + +(define-syntax LOOP_SET_FD ; + (identifier-syntax #x4C00)) + +(define-syntax LOOP_SET_STATUS64 ; + (identifier-syntax #x4C04)) + +(define-syntax LOOP_GET_STATUS64 ; + (identifier-syntax #x4C05)) + +(define-bits lo-flags ; + 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. ; +(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))