diff options
Diffstat (limited to 'guix')
| -rw-r--r-- | guix/build/syscalls.scm | 13 | ||||
| -rw-r--r-- | guix/nar.scm | 30 | ||||
| -rw-r--r-- | guix/scripts/system.scm | 2 |
3 files changed, 36 insertions, 9 deletions
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 00d8ceb480..4ee2b97e76 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -5,6 +5,7 @@ ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2019 Guillaume Le Vaillant <glv@posteo.net> ;;; Copyright © 2020 Julien Lepiller <julien@lepiller.eu> +;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -1205,6 +1206,8 @@ bytes." ;;; (define SIOCGIFCONF ;from <bits/ioctls.h> + ; <net/if.h> + ; <hurd/ioctl.h> (if (string-contains %host-type "linux") #x8912 ;GNU/Linux #xf00801a4)) ;GNU/Hurd @@ -1215,23 +1218,23 @@ bytes." (define SIOCSIFFLAGS (if (string-contains %host-type "linux") #x8914 ;GNU/Linux - -1)) ;FIXME: GNU/Hurd? + #x84804190)) ;GNU/Hurd (define SIOCGIFADDR (if (string-contains %host-type "linux") #x8915 ;GNU/Linux - -1)) ;FIXME: GNU/Hurd? + #xc08401a1)) ;GNU/Hurd (define SIOCSIFADDR (if (string-contains %host-type "linux") #x8916 ;GNU/Linux - -1)) ;FIXME: GNU/Hurd? + #x8084018c)) ;GNU/Hurd (define SIOCGIFNETMASK (if (string-contains %host-type "linux") #x891b ;GNU/Linux - -1)) ;FIXME: GNU/Hurd? + #xc08401a5)) ;GNU/Hurd (define SIOCSIFNETMASK (if (string-contains %host-type "linux") #x891c ;GNU/Linux - -1)) ;FIXME: GNU/Hurd? + #x80840196)) ;GNU/Hurd (define SIOCADDRT (if (string-contains %host-type "linux") #x890B ;GNU/Linux diff --git a/guix/nar.scm b/guix/nar.scm index 29636aa0f8..eff4becbce 100644 --- a/guix/nar.scm +++ b/guix/nar.scm @@ -82,10 +82,28 @@ REFERENCES and DERIVER. When LOCK? is true, acquire exclusive locks on TARGET before attempting to register it; otherwise, assume TARGET's locks are already held." + ;; TODO: make this reusable + (define (acquire-lock file) + (let ((port (lock-file file))) + ;; There is an inherent race condition between opening the lock file and + ;; attempting to acquire the lock on it, and because we like deleting + ;; these lock files when we release them, only the first successful + ;; acquisition on a given lock file matters. To make it easier to tell + ;; when an acquisition is and isn't the first, the first to acquire it + ;; writes a deletion token (arbitrary character) prior to releasing the + ;; lock. + (if (zero? (stat:size (stat port))) + port + ;; if FILE is non-empty, that's because it contains the deletion + ;; token, so we aren't the first to acquire it. So try again! + (begin + (close port) + (acquire-lock file))))) + (with-database %default-database-file db (unless (path-id db target) (let ((lock (and lock? - (lock-file (string-append target ".lock"))))) + (acquire-lock (string-append target ".lock"))))) (unless (path-id db target) ;; If FILE already exists, delete it (it's invalid anyway.) @@ -102,6 +120,12 @@ held." #:deriver deriver)) (when lock? + (delete-file (string-append target ".lock")) + ;; Write the deletion token to inform anyone who acquires the lock + ;; on this particular file next that they aren't the first to + ;; acquire it, so they should retry. + (display "d" lock) + (force-output lock) (unlock-file lock)))))) (define (temporary-store-file) @@ -114,8 +138,8 @@ held." (define-syntax-rule (with-temporary-store-file name body ...) "Evaluate BODY with NAME bound to the file name of a temporary store item protected from GC." - (let loop ((name (temporary-store-file))) - (with-store store + (with-store store + (let loop ((name (temporary-store-file))) ;; Add NAME to the current process' roots. (Opening this connection to ;; the daemon allows us to reuse its code that deals with the ;; per-process roots file.) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 3c8691a08c..3efd113ac8 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -700,7 +700,7 @@ checking this by themselves in their 'check' procedure." (size image-size) (operating-system os)))) ((docker-image) - (system-docker-image os)))) + (system-docker-image os #:shared-network? container-shared-network?)))) (define (maybe-suggest-running-guix-pull) "Suggest running 'guix pull' if this has never been done before." |