From bb7b9a5449ebdb7f5d9e730a5ea058fd98862eb7 Mon Sep 17 00:00:00 2001 From: Danny Milosavljevic Date: Tue, 3 Sep 2019 01:39:36 +0200 Subject: import: Add buildroot importer. * gnu/bootloader/u-boot.scm (install-buildroot-u-boot): New procedure. * guix/import/buildroot.scm: New file. * guix/scripts/import/buildroot.scm: New file. * guix/scripts/import.scm (importers): Add it. * Makefile.am (MODULES): Add them. --- Makefile.am | 2 + gnu/bootloader/u-boot.scm | 7 ++ guix/import/buildroot.scm | 137 ++++++++++++++++++++++++++++++++++++++ guix/scripts/import.scm | 2 +- guix/scripts/import/buildroot.scm | 94 ++++++++++++++++++++++++++ 5 files changed, 241 insertions(+), 1 deletion(-) create mode 100644 guix/import/buildroot.scm create mode 100644 guix/scripts/import/buildroot.scm diff --git a/Makefile.am b/Makefile.am index fa6bf8fe80..cf9d95e739 100644 --- a/Makefile.am +++ b/Makefile.am @@ -207,6 +207,7 @@ MODULES = \ guix/build/make-bootstrap.scm \ guix/search-paths.scm \ guix/packages.scm \ + guix/import/buildroot.scm \ guix/import/cabal.scm \ guix/import/cpan.scm \ guix/import/cran.scm \ @@ -252,6 +253,7 @@ MODULES = \ guix/scripts/system/reconfigure.scm \ guix/scripts/lint.scm \ guix/scripts/challenge.scm \ + guix/scripts/import/buildroot.scm \ guix/scripts/import/crate.scm \ guix/scripts/import/cran.scm \ guix/scripts/import/elpa.scm \ diff --git a/gnu/bootloader/u-boot.scm b/gnu/bootloader/u-boot.scm index 54abfe1c69..001edc5dac 100644 --- a/gnu/bootloader/u-boot.scm +++ b/gnu/bootloader/u-boot.scm @@ -21,6 +21,7 @@ (define-module (gnu bootloader u-boot) #:use-module (gnu bootloader extlinux) #:use-module (gnu bootloader) #:use-module (gnu packages bootloaders) + #:use-module (gnu packages genimage) #:use-module (guix gexp) #:export (u-boot-bootloader u-boot-a20-olinuxino-lime-bootloader @@ -90,6 +91,12 @@ (define install-puma-rk3399-u-boot (write-file-on-device u-boot (stat:size (stat u-boot)) device (* 512 512))))) +(define install-buildroot-u-boot + #~(lambda (bootloader device mount-point) + ;; FIXME: Take genimage and a custom config from buildroot in order to install bootloader. + #$genimage + #f)) + ;;; diff --git a/guix/import/buildroot.scm b/guix/import/buildroot.scm new file mode 100644 index 0000000000..73801433dd --- /dev/null +++ b/guix/import/buildroot.scm @@ -0,0 +1,137 @@ +;;; Copyright © 2018 Julien Lepiller +;;; +;;; 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 . + +(define-module (guix import buildroot) + #:use-module (ice-9 ftw) + #:use-module (ice-9 match) + #:use-module (ice-9 peg) + #:use-module (ice-9 receive) + #:use-module ((ice-9 rdelim) #:select (read-line)) + #:use-module (ice-9 textual-ports) + #:use-module (ice-9 vlist) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-2) + #:use-module (web uri) + #:use-module (guix build-system) + #:use-module (guix build-system ocaml) + #:use-module (guix http-client) + #:use-module (guix git) + #:use-module (guix ui) + #:use-module (guix packages) + #:use-module (guix store) + #:use-module (guix upstream) + #:use-module (guix utils) + #:use-module (guix import utils) + #:use-module ((guix licenses) #:prefix license:) + #:export (buildroot->guix-package)) + +(define download + (memoize + (lambda* (url #:optional git) + (with-store store + (if git + (latest-repository-commit store url) + (download-to-store store url)))))) + +(define (decomment line) + (match (string-split line #\#) + ((a b ...) + (string-trim a)))) + +(define (read-configuration-file port) + (filter-map + (lambda (line) + (match (string-split (decomment line) #\=) + (("") ; comment etc + #f) + ((key value-string) + (cons key + (cond + ((string-prefix? "\"" value-string) + (substring value-string 1 (- (string-length value-string) 1))) ; FIXME: Be more correct. + ((string-prefix? "0" value-string) + (string->number value-string)) + ((string-prefix? "1" value-string) + (string->number value-string)) + ((string-prefix? "2" value-string) + (string->number value-string)) + ((string-prefix? "3" value-string) + (string->number value-string)) + ((string-prefix? "4" value-string) + (string->number value-string)) + ((string-prefix? "5" value-string) + (string->number value-string)) + ((string-prefix? "6" value-string) + (string->number value-string)) + ((string-prefix? "7" value-string) + (string->number value-string)) + ((string-prefix? "8" value-string) + (string->number value-string)) + ((string-prefix? "9" value-string) + (string->number value-string)) + (else + (string->symbol value-string))))))) + (read-lines port))) + +(define (buildroot->guix-package name) + (let* ((buildroot-root-directory + (download "git://git.buildroot.net/buildroot" #t)) + (buildroot-configuration-directory + (string-append buildroot-root-directory "/configs")) + (buildroot-configuration-name + (string-append buildroot-configuration-directory "/" name)) + (buildroot-configuration + (if (file-exists? buildroot-configuration-name) + (call-with-input-file buildroot-configuration-name read-configuration-file) + (begin + (display "Unknown buildroot configuration. Possible values are: " (current-error-port)) + (display (scandir buildroot-configuration-directory) (current-error-port)) + (newline (current-error-port)) + #f))) + (buildroot-board-directory + (string-append buildroot-root-directory "/board"))) + (and buildroot-configuration (assoc-ref buildroot-configuration "BR2_TARGET_UBOOT_BOARD_DEFCONFIG") + (begin + ;(write buildroot-configuration) + ;(newline) + ; BR2_TARGET_UBOOT=y + ; BR2_TARGET_UBOOT_BOARD_DEFCONFIG="orangepi_zero" + ; BR2_TARGET_UBOOT_NEEDS_DTC=y + ; BR2_TARGET_UBOOT_FORMAT_CUSTOM=y + ; BR2_TARGET_UBOOT_FORMAT_CUSTOM_NAME="u-boot-sunxi-with-spl.bin" + ; BR2_TARGET_UBOOT_BOOT_SCRIPT=y + ; BR2_TARGET_UBOOT_BOOT_SCRIPT_SOURCE="board/orangepi/orangepi-zero/boot.cmd" + ; [BR2_PACKAGE_HOST_DOSFSTOOLS=y => install-buildroot-u-boot requires "dosfstools" package in profile] + ; BR2_PACKAGE_HOST_GENIMAGE=y => install-buildroot-u-boot requires "genimage" package in profile" + ; [BR2_PACKAGE_HOST_MTOOLS=y => install-buildroot-u-boot requires "mtools" package in profile] + ; [BR2_PACKAGE_HOST_UBOOT_TOOLS=y => install-buildroot-u-boot requires "u-boot-tools" package in profile] + ; BR2_ROOTFS_POST_IMAGE_SCRIPT + ; BR2_ROOTFS_POST_SCRIPT_ARGS + ; BR2_TARGET_ROOTFS_EXT2 + ; BR2_TARGET_ROOTFS_EXT2_4 + ; BR2_TARGET_ROOTFS_EXT2_SIZE + (values + `((bootloader + (inherit u-boot-bootloader) + (package + (make-u-boot-package + ,(string-append (assoc-ref buildroot-configuration "BR2_TARGET_UBOOT_BOARD_DEFCONFIG") + "_defconfig") + (if (eq? (assoc-ref "BR2_aarch64" 'y) + "aarch64-linux-gnu" + "arm-linux-gnueabihf")))) + (installer install-buildroot-u-boot)))))))) diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm index c6cc93fad8..fc22bc3e19 100644 --- a/guix/scripts/import.scm +++ b/guix/scripts/import.scm @@ -76,7 +76,7 @@ (define %standard-import-options '()) ;;; (define importers '("gnu" "nix" "pypi" "cpan" "hackage" "stackage" "elpa" "gem" - "cran" "crate" "texlive" "json" "opam")) + "cran" "crate" "texlive" "json" "opam" "buildroot")) (define (resolve-importer name) (let ((module (resolve-interface diff --git a/guix/scripts/import/buildroot.scm b/guix/scripts/import/buildroot.scm new file mode 100644 index 0000000000..05a4b86933 --- /dev/null +++ b/guix/scripts/import/buildroot.scm @@ -0,0 +1,94 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018 Julien Lepiller +;;; +;;; 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 . + +(define-module (guix scripts import buildroot) + #:use-module (guix ui) + #:use-module (guix utils) + #:use-module (guix scripts) + #:use-module (guix import buildroot) + #:use-module (guix scripts import) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-37) + #:use-module (srfi srfi-41) + #:use-module (ice-9 match) + #:use-module (ice-9 format) + #:export (guix-import-buildroot)) + + +;;; +;;; Command-line options. +;;; + +(define %default-options + '()) + +(define (show-help) + (display (G_ "Usage: guix import buildroot CONFIG-NAME +Import u-boot and board configuration for CONFIG-NAME.\n")) + (display (G_ " + -h, --help display this help and exit")) + (display (G_ " + -V, --version display version information and exit")) + (newline) + (show-bug-report-information)) + +(define %options + ;; Specification of the command-line options. + (cons* (option '(#\h "help") #f #f + (lambda args + (show-help) + (exit 0))) + (option '(#\V "version") #f #f + (lambda args + (show-version-and-exit "guix import buildroot"))) + %standard-import-options)) + + +;;; +;;; Entry point. +;;; + +(define (guix-import-buildroot . args) + (define (parse-options) + ;; Return the alist of option values. + (args-fold* args %options + (lambda (opt name arg result) + (leave (G_ "~A: unrecognized option~%") name)) + (lambda (arg result) + (alist-cons 'argument arg result)) + %default-options)) + + (let* ((opts (parse-options)) + (args (filter-map (match-lambda + (('argument . value) + value) + (_ #f)) + (reverse opts)))) + (match args + ((package-name) + ;; Single import + (let ((sexp (buildroot->guix-package package-name))) + (unless sexp + (leave (G_ "failed to download meta-data for config '~a'~%") + package-name)) + sexp)) + (() + (leave (G_ "too few arguments~%"))) + ((many ...) + (leave (G_ "too many arguments~%")))))) -- cgit v1.2.3