GNU bug report logs - #52603
[PATCH 0/2] Flag missing netmasks early on

Previous Next

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 52603 in the body.
You can then email your comments to 52603 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: guix-patches <at> gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>
Subject: [PATCH 0/2] Flag missing netmasks early on
Date: Sat, 18 Dec 2021 18:02:27 +0100

Hi!

As discussed yesterday on IRC, I mistakenly configured a machine with
something like:

  (network-address
    (device "eno1")
    (value "1.2.3.4"))

This results in having a “/0” subnet, thereby preventing the addition
of a route without a clear diagnostic from Guile-Netlink or ‘ip’.

To avoid this, this patch flags it at expansion time (if possible) or
at run time, before the machine configuration is built.

Did I go overboard with ‘define-compile-time-procedure’?  I don’t think
so :-), I think it will serve us more than once.

Thoughts?

Ludo’.

Ludovic Courtès (2):
  combinators: Add 'define-compile-time-procedure'.
  services: static-networking: Sanitize <network-address> values.

 gnu/services/base.scm | 28 ++++++++++++++++++++++--
 guix/combinators.scm  | 50 +++++++++++++++++++++++++++++++++++++++++--
 2 files changed, 74 insertions(+), 4 deletions(-)


base-commit: 4204156eb4c1afd5365ef505e356f87daa91787d
-- 
2.33.0

Message #8 received at 52603 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 52603 <at> debbugs.gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>
Subject: [PATCH 1/2] combinators: Add 'define-compile-time-procedure'.
Date: Sat, 18 Dec 2021 18:10:39 +0100

* guix/combinators.scm (procedure-call-location): New syntax parameter.
(define-compile-time-procedure): New macro.
---
 guix/combinators.scm | 50 ++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 48 insertions(+), 2 deletions(-)

diff --git a/guix/combinators.scm b/guix/combinators.scm
index 88ad09dbe6..261d6bb57e 100644
--- a/guix/combinators.scm
+++ b/guix/combinators.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo <at> gnu.org>
+;;; Copyright © 2012-2017, 2021 Ludovic Courtès <ludo <at> gnu.org>
 ;;; Copyright © 2014 Eric Bavier <bavier <at> member.fsf.org>
 ;;; Copyright © 2020 Arun Isaac <arunisaac <at> systemreboot.net>
 ;;;
@@ -24,7 +24,9 @@ (define-module (guix combinators)
   #:export (fold2
             fold-tree
             fold-tree-leaves
-            compile-time-value))
+            compile-time-value
+            procedure-call-location
+            define-compile-time-procedure))
 
 ;;; Commentary:
 ;;;
@@ -100,4 +102,48 @@ (define-syntax compile-time-value                 ;not quite at home
                            (_ #`'#,(datum->syntax s val)))))))
        v))))
 
