[bug#51471] [PATCH] gnu: Add geth-binary.

[Attila Lendvai <attila@lendvai.name>]

It downloads, verifies, and patches the official binary release of the
go-ethereum client using patchelf.

* gnu/packages/geth-binary.scm (geth-binary): New variable.
---

dear fellow Guix hackers,

RFC: would Guix accept a package like this? if yes, then i welcome any
feedback, this is my first binary package. i welcome also pointers to
other packages from which i should mimic something.

this is only lightly tested for now, but before i tidy everything up,
i wanted to know whether such a beast would ever be accepted.

 gnu/packages/geth-binary.scm | 222 +++++++++++++++++++++++++++++++++++
 1 file changed, 222 insertions(+)
 create mode 100644 gnu/packages/geth-binary.scm

diff --git a/gnu/packages/geth-binary.scm b/gnu/packages/geth-binary.scm
new file mode 100644
index 0000000000..d8a5ea1550
--- /dev/null
+++ b/gnu/packages/geth-binary.scm
@@ -0,0 +1,222 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Attila Lendvai <attila@lendvai.name>
+;;;
+;;; 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 geth-binary)
+  #:use-module ((guix licenses)
+                #:select (gpl3+))
+  #: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 bootstrap)
+  #:use-module (gnu packages elf)
+  #:use-module (gnu packages gnupg)
+  #:use-module (ice-9 match))
+
+;; as per https://geth.ethereum.org/downloads/#openpgp_signatures
+(define +geth-linux-builder-key-fingerprint+
+  "FDE5A1A044FA13D2F7ADA019A61A13569BA28146")
+
+(define +geth-linux-builder-key+
+  "-----BEGIN PGP PUBLIC KEY BLOCK-----
+Comment: Hostname: 
+Version: Hockeypuck ~unreleased
+
+xsFNBFggyuEBEADAWrc/bm0LD0EsymPoWKf3L5br0CNIoDfN0eHRFDKu11blTUY2
+GcK7BcrE7yTp7iyY2C3GCXIvm/2MT8ljp7ilqhlWlMiEaxZuhHIAiv4021G1hm5V
+7MpDKaXLoMcbKLdk6wtULfx8u+KvOFgDEAXyfe93RZtJqEnm/ed3KWF123s/ceXy
+df4ruFypyW04gaKHepb23WNnz98kQqWxlmSWResp7gD7rOGEE0R1blK2VnVksTAi
++ObUJdrRl/aNYYzwaPwysSoZf+WQAQrd/Wcx/FTlnp6IODvxH88mTIUa3KnCNOxx
+BD3i2eXIWcR3fqyMnIAaoVxKQzL0odkuTHO+2axNecvfXU7rN+k1eEA121bJDQjx
+qKhtgKfCiwg+prw9+sGS/ZnFLxP+s1ss5z1HpTTO60YQpnYoUPSbL4RGaFBuAkzS
+g43iS3RaaXLk8lNunpWwQxY85995ZHKkf/yvg9wULwQ7lDvDO6nD+HCbf6H5AOAL
+t2uQAPaG1bKk+bioaLDF2ziHW6jwDRKxRa0FyNtP2yb6nCM1wJSu6ymaRQxqTFcQ
+jfHxNeFWYZhObfC90eqUnlUEhfAWz/tflDIioDGRhB9XB3gRCvjVz/gSxp4xOMgE
+tIsUgzsavPWxE1HDGB0CKB8UChGVqNWl0Lom0GXGxUg2VNF+gTppees7qwARAQAB
+zTBHbyBFdGhlcmV1bSBMaW51eCBCdWlsZGVyIDxnZXRoLWNpQGV0aGVyZXVtLm9y
+Zz7CwXgEEwECACIFAlggyuECGwMGCwkIBwMCBhUIAgkKCwQWAgMBAh4BAheAAAoJ
+EKYaE1abooFGAkEP/jem4pUVBAZ3Hg/i58LSz/k1poUGjNQBS3ktZqB0P0wofyF2
+xDGMsen0NDiV+tqy2PhIpDYxO5EtaS2uaZ8iAXicxy/paFUUdsRXvm0Y6P4xvJXk
+lcazSxHGaosjnEjLJm8k1ocBO0Lo4day/GXsoarXLlHzJqjSS6VLeocn7LWBfMVP
+fELj0a3S+AKYTLQAizWPtKZaI5rvCzDvpfD72pakVsWdO3aKrYQ10wPic9mY2Xbc
+EZl9Vx6TZMFQ2cTnhPbCm/tixUXwOM0eSEPSEvaf0IyjmfzZ/TuYYexc13LmX5+Q
+REKpUv2MG5AL15AZl8jIuFXLw+SDr4nYL5KyiVCyeoIWWlfWq2U5N3FttQJsiK25
+Uf5Owk05A41eDx3X2+xGFPXGR1PyUcGrsrRnHxfPbsPD8v0PtwJSCqwkIooFLVVJ
+YT5f05FTSJIGuS1kprNj8zc2H+J514Aeb+7iNcuj31tnpHKrbTjXuRDFx4vemEWl
+fhXU3T8MscPTpKdiupmpJ62njaOKiwMD6bQoNAHbDgqr2gY1i55G+maok1dlS6aI
+tOEUZgYfsvUta+i0Meu8DjlNP6pR1M2353PPk6dIgUYMHGB3fa11wtZRNEWGDyue
+jihYThK3L9mCtsHHt2cy24rzCK54/J9v/4pzNEYqz7jtzGDKGNAhjdecx+sZwsDc
+BBABCgAGBQJaIWwNAAoJEOEDogis3/oR21QMAJLH+Lbya9OZwD/jrh9EgMykmYm8
+N6uZi/x4iCt/M3zPzOKjZDIYP56vd6lCm3BdGJcEPjnnxPpTE+loO9EEbH2zEVBo
+Gq+Z8YBYBOhpoyJR3L5rYouDjEBWDM1EMo2+XIal5SMGC33KkvPBcbHdVu+Eshx2
+8N8+VsYoPWnhdNnDDjpbjSZSEjPIz5wX2bjzPOfMAooDPjXec+zSYn0iR5PW1GXm
+ZnP22ynL/9oA1IJkqaqUXrN6BywSWmcE3cFZbFqmU+bED/AOLIk+F8llZURR4JZx
+wVZY5KHyroTwr2jGfOP/u8x8Qg+LF6ceARlmYP1xOxbZ7odiN2fctchs+ogtA9P3
+/Vj4Q4Sm7eRg6MdOrFQbxMWPXiXWZqdzPU0wBT7pec0OnxP58gTxc+bqmirav3bp
+jDPr9lDnazxuyK92mlV9Nt1mwn+deoNEeAJLKLgQywTpIT/Wi5pKpikHTZmOGBz0
+aD1XJM7Aqq5KSSLvJMap9uHNO3WQXuNOoeLsSg==
+=1D3S
+-----END PGP PUBLIC KEY BLOCK-----")
+
+(define +url-base+ "https://gethstore.blob.core.windows.net/builds/")
+
+(define (unsupported-arch system)
+  (raise (formatted-message
+          (G_ "The geth-binary package does not support Guix system '~a'")
+          system)))
+
+(define (guix-system-name->geth-system-name system)
+  (match system
+    ("x86_64-linux"      "linux-amd64")
+    ("i686-linux"        "linux-386")
+    ("aarch64-linux"     "linux-arm64")
+    (_ (unsupported-arch system))))
+
+(define (geth-directory system version commit-hash)
+  (string-append "geth-alltools-"
+                 (guix-system-name->geth-system-name system) "-"
+                 version "-"
+                 commit-hash))
+
+(define-public geth-binary
+  (let ((version "1.10.11")
+        (commit-hash "7231b3ef"))
+    (package
+      (name "geth-binary")
+      (version version)
+      (source #false)                   ; see below
+      (outputs '("out" "clef" "evm"))
+      (build-system gnu-build-system)
+      (arguments
+       `(#:modules ((guix build gnu-build-system)
+                    (guix build utils)
+                    (srfi srfi-26)
+                    (srfi srfi-1))
+         #:phases
+         (modify-phases %standard-phases
+           (delete 'bootstrap)
+           (delete 'configure)
+           (delete 'build)
+           (delete 'check)
+           (add-before 'unpack 'check-singatures
+             (lambda* (#:key inputs #:allow-other-keys)
+               (let* ((gpg-homedir "gpg-homedir")
+                      (key-file "geth-linux-builder.asc")
+                      (gpg-options (list "gpg"
+                                         "--homedir" gpg-homedir
+                                         "--no-options"
+                                         "--trust-model" "tofu"
+                                         "--no-auto-check-trustdb"
+                                         "--no-default-keyring")))
+                 (mkdir-p gpg-homedir)
+                 (chmod gpg-homedir #o700)
+                 (with-output-to-file key-file
+                   (lambda _
+                     (display ,+geth-linux-builder-key+)))
+                 ;; import the key
+                 (apply invoke (append gpg-options
+                                       (list "--import" key-file)))
+                 ;; trust it
+                 (apply invoke (append gpg-options
+                                       (list "--tofu-policy" "good"
+                                             ,+geth-linux-builder-key-fingerprint+)))
+                 ;; verify the archive
+                 (apply invoke (append gpg-options
+                                       (list "--verify"
+                                             (assoc-ref inputs "signature")
+                                             (assoc-ref inputs "source")))))
+               #t))
+           (replace 'unpack
+             (lambda* (#:key inputs #:allow-other-keys)
+               (invoke "tar" "--strip-components=1" "-xzvf"
+                       (assoc-ref inputs "source"))
+               #t))
+           (add-after 'unpack 'patchelf
+             (lambda* (#:key inputs outputs #:allow-other-keys)
+               (let* ((binaries '("geth" "clef" "evm"))
+                      (ld-so (string-append (assoc-ref inputs "libc")
+                                            ,(glibc-dynamic-linker))))
+                 (for-each (cut invoke "patchelf" "--set-interpreter" ld-so <>)
+                           binaries))
+               #t))
+           (replace 'install
+             (lambda* (#:key system outputs #:allow-other-keys)
+               (let ((out  (assoc-ref outputs "out"))
+                     (clef (assoc-ref outputs "clef"))
+                     (evm  (assoc-ref outputs "evm"))
+                     (doit (lambda (name target)
+                             (let ((target-dir (string-append target "/bin")))
+                               (mkdir-p target-dir)
+                               (copy-file name (string-append target-dir "/" name))))))
+                 (doit "geth" out)
+                 (doit "clef" clef)
+                 (doit "evm"  evm))
+               #t)))))
+      (native-inputs
+       `(("gnupg" ,gnupg)
+         ("patchelf" ,patchelf)))
+      (inputs
+       `(("source"
+          ,(origin
+             (method url-fetch)
+             (uri (string-append
+                   +url-base+
+                   (geth-directory (%current-system) version commit-hash)
+                   ".tar.gz"))
+             (sha256
+              (match (%current-system)
+                ("x86_64-linux"
+                 (base32
+                  "1r50i97aiksjx81lalh0rq0ffk2gc68b68lnrmm8c8rvarv547n3"))
+                ("i686-linux"
+                 (base32
+                  "0f2dbswmahwqga2sxvf6037n4c7rpmr3vf4hfhbjankfknb4l8gv"))
+                ("aarch64-linux"
+                 (base32
+                  "0s4f7254gv5v92nbddwvlbyb2gg3kz2v2g586zk3ygvga86yky6m"))
+                (_ (unsupported-arch (%current-system)))))))
+         ("signature"
+          ,(origin
+             (method url-fetch)
+             (uri (string-append
+                   +url-base+
+                   (geth-directory (%current-system) version commit-hash)
+                   ".tar.gz.asc"))
+             (sha256
+              (match (%current-system)
+                ("x86_64-linux"
+                 (base32
+                  "1j14bli8hq4nkcirbpkm1vgr3zr91glrxzix62imzahwhwkfsq9a"))
+                ("i686-linux"
+                 (base32
+                  "1jb53xdp7qx45npdzlcxds7nnlinkzq55l1ygpsivr9gl4aryq0f"))
+                ("aarch64-linux"
+                 (base32
+                  "1dglzi4lxpxih6pq6j2kyzl44yw7afhnmpmh06vbwazsqvhlil2k"))
+                (_ (unsupported-arch (%current-system)))))))))
+
+      (supported-systems '("x86_64-linux" "i686-linux" "aarch64-linux"))
+
+      (home-page "https://geth.ethereum.org/")
+      (synopsis "Official Go implementation of the Ethereum protocol")
+      (description
+       "Ethereum is a decentralized platform that runs smart contracts,
+applications that run exactly as programmed without possibility of downtime,
+censorship, fraud or third party interference.")
+      (license gpl3+))))
-- 
2.33.0