aboutsummaryrefslogtreecommitdiff
path: root/gnu/packages/cook.scm
diff options
context:
space:
mode:
authorJorge Gomez <jgart@dismail.de>2021-11-18 20:22:18 -0500
committerLeo Famulari <leo@famulari.name>2021-11-22 16:16:25 -0500
commitc4bc557c3a2e59b0d127f1a8a963e1a19daf6cdb (patch)
treec690e5d3cb5b90782ca139c79f147769f29d91df /gnu/packages/cook.scm
parentbb3fbb4d9d5c1e789958bc0f37026eccf64e8e93 (diff)
downloadguix-c4bc557c3a2e59b0d127f1a8a963e1a19daf6cdb.tar.gz
guix-c4bc557c3a2e59b0d127f1a8a963e1a19daf6cdb.zip
gnu: Add sc-im.
* gnu/packages/spreadsheet.scm: New file. * gnu/local.mk (GNU_SYSTEM_MODULES): Add it. Signed-off-by: Leo Famulari <leo@famulari.name>
Diffstat (limited to 'gnu/packages/cook.scm')
0 files changed, 0 insertions, 0 deletions
generated by cgit
a> 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 
#!@BASH@
# -*- mode: scheme; coding: utf-8; -*-

# XXX: We have to go through Bash because there's no command-line switch to
# augment %load-compiled-path, and because of the silly 127-byte limit for
# the shebang line in Linux.
# Use `load-compiled' because `load' (and `-l') doesn't otherwise load our
# .go file (see <http://bugs.gnu.org/12519>).

main="(@ (gnu build-support ld-wrapper) ld-wrapper)"
exec @GUILE@ -c "(load-compiled \"$0.go\") (apply $main (cdr (command-line)))" "$@"
!#
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;;
;;; 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 <http://www.gnu.org/licenses/>.

(define-module (gnu build-support ld-wrapper)
  #:use-module (srfi srfi-1)
  #:use-module (ice-9 match)
  #:export (ld-wrapper))

;;; Commentary:
;;;
;;; This is a wrapper for the linker.  Its purpose is to inspect the -L and
;;; -l switches passed to the linker, add corresponding -rpath arguments, and
;;; invoke the actual linker with this new set of arguments.
;;;
;;; The alternatives to this hack would be:
;;;
;;;   1. Using $LD_RUN_PATH.  However, that would tend to include more than
;;;      needed in the RPATH; for instance, given a package with `libfoo' as
;;;      an input, all its binaries would have libfoo in their RPATH,
;;;      regardless of whether they actually NEED it.
;;;
;;;   2. Use a GCC "lib" spec string such as `%{L*:-rpath %*}', which adds a
;;;      `-rpath LIBDIR' argument for each occurrence of `-L LIBDIR'.
;;;      However, this doesn't work when $LIBRARY_PATH is used, because the
;;;      additional `-L' switches are not matched by the above rule, because
;;;      the rule only matches explicit user-provided switches.  See
;;;      <http://gcc.gnu.org/ml/gcc-help/2012-09/msg00110.html> for details.
;;;
;;; As a bonus, this wrapper checks for "impurities"--i.e., references to
;;; libraries outside the store.
;;;
;;; Code:

(define %real-ld
  ;; Name of the linker that we wrap.
  "@LD@")

(define %store-directory
  ;; File name of the store.
  (or (getenv "NIX_STORE") "/gnu/store"))

(define %temporary-directory
  ;; Temporary directory.
  (or (getenv "TMPDIR") "/tmp"))

(define %build-directory
  ;; Top build directory when run from a builder.
  (getenv "NIX_BUILD_TOP"))

(define %allow-impurities?
  ;; Whether to allow references to libraries outside the store.
  (getenv "GUIX_LD_WRAPPER_ALLOW_IMPURITIES"))

(define %debug?
  ;; Whether to emit debugging output.
  (getenv "GUIX_LD_WRAPPER_DEBUG"))

(define (pure-file-name? file)
  ;; Return #t when FILE is the name of a file either within the store
  ;; (possibly via a symlink) or within the build directory.
  (define %max-symlink-depth 50)

  (let loop ((file  file)
             (depth 0))
    (or (not (string-prefix? "/" file))
        (string-prefix? %store-directory file)
        (string-prefix? %temporary-directory file)
        (if %build-directory
            (string-prefix? %build-directory file)

            ;; When used from a user environment, FILE may refer to
            ;; ~/.guix-profile/lib/libfoo.so, which is itself a symlink to the
            ;; store.  Check whether this is the case.
            (let ((s (false-if-exception (lstat file))))
              (and s
                   (eq? 'symlink (stat:type s))
                   (< depth %max-symlink-depth)
                   (loop (readlink file) (+ 1 depth))))))))

(define (shared-library? file)
  ;; Return #t when FILE denotes a shared library.
  (or (string-suffix? ".so" file)
      (let ((index (string-contains file ".so.")))
        ;; Since we cannot use regexps during bootstrap, roll our own.
        (and index
             (string-every (char-set-union (char-set #\.) char-set:digit)
                           (string-drop file (+ index 3)))))))

(define (library-files-linked args)
  ;; Return the file names of shared libraries explicitly linked against via
  ;; `-l' or with an absolute file name in ARGS.
  (define path+files
    (fold (lambda (argument result)
            (match result
              ((library-path . library-files)
               (cond ((string-prefix? "-L" argument) ;augment the search path
                      (cons (append library-path
                                    (list (string-drop argument 2)))
                            library-files))
                     ((string-prefix? "-l" argument) ;add library
                      (let* ((lib  (string-append "lib"
                                                  (string-drop argument 2)
                                                  ".so"))
                             (full (search-path library-path lib)))
                        (if full
                            (cons library-path
                                  (cons full library-files))
                            result)))
                     ((and (string-prefix? %store-directory argument)
                           (shared-library? argument)) ;add library
                      (cons library-path
                            (cons argument library-files)))
                     (else
                      result)))))
          (cons '() '())
          args))

  (match path+files
    ((path . files)
     (reverse files))))

(define (rpath-arguments library-files)
  ;; Return the `-rpath' argument list for each of LIBRARY-FILES, a list of
  ;; absolute file names.
  (fold-right (lambda (file args)
                (if (or %allow-impurities?
                        (pure-file-name? file))
                    (cons* "-rpath" (dirname file) args)
                    (begin
                      (format (current-error-port)
                              "ld-wrapper: error: attempt to use impure library ~s~%"
                              file)
                      (exit 1))))
              '()
              library-files))

(define (ld-wrapper . args)
  ;; Invoke the real `ld' with ARGS, augmented with `-rpath' switches.
  (let* ((libs (library-files-linked args))
         (args (append args (rpath-arguments libs))))
    (when %debug?
      (format (current-error-port)
              "ld-wrapper: invoking `~a' with ~s~%"
              %real-ld args))
    (apply execl %real-ld (basename %real-ld) args)))

;;; ld-wrapper.scm ends here
generated by cgit