aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/packages.scm124
-rw-r--r--guix/utils.scm8
2 files changed, 130 insertions, 2 deletions
diff --git a/guix/packages.scm b/guix/packages.scm
index 9433fe9586..44f683f776 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -37,6 +37,10 @@
origin-method
origin-sha256
origin-file-name
+ origin-patches
+ origin-patch-flags
+ origin-patch-inputs
+ origin-patch-guile
base32
<search-path-specification>
@@ -101,7 +105,14 @@
(uri origin-uri) ; string
(method origin-method) ; symbol
(sha256 origin-sha256) ; bytevector
- (file-name origin-file-name (default #f))) ; optional file name
+ (file-name origin-file-name (default #f)) ; optional file name
+ (patches origin-patches (default '())) ; list of file names
+ (patch-flags origin-patch-flags ; list of strings
+ (default '("-p1")))
+ (patch-inputs origin-patch-inputs ; input list or #f
+ (default #f))
+ (patch-guile origin-patch-guile ; derivation or #f
+ (default #f)))
(define-syntax base32
(lambda (s)
@@ -243,13 +254,122 @@ corresponds to the arguments expected by `set-path-environment-variable'."
"Return the full name of PACKAGE--i.e., `NAME-VERSION'."
(string-append (package-name package) "-" (package-version package)))
+(define (%standard-patch-inputs)
+ (let ((ref (lambda (module var)
+ (module-ref (resolve-interface module) var))))
+ `(("tar" ,(ref '(gnu packages base) 'tar))
+ ("xz" ,(ref '(gnu packages compression) 'xz))
+ ("bzip2" ,(ref '(gnu packages compression) 'bzip2))
+ ("gzip" ,(ref '(gnu packages compression) 'gzip))
+ ("lzip" ,(ref '(gnu packages compression) 'lzip))
+ ("patch" ,(ref '(gnu packages base) 'patch)))))
+
+(define (default-guile store system)
+ "Return a derivation of d the default Guile package for SYSTEM."
+ (let* ((distro (resolve-interface '(gnu packages base)))
+ (guile (module-ref distro 'guile-final)))
+ (package-derivation store guile system)))
+
+(define* (patch-and-repack store source patches inputs
+ #:key
+ (flags '("-p1"))
+ (guile-for-build (%guile-for-build))
+ (system (%current-system)))
+ "Unpack SOURCE (a derivation), apply all of PATCHES, and repack the tarball
+using the tools listed in INPUTS."
+ (define decompression-type
+ (let ((out (derivation->output-path source)))
+ (cond ((string-suffix? "gz" out) "gzip")
+ ((string-suffix? "bz2" out) "bzip2")
+ ((string-suffix? "lz" out) "lzip")
+ (else "xz"))))
+
+ (define original-file-name
+ (let ((out (derivation->output-path source)))
+ ;; Remove the store prefix plus the slash, hash, and hyphen.
+ (let* ((sans (string-drop out (+ (string-length (%store-prefix)) 1)))
+ (dash (string-index sans #\-)))
+ (string-drop sans (+ 1 dash)))))
+
+ (define patch-inputs
+ (map (lambda (number patch)
+ (list (string-append "patch" (number->string number))
+ (add-to-store store (basename patch) #t
+ "sha256" patch)))
+ (iota (length patches))
+
+ patches))
+
+ (define builder
+ `(begin
+ (use-modules (ice-9 ftw)
+ (srfi srfi-1))
+
+ (let ((out (assoc-ref %outputs "out"))
+ (xz (assoc-ref %build-inputs "xz"))
+ (decomp (assoc-ref %build-inputs ,decompression-type))
+ (source (assoc-ref %build-inputs "source"))
+ (tar (string-append (assoc-ref %build-inputs "tar")
+ "/bin/tar"))
+ (patch (string-append (assoc-ref %build-inputs "patch")
+ "/bin/patch")))
+ (define (apply-patch input)
+ (let ((patch* (assoc-ref %build-inputs input)))
+ (format (current-error-port) "applying '~a'...~%" patch*)
+ (zero? (system* patch "--batch" ,@flags "--input" patch*))))
+
+ (setenv "PATH" (string-append xz "/bin" ":"
+ decomp "/bin"))
+ (and (zero? (system* tar "xvf" source))
+ (let ((directory (car (scandir "."
+ (lambda (name)
+ (not
+ (member name
+ '("." ".."))))))))
+ (format (current-error-port)
+ "source is under '~a'~%" directory)
+ (chdir directory)
+ (and (every apply-patch ',(map car patch-inputs))
+ (begin (chdir "..") #t)
+ (zero? (system* tar "cvfa" out directory))))))))
+
+
+ (let ((name (string-append (file-sans-extension original-file-name)
+ ".xz"))
+ (inputs (filter-map (match-lambda
+ ((name (? package? p))
+ (and (member name (cons decompression-type
+ '("tar" "xz" "patch")))
+ (list name
+ (package-derivation store p
+ system)))))
+ (or inputs (%standard-patch-inputs)))))
+
+ (build-expression->derivation store name system builder
+ `(("source" ,source)
+ ,@inputs
+ ,@patch-inputs)
+ #:guile-for-build guile-for-build)))
+
(define* (package-source-derivation store source
#:optional (system (%current-system)))
"Return the derivation path for SOURCE, a package source, for SYSTEM."
(match source
- (($ <origin> uri method sha256 name)
+ (($ <origin> uri method sha256 name ())
+ ;; No patches.
(method store uri 'sha256 sha256 name
#:system system))
+ (($ <origin> uri method sha256 name (patches ...) (flags ...)
+ inputs guile-for-build)
+ ;; One or more patches.
+ (let ((source (method store uri 'sha256 sha256 name
+ #:system system)))
+ (patch-and-repack store source patches inputs
+ #:flags flags
+ #:system system
+ #:guile-for-build (or guile-for-build
+ (%guile-for-build)
+ (default-guile store system)))))
((and (? string?) (? store-path?) file)
file)
((? string? file)
diff --git a/guix/utils.scm b/guix/utils.scm
index 733319a0b4..1f3c0c8ad6 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -63,6 +63,7 @@
package-name->name+version
string-tokenize*
file-extension
+ file-sans-extension
call-with-temporary-output-file
fold2
filtered-port))
@@ -352,6 +353,13 @@ introduce the version part."
(let ((dot (string-rindex file #\.)))
(and dot (substring file (+ 1 dot) (string-length file)))))
+(define (file-sans-extension file)
+ "Return the substring of FILE without its extension, if any."
+ (let ((dot (string-rindex file #\.)))
+ (if dot
+ (substring file 0 dot)
+ file)))
+
(define (string-tokenize* string separator)
"Return the list of substrings of STRING separated by SEPARATOR. This is
like `string-tokenize', but SEPARATOR is a string."