bug#63451: Guix pull not successful

2023-05-23 Thread a 
~ guix pull -l


Generation 1 Feb 05 2023 20:46:03
  guix 4b9e1e8
repository URL: https://git.savannah.gnu.org/git/guix.git
branch: master
commit: 4b9e1e84585270a40cec485046ce15387405d256
Generation 2 Feb 06 2023 10:23:38
  guix a582d86
repository URL: https://git.savannah.gnu.org/git/guix.git
branch: master
commit: a582d863465990642d331bc05bf073f47fb80908
Generation 3 May 08 2023 07:32:24
  guix e118b92
repository URL: https://git.savannah.gnu.org/git/guix.git
branch: master
commit: e118b92cfe7a598b71dbbda2622b7551f4a72104

News for channel 'guix'
  New `--with-configure-flag' transformation option
commit ae11fcb84ac478dfa56d322ef08890645183a087

The new `--with-configure-flag' package transformation option lets you
pass an additional configure flag to the build system of a
package.  For instance, here is how you would pass a flag to `cmake',
the build system of the `lapack' package:

 guix build lapack \
   --with-configure-flag=lapack=-DBUILD_COMPLEX=OFF

Run `info "(guix) Package Transformation Options"' for more info.
  Core packages updated
commit c919bfefd98bf2e29549539b4e28e6dc2a8a6f32

Core packages have been updated, following months of hard work by
contributors.  Noteworthy package upgrades include:

   * glibc 2.35;

   * Python 3.10;

   * Perl 5.36;

   * Mesa 22;

   * GCC 11 is now used as the default compiler.

A major highlight is the introduction of the so-called "full-source
bootstrap": packages are all built starting from a 500-byte program
called stage0, which is then used to build a higher-level interpreter,
a basic Scheme interpreter and C compiler (GNU Mes), and so on,
until GCC (the GNU Compiler Collection) is finally built.  This is a
premiere and a huge step forward in terms of transparency of
auditability.
  Linux-libre LTS kernel updated to 6.1
commit 21564fada141bfba25d471518b293b6004244c3a

...skipping...

   * GCC 11 is now used as the default compiler.

A major highlight is the introduction of the so-called "full-source
bootstrap": packages are all built starting from a 500-byte program
called stage0, which is then used to build a higher-level interpreter,
a basic Scheme interpreter and C compiler (GNU Mes), and so on,
until GCC (the GNU Compiler Collection) is finally built.  This is a
premiere and a huge step forward in terms of transparency of
auditability.
  Linux-libre LTS kernel updated to 6.1
commit 21564fada141bfba25d471518b293b6004244c3a

The default version of the `linux-libre-lts' kernel has been updated to
the 6.1 longterm release series.
  Using Guix within `guix shell --container'
commit 57db09aae73e3713a10c5253758d84e1046f80dc

The `--container' (or `-C') option lets you spawn a container---an
isolated software environment.  In some cases, it is useful to use
Guix from within the container, something that is normally not possible.

The new `--nesting' (or `-W') option lets you do exactly that: a
container created with that option will let you use `guix' commands,
including `guix shell -C', _inside_ of it.

The example below shows how to evaluate a `guix.scm' file to build a
package from within an isolated container, which is useful if
`guix.scm' is untrusted:

 guix shell -CW -- guix build -f guix.scm

Run `info "(guix) Invoking guix shell"' for more information.
  Linux-libre kernel updated to 6.2
commit 0e18c5e5bcb9204c278cfc75493d3b02b746d5c3

The default version of the linux-libre kernel has been updated to the
6.2 release series.
  New `rpm' format for the `guix pack' command
commit 598f4c509bbfec2b983a8ee246cce0a0fe45ec7f

RPM archives (with the .rpm file extension) can now be produced via the
`guix pack --format=rpm' command, providing an alternative
distribution path for software built with Guix.  Here is a simple
example that generates an RPM archive for the `hello' package:

 guix pack --format=rpm --symlink=/usr/bin/hello=bin/hello hello

See `info "(guix) Invoking guix pack"' for more information.

Generation 4 May 11 2023 13:02:21
  guix d6f6b57
repository URL: https://git.savannah.gnu.org/git/guix.git
branch: master
commit: d6f6b57766e95d2fa8af63d4460a2b303ca4d867
Generation 5 May 14 2023 21:53:47 (current)
  guix c5fa9dd
repository URL: https://git.savannah.gnu.org/git/guix.git
branch: master
commit: c5fa9dd0e96493307cc76ea098a6bca9b076e012


On Tue, May 16, 2023 at 10:06 AM Simon Tournier 
wrote:

> Hi,
>
> On Thu, 11 May 2023 at 13:03, a  wrote:
>
> > \Backtrace:
> > In ice-9/boot-9.scm:
> >222:29 19 (map1 (# (#) # x>)
> > # ?))
> >222:29 18 (map1 (# (#) # x>)
> > (# ()))> # ?))
> >222:17 17 (map1 (# > sanitize-location> (# ?))
> > In ice-9/psyntax.scm:
> > Exception thrown while printing backtrace:
> > Wrong type to apply: 129
> >
> > ice-9/boot-9.scm:3165:6: In procedure module-gensym:
> > In

bug#55358: [PATCH] services: docker: Add 'enable-userns-remap?' argument.

2023-05-23 Thread Remco van 't Veer 
* gnu/services/docker.scm (docker-configuration): Define the argument.
* gnu/services/docker.scm (docker-shepherd-service): Use it.
* doc/guix.texi (Docker Service): Document it.
---
 doc/guix.texi   | 27 ++-
 gnu/services/docker.scm | 28 +++-
 2 files changed, 53 insertions(+), 2 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index f4cca66d76..ae185ced61 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -100,7 +100,7 @@
 Copyright @copyright{} 2021 muradm@*
 Copyright @copyright{} 2021, 2022 Andrew Tropin@*
 Copyright @copyright{} 2021 Sarah Morgensen@*
-Copyright @copyright{} 2022 Remco van 't Veer@*
+Copyright @copyright{} 2022, 2023 Remco van 't Veer@*
 Copyright @copyright{} 2022 Aleksandr Vityazev@*
 Copyright @copyright{} 2022 Philip M@sup{c}Grath@*
 Copyright @copyright{} 2022 Karl Hallsby@*
@@ -38533,6 +38533,31 @@ Miscellaneous Services
 @item @code{enable-iptables?} (default @code{#t})
 Enable or disable the addition of iptables rules.
 
+@item @code{enable-userns-remap?} (default @code{#f})
+Enable remapping and subordinate user and group IDs.
+
+A system user account named @code{dockremap} and user group named
+@code{dockremap} will be created.  They must be mapped using the
+@file{/etc/subuid} and @file{/etc/subguid} files otherwise docker fail
+to startup.
+
+Here's an example service to setup both files:
+
+@lisp
+(simple-service
+   'subuid-subgid etc-service-type
+   (list `("subuid"
+   ,(plain-file "subuid"
+"dockremap:65536:65536\n"))
+ `("subgid"
+   ,(plain-file "subgid"
+"dockremap:65536:65536\n"
+@end lisp
+
+The above will remap to UID 0 (root) to 65536, UID 1 to 65537 etc.  For
+more information regarding the format of these files, consult
+@command{man 5 subuid} and @command{man 5 subgid}.
+
 @item @code{environment-variables} (default: @code{()})
 List of environment variables to set for @command{dockerd}.
 
diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm
index 741bab5a8c..e138a6be7e 100644
--- a/gnu/services/docker.scm
+++ b/gnu/services/docker.scm
@@ -5,6 +5,7 @@
 ;;; Copyright © 2020 Efraim Flashner 
 ;;; Copyright © 2020 Jesse Dowell 
 ;;; Copyright © 2021 Brice Waegeneire 
+;;; Copyright © 2023 Remco van 't Veer 
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -29,6 +30,7 @@ (define-module (gnu services docker)
   #:use-module (gnu services shepherd)
   #:use-module (gnu system setuid)
   #:use-module (gnu system shadow)
+  #:use-module (gnu packages admin)
   #:use-module (gnu packages docker)
   #:use-module (gnu packages linux)   ;singularity
   #:use-module (guix records)
@@ -62,6 +64,9 @@ (define-configuration docker-configuration
   (enable-iptables?
(boolean #t)
"Enable addition of iptables rules (enabled by default).")
+  (enable-userns-remap?
+   (boolean #f)
+   "Enable remapping and subordinate user and group IDs (disabled by 
default).")
   (environment-variables
(list '())
"Environment variables to set for dockerd")
@@ -107,6 +112,7 @@ (define (docker-shepherd-service config)
   (let* ((docker (docker-configuration-docker config))
  (enable-proxy? (docker-configuration-enable-proxy? config))
  (enable-iptables? (docker-configuration-enable-iptables? config))
+ (enable-userns-remap? (docker-configuration-enable-userns-remap? 
config))
  (environment-variables (docker-configuration-environment-variables 
config))
  (proxy (docker-configuration-proxy config))
  (debug? (docker-configuration-debug? config)))
@@ -135,6 +141,9 @@ (define (docker-shepherd-service config)
 #~(string-append
"--userland-proxy-path=" #$proxy 
"/bin/proxy"))
   '("--userland-proxy=false"))
+   #$@(if enable-userns-remap?
+  '("--userns-remap=dockremap")
+  '())
(if #$enable-iptables?
"--iptables"
"--iptables=false")
@@ -145,6 +154,18 @@ (define (docker-shepherd-service config)
  #:log-file "/var/log/docker.log"))
(stop #~(make-kill-destructor)
 
+(define %docker-remap-user-group
+  (user-group (name "dockremap")
+  (system? #t)))
+
+(define %docker-remap-user-account
+  (user-account (name "dockremap")
+(group "dockremap")
+(system? #t)
+(comment "Docker user namespace remap user")
+(home-directory "/var/empty")
+(shell (file-append shadow "/sbin/nologin"
+
 (define docker-service-type
   (service-type (name 'docker)
 (description "Provide capability to run Docker application
@@ -161,7 +182,12 @@ (define docker-service-type

bug#55358: docker containers stopped when doing guix install or guix shell

2023-05-23 Thread Remco van 't Veer 
Hi Csepp,

2023/05/20 00:29, Csepp:

> Remco van 't Veer  writes:
>
>> Hi Maxim and Zimoun,
>>
>> 2023/02/09 13:26, Remco van 't Veer:
>>
>>> I think I know what is causing the issue.  Both the "standard" mysql and
>>> postgres containers use user-id 999 to run the database service (this
>>> seems like a common practice because the redis container is configured
>>> similarly).  That user-id is also configured as guixbuilder01 so I guess
>>> the guix daemon is killing those when processes when it finishes doing
>>> builds.
>>
>> I found a solution / workaround for this problem by using
>> "userns-remap".  This feature allows the remapping of uids and guids to
>> different ranges.  I tried it by hacking the required files into my
>> etc-directory and it works; guix no long kills my database containers.
>>
>> I'd like to add this feature to docker-service-type having a new
>> configuration option named enable-userns-remap? which introduces a new
>> user and group (both named dockremap) to do the remapping by adding some
>> configurable number to the uids and guids of the running container.  In
>> /etc/subuid and /etc/subgid it would look like:
>>
>>   dockremap:10:65536
>>
>> See https://docs.docker.com/engine/security/userns-remap/ for
>> documentation about this.
>>
>> WDYT?
>>
>> Cheers,
>> Remco
>
> The rootless podman example that was shared a few months ago could be
> relevant to this, since that also adds a subuid/subgid mapping.

Thanks!  Borrowed that.

For future reference:

  https://lists.gnu.org/archive/html/guix-devel/2023-03/msg00176.html

Cheers,
Remco

bug#63658: solaar: make udev rules available at /etc/udev/rules.d

2023-05-23 Thread Julian Flake 

Hi,

package solaar (1.0.7) contains a file
/share/solaar/udev-rules.d/42-logitech-unify-permissions.rules 
. It

should be made available at
/etc/udev/rules.d/42-logitech-unify-permissions.rules

Best Regards,
Julian

bug#63659: 'guix offload status' should continue on missing machine

2023-05-23 Thread Efraim Flashner 
I have 8 machines in my /etc/guix/machines.scm file and I often find
myself editing it often. Most of the machines are various aarch64 or
riscv64 boards, and they go online and offline often depending on the
weather and what I have them build.

Currently I have this:
(ins)efraim@3900XT ~$ guix offload status
guix offload: getting status of 5 build machines defined in 
'/etc/guix/machines.scm'...
guix offload: error: failed to connect to 'pine64': Failed to resolve hostname 
pine64 (Name or service not known)

What I'd like:
(ins)efraim@3900XT ~$ guix offload status
guix offload: getting status of 5 build machines defined in 
'/etc/guix/machines.scm'...
guix offload: error: failed to connect to 'pine64': Failed to resolve hostname 
pine64 (Name or service not known)
guix offload: warning: machine 'pbp' is 6 seconds behind
pbp
  kernel: Linux 6.2.10-1-MANJARO-ARM
  architecture: aarch64
  host name: pbp
  normalized load: 0.00
  free disk space: 18542.41 MiB
  time difference: -6 s
...

-- 
Efraim Flashner  רנשלפ םירפא
GPG key = A28B F40C 3E55 1372 662D  14F7 41AA E7DC CA3D 8351
Confidentiality cannot be guaranteed on emails sent or received unencrypted


signature.asc
Description: PGP signature

bug#63660: Manual: Example for multiple SLiM instances doesn't work

2023-05-23 Thread Ivan Vilata i Balaguer 
Hi!  Under section "X Window", the Guix Manual provides an example on "how to
replace the default GDM service with two SLiM services on tty7 and tty8":

```
(use-modules (gnu services)
   (gnu services desktop)
   (gnu services xorg))

