guix-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

05/06: publish: Add a handler for / and /index.html.


From: Ludovic Courtès
Subject: 05/06: publish: Add a handler for / and /index.html.
Date: Wed, 19 Apr 2017 17:46:00 -0400 (EDT)

civodul pushed a commit to branch master
in repository guix.

commit e1bbc0e38d0c9a5d248ec8b686fdd0a972a61ff4
Author: Ludovic Courtès <address@hidden>
Date:   Wed Apr 19 23:39:27 2017 +0200

    publish: Add a handler for / and /index.html.
    
    Suggested by Quiliro <address@hidden>
    in <https://bugs.gnu.org/26567>.
    
    * guix/scripts/publish.scm (render-home-page): New procedure.
    (make-request-handler): Handle it.
---
 guix/scripts/publish.scm | 20 ++++++++++++++++++++
 1 file changed, 20 insertions(+)

diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index 9dc006e..3faff06 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -39,6 +39,7 @@
   #:use-module (web response)
   #:use-module (web server)
   #:use-module (web uri)
+  #:autoload   (sxml simple) (sxml->xml)
   #:use-module (guix base32)
   #:use-module (guix base64)
   #:use-module (guix config)
@@ -532,6 +533,22 @@ has the given HASH of type ALGO."
             (not-found request)))
       (not-found request)))
 
+(define (render-home-page request)
+  "Render the home page."
+  (values `((content-type . (text/html (charset . "UTF-8"))))
+          (call-with-output-string
+            (lambda (port)
+              (sxml->xml '(html
+                           (head (title "GNU Guix Substitute Server"))
+                           (body
+                            (h1 "GNU Guix Substitute Server")
+                            (p "Hi, "
+                               (a (@ (href
+                                      
"https://gnu.org/s/guix/manual/html_node/Invoking-guix-publish.html";))
+                                  (tt "guix publish"))
+                               " speaking.  Welcome!")))
+                         port)))))
+
 (define extract-narinfo-hash
   (let ((regexp (make-regexp "^([a-df-np-sv-z0-9]{32}).narinfo$")))
     (lambda (str)
@@ -686,6 +703,9 @@ blocking."
           ;; /nix-cache-info
           (("nix-cache-info")
            (render-nix-cache-info))
+          ;; /
+          ((or () ("index.html"))
+           (render-home-page request))
           ;; /<hash>.narinfo
           (((= extract-narinfo-hash (? string? hash)))
            ;; TODO: Register roots for HASH that will somehow remain for



reply via email to

[Prev in Thread] Current Thread [Next in Thread]