gnu: guile-static: Add bindings for low-level Linux syscalls.
* gnu/packages/make-bootstrap.scm (%guile-static): Add `guile-linux-syscalls.patch' as an input, and use it. * gnu/packages/patches/guile-linux-syscalls.patch: New file. * Makefile.am (dist_patch_DATA): Add it.
This commit is contained in:
		
							parent
							
								
									1dee732b81
								
							
						
					
					
						commit
						6956067b04
					
				
					 3 changed files with 239 additions and 1 deletions
				
			
		| 
						 | 
				
			
			@ -186,6 +186,7 @@ dist_patch_DATA =						\
 | 
			
		|||
  gnu/packages/patches/grub-gets-undeclared.patch		\
 | 
			
		||||
  gnu/packages/patches/guile-1.8-cpp-4.5.patch			\
 | 
			
		||||
  gnu/packages/patches/guile-default-utf8.patch			\
 | 
			
		||||
  gnu/packages/patches/guile-linux-syscalls.patch		\
 | 
			
		||||
  gnu/packages/patches/guile-relocatable.patch			\
 | 
			
		||||
  gnu/packages/patches/libapr-skip-getservbyname-test.patch 	\
 | 
			
		||||
  gnu/packages/patches/libevent-dns-tests.patch			\
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -412,6 +412,8 @@
 | 
			
		|||
                      ,(search-patch "guile-relocatable.patch"))
 | 
			
		||||
                     ("patch/utf8"
 | 
			
		||||
                      ,(search-patch "guile-default-utf8.patch"))
 | 
			
		||||
                     ("patch/syscalls"
 | 
			
		||||
                      ,(search-patch "guile-linux-syscalls.patch"))
 | 
			
		||||
                     ,@(package-inputs guile-2.0)))
 | 
			
		||||
                  (propagated-inputs
 | 
			
		||||
                   `(("bdw-gc" ,libgc)
 | 
			
		||||
| 
						 | 
				
			
			@ -443,7 +445,8 @@
 | 
			
		|||
                     ;; bootstrap.
 | 
			
		||||
                     #:patches
 | 
			
		||||
                     (list (assoc-ref %build-inputs "patch/relocatable")
 | 
			
		||||
                           (assoc-ref %build-inputs "patch/utf8"))
 | 
			
		||||
                           (assoc-ref %build-inputs "patch/utf8")
 | 
			
		||||
                           (assoc-ref %build-inputs "patch/syscalls"))
 | 
			
		||||
 | 
			
		||||
                     ;; There are uses of `dynamic-link' in
 | 
			
		||||
                     ;; {foreign,coverage}.test that don't fly here.
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
							
								
								
									
										234
									
								
								gnu/packages/patches/guile-linux-syscalls.patch
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										234
									
								
								gnu/packages/patches/guile-linux-syscalls.patch
									
										
									
									
									
										Normal file
									
								
							| 
						 | 
				
			
			@ -0,0 +1,234 @@
 | 
			
		|||
This patch adds bindings to Linux syscalls for which glibc has symbols.
 | 
			
		||||
 | 
			
		||||
diff --git a/libguile/posix.c b/libguile/posix.c
 | 
			
		||||
index 324f21b..ace5211 100644
 | 
			
		||||
--- a/libguile/posix.c
 | 
			
		||||
+++ b/libguile/posix.c
 | 
			
		||||
@@ -2286,6 +2286,227 @@ scm_init_popen (void)
 | 
			
		||||
 }
 | 
			
		||||
 #endif
 | 
			
		||||
 
 | 
			
		||||
+
 | 
			
		||||
+/* Linux! */
 | 
			
		||||
+
 | 
			
		||||
+#include <sys/mount.h>
 | 
			
		||||
+#include "libguile/foreign.h"
 | 
			
		||||
+#include "libguile/bytevectors.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;
 | 
			
		||||
+  unsigned long c_flags;
 | 
			
		||||
+  void *c_data;
 | 
			
		||||
+
 | 
			
		||||
+  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);
 | 
			
		||||
+  c_data = SCM_UNBNDP (data) ? NULL : scm_to_pointer (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 (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);
 | 
			
		||||
+
 | 
			
		||||
+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)
 | 
			
		||||
+    {
 | 
			
		||||
+      /* XXX: `insmod' actually provides better translation of some of
 | 
			
		||||
+	 the error codes.  */
 | 
			
		||||
+      errno = err;
 | 
			
		||||
+      SCM_SYSERROR;
 | 
			
		||||
+    }
 | 
			
		||||
+
 | 
			
		||||
+  return SCM_UNSPECIFIED;
 | 
			
		||||
+}
 | 
			
		||||
+#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
 | 
			
		||||
+
 | 
			
		||||
 void
 | 
			
		||||
 scm_init_posix ()
 | 
			
		||||
 {
 | 
			
		||||
		Reference in a new issue