GNU bug report logs - #31089
cgit service: add support for file-like objects

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 31089 in the body.
You can then email your comments to 31089 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: Clément Lassieur <clement <at> lassieur.org>
To: guix-patches <at> gnu.org
Subject: cgit service: add support for file-like objects
Date: Sat, 07 Apr 2018 19:04:17 +0200

Hi,

These patches aim to add support for file-like objects and a few other
things related to the cgit service.

Comments are welcome,
Clément

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

From: Clément Lassieur <clement <at> lassieur.org>
To: 31089 <at> debbugs.gnu.org
Subject: [PATCH 1/5] services: cgit: Simplify 'uglify-field-name'.
Date: Sat,  7 Apr 2018 19:07:05 +0200

* gnu/services/cgit.scm (uglify-field-name): Remove STRING-JOIN and
STRING-SPLIT.
---
 gnu/services/cgit.scm | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/gnu/services/cgit.scm b/gnu/services/cgit.scm
index a868d758a..b263aa491 100644
--- a/gnu/services/cgit.scm
+++ b/gnu/services/cgit.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018 Oleg Pykhalov <go.wigust <at> gmail.com>
+;;; Copyright © 2018 Clément Lassieur <clement <at> lassieur.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -72,8 +73,7 @@
 ;;;
 
 (define (uglify-field-name field-name)
-  (let ((str (symbol->string field-name)))
-    (string-join (string-split (string-delete #\? str) #\-) "-")))
+  (string-delete #\? (symbol->string field-name)))
 
 (define (serialize-field field-name val)
   (format #t "~a=~a\n" (uglify-field-name field-name) val))
-- 
2.17.0

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

From: Clément Lassieur <clement <at> lassieur.org>
To: 31089 <at> debbugs.gnu.org
Subject: [PATCH 2/5] services: cgit: Simplify 'serialize-module-link-path'.
Date: Sat,  7 Apr 2018 19:07:06 +0200

* gnu/services/cgit.scm (serialize-module-link-path): Remove STRING-DROP-RIGHT
and UGLIFY-FIELD-NAME.
---
 gnu/services/cgit.scm | 5 +----
 1 file changed, 1 insertion(+), 4 deletions(-)

diff --git a/gnu/services/cgit.scm b/gnu/services/cgit.scm
index b263aa491..3c685f1b5 100644
--- a/gnu/services/cgit.scm
+++ b/gnu/services/cgit.scm
@@ -150,10 +150,7 @@
   (if (null? val) ""
       (match val
         ((path text)
-         (format #t "repo.~a.~a=~a\n"
-                 (string-drop-right (uglify-field-name 'module-link-path)
-                                    (string-length "-path"))
-                 path text)))))
+         (format #t "repo.module-link.~a=~a\n" path text)))))
 
 (define repository-directory? string?)
 
-- 
2.17.0

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

From: Clément Lassieur <clement <at> lassieur.org>
To: 31089 <at> debbugs.gnu.org
Subject: [PATCH 3/5] services: cgit: Add support for file-like objects.
Date: Sat,  7 Apr 2018 19:07:07 +0200

* doc/guix.texi (Version Control Services): Update accordingly.
* gnu/services/cgit.scm (serialize-field, serialize-string, serialize-boolean,
serialize-integer, serialize-repository-cgit-configuration-list,
serialize-nginx-server-configuration-list, serialize-repo-field,
serialize-repo-boolean, serialize-repo-integer, serialize-module-link-path,
serialize-repository-directory, serialize-mimetype-alist): Return strings or
string-valued gexps and stop printing.
(repository-cgit-configuration)[source-filter, about-filter, commit-filter,
logo, owner-filter], (cgit-configuration)[auth-filter, commit-filter, css,
email-filter, favicon, include, logo, owner-filter, mimetype-file, readme,
source-filter]: Replace STRING with FILE-OBJECT.
(file-object?, serialize-file-object, repo-file-object?,
serialize-repo-file-object): New procedures.
(cgit-activation): Use SERIALIZE-CONFIGURATION's return value with
MIXED-TEXT-FILE instead of using its output with PLAIN-FILE.
---
 doc/guix.texi         | 37 +++++++++---------
 gnu/services/cgit.scm | 87 ++++++++++++++++++++++++-------------------
 2 files changed, 67 insertions(+), 57 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 738fdf65c..35d23e1be 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -18552,7 +18552,7 @@ NGINX configuration.
 
 @end deftypevr
 
-@deftypevr {@code{cgit-configuration} parameter} string about-filter
+@deftypevr {@code{cgit-configuration} parameter} file-object about-filter
 Specifies a command which will be invoked to format the content of about
 pages (both top-level and for each repository).
 
@@ -18568,7 +18568,7 @@ Defaults to @samp{""}.
 
 @end deftypevr
 
-@deftypevr {@code{cgit-configuration} parameter} string auth-filter
+@deftypevr {@code{cgit-configuration} parameter} file-object auth-filter
 Specifies a command that will be invoked for authenticating repository
 access.
 
@@ -18677,7 +18677,7 @@ Defaults to @samp{()}.
 
 @end deftypevr
 
-@deftypevr {@code{cgit-configuration} parameter} string commit-filter
+@deftypevr {@code{cgit-configuration} parameter} file-object commit-filter
 Command which will be invoked to format commit messages.
 
 Defaults to @samp{""}.
@@ -18693,14 +18693,14 @@ Defaults to @samp{"git log"}.
 
 @end deftypevr
 
-@deftypevr {@code{cgit-configuration} parameter} string css
+@deftypevr {@code{cgit-configuration} parameter} file-object css
 URL which specifies the css document to include in all cgit pages.
 
 Defaults to @samp{"/share/cgit/cgit.css"}.
 
 @end deftypevr
 
-@deftypevr {@code{cgit-configuration} parameter} string email-filter
+@deftypevr {@code{cgit-configuration} parameter} file-object email-filter
 Specifies a command which will be invoked to format names and email
 address of committers, authors, and taggers, as represented in various
 places throughout the cgit interface.
@@ -18824,7 +18824,7 @@ Defaults to @samp{#f}.
 
 @end deftypevr
 
-@deftypevr {@code{cgit-configuration} parameter} string favicon
+@deftypevr {@code{cgit-configuration} parameter} file-object favicon
 URL used as link to a shortcut icon for cgit.
 
 Defaults to @samp{"/favicon.ico"}.
@@ -18856,7 +18856,7 @@ Defaults to @samp{""}.
 
 @end deftypevr
 
-@deftypevr {@code{cgit-configuration} parameter} string include
+@deftypevr {@code{cgit-configuration} parameter} file-object include
 Name of a configfile to include before the rest of the current config-
 file is parsed.
 
@@ -18888,7 +18888,7 @@ Defaults to @samp{#f}.
 
 @end deftypevr
 
-@deftypevr {@code{cgit-configuration} parameter} string logo
+@deftypevr {@code{cgit-configuration} parameter} file-object logo
 URL which specifies the source of an image which will be used as a logo
 on all cgit pages.
 
@@ -18903,7 +18903,7 @@ Defaults to @samp{""}.
 
 @end deftypevr
 
-@deftypevr {@code{cgit-configuration} parameter} string owner-filter
+@deftypevr {@code{cgit-configuration} parameter} file-object owner-filter
 Command which will be invoked to format the Owner column of the main
 page.
 
@@ -18972,7 +18972,7 @@ Defaults to @samp{((gif "image/gif") (html "text/html") (jpg
 
 @end deftypevr
 
-@deftypevr {@code{cgit-configuration} parameter} string mimetype-file
+@deftypevr {@code{cgit-configuration} parameter} file-object mimetype-file
 Specifies the file to use for automatic mimetype lookup.
 
 Defaults to @samp{""}.
@@ -19010,7 +19010,7 @@ Defaults to @samp{#f}.
 
 @end deftypevr
 
-@deftypevr {@code{cgit-configuration} parameter} string readme
+@deftypevr {@code{cgit-configuration} parameter} file-object readme
 Text which will be used as default value for @code{cgit-repo-readme}.
 
 Defaults to @samp{""}.
@@ -19128,7 +19128,7 @@ Defaults to @samp{#f}.
 
 @end deftypevr
 
-@deftypevr {@code{cgit-configuration} parameter} string source-filter
+@deftypevr {@code{cgit-configuration} parameter} file-object source-filter
 Specifies a command which will be invoked to format plaintext blobs in
 the tree view.
 
@@ -19190,7 +19190,7 @@ Defaults to @samp{()}.
 
 @end deftypevr
 
-@deftypevr {@code{repository-cgit-configuration} parameter} repo-string source-filter
+@deftypevr {@code{repository-cgit-configuration} parameter} repo-file-object source-filter
 Override the default @code{source-filter}.
 
 Defaults to @samp{""}.
@@ -19204,7 +19204,7 @@ Defaults to @samp{""}.
 
 @end deftypevr
 
-@deftypevr {@code{repository-cgit-configuration} parameter} repo-string about-filter
+@deftypevr {@code{repository-cgit-configuration} parameter} repo-file-object about-filter
 Override the default @code{about-filter}.
 
 Defaults to @samp{""}.
@@ -19226,7 +19226,7 @@ Defaults to @samp{()}.
 
 @end deftypevr
 
-@deftypevr {@code{repository-cgit-configuration} parameter} repo-string commit-filter
+@deftypevr {@code{repository-cgit-configuration} parameter} repo-file-object commit-filter
 Override the default @code{commit-filter}.
 
 Defaults to @samp{""}.
@@ -19266,7 +19266,7 @@ Defaults to @samp{""}.
 
 @end deftypevr
 
-@deftypevr {@code{repository-cgit-configuration} parameter} repo-string email-filter
+@deftypevr {@code{repository-cgit-configuration} parameter} repo-file-object email-filter
 Override the default @code{email-filter}.
 
 Defaults to @samp{""}.
@@ -19336,7 +19336,7 @@ Defaults to @samp{#f}.
 
 @end deftypevr
 
-@deftypevr {@code{repository-cgit-configuration} parameter} repo-string logo
+@deftypevr {@code{repository-cgit-configuration} parameter} repo-file-object logo
 URL which specifies the source of an image which will be used as a logo
 on this repo’s pages.
 
@@ -19351,7 +19351,7 @@ Defaults to @samp{""}.
 
 @end deftypevr
 
-@deftypevr {@code{repository-cgit-configuration} parameter} repo-string owner-filter
+@deftypevr {@code{repository-cgit-configuration} parameter} repo-file-object owner-filter
 Override the default @code{owner-filter}.
 
 Defaults to @samp{""}.
@@ -19436,6 +19436,7 @@ Defaults to @samp{()}.
 
 @end deftypevr
 
+
 @c %end of fragment
 
 However, it could be that you just want to get a @code{cgitrc} up and
diff --git a/gnu/services/cgit.scm b/gnu/services/cgit.scm
index 3c685f1b5..98e46e0b8 100644
--- a/gnu/services/cgit.scm
+++ b/gnu/services/cgit.scm
@@ -76,13 +76,12 @@
   (string-delete #\? (symbol->string field-name)))
 
 (define (serialize-field field-name val)
-  (format #t "~a=~a\n" (uglify-field-name field-name) val))
+  #~(format #f "~a=~a\n" #$(uglify-field-name field-name) #$val))
 
 (define (serialize-string field-name val)
-  (if (string=? val "") "" (serialize-field field-name val)))
-
-(define (serialize-boolean field-name val)
-  (serialize-field field-name (if val 1 0)))
+  (if (and (string? val) (string=? val ""))
+      ""
+      (serialize-field field-name val)))
 
 (define (serialize-list field-name val)
   (if (null? val) "" (serialize-field field-name (string-join val))))
@@ -96,7 +95,10 @@
   (exact-integer? val))
 
 (define (serialize-integer field-name val)
-  (serialize-field field-name val))
+  (serialize-field field-name (number->string val)))
+
+(define (serialize-boolean field-name val)
+  (serialize-integer field-name (if val 1 0)))
 
 (define (serialize-repository-cgit-configuration x)
   (serialize-configuration x repository-cgit-configuration-fields))
@@ -105,7 +107,13 @@
   (list? val))
 
 (define (serialize-repository-cgit-configuration-list field-name val)
-  (for-each serialize-repository-cgit-configuration val))
+  #~(string-append
+     #$@(map serialize-repository-cgit-configuration val)))
+
+(define (file-object? val)
+  (or (file-like? val) (string? val)))
+(define (serialize-file-object field-name val)
+  (serialize-string field-name val))
 
 
 ;;;
@@ -116,7 +124,7 @@
   (and (list? val) (and-map nginx-server-configuration? val)))
 
 (define (serialize-nginx-server-configuration-list field-name val)
-  #f)
+  "")
 
 
 ;;;
@@ -124,18 +132,18 @@
 ;;;
 
 (define (serialize-repo-field field-name val)
-  (format #t "repo.~a=~a\n" (uglify-field-name field-name) val))
+  #~(format #f "repo.~a=~a\n" #$(uglify-field-name field-name) #$val))
 
 (define (serialize-repo-list field-name val)
   (if (null? val) "" (serialize-repo-field field-name (string-join val))))
 
 (define repo-boolean? boolean?)
 
-(define (serialize-repo-boolean field-name val)
-  (serialize-repo-field field-name (if val 1 0)))
-
 (define (serialize-repo-integer field-name val)
-  (serialize-repo-field field-name val))
+  (serialize-repo-field field-name (number->string val)))
+
+(define (serialize-repo-boolean field-name val)
+  (serialize-repo-integer field-name (if val 1 0)))
 
 (define repo-list? list?)
 
@@ -144,23 +152,26 @@
 (define (serialize-repo-string field-name val)
   (if (string=? val "") "" (serialize-repo-field field-name val)))
 
+(define repo-file-object? file-object?)
+(define serialize-repo-file-object serialize-repo-string)
+
 (define module-link-path? list?)
 
 (define (serialize-module-link-path field-name val)
   (if (null? val) ""
       (match val
         ((path text)
-         (format #t "repo.module-link.~a=~a\n" path text)))))
+         (format #f "repo.module-link.~a=~a\n" path text)))))
 
 (define repository-directory? string?)
 
 (define (serialize-repository-directory _ val)
-  (if (string=? val "") "" (format #t "scan-path=~a\n" val)))
+  (if (string=? val "") "" (format #f "scan-path=~a\n" val)))
 
 (define mimetype-alist? list?)
 
 (define (serialize-mimetype-alist field-name val)
-  (format #t "# Mimetypes\n~a"
+  (format #f "# Mimetypes\n~a"
           (string-join
            (map (match-lambda
                   ((extension mimetype)
@@ -174,13 +185,13 @@
    "A mask of snapshot formats for this repo that cgit generates links for,
 restricted by the global @code{snapshots} setting.")
   (source-filter
-   (repo-string "")
+   (repo-file-object "")
    "Override the default @code{source-filter}.")
   (url
    (repo-string "")
    "The relative URL used to access the repository.")
   (about-filter
-   (repo-string "")
+   (repo-file-object "")
    "Override the default @code{about-filter}.")
   (branch-sort
    (repo-string "")
@@ -190,7 +201,7 @@ ref list, and when set to @samp{name} enables ordering by branch name.")
    (repo-list '())
    "A list of URLs which can be used to clone repo.")
   (commit-filter
-   (repo-string "")
+   (repo-file-object "")
    "Override the default @code{commit-filter}.")
   (commit-sort
    (repo-string "")
@@ -209,7 +220,7 @@ is no suitable HEAD.")
    (repo-string "")
    "The value to show as repository homepage.")
   (email-filter
-   (repo-string "")
+   (repo-file-object "")
    "Override the default @code{email-filter}.")
   (enable-commit-graph?
    (repo-boolean #f)
@@ -243,14 +254,14 @@ repository index.")
    (repo-boolean #f)
    "Flag which, when set to @samp{#t}, ignores the repository.")
   (logo
-   (repo-string "")
+   (repo-file-object "")
    "URL which specifies the source of an image which will be used as a
 logo on this repo’s pages.")
   (logo-link
    (repo-string "")
    "URL loaded when clicking on the cgit logo image.")
   (owner-filter
-   (repo-string "")
+   (repo-file-object "")
    "Override the default @code{owner-filter}.")
   (module-link
    (repo-string "")
@@ -296,7 +307,7 @@ after this option will inherit the current section name.")
    (nginx-server-configuration-list (list %cgit-configuration-nginx))
    "NGINX configuration.")
   (about-filter
-   (string "")
+   (file-object "")
    "Specifies a command which will be invoked to format the content of about
 pages (both top-level and for each repository).")
   (agefile
@@ -304,7 +315,7 @@ pages (both top-level and for each repository).")
    "Specifies a path, relative to each repository path, which can be used to
 specify the date and time of the youngest commit in the repository.")
   (auth-filter
-   (string "")
+   (file-object "")
    "Specifies a command that will be invoked for authenticating repository
 access.")
   (branch-sort
@@ -357,7 +368,7 @@ generates valid clone URLs for the repository.")
    (list '())
    "List of @code{clone-url} templates.")
   (commit-filter
-   (string "")
+   (file-object "")
    "Command which will be invoked to format commit messages.")
   (commit-sort
    (string "git log")
@@ -365,10 +376,10 @@ generates valid clone URLs for the repository.")
 commit log, and when set to @samp{topo} enables strict topological
 ordering.")
   (css
-   (string "/share/cgit/cgit.css")
+   (file-object "/share/cgit/cgit.css")
    "URL which specifies the css document to include in all cgit pages.")
   (email-filter
-   (string "")
+   (file-object "")
    "Specifies a command which will be invoked to format names and email
 address of committers, authors, and taggers, as represented in various
 places throughout the cgit interface.")
@@ -432,7 +443,7 @@ links for plaintext blobs printed in the tree view.")
    "Flag which, when set to @samp{#f}, will allow cgit to use Git config to
 set any repo specific settings.")
   (favicon
-   (string "/favicon.ico")
+   (file-object "/favicon.ico")
    "URL used as link to a shortcut icon for cgit.")
   (footer
    (string "")
@@ -448,7 +459,7 @@ verbatim in the HTML HEAD section on all pages.")
    "The content of the file specified with this option will be included
 verbatim at the top of all pages.")
   (include
-   (string "")
+   (file-object "")
    "Name of a configfile to include before the rest of the current config-
 file is parsed.")
   (index-header
@@ -464,14 +475,14 @@ verbatim below the heading on the repository index page.")
    "Flag which, if set to @samp{#t}, makes cgit print commit and tag times
 in the servers timezone.")
   (logo
-   (string "/share/cgit/cgit.png")
+   (file-object "/share/cgit/cgit.png")
    "URL which specifies the source of an image which will be used as a logo
 on all cgit pages.")
   (logo-link
    (string "")
    "URL loaded when clicking on the cgit logo image.")
   (owner-filter
-   (string "")
+   (file-object "")
    "Command which will be invoked to format the Owner column of the main
 page.")
   (max-atom-items
@@ -508,7 +519,7 @@ on the repository index page.")
                      (svg "image/svg+xml")))
    "Mimetype for the specified filename extension.")
   (mimetype-file
-   (string "")
+   (file-object "")
    "Specifies the file to use for automatic mimetype lookup.")
   (module-link
    (string "")
@@ -533,7 +544,7 @@ header on all pages.")
   ;;    "A list of subdirectories inside of @code{repository-directory},
   ;; relative to it, that should loaded as Git repositories.")
   (readme
-   (string "")
+   (file-object "")
    "Text which will be used as default value for @code{cgit-repo-readme}.")
   (remove-suffix?
    (boolean #f)
@@ -591,7 +602,7 @@ many path elements from each repo path to use as a default section name.")
    "If set to @samp{#t} shows side-by-side diffs instead of unidiffs per
 default.")
   (source-filter
-   (string "")
+   (file-object "")
    "Specifies a command which will be invoked to format plaintext blobs in the
 tree view.")
   (summary-branches
@@ -640,16 +651,14 @@ for cgit to allow access to that repository.")
          (config-str
           (if opaque-config?
               (opaque-cgit-configuration-cgitrc config)
-              (with-output-to-string
-                (lambda ()
-                  (serialize-configuration config
-                                           cgit-configuration-fields))))))
+              (serialize-configuration config cgit-configuration-fields))))
     #~(begin
         (use-modules (guix build utils))
         (mkdir-p #$(if opaque-config?
                        (opaque-cgit-configuration-cache-root config)
                        (cgit-configuration-cache-root config)))
-        (copy-file #$(plain-file "cgitrc" config-str) "/etc/cgitrc"))))
+        (copy-file #$(mixed-text-file "cgitrc" config-str)
+                   "/etc/cgitrc"))))
 
 (define (cgit-configuration-nginx-config config)
   (if (opaque-cgit-configuration? config)
-- 
2.17.0

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

From: Clément Lassieur <clement <at> lassieur.org>
To: 31089 <at> debbugs.gnu.org
Subject: [PATCH 4/5] services: cgit: Enforce serialization order.
Date: Sat,  7 Apr 2018 19:07:08 +0200

This distinguishes fields whose order matters, and makes sure further changes
won't inadvertently change the order.

* gnu/services/cgit.scm (serialize-cgit-configuration): New procedure that
serializes fields with a precise order.
(cgit-activation): Replace the generic SERIALIZE-CONFIGURATION with
SERIALIZE-CGIT-CONFIGURATION.
---
 gnu/services/cgit.scm | 13 ++++++++++++-
 1 file changed, 12 insertions(+), 1 deletion(-)

diff --git a/gnu/services/cgit.scm b/gnu/services/cgit.scm
index 98e46e0b8..f53306cd3 100644
--- a/gnu/services/cgit.scm
+++ b/gnu/services/cgit.scm
@@ -631,6 +631,17 @@ for cgit to allow access to that repository.")
    (list '())
    "Extra options will be appended to cgitrc file."))
 
+(define (serialize-cgit-configuration config)
+  (define (rest? field)
+    (not (memq (configuration-field-name field)
+               '(repositories))))
+  #~(string-append
+     #$(let ((rest (filter rest? cgit-configuration-fields)))
+         (serialize-configuration config rest))
+     #$(serialize-repository-cgit-configuration-list
+        'repositories
+        (cgit-configuration-repositories config))))
+
 (define-configuration opaque-cgit-configuration
   (cgit
    (package cgit)
@@ -651,7 +662,7 @@ for cgit to allow access to that repository.")
          (config-str
           (if opaque-config?
               (opaque-cgit-configuration-cgitrc config)
-              (serialize-configuration config cgit-configuration-fields))))
+              (serialize-cgit-configuration config))))
     #~(begin
         (use-modules (guix build utils))
         (mkdir-p #$(if opaque-config?
-- 
2.17.0

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

From: Clément Lassieur <clement <at> lassieur.org>
To: 31089 <at> debbugs.gnu.org
Subject: [PATCH 5/5] services: cgit: Add support for project-list.
Date: Sat,  7 Apr 2018 19:07:09 +0200

* doc/guix.texi (Version Control Services): Update accordingly.
* gnu/services/cgit.scm (cgit-configuration)[project-list]: New field.
(serialize-project-list): New procedure that uses PLAIN-FILE to generate a
file from the string list given by the user as input.
(serialize-cgit-configuration): Make sure to serialize 'project-list' before
'repostory-directory'.
---
 doc/guix.texi         |  9 +++++++++
 gnu/services/cgit.scm | 28 ++++++++++++++++++++--------
 2 files changed, 29 insertions(+), 8 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 35d23e1be..add29320e 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -19010,6 +19010,15 @@ Defaults to @samp{#f}.
 
 @end deftypevr
 
+@deftypevr {@code{cgit-configuration} parameter} list project-list
+A list of subdirectories inside of @code{repository-directory}, relative
+to it, that should loaded as Git repositories.  An empty list means that
+all subdirectories will be loaded.
+
+Defaults to @samp{()}.
+
+@end deftypevr
+
 @deftypevr {@code{cgit-configuration} parameter} file-object readme
 Text which will be used as default value for @code{cgit-repo-readme}.
 
diff --git a/gnu/services/cgit.scm b/gnu/services/cgit.scm
index f53306cd3..a39c09721 100644
--- a/gnu/services/cgit.scm
+++ b/gnu/services/cgit.scm
@@ -163,6 +163,12 @@
         ((path text)
          (format #f "repo.module-link.~a=~a\n" path text)))))
 
+(define (serialize-project-list _ val)
+  (if (null? val) ""
+      (serialize-field
+       'project-list
+       (plain-file "project-list" (string-join val "\n")))))
+
 (define repository-directory? string?)
 
 (define (serialize-repository-directory _ val)
@@ -536,13 +542,11 @@ disabled.")
    (boolean #f)
    "Flag which, when set to @samp{#t}, will make cgit omit the standard
 header on all pages.")
-  ;; TODO: cgit expects a file name
-  ;; that should be created from a list of strings provided by the user.
-  ;;
-  ;; (project-list
-  ;;    (string "")
-  ;;    "A list of subdirectories inside of @code{repository-directory},
-  ;; relative to it, that should loaded as Git repositories.")
+  (project-list
+   (list '())
+   "A list of subdirectories inside of @code{repository-directory}, relative
+to it, that should loaded as Git repositories.  An empty list means that all
+subdirectories will be loaded.")
   (readme
    (file-object "")
    "Text which will be used as default value for @code{cgit-repo-readme}.")
@@ -634,10 +638,18 @@ for cgit to allow access to that repository.")
 (define (serialize-cgit-configuration config)
   (define (rest? field)
     (not (memq (configuration-field-name field)
-               '(repositories))))
+               '(project-list
+                 repository-directory
+                 repositories))))
   #~(string-append
      #$(let ((rest (filter rest? cgit-configuration-fields)))
          (serialize-configuration config rest))
+     #$(serialize-project-list
+        'project-list
+        (cgit-configuration-project-list config))
+     #$(serialize-repository-directory
+        'repository-directory
+        (cgit-configuration-repository-directory config))
      #$(serialize-repository-cgit-configuration-list
         'repositories
         (cgit-configuration-repositories config))))
-- 
2.17.0

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

From: Clément Lassieur <clement <at> lassieur.org>
To: 31089 <at> debbugs.gnu.org
Subject: Re: [bug#31089] [PATCH 3/5] services: cgit: Add support for file-like
 objects.
Date: Mon, 09 Apr 2018 09:19:37 +0200

Clément Lassieur <clement <at> lassieur.org> writes:

> * doc/guix.texi (Version Control Services): Update accordingly.
> * gnu/services/cgit.scm (serialize-field, serialize-string, serialize-boolean,
> serialize-integer, serialize-repository-cgit-configuration-list,
> serialize-nginx-server-configuration-list, serialize-repo-field,
> serialize-repo-boolean, serialize-repo-integer, serialize-module-link-path,
> serialize-repository-directory, serialize-mimetype-alist): Return strings or
> string-valued gexps and stop printing.
> (repository-cgit-configuration)[source-filter, about-filter, commit-filter,
> logo, owner-filter], (cgit-configuration)[auth-filter, commit-filter, css,
> email-filter, favicon, include, logo, owner-filter, mimetype-file, readme,
> source-filter]: Replace STRING with FILE-OBJECT.
> (file-object?, serialize-file-object, repo-file-object?,
> serialize-repo-file-object): New procedures.
> (cgit-activation): Use SERIALIZE-CONFIGURATION's return value with
> MIXED-TEXT-FILE instead of using its output with PLAIN-FILE.
> ---
>  doc/guix.texi         | 37 +++++++++---------
>  gnu/services/cgit.scm | 87 ++++++++++++++++++++++++-------------------
>  2 files changed, 67 insertions(+), 57 deletions(-)
>
> diff --git a/doc/guix.texi b/doc/guix.texi
> index 738fdf65c..35d23e1be 100644
> --- a/doc/guix.texi
> +++ b/doc/guix.texi
> @@ -18552,7 +18552,7 @@ NGINX configuration.

I'll also add:

The @code{file-object} type designates either a file-like object
(@pxref{G-Expressions, file-like objects}) or a string.

>  @end deftypevr
>  
> -@deftypevr {@code{cgit-configuration} parameter} string about-filter
> +@deftypevr {@code{cgit-configuration} parameter} file-object about-filter
>  Specifies a command which will be invoked to format the content of about
>  pages (both top-level and for each repository).

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

From: ludo <at> gnu.org (Ludovic Courtès)
To: Clément Lassieur <clement <at> lassieur.org>
Cc: 31089 <at> debbugs.gnu.org
Subject: Re: [bug#31089] [PATCH 1/5] services: cgit: Simplify
 'uglify-field-name'.
Date: Tue, 10 Apr 2018 22:56:16 +0200

Hello,

Clément Lassieur <clement <at> lassieur.org> skribis:

> * gnu/services/cgit.scm (uglify-field-name): Remove STRING-JOIN and
> STRING-SPLIT.

LGTM!

> -    (string-join (string-split (string-delete #\? str) #\-) "-")))

Funny.  :-)

Ludo’.

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

From: ludo <at> gnu.org (Ludovic Courtès)
To: Clément Lassieur <clement <at> lassieur.org>
Cc: 31089 <at> debbugs.gnu.org
Subject: Re: [bug#31089] [PATCH 2/5] services: cgit: Simplify
 'serialize-module-link-path'.
Date: Tue, 10 Apr 2018 22:56:38 +0200

Clément Lassieur <clement <at> lassieur.org> skribis:

> * gnu/services/cgit.scm (serialize-module-link-path): Remove STRING-DROP-RIGHT
> and UGLIFY-FIELD-NAME.

OK.

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

From: ludo <at> gnu.org (Ludovic Courtès)
To: Clément Lassieur <clement <at> lassieur.org>
Cc: 31089 <at> debbugs.gnu.org
Subject: Re: [bug#31089] [PATCH 3/5] services: cgit: Add support for file-like
 objects.
Date: Tue, 10 Apr 2018 22:59:23 +0200

Clément Lassieur <clement <at> lassieur.org> skribis:

> * doc/guix.texi (Version Control Services): Update accordingly.
> * gnu/services/cgit.scm (serialize-field, serialize-string, serialize-boolean,
> serialize-integer, serialize-repository-cgit-configuration-list,
> serialize-nginx-server-configuration-list, serialize-repo-field,
> serialize-repo-boolean, serialize-repo-integer, serialize-module-link-path,
> serialize-repository-directory, serialize-mimetype-alist): Return strings or
> string-valued gexps and stop printing.
> (repository-cgit-configuration)[source-filter, about-filter, commit-filter,
> logo, owner-filter], (cgit-configuration)[auth-filter, commit-filter, css,
> email-filter, favicon, include, logo, owner-filter, mimetype-file, readme,
> source-filter]: Replace STRING with FILE-OBJECT.
> (file-object?, serialize-file-object, repo-file-object?,
> serialize-repo-file-object): New procedures.
> (cgit-activation): Use SERIALIZE-CONFIGURATION's return value with
> MIXED-TEXT-FILE instead of using its output with PLAIN-FILE.

Nice!

>           (config-str
>            (if opaque-config?
>                (opaque-cgit-configuration-cgitrc config)
> -              (with-output-to-string
> -                (lambda ()
> -                  (serialize-configuration config
> -                                           cgit-configuration-fields))))))
> +              (serialize-configuration config cgit-configuration-fields))))
>      #~(begin
>          (use-modules (guix build utils))
>          (mkdir-p #$(if opaque-config?
>                         (opaque-cgit-configuration-cache-root config)
>                         (cgit-configuration-cache-root config)))
> -        (copy-file #$(plain-file "cgitrc" config-str) "/etc/cgitrc"))))
> +        (copy-file #$(mixed-text-file "cgitrc" config-str)
> +                   "/etc/cgitrc"))))

For clarity, since ‘config-str’ is no longer a string (right?), I’d
rename it to just ‘config’ or something.

Also, could it be that you’re missing ‘apply’ above, as in:

  (apply mixed-text-file "cgitrc" config-str)

?

Otherwise LGTM, thanks!

Ludo’.

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

From: ludo <at> gnu.org (Ludovic Courtès)
To: Clément Lassieur <clement <at> lassieur.org>
Cc: 31089 <at> debbugs.gnu.org
Subject: Re: [bug#31089] [PATCH 4/5] services: cgit: Enforce serialization
 order.
Date: Tue, 10 Apr 2018 23:00:22 +0200

Clément Lassieur <clement <at> lassieur.org> skribis:

> This distinguishes fields whose order matters, and makes sure further changes
> won't inadvertently change the order.
>
> * gnu/services/cgit.scm (serialize-cgit-configuration): New procedure that
> serializes fields with a precise order.
> (cgit-activation): Replace the generic SERIALIZE-CONFIGURATION with
> SERIALIZE-CGIT-CONFIGURATION.
> ---
>  gnu/services/cgit.scm | 13 ++++++++++++-
>  1 file changed, 12 insertions(+), 1 deletion(-)
>
> diff --git a/gnu/services/cgit.scm b/gnu/services/cgit.scm
> index 98e46e0b8..f53306cd3 100644
> --- a/gnu/services/cgit.scm
> +++ b/gnu/services/cgit.scm
> @@ -631,6 +631,17 @@ for cgit to allow access to that repository.")
>     (list '())
>     "Extra options will be appended to cgitrc file."))
>  
> +(define (serialize-cgit-configuration config)
> +  (define (rest? field)
> +    (not (memq (configuration-field-name field)
> +               '(repositories))))
> +  #~(string-append
> +     #$(let ((rest (filter rest? cgit-configuration-fields)))
> +         (serialize-configuration config rest))
> +     #$(serialize-repository-cgit-configuration-list
> +        'repositories
> +        (cgit-configuration-repositories config))))

Please add a comment here explaining the story about field ordering.

OK with this change!

Ludo’.

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

From: ludo <at> gnu.org (Ludovic Courtès)
To: Clément Lassieur <clement <at> lassieur.org>
Cc: 31089 <at> debbugs.gnu.org
Subject: Re: [bug#31089] [PATCH 5/5] services: cgit: Add support for
 project-list.
Date: Tue, 10 Apr 2018 23:00:57 +0200

Clément Lassieur <clement <at> lassieur.org> skribis:

> * doc/guix.texi (Version Control Services): Update accordingly.
> * gnu/services/cgit.scm (cgit-configuration)[project-list]: New field.
> (serialize-project-list): New procedure that uses PLAIN-FILE to generate a
> file from the string list given by the user as input.
> (serialize-cgit-configuration): Make sure to serialize 'project-list' before
> 'repostory-directory'.

Pretty cool.  LGTM, thanks!

Ludo'.

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

From: Clément Lassieur <clement <at> lassieur.org>
To: Ludovic Courtès <ludo <at> gnu.org>
Cc: 31089 <at> debbugs.gnu.org
Subject: Re: [bug#31089] [PATCH 3/5] services: cgit: Add support for file-like
 objects.
Date: Wed, 11 Apr 2018 10:35:19 +0200

Ludovic Courtès <ludo <at> gnu.org> writes:

>>           (config-str
>>            (if opaque-config?
>>                (opaque-cgit-configuration-cgitrc config)
>> -              (with-output-to-string
>> -                (lambda ()
>> -                  (serialize-configuration config
>> -                                           cgit-configuration-fields))))))
>> +              (serialize-configuration config cgit-configuration-fields))))
>>      #~(begin
>>          (use-modules (guix build utils))
>>          (mkdir-p #$(if opaque-config?
>>                         (opaque-cgit-configuration-cache-root config)
>>                         (cgit-configuration-cache-root config)))
>> -        (copy-file #$(plain-file "cgitrc" config-str) "/etc/cgitrc"))))
>> +        (copy-file #$(mixed-text-file "cgitrc" config-str)
>> +                   "/etc/cgitrc"))))
>
> For clarity, since ‘config-str’ is no longer a string (right?), I’d
> rename it to just ‘config’ or something.
>
> Also, could it be that you’re missing ‘apply’ above, as in:
>
>   (apply mixed-text-file "cgitrc" config-str)
>
> ?

Yes, config-str is still a string (or a string-valued gexp).  I use
mixed-text-file because it can take gexps as arguments, whereas
plain-file can't.

> Otherwise LGTM, thanks!

Thank you for the review!

Clément

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

From: Clément Lassieur <clement <at> lassieur.org>
To: Ludovic Courtès <ludo <at> gnu.org>
Cc: 31089-done <at> debbugs.gnu.org
Subject: Re: [bug#31089] [PATCH 3/5] services: cgit: Add support for file-like
 objects.
Date: Wed, 11 Apr 2018 21:27:14 +0200

Clément Lassieur <clement <at> lassieur.org> writes:

> Ludovic Courtès <ludo <at> gnu.org> writes:
>
>>>           (config-str
>>>            (if opaque-config?
>>>                (opaque-cgit-configuration-cgitrc config)
>>> -              (with-output-to-string
>>> -                (lambda ()
>>> -                  (serialize-configuration config
>>> -                                           cgit-configuration-fields))))))
>>> +              (serialize-configuration config cgit-configuration-fields))))
>>>      #~(begin
>>>          (use-modules (guix build utils))
>>>          (mkdir-p #$(if opaque-config?
>>>                         (opaque-cgit-configuration-cache-root config)
>>>                         (cgit-configuration-cache-root config)))
>>> -        (copy-file #$(plain-file "cgitrc" config-str) "/etc/cgitrc"))))
>>> +        (copy-file #$(mixed-text-file "cgitrc" config-str)
>>> +                   "/etc/cgitrc"))))
>>
>> For clarity, since ‘config-str’ is no longer a string (right?), I’d
>> rename it to just ‘config’ or something.
>>
>> Also, could it be that you’re missing ‘apply’ above, as in:
>>
>>   (apply mixed-text-file "cgitrc" config-str)
>>
>> ?
>
> Yes, config-str is still a string (or a string-valued gexp).  I use
> mixed-text-file because it can take gexps as arguments, whereas
> plain-file can't.
>
>> Otherwise LGTM, thanks!
>
> Thank you for the review!
>
> Clément

Pushed.

Previous Next

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