aboutsummaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
Diffstat (limited to 'guix')
-rw-r--r--guix/build-system/python.scm2
-rw-r--r--guix/build/bournish.scm62
-rw-r--r--guix/build/emacs-build-system.scm11
-rw-r--r--guix/config.scm.in4
-rw-r--r--guix/gexp.scm6
-rw-r--r--guix/import/pypi.scm6
-rwxr-xr-xguix/scripts/substitute.scm28
-rw-r--r--guix/store.scm31
-rw-r--r--guix/utils.scm36
9 files changed, 132 insertions, 54 deletions
diff --git a/guix/build-system/python.scm b/guix/build-system/python.scm
index c3d6c62404..705943eb73 100644
--- a/guix/build-system/python.scm
+++ b/guix/build-system/python.scm
@@ -48,7 +48,7 @@
"Return a URI string for the Python package hosted on the Python Package
Index (PyPI) corresponding to NAME and VERSION. EXTENSION is the file name
extension, such as '.tar.gz'."
- (string-append "https://pypi.python.org/packages/source/"
+ (string-append "https://pypi.io/packages/source/"
(string-take name 1) "/" name "/"
name "-" version extension))
diff --git a/guix/build/bournish.scm b/guix/build/bournish.scm
index 1f17e0a22d..928bef5b9e 100644
--- a/guix/build/bournish.scm
+++ b/guix/build/bournish.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -25,6 +26,7 @@
#:use-module (ice-9 match)
#:use-module (ice-9 ftw)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:export (%bournish-language))
@@ -103,6 +105,63 @@ characters."
((@ (guix build utils) dump-port) port (current-output-port))
*unspecified*)))
+(define (lines+chars port)
+ "Return the number of lines and number of chars read from PORT."
+ (let loop ((lines 0) (chars 0))
+ (match (read-char port)
+ ((? eof-object?) ;done!
+ (values lines chars))
+ (#\newline ;recurse
+ (loop (1+ lines) (1+ chars)))
+ (_ ;recurse
+ (loop lines (1+ chars))))))
+
+(define (file-exists?* file)
+ "Like 'file-exists?' but emits a warning if FILE is not accessible."
+ (catch 'system-error
+ (lambda ()
+ (stat file))
+ (lambda args
+ (let ((errno (system-error-errno args)))
+ (format (current-error-port) "~a: ~a~%"
+ file (strerror errno))
+ #f))))
+
+(define (wc-print file)
+ (let-values (((lines chars)
+ (call-with-input-file file lines+chars)))
+ (format #t "~a ~a ~a~%" lines chars file)))
+
+(define (wc-l-print file)
+ (let-values (((lines chars)
+ (call-with-input-file file lines+chars)))
+ (format #t "~a ~a~%" lines file)))
+
+(define (wc-c-print file)
+ (let-values (((lines chars)
+ (call-with-input-file file lines+chars)))
+ (format #t "~a ~a~%" chars file)))
+
+(define (wc-command-implementation . files)
+ (for-each wc-print (filter file-exists?* files)))
+
+(define (wc-l-command-implementation . files)
+ (for-each wc-l-print (filter file-exists?* files)))
+
+(define (wc-c-command-implementation . files)
+ (for-each wc-c-print (filter file-exists?* files)))
+
+(define (wc-command . args)
+ "Emit code for the 'wc' command."
+ (cond ((member "-l" args)
+ `((@@ (guix build bournish) wc-l-command-implementation)
+ ,@(delete "-l" args)))
+ ((member "-c" args)
+ `((@@ (guix build bournish) wc-c-command-implementation)
+ ,@(delete "-c" args)))
+ (else
+ `((@@ (guix build bournish) wc-command-implementation) ,@args))))
+
(define (help-command . _)
(display "\
Hello, this is Bournish, a minimal Bourne-like shell in Guile!
@@ -129,7 +188,8 @@ commands such as 'ls' and 'cd'; it lacks globbing, pipes---everything.\n"))
("help" ,help-command)
("ls" ,ls-command)
("which" ,which-command)
- ("cat" ,cat-command)))
+ ("cat" ,cat-command)
+ ("wc" ,wc-command)))
(define (read-bournish port env)
"Read a Bournish expression from PORT, and return the corresponding Scheme
diff --git a/guix/build/emacs-build-system.scm b/guix/build/emacs-build-system.scm
index ab970012a7..44e8b0d31e 100644
--- a/guix/build/emacs-build-system.scm
+++ b/guix/build/emacs-build-system.scm
@@ -1,5 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
+;;; Copyright © 2016 David Thompson <davet@gnu.org>
+;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -152,10 +154,11 @@ store in '.el' files."
(define (emacs-inputs-el-directories dirs)
"Build the list of Emacs Lisp directories from the Emacs package directory
DIRS."
- (map (lambda (d)
- (string-append d %install-suffix "/"
- (store-directory->elpa-name-version d)))
- dirs))
+ (append-map (lambda (d)
+ (list (string-append d "/share/emacs/site-lisp")
+ (string-append d %install-suffix "/"
+ (store-directory->elpa-name-version d))))
+ dirs))
(define (package-name-version->elpa-name-version name-ver)
"Convert the Guix package NAME-VER to the corresponding ELPA name-version
diff --git a/guix/config.scm.in b/guix/config.scm.in
index d7df9f7d2b..adffa0cfec 100644
--- a/guix/config.scm.in
+++ b/guix/config.scm.in
@@ -59,8 +59,8 @@
(or (getenv "NIX_STATE_DIR") "@guix_localstatedir@/guix"))
(define %config-directory
- ;; This must match `NIX_CONF_DIR' as defined in `nix/local.mk'.
- (or (getenv "NIX_CONF_DIR") "@guix_sysconfdir@/guix"))
+ ;; This must match `GUIX_CONFIGURATION_DIRECTORY' as defined in `nix/local.mk'.
+ (or (getenv "GUIX_CONFIGURATION_DIRECTORY") "@guix_sysconfdir@/guix"))
(define %guix-register-program
;; The 'guix-register' program.
diff --git a/guix/gexp.scm b/guix/gexp.scm
index 2bf1013b3c..b929b79c26 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -856,8 +856,10 @@ and in the current monad setting (system type, etc.)"
(define %utils-module
;; This file provides 'mkdir-p', needed to implement 'imported-files' and
- ;; other primitives below.
- (local-file (search-path %load-path "guix/build/utils.scm")
+ ;; other primitives below. Note: We give the file name relative to this
+ ;; file you are currently reading; 'search-path' could return a file name
+ ;; relative to the current working directory.
+ (local-file "build/utils.scm"
"build-utils.scm"))
(define* (imported-files files
diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm
index 70ef507666..efa69081ef 100644
--- a/guix/import/pypi.scm
+++ b/guix/import/pypi.scm
@@ -175,8 +175,10 @@ cannot determine package dependencies"))
(lambda (port)
(let* ((metadata (json->scm port))
(run_requires (hash-ref metadata "run_requires"))
- (requirements (hash-ref (list-ref run_requires 0)
- "requires")))
+ (requirements (if run_requires
+ (hash-ref (list-ref run_requires 0)
+ "requires")
+ '())))
(map (lambda (r)
(python->package-name (clean-requirement r)))
requirements)))))
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 81ce770dc5..5722aa821d 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -94,10 +94,15 @@
;;; Code:
(define %narinfo-cache-directory
- ;; A local cache of narinfos, to avoid going to the network.
- (or (and=> (getenv "XDG_CACHE_HOME")
- (cut string-append <> "/guix/substitute"))
- (string-append %state-directory "/substitute/cache")))
+ ;; A local cache of narinfos, to avoid going to the network. Most of the
+ ;; time, 'guix substitute' is called by guix-daemon as root and stores its
+ ;; cached data in /var/guix/…. However, when invoked from 'guix challenge'
+ ;; as a user, it stores its cache in ~/.cache.
+ (if (zero? (getuid))
+ (or (and=> (getenv "XDG_CACHE_HOME")
+ (cut string-append <> "/guix/substitute"))
+ (string-append %state-directory "/substitute/cache"))
+ (string-append (cache-directory) "/substitute")))
(define %allow-unauthenticated-substitutes?
;; Whether to allow unchecked substitutes. This is useful for testing
@@ -501,17 +506,10 @@ indicates that PATH is unavailable at CACHE-URL."
(value ,(and=> narinfo narinfo->string))))
(let ((file (narinfo-cache-file cache-url path)))
- (catch 'system-error
- (lambda ()
- (mkdir-p (dirname file))
- (with-atomic-file-output file
- (lambda (out)
- (write (cache-entry cache-url narinfo) out))))
- (lambda args
- ;; We may not have write access to the local cache when called from an
- ;; unprivileged process such as 'guix challenge'.
- (unless (= EACCES (system-error-errno args))
- (apply throw args)))))
+ (mkdir-p (dirname file))
+ (with-atomic-file-output file
+ (lambda (out)
+ (write (cache-entry cache-url narinfo) out))))
narinfo)
diff --git a/guix/store.scm b/guix/store.scm
index a64016611d..276684e2fb 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -1061,24 +1061,19 @@ Return #t on success.
Use with care as it directly modifies the store! This is primarily meant to
be used internally by the daemon's build hook."
;; Currently this is implemented by calling out to the fine C++ blob.
- (catch 'system-error
- (lambda ()
- (let ((pipe (apply open-pipe* OPEN_WRITE %guix-register-program
- `(,@(if prefix
- `("--prefix" ,prefix)
- '())
- ,@(if state-directory
- `("--state-directory" ,state-directory)
- '())))))
- (and pipe
- (begin
- (format pipe "~a~%~a~%~a~%"
- path (or deriver "") (length references))
- (for-each (cut format pipe "~a~%" <>) references)
- (zero? (close-pipe pipe))))))
- (lambda args
- ;; Failed to run %GUIX-REGISTER-PROGRAM.
- #f)))
+ (let ((pipe (apply open-pipe* OPEN_WRITE %guix-register-program
+ `(,@(if prefix
+ `("--prefix" ,prefix)
+ '())
+ ,@(if state-directory
+ `("--state-directory" ,state-directory)
+ '())))))
+ (and pipe
+ (begin
+ (format pipe "~a~%~a~%~a~%"
+ path (or deriver "") (length references))
+ (for-each (cut format pipe "~a~%" <>) references)
+ (zero? (close-pipe pipe))))))
;;;
diff --git a/guix/utils.scm b/guix/utils.scm
index a642bd3d62..9e1b8ead0a 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -637,10 +637,11 @@ output port, and PROC's result is returned."
(define (cache-directory)
"Return the cache directory for Guix, by default ~/.cache/guix."
- (or (getenv "XDG_CONFIG_HOME")
- (and=> (or (getenv "HOME")
- (passwd:dir (getpwuid (getuid))))
- (cut string-append <> "/.cache/guix"))))
+ (string-append (or (getenv "XDG_CACHE_HOME")
+ (and=> (or (getenv "HOME")
+ (passwd:dir (getpwuid (getuid))))
+ (cut string-append <> "/.cache")))
+ "/guix"))
(define (readlink* file)
"Call 'readlink' until the result is not a symlink."
@@ -702,6 +703,18 @@ output port, and PROC's result is returned."
;;; Source location.
;;;
+(define (absolute-dirname file)
+ "Return the absolute name of the directory containing FILE, or #f upon
+failure."
+ (match (search-path %load-path file)
+ (#f #f)
+ ((? string? file)
+ ;; If there are relative names in %LOAD-PATH, FILE can be relative and
+ ;; needs to be canonicalized.
+ (if (string-prefix? "/" file)
+ (dirname file)
+ (canonicalize-path (dirname file))))))
+
(define-syntax current-source-directory
(lambda (s)
"Return the absolute name of the current directory, or #f if it could not
@@ -711,11 +724,16 @@ be determined."
(match (assq 'filename (syntax-source s))
(('filename . (? string? file-name))
;; If %FILE-PORT-NAME-CANONICALIZATION is 'relative, then FILE-NAME
- ;; can be relative. In that case, we try to find out the absolute
- ;; file name by looking at %LOAD-PATH.
- (if (string-prefix? "/" file-name)
- (dirname file-name)
- (and=> (search-path %load-path file-name) dirname)))
+ ;; can be relative. In that case, we try to find out at run time
+ ;; the absolute file name by looking at %LOAD-PATH; doing this at
+ ;; run time rather than expansion time is necessary to allow files
+ ;; to be moved on the file system.
+ (cond ((not file-name)
+ #f) ;raising an error would upset Geiser users
+ ((string-prefix? "/" file-name)
+ (dirname file-name))
+ (else
+ #`(absolute-dirname #,file-name))))
(_
#f))))))
generated by cgit v1.2.3 (git 2.45.0) at 2024-11-26 18:02:07 +0000