[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
03/04: gnu: Add relocatable static Guile 3.0 variant.
|
From: |
guix-commits |
|
Subject: |
03/04: gnu: Add relocatable static Guile 3.0 variant. |
|
Date: |
Fri, 1 May 2020 16:12:21 -0400 (EDT) |
mbakke pushed a commit to branch core-updates
in repository guix.
commit 3ba23f0582a432dfc04bfbf58f375f6643caae19
Author: Marius Bakke <address@hidden>
AuthorDate: Mon Apr 27 19:54:03 2020 +0200
gnu: Add relocatable static Guile 3.0 variant.
* gnu/packages/patches/guile-2.2-default-utf8.patch: New file, extracted
from
commit 2acfe022a740f79b593348cc6362cc4ee8f33bb4.
* gnu/packages/patches/guile-3.0-linux-syscalls.patch,
gnu/packages/patches/guile-3.0-relocatable.patch: New files.
* gnu/local.mk (dist_patch_DATA): Adjust accordingly. Move all Guile
patches
together while at it.
* gnu/packages/make-bootstrap.scm (%guile-3.0-static-stripped): New public
variable.
---
gnu/local.mk | 7 +-
gnu/packages/make-bootstrap.scm | 11 +-
gnu/packages/patches/guile-2.2-default-utf8.patch | 82 +++++
.../patches/guile-3.0-linux-syscalls.patch | 345 +++++++++++++++++++++
gnu/packages/patches/guile-3.0-relocatable.patch | 69 +++++
5 files changed, 511 insertions(+), 3 deletions(-)
diff --git a/gnu/local.mk b/gnu/local.mk
index 38e1d85..0111ae2 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -1027,10 +1027,13 @@ dist_patch_DATA =
\
%D%/packages/patches/guile-1.8-cpp-4.5.patch \
%D%/packages/patches/guile-2.2-skip-oom-test.patch \
%D%/packages/patches/guile-default-utf8.patch \
- %D%/packages/patches/guile-gdbm-ffi-support-gdbm-1.14.patch \
+ %D%/packages/patches/guile-2.2-default-utf8.patch \
+ %D%/packages/patches/guile-relocatable.patch \
+ %D%/packages/patches/guile-3.0-relocatable.patch \
%D%/packages/patches/guile-linux-syscalls.patch \
+ %D%/packages/patches/guile-3.0-linux-syscalls.patch \
+ %D%/packages/patches/guile-gdbm-ffi-support-gdbm-1.14.patch \
%D%/packages/patches/guile-present-coding.patch \
- %D%/packages/patches/guile-relocatable.patch \
%D%/packages/patches/guile-rsvg-pkgconfig.patch \
%D%/packages/patches/guile-emacs-fix-configure.patch \
%D%/packages/patches/guile-sqlite3-fix-cross-compilation.patch \
diff --git a/gnu/packages/make-bootstrap.scm b/gnu/packages/make-bootstrap.scm
index d336818..fe86f81 100644
--- a/gnu/packages/make-bootstrap.scm
+++ b/gnu/packages/make-bootstrap.scm
@@ -55,7 +55,8 @@
%mes-bootstrap-tarball
%bootstrap-tarballs
- %guile-static-stripped))
+ %guile-static-stripped
+ %guile-3.0-static-stripped))
;;; Commentary:
;;;
@@ -797,6 +798,14 @@ for `sh' in $PATH, and without nscd, and with static NSS
modules."
;; A stripped static Guile binary, for use during bootstrap.
(make-guile-static-stripped %guile-static))
+(define %guile-3.0-static-stripped
+ ;; A stripped static Guile 3.0 binary, for use in initrds.
+ (make-guile-static-stripped
+ (make-guile-static guile-3.0
+ '("guile-2.2-default-utf8.patch"
+ "guile-3.0-linux-syscalls.patch"
+ "guile-3.0-relocatable.patch"))))
+
(define (tarball-package pkg)
"Return a package containing a tarball of PKG."
(package (inherit pkg)
diff --git a/gnu/packages/patches/guile-2.2-default-utf8.patch
b/gnu/packages/patches/guile-2.2-default-utf8.patch
new file mode 100644
index 0000000..f55a643
--- /dev/null
+++ b/gnu/packages/patches/guile-2.2-default-utf8.patch
@@ -0,0 +1,82 @@
+This hack makes Guile default to UTF-8. This avoids calls to
+`iconv_open'; `iconv_open' tries to open shared objects that aren't
+available during bootstrap, so using UTF-8 avoids that (and UTF-8 has
+built-in conversions in glibc, too.)
+
+diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c
+index 0ac5ea6a6..f73301e2f 100644
+--- a/libguile/bytevectors.c
++++ b/libguile/bytevectors.c
+@@ -1931,7 +1931,7 @@ utf_encoding_name (char *name, size_t utf_width, SCM
endianness)
+ if (scm_i_is_narrow_string (str)) \
+ { \
+ err = mem_iconveh (scm_i_string_chars (str), c_strlen, \
+- "ISO-8859-1", c_utf_name, \
++ "UTF-8", c_utf_name, \
+ iconveh_question_mark, NULL, \
+ &c_utf, &c_utf_len); \
+ if (SCM_UNLIKELY (err)) \
+diff --git a/libguile/ports.c b/libguile/ports.c
+index 45e62f4e4..42012f3aa 100644
+--- a/libguile/ports.c
++++ b/libguile/ports.c
+@@ -974,7 +974,9 @@ canonicalize_encoding (const char *enc)
+ char *ret;
+ int i;
+
+- if (!enc || encoding_matches (enc, sym_ISO_8859_1))
++ if (enc == NULL)
++ return sym_UTF_8;
++ if (encoding_matches (enc, sym_ISO_8859_1))
+ return sym_ISO_8859_1;
+ if (encoding_matches (enc, sym_UTF_8))
+ return sym_UTF_8;
+@@ -4198,7 +4200,7 @@ scm_init_ports (void)
+ scm_c_define ("%default-port-conversion-strategy",
+ scm_make_fluid_with_default (sym_substitute));
+ /* Use the locale as the default port encoding. */
+- scm_i_set_default_port_encoding (locale_charset ());
++ scm_i_set_default_port_encoding ("UTF-8");
+
+ scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
+ "scm_init_ice_9_ports",
+diff --git a/libguile/strings.c b/libguile/strings.c
+index 056b4c99f..63a6c050d 100644
+--- a/libguile/strings.c
++++ b/libguile/strings.c
+@@ -1579,7 +1579,7 @@ scm_i_default_string_failed_conversion_handler (void)
+ SCM
+ scm_from_locale_stringn (const char *str, size_t len)
+ {
+- return scm_from_stringn (str, len, locale_charset (),
++ return scm_from_stringn (str, len, "UTF-8",
+ scm_i_default_string_failed_conversion_handler ());
+ }
+
+@@ -1907,7 +1907,7 @@ char *
+ scm_to_locale_stringn (SCM str, size_t *lenp)
+ {
+ return scm_to_stringn (str, lenp,
+- locale_charset (),
++ "UTF-8",
+ scm_i_default_string_failed_conversion_handler ());
+ }
+
+@@ -2195,7 +2195,7 @@ scm_to_stringn (SCM str, size_t *lenp, const char
*encoding,
+ scm_wrong_type_arg_msg (NULL, 0, str, "string");
+
+ if (encoding == NULL)
+- encoding = "ISO-8859-1";
++ encoding = "UTF-8";
+
+ if (c_strcasecmp (encoding, "UTF-8") == 0)
+ /* This is the most common case--e.g., when calling libc bindings
+@@ -2247,7 +2247,7 @@ scm_to_stringn (SCM str, size_t *lenp, const char
*encoding,
+ if (scm_i_is_narrow_string (str))
+ {
+ ret = mem_iconveh (scm_i_string_chars (str), ilen,
+- "ISO-8859-1", encoding,
++ "UTF-8", encoding,
+ (enum iconv_ilseq_handler) handler, NULL,
+ &buf, &len);
+
diff --git a/gnu/packages/patches/guile-3.0-linux-syscalls.patch
b/gnu/packages/patches/guile-3.0-linux-syscalls.patch
new file mode 100644
index 0000000..0d27f77
--- /dev/null
+++ b/gnu/packages/patches/guile-3.0-linux-syscalls.patch
@@ -0,0 +1,345 @@
+This patch adds bindings to Linux syscalls for which glibc has symbols.
+
+Using the FFI would have been nice, but that's not an option when using
+a statically-linked Guile in an initrd that doesn't have libc.so around.
+
+diff --git a/libguile/posix.c b/libguile/posix.c
+--- a/libguile/posix.c
++++ b/libguile/posix.c
+@@ -2375,6 +2375,336 @@ scm_init_popen (void)
+ }
+ #endif /* HAVE_START_CHILD */
+
++
++/* Linux! */
++#ifdef __linux__
++
++#include <sys/mount.h>
++#include <sys/syscall.h>
++
++#include "libguile/foreign.h"
++#include "libguile/bytevectors.h"
++#include <libguile/variable.h>
++
++SCM_DEFINE (scm_mount, "mount", 3, 2, 0,
++ (SCM source, SCM target, SCM type, SCM flags, SCM data),
++ "Mount file system of @var{type} specified by @var{source} "
++ "on @var{target}.")
++#define FUNC_NAME s_scm_mount
++{
++ int err;
++ char *c_source, *c_target, *c_type, *c_data;
++ unsigned long c_flags;
++
++ c_source = scm_to_locale_string (source);
++ c_target = scm_to_locale_string (target);
++ c_type = scm_to_locale_string (type);
++ c_flags = SCM_UNBNDP (flags) ? 0 : scm_to_ulong (flags);
++
++ if (SCM_UNBNDP (data) || scm_is_false (data))
++ c_data = NULL;
++ else
++ c_data = scm_to_locale_string (data);
++
++ err = mount (c_source, c_target, c_type, c_flags, c_data);
++ if (err != 0)
++ err = errno;
++
++ free (c_source);
++ free (c_target);
++ free (c_type);
++
++ if (c_data != NULL)
++ free (c_data);
++
++ if (err != 0)
++ {
++ errno = err;
++ SCM_SYSERROR;
++ }
++
++ return SCM_UNSPECIFIED;
++}
++#undef FUNC_NAME
++
++SCM_DEFINE (scm_umount, "umount", 1, 0, 0,
++ (SCM target),
++ "Unmount the file system on @var{target}.")
++#define FUNC_NAME s_scm_umount
++{
++ int err;
++ char *c_target;
++
++ c_target = scm_to_locale_string (target);
++
++ err = umount (c_target);
++ if (err != 0)
++ err = errno;
++
++ free (c_target);
++
++ if (err != 0)
++ {
++ errno = err;
++ SCM_SYSERROR;
++ }
++
++ return SCM_UNSPECIFIED;
++}
++#undef FUNC_NAME
++
++/* Linux's module installation syscall. See `kernel/module.c' in Linux;
++ the function itself is part of the GNU libc.
++
++ Load the LEN bytes at MODULE as a kernel module, with arguments from
++ ARGS, a space-separated list of options. */
++extern long init_module (void *module, unsigned long len, const char *args);
++
++/* Load a kernel module from FD. FLAGS must be a bitwise or of
++ MODULE_INIT_* constants. The GNU libc doesn't provide a wrapper for
++ this one so we use 'syscall'. */
++static int
++finit_module (int fd, const char *args, int flags)
++{
++ return syscall (SYS_finit_module, fd, args, flags);
++}
++
++
++SCM_DEFINE (scm_load_linux_module, "load-linux-module", 1, 1, 0,
++ (SCM data, SCM options),
++ "Load the Linux kernel module whose contents are in bytevector "
++ "DATA (the contents of a @code{.ko} file), with the arguments "
++ "from the OPTIONS string.")
++#define FUNC_NAME s_scm_load_linux_module
++{
++ long err;
++ void *c_data;
++ unsigned long c_len;
++ char *c_options;
++
++ SCM_VALIDATE_BYTEVECTOR (SCM_ARG1, data);
++
++ c_data = SCM_BYTEVECTOR_CONTENTS (data);
++ c_len = SCM_BYTEVECTOR_LENGTH (data);
++ c_options =
++ scm_to_locale_string (SCM_UNBNDP (options) ? scm_nullstr : options);
++
++ err = init_module (c_data, c_len, c_options);
++
++ free (c_options);
++
++ if (err != 0)
++ SCM_SYSERROR;
++
++ return SCM_UNSPECIFIED;
++}
++#undef FUNC_NAME
++
++SCM_DEFINE (scm_load_linux_module_fd, "load-linux-module/fd", 1, 2, 0,
++ (SCM fd, SCM options, SCM flags),
++ "Load the Linux kernel module from the file at FD, "
++ "with the arguments from the OPTIONS string, and "
++ "optionally the given FLAGS.")
++#define FUNC_NAME s_scm_load_linux_module_fd
++{
++ long err;
++ int c_fd, c_flags;
++ char *c_options;
++
++ c_fd = scm_to_int (fd);
++ c_options =
++ scm_to_locale_string (SCM_UNBNDP (options) ? scm_nullstr : options);
++ c_flags = SCM_UNBNDP (flags) ? 0 : scm_to_int (flags);
++
++ err = finit_module (c_fd, c_options, c_flags);
++
++ free (c_options);
++
++ if (err != 0)
++ SCM_SYSERROR;
++
++ return SCM_UNSPECIFIED;
++}
++#undef FUNC_NAME
++
++
++/* Rebooting, halting, and all that. */
++
++#include <sys/reboot.h>
++
++SCM_VARIABLE_INIT (flag_RB_AUTOBOOT, "RB_AUTOBOOT",
++ scm_from_int (RB_AUTOBOOT));
++SCM_VARIABLE_INIT (flag_RB_HALT_SYSTEM, "RB_HALT_SYSTEM",
++ scm_from_int (RB_HALT_SYSTEM));
++SCM_VARIABLE_INIT (flag_RB_ENABLE_CAD, "RB_ENABLE_CAD",
++ scm_from_int (RB_ENABLE_CAD));
++SCM_VARIABLE_INIT (flag_RB_DISABLE_CAD, "RB_DISABLE_CAD",
++ scm_from_int (RB_DISABLE_CAD));
++SCM_VARIABLE_INIT (flag_RB_POWER_OFF, "RB_POWER_OFF",
++ scm_from_int (RB_POWER_OFF));
++SCM_VARIABLE_INIT (flag_RB_SW_SUSPEND, "RB_SW_SUSPEND",
++ scm_from_int (RB_SW_SUSPEND));
++SCM_VARIABLE_INIT (flag_RB_KEXEC, "RB_KEXEC",
++ scm_from_int (RB_KEXEC));
++
++SCM_DEFINE (scm_reboot, "reboot", 0, 1, 0,
++ (SCM command),
++ "Reboot the system. @var{command} must be one of the @code{RB_} "
++ "constants; if omitted, @var{RB_AUTOBOOT} is used, thus "
++ "performing a hard reset.")
++#define FUNC_NAME s_scm_reboot
++{
++ int c_command;
++
++ if (SCM_UNBNDP (command))
++ c_command = RB_AUTOBOOT;
++ else
++ c_command = scm_to_int (command);
++
++ reboot (c_command);
++
++ return SCM_UNSPECIFIED; /* likely unreached */
++}
++#undef FUNC_NAME
++
++/* Linux network interfaces. See <linux/if.h>. */
++
++#include <linux/if.h>
++#include <linux/sockios.h>
++#include "libguile/socket.h"
++
++SCM_VARIABLE_INIT (flag_IFF_UP, "IFF_UP",
++ scm_from_int (IFF_UP));
++SCM_VARIABLE_INIT (flag_IFF_BROADCAST, "IFF_BROADCAST",
++ scm_from_int (IFF_BROADCAST));
++SCM_VARIABLE_INIT (flag_IFF_DEBUG, "IFF_DEBUG",
++ scm_from_int (IFF_DEBUG));
++SCM_VARIABLE_INIT (flag_IFF_LOOPBACK, "IFF_LOOPBACK",
++ scm_from_int (IFF_LOOPBACK));
++SCM_VARIABLE_INIT (flag_IFF_POINTOPOINT, "IFF_POINTOPOINT",
++ scm_from_int (IFF_POINTOPOINT));
++SCM_VARIABLE_INIT (flag_IFF_NOTRAILERS, "IFF_NOTRAILERS",
++ scm_from_int (IFF_NOTRAILERS));
++SCM_VARIABLE_INIT (flag_IFF_RUNNING, "IFF_RUNNING",
++ scm_from_int (IFF_RUNNING));
++SCM_VARIABLE_INIT (flag_IFF_NOARP, "IFF_NOARP",
++ scm_from_int (IFF_NOARP));
++SCM_VARIABLE_INIT (flag_IFF_PROMISC, "IFF_PROMISC",
++ scm_from_int (IFF_PROMISC));
++SCM_VARIABLE_INIT (flag_IFF_ALLMULTI, "IFF_ALLMULTI",
++ scm_from_int (IFF_ALLMULTI));
++
++SCM_DEFINE (scm_set_network_interface_address,
"set-network-interface-address",
++ 3, 0, 0,
++ (SCM socket, SCM name, SCM address),
++ "Configure network interface @var{name}.")
++#define FUNC_NAME s_scm_set_network_interface_address
++{
++ char *c_name;
++ struct ifreq ifr;
++ struct sockaddr *c_address;
++ size_t sa_len;
++ int fd, err;
++
++ socket = SCM_COERCE_OUTPORT (socket);
++ SCM_VALIDATE_OPFPORT (1, socket);
++ fd = SCM_FPORT_FDES (socket);
++
++ memset (&ifr, 0, sizeof ifr);
++ c_name = scm_to_locale_string (name);
++ c_address = scm_to_sockaddr (address, &sa_len);
++
++ strncpy (ifr.ifr_name, c_name, sizeof ifr.ifr_name - 1);
++ memcpy (&ifr.ifr_addr, c_address, sa_len);
++
++ err = ioctl (fd, SIOCSIFADDR, &ifr);
++ if (err != 0)
++ err = errno;
++
++ free (c_name);
++ free (c_address);
++
++ if (err != 0)
++ {
++ errno = err;
++ SCM_SYSERROR;
++ }
++
++ return SCM_UNSPECIFIED;
++}
++#undef FUNC_NAME
++
++SCM_DEFINE (scm_set_network_interface_flags, "set-network-interface-flags",
++ 3, 0, 0,
++ (SCM socket, SCM name, SCM flags),
++ "Change the flags of network interface @var{name} to "
++ "@var{flags}.")
++#define FUNC_NAME s_scm_set_network_interface_flags
++{
++ struct ifreq ifr;
++ char *c_name;
++ int fd, err;
++
++ socket = SCM_COERCE_OUTPORT (socket);
++ SCM_VALIDATE_OPFPORT (1, socket);
++ fd = SCM_FPORT_FDES (socket);
++
++ memset (&ifr, 0, sizeof ifr);
++ c_name = scm_to_locale_string (name);
++ strncpy (ifr.ifr_name, c_name, sizeof ifr.ifr_name - 1);
++ ifr.ifr_flags = scm_to_short (flags);
++
++ err = ioctl (fd, SIOCSIFFLAGS, &ifr);
++ if (err != 0)
++ err = errno;
++
++ free (c_name);
++
++ if (err != 0)
++ {
++ errno = err;
++ SCM_SYSERROR;
++ }
++
++ return SCM_UNSPECIFIED;
++}
++#undef FUNC_NAME
++
++SCM_DEFINE (scm_network_interface_flags, "network-interface-flags",
++ 2, 0, 0,
++ (SCM socket, SCM name),
++ "Return the flags of network interface @var{name}.")
++#define FUNC_NAME s_scm_network_interface_flags
++{
++ struct ifreq ifr;
++ char *c_name;
++ int fd, err;
++
++ socket = SCM_COERCE_OUTPORT (socket);
++ SCM_VALIDATE_OPFPORT (1, socket);
++ fd = SCM_FPORT_FDES (socket);
++
++ memset (&ifr, 0, sizeof ifr);
++ c_name = scm_to_locale_string (name);
++ strncpy (ifr.ifr_name, c_name, sizeof ifr.ifr_name - 1);
++
++ err = ioctl (fd, SIOCGIFFLAGS, &ifr);
++ if (err != 0)
++ err = errno;
++
++ free (c_name);
++
++ if (err != 0)
++ {
++ errno = err;
++ SCM_SYSERROR;
++ }
++
++ return scm_from_short (ifr.ifr_flags);
++}
++#undef FUNC_NAME
++#endif
++
+ void
+ scm_init_posix ()
+ {
diff --git a/gnu/packages/patches/guile-3.0-relocatable.patch
b/gnu/packages/patches/guile-3.0-relocatable.patch
new file mode 100644
index 0000000..3d10163
--- /dev/null
+++ b/gnu/packages/patches/guile-3.0-relocatable.patch
@@ -0,0 +1,69 @@
+This patch changes Guile to use a default search path relative to the
+location of the `guile' binary, allowing it to be relocated.
+
+diff --git a/libguile/load.c b/libguile/load.c
+--- a/libguile/load.c
++++ b/libguile/load.c
+@@ -27,6 +27,7 @@
+ #include <stat-time.h>
+ #include <string.h>
+ #include <stdio.h>
++#include <libgen.h>
+ #include <sys/types.h>
+ #include <sys/stat.h>
+ #include <unistd.h>
+@@ -334,6 +335,32 @@ scm_init_load_path ()
+ SCM cpath = SCM_EOL;
+
+ #ifdef SCM_LIBRARY_DIR
++ char *program, *bin_dir, *prefix, *module_dir, *ccache_dir;
++
++ /* Determine the source and compiled module directories at run-time,
++ relative to the executable's location.
++
++ Note: Use /proc/self/exe instead of argv[0] because the latter is
++ not necessarily an absolute, nor a valid file name. */
++
++ program = scm_gc_malloc_pointerless (256, "string");
++ readlink ("/proc/self/exe", program, 256);
++
++ bin_dir = dirname (strdupa (program));
++
++ prefix = scm_gc_malloc_pointerless (strlen (bin_dir) + 4, "string");
++ strcpy (prefix, bin_dir);
++ strcat (prefix, "/..");
++ prefix = canonicalize_file_name (prefix);
++
++ module_dir = scm_gc_malloc_pointerless (strlen (prefix) + 50, "string");
++ strcpy (module_dir, prefix);
++ strcat (module_dir, "/share/guile/" SCM_EFFECTIVE_VERSION);
++
++ ccache_dir = scm_gc_malloc_pointerless (strlen (prefix) + 50, "string");
++ strcpy (ccache_dir, prefix);
++ strcat (ccache_dir, "/lib/guile/" SCM_EFFECTIVE_VERSION "/ccache");
++
+ env = scm_i_mirror_backslashes (getenv ("GUILE_SYSTEM_PATH"));
+ if (env && strcmp (env, "") == 0)
+ /* special-case interpret system-path=="" as meaning no system path
instead
+@@ -342,10 +369,7 @@ scm_init_load_path ()
+ else if (env)
+ path = scm_parse_path (scm_from_locale_string (env), path);
+ else
+- path = scm_list_4 (scm_from_utf8_string (SCM_LIBRARY_DIR),
+- scm_from_utf8_string (SCM_SITE_DIR),
+- scm_from_utf8_string (SCM_GLOBAL_SITE_DIR),
+- scm_from_utf8_string (SCM_PKGDATA_DIR));
++ path = scm_list_1 (scm_from_locale_string (module_dir));
+
+ env = scm_i_mirror_backslashes (getenv ("GUILE_SYSTEM_COMPILED_PATH"));
+ if (env && strcmp (env, "") == 0)
+@@ -355,8 +379,7 @@ scm_init_load_path ()
+ cpath = scm_parse_path (scm_from_locale_string (env), cpath);
+ else
+ {
+- cpath = scm_list_2 (scm_from_utf8_string (SCM_CCACHE_DIR),
+- scm_from_utf8_string (SCM_SITE_CCACHE_DIR));
++ cpath = scm_list_1 (scm_from_locale_string (ccache_dir));
+ }
+
+ #endif /* SCM_LIBRARY_DIR */