From 3ba23f0582a432dfc04bfbf58f375f6643caae19 Mon Sep 17 00:00:00 2001 From: Marius Bakke Date: Mon, 27 Apr 2020 19:54:03 +0200 Subject: 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(-) create mode 100644 gnu/packages/patches/guile-2.2-default-utf8.patch create mode 100644 gnu/packages/patches/guile-3.0-linux-syscalls.patch create mode 100644 gnu/packages/patches/guile-3.0-relocatable.patch diff --git a/gnu/local.mk b/gnu/local.mk index 38e1d85b7b..0111ae2161 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 d336818299..fe86f810bf 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 0000000000..f55a6430c1 --- /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 0000000000..0d27f77ee2 --- /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 ++#include ++ ++#include "libguile/foreign.h" ++#include "libguile/bytevectors.h" ++#include ++ ++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 ++ ++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 . */ ++ ++#include ++#include ++#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 0000000000..3d101636dc --- /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 + #include + #include ++#include + #include + #include + #include +@@ -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 */ -- cgit v1.2.3