aboutsummaryrefslogtreecommitdiff
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 John Darrington <jmd@gnu.org>
;;; Copyright © 2016-2020, 2023 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2018–2022 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2022 LuHui <luhux76@gmail.com>
;;; Copyright © 2024 Zheng Junjie <873216071@qq.com>
;;;
;;; 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 busybox)
  #:use-module (guix gexp)
  #:use-module (guix licenses)
  #:use-module (guix packages)
  #:use-module (guix download)
  #:use-module (guix utils)
  #:use-module (guix build-system gnu)
  #:use-module (gnu packages)
  #:use-module (gnu packages admin)
  #:use-module (gnu packages algebra)
  #:use-module (gnu packages compression)
  #:use-module (gnu packages crypto)
  #:use-module (gnu packages perl))

(define-public busybox
  (package
    (name "busybox")
    (version "1.37.0")
    (source (origin
              (method url-fetch)
              (uri (string-append
                    "https://www.busybox.net/downloads/" name "-"
                    version ".tar.bz2"))
              (sha256
               (base32
                "1923f21rnlbv1qjvk2qhgqnki5mkgr6z0p8dvzs9jr3l5vrxy49k"))
              (patches
               (search-patches "busybox-add-missing-sha-NI-guard.patch"))))
    (build-system gnu-build-system)
    (arguments
     (list #:phases
           #~(modify-phases %standard-phases
               (add-before 'configure 'disable-timestamps
                 (lambda _
                   (setenv "KCONFIG_NOTIMESTAMP" "1")))
               (add-before 'configure 'disable-taskset
                 ;; This feature fails its tests in the build environment,
                 ;; was default 'n' until after 1.26.2.
                 (lambda _
                   (substitute* "util-linux/taskset.c"
                     (("default y") "default n"))))
               (replace 'configure
                 (lambda* (#:key make-flags #:allow-other-keys)
                   (apply invoke "make" "defconfig" make-flags)))
               (add-after 'configure 'dont-install-to-usr
                 (lambda _
                   (substitute* ".config"
                     (("# CONFIG_INSTALL_NO_USR is not set")
                      "CONFIG_INSTALL_NO_USR=y"))))
               (replace 'check
                 (lambda* (#:key tests? make-flags #:allow-other-keys)
                   (substitute* '("testsuite/du/du-s-works"
                                  "testsuite/du/du-works")
                     (("/bin") "/etc")) ; there is no /bin but there is a /etc

                   ;; There is no /usr/bin or /bin - replace it with
                   ;; /gnu/store.
                   (substitute* "testsuite/cpio.tests"
                     (("/usr/bin") (%store-directory))
                     (("usr") (car (filter (negate string-null?)
                                           (string-split (%store-directory) #\/)))))

                   (substitute* "testsuite/date/date-works-1"
                     (("/bin/date") (which "date")))

                   (substitute* "testsuite/start-stop-daemon.tests"
                     (("/bin/false") (which "false")))

                   ;; The pidof tests assume that pid 1 is called "init" but
                   ;; that is not true in guix build environment
                   (substitute* "testsuite/pidof.tests"
                     (("-s init") "-s $(cat /proc/1/comm)"))

                   ;; This test cannot possibly pass.  It is trying to test
                   ;; that "which ls" returns "/bin/ls" when PATH is not set.
                   ;; However, this relies on /bin/ls existing.  Which it does
                   ;; not in guix.
                   (delete-file "testsuite/which/which-uses-default-path")
                   (rmdir "testsuite/which")

                   (when tests?
                     (apply invoke "make"
                            ;; "V=1"
                            "SKIP_KNOWN_BUGS=1"
                            "SKIP_INTERNET_TESTS=1"
                            "check" make-flags))))
               (replace 'install
                 (lambda* (#:key outputs make-flags #:allow-other-keys)
                   (let ((out (assoc-ref outputs "out")))
                     (apply invoke "make"
                            (string-append "CONFIG_PREFIX=" out)
                            "install" make-flags)))))
           #:make-flags
           #~(let ((target #$(%current-target-system)))
               (if target
                   (list (string-append "CROSS_COMPILE=" target "-"))
                   '()))))
    (native-inputs (list perl     ; needed to generate the man pages (pod2man)
                         ;; The following are needed by the tests.
                         inetutils
                         (@ (gnu packages base) which)
                         zip))
    (synopsis "Many common UNIX utilities in a single executable")
    (description "BusyBox combines tiny versions of many common UNIX utilities
into a single small executable.  It provides a fairly complete environment for
any small or embedded system.")
    (home-page "https://www.busybox.net")
    ;; Some files are gplv2+
    (license gpl2)))

(define-public toybox
  (package
    (name "toybox")
    (version "0.8.11")
    (source (origin
              (method url-fetch)
              (uri (string-append
                    "https://landley.net/toybox/downloads/toybox-"
                    version ".tar.gz"))
              (sha256
               (base32
                "1p37zqxhj48klwwxl8jc2hw1x7pr2w39bfb1nx6qghaf5y1kzahm"))))
    (build-system gnu-build-system)
    (arguments
     (list #:make-flags
           #~(list (string-append "CC=" #$(cc-for-target))
                   (string-append "HOSTCC=gcc")
                   (string-append "PREFIX=" #$output))
           #:phases
           #~(modify-phases %standard-phases
               (replace 'configure
                 (lambda* (#:key make-flags #:allow-other-keys)
                   (apply invoke "make" "defconfig" make-flags)))
               (add-before 'check 'fix-or-skip-broken-tests
                 (lambda _
                   ;; Some tests expect $USER to magically be the current user.
                   (setenv "USER" (passwd:name (getpwnam (geteuid))))
                   ;; This uses /bin/sh.
                   (substitute* "tests/timeout.test"
                     (("/bin/sh") (which "bash")))
                   ;; This expects directories to be exactly 4K.  They aren't!
                   (delete-file "tests/du.test")
                   ;; Delete tests that expect a root or 0 user to exist.
                   (substitute* "tests/id.test"
                     (("^testing .*[ \\(]root.*") ""))
                   (delete-file "tests/tar.test")))
               (add-after 'install 'remove-usr-directory
                 (lambda* (#:key outputs #:allow-other-keys)
                   (delete-file-recursively (string-append #$output "/usr")))))
           #:test-target "tests"))
    (native-inputs (list bc))
    (inputs (list libxcrypt))
    (synopsis "Many common UNIX utilities in a single executable")
    (description "ToyBox combines tiny versions of many common UNIX utilities
into a single small executable.  It provides a fairly complete environment for
any small or embedded system.")
    (home-page "https://landley.net/toybox/")
    (license bsd-2)))
generated by cgit
ases %standard-phases (delete 'bootstrap) (add-before 'configure 'bootstrap (lambda _ (unless (zero? (system* "autoreconf" "-vfi")) (error "autoreconf failed")) #t))))) (native-inputs `(("pkg-config" ,(specification->package "pkg-config")) ("autoconf" ,(specification->package "autoconf")) ("automake" ,(specification->package "automake")) ("texinfo" ,(specification->package "texinfo")))) (inputs `(("guile" ,(specification->package "guile")) ("libgcrypt" ,(specification->package "libgcrypt")))) (synopsis "Cryptography library for Guile using Libgcrypt") (description "Guile-Gcrypt provides a Guile 2.x interface to a subset of the GNU Libgcrypt crytographic library. It provides modules for cryptographic hash functions, message authentication codes (MAC), public-key cryptography, strong randomness, and more. It is implemented using the foreign function interface (FFI) of Guile.") (license #f))) ;license:gpl3+ ((package . _) package))) (define* (build-program source version #:optional (guile-version (effective-version)) #:key (pull-version 0) (channel-metadata #f) built-in-builders) "Return a program that computes the derivation to build Guix from SOURCE. If BUILT-IN-BUILDERS is provided, it should be a list of strings and this will be used instead of the builtin builders provided by the build daemon, from within the generated build program." (define select? ;; Select every module but (guix config) and non-Guix modules. ;; Also exclude (guix channels): it is autoloaded by (guix describe), but ;; only for peripheral functionality. (match-lambda (('guix 'config) #f) (('guix 'channels) #f) (('guix 'build 'download) #f) ;autoloaded by (guix download) (('guix _ ...) #t) (('gnu _ ...) #t) (_ #f))) (define fake-gcrypt-hash ;; Fake (gcrypt hash) module; see below. (scheme-file "hash.scm" #~(define-module (gcrypt hash) #:export (sha1 sha256)))) (define fake-git (scheme-file "git.scm" #~(define-module (git)))) (with-imported-modules `(((guix config) => ,(make-config.scm)) ;; To avoid relying on 'with-extensions', which was ;; introduced in 0.15.0, provide a fake (gcrypt ;; hash) just so that we can build modules, and ;; adjust %LOAD-PATH later on. ((gcrypt hash) => ,fake-gcrypt-hash) ;; (guix git-download) depends on (git) but only ;; for peripheral functionality. Provide a dummy ;; (git) to placate it. ((git) => ,fake-git) ,@(source-module-closure `((guix store) (guix self) (guix derivations) (gnu packages bootstrap)) (list source) #:select? select?)) (gexp->script "compute-guix-derivation" #~(begin (use-modules (ice-9 match)) (eval-when (expand load eval) ;; (gnu packages …) modules are going to be looked up ;; under SOURCE. (guix config) is looked up in FRONT. (match (command-line) ((_ source _ ...) (match %load-path ((front _ ...) (unless (string=? front source) ;already done? (set! %load-path (list source (string-append #$guile-gcrypt "/share/guile/site/" (effective-version)) front))))))) ;; Only load Guile-Gcrypt, our own modules, or those ;; of Guile. (set! %load-compiled-path (cons (string-append #$guile-gcrypt "/lib/guile/" (effective-version) "/site-ccache") %load-compiled-path)) ;; Disable position recording to save time and space ;; when loading the package modules. (read-disable 'positions)) (use-modules (guix store) (guix self) (guix derivations) (srfi srfi-1)) (match (command-line) ((_ source system version protocol-version build-output) ;; The current input port normally wraps a file ;; descriptor connected to the daemon, or it is ;; connected to /dev/null. In the former case, reuse ;; the connection such that we inherit build options ;; such as substitute URLs and so on; in the latter ;; case, attempt to open a new connection. (let* ((proto (string->number protocol-version)) (store (if (integer? proto) (port->connection (duplicate-port (current-input-port) "w+0") #:version proto #:built-in-builders '#$built-in-builders) (open-connection #:built-in-builders '#$built-in-builders))) (sock (socket AF_UNIX SOCK_STREAM 0))) ;; Connect to BUILD-OUTPUT and send it the raw ;; build output. (connect sock AF_UNIX build-output) (display (and=> ;; Silence autoload warnings and the likes. (parameterize ((current-warning-port (%make-void-port "w")) (current-build-output-port sock)) (run-with-store store (guix-derivation source version #$guile-version #:channel-metadata '#$channel-metadata #:pull-version #$pull-version) #:system system)) derivation-file-name)))))) #:module-path (list source)))) (define (proxy input output) "Dump the contents of INPUT to OUTPUT until EOF is reached on INPUT. Display a spinner when nothing happens." (define spin (circular-list "-" "\\" "|" "/" "-" "\\" "|" "/")) (setvbuf input 'block 16384) (let loop ((spin spin)) (match (select (list input) '() '() 1) ((() () ()) (when (isatty? (current-error-port)) (display (string-append "\b" (car spin)) (current-error-port)) (force-output (current-error-port))) (loop (cdr spin))) (((_) () ()) ;; Read from INPUT as much as can be read without blocking. (let ((bv (get-bytevector-some input))) (unless (eof-object? bv) (put-bytevector output bv) (loop spin))))))) (define (call-with-clean-environment thunk) (let ((env (environ))) (dynamic-wind (lambda () (environ '())) thunk (lambda () (environ env))))) (define-syntax-rule (with-clean-environment exp ...) "Evaluate EXP in a context where zero environment variables are defined." (call-with-clean-environment (lambda () exp ...))) ;; The procedure below is our return value. (define* (build source #:key verbose? (version (date-version-string)) channel-metadata system (pull-version 0) ;; For the standalone Guix, default to Guile 3.0. For old ;; versions of 'guix pull' (pre-0.15.0), we have to use the ;; same Guile as the current one. (guile-version (if (> pull-version 0) "3.0" (effective-version))) built-in-builders #:allow-other-keys #:rest rest) "Return a derivation that unpacks SOURCE into STORE and compiles Scheme files." ;; Build the build program and then use it as a trampoline to build from ;; SOURCE. (mlet %store-monad ((build (build-program source version guile-version #:channel-metadata channel-metadata #:pull-version pull-version #:built-in-builders built-in-builders)) (system (if system (return system) (current-system))) (home -> (getenv "HOME")) ;; Note: Use the deprecated names here because the ;; caller might be Guix <= 0.16.0. (port ((store-lift nix-server-socket))) (major ((store-lift nix-server-major-version))) (minor ((store-lift nix-server-minor-version)))) (mbegin %store-monad ;; Before 'with-build-handler' was implemented and used, we had to ;; explicitly call 'show-what-to-build*'. (munless (module-defined? (resolve-module '(guix store)) 'with-build-handler) (show-what-to-build* (list build))) (built-derivations (list build)) ;; Use the port beneath the current store as the stdin of BUILD. This ;; way, we know 'open-pipe*' will not close it on 'exec'. If PORT is ;; not a file port (e.g., it's an SSH channel), then the subprocess's ;; stdin will actually be /dev/null. (let* ((sock (socket AF_UNIX SOCK_STREAM 0)) (node (let ((file (string-append (or (getenv "TMPDIR") "/tmp") "/guix-build-output-" (number->string (getpid))))) (bind sock AF_UNIX file) (listen sock 1) file)) (pipe (with-input-from-port port (lambda () ;; Make sure BUILD is not influenced by ;; $GUILE_LOAD_PATH & co. (with-clean-environment (setenv "GUILE_WARN_DEPRECATED" "no") ;be quiet and drive (setenv "COLUMNS" "120") ;show wider backtraces (when home ;; Inherit HOME so that 'xdg-directory' works. (setenv "HOME" home)) (open-pipe* OPEN_READ (derivation->output-path build) source system version (if (file-port? port) (number->string (logior major minor)) "none") node)))))) (format (current-error-port) "Computing Guix derivation for '~a'... " system) ;; Wait for a connection on SOCK and proxy build output so it can be ;; processed according to the settings currently in effect (build ;; traces, verbosity level, and so on). (match (accept sock) ((port . _) (close-port sock) (delete-file node) (proxy port (current-build-output-port)))) ;; Now that the build output connection was closed, read the result, a ;; derivation file name, from PIPE. (let ((str (get-string-all pipe)) (status (close-pipe pipe))) (match str ((? eof-object?) (error "build program failed" (list build status))) ((? derivation-path? drv) (mbegin %store-monad (return (newline (current-error-port))) ((store-lift add-temp-root) drv) (return (read-derivation-from-file drv)))) ("#f" ;; Unsupported PULL-VERSION. (return #f)) ((? string? str) (raise (condition (&message (message (format #f "You found a bug: the program '~a' failed to compute the derivation for Guix (version: ~s; system: ~s; host version: ~s; pull-version: ~s). Please report the COMPLETE output above by email to <~a>.~%" (derivation->output-path build) version system %guix-version pull-version %guix-bug-report-address)))))))))))) ;; This file is loaded by 'guix pull'; return it the build procedure. build ;; Local Variables: ;; eval: (put 'with-load-path 'scheme-indent-function 1) ;; End: ;;; build-self.scm ends here
generated by cgit