+(define-syntax-parameter procedure-call-location
+  (lambda (s)
+    (syntax-violation 'procedure-call-location
+                      "'procedure-call-location' may only be used \
+within 'define-compile-time-procedure'"
+                      s)))
+
+(define-syntax-rule (define-compile-time-procedure (proc (arg pred) ...)
+                      body ...)
+  "Define PROC as a macro such that, if every actual argument in a \"call\"
+matches PRED, then BODY is evaluated at macro-expansion time.  BODY must
+return a single value in a type that has read syntax--e.g., numbers, strings,
+lists, etc.
+
+BODY can refer to 'procedure-call-location', which is bound to a source
+property alist corresponding to the call site.
+
+This macro is meant to be used primarily for small procedures that validate or
+process its arguments in a way that may be equally well performed at
+macro-expansion time."
+  (define-syntax proc
+    (lambda (s)
+      (define loc
+        #`(identifier-syntax
+           '#,(datum->syntax #'s (syntax-source s))))
+
+      (syntax-case s ()
+        ((_ arg ...)
+         (and (pred (syntax->datum #'arg)) ...)
+         (let ((arg (syntax->datum #'arg)) ...)
+           (syntax-parameterize ((procedure-call-location
+                                  (identifier-syntax (syntax-source s))))
+             body ...)))
+        ((_ actual (... ...))
+         #`((lambda (arg ...)
+              (syntax-parameterize ((procedure-call-location #,loc))
+                body ...))
+            actual (... ...)))
+        (id
+         (identifier? #'id)
+         #`(lambda (arg ...)
+             (syntax-parameterize ((procedure-call-location #,loc))
+               body ...)))))))
+
 ;;; combinators.scm ends here
-- 
2.33.0

Message #11 received at 52603 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 52603 <at> debbugs.gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>
Subject: [PATCH 2/2] services: static-networking: Sanitize <network-address>
 values.
Date: Sat, 18 Dec 2021 18:10:40 +0100

This makes sure users do not mistakenly configuring a network with "/0"
as its netmask.

* gnu/services/base.scm (assert-valid-address): New procedure.
(<network-address>)[value]: Add it as 'sanitize'.
---
 gnu/services/base.scm | 28 ++++++++++++++++++++++++++--
 1 file changed, 26 insertions(+), 2 deletions(-)

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 5f93483dda..49ec856de4 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -35,8 +35,9 @@
 (define-module (gnu services base)
   #:use-module (guix store)
   #:use-module (guix deprecation)
-  #:autoload   (guix diagnostics) (warning)
+  #:autoload   (guix diagnostics) (warning &fix-hint)
   #:autoload   (guix i18n) (G_)
+  #:use-module (guix combinators)
   #:use-module (gnu services)
   #:use-module (gnu services admin)
   #:use-module (gnu services shepherd)
@@ -72,6 +73,8 @@ (define-module (gnu services base)
   #:use-module (guix i18n)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
   #:re-export (user-processes-service-type        ;backwards compatibility
@@ -2388,6 +2391,26 @@ (define (ipv6-address? str)
   "Return true if STR denotes an IPv6 address."
   (false-if-exception (->bool (inet-pton AF_INET6 str))))
 
+(define-compile-time-procedure (assert-valid-address (address string?))
+  "Ensure ADDRESS has a valid netmask."
+  (unless (or (cidr->netmask address)
+              (and=> (false-if-exception (inet-pton AF_INET address))
+                     (cut = INADDR_LOOPBACK <>))
+              (and=> (false-if-exception (inet-pton AF_INET6 address))
+                     (cut = 1 <>)))
+    (raise
+     (make-compound-condition
+      (formatted-message (G_ "address '~a' lacks a network mask")
+                         address)
+      (condition (&error-location
+                  (location
+                   (source-properties->location procedure-call-location))))
+      (condition (&fix-hint
+                  (hint (format #f (G_ "\
+Write, say, @samp{\"~a/24\"} for a 24-bit network mask.")
+                                address)))))))
+  address)
+
 (define-record-type* <static-networking>
   static-networking make-static-networking
   static-networking?
@@ -2405,7 +2428,8 @@ (define-record-type* <network-address>
   network-address make-network-address
   network-address?
   (device    network-address-device)              ;string--e.g., "en01"
-  (value     network-address-value)               ;string--CIDR notation
+  (value     network-address-value                ;string--CIDR notation
+             (sanitize assert-valid-address))
   (ipv6?     network-address-ipv6?                ;Boolean
              (thunked)
              (default
-- 
2.33.0

Message #14 received at 52603 <at> debbugs.gnu.org (full text, mbox):

From: Mathieu Othacehe <othacehe <at> gnu.org>
To: Ludovic Courtès <ludo <at> gnu.org>
Cc: 52603 <at> debbugs.gnu.org
Subject: Re: bug#52603: [PATCH 0/2] Flag missing netmasks early on
Date: Sun, 19 Dec 2021 10:13:47 +0100

Hey Ludo,

> To avoid this, this patch flags it at expansion time (if possible) or
> at run time, before the machine configuration is built.
>
> Did I go overboard with ‘define-compile-time-procedure’?  I don’t think
> so :-), I think it will serve us more than once.

I tested this series, works fine! It is still possible to pass incorrect
netmasks (negative, > 32 for IPv4), but they should be way less frequent
than forgetting to add a netmask.

Thanks,

Mathieu

Message #19 received at 52603-done <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: Mathieu Othacehe <othacehe <at> gnu.org>
Cc: 52603-done <at> debbugs.gnu.org
Subject: Re: bug#52603: [PATCH 0/2] Flag missing netmasks early on
Date: Mon, 20 Dec 2021 16:28:05 +0100

Hi,

Mathieu Othacehe <othacehe <at> gnu.org> skribis:

>> To avoid this, this patch flags it at expansion time (if possible) or
>> at run time, before the machine configuration is built.
>>
>> Did I go overboard with ‘define-compile-time-procedure’?  I don’t think
>> so :-), I think it will serve us more than once.
>
> I tested this series, works fine! It is still possible to pass incorrect
> netmasks (negative, > 32 for IPv4), but they should be way less frequent
> than forgetting to add a netmask.

Yeah…

Pushed as 4df584aeac56fb6575ba43bc94f60f04522caf88, thanks for testing!

Ludo’.

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.