From a35136cb564123932dbab2e3f319b344ecdca555 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Wed, 19 Apr 2017 17:16:21 +0200
Subject: [PATCH] services: guix-publish: Add 'cache', 'workers', and 'ttl'
 config knobs.

* gnu/services/base.scm (<guix-publish-configuration>)[cache, workers,
ttl]: New fields.
(guix-publish-shepherd-service): Honor them.
(guix-publish-activation): New procedure.
(guix-publish-service-type): Extend ACTIVATION-SERVICE-TYPE.
* doc/guix.texi (Base Services): Document it.
---
 doc/guix.texi         | 17 ++++++++++++++++
 gnu/services/base.scm | 46 +++++++++++++++++++++++++++++++++++++++----
 2 files changed, 59 insertions(+), 4 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index f2eba59d9c..a482beea50 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -9145,6 +9145,23 @@ compression ratio at the expense of increased CPU usage.
 @item @code{nar-path} (default: @code{"nar"})
 The URL path at which ``nars'' can be fetched.  @xref{Invoking guix
 publish, @code{--nar-path}}, for details.
+
+@item @code{cache} (default: @code{#f})
+When it is @code{#f}, disable caching and instead generate archives on
+demand.  Otherwise, this should be the name of a directory---e.g.,
+@code{"/var/cache/guix/publish"}---where @command{guix publish} caches
+archives and meta-data ready to be sent.  @xref{Invoking guix publish,
+@option{--cache}}, for more information on the tradeoffs involved.
+
+@item @code{workers} (default: @code{#f})
+When it is an integer, this is the number of worker threads used for
+caching; when @code{#f}, the number of processors is used.
+@xref{Invoking guix publish, @option{--workers}}, for more information.
+
+@item @code{ttl} (default: @code{#f})
+When it is an integer, this denotes the @dfn{time-to-live} of the
+published archives.  @xref{Invoking guix publish, @option{--ttl}}, for
+more information.
 @end table
 @end deftp
 
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index fae992f0db..67972bf614 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -129,6 +129,8 @@ (define-module (gnu services base)
             guix-publish-configuration-host
             guix-publish-configuration-compression-level
             guix-publish-configuration-nar-path
+            guix-publish-configuration-cache
+            guix-publish-configuration-ttl
             guix-publish-service
             guix-publish-service-type
 
@@ -1445,11 +1447,18 @@ (define-record-type* <guix-publish-configuration>
   (compression-level guix-publish-configuration-compression-level ;integer
                      (default 3))
   (nar-path    guix-publish-configuration-nar-path ;string
-               (default "nar")))
+               (default "nar"))
+  (cache       guix-publish-configuration-cache   ;#f | string
+               (default #f))
+  (workers     guix-publish-configuration-workers ;#f | integer
+               (default #f))
+  (ttl         guix-publish-configuration-ttl     ;#f | integer
+               (default #f)))
 
 (define guix-publish-shepherd-service
   (match-lambda
-    (($ <guix-publish-configuration> guix port host compression nar-path)
+    (($ <guix-publish-configuration> guix port host compression
+                                     nar-path cache workers ttl)
      (list (shepherd-service
             (provision '(guix-publish))
             (requirement '(guix-daemon))
@@ -1459,7 +1468,20 @@ (define guix-publish-shepherd-service
                             "-p" #$(number->string port)
                             "-C" #$(number->string compression)
                             (string-append "--nar-path=" #$nar-path)
-                            (string-append "--listen=" #$host))))
+                            (string-append "--listen=" #$host)
+                            #$@(if workers
+                                   #~((string-append "--workers="
+                                                     #$(number->string
+                                                        workers)))
+                                   #~())
+                            #$@(if ttl
+                                   #~((string-append "--ttl="
+                                                     #$(number->string ttl)
+                                                     "s"))
+                                   #~())
+                            #$@(if cache
+                                   #~((string-append "--cache=" #$cache))
+                                   #~()))))
             (stop #~(make-kill-destructor)))))))
 
 (define %guix-publish-accounts
@@ -1472,13 +1494,29 @@ (define %guix-publish-accounts
          (home-directory "/var/empty")
          (shell (file-append shadow "/sbin/nologin")))))
 
+(define (guix-publish-activation config)
+  (let ((cache (guix-publish-configuration-cache config)))
+    (if cache
+        (with-imported-modules '((guix build utils))
+          #~(begin
+              (use-modules (guix build utils))
+
+              (mkdir-p #$cache)
+              (let* ((pw  (getpw "guix-publish"))
+                     (uid (passwd:uid pw))
+                     (gid (passwd:gid pw)))
+                (chown #$cache uid gid))))
+        #t)))
+
 (define guix-publish-service-type
   (service-type (name 'guix-publish)
                 (extensions
                  (list (service-extension shepherd-root-service-type
                                           guix-publish-shepherd-service)
                        (service-extension account-service-type
-                                          (const %guix-publish-accounts))))
+                                          (const %guix-publish-accounts))
+                       (service-extension activation-service-type
+                                          guix-publish-activation)))
                 (default-value (guix-publish-configuration))))
 
 (define* (guix-publish-service #:key (guix guix) (port 80) (host "localhost"))