diff options
author | Maxim Cournoyer <maxim.cournoyer@gmail.com> | 2021-07-03 23:08:15 -0400 |
---|---|---|
committer | Maxim Cournoyer <maxim.cournoyer@gmail.com> | 2021-07-05 16:34:07 -0400 |
commit | 38bcef1c3b4f67abb314368d2248e08026219de3 (patch) | |
tree | a42abddbf94b6c6ab649eabfa07dbe516c9fcd0b | |
parent | 4fa62cf70214b4bd10e3682b8c91f62aa9ceb387 (diff) | |
download | guix-38bcef1c3b4f67abb314368d2248e08026219de3.tar.gz |
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>
-rw-r--r-- | guix/docker.scm | 28 |
1 files changed, 22 insertions, 6 deletions
diff --git a/guix/docker.scm b/guix/docker.scm index bd952e45ec..a6f73d423c 100644 --- a/guix/docker.scm +++ b/guix/docker.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2017, 2018, 2019, 2021 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com> +;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -59,8 +60,13 @@ (container_config . #nil))) (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." + ;; Refer to https://docs.docker.com/docker-hub/repos/. + (define min-length 2) + (define padding-character #\a) + (define max-length 255) + (define ascii-letters (string->char-set "abcdefghijklmnopqrstuvwxyz")) @@ -70,11 +76,21 @@ Return a version of TAG that follows these rules." (define repo-char-set (char-set-union char-set:digit ascii-letters separators)) - (string-map (lambda (chr) - (if (char-set-contains? repo-char-set chr) - chr - #\.)) - (string-trim (string-downcase name) separators))) + (define normalized-name + (string-map (lambda (chr) + (if (char-set-contains? repo-char-set chr) + chr + #\.)) + (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")) "Generate a simple image manifest." |