(operating-system
  ;; ...
  (services (cons* (service slim-service-type (slim-configuration
   (display ":0")
   (vt "vt7")))
   (service slim-service-type (slim-configuration
   (display ":1")
   (vt "vt8")))
   (modify-services %desktop-services
 (delete gdm-service-type)
```

Unfortunately, reconfiguring a system (on commit 14c03807) reports the
following error:

guix system: error: service 'xorg-server' provided more than once

Actually, leaving just the first `service` entry still produces the same
error.  One needs to also add a second argument to `xorg-configuration`, like
this:

```
(set-xorg-configuration
 (xorg-configuration […])
 slim-service-type)
```

And then the `service` entry can actually be removed.  To summarize, these are
the changes that I needed for actually having *one* operational SLiM instance:

```
(operating-system
 (packages (cons*
(specification->package "slim")
%base-packages))

 (services (cons*
(set-xorg-configuration
 (xorg-configuration […])
 slim-service-type)

(modify-services
 %desktop-services
 (delete gdm-service-type)
```

For completeness sake, adding the two `service` entries causes the error:

guix system: error: more than one target service of type 'slim'

as already discussed in .  There's a
possible workaround explained there which implies duplicating the Xorg server
configuration.

But maybe I missed some point in the instructions.  Otherwise, I wonder
whether they should be either fixed, or updated for a single-instance example
that does work (which may be ok as that's probably the most common use case).

Thanks, and cheers!

-- 
Ivan Vilata i Balaguer -- https://elvil.net/


signature.asc
Description: PGP signature

bug#63516: [PATCH Guile-Netlink 07/11] addr: Extract 'new-address-message->address'.

2023-05-23 Thread Ludovic Courtès 
* ip/addr.scm (new-address-message->address): New procedure.
(get-addrs): Use it, and use 'filter-map' instead of 'filter' followed
by 'map'.
---
 ip/addr.scm | 40 +++-
 1 file changed, 19 insertions(+), 21 deletions(-)

diff --git a/ip/addr.scm b/ip/addr.scm
index fcb286f..f82d733 100644
--- a/ip/addr.scm
+++ b/ip/addr.scm
@@ -183,6 +183,24 @@
   (close-port sock)
   (answer-ok? (last answer)
 
+(define (new-address-message->address msg)
+  "If MSG has type 'RTM_NEWADDR', return the corresponding  object.
+Otherwise return #f."
+  (and (eqv? (message-kind msg) RTM_NEWADDR)
+   (let* ((data (message-data msg))
+  (attrs (addr-message-attrs data)))
+ (make-addr (addr-message-family data)
+(addr-message-prefix-len data)
+(map int->ifa-flag
+ (split-flags (logior (addr-message-flags data)
+  (get-attr attrs IFA_FLAGS
+(addr-message-scope data)
+(addr-message-index data)
+(get-attr attrs IFA_LABEL)
+(get-attr attrs IFA_ADDRESS)
+(get-attr attrs IFA_BROADCAST)
+(get-attr attrs IFA_CACHEINFO)
+
 (define (get-addrs)
   (define request-num (random 65535))
   (define message
@@ -195,27 +213,7 @@
   (let ((sock (connect-route)))
 (send-msg message sock)
 (let* ((answer (receive-and-decode-msg sock %default-route-decoder))
-   (addrs (filter
-(lambda (msg) (equal? (message-kind msg) RTM_NEWADDR))
-answer))
-   (addrs (map
-(lambda (msg)
-  (let* ((data (message-data msg))
- (attrs (addr-message-attrs data)))
-(make-addr
-  (addr-message-family data)
-  (addr-message-prefix-len data)
-  (map
-int->ifa-flag
-(split-flags (logior (addr-message-flags data)
- (get-attr attrs IFA_FLAGS
-  (addr-message-scope data)
-  (addr-message-index data)
-  (get-attr attrs IFA_LABEL)
-  (get-attr attrs IFA_ADDRESS)
-  (get-attr attrs IFA_BROADCAST)
-  (get-attr attrs IFA_CACHEINFO
-addrs)))
+   (addrs (filter-map new-address-message->address answer)))
   (close-port sock)
   addrs)))
 
-- 
2.40.1

bug#63516: [PATCH Guile-Netlink 03/11] connection: Throw upon errors in FFI bindings.

2023-05-23 Thread Ludovic Courtès 
* netlink/connection.scm (syscall->procedure): New procedure.
(ffi-sendto, ffi-recvmsg, ffi-bind): Use it.
---
 netlink/connection.scm | 35 ---
 1 file changed, 24 insertions(+), 11 deletions(-)

diff --git a/netlink/connection.scm b/netlink/connection.scm
index 6f41ef8..f4a5cc6 100644
--- a/netlink/connection.scm
+++ b/netlink/connection.scm
@@ -1,7 +1,8 @@
  This file is part of Guile Netlink
 
  Copyright (C) 2021 Julien Lepiller 
- 
+ Copyright (C) 2023 Ludovic Courtès 
+
  This library 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
@@ -24,6 +25,7 @@
   #:use-module (system foreign)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
+  #:use-module (srfi srfi-71)
   #:export (connect
 connect-route
 close-socket
@@ -34,16 +36,27 @@
 
 (define libc (dynamic-link))
 
-(define ffi-sendto (pointer->procedure int
-   (dynamic-func "sendto" libc)
-   (list int '* size_t int '* int)
-   #:return-errno? #t))
-(define ffi-recvmsg (pointer->procedure int
-(dynamic-func "recvmsg" libc)
-(list int '* int)))
-(define ffi-bind (pointer->procedure int
- (dynamic-func "bind" libc)
- (list int '* int)))
+(define (syscall->procedure return-type function
+argument-types)
+  "Return a procedure that calls FUNCTION, a syscall wrapper from the C library
+with the given RETURN-TYPE and ARGUMENT-TYPES."
+  (let ((proc (pointer->procedure return-type
+  (dynamic-func function libc)
+  argument-types
+  #:return-errno? #t)))
+(lambda args
+  (let ((ret errno (apply proc args)))
+(when (< ret 0)
+  (throw 'system-error function "~A"
+ (list (strerror errno)) (list errno)))
+ret
+
+(define ffi-sendto
+  (syscall->procedure int "sendto" (list int '* size_t int '* int)))
+(define ffi-recvmsg
+  (syscall->procedure int "recvmsg" (list int '* int)))
+(define ffi-bind
+  (syscall->procedure int "bind" (list int '* int)))
 
 ;; define simple functions to open/close sockets
 (define (open-socket proto)
-- 
2.40.1

bug#63516: [PATCH Guile-Netlink 01/11] connection: Remove unused procedure.

2023-05-23 Thread Ludovic Courtès 
* netlink/connection.scm (ffi-sendmsg): Remove.
---
 netlink/connection.scm | 4 
 1 file changed, 4 deletions(-)

diff --git a/netlink/connection.scm b/netlink/connection.scm
index 4d2ceca..11f004f 100644
--- a/netlink/connection.scm
+++ b/netlink/connection.scm
@@ -40,10 +40,6 @@
 (define ffi-close (pointer->procedure void
   (dynamic-func "close" libc)
   (list int)))
-(define ffi-sendmsg (pointer->procedure int
-(dynamic-func "sendmsg" libc)
-(list int '* int)
-#:return-errno? #t))
 (define ffi-sendto (pointer->procedure int
(dynamic-func "sendto" libc)
(list int '* size_t int '* int)
-- 
2.40.1

bug#63516: [PATCH Guile-Netlink 04/11] connection: Add support for suspendable sockets.

2023-05-23 Thread Ludovic Courtès 
* netlink/connection.scm (syscall->procedure): Add #:waiter.
Distinguish first argument and call WAITER upon EWOULDBLOCK or EAGAIN
when the first argument is a port.
(ffi-sendto, ffi-recvmsg, ffi-bind): Pass #:waiter.
(connect, send-msg, receive-msg): Pass SOCK instead of (fileno sock).
---
 netlink/connection.scm | 45 --
 1 file changed, 30 insertions(+), 15 deletions(-)

diff --git a/netlink/connection.scm b/netlink/connection.scm
index f4a5cc6..42f7dbb 100644
--- a/netlink/connection.scm
+++ b/netlink/connection.scm
@@ -26,6 +26,8 @@
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
   #:use-module (srfi srfi-71)
+  #:autoload   (ice-9 suspendable-ports) (current-read-waiter
+  current-write-waiter)
   #:export (connect
 connect-route
 close-socket
@@ -36,27 +38,40 @@
 
 (define libc (dynamic-link))
 
-(define (syscall->procedure return-type function
-argument-types)
+(define* (syscall->procedure return-type function
+ argument-types
+ #:key waiter)
   "Return a procedure that calls FUNCTION, a syscall wrapper from the C library
-with the given RETURN-TYPE and ARGUMENT-TYPES."
+with the given RETURN-TYPE and ARGUMENT-TYPES.  When WAITER is true and the
+first argument is a port, call it upon EAGAIN or EWOULDBLOCK."
   (let ((proc (pointer->procedure return-type
   (dynamic-func function libc)
   argument-types
   #:return-errno? #t)))
-(lambda args
-  (let ((ret errno (apply proc args)))
-(when (< ret 0)
-  (throw 'system-error function "~A"
- (list (strerror errno)) (list errno)))
-ret
+(lambda (first . rest)
+  (let loop ()
+(let ((ret errno (apply proc
+(if (port? first) (fileno first) first)
+rest)))
+  (if (< ret 0)
+  (if (and (memv errno (list EAGAIN EWOULDBLOCK))
+   (port? first) waiter)
+  (begin
+((waiter) first)
+(loop))
+  (throw 'system-error function "~A"
+ (list (strerror errno)) (list errno)))
+  ret))
 
 (define ffi-sendto
-  (syscall->procedure int "sendto" (list int '* size_t int '* int)))
+  (syscall->procedure int "sendto" (list int '* size_t int '* int)
+  #:waiter (lambda () (current-write-waiter
 (define ffi-recvmsg
-  (syscall->procedure int "recvmsg" (list int '* int)))
+  (syscall->procedure int "recvmsg" (list int '* int)
+  #:waiter (lambda () (current-read-waiter
 (define ffi-bind
-  (syscall->procedure int "bind" (list int '* int)))
+  (syscall->procedure int "bind" (list int '* int)
+  #:waiter (lambda () (current-read-waiter
 
 ;; define simple functions to open/close sockets
 (define (open-socket proto)
@@ -89,7 +104,7 @@ such as 'bind' cannot handle."
 
 (define* (connect proto addr)
   (let ((sock (open-socket proto)))
-(ffi-bind (fileno sock)
+(ffi-bind sock
   (bytevector->pointer addr)
   12)
 sock))
@@ -105,7 +120,7 @@ such as 'bind' cannot handle."
   (let* ((len (data-size msg))
  (bv (make-bytevector len)))
 (serialize msg 0 bv)
-(ffi-sendto (fileno sock) (bytevector->pointer bv) len 0 %null-pointer 0)))
+(ffi-sendto sock (bytevector->pointer bv) len 0 %null-pointer 0)))
 
 (define* (receive-msg sock #:key (addr (get-addr AF_NETLINK 0 0)))
   (let* ((len (* 1024 32))
@@ -115,7 +130,7 @@ such as 'bind' cannot handle."
  iovec 1
  %null-pointer 0
  0))
- (size (ffi-recvmsg (fileno sock) msghdr 0))
+ (size (ffi-recvmsg sock msghdr 0))
  (answer (make-bytevector size)))
 (when (> size (* 1024 32))
   (raise (condition (&netlink-answer-too-big-error (size size)
-- 
2.40.1

bug#63516: [PATCH Guile-Netlink 00/11] Add 'wait-for-link' and related code

2023-05-23 Thread Ludovic Courtès 
Hi Julien,

As a followup to , here is code that
lets us wait for a link to show up “the right way”—i.e., without polling.
It works over SOCK_NONBLOCK sockets, for use in Fibers programs.

I tested it in a VM created with ‘guix system vm’.  If the “ens3” device
is already there, (wait-for-link "ens3") returns immediately.  Then I
ran “rmmod e1000” to make the device disappear, and made another
(wait-for-link "ens3") call: that call returns once I’ve run “modprobe e1000”
in another terminal.  Wonderful.  :-)

Now, it would be good to have a test suite that can run without
complicated setups.  We should check the strategy used by libnl, systemd,
and the likes.

Thoughts?

Ludo’.

Ludovic Courtès (11):
  connection: Remove unused procedure.
  connection: Use Guile's 'socket' procedure to open a socket.
  connection: Throw upon errors in FFI bindings.
  connection: Add support for suspendable sockets.
  connection: Allow users to pass extra SOCK_ flags to 'socket'.
  link: Extract 'new-link-message->link'.
  addr: Extract 'new-address-message->address'.
  connection: Add 'add-socket-membership'.
  error: Add 'sub-type' field to '&netlink-decoder-error' and use it.
  doc: Add indexes.
  link: Add 'wait-for-link'.

 doc/guile-netlink.texi |  51 +++--
 ip/addr.scm|  46 +++
 ip/link.scm| 122 ++-
 ip/route.scm   |   6 +-
 netlink/connection.scm | 126 +++--
 netlink/constant.scm   |  40 +
 netlink/data.scm   |  13 +++--
 netlink/error.scm  |   4 +-
 8 files changed, 303 insertions(+), 105 deletions(-)


base-commit: beceb4cfea4739954e558411f46e07425891c774
-- 
2.40.1

bug#63516: [PATCH Guile-Netlink 02/11] connection: Use Guile's 'socket' procedure to open a socket.

2023-05-23 Thread Ludovic Courtès 
This gives us a real port, which can then let us benefit from the
suspendable port facilities.

* netlink/connection.scm (ffi-socket, ffi-close): Remove.
(socket): Remove record type.
(open-socket): Use Guile's 'socket' procedure.
(close-socket): Make a deprecated alias for 'close-port'.
(get-addr): Add docstring.
(connect, send-msg, receive-msg): Use 'fileno' instead of 'socket-num'.
* ip/addr.scm (addr-del, addr-add, get-addrs): Use 'close-port' instead
of 'close-socket'.
* ip/link.scm (get-links, link-set, link-add, link-del): Likewise.
* ip/route.scm (route-del, route-add, get-routes): Likewise.
* doc/guile-netlink.texi (Netlink Connections): Remove 'close-socket'.
---
 doc/guile-netlink.texi |  4 
 ip/addr.scm|  6 +++---
 ip/link.scm|  8 
 ip/route.scm   |  6 +++---
 netlink/connection.scm | 35 +--
 5 files changed, 23 insertions(+), 36 deletions(-)

diff --git a/doc/guile-netlink.texi b/doc/guile-netlink.texi
index 548e47b..48ca6d7 100644
--- a/doc/guile-netlink.texi
+++ b/doc/guile-netlink.texi
@@ -256,10 +256,6 @@ rtnetlink protocol, binds it to the kernel and returns it. 
 By passing the
 optional @var{groups} keyword, you can select broadcast groups to subscribe to.
 @end deffn
 
-@deffn {Scheme Procedure} close-socket @var{socket}
-Closes a netlink socket.  The socket cannot be used afterwards.
-@end deffn
-
 @deffn {Scheme Procedure} send-msg @var{msg} @var{sock} [#:@var{addr}]
 Send @var{msg} (it must be of type message, @xref{Netlink Headers}) to
 @var{addr} using @var{sock}.  If not passed, @var{addr} is the address of
diff --git a/ip/addr.scm b/ip/addr.scm
index 0976ab9..fcb286f 100644
--- a/ip/addr.scm
+++ b/ip/addr.scm
@@ -100,7 +100,7 @@
   (let ((sock (connect-route)))
 (send-msg message sock)
 (let ((answer (receive-and-decode-msg sock %default-route-decoder)))
-  (close-socket sock)
+  (close-port sock)
   (answer-ok? (last answer)
 
 (define* (addr-add device cidr #:key (ipv6? #f) (peer (cidr->addr cidr))
@@ -180,7 +180,7 @@
   (let ((sock (connect-route)))
 (send-msg message sock)
 (let ((answer (receive-and-decode-msg sock %default-route-decoder)))
-  (close-socket sock)
+  (close-port sock)
   (answer-ok? (last answer)
 
 (define (get-addrs)
@@ -216,7 +216,7 @@
   (get-attr attrs IFA_BROADCAST)
   (get-attr attrs IFA_CACHEINFO
 addrs)))
-  (close-socket sock)
+  (close-port sock)
   addrs)))
 
 (define print-addr
diff --git a/ip/link.scm b/ip/link.scm
index 0957a5e..814a008 100644
--- a/ip/link.scm
+++ b/ip/link.scm
@@ -94,7 +94,7 @@
(get-attr attrs IFLA_ADDRESS)
(get-attr attrs IFLA_BROADCAST
links)))
-  (close-socket sock)
+  (close-port sock)
   links)))
 
 (define print-link
@@ -246,7 +246,7 @@ criteria."
 (let ((answer (receive-and-decode-msg sock %default-route-decoder)))
   (when netnsfd
 (close netnsfd))
-  (close-socket sock)
+  (close-port sock)
   (answer-ok? (last answer)
 
 (define* (bond-type-args #:key (mode #f) (miimon #f) (lacp-active #f) 
(lacp-rate #f)
@@ -364,7 +364,7 @@ 
balance-rr|active-backup|balance-xor|broadcast|802.3ad|balance-tlb|balance-alb"
   (let ((sock (connect-route)))
 (send-msg message sock)
 (let ((answer (receive-and-decode-msg sock %default-route-decoder)))
-  (close-socket sock)
+  (close-port sock)
   (answer-ok? (last answer)
 
 (define* (link-del device)
@@ -390,5 +390,5 @@ 
balance-rr|active-backup|balance-xor|broadcast|802.3ad|balance-tlb|balance-alb"
   (let ((sock (connect-route)))
 (send-msg message sock)
 (let ((answer (receive-and-decode-msg sock %default-route-decoder)))
-  (close-socket sock)
+  (close-port sock)
   (answer-ok? (last answer)
diff --git a/ip/route.scm b/ip/route.scm
index bf43c18..d5e1275 100644
--- a/ip/route.scm
+++ b/ip/route.scm
@@ -106,7 +106,7 @@
   (let ((sock (connect-route)))
 (send-msg message sock)
 (let ((answer (receive-and-decode-msg sock %default-route-decoder)))
-  (close-socket sock)
+  (close-port sock)
   (answer-ok? (last answer)
 
 (define* (route-add dest
@@ -170,7 +170,7 @@
   (let ((sock (connect-route)))
 (send-msg message sock)
 (let ((answer (receive-and-decode-msg sock %default-route-decoder)))
-  (close-socket sock)
+  (close-port sock)
   (answer-ok? (last answer)
 
 (define (link-ref links id)
@@ -221,7 +221,7 @@
(get-attr attrs RTA_PRIORITY)
(link-ref links (get-attr attrs RTA_OIF)
  routes)))
-  (close-socket sock)
+  (close-port sock)
   routes)))
 
 (define print-route
diff --git a/netlink/connection.scm b/netlink/connection.scm
index 11f004f..6f41ef8 100644
--- a/netlink/connection.scm
++

bug#63516: [PATCH Guile-Netlink 05/11] connection: Allow users to pass extra SOCK_ flags to 'socket'.

2023-05-23 Thread Ludovic Courtès 
In particular, this lets users pass SOCK_NONBLOCK.

* netlink/connection.scm (open-socket): Add 'flags' parameter and honor it.
(connect): Add #:flags and pass it to 'open-socket'.
(connect-route): Add #:flags and pass it to 'connect'.
* doc/guile-netlink.texi (Netlink Connections): Adjust accordingly.
---
 doc/guile-netlink.texi | 11 +--
 netlink/connection.scm | 13 +++--
 2 files changed, 16 insertions(+), 8 deletions(-)

diff --git a/doc/guile-netlink.texi b/doc/guile-netlink.texi
index 48ca6d7..bdb20c6 100644
--- a/doc/guile-netlink.texi
+++ b/doc/guile-netlink.texi
@@ -240,7 +240,8 @@ to communicate or 0 for the kernel. @var{groups} is an 
integer representing
 the set of broadcast groups to which the connection subscribes.
 @end deffn
 
-@deffn {Scheme Procedure} connect @var{proto} @var{addr}
+@cindex non-blocking socket
+@deffn {Scheme Procedure} connect @var{proto} @var{addr} [#:flags 0]
 Creates a netlink socket for @var{proto} and binds it to @var{addr}.
 
 @var{proto} is the integer representing the protocol.  For instance, rtnetlink
@@ -248,12 +249,18 @@ can be selected by usin @code{NETLINK_ROUTE} (defined in
 @code{(netlink constant)}).
 
 @var{addr} is a bytevector, as returned by @code{get-addr}.
+
+@var{flags} is a set of additional flags to pass as the second argument
+to the @code{socket} system call---e.g., @code{SOCK_NONBLOCK}.
 @end deffn
 
-@deffn {Scheme Procedure} connect-route [#:groups @code{0}]
+@deffn {Scheme Procedure} connect-route [#:groups 0] [#:flags 0]
 This procedure is a wrapper for @code{connect} that creates a socket for the
 rtnetlink protocol, binds it to the kernel and returns it.  By passing the
 optional @var{groups} keyword, you can select broadcast groups to subscribe to.
+
+@var{flags} is a set of additional flags to pass as the second argument
+to the @code{socket} system call---e.g., @code{SOCK_NONBLOCK}.
 @end deffn
 
 @deffn {Scheme Procedure} send-msg @var{msg} @var{sock} [#:@var{addr}]
diff --git a/netlink/connection.scm b/netlink/connection.scm
index 42f7dbb..4ad9b10 100644
--- a/netlink/connection.scm
+++ b/netlink/connection.scm
@@ -74,8 +74,8 @@ first argument is a port, call it upon EAGAIN or EWOULDBLOCK."
   #:waiter (lambda () (current-read-waiter
 
 ;; define simple functions to open/close sockets
-(define (open-socket proto)
-  (socket AF_NETLINK (logior SOCK_RAW SOCK_CLOEXEC) proto))
+(define (open-socket proto flags)
+  (socket AF_NETLINK (logior SOCK_RAW SOCK_CLOEXEC flags) proto))
 
 (define (close-socket sock)
   (issue-deprecation-warning
@@ -102,15 +102,16 @@ such as 'bind' cannot handle."
 (list '* size_t)
 (list content size)))
 
-(define* (connect proto addr)
-  (let ((sock (open-socket proto)))
+(define* (connect proto addr #:key (flags 0))
+  (let ((sock (open-socket proto flags)))
 (ffi-bind sock
   (bytevector->pointer addr)
   12)
 sock))
 
-(define* (connect-route #:key (groups 0))
-  (connect NETLINK_ROUTE (get-addr AF_NETLINK 0 groups)))
+(define* (connect-route #:key (groups 0) (flags 0))
+  (connect NETLINK_ROUTE (get-addr AF_NETLINK 0 groups)
+   #:flags flags))
 
 (define* (send-msg msg sock #:key (addr (get-addr AF_NETLINK 0 0)))
   (unless (message? msg)
-- 
2.40.1

bug#63516: [PATCH Guile-Netlink 08/11] connection: Add 'add-socket-membership'.

2023-05-23 Thread Ludovic Courtès 
* netlink/connection.scm (socklen_t, ffi-setsockopt, SOL_NETLINK)
* netlink/connection.scm (NETLINK_ADD_MEMBERSHIP):
(NETLINK_DROP_MEMBERSHIP, NETLINK_PKTINFO)
(NETLINK_BROADCAST_ERROR, NETLINK_NO_ENOBUFS)
(NETLINK_LISTEN_ALL_NSID, NETLINK_LIST_MEMBERSHIPS)
(NETLINK_CAP_ACK, NETLINK_EXT_ACK, NETLINK_GET_STRICT_CHK): New
variables.
(add-socket-membership): New procedure.
* netlink/constant.scm (int->rtnetlink-group): New enum.
* doc/guile-netlink.texi (Netlink Connections): Document it.
---
 doc/guile-netlink.texi | 18 ++
 netlink/connection.scm | 26 ++
 netlink/constant.scm   | 40 
 3 files changed, 84 insertions(+)

diff --git a/doc/guile-netlink.texi b/doc/guile-netlink.texi
index bdb20c6..19db019 100644
--- a/doc/guile-netlink.texi
+++ b/doc/guile-netlink.texi
@@ -263,6 +263,24 @@ optional @var{groups} keyword, you can select broadcast 
groups to subscribe to.
 to the @code{socket} system call---e.g., @code{SOCK_NONBLOCK}.
 @end deffn
 
+@cindex subscribing, to an rtnetlink group
+@deffn {Scheme Procedure} add-socket-membership @var{sock} @var{group}
+Make @var{sock} a member of @var{group}, an @code{RTNLGRP_} constant,
+meaning that it will be subscribed to events of that group.
+
+For example, here is how you could create a netlink socket and subscribe
+it to the ``link'' group so that it receives notifications for new and
+removed links:
+
+@lisp
+(let ((sock (connect-route)))
+  (add-socket-membership sock RTNLGRP_LINK)
+  @dots{})
+@end lisp
+
+This procedure is implemented as a @code{setsockopt} call.
+@end deffn
+
 @deffn {Scheme Procedure} send-msg @var{msg} @var{sock} [#:@var{addr}]
 Send @var{msg} (it must be of type message, @xref{Netlink Headers}) to
 @var{addr} using @var{sock}.  If not passed, @var{addr} is the address of
diff --git a/netlink/connection.scm b/netlink/connection.scm
index 4ad9b10..1b6e1c5 100644
--- a/netlink/connection.scm
+++ b/netlink/connection.scm
@@ -30,6 +30,7 @@
   current-write-waiter)
   #:export (connect
 connect-route
+add-socket-membership
 close-socket
 send-msg
 receive-msg
@@ -73,10 +74,35 @@ first argument is a port, call it upon EAGAIN or 
EWOULDBLOCK."
   (syscall->procedure int "bind" (list int '* int)
   #:waiter (lambda () (current-read-waiter
 
+(define socklen_t uint32) ;per 
+(define ffi-setsockopt
+  (syscall->procedure int "setsockopt" (list int int int '* socklen_t)))
+
+(define SOL_NETLINK 270)
+
+(define NETLINK_ADD_MEMBERSHIP 1)
+(define NETLINK_DROP_MEMBERSHIP 2)
+(define NETLINK_PKTINFO 3)
+(define NETLINK_BROADCAST_ERROR 4)
+(define NETLINK_NO_ENOBUFS 5)
+(define NETLINK_LISTEN_ALL_NSID 8)
+(define NETLINK_LIST_MEMBERSHIPS 9)
+(define NETLINK_CAP_ACK 10)
+(define NETLINK_EXT_ACK 11)
+(define NETLINK_GET_STRICT_CHK 12)
+
 ;; define simple functions to open/close sockets
 (define (open-socket proto flags)
   (socket AF_NETLINK (logior SOCK_RAW SOCK_CLOEXEC flags) proto))
 
+(define (add-socket-membership sock group)
+  "Make @var{sock} a member of @var{group}, an @code{RTNLGRP_} constant,
+meaning that it will be subscribed to events of that group."
+  (let ((bv (make-bytevector (sizeof int
+(bytevector-uint-set! bv 0 group (native-endianness) (sizeof int))
+(ffi-setsockopt sock SOL_NETLINK NETLINK_ADD_MEMBERSHIP
+(bytevector->pointer bv) (bytevector-length bv
+
 (define (close-socket sock)
   (issue-deprecation-warning
"'close-socket' is deprecated; use 'close-port' instead.")
diff --git a/netlink/constant.scm b/netlink/constant.scm
index e7a681e..02c905a 100644
--- a/netlink/constant.scm
+++ b/netlink/constant.scm
@@ -345,3 +345,43 @@
 (define-enum int->link-type
   (ARPHRD_ETHER 1)
   (ARPHRD_LOOPBACK 772))
+
+;; enum rtnetlink_groups
+(define-enum int->rtnetlink-group
+  (RTNLGRP_NONE 0)
+  RTNLGRP_LINK
+  RTNLGRP_NOTIFY
+  RTNLGRP_NEIGH
+  RTNLGRP_TC
+  RTNLGRP_IPV4_IFADDR
+  RTNLGRP_IPV4_MROUTE
+  RTNLGRP_IPV4_ROUTE
+  RTNLGRP_IPV4_RULE
+  RTNLGRP_IPV6_IFADDR
+  RTNLGRP_IPV6_MROUTE
+  RTNLGRP_IPV6_ROUTE
+  RTNLGRP_IPV6_IFINFO
+  RTNLGRP_DECnet_IFADDR
+  RTNLGRP_NOP2
+  RTNLGRP_DECnet_ROUTE
+  RTNLGRP_DECnet_RULE
+  RTNLGRP_NOP4
+  RTNLGRP_IPV6_PREFIX
+  RTNLGRP_IPV6_RULE
+  RTNLGRP_ND_USEROPT
+  RTNLGRP_PHONET_IFADDR
+  RTNLGRP_PHONET_ROUTE
+  RTNLGRP_DCB
+  RTNLGRP_IPV4_NETCONF
+  RTNLGRP_IPV6_NETCONF
+  RTNLGRP_MDB
+  RTNLGRP_MPLS_ROUTE
+  RTNLGRP_NSID
+  RTNLGRP_MPLS_NETCONF
+  RTNLGRP_IPV4_MROUTE_R
+  RTNLGRP_IPV6_MROUTE_R
+  RTNLGRP_NEXTHOP
+  RTNLGRP_BRVLAN
+  RTNLGRP_MCTP_IFADDR
+  RTNLGRP_TUNNEL
+  RTNLGRP_STATS)
-- 
2.40.1

bug#63516: [PATCH Guile-Netlink 11/11] link: Add 'wait-for-link'.

2023-05-23 Thread Ludovic Courtès 
* ip/link.scm (message->event+link): New procedure.
(new-link-message->link): Use it.
(monitor-links, wait-for-link): New procedures.
* doc/guile-netlink.texi (Link): Document 'wait-for-link'.
---
 doc/guile-netlink.texi |   8 
 ip/link.scm| 102 ++---
 2 files changed, 94 insertions(+), 16 deletions(-)

diff --git a/doc/guile-netlink.texi b/doc/guile-netlink.texi
index 4dbeafe..3355c27 100644
--- a/doc/guile-netlink.texi
+++ b/doc/guile-netlink.texi
@@ -567,6 +567,14 @@ Returns the list of existing links in the system, as a 
list of @code{}
 objects.
 @end deffn
 
+@deffn {Scheme Procedure} wait-for-link @var{name} [#:blocking? #t]
+Wait until a link called @var{name} (a string such as @code{"ens3"}) shows
+up.
+
+When @var{blocking?} is false, use a non-blocking socket and cooperate via
+@code{current-read-waiter}---useful when using Fibers.
+@end deffn
+
 @deffn {Sceme Procedure} print-link @var{link}
 Display @var{link} on the standard output, using a format similar to
 @command{ip link} from @code{iproute2}.
diff --git a/ip/link.scm b/ip/link.scm
index 7e0ae6b..1323444 100644
--- a/ip/link.scm
+++ b/ip/link.scm
@@ -1,7 +1,8 @@
  This file is part of Guile Netlink
 
  Copyright (C) 2021 Julien Lepiller 
- 
+ Copyright (C) 2023 Ludovic Courtès 
+
  This library 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
@@ -31,12 +32,14 @@
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
+  #:use-module (srfi srfi-71)
   #:export (link-add
 link-del
 link-set
 link-show
 link-name->index
 get-links
+wait-for-link
 print-link
 
  make-link link?
@@ -59,24 +62,35 @@
   (addr  link-addr)
   (brd   link-brd))
 
+(define (message->event+link msg)
+  "If MSG relates to a link event, return two values: its kind (e.g.,
+RTM_NEWLINK) and its associated  value.  Otherwise return #f and #f."
+  (if (memv (message-kind msg)
+(list RTM_NEWLINK
+  RTM_DELLINK
+  RTM_SETLINK))
+  (values (message-kind msg)
+  (let* ((data (message-data msg))
+ (attrs (link-message-attrs data)))
+(make-link (get-attr attrs IFLA_IFNAME)
+   (link-message-index data)
+   (link-message-kind data)
+   (map int->device-flags (split-flags 
(link-message-flags data)))
+   (get-attr attrs IFLA_MTU)
+   (get-attr attrs IFLA_QDISC)
+   (get-attr attrs IFLA_OPERSTATE)
+   (get-attr attrs IFLA_LINKMODE)
+   (get-attr attrs IFLA_GROUP)
+   (get-attr attrs IFLA_TXQLEN)
+   (get-attr attrs IFLA_ADDRESS)
+   (get-attr attrs IFLA_BROADCAST
+  (values #f #f)))
+
 (define (new-link-message->link msg)
   "If MSG has type 'RTM_NEWLINK', return the corresponding  object.
 Otherwise return #f."
-  (and (eqv? (message-kind msg) RTM_NEWLINK)
-   (let* ((data (message-data msg))
-  (attrs (link-message-attrs data)))
- (make-link (get-attr attrs IFLA_IFNAME)
-(link-message-index data)
-(link-message-kind data)
-(map int->device-flags (split-flags (link-message-flags 
data)))
-(get-attr attrs IFLA_MTU)
-(get-attr attrs IFLA_QDISC)
-(get-attr attrs IFLA_OPERSTATE)
-(get-attr attrs IFLA_LINKMODE)
-(get-attr attrs IFLA_GROUP)
-(get-attr attrs IFLA_TXQLEN)
-(get-attr attrs IFLA_ADDRESS)
-(get-attr attrs IFLA_BROADCAST)
+  (let ((kind link (message->event+link msg)))
+(and (eqv? kind RTM_NEWLINK) link)))
 
 (define (get-links)
   (define request-num (random 65535))
@@ -390,3 +404,59 @@ 
balance-rr|active-backup|balance-xor|broadcast|802.3ad|balance-tlb|balance-alb"
 (let ((answer (receive-and-decode-msg sock %default-route-decoder)))
   (close-port sock)
   (answer-ok? (last answer)
+
+(define* (monitor-links proc init terminate?  ;TODO: Make public?
+#:key (blocking? #t))
+  "Wait for link events until @var{terminate?} returns true.  Call @var{init}
+with the initial list of links; use its result as the initial state.  From
+then on, call @code{(@var{proc} @var{event} @var{link} @var{state})} where
+@var{event} is a constant such as @code{RTM_NEWLINK} and @var{link} is the
+corresponding link.  Return the final state.
+
+When @code{blocking?} is false, use a non

bug#63516: [PATCH Guile-Netlink 10/11] doc: Add indexes.

2023-05-23 Thread Ludovic Courtès 
* doc/guile-netlink.texi (Concept Index, Programming Index): New nodes.
---
 doc/guile-netlink.texi | 14 ++
 1 file changed, 14 insertions(+)

diff --git a/doc/guile-netlink.texi b/doc/guile-netlink.texi
index 19db019..4dbeafe 100644
--- a/doc/guile-netlink.texi
+++ b/doc/guile-netlink.texi
@@ -34,6 +34,9 @@ implementation of the netlink protocol.
 * API Reference::  Description of the library interface.
 * IP Library:: High-level functions for network devices.
 
+* Concept Index::  Concepts.
+* Programming Index::  Data types, procedures, and variables.
+
 @detailmenu
 --- The Detailed Node Listing ---
 
@@ -795,4 +798,15 @@ number of routes displayed, you can specify the family as 
in this example.
 @end example
 @end deffn
 
+@c *
+@node Concept Index
+@unnumbered Concept Index
+@printindex cp
+
+@node Programming Index
+@unnumbered Programming Index
+@syncodeindex tp fn
+@syncodeindex vr fn
+@printindex fn
+
 @bye
-- 
2.40.1

bug#63516: [PATCH Guile-Netlink 06/11] link: Extract 'new-link-message->link'.

2023-05-23 Thread Ludovic Courtès 
* ip/link.scm (new-link-message->link): New procedure.
(get-links): Use it, and use 'filter-map' instead of 'filter' followed
by 'map'.
---
 ip/link.scm | 42 --
 1 file changed, 20 insertions(+), 22 deletions(-)

diff --git a/ip/link.scm b/ip/link.scm
index 814a008..7e0ae6b 100644
--- a/ip/link.scm
+++ b/ip/link.scm
@@ -59,6 +59,25 @@
   (addr  link-addr)
   (brd   link-brd))
 
+(define (new-link-message->link msg)
+  "If MSG has type 'RTM_NEWLINK', return the corresponding  object.
+Otherwise return #f."
+  (and (eqv? (message-kind msg) RTM_NEWLINK)
+   (let* ((data (message-data msg))
+  (attrs (link-message-attrs data)))
+ (make-link (get-attr attrs IFLA_IFNAME)
+(link-message-index data)
+(link-message-kind data)
+(map int->device-flags (split-flags (link-message-flags 
data)))
+(get-attr attrs IFLA_MTU)
+(get-attr attrs IFLA_QDISC)
+(get-attr attrs IFLA_OPERSTATE)
+(get-attr attrs IFLA_LINKMODE)
+(get-attr attrs IFLA_GROUP)
+(get-attr attrs IFLA_TXQLEN)
+(get-attr attrs IFLA_ADDRESS)
+(get-attr attrs IFLA_BROADCAST)
+
 (define (get-links)
   (define request-num (random 65535))
   (define message
@@ -72,28 +91,7 @@
   (let ((sock (connect-route)))
 (send-msg message sock)
 (let* ((answer (receive-and-decode-msg sock %default-route-decoder))
-   (links (filter
-(lambda (msg) (equal? (message-kind msg) RTM_NEWLINK))
-answer))
-   (links
- (map
-   (lambda (msg)
- (let* ((data (message-data msg))
-(attrs (link-message-attrs data)))
- (make-link
-   (get-attr attrs IFLA_IFNAME)
-   (link-message-index data)
-   (link-message-kind data)
-   (map int->device-flags (split-flags (link-message-flags 
data)))
-   (get-attr attrs IFLA_MTU)
-   (get-attr attrs IFLA_QDISC)
-   (get-attr attrs IFLA_OPERSTATE)
-   (get-attr attrs IFLA_LINKMODE)
-   (get-attr attrs IFLA_GROUP)
-   (get-attr attrs IFLA_TXQLEN)
-   (get-attr attrs IFLA_ADDRESS)
-   (get-attr attrs IFLA_BROADCAST
-   links)))
+   (links (filter-map new-link-message->link answer)))
   (close-port sock)
   links)))
 
-- 
2.40.1

bug#63516: [PATCH Guile-Netlink 09/11] error: Add 'sub-type' field to '&netlink-decoder-error' and use it.

2023-05-23 Thread Ludovic Courtès 
* netlink/error.scm (&netlink-decoder-error)[sub-type]: New field.
* netlink/data.scm (get-next-deserialize, get-current-deserialize): Fill
it out.
---
 netlink/data.scm  | 13 +
 netlink/error.scm |  4 +++-
 2 files changed, 12 insertions(+), 5 deletions(-)

diff --git a/netlink/data.scm b/netlink/data.scm
index c9b5fb8..ac95051 100644
--- a/netlink/data.scm
+++ b/netlink/data.scm
@@ -51,15 +51,20 @@
   (match (assoc-ref decoder current-type)
 ((_ . type-alist)
  (or (assoc-ref type-alist target-type)
- (assoc-ref type-alist 'default)))
+ (assoc-ref type-alist 'default)
+ (raise (condition (&netlink-decoder-error
+(type current-type)
+(sub-type target-type))
 (#f (raise (condition (&netlink-decoder-error
-(type current-type)))
-  
+   (type current-type)
+   (sub-type target-type)))
+
 (define (get-current-deserialize decoder current-type)
   (match (assoc-ref decoder current-type)
 ((current-deserialize . _) current-deserialize)
 (#f (raise (condition (&netlink-decoder-error
-(type current-type)))
+(type current-type)
+(sub-type #f)))
 
 (define (deserialize type decoder bv pos)
   (let ((deserialize (get-current-deserialize decoder type)))
diff --git a/netlink/error.scm b/netlink/error.scm
index 3e101ed..fa1dba6 100644
--- a/netlink/error.scm
+++ b/netlink/error.scm
@@ -23,6 +23,7 @@
 &netlink-decoder-error
 netlink-decoder-error?
 netlink-decoder-error-type
+netlink-decoder-error-sub-type
 
 &netlink-family-error
 netlink-family-error?
@@ -57,7 +58,8 @@
 ;; No decoder for type
 (define-condition-type &netlink-decoder-error &netlink-error
   netlink-decoder-error?
-  (type netlink-decoder-error-type))
+  (type netlink-decoder-error-type)
+  (sub-type netlink-decoder-error-sub-type))
 
 ;; Unknown protocol family
 (define-condition-type &netlink-family-error &netlink-error
-- 
2.40.1

bug#63451: Guix pull not successful

2023-05-23 Thread Simon Tournier 
Hi,

On Mon, 22 May 2023 at 23:31, a  wrote:

This:

> ~ guix pull -l
>
> Generation 1 Feb 05 2023 20:46:03
>   guix 4b9e1e8
> Generation 2 Feb 06 2023 10:23:38
>   guix a582d86
> Generation 3 May 08 2023 07:32:24
>   guix e118b92
> Generation 4 May 11 2023 13:02:21
>   guix d6f6b57
> Generation 5 May 14 2023 21:53:47 (current)
>   guix c5fa9dd

is inconsistent with the initial report:

> λ ~ guix pull
>  [1259]
> Updating channel 'guix' from Git repository at '
> https://git.savannah.gnu.org/git/guix.git'...
> Authenticating channel 'guix', commits 9edb3f6 to d6f6b57 (667 new commits)...

[...]

> guix pull: error: You found a bug: the program
> '/gnu/store/s2rl9h1zmxx84iyk25ndmn7rmy9508dj-compute-guix-derivation'
> failed to compute the derivation for Guix (version:
> "d6f6b57766e95d2fa8af63d4460a2b303ca4d867"; system: "x86_64-linux";
> host version: "1.4.0"; pull-version: 1).

And as pointed previously, this last message is also inconsistent by
itself.


>> Well, can you share the output of “guix pull -l”?  It would not explain
>> why the Guile ’module-gensym’ failed though.

Well, since the error seems from:

--8<---cut here---start->8---
\Backtrace:
In ice-9/boot-9.scm:
   222:29 19 (map1 (# (#) #)
# ?))
   222:29 18 (map1 (# (#) #)
(# ()))> # ?))
   222:17 17 (map1 (# (# ?))
In ice-9/psyntax.scm:
Exception thrown while printing backtrace:
Wrong type to apply: 129
>
ice-9/boot-9.scm:3165:6: In procedure module-gensym:
Invalid read access of chars of wide string: "m-1bcbf699e1749862-28a08"
--8<---cut here---end--->8---

Well, I do not know if it’s possible to investigate more.  Especially,
when you re-run “guix pull” and it passes.

As Csepp is saying, maybe it comes from your hardware or your
filesystem.


Cheers,
simon

bug#63666: sporadic “guix substitute: error: connect*: Connection timed out”

2023-05-23 Thread Simon Tournier 
Hi,

On different machines (laptop, desktop, workstation) using different
networks, running different revisions of Guix, I often see this sort of
message (here bash-static and aspell-dict-fr are examples, I see that
for various others):

--8<---cut here---start->8---
 bash-static-5.1.16  701KiB
409KiB/s 00:00 ▕█▋▏   9.1%guix substitute: warning: while 
fetching 
https://ci.guix.gnu.org/nar/lzip/s3lfskbxkq65f4zf0iair8yz3s7nskml-aspell-dict-fr-0.50-3:
 server is somewhat slow
guix substitute: warning: try `--no-substitutes' if the problem persists
guix substitute: error: connect*: Connection timed out
--8<---cut here---end--->8---

And I have not noticed if it’s always about the same compression (lzip).

The most recent failure uses 3f59fd6 (pulled on May 23) with:

$ /root/.config/guix/current/bin/guix-daemon --version
guix-daemon (GNU Guix) 1.3.0-31.3170843

Well, if that’s because guix-daemon is too old, maybe we could provide a
more meaningful message.

Sometimes, I even get:

--8<---cut here---start->8---
substitute: updating substitutes from 'https://ci.guix.gnu.org'...   0.0%guix 
substitute: warning: ci.guix.gnu.org: connection failed: Connection timed out
--8<---cut here---end--->8---


Cheers,
simon

bug#63667: channel-with-substitutes-available and broken revision

2023-05-23 Thread Simon Tournier 
Hi,

As documented by the manual [1], I have:

--8<---cut here---start->8---
(use-modules (guix ci))

(list (channel-with-substitutes-available
   %default-guix-channel
   "https://ci.guix.gnu.org";
--8<---cut here---end--->8---

Running “guix pull”, it picks e499cb2c12d7f1c6d2f004364c9cc7bdb7e38cd5
which is broken [2].  To be precise, this commit contains a cycle:
emacs-keycast lists emacs-keycast as propagated inputs; introduced by the
previous commit 87d5754107e2393cc5d2ab44cd9586b3bf73b011 [3].

This cycle leads to an exploding guix-package-cache.drv.  It consumes
all the RAM.

What happens is that ’channel-with-substitutes-available’ checks the
latest success of the “guix” jobset [4].  And that passes [5], at least
for x86_64.

It passes because the Cuirass jobset does not build
guix-package-cache.drv.  Otherwise it would probably fail; as it happens
on Bordeaux [2].

Well, I do not find where this jobset “guix” is defined but it appears
to me worth to add this guix-package-cache.drv derivation.

1: https://guix.gnu.org/manual/devel/en/guix.html#Channels-with-Substitutes
2: https://data.guix.gnu.org/revision/e499cb2c12d7f1c6d2f004364c9cc7bdb7e38cd5
3: 
https://git.savannah.gnu.org/cgit/guix.git/commit/?id=87d5754107e2393cc5d2ab44cd9586b3bf73b011
4: https://ci.guix.gnu.org/jobset/guix
5: https://ci.guix.gnu.org/eval/479592

Cheers,
simon

PS: If one has enough RAM, one could read:

--8<---cut here---start->8---
GC Warning: Repeated allocation of very large block (appr. size 1073741824):
May lead to memory leak and poor performance
-8<---cut here---end--->8---

And note that if one has more RAM, then this guix-package-cache.drv can
even be built.  Maybe a bug on Guile side, another story.

bug#63666: sporadic “guix substitute: error: connect*: Connection timed out”

2023-05-23 Thread Simon Tournier 
Hi,

On Tue, 23 May 2023 at 17:14, Simon Tournier  wrote:

> The most recent failure uses 3f59fd6 (pulled on May 23) with:
>
> $ /root/.config/guix/current/bin/guix-daemon --version
> guix-daemon (GNU Guix) 1.3.0-31.3170843

Just in case, using recent guix-daemon as 3f59fd6, I see:

--8<---cut here---start->8---
 gumbo-parser-0.10.1  149KiB

   555KiB/s 00:00 ▕██▏ 100.0%
 cups-minimal-2.4.2  4.9MiB 

   533KiB/s 00:03 ▕█▎▏  
29.2%guix substitute: warning: while fetching 
https://ci.guix.gnu.org/nar/lzip/mcdi162f45smrgvjmm3vldx2i1xhz0x5-iso-codes-4.5.0:
 server is somewhat slow
guix substitute: warning: try `--no-substitutes' if the problem persists
retrying download of 
'/gnu/store/mcdi162f45smrgvjmm3vldx2i1xhz0x5-iso-codes-4.5.0' with other 
substitute URLs...
--8<---cut here---end--->8---

And I do not know which other substitute URLs are since I pass the
option ’--substitute-urls=https://ci.guix.gnu.org’; both to guix-daemon
and to “guix shell”.

Last, I start to see the progress bar, then something happens and I only
see this:

--8<---cut here---start->8---
substitution of /gnu/store/6r4brvchlkbbqx2n2iz2p6i2ki78zfp2-kexec-tools-2.0.23 
complete

substitution of /gnu/store/rfx142plc19c12mcfk86a8ff0c7bpch0-lame-3.100 complete

substitution of /gnu/store/65rbvsb9fyx74ff1sjnar1bp8qif7k07-libaacs-0.11.0 
complete
--8<---cut here---end--->8---

No more progress bars.


Cheers,
simon

bug#63669: Cutter package is heavily outdated and uses wrong backend

2023-05-23 Thread XVilka Haos of System 
Hi!
Regarding the package https://packages.guix.gnu.org/packages/cutter/

Since Cutter 2.x versions, it switched from Radare2 to Rizin as a
backend (a fork of Radare2). Meanwhile, Radare2 developers renamed
their GUI to "Iaito":

The latest available Cutter release at this time (May 23, 2023) is
2.2.1, and the corresponding Rizin release is 0.5.2

Since Guix already has packaged Rizin, upgrading the Cutter package
should be straightforward:
https://packages.guix.gnu.org/packages/rizin

**Links for the reference**

- https://cutter.re
- https://github.com/rizinorg/cutter
- https://rizin.re/posts/faq/
- https://github.com/radareorg/iaito
- https://repology.org/project/cutter-re/versions
- https://repology.org/project/rizin/versions

**Release links**

- https://github.com/rizinorg/cutter/releases/tag/v2.2.1
- https://github.com/rizinorg/rizin/releases/tag/v0.5.2

Best regards,
XVilka.

bug#63516: [PATCH Guile-Netlink 00/11] Add 'wait-for-link' and related code

2023-05-23 Thread Julien Lepiller 
Thanks, I was able to test it simply by doing something like
(wait-for-link "veth0") and from another terminal, "ip l add veth0 type
veth peer veth1" (it doesn't have to be veth, it's the first one I
thought of that I didn't have to reach the manual for).

Pushed to guile-netlink's master :)

Le Tue, 23 May 2023 14:39:40 +0200,
Ludovic Courtès  a écrit :

> Hi Julien,
> 
> As a followup to , here is code
> that lets us wait for a link to show up “the right way”—i.e., without
> polling. It works over SOCK_NONBLOCK sockets, for use in Fibers
> programs.
> 
> I tested it in a VM created with ‘guix system vm’.  If the “ens3”
> device is already there, (wait-for-link "ens3") returns immediately.
> Then I ran “rmmod e1000” to make the device disappear, and made
> another (wait-for-link "ens3") call: that call returns once I’ve run
> “modprobe e1000” in another terminal.  Wonderful.  :-)
> 
> Now, it would be good to have a test suite that can run without
> complicated setups.  We should check the strategy used by libnl,
> systemd, and the likes.
> 
> Thoughts?
> 
> Ludo’.
> 
> Ludovic Courtès (11):
>   connection: Remove unused procedure.
>   connection: Use Guile's 'socket' procedure to open a socket.
>   connection: Throw upon errors in FFI bindings.
>   connection: Add support for suspendable sockets.
>   connection: Allow users to pass extra SOCK_ flags to 'socket'.
>   link: Extract 'new-link-message->link'.
>   addr: Extract 'new-address-message->address'.
>   connection: Add 'add-socket-membership'.
>   error: Add 'sub-type' field to '&netlink-decoder-error' and use it.
>   doc: Add indexes.
>   link: Add 'wait-for-link'.
> 
>  doc/guile-netlink.texi |  51 +++--
>  ip/addr.scm|  46 +++
>  ip/link.scm| 122 ++-
>  ip/route.scm   |   6 +-
>  netlink/connection.scm | 126
> +++-- netlink/constant.scm   |
> 40 + netlink/data.scm   |  13 +++--
>  netlink/error.scm  |   4 +-
>  8 files changed, 303 insertions(+), 105 deletions(-)
> 
> 
> base-commit: beceb4cfea4739954e558411f46e07425891c774

bug#63198: cups-service-type uses PAM-enabled 'cups' by default which prevents authentication

2023-05-23 Thread Ricardo Wurmus 
I’ll second muradm: these changes broke my printing setup:

* my printer is no longer found because cups-minimal has minimal
  features and does not include dnssd
* I cannot add a new printer with ipp://192.168.x.x manually because of
  authentication problems.  The logs tell me that cups-brf needs to run
  as root.

As a bonus problem I cannot restart Cups with the “cups” package because
it cannot be killed.  I disabled the “cups” service and stopped it, but
cups still runs; killing it is of no use because it’s respawned
immediately.  Shepherd says it didn’t do it.  I also tried deleting the
cups socket file, but that also didn’t help.

-- 
Ricardo

bug#63198: cups-service-type uses PAM-enabled 'cups' by default which prevents authentication

2023-05-23 Thread Maxim Cournoyer 
Hi muradm,

muradm  writes:

[...]

>> Could you look into adding "regular" login PAM support instead of a
>> bypass disabled by default?  The user should still be prompted for
>> its
>> password, and it should go through the PAM auth module.
>>
>> I'm not very PAM-aware, but I believe there are examples spread in
>> the
>> code base.
>
> This patch provides necessary configuration for proper PAM support.
> I decided to take screen-locker-service-type's configuration as
> basis, since it is was most simpliest and adequate enough for this
> case.
> This patch does not disables, baypasses or cheats PAM in any way.
> User may navigate to CUPS portal. In the event of administrative
> actions taken by user, CUPS portal asks user to authenticate.
> With this configuration, it will attempt to authenticate as local
> system user. In the event of proper system user/password supplied
> and positively authenticated against PAM using "cups" service name,
> user allowed to take administrative action. In the event of invalid
> system user/password supplied, CUPS portal will keep looping
> begging for password (just as in your original case). If user decides
> to Cancel the authentication dialog, CUPS portal is navigated to
> Unauthorized access informing page.
>
> Why would I submit something that it is not working?

I didn't mean to imply that it didn't work; I just thought that it was
somehow bypassing PAM (and the original problem it caused in the first
place).  As I wrote earlier, I know next to nothing about PAM, and
misread your patch.

I've now installed the change.  Thanks for the fix, and thanks to
Ricardo for the reminder.

-- 
Maxim

bug#63675: shepherd 0.10.0 test 2 fail on riscv64-linux

2023-05-23 Thread Z572 via Bug reports for GNU Guix 

shepherd 0.10.0 test 2 fail on riscv64-linux. same error use
`guix build shepherd -s riscv64-linux` on x86_64 or
`guix build shepherd` on riscv64.

FAIL tests/pid-file.sh
FAIL: tests/forking-service

at commit e02584b456a3f9c00b303ef4815d892a47edc2e6.

you can use https://cache.z572.online as substitute server.

see attachment.

===
   GNU Shepherd 0.10.0: ./test-suite.log
===

# TOTAL: 25
# PASS:  23
# SKIP:  0
# XFAIL: 0
# FAIL:  2
# XPASS: 0
# ERROR: 0

.. contents:: :depth: 2

FAIL: tests/pid-file


+ shepherd --version
shepherd (GNU Shepherd) 0.10.0
Copyright (C) 2023 the Shepherd authors
License GPLv3+: GNU GPL version 3 or later 
This is free software: you are free to change and redistribute it.
There is NO WARRANTY, to the extent permitted by law.
+ herd --version
herd (GNU Shepherd) 0.10.0
Copyright (C) 2023 the Shepherd authors
License GPLv3+: GNU GPL version 3 or later 
This is free software: you are free to change and redistribute it.
There is NO WARRANTY, to the extent permitted by law.
+ socket=t-socket-3925
+ conf=t-conf-3925
+ log=t-log-3925
+ pid=t-pid-3925
+ service_pid=t-service-pid-3925
+ herd='herd -s t-socket-3925'
+ trap 'cat t-log-3925 || true; rm -f t-socket-3925 t-conf-3925 
t-service-pid-3925 t-log-3925;
  test -f t-pid-3925 && kill `cat t-pid-3925` || true; rm -f t-pid-3925' 
EXIT
+ cat
+ rm -f t-pid-3925
+ test -f t-pid-3925
+ sleep 0.3
+ shepherd -I -s t-socket-3925 -c t-conf-3925 -l t-log-3925 --pid=t-pid-3925
+ test -f t-pid-3925
+ sleep 0.3
+ test -f t-pid-3925
+ sleep 0.3
+ test -f t-pid-3925
+ sleep 0.3
+ test -f t-pid-3925
+ sleep 0.3
+ test -f t-pid-3925
+ sleep 0.3
+ test -f t-pid-3925
+ sleep 0.3
+ test -f t-pid-3925
+ sleep 0.3
+ test -f t-pid-3925
+ sleep 0.3
+ test -f t-pid-3925
+ sleep 0.3
+ test -f t-pid-3925
+ sleep 0.3
+ test -f t-pid-3925
+ sleep 0.3
+ test -f t-pid-3925
+ sleep 0.3
Starting service root...
Service root started.
Service root running with value #t.
Service root has been started.
+ test -f t-pid-3925
+ sleep 0.3
+ test -f t-pid-3925
+ sleep 0.3
+ test -f t-pid-3925
+ sleep 0.3
+ test -f t-pid-3925
+ sleep 0.3
Starting service test-works...
+ test -f t-pid-3925
+ sleep 0.3
+ test -f t-pid-3925
+ sleep 0.3
+ test -f t-pid-3925
+ sleep 0.3
+ test -f t-pid-3925
+ sleep 0.3
Service test-works has been started.
Service test-works started.
Service test-works running with value 5928.
+ test -f t-pid-3925
++ cat t-pid-3925
+ shepherd_pid=4718
+ herd -s t-socket-3925 status test-works
+ grep running
  It is running since 03:39:15 (2 seconds ago).
+ test -f t-service-pid-3925
++ cat t-service-pid-3925
+ kill -0 5928
+ herd -s t-socket-3925 stop test-works
Stopping service test-works...
Service test-works stopped.
Service test-works is now stopped.
+ rm t-service-pid-3925
+ herd -s t-socket-3925 start test
Service test could not be started.
herd: error: failed to start service test
+ true
+ grep stopped
+ herd -s t-socket-3925 status test
  It is stopped (failing).
+ test -f t-service-pid-3925
++ cat t-service-pid-3925
+ kill -0 7240
./tests/pid-file.sh: line 127: kill: (7240) - No such process
+ true
+ rm -f t-service-pid-3925
+ herd -s t-socket-3925 start test-daemonizes
Service test-daemonizes could not be started.
herd: error: failed to start service test-daemonizes
+ true
+ grep stopped
+ herd -s t-socket-3925 status test-daemonizes
  It is stopped (failing).
+ test -f t-service-pid-3925
++ cat t-service-pid-3925
+ kill -0 9303
+ false
+ cat t-log-3925
2023-05-24 03:39:12 Starting service root...
2023-05-24 03:39:12 Service root started.
2023-05-24 03:39:12 Service root running with value #t.
2023-05-24 03:39:12 Service root has been started.
2023-05-24 03:39:13 Starting service test-works...
2023-05-24 03:39:15 Service test-works has been started.
2023-05-24 03:39:15 Service test-works started.
2023-05-24 03:39:15 Service test-works running with value 5928.
2023-05-24 03:39:19 Stopping service test-works...
2023-05-24 03:39:19 Service test-works stopped.
2023-05-24 03:39:19 Service test-works is now stopped.
2023-05-24 03:39:20 Starting service test...
2023-05-24 03:39:26 Service test could not be started.
2023-05-24 03:39:27 Service test failed to start.
2023-05-24 03:39:30 Starting service test-daemonizes...
2023-05-24 03:39:36 Service test-daemonizes could not be started.
2023-05-24 03:39:36 Service test-daemonizes failed to start.
+ rm -f t-socket-3925 t-conf-3925 t-service-pid-3925 t-log-3925
+ test -f t-pid-3925
++ cat t-pid-3925
+ kill 4718
+ rm -f t-pid-3925
Stopping service root...
Exiting shepherd...
Exiting.

Some deprecated features have been used.  Set the environment
variable GUILE_WARN_DEPRECATED to "detailed" and rerun the
program to get more information.  Set it to "no" to suppress
this message.
FAIL tests/pid-file.sh (exit status: 1)

FAIL: tests/forking-service
=