mirror of
https://github.com/fosslinux/live-bootstrap.git
synced 2026-03-25 20:46:32 +01:00
fix(guix-bootstrap): serve local distfiles via fixed localhost HTTP mirror
This commit is contained in:
parent
85a0ff7c72
commit
19501750f5
5 changed files with 60 additions and 60 deletions
|
|
@ -1,51 +0,0 @@
|
|||
--- guix-1.5.0/guix/scripts/perform-download.scm
|
||||
+++ guix-1.5.0/guix/scripts/perform-download.scm
|
||||
@@ -97,16 +97,46 @@ a list of wrapper procedures for safely calling the list of procedures that
|
||||
(call-with-port (open file (logior O_NOFOLLOW O_RDONLY))
|
||||
proc))
|
||||
|
||||
+(define %allowed-local-download-directories
|
||||
+ ;; Allow only the explicitly prepared offline distfiles directory. Other
|
||||
+ ;; local file URLs remain forbidden.
|
||||
+ '("/external/distfiles"))
|
||||
+
|
||||
+(define (path-within-directory? path directory)
|
||||
+ (or (string=? path directory)
|
||||
+ (string-prefix? (string-append directory "/") path)))
|
||||
+
|
||||
+(define (allowed-local-file? path)
|
||||
+ (let ((canon-path (false-if-exception (canonicalize-path path))))
|
||||
+ (and canon-path
|
||||
+ (let loop ((directories %allowed-local-download-directories))
|
||||
+ (match directories
|
||||
+ (() #f)
|
||||
+ ((directory rest ...)
|
||||
+ (let ((canon-directory
|
||||
+ (false-if-exception (canonicalize-path directory))))
|
||||
+ (if (and canon-directory
|
||||
+ (path-within-directory? canon-path canon-directory))
|
||||
+ #t
|
||||
+ (loop rest)))))))))
|
||||
+
|
||||
+(define (file-uri-allowed? url)
|
||||
+ (let ((uri (string->uri url)))
|
||||
+ (and uri
|
||||
+ (eq? (uri-scheme uri) 'file)
|
||||
+ (allowed-local-file? (uri-path uri)))))
|
||||
+
|
||||
(define (assert-non-local-urls url)
|
||||
"Exit if URL (or any element of URL if it is a list) is either not a valid
|
||||
URL or is a URL for a local file."
|
||||
(for-each (lambda (url)
|
||||
- (let ((scheme (and=> (string->uri url) uri-scheme)))
|
||||
- (unless scheme
|
||||
+ (let ((uri (string->uri url)))
|
||||
+ (unless uri
|
||||
(leave (G_ "URL ~S can't be decoded~%") url))
|
||||
- (when (eq? scheme 'file)
|
||||
+ (when (and (eq? (uri-scheme uri) 'file)
|
||||
+ (not (file-uri-allowed? url)))
|
||||
(leave (G_ "URL ~S is for a local file~%") url))))
|
||||
(if (list? url)
|
||||
url
|
||||
(list url))))
|
||||
|
|
@ -27,7 +27,7 @@
|
|||
- "https://alpha.gnu.org/gnu/guix/bootstrap/"
|
||||
- "http://flashner.co.il/guix/bootstrap/"
|
||||
- "http://lilypond.org/janneke/guix/"))
|
||||
+ '("file:///external/distfiles/"))
|
||||
+ '("http://127.0.0.1:38445/"))
|
||||
|
||||
(define (bootstrap-executable-file-name system program)
|
||||
"Return the FILE-NAME part of url where PROGRAM can be found for SYSTEM."
|
||||
|
|
|
|||
|
|
@ -17,8 +17,8 @@
|
|||
"http://lilypond.org/janneke/guix/"))
|
||||
|
||||
+(define %bootstrap-base-urls
|
||||
+ ;; All bootstrap binaries must come from local, reproducible distfiles.
|
||||
+ '("file:///external/distfiles"))
|
||||
+ ;; All bootstrap binaries must come from the local bootstrap mirror.
|
||||
+ '("http://127.0.0.1:38445"))
|
||||
+
|
||||
(define (bootstrap-guile-url-path system)
|
||||
"Return the URI for FILE."
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue