[gnunet-scheme] 282/324: config: Allow expanding loaded configurations.

[gnunet]

This is an automated email from the git hooks/post-receive script.

maxime-devos pushed a commit to branch master
in repository gnunet-scheme.

commit 0d19fac619d387eced6629f722640352cfae6c60
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Mon Sep 13 16:05:59 2021 +0200

    config: Allow expanding loaded configurations.
    
    * gnu/gnunet/config/fs.scm
      (make-expanded-configuration): New procedure.
    * doc/scheme-gnunet.tm (Loading configuration files):
      Document new procedure.
    * tests/config-fs.scm
      (load-string->config/expanded, load-string->alist/expanded):
      New procedures.
      ("make-expanded-configuration, one variable"
      ("make-expanded-configuration, expand variable (via getenv)")
      ("make-expanded-configuration, expand variable (via getenv, fancyness)")
      ("make-expanded-configuration, expand variable (via PATHS)")
      ("make-expanded-configuration, expand variable (via PATHS + getenv)")
      ("make-expanded-configuration, loop detected"): New tests.
---
 doc/scheme-gnunet.tm     | 20 ++++++++++++--
 gnu/gnunet/config/fs.scm | 52 ++++++++++++++++++++++++++++++++---
 tests/config-fs.scm      | 70 +++++++++++++++++++++++++++++++++++++++++++++++-
 3 files changed, 136 insertions(+), 6 deletions(-)

diff --git a/doc/scheme-gnunet.tm b/doc/scheme-gnunet.tm
index b0608e0..0ddaf1b 100644
--- a/doc/scheme-gnunet.tm
+++ b/doc/scheme-gnunet.tm
@@ -162,8 +162,24 @@
     <todo|document expansible objects><todo|error reporting>
   </explain>
 
-  <todo|loading configuration files from the disk><todo|expanding
-  configuration files>
+  A variable assignment <verbatim|[section] key=value${var}> can refer to
+  variables defined in the <verbatim|PATHS> section and variables from the
+  environment.<space|1em>The previously described procedure
+  <scm|load-configuration/port!> will <em|not> expand such assignements. \ To
+  expand variable assignments, use the procedure
+  <scm|make-expanded-configuration> instead.
+
+  <\explain>
+    <scm|(make-expanded-configuration <var|load!> #:getenv=<var|getenv>)>
+  <|explain>
+    Make a configuration object.<space|1em>To populate the configuration, all
+    the procedure <var|load!> with a <scm|set-value!> procedure as expected
+    by <scm|load-configuration/port!>.<space|1em>The values from
+    <scm|set-value!> are added to the confoiguration and every variable is
+    expanded.
+  </explain>
+
+  <todo|loading configuration files from the disk>
 
   <subsection|Value types>
 
diff --git a/gnu/gnunet/config/fs.scm b/gnu/gnunet/config/fs.scm
index 02a1916..f927d5c 100644
--- a/gnu/gnunet/config/fs.scm
+++ b/gnu/gnunet/config/fs.scm
@@ -34,10 +34,14 @@
 (define-library (gnu gnunet config fs)
   (export locate-system-configuration
          locate-user-configuration
-         load-configuration/port!)
+         load-configuration/port!
+         make-expanded-configuration)
   (import (only (rnrs base)
                begin define and not or cond define-syntax identifier-syntax
-               if ... eq? values + lambda quote vector)
+               if ... eq? values + lambda quote vector car cdr cons string?
+               string-length vector? vector-ref string=? list)
+         (prefix (rnrs hashtables)
+                 rnrs:)
          (only (ice-9 optargs)
                define*)
          (only (ice-9 rdelim)
@@ -45,9 +49,12 @@
          (only (guile)
                getenv in-vicinity string-null? define-syntax-rule eof-object?
                substring error syntax-error define-syntax-parameter
-               syntax-parameterize syntax-violation identity)
+               syntax-parameterize syntax-violation identity
+               make-hash-table hash-set! hash-ref hash-for-each)
          (only (gnu gnunet utils hat-let)
                let^)
+         (gnu gnunet config db)
+         (gnu gnunet config expand)
          (gnu gnunet config parser))
   (begin
     (define (locate-system-configuration)
@@ -167,5 +174,44 @@ where @var{value} is a list of expansible objects."
       (syntax-parameterize ((line-number (identifier-syntax 0)))
        (no-section*)))
 
+    (define* (make-expanded-configuration load! #:key (getenv getenv))
+      "Make a configuration object.  To populate the configuration,
+call the procedure @var{load!} with a @code{set-value!} procedure as expected
+by @code{load-configuration/port!}.  The values from @code{set-value!}
+are added to the configuration and every variable is expanded."
+      (define hash (make-hash-table))
+      (define (set-unexpanded-value! section key value-vector)
+       (hash-set! hash (cons section key) value-vector))
+      (load! set-unexpanded-value!)
+      (define config (hash->configuration (rnrs:make-hashtable hash-key 
key=?)))
+      (define (substring=? line0 start0 end0 line1 start1 end1)
+       (string=? (substring line0 start0 end0)
+                 (substring line1 start1 end1)))
+      (define (query line start end)
+       (define variable (substring line start end))
+       ;; In the section PATHS, variables participating in expansion can be
+       ;; defined.
+       (define unexpanded-value
+         (or (hash-ref hash (cons "PATHS" variable))
+             (getenv variable)))
+       (cond ((string? unexpanded-value) ; result of getenv
+              (values unexpanded-value
+                      (list (make-literal-position
+                             0 (string-length unexpanded-value)))))
+             ((vector? unexpanded-value)
+              (values (vector-ref unexpanded-value 0) ; line
+                      (vector-ref unexpanded-value 2))) ; list of expo objects
+             (#t (values)))) ; undefined variable
+      (hash-for-each
+       (lambda (key value)
+        (define line (vector-ref value 0))
+        (define expo-list (vector-ref value 2))
+        (define expanded-value
+          (expand->string query substring=? line expo-list))
+        (set-value! identity config (car key) (cdr key) expanded-value))
+       hash)
+      config)
+
+    ;; TODO error reporting
     ;; TODO actually load the configuration, defaults, ...
     ))
diff --git a/tests/config-fs.scm b/tests/config-fs.scm
index e457b0a..b194a6b 100644
--- a/tests/config-fs.scm
+++ b/tests/config-fs.scm
@@ -16,8 +16,12 @@
 ;;
 ;; SPDX-License-Identifier: AGPL3.0-or-later
 
-(import (gnu gnunet config fs)
+(import (gnu gnunet config db)
+       (gnu gnunet config expand)
+       (gnu gnunet config fs)
        (gnu gnunet config parser)
+       (rnrs exceptions)
+       (srfi srfi-1)
        (srfi srfi-64))
 (test-begin "config-fs")
 
@@ -145,4 +149,68 @@
   (load-string->alist/unexpanded
    "[section1]\nVAR = VALUE\n[section2]\nVAR2 = VALUE2"))
 
+(define (load-string->config/expanded text environment-variables)
+  (make-expanded-configuration
+   (lambda (set-value!)
+     (call-with-input-string text
+       (lambda (p)
+        (load-configuration/port! set-value! p))))
+   #:getenv
+   (alist->getenv environment-variables)))
+
+(define (load-string->alist/expanded text interested environment-variables)
+  (define config (load-string->config/expanded text environment-variables))
+  (filter-map (lambda (section+key)
+               `(,section+key
+                 . ,(guard (c ((undefined-key-error? c) 'undefined))
+                      (read-value identity config (car section+key)
+                                  (cdr section+key)))))
+             interested))
+
+(test-equal "make-expanded-configuration, one variable"
+  '((("sect" . "var") . "iable"))
+  (load-string->alist/expanded "[sect]\nvar=iable"
+                              '(("sect" . "var")) '()))
+
+;; Detected a missing 'list'
+(test-equal "make-expanded-configuration, expand variable (via getenv)"
+  '((("sect" . "var") . "iable"))
+  (load-string->alist/expanded "[sect]\nvar=i$a"
+                              '(("sect" . "var")) '(("a" . "able"))))
+
+
+(test-equal "make-expanded-configuration, expand variable (via getenv, 
fancyness)"
+  '((("sect" . "var") . "i}\\$able%f'"))
+  (load-string->alist/expanded "[sect]\nvar=i$a"
+                              '(("sect" . "var"))
+                              '(("a" . "}\\$able%f'"))))
+
+(test-equal "make-expanded-configuration, expand variable (via PATHS)"
+  '((("sect" . "var") . "iable")
+    (("PATHS" . "something") . "able"))
+  (load-string->alist/expanded
+   "[sect]\nvar=i$something\n[PATHS]\nsomething=able"
+   '(("sect" . "var")
+     ("PATHS" . "something"))
+   '()))
+
+;; Detects incorrect implementation of substring=? (string=? was used instead)
+(test-equal "make-expanded-configuration, expand variable (via PATHS + getenv)"
+  '((("sect" . "var") . "iable")
+    (("PATHS" . "something") . "able"))
+  (load-string->alist/expanded
+   "[sect]\nvar=i$something\n[PATHS]\nsomething=a$else"
+   '(("sect" . "var")
+     ("PATHS" . "something"))
+   '(("else" . "ble"))))
+
+;; Detect implementations of substring=? that always return #f.
+(test-equal "make-expanded-configuration, loop detected"
+  #t
+  (guard (c ((expansion-loop-error? c) #t))
+    (load-string->alist/expanded
+     "[sect]\nvar=i${something}\n[PATHS]\nsomething=d${something}"
+     '(("PATHS" . "something"))
+     '(("something" . "unused")))))
+
 (test-end "config-fs")

-- 
To stop receiving notification emails like this one, please contact
gnunet@gnunet.org.