build-system/go: Don't let Go executables refer to the Go compiler.

* guix/build/go-build-system.scm (remove-store-reference, remove-go-references):
New procedures.
(%standard-phases): Add 'remove-go-references' phase.
* guix/build-system/go.scm (go-build): Add allow-go-reference? key.

1 files changed, 58 insertions, 2 deletions

diff --git a/guix/build/go-build-system.scm b/guix/build/go-build-system.scm
index d175f3b76a..eaad9d8751 100644
--- a/guix/build/go-build-system.scm
+++ b/guix/build/go-build-system.scm
@@ -22,6 +22,8 @@
   #:use-module (guix build utils)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
+  #:use-module (rnrs io ports)
+  #:use-module (rnrs bytevectors)
   #:export (%standard-phases
             go-build))
 
@@ -197,13 +199,66 @@ respectively."
 
 (define* (install #:key outputs #:allow-other-keys)
   "Install the compiled libraries. `go install` installs these files to
-$GOPATH/pkg, so we have to copy them into the output direcotry manually.
+$GOPATH/pkg, so we have to copy them into the output directory manually.
 Compiled executable files should have already been installed to the store based
 on $GOBIN in the build phase."
   (when (file-exists? "pkg")
     (copy-recursively "pkg" (string-append (assoc-ref outputs "out") "/pkg")))
   #t)
 
+(define* (remove-store-reference file file-name
+                                  #:optional (store (%store-directory)))
+  "Remove from FILE occurrences of FILE-NAME in STORE; return #t when FILE-NAME
+is encountered in FILE, #f otherwise. This implementation reads FILE one byte at
+a time, which is slow. Instead, we should use the Boyer-Moore string search
+algorithm; there is an example in (guix build grafts)."
+  (define pattern
+    (string-take file-name
+                 (+ 34 (string-length (%store-directory)))))
+
+  (with-fluids ((%default-port-encoding #f))
+    (with-atomic-file-replacement file
+      (lambda (in out)
+        ;; We cannot use `regexp-exec' here because it cannot deal with
+        ;; strings containing NUL characters.
+        (format #t "removing references to `~a' from `~a'...~%" file-name file)
+        (setvbuf in 'block 65536)
+        (setvbuf out 'block 65536)
+        (fold-port-matches (lambda (match result)
+                             (put-bytevector out (string->utf8 store))
+                             (put-u8 out (char->integer #\/))
+                             (put-bytevector out
+                                             (string->utf8
+                                              "eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee-"))
+                             #t)
+                           #f
+                           pattern
+                           in
+                           (lambda (char result)
+                             (put-u8 out (char->integer char))
+                             result))))))
+
+(define* (remove-go-references #:key allow-go-reference?
+                               inputs outputs #:allow-other-keys)
+  "Remove any references to the Go compiler from the compiled Go executable
+files in OUTPUTS."
+;; We remove this spurious reference to save bandwidth when installing Go
+;; executables. It would be better to not embed the reference in the first
+;; place, but I'm not sure how to do that. The subject was discussed at:
+;; <https://lists.gnu.org/archive/html/guix-devel/2017-10/msg00207.html>
+  (if allow-go-reference?
+    #t
+    (let ((go (assoc-ref inputs "go"))
+          (bin "/bin"))
+      (for-each (lambda (output)
+                  (when (file-exists? (string-append (cdr output)
+                                                     bin))
+                    (for-each (lambda (file)
+                                (remove-store-reference file go))
+                              (find-files (string-append (cdr output) bin)))))
+                outputs)
+      #t)))
+
 (define %standard-phases
   (modify-phases gnu:%standard-phases
     (delete 'configure)
@@ -213,7 +268,8 @@ on $GOBIN in the build phase."
     (add-before 'build 'setup-environment setup-environment)
     (replace 'build build)
     (replace 'check check)
-    (replace 'install install)))
+    (replace 'install install)
+    (add-after 'install 'remove-go-references remove-go-references)))
 
 (define* (go-build #:key inputs (phases %standard-phases)
                       #:allow-other-keys #:rest args)