From 3ae5c9f2a78ce85beceb7467479c741e4c046830 Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Thu, 30 Oct 2025 16:19:51 +0900 Subject: [PATCH] Revert "syscalls: Add mmap support." This reverts commit e1994a021437b3fd73089c08d7e8db876fad698d. --- Makefile.am | 1 - guix/build/io.scm | 58 --------------------- guix/build/syscalls.scm | 112 +--------------------------------------- tests/syscalls.scm | 70 +------------------------ 4 files changed, 3 insertions(+), 238 deletions(-) delete mode 100644 guix/build/io.scm diff --git a/Makefile.am b/Makefile.am index a6c2e73388f..a4e7277d6d4 100644 --- a/Makefile.am +++ b/Makefile.am @@ -265,7 +265,6 @@ MODULES = \ guix/build/kconfig.scm \ guix/build/linux-module-build-system.scm \ guix/build/store-copy.scm \ - guix/build/io.scm \ guix/build/json.scm \ guix/build/pack.scm \ guix/build/utils.scm \ diff --git a/guix/build/io.scm b/guix/build/io.scm deleted file mode 100644 index 1dddbf239cb..00000000000 --- a/guix/build/io.scm +++ /dev/null @@ -1,58 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2025 Maxim Cournoyer -;;; -;;; This file is part of GNU Guix. -;;; -;;; GNU Guix is free software; you can redistribute it and/or modify it -;;; under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 3 of the License, or (at -;;; your option) any later version. -;;; -;;; GNU Guix is distributed in the hope that it will be useful, but -;;; WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with GNU Guix. If not, see . - -(define-module (guix build io) - #:use-module (guix build syscalls) - #:use-module (ice-9 format) - #:use-module (rnrs bytevectors) - #:use-module (rnrs io ports) - #:use-module (system foreign) - #:export (file->bytevector) - ;; For convenience. - #:re-export (PROT_READ - PROT_NONE - PROT_READ - PROT_WRITE - PROT_EXEC - PROT_SEM - MAP_SHARED - MAP_PRIVATE - MAP_FAILED - munmap)) - -;;; -;;; Memory mapped files. -;;; - -(define* (file->bytevector file #:key - (protection PROT_READ) - (flags (if (logtest PROT_WRITE protection) - MAP_SHARED - MAP_PRIVATE)) - (offset 0)) - "Return a bytevector object that is backed by a memory mapped FILE. This -avoids eagerly copying the full file contents into memory, instead letting the -kernel lazily page it in on demand. The underlying memory map is -automatically unmapped when the bytevector is no longer referenced." - (let* ((mode (format #f "rb~:[~;+~]" (and (logtest PROT_WRITE protection) - (logtest MAP_SHARED flags)))) - (port (open-file file mode))) - (call-with-port port - (lambda (port) - (mmap (fileno port) (- (stat:size (stat file)) offset) - #:protection protection #:flags flags #:offset offset))))) diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index ef678754706..d40b1ae5d93 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -42,23 +42,8 @@ #:use-module (ice-9 regex) #:use-module (ice-9 match) #:use-module (ice-9 ftw) - #:export (PROT_NONE - PROT_READ - PROT_WRITE - PROT_EXEC - PROT_SEM - MAP_SHARED - MAP_PRIVATE - MAP_FAILED - mmap - munmap - - MS_ASYNC - MS_INVALIDATE - MS_SYNC - msync - - MS_RDONLY + #:use-module (ice-9 threads) + #:export (MS_RDONLY MS_NOSUID MS_NODEV MS_NOEXEC @@ -1121,99 +1106,6 @@ backend device." (list file key value (strerror err)) (list err))))))) - -;;; -;;; Memory maps. -;;; - -;;; Constants from -(define PROT_NONE #x0) ;page can not be accessed -(define PROT_READ #x1) ;page can be read -(define PROT_WRITE #x2) ;page can be written -(define PROT_EXEC #x4) ;page can be executed -(define PROT_SEM #x8) ;page can be used for atomic operations - -(define MAP_SHARED #x01) ;share changes with other processes -(define MAP_PRIVATE #x02) ;private copy-on-write mapping -(define MAP_FAILED #xffffffffffffffff) ;mmap failure sentinel - -(define %mmap - (syscall->procedure '* "mmap" (list '* size_t int int int long))) - -(define %mmap-guardian - (make-guardian)) - -(define %unmapped-bytevectors - (make-weak-key-hash-table)) - -(define (unmapped-bytevector? bv) - "True if the bytevector BV was already munmap'd." - (hashq-ref %unmapped-bytevectors bv #f)) - -(define (pump-mmap-guardian) - (let ((bv (%mmap-guardian))) - (when bv - (if (unmapped-bytevector? bv) - (hashq-remove! %unmapped-bytevectors bv) - (munmap bv)) - (pump-mmap-guardian)))) - -(add-hook! after-gc-hook pump-mmap-guardian) - -(define* (mmap fd len #:key - (protection PROT_READ) - (flags (if (logtest PROT_WRITE protection) - MAP_SHARED - MAP_PRIVATE)) - (offset 0)) - "Return a bytevector to a memory-mapped region of length LEN bytes -for the open file descriptor FD. The mapping is created with the given memory -PROTECTION and FLAGS, biwise-or of PROT_* and MAP_* constants which -determine whether updates are visible to other processes and/or carried -through to the underlying file. Raise a 'system-error' exception on error. -The memory is automatically unmapped with `munmap' when the bytevector object -is no longer referenced." - (let-values (((ptr err) (%mmap %null-pointer len protection flags fd offset))) - (when (= MAP_FAILED (pointer-address ptr)) - (throw 'system-error "mmap" "mmap ~S with len ~S: ~A" - (list fd len (strerror err)) - (list err))) - (let ((bv (pointer->bytevector ptr len))) - (%mmap-guardian bv) - bv))) - -(define %munmap - (syscall->procedure int "munmap" (list '* size_t))) - -(define (munmap bv) - "Unmap the memory region described by BV, a bytevector object." - (let*-values (((ptr) (bytevector->pointer bv)) - ((len) (bytevector-length bv)) - ((ret err) (%munmap ptr len))) - (unless (zero? ret) - (throw 'system-error "munmap" "munmap ~S with len ~S: ~A" - (list ptr len (strerror err)) - (list err))) - (hashq-set! %unmapped-bytevectors bv #t))) - -(define MS_ASYNC 1) ;sync memory asynchronously -(define MS_INVALIDATE 2) ;invalidate the caches -(define MS_SYNC 4) ;synchronous memory sync - -(define %msync - (syscall->procedure int "msync" (list '* size_t int))) - -(define* (msync bv #:key (flags MS_SYNC)) - "Flush changes made to the in-core copy of a file that was mapped into memory -using `mmap' back to the file system." - (let*-values (((ptr) (bytevector->pointer bv)) - ((len) (bytevector-length bv)) - ((ret err) (%msync ptr len flags))) - (unless (zero? ret) - (throw 'system-error "msync" "msync ~S with len ~S: ~A" - (list ptr len (strerror err)) - (list err))))) - ;;; ;;; Random. diff --git a/tests/syscalls.scm b/tests/syscalls.scm index 1ea49b0acc4..a0483e68f08 100644 --- a/tests/syscalls.scm +++ b/tests/syscalls.scm @@ -22,11 +22,8 @@ (define-module (test-syscalls) #:use-module (guix utils) - #:use-module (guix build io) #:use-module (guix build syscalls) - #:use-module (guix build utils) #:use-module (gnu build linux-container) - #:use-module (rnrs bytevectors) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (srfi srfi-64) @@ -34,7 +31,7 @@ #:use-module (system foreign) #:use-module ((ice-9 ftw) #:select (scandir)) #:use-module (ice-9 match) - #:use-module (ice-9 textual-ports)) + #:use-module (ice-9 threads)) ;; Test the (guix build syscalls) module, although there's not much that can ;; actually be tested without being root. @@ -42,9 +39,6 @@ (define temp-file (string-append "t-utils-" (number->string (getpid)))) -(define strace-output - (string-append "t-utils-strace" (number->string (getpid)))) - (test-begin "syscalls") @@ -741,68 +735,6 @@ (member (system-error-errno args) (list EPERM ENOSYS))))) -(test-assert "mmap and munmap" - (begin - (call-with-output-file temp-file - (lambda (p) - (display "abcdefghij"))) - (let* ((len 5) - (bv (mmap (open-fdes temp-file O_RDONLY) len))) - (munmap bv)))) - -(test-equal "file->bytevector, reading" - #\6 - (begin - (call-with-output-file temp-file - (lambda (p) - (display "0123456789\n" p))) - (sync) - (integer->char - (bytevector-u8-ref (file->bytevector temp-file) 6)))) - -(test-equal "file->bytevector, writing" - "0000000700" - (begin - (call-with-output-file temp-file - (lambda (p) - (display "0000000000" p))) - (sync) - (let ((bv (file->bytevector temp-file - #:protection PROT_WRITE))) - - (bytevector-u8-set! bv 7 (char->integer #\7)) - (msync bv)) ;ensure the file gets written - (call-with-input-file temp-file get-string-all))) - -(unless (which "strace") - (test-skip 1)) -;;; This test currently fails, due to protected items in a guardian being -;;; dropped from weak hash tables (see: -;;; ). -(test-expect-fail 1) -(test-equal "manual munmap does not lead to double free" - 1 ;single munmap call - (begin - (call-with-output-file temp-file - (lambda (p) - (display "something interesting\n" p))) - (sync) - (gc) - (system (string-append "strace -o " strace-output - " -p " (number->string (getpid)) - " -e trace=munmap &")) - (sleep 1) ;allow strace to start - (let ((bv (file->bytevector temp-file))) - (munmap bv)) - (gc) - (sync) - (let ((text (call-with-input-file strace-output get-string-all))) - ;; The address seen by strace is not the same as the one seen by Guile, - ;; so we can't use it in the pattern. - (length (filter (cut string-prefix? "munmap(0x" <>) - (string-split text #\newline)))))) - (test-end) (false-if-exception (delete-file temp-file)) -(false-if-exception (delete-file strace-output))