summaryrefslogtreecommitdiff
path: root/guix/docker.scm
diff options
context:
space:
mode:
authorMaxim Cournoyer <maxim.cournoyer@gmail.com>2021-07-03 23:08:15 -0400
committerMaxim Cournoyer <maxim.cournoyer@gmail.com>2021-07-05 16:34:07 -0400
commit38bcef1c3b4f67abb314368d2248e08026219de3 (patch)
treea42abddbf94b6c6ab649eabfa07dbe516c9fcd0b /guix/docker.scm
parent4fa62cf70214b4bd10e3682b8c91f62aa9ceb387 (diff)
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>
Diffstat (limited to 'guix/docker.scm')
-rw-r--r--guix/docker.scm28
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."