[bug#33080] [PATCH] gnu: Add inferno.

[Diego Nicola Barbato]

Hello Guix,

This patch adds inferno as discussed here:
https://lists.gnu.org/archive/html/guix-devel/2018-10/msg00031.html

>From c97b28e97a210cc31e34c08bc1abdc8bd74114fa Mon Sep 17 00:00:00 2001
From: Diego Nicola Barbato <address@hidden>
Date: Wed, 17 Oct 2018 23:07:40 +0200
Subject: [PATCH] gnu: Add inferno.

* gnu/packages/inferno.scm: New file.
* gnu/local.mk (GNU_SYSTEM_MODULES): Register it.
---
 gnu/local.mk             |   1 +
 gnu/packages/inferno.scm | 201 +++++++++++++++++++++++++++++++++++++++
 2 files changed, 202 insertions(+)
 create mode 100644 gnu/packages/inferno.scm

diff --git a/gnu/local.mk b/gnu/local.mk
index 402505e22..d10db3dcc 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -232,6 +232,7 @@ GNU_SYSTEM_MODULES =                                \
   %D%/packages/image-processing.scm    \
   %D%/packages/image-viewers.scm       \
   %D%/packages/imagemagick.scm                 \
+  %D%/packages/inferno.scm                     \
   %D%/packages/inklingreader.scm               \
   %D%/packages/inkscape.scm                    \
   %D%/packages/irc.scm                         \
diff --git a/gnu/packages/inferno.scm b/gnu/packages/inferno.scm
new file mode 100644
index 000000000..7bf9f970e
--- /dev/null
+++ b/gnu/packages/inferno.scm
@@ -0,0 +1,201 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Diego Nicola Barbato <address@hidden>
+;;;
+;;; 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 inferno)
+  #:use-module (ice-9 match)
+  #:use-module (guix packages)
+  #:use-module (guix git-download)
+  #:use-module (guix hg-download)
+  #:use-module (guix build-system gnu)
+  #:use-module ((guix licenses) #:prefix license:)
+  #:use-module (gnu packages xorg))
+
+(define-public inferno
+  (let ((commit "62ae0f7")
+        (revision "0"))
+    (package
+      (name "inferno")
+      (version (git-version "4" revision commit))
+      (source
+       (origin
+         (method hg-fetch)
+         (uri (hg-reference
+               (url "https://bitbucket.org/inferno-os/inferno-os";)
+               (changeset commit)))
+         (file-name (string-append name "-" version "-checkout"))
+         (sha256
+          (base32 "18irka9qad8m1r2m9f56glv9d0gwk4ai7n7i0mzbi47vcmm60hdd"))
+         ;; Remove bundled non-free fonts.
+         (modules '((guix build utils)))
+         (snippet
+          '(begin
+             (for-each delete-file-recursively
+                       '("fonts/lucidasans"
+                         "fonts/pelm"
+                         "fonts/lucida"
+                         "fonts/lucm"))
+             #t))))
+      (build-system gnu-build-system)
+      (inputs `(("libx11" ,libx11)
+                ("xorgproto" ,xorgproto)
+                ("libxext" ,libxext)))
+      (arguments
+       `(;; Force a 32-bit build targeting a similar architecture, i.e.:
+         ;; armhf for armhf/aarch64, i686 for i686/x86_64.
+         #:system ,@(match (%current-system)
+                      ((or "armhf-linux" "aarch64-linux")
+                       `("armhf-linux"))
+                      (_
+                       `("i686-linux")))
+         #:phases
+         (let* ((bash (assoc-ref %build-inputs "bash"))
+                (objtype ,@(match (%current-system)
+                             ((or "armhf-linux" "aarch64-linux")
+                              `("arm"))
+                             (_
+                              `("386"))))
+                (out (assoc-ref %outputs "out"))
+                (root (string-append out "/share/inferno"))
+                (root/bindir (string-append root "/Linux/"
+                                            objtype "/bin"))
+                (bindir (string-append out "/bin"))
+                (infwm-script (string-append bindir "/infwm")))
+           `(,(assoc 'set-paths %standard-phases)
+             (unpack . ,(lambda* (#:key source #:allow-other-keys)
+                          ;; Extract directly to 'root' since the source
+                          ;; tree doubles as Inferno's root directory
+                          ;; and its path is baked into the emu binary.
+                          (mkdir-p root)
+                          ;; Do not preserve the data modification time
+                          ;; of files ('-m' flag) otherwise the 'build'
+                          ;; phase fails.
+                          (invoke "tar" "xvf" source "-C" root "--strip=1" 
"-m")
+                          (chdir root)
+                          #t))
+             (patch-src-files . ,(lambda _
+                                   ;; Substitute ocurrences of /bin/sh.
+                                   (for-each (lambda (file)
+                                               (substitute* file
+                                                 (("/bin/sh")
+                                                  (string-append bash 
"/bin/sh"))))
+                                             '("makemk.sh"
+                                               "mkfiles/mkhost-Linux"
+                                               "emu/Linux/mk-wrt"
+                                               "utils/mk/Posix.c"))
+                                   ;; Do not pass '-m32' unconditionally
+                                   ;; when building mk.
+                                   (substitute* "makemk.sh"
+                                     (("-m32") ""))
+                                   ;; Use the correct name for gcc.
+                                   (substitute* "mkfiles/mkfile-Linux-386"
+                                     (("cc -") ; Don't match yacc.
+                                      "gcc -"))
+                                   (substitute* "mkfiles/mkfile-Linux-arm"
+                                     (("arm-gcc") "gcc"))
+                                   ;; Make build reproducible by
+                                   ;; ensuring timestamps embedded into
+                                   ;; binaries are set to 0.
+                                   (substitute* "emu/Linux/mkfile"
+                                     (("^KERNDATE=.*$")
+                                      "KERNDATE=0\n"))
+                                   #t))
+             (configure . ,(lambda _
+                             (substitute* "mkconfig"
+                               (("ROOT=/usr/inferno")
+                                (string-append "ROOT=" root))
+                               (("SYSHOST=Plan9")
+                                "SYSHOST=Linux")
+                               (("OBJTYPE=\\$objtype")
+                                (string-append "OBJTYPE=" objtype)))
+                             #t))
+             ;; Build mk.
+             ;; TODO: Use mk from 9base instead.
+             (makemk . ,(lambda _
+                          (invoke "./makemk.sh")))
+             (build . ,(lambda _
+                         ;; Add mk's location to PATH.
+                         (setenv "PATH"
+                                 (string-append
+                                  root/bindir ":"
+                                  (getenv "PATH")))
+                         ;; Build emu and .dis files using mk.
+                         (invoke "mk" "-s" "nuke" "mkdirs" "install")))
+             (install . ,(lambda _
+                           ;; Install infwm script.
+                           (mkdir-p bindir)
+                           (with-output-to-file infwm-script
+                             (lambda ()
+                               (display
+                                (string-append
+                                 "#!" bash "/bin/sh\n"
+                                 "exec " root/bindir "/emu $* "
+                                 "/dis/sh.dis -c \""
+                                 ;; Bind the host's /tmp to Inferno's
+                                 ;; /tmp to make it writable.
+                                 "bind -bc '#U*/tmp' /tmp; "
+                                 ;; Bind the host's /home to Inferno's
+                                 ;; /usr.
+                                 "bind '#U*/home' /usr; "
+                                 ;; Launch the window manager and login
+                                 ;; as $USER.
+                                 "wm/wm wm/logon -u $USER"
+                                 "\"\n"))))
+                           (chmod infwm-script #o755)
+                           ;; Install a symlink to the Inferno emulator.
+                           (symlink (string-append root/bindir "/emu")
+                                    (string-append bindir "/emu"))
+                           ;; Install a symlink to the Limbo compiler.
+                           (symlink (string-append root/bindir "/limbo")
+                                    (string-append bindir "/limbo"))
+                           #t))))))
+      (home-page "http://www.inferno-os.org";)
+      (synopsis
+       "Compact operating system for building cross-platform distributed 
systems")
+      (description
+       ;; Except for the last sentence this is taken verbatim from the
+       ;; intro(1) man page (man/1/0intro in the source tree).
+       "Inferno is a virtualised operating system that can run natively across
+a wide range of processor architectures or hosted on a wide range of
+operating systems.  The principal components of the system are:
address@hidden
address@hidden The Inferno kernel which can run both native and hosted on a
+range of platforms and which presents the same interface to programs
+in both cases.
address@hidden The Dis virtual machine.
address@hidden Styx - the tiny broad-spectrum file service protocol.
address@hidden Limbo - a new simple, modular, concurrent programming language.
address@hidden Tk and Prefab - graphical user interface (GUI) primitives
+without a lot of goo.
address@hidden The portable cross-development suites that allow any native
+Inferno platform to be cross-compiled on any hosted system.
address@hidden itemize
+This package provides hosted Inferno.\n")
+      (supported-systems '("i686-linux" "x86_64-linux" "armhf-linux" 
"aarch64-linux"))
+      (license (list
+                ;; According to NOTICE the combined work is effectively
+                ;; GPLv2+.
+                license:gpl2+
+                license:lgpl2.0+
+                license:expat
+                ;; XXX: Contrary to NOTICE, which claims that the
+                ;; licenses of individual components "are all compatible
+                ;; with the GPLv2", the Lucent Public License 1.02 is
+                ;; not compatible with the GPL.
+                (license:non-copyleft
+                 "https://www.gnu.org/licenses/license-list.html#lucent102";)
+                license:freetype)))))
-- 
2.19.0