me
/
guix
Archived
1
0
Fork 0
Code

guix: docker: Ensure repository name length limits are met. 

* guix/docker.scm (canonicalize-repository-name): Fix typo in doc.  Capture
repository name length limits and ensure they are met, by either truncating or
padding the normalized name.

Reported-by: Ludovic Courtès <ludo@gnu.org>
master
Maxim Cournoyer 2021-07-03 23:08:15 -04:00
parent 4fa62cf702
commit 38bcef1c3b
No known key found for this signature in database
GPG Key ID: 1260E46482E63562
1 changed files with 22 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
guix/docker.scm
View File

@ -2,6 +2,7 @@
;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2017, 2018, 2019, 2021 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2017, 2018, 2019, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com> ;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -59,8 +60,13 @@
(container_config . #nil))) (container_config . #nil)))
(define (canonicalize-repository-name name) (define (canonicalize-repository-name name)
"\"Repository\" names are restricted to roughtl [a-z0-9_.-]. "\"Repository\" names are restricted to roughly [a-z0-9_.-].
Return a version of TAG that follows these rules." Return a version of TAG that follows these rules."
;; Refer to https://docs.docker.com/docker-hub/repos/.
(define min-length 2)
(define padding-character #\a)
(define max-length 255)
(define ascii-letters (define ascii-letters
(string->char-set "abcdefghijklmnopqrstuvwxyz")) (string->char-set "abcdefghijklmnopqrstuvwxyz"))
@ -70,11 +76,21 @@ Return a version of TAG that follows these rules."
(define repo-char-set (define repo-char-set
(char-set-union char-set:digit ascii-letters separators)) (char-set-union char-set:digit ascii-letters separators))
(string-map (lambda (chr) (define normalized-name
(if (char-set-contains? repo-char-set chr) (string-map (lambda (chr)
chr (if (char-set-contains? repo-char-set chr)
#\.)) chr
(string-trim (string-downcase name) separators))) #\.))
(string-trim (string-downcase name) separators)))
(let ((l (string-length normalized-name)))
(match l
((? (cut > <> max-length))
(string-take normalized-name max-length))
((? (cut < <> min-length))
(string-append normalized-name
(make-string (- min-length l) padding-character)))
(_ normalized-name))))
(define* (manifest path id #:optional (tag "guix")) (define* (manifest path id #:optional (tag "guix"))
"Generate a simple image manifest." "Generate a simple image manifest."