From ce1dac19ef1790cc371fb3acb679a6ca871e4142 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Sat, 22 Jan 2022 17:03:04 +0000
Subject: Support specifying TTL's for narinfo responses

Using the same approach as guix publish.
---
 scripts/nar-herder.in | 27 +++++++++++++++++++++++++--
 1 file changed, 25 insertions(+), 2 deletions(-)

(limited to 'scripts')

diff --git a/scripts/nar-herder.in b/scripts/nar-herder.in
index a969910..1cc5a67 100644
--- a/scripts/nar-herder.in
+++ b/scripts/nar-herder.in
@@ -48,7 +48,7 @@
              (fibers)
              (fibers conditions)
              (fibers web server)
-             ((guix ui) #:select (read/eval))
+             ((guix ui) #:select (read/eval string->duration))
              (guix progress)
              (guix narinfo)
              (guix derivations)
@@ -116,6 +116,27 @@
                                  (cons (string->symbol sym) rest)))
                               result)))
 
+        (option '("ttl") #t #f
+                (lambda (opt name arg result)
+                  (let ((duration (string->duration arg)))
+                    (unless duration
+                      (simple-format (current-error-port)
+                                     "~A: invalid duration\n"
+                                     arg)
+                      (exit 1))
+                    (alist-cons 'narinfo-ttl (time-second duration)
+                                result))))
+        (option '("negative-ttl") #t #f
+                (lambda (opt name arg result)
+                  (let ((duration (string->duration arg)))
+                    (unless duration
+                      (simple-format (current-error-port)
+                                     "~A: invalid duration\n"
+                                     arg)
+                      (exit 1))
+                    (alist-cons 'narinfo-negative-ttl (time-second duration)
+                                result))))
+
         (option '("recent-changes-limit") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'recent-changes-limit
@@ -318,6 +339,8 @@
                       "starting server\n")
        (run-server
         (make-request-handler database
-                              canonical-storage)
+                              canonical-storage
+                              #:ttl (assq-ref opts 'narinfo-ttl)
+                              #:negative-ttl (assq-ref opts 'narinfo-negative-ttl))
         #:host (assq-ref opts 'host)
         #:port (assq-ref opts 'port))))))
-- 
cgit v1.2.3