ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 21:38:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

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

Browse source 
* 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>
This commit is contained in:
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, 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 @@ (define (image-description id time)
(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 @@ (define separators
(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."