aboutsummaryrefslogtreecommitdiff
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Vincent Legoll <vincent.legoll@gmail.com>
;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2018–2020, 2022 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2024 Efraim Flashner <efraim@flashner.co.il>
;;;
;;; 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 packages musl)
  #:use-module (guix download)
  #:use-module (guix packages)
  #:use-module (guix gexp)
  #:use-module (guix build-system gnu)
  #:use-module ((guix licenses) #:prefix license:)
  #:use-module (gnu packages)
  #:use-module (gnu packages bash))

(define-public musl
  (package
    (name "musl")
    (version "1.2.5")
    (source (origin
              (method url-fetch)
              (uri (string-append "https://www.musl-libc.org/releases/"
                                  "musl-" version ".tar.gz"))
              (sha256
               (base32
                "1r3mgky9d19b2285s274qxzlgs7sncx8plm01vd691sdx2xii8d9"))))
    (build-system gnu-build-system)
    (arguments
     (list #:tests? #f                      ; musl has no tests
           #:configure-flags
           #~(list "--enable-wrapper=all"
                   (string-append "--syslibdir=" #$output "/lib"))
           #:license-file-regexp "COPYRIGHT"))
    (inputs (list bash-minimal))
    (synopsis "Small C standard library")
    (description "musl is a simple and lightweight C standard library.  It
strives to be correct in the sense of standards-conformance and safety.")
    (home-page "https://musl.libc.org")
    (properties `((release-monitoring-url . ,home-page)))
    ;; Musl as a whole is released under the Expat license.  Parts of it are
    ;; derived from various third-party projects that are released under
    ;; non-copyleft licenses.  See the COPYRIGHT file for details.
    (license license:expat)))
generated by cgit
s. 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. ;; Allow them by default for convenience. (let ((value (getenv "GUIX_LD_WRAPPER_ALLOW_IMPURITIES"))) (or (not value) (let ((value (string-downcase value))) (cond ((member value '("yes" "y" "t" "true" "1")) #t) ((member value '("no" "n" "f" "false" "0")) #f) (else (format (current-error-port) "ld-wrapper: ~s: invalid value for \ 'GUIX_LD_WRAPPER_ALLOW_IMPURITIES'~%" value))))))) (define %debug? ;; Whether to emit debugging output. (getenv "GUIX_LD_WRAPPER_DEBUG")) (define %disable-rpath? ;; Whether to disable automatic '-rpath' addition. (getenv "GUIX_LD_WRAPPER_DISABLE_RPATH")) (define (readlink* file) ;; Call 'readlink' until the result is not a symlink. (define %max-symlink-depth 50) (let loop ((file file) (depth 0)) (define (absolute target) (if (absolute-file-name? target) target (string-append (dirname file) "/" target))) (if (>= depth %max-symlink-depth) file (call-with-values (lambda () (catch 'system-error (lambda () (values #t (readlink file))) (lambda args (let ((errno (system-error-errno args))) (if (or (= errno EINVAL) (= errno ENOENT)) (values #f file) (apply throw args)))))) (lambda (success? target) (if success? (loop (absolute target) (+ depth 1)) file)))))) (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. (let ((file (readlink* file))) (or (not (string-prefix? "/" file)) (string-prefix? %store-directory file) (string-prefix? %temporary-directory file) (and %build-directory (string-prefix? %build-directory file))))) (define (store-file-name? file) ;; Return #t when FILE is a store file, possibly indirectly. (string-prefix? %store-directory (readlink* file))) (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-search-path args) ;; Return the library search path as a list of directory names. The GNU ld ;; manual notes that "[a]ll `-L' options apply to all `-l' options, ;; regardless of the order in which the options appear", so we must compute ;; the search path independently of the -l options. (let loop ((args args) (path '())) (match args (() (reverse path)) (("-L" directory . rest) (loop rest (cons directory path))) ((argument . rest) (if (string-prefix? "-L" argument) ;augment the search path (loop rest (cons (string-drop argument 2) path)) (loop rest path)))))) (define (library-files-linked args library-path) ;; Return the absolute file names of shared libraries explicitly linked ;; against via `-l' or with an absolute file name in ARGS, looking them up ;; in LIBRARY-PATH. (define files+args (fold (lambda (argument result) (match result ((library-files ((and flag (or "-dynamic-linker" "-plugin")) . rest)) ;; When passed '-dynamic-linker ld.so', ignore 'ld.so'; when ;; passed '-plugin liblto_plugin.so', ignore ;; 'liblto_plugin.so'. See <http://bugs.gnu.org/20102>. (list library-files (cons* argument flag rest))) ((library-files previous-args) (cond ((string-prefix? "-l" argument) ;add library (let* ((lib (string-append "lib" (string-drop argument 2) ".so")) (full (search-path library-path lib))) (list (if full (cons full library-files) library-files) (cons argument previous-args)))) ((and (string-prefix? %store-directory argument) (shared-library? argument)) ;add library (list (cons argument library-files) (cons argument previous-args))) (else (list library-files (cons argument previous-args))))))) (list '() '()) args)) (match files+args ((files arguments) (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) ;; Add '-rpath' if and only if FILE is in the store; we don't ;; want to add '-rpath' for files under %BUILD-DIRECTORY or ;; %TEMPORARY-DIRECTORY because that could leak to installed ;; files. (cond ((and (not %disable-rpath?) (store-file-name? file)) (cons* "-rpath" (dirname file) args)) ((or %allow-impurities? (pure-file-name? file)) args) (else (begin (format (current-error-port) "ld-wrapper: error: attempt to use \ library outside of ~a: ~s~%" %store-directory file) (exit 1))))) '() library-files)) (define (expand-arguments args) ;; Expand ARGS such that "response file" arguments, such as "@args.txt", are ;; expanded (info "(gcc) Overall Options"). (define (response-file-arguments file) (define (tokenize port) ;; Return a list of all strings found in PORT. Quote characters are ;; removed, but whitespaces within quoted strings are preserved. (let loop ((tokens '())) (let* ((token+delimiter (read-delimited " '\"\n" port 'split)) (token (car token+delimiter)) (delim (cdr token+delimiter))) (if (eof-object? token) (reverse tokens) (case delim ((#\") (loop (cons (read-delimited "\"" port) tokens))) ((#\') (loop (cons (read-delimited "'" port) tokens))) (else (if (> (string-length token) 0) (loop (cons token tokens)) (loop tokens)))))))) (when %debug? (format (current-error-port) "ld-wrapper: attempting to read arguments from '~a'~%" file)) (call-with-input-file file tokenize)) (define result (fold-right (lambda (arg result) (if (string-prefix? "@" arg) (let ((file (string-drop arg 1))) (append (catch 'system-error (lambda () (response-file-arguments file)) (lambda args ;; FILE doesn't exist or cannot be read so ;; leave ARG as is. (list arg))) result)) (cons arg result))) '() args)) ;; If there are "@" arguments in RESULT *and* we can expand them (they don't ;; refer to nonexistent files), then recurse. (if (equal? result args) result (expand-arguments result))) (define (ld-wrapper args) ;; Invoke the real `ld' with ARGS, augmented with `-rpath' switches. (let* ((args (expand-arguments (cdr args))) ;strip arg0 (path (library-search-path args)) (libs (library-files-linked args path)) (args (append args (rpath-arguments libs)))) (when %debug? (format (current-error-port) "ld-wrapper: library search path: ~s~%" path) (format (current-error-port) "ld-wrapper: libraries linked: ~s~%" libs) (format (current-error-port) "ld-wrapper: invoking `~a' with ~s~%" %real-ld args) (force-output (current-error-port))) (apply execl %real-ld (basename %real-ld) args))) ;;; ld-wrapper.scm ends here
generated by cgit