diff options
Diffstat (limited to 'guix')
-rw-r--r-- | guix/build/qt-utils.scm | 2 | ||||
-rw-r--r-- | guix/download.scm | 10 | ||||
-rw-r--r-- | guix/git.scm | 2 | ||||
-rw-r--r-- | guix/gnu-maintenance.scm | 6 | ||||
-rw-r--r-- | guix/graph.scm | 36 | ||||
-rw-r--r-- | guix/import/texlive.scm | 9 | ||||
-rw-r--r-- | guix/inferior.scm | 57 | ||||
-rw-r--r-- | guix/profiles.scm | 2 | ||||
-rw-r--r-- | guix/scripts/home.scm | 4 | ||||
-rw-r--r-- | guix/scripts/pull.scm | 20 | ||||
-rw-r--r-- | guix/scripts/refresh.scm | 31 | ||||
-rw-r--r-- | guix/scripts/system.scm | 2 | ||||
-rw-r--r-- | guix/scripts/time-machine.scm | 46 | ||||
-rw-r--r-- | guix/ssh.scm | 5 | ||||
-rw-r--r-- | guix/ui.scm | 16 |
15 files changed, 194 insertions, 54 deletions
diff --git a/guix/build/qt-utils.scm b/guix/build/qt-utils.scm index f52e3f7af5..7d1b0e0e23 100644 --- a/guix/build/qt-utils.scm +++ b/guix/build/qt-utils.scm @@ -90,7 +90,7 @@ '("XDG_CONFIG_DIRS" suffix directory "/etc/xdg") `("QT_PLUGIN_PATH" prefix directory ,(format #f "/lib/qt~a/plugins" qt-major-version)) - `("QML2_IMPORT_PATH" = directory + `("QML2_IMPORT_PATH" prefix directory ,(format #f "/lib/qt~a/qml" qt-major-version)) ;; QTWEBENGINEPROCESS_PATH accepts a single value, which makes 'exact the ;; most suitable environment variable type for it. diff --git a/guix/download.scm b/guix/download.scm index 30d7c5a86e..ce6ebd0df8 100644 --- a/guix/download.scm +++ b/guix/download.scm @@ -358,7 +358,15 @@ "https://mirror.esc7.net/pub/OpenBSD/") (mate "https://pub.mate-desktop.org/releases/" - "http://pub.mate-desktop.org/releases/")))) + "http://pub.mate-desktop.org/releases/") + (qt + "https://mirrors.ocf.berkeley.edu/qt/official_releases/" + "https://ftp.jaist.ac.jp/pub/qtproject/official_releases/" + "https://ftp.nluug.nl/languages/qt/official_releases/" + "https://mirrors.cloud.tencent.com/qt/official_releases/" + "https://mirrors.sjtug.sjtu.edu.cn/qt/official_releases/" + "https://qtproject.mirror.liquidtelecom.com/official_releases/" + "https://download.qt.io/official_releases/")))) ;slow (define %mirror-file ;; Copy of the list of mirrors to a file. This allows us to keep a single diff --git a/guix/git.scm b/guix/git.scm index be20cde019..dbc3b7caa7 100644 --- a/guix/git.scm +++ b/guix/git.scm @@ -439,7 +439,7 @@ could not be fetched from Software Heritage~%") #:recursive? recursive?))) "Update the cached checkout of URL to REF in CACHE-DIRECTORY. Return three values: the cache directory name, and the SHA1 commit (a string) corresponding -to REF, and the relation of the new commit relative to STARTING-COMMIT (if +to REF, and the relation of STARTING-COMMIT relative to the new commit (if provided) as returned by 'commit-relation'. REF is pair whose key is [branch | commit | tag | tag-or-commit ] and value diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm index 32712f7218..5c16a7617d 100644 --- a/guix/gnu-maintenance.scm +++ b/guix/gnu-maintenance.scm @@ -846,7 +846,11 @@ Optionally include a VERSION string to fetch a specific version." (let ((scheme (uri-scheme uri)) (host (uri-host uri))) (and (memq scheme '(http https)) - (not (member host hosting-sites))))))))) + ;; HOST may contain prefixes, + ;; e.g. "profanity-im.github.io", hence the + ;; suffix-based test below. + (not (any (cut string-suffix? <> host) + hosting-sites))))))))) (lambda (package) (or (assoc-ref (package-properties package) 'release-monitoring-url) diff --git a/guix/graph.scm b/guix/graph.scm index aee0021d6c..9f1111a0ae 100644 --- a/guix/graph.scm +++ b/guix/graph.scm @@ -29,6 +29,7 @@ #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (ice-9 match) + #:use-module (ice-9 string-fun) #:use-module (ice-9 vlist) #:export (node-type node-type? @@ -49,6 +50,7 @@ %graph-backends %d3js-backend %graphviz-backend + %graphml-backend lookup-backend graph-backend? @@ -328,6 +330,37 @@ nodeArray.push(nodes[\"~a\"]);~%" emit-cypher-prologue emit-cypher-epilogue emit-cypher-node emit-cypher-edge)) + +;;; +;;; GraphML export. +;;; + +(define (emit-graphml-prologue name port) + (format port "<?xml version=\"1.0\" encoding=\"UTF-8\"?> +<graphml xmlns=\"http://graphml.graphdrawing.org/xmlns\" + xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\" + xsi:schemaLocation=\"http://graphml.graphdrawing.org/xmlns + http://graphml.graphdrawing.org/xmlns/1.0/graphml.xsd\"> + <graph id=\"G\" edgedefault=\"directed\">~%")) + +(define (emit-graphml-epilogue port) + (format port " </graph> +</graphml>")) + +(define (emit-graphml-node id label port) + (format port " <node id=\"~a\"/>~%" + (string-replace-substring (object->string id) "\"" "\\\""))) + +(define (emit-graphml-edge id1 id2 port) + (format port " <edge source=\"~a\" target=\"~a\"/>~%" + (string-replace-substring (object->string id1) "\"" "\\\"") + (string-replace-substring (object->string id2) "\"" "\\\""))) + +(define %graphml-backend + (graph-backend "graphml" + "Generate GraphML." + emit-graphml-prologue emit-graphml-epilogue + emit-graphml-node emit-graphml-edge)) ;;; @@ -337,7 +370,8 @@ nodeArray.push(nodes[\"~a\"]);~%" (define %graph-backends (list %graphviz-backend %d3js-backend - %cypher-backend)) + %cypher-backend + %graphml-backend)) (define (lookup-backend name) "Return the graph backend called NAME. Raise an error if it is not found." diff --git a/guix/import/texlive.scm b/guix/import/texlive.scm index b5a812b34e..7e79c77884 100644 --- a/guix/import/texlive.scm +++ b/guix/import/texlive.scm @@ -101,6 +101,7 @@ ("cc-by-sa-3" 'cc-by-sa3.0) ("cc-by-sa-4" 'cc-by-sa4.0) ("mit" 'expat) + ("x11" 'x11) ("fdl" 'fdl1.3+) ;; The GUST Font Nosource License, which is legally equivalent to ;; lppl1.3c+, is no longer in use (per @@ -298,7 +299,7 @@ When TEXLIVE-ONLY is true, only TeX Live packages are returned." (define (linked-scripts name package-database) "Return a list of script names to symlink from \"bin/\" directory for package NAME according to PACKAGE-DATABASE. Consider as scripts files with -\".lua\", \".pl\", \".py\", \".sh\", \".tcl\", \".texlua\", \".tlu\" +\".lua\", \".pl\", \".py\", \".rb\", \".sh\", \".tcl\", \".texlua\", \".tlu\" extensions, and files without extension." (and-let* ((data (assoc-ref package-database name)) ;; Check if binaries are associated to the package. @@ -317,7 +318,8 @@ extensions, and files without extension." (filter-map (lambda (script) (and (any (lambda (ext) (member (basename script ext) binaries)) - '(".lua" ".pl" ".py" ".sh" ".tcl" ".texlua" ".tlu")) + '(".lua" ".pl" ".py" ".rb" ".sh" ".tcl" ".texlua" + ".tlu")) (basename script))) ;; Get the right (alphabetic) order. (reverse scripts)))) @@ -476,6 +478,7 @@ of those files are returned that are unexpectedly installed." ,@(match (append-map (lambda (s) (cond ((string-suffix? ".pl" s) '(perl)) ((string-suffix? ".py" s) '(python)) + ((string-suffix? ".rb" s) '(ruby)) ((string-suffix? ".tcl" s) '(tcl tk)) (else '()))) (or scripts '())) @@ -499,7 +502,7 @@ of those files are returned that are unexpectedly installed." (license ,(cond (meta-package? - '(license:fsf-free "https://www.tug.org/texlive/copying.html")) + '(fsf-free "https://www.tug.org/texlive/copying.html")) ((assoc-ref data 'catalogue-license) => string->license) (else #f)))) (translate-depends depends #t))))) diff --git a/guix/inferior.scm b/guix/inferior.scm index 5dfd30a6c8..fca6fb4b22 100644 --- a/guix/inferior.scm +++ b/guix/inferior.scm @@ -871,11 +871,15 @@ prefix, resolve it; and if 'commit' is unset, fetch CHANNEL's branch tip." #:key (authenticate? #t) (cache-directory (%inferior-cache-directory)) - (ttl (* 3600 24 30))) + (ttl (* 3600 24 30)) + validate-channels) "Return a directory containing a guix filetree defined by CHANNELS, a list of channels. -The directory is a subdirectory of CACHE-DIRECTORY, where entries can be reclaimed after TTL seconds. -This procedure opens a new connection to the build daemon. AUTHENTICATE? -determines whether CHANNELS are authenticated." +The directory is a subdirectory of CACHE-DIRECTORY, where entries can be +reclaimed after TTL seconds. This procedure opens a new connection to the +build daemon. AUTHENTICATE? determines whether CHANNELS are authenticated. +VALIDATE-CHANNELS, if specified, must be a one argument procedure accepting a +list of channels that can be used to validate the channels; it should raise an +exception in case of problems." (define commits ;; Since computing the instances of CHANNELS is I/O-intensive, use a ;; cheaper way to get the commit list of CHANNELS. This limits overhead @@ -923,27 +927,30 @@ determines whether CHANNELS are authenticated." (if (file-exists? cached) cached - (run-with-store store - (mlet* %store-monad ((instances - -> (latest-channel-instances store channels - #:authenticate? - authenticate?)) - (profile - (channel-instances->derivation instances))) - (mbegin %store-monad - ;; It's up to the caller to install a build handler to report - ;; what's going to be built. - (built-derivations (list profile)) - - ;; Cache if and only if AUTHENTICATE? is true. - (if authenticate? - (mbegin %store-monad - (symlink* (derivation->output-path profile) cached) - (add-indirect-root* cached) - (return cached)) - (mbegin %store-monad - (add-temp-root* (derivation->output-path profile)) - (return (derivation->output-path profile))))))))) + (begin + (when (procedure? validate-channels) + (validate-channels channels)) + (run-with-store store + (mlet* %store-monad ((instances + -> (latest-channel-instances store channels + #:authenticate? + authenticate?)) + (profile + (channel-instances->derivation instances))) + (mbegin %store-monad + ;; It's up to the caller to install a build handler to report + ;; what's going to be built. + (built-derivations (list profile)) + + ;; Cache if and only if AUTHENTICATE? is true. + (if authenticate? + (mbegin %store-monad + (symlink* (derivation->output-path profile) cached) + (add-indirect-root* cached) + (return cached)) + (mbegin %store-monad + (add-temp-root* (derivation->output-path profile)) + (return (derivation->output-path profile)))))))))) (define* (inferior-for-channels channels #:key diff --git a/guix/profiles.scm b/guix/profiles.scm index 2bd6477cf8..fea766879d 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -1786,7 +1786,7 @@ MANIFEST." (if (string-prefix? "texlive-" name) (cons (gexp-input thing output) (append-map entry->texlive-input deps)) - '())))) + (append-map entry->texlive-input deps))))) (define texlive-scripts-entry? (match-lambda (($ <manifest-entry> name version output thing deps) diff --git a/guix/scripts/home.scm b/guix/scripts/home.scm index fbd5689be8..e0800bc062 100644 --- a/guix/scripts/home.scm +++ b/guix/scripts/home.scm @@ -330,6 +330,10 @@ immediately. Return the exit status of the process in the container." (display "127.0.0.1 localhost\n" port) (chmod port #o444)))) + ;; Create /tmp; bits of code expect it, such as + ;; 'least-authority-wrapper'. + (mkdir-p "/tmp") + ;; Set PATH for things that the activation script might expect, such ;; as "env". (load-profile #$system-profile) diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index ecd264d3fa..759c3a94a3 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -85,6 +85,9 @@ Download and deploy the latest version of Guix.\n")) (display (G_ " -C, --channels=FILE deploy the channels defined in FILE")) (display (G_ " + -q, --no-channel-files + inhibit loading of user and system 'channels.scm'")) + (display (G_ " --url=URL download \"guix\" channel from the Git repository at URL")) (display (G_ " --commit=COMMIT download the specified \"guix\" channel COMMIT")) @@ -133,6 +136,9 @@ Download and deploy the latest version of Guix.\n")) (cons* (option '(#\C "channels") #t #f (lambda (opt name arg result) (alist-cons 'channel-file arg result))) + (option '(#\q "no-channel-files") #f #f + (lambda (opt name arg result) + (alist-cons 'ignore-channel-files? #t result))) (option '(#\l "list-generations") #f #t (lambda (opt name arg result) (cons `(query list-generations ,arg) @@ -166,7 +172,7 @@ Download and deploy the latest version of Guix.\n")) (alist-delete 'repository-url result)))) (option '("commit") #t #f (lambda (opt name arg result) - (alist-cons 'ref `(commit . ,arg) result))) + (alist-cons 'ref `(tag-or-commit . ,arg) result))) (option '("branch") #t #f (lambda (opt name arg result) (alist-cons 'ref `(branch . ,arg) result))) @@ -735,6 +741,9 @@ transformations specified in OPTS (resulting from '--url', '--commit', or (define file (assoc-ref opts 'channel-file)) + (define ignore-channel-files? + (assoc-ref opts 'ignore-channel-files?)) + (define default-file (string-append (config-directory) "/channels.scm")) @@ -750,9 +759,11 @@ transformations specified in OPTS (resulting from '--url', '--commit', or (define channels (cond (file (load-channels file)) - ((file-exists? default-file) + ((and (not ignore-channel-files?) + (file-exists? default-file)) (load-channels default-file)) - ((file-exists? global-file) + ((and (not ignore-channel-files?) + (file-exists? global-file)) (load-channels global-file)) (else %default-channels))) @@ -774,7 +785,8 @@ Use '~/.config/guix/channels.scm' instead.")) (if (guix-channel? c) (let ((url (or url (channel-url c)))) (match ref - (('commit . commit) + ((or ('commit . commit) + ('tag-or-commit . commit)) (channel (inherit c) (url url) (commit commit) (branch #f))) (('branch . branch) diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm index a9241aa20d..f39dc743b1 100644 --- a/guix/scripts/refresh.scm +++ b/guix/scripts/refresh.scm @@ -10,6 +10,7 @@ ;;; Copyright © 2020 Simon Tournier <zimon.toutoune@gmail.com> ;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev> ;;; Copyright © 2022 Hartmut Goebel <h.goebel@crazy-compilers.com> +;;; Copyright © 2023 Maxim Cournoyer maxim.cournoyer@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -106,6 +107,9 @@ (option '(#\m "manifest") #t #f (lambda (opt name arg result) (alist-cons 'manifest arg result))) + (option '("target-version") #t #f + (lambda (opt name arg result) + (alist-cons 'target-version arg result))) (option '(#\e "expression") #t #f (lambda (opt name arg result) (alist-cons 'expression arg result))) @@ -165,6 +169,9 @@ specified with `--select'.\n")) (display (G_ " -m, --manifest=FILE select all the packages from the manifest in FILE")) (display (G_ " + --target-version=VERSION + update the package or packages to VERSION")) + (display (G_ " -t, --type=UPDATER,... restrict to updates from the specified updaters (e.g., 'gnu')")) (display (G_ " @@ -213,17 +220,20 @@ specified with `--select'.\n")) (define* (update-spec package #:optional version) (%update-spec package version)) -(define (update-specification->update-spec spec) +(define (update-specification->update-spec spec fallback-version) "Given SPEC, a package name like \"guile@2.0=2.0.8\", return a <update> -record with two fields: the package to upgrade, and the target version." +record with two fields: the package to upgrade, and the target version. When +SPEC lacks a version, use FALLBACK-VERSION." (match (string-rindex spec #\=) - (#f (update-spec (specification->package spec) #f)) + (#f (update-spec (specification->package spec) fallback-version)) (idx (update-spec (specification->package (substring spec 0 idx)) (substring spec (1+ idx)))))) (define (options->update-specs opts) "Return the list of <update-spec> records requested by OPTS, honoring options like '--recursive'." + (define target-version (assoc-ref opts 'target-version)) + (define core-package? (let* ((input->package (match-lambda ((name (? package? package) _ ...) package) @@ -263,13 +273,18 @@ update would trigger a complete rebuild." ;; Update specs explicitly passed as command-line arguments. (match (append-map (match-lambda (('argument . spec) - ;; Take either the specified version or the - ;; latest one. - (list (update-specification->update-spec spec))) + ;; Take either the specified version or the latest + ;; one. The version specified as part of a spec + ;; takes precedence, with the command-line specified + ;; --target-version used as a fallback. + (list (update-specification->update-spec + spec target-version))) (('expression . exp) - (list (update-spec (read/eval-package-expression exp)))) + (list (update-spec (read/eval-package-expression exp) + target-version))) (('manifest . manifest) - (map update-spec (packages-from-manifest manifest))) + (map (cut update-spec <> target-version) + (packages-from-manifest manifest))) (_ '())) opts) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index acbe3dab2c..ec331809ef 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -1169,7 +1169,7 @@ Some ACTIONS support additional ARGS.\n")) (debug . 0) (verbosity . #f) ;default (validate-reconfigure . ,ensure-forward-reconfigure) - (image-type . efi-raw) + (image-type . mbr-raw) (image-size . guess) (install-bootloader? . #t) (label . #f) diff --git a/guix/scripts/time-machine.scm b/guix/scripts/time-machine.scm index d7c71ef705..87000d82ec 100644 --- a/guix/scripts/time-machine.scm +++ b/guix/scripts/time-machine.scm @@ -1,7 +1,8 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2019 Konrad Hinsen <konrad.hinsen@fastmail.net> -;;; Copyright © 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2019, 2020, 2021, 2023 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com> +;;; Copyright © 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -19,13 +20,15 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (guix scripts time-machine) + #:use-module (guix channels) + #:use-module (guix diagnostics) #:use-module (guix ui) #:use-module (guix scripts) #:use-module (guix inferior) #:use-module (guix store) #:use-module (guix status) #:use-module ((guix git) - #:select (with-git-error-handling)) + #:select (update-cached-checkout with-git-error-handling)) #:use-module ((guix utils) #:select (%current-system)) #:use-module ((guix scripts pull) @@ -38,9 +41,17 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) + #:use-module (srfi srfi-34) #:use-module (srfi srfi-37) + #:use-module (srfi srfi-71) #:export (guix-time-machine)) +;;; The required inferiors mechanism relied on by 'guix time-machine' was +;;; firmed up in v1.0.0; it is the oldest, safest commit that can be travelled +;;; to. +(define %oldest-possible-commit + "6298c3ffd9654d3231a6f25390b056483e8f407c") ;v1.0.0 + ;;; ;;; Command-line options. @@ -52,6 +63,9 @@ Execute COMMAND ARGS... in an older version of Guix.\n")) (display (G_ " -C, --channels=FILE deploy the channels defined in FILE")) (display (G_ " + -q, --no-channel-files + inhibit loading of user and system 'channels.scm'")) + (display (G_ " --url=URL use the Git repository at URL")) (display (G_ " --commit=COMMIT use the specified COMMIT")) @@ -75,13 +89,16 @@ Execute COMMAND ARGS... in an older version of Guix.\n")) (cons* (option '(#\C "channels") #t #f (lambda (opt name arg result) (alist-cons 'channel-file arg result))) + (option '(#\q "no-channel-files") #f #f + (lambda (opt name arg result) + (alist-cons 'ignore-channel-files? #t result))) (option '("url") #t #f (lambda (opt name arg result) (alist-cons 'repository-url arg (alist-delete 'repository-url result)))) (option '("commit") #t #f (lambda (opt name arg result) - (alist-cons 'ref `(commit . ,arg) result))) + (alist-cons 'ref `(tag-or-commit . ,arg) result))) (option '("branch") #t #f (lambda (opt name arg result) (alist-cons 'ref `(branch . ,arg) result))) @@ -140,8 +157,27 @@ Execute COMMAND ARGS... in an older version of Guix.\n")) (let* ((opts (parse-args args)) (channels (channel-list opts)) (command-line (assoc-ref opts 'exec)) + (ref (assoc-ref opts 'ref)) (substitutes? (assoc-ref opts 'substitutes?)) (authenticate? (assoc-ref opts 'authenticate-channels?))) + + (define (validate-guix-channel channels) + "Finds the Guix channel among CHANNELS, and validates that REF as +captured from the closure, a git reference specification such as a commit hash +or tag associated to CHANNEL, is valid and new enough to satisfy the 'guix +time-machine' requirements. A `formatted-message' condition is raised +otherwise." + (let* ((guix-channel (find guix-channel? channels)) + (checkout commit relation (update-cached-checkout + (channel-url guix-channel) + #:ref (or ref '()) + #:starting-commit + %oldest-possible-commit))) + (unless (memq relation '(ancestor self)) + (raise (formatted-message + (G_ "cannot travel past commit `~a' from May 1st, 2019") + (string-take %oldest-possible-commit 12)))))) + (when command-line (let* ((directory (with-store store @@ -153,6 +189,8 @@ Execute COMMAND ARGS... in an older version of Guix.\n")) #:dry-run? #f) (set-build-options-from-command-line store opts) (cached-channel-instance store channels - #:authenticate? authenticate?))))) + #:authenticate? authenticate? + #:validate-channels + validate-guix-channel))))) (executable (string-append directory "/bin/guix"))) (apply execl (cons* executable executable command-line)))))))) diff --git a/guix/ssh.scm b/guix/ssh.scm index b7b9807ebf..c4617d2c74 100644 --- a/guix/ssh.scm +++ b/guix/ssh.scm @@ -175,8 +175,9 @@ to SSH server at '~a'") (disconnect! session) (raise (condition (&message - (message (format #f (G_ "SSH authentication failed for '~a': ~a~%") - host (get-error session))))))))))) + (message (format #f (G_ "SSH authentication failed for '~a@~a': ~a~%") + (session-get session 'user) host + (get-error session))))))))))) (x ;; Connection failed or timeout expired. (raise (formatted-message (G_ "SSH connection to '~a' failed: ~a~%") diff --git a/guix/ui.scm b/guix/ui.scm index 47a118364a..6f2d4fe245 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -200,6 +200,20 @@ information, or #f if it could not be found." (parameterize (((@ (system base compile) default-optimization-level) 1)) exp)) +(define (try-canonicalize-path file) + "Like 'canonicalize-path', but return FILE as-is if 'canonicalize-path' +throws. + +This is necessary for corner cases where 'canonicalize-path' fails. One +example is on Linux when a /dev/fd/N file denotes a pipe, represented as a +symlink to a non-existent file like 'pipe:[1234]', as in this example: + + sh -c 'stat $(readlink -f /dev/fd/1)' | cat" + (catch 'system-error + (lambda () + (canonicalize-path file)) + (const file))) + (define* (load* file user-module #:key (on-error 'nothing-special)) "Load the user provided Scheme source code FILE." @@ -230,7 +244,7 @@ information, or #f if it could not be found." ;; 'primitive-load', so that FILE is compiled, which then allows ;; us to provide better error reporting with source line numbers. (without-compiler-optimizations - (load (canonicalize-path file)))) + (load (try-canonicalize-path file)))) (const #f)))))) (lambda _ ;; XXX: Errors are reported from the pre-unwind handler below, but |