mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-25 22:08:16 -05:00
gnu-maintenance: Remove unused procedures.
* guix/gnu-maintenance.scm (url-prefix-rewrite, adjusted-upstream-source): Remove. Signed-off-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
parent
d9b8169a9f
commit
55d4200002
1 changed files with 0 additions and 16 deletions
|
@ -660,13 +660,6 @@ (define (pure-gnu-package? package)
|
||||||
(define gnu-hosted?
|
(define gnu-hosted?
|
||||||
(url-prefix-predicate "mirror://gnu/"))
|
(url-prefix-predicate "mirror://gnu/"))
|
||||||
|
|
||||||
(define (url-prefix-rewrite old new)
|
|
||||||
"Return a one-argument procedure that rewrites URL prefix OLD to NEW."
|
|
||||||
(lambda (url)
|
|
||||||
(if (and url (string-prefix? old url))
|
|
||||||
(string-append new (string-drop url (string-length old)))
|
|
||||||
url)))
|
|
||||||
|
|
||||||
(define (uri-mirror-rewrite uri)
|
(define (uri-mirror-rewrite uri)
|
||||||
"Rewrite URI to a mirror:// URI if possible, or return URI unmodified."
|
"Rewrite URI to a mirror:// URI if possible, or return URI unmodified."
|
||||||
(if (string-prefix? "mirror://" uri)
|
(if (string-prefix? "mirror://" uri)
|
||||||
|
@ -684,15 +677,6 @@ (define (uri-mirror-rewrite uri)
|
||||||
mirror-id
|
mirror-id
|
||||||
(string-drop uri (string-length prefix))))))))))
|
(string-drop uri (string-length prefix))))))))))
|
||||||
|
|
||||||
(define (adjusted-upstream-source source rewrite-url)
|
|
||||||
"Rewrite URLs in SOURCE by apply REWRITE-URL to each of them."
|
|
||||||
(upstream-source
|
|
||||||
(inherit source)
|
|
||||||
(urls (map rewrite-url (upstream-source-urls source)))
|
|
||||||
(signature-urls (and=> (upstream-source-signature-urls source)
|
|
||||||
(lambda (urls)
|
|
||||||
(map rewrite-url urls))))))
|
|
||||||
|
|
||||||
(define %savannah-base
|
(define %savannah-base
|
||||||
;; One of the Savannah mirrors listed at
|
;; One of the Savannah mirrors listed at
|
||||||
;; <http://download0.savannah.gnu.org/mirmon/savannah/> that serves valid
|
;; <http://download0.savannah.gnu.org/mirmon/savannah/> that serves valid
|
||||||
|
|
Loading…
Reference in a new issue