build: go-build-system: Ensure uniform unpacking directory.

Depending on whether the source is a directory or an archive, we strip the
source directory or preserve it, respectively.  This change makes it so that
whether the type of the source, it is unpacked at the expected location given
by the IMPORT-PATH of the Go build system.

* guix/build/go-build-system.scm: Add the (ice-9 ftw) module.
(unpack): Add inner procedure to maybe strip the top level directory of an
archive, document it and use it.
This commit is contained in:
Maxim Cournoyer 2019-04-05 00:00:08 -04:00
parent 7e84d3eef7
commit f42e4ebb56
No known key found for this signature in database
GPG Key ID: 1260E46482E63562
1 changed files with 27 additions and 9 deletions

View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Petter <petter@mykolab.ch> ;;; Copyright © 2016 Petter <petter@mykolab.ch>
;;; Copyright © 2017, 2019 Leo Famulari <leo@famulari.name> ;;; Copyright © 2017, 2019 Leo Famulari <leo@famulari.name>
;;; Copyright © 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -22,6 +23,7 @@
#:use-module (guix build union) #:use-module (guix build union)
#:use-module (guix build utils) #:use-module (guix build utils)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 ftw)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (rnrs io ports) #:use-module (rnrs io ports)
#:use-module (rnrs bytevectors) #:use-module (rnrs bytevectors)
@ -151,13 +153,31 @@ dependencies, so it should be self-contained."
#t) #t)
(define* (unpack #:key source import-path unpack-path #:allow-other-keys) (define* (unpack #:key source import-path unpack-path #:allow-other-keys)
"Relative to $GOPATH, unpack SOURCE in the UNPACK-PATH, or the IMPORT-PATH is "Relative to $GOPATH, unpack SOURCE in UNPACK-PATH, or IMPORT-PATH when
the UNPACK-PATH is unset. When SOURCE is a directory, copy it instead of UNPACK-PATH is unset. If the SOURCE archive has a single top level directory,
it is stripped so that the sources appear directly under UNPACK-PATH. When
SOURCE is a directory, copy its content into UNPACK-PATH instead of
unpacking." unpacking."
(if (string-null? import-path) (define (unpack-maybe-strip source dest)
((display "WARNING: The Go import path is unset.\n"))) (let* ((scratch-dir (string-append (or (getenv "TMPDIR") "/tmp")
(if (string-null? unpack-path) "/scratch-dir"))
(set! unpack-path import-path)) (out (mkdir-p scratch-dir)))
(with-directory-excursion scratch-dir
(if (string-suffix? ".zip" source)
(invoke "unzip" source)
(invoke "tar" "-xvf" source))
(let ((top-level-files (remove (lambda (x)
(member x '("." "..")))
(scandir "."))))
(match top-level-files
((top-level-file)
(when (file-is-directory? top-level-file)
(copy-recursively top-level-file dest #:keep-mtime? #t)))
(_
(copy-recursively "." dest #:keep-mtime? #t)))
#t))
(delete-file-recursively scratch-dir)))
(when (string-null? import-path) (when (string-null? import-path)
((display "WARNING: The Go import path is unset.\n"))) ((display "WARNING: The Go import path is unset.\n")))
(when (string-null? unpack-path) (when (string-null? unpack-path)
@ -168,9 +188,7 @@ unpacking."
(begin (begin
(copy-recursively source dest #:keep-mtime? #t) (copy-recursively source dest #:keep-mtime? #t)
#t) #t)
(if (string-suffix? ".zip" source) (unpack-maybe-strip source dest))))
(invoke "unzip" "-d" dest source)
(invoke "tar" "-C" dest "-xvf" source)))))
(define (go-package? name) (define (go-package? name)
(string-prefix? "go-" name)) (string-prefix? "go-" name))