me
/
guix
Archived
1
0
Fork 0
Code

publish: Provide server's signing key. 

* guix/scripts/publish.scm (render-signing-key): New procedure.
(render-home-page): Add link to it.
(make-request-handler): Handle it.

Signed-off-by: Ludovic Courtès <ludo@gnu.org>
master
Amar Singh 2020-10-21 02:02:02 +05:30 committed by Ludovic Courtès
parent b35550c3d8
commit 6955cff962
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 22 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
guix/scripts/publish.scm
View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 David Thompson <davet@gnu.org> ;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;; Copyright © 2020 by Amar M. Singh <nly@disroot.org>
;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -686,6 +687,13 @@ to compress or decompress the log file; just return it as-is."
(values (response-headers log) log) (values (response-headers log) log)
(not-found request)))) (not-found request))))
(define (render-signing-key)
"Render signing key."
(let ((file %public-key-file))
(values `((content-type . (text/plain (charset . "UTF-8")))
(x-raw-file . ,file))
file)))
(define (render-home-page request) (define (render-home-page request)
"Render the home page." "Render the home page."
(values `((content-type . (text/html (charset . "UTF-8")))) (values `((content-type . (text/html (charset . "UTF-8"))))
@ -699,7 +707,12 @@ to compress or decompress the log file; just return it as-is."
(a (@ (href (a (@ (href
"https://guix.gnu.org/manual/en/html_node/Invoking-guix-publish.html")) "https://guix.gnu.org/manual/en/html_node/Invoking-guix-publish.html"))
(tt "guix publish")) (tt "guix publish"))
" speaking. Welcome!"))) " speaking. Welcome!")
(p "Here is the "
(a (@ (href
"signing-key.pub"))
(tt "signing key"))
" for this server. Knock yourselves out!")))
port))))) port)))))
(define (extract-narinfo-hash str) (define (extract-narinfo-hash str)
@ -918,6 +931,9 @@ methods, return the applicable compression."
;; / ;; /
((or () ("index.html")) ((or () ("index.html"))
(render-home-page request)) (render-home-page request))
;; guix signing-key
(("signing-key.pub")
(render-signing-key))
;; /<hash>.narinfo ;; /<hash>.narinfo
(((= extract-narinfo-hash (? string? hash))) (((= extract-narinfo-hash (? string? hash)))
(if cache (if cache

5
tests/publish.scm
View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 David Thompson <davet@gnu.org> ;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;; Copyright © 2020 by Amar M. Singh <nly@disroot.org>
;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -613,6 +614,10 @@ References: ~%"
(let ((uri (publish-uri "/log/does-not-exist"))) (let ((uri (publish-uri "/log/does-not-exist")))
(response-code (http-get uri)))) (response-code (http-get uri))))
(test-equal "/signing-key.pub"
200
(response-code (http-get (publish-uri "/signing-key.pub"))))
(test-equal "non-GET query" (test-equal "non-GET query"
'(200 404) '(200 404)
(let ((path (string-append "/" (store-path-hash-part %item) (let ((path (string-append "/" (store-path-hash-part %item)