/ docker-image.el
docker-image.el
1 ;;; docker-image.el --- Interface to docker-image -*- lexical-binding: t -*- 2 3 ;; Author: Philippe Vaucher <philippe.vaucher@gmail.com> 4 5 ;; This file is NOT part of GNU Emacs. 6 7 ;; This program is free software; you can redistribute it and/or modify 8 ;; it under the terms of the GNU General Public License as published by 9 ;; the Free Software Foundation; either version 3, or (at your option) 10 ;; any later version. 11 ;; 12 ;; This program is distributed in the hope that it will be useful, 13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 ;; GNU General Public License for more details. 16 ;; 17 ;; You should have received a copy of the GNU General Public License 18 ;; along with GNU Emacs; see the file COPYING. If not, write to the 19 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 20 ;; Boston, MA 02110-1301, USA. 21 22 ;;; Commentary: 23 24 ;;; Code: 25 (eval-when-compile 26 (setq-local byte-compile-warnings '(not docstrings))) 27 28 (require 's) 29 (require 'aio) 30 (require 'dash) 31 (require 'json) 32 (require 'tablist) 33 (require 'transient) 34 35 (require 'docker-core) 36 (require 'docker-faces) 37 (require 'docker-utils) 38 39 (defgroup docker-image nil 40 "Docker images customization group." 41 :group 'docker) 42 43 (defconst docker-image-id-template 44 "[{{ json .Repository }},{{ json .Tag }},{{ json .ID }}]" 45 "This Go template defines what will be passed to transient commands. 46 47 This value is processed by `docker-image-make-id'.") 48 49 (defcustom docker-image-default-sort-key '("Repository" . nil) 50 "Sort key for docker images. 51 52 This should be a cons cell (NAME . FLIP) where 53 NAME is a string matching one of the column names 54 and FLIP is a boolean to specify the sort order." 55 :group 'docker-image 56 :type '(cons (string :tag "Column Name" 57 :validate (lambda (widget) 58 (unless (--any-p (equal (plist-get it :name) (widget-value widget)) docker-image-columns) 59 (widget-put widget :error "Default Sort Key must match a column name") 60 widget))) 61 (choice (const :tag "Ascending" nil) 62 (const :tag "Descending" t)))) 63 64 (defcustom docker-image-columns 65 '((:name "Repository" :width 30 :template "{{ json .Repository }}" :sort nil :format nil) 66 (:name "Tag" :width 20 :template "{{ json .Tag }}" :sort nil :format nil) 67 (:name "Id" :width 16 :template "{{ json .ID }}" :sort nil :format nil) 68 (:name "Created" :width 24 :template "{{ json .CreatedAt }}" :sort nil :format (lambda (x) (format-time-string "%F %T" (date-to-time x)))) 69 (:name "Size" :width 10 :template "{{ json .Size }}" :sort docker-utils-human-size-predicate :format nil)) 70 "Column specification for docker images. 71 72 The order of entries defines the displayed column order. 73 'Template' is the Go template passed to `docker-image-ls' to create the column 74 data. It should return a string delimited with double quotes. 75 'Sort function' is a binary predicate that should return true when the first 76 argument should be sorted before the second. 77 'Format function' is a function from string to string that transforms the 78 displayed values in the column." 79 :group 'docker-image 80 :set 'docker-utils-columns-setter 81 :get 'docker-utils-columns-getter 82 :type '(repeat (list :tag "Column" 83 (string :tag "Name") 84 (integer :tag "Width") 85 (string :tag "Template") 86 (sexp :tag "Sort function") 87 (sexp :tag "Format function")))) 88 89 (defconst docker-image-history-id-template 90 "{{ json .ID }}" 91 "This Go template extracts the history entry id.") 92 93 (defcustom docker-image-history-default-sort-key '("Created" . t) 94 "Sort key for docker image history. 95 96 This should be a cons cell (NAME . FLIP) where 97 NAME is a string matching one of the column names 98 and FLIP is a boolean to specify the sort order." 99 :group 'docker-image 100 :type '(cons (string :tag "Column Name" 101 :validate (lambda (widget) 102 (unless (--any-p (equal (plist-get it :name) (widget-value widget)) docker-image-history-columns) 103 (widget-put widget :error "Default Sort Key must match a column name") 104 widget))) 105 (choice (const :tag "Ascending" nil) 106 (const :tag "Descending" t)))) 107 108 (defcustom docker-image-history-columns 109 '((:name "Id" :width 16 :template "{{ json .ID }}" :sort nil :format nil) 110 (:name "Created" :width 24 :template "{{ json .CreatedAt }}" :sort nil :format (lambda (x) (format-time-string "%F %T" (date-to-time x)))) 111 (:name "CreatedBy" :width 60 :template "{{ json .CreatedBy }}" :sort nil :format nil) 112 (:name "Size" :width 10 :template "{{ json .Size }}" :sort docker-utils-human-size-predicate :format nil) 113 (:name "Comment" :width 20 :template "{{ json .Comment }}" :sort nil :format nil)) 114 "Column specification for docker image history. 115 116 The order of entries defines the displayed column order. 117 'Template' is the Go template passed to `docker-image-history' to create the column 118 data. It should return a string delimited with double quotes. 119 'Sort function' is a binary predicate that should return true when the first 120 argument should be sorted before the second. 121 'Format function' is a function from string to string that transforms the 122 displayed values in the column." 123 :group 'docker-image 124 :set 'docker-utils-columns-setter 125 :get 'docker-utils-columns-getter 126 :type '(repeat (list :tag "Column" 127 (string :tag "Name") 128 (integer :tag "Width") 129 (string :tag "Template") 130 (sexp :tag "Sort function") 131 (sexp :tag "Format function")))) 132 133 (defcustom docker-image-run-default-args 134 '("-i" "-t" "--rm") 135 "Default infix args used when docker run is invoked. 136 137 Note this can be overriden for specific images using 138 `docker-image-run-custom-args'." 139 :group 'docker-image 140 :type '(repeat string)) 141 142 (make-obsolete-variable 'docker-run-default-args 'docker-image-run-default-args "Docker 2.1.0") 143 144 (defcustom docker-image-run-custom-args 145 nil 146 "List which can be used to customize the default arguments for docker run. 147 148 Its elements should be of the form (REGEX ARGS) where 149 REGEX is a (string) regular expression and ARGS is a list of strings 150 corresponding to arguments. 151 152 Also note if you do not specify `docker-run-default-args', they will be ignored." 153 :type '(repeat (list string (repeat string)))) 154 155 (defalias 'docker-image-inspect 'docker-inspect) 156 157 (defun docker-image-make-id (parsed-line) 158 "Fix the id string of the entry and return the fixed entry. 159 160 PARSED-LINE is the output of `docker-utils-parse', the car is expected to 161 be the list (repository tag id). See `docker-image-id-template'." 162 ;; This could be written as a complex go template, 163 ;; however the literal '<none>' causes havoc in the windows shell. 164 (-let* ((([repo tag id] rest) parsed-line) 165 (new-id (if (or (equal repo "<none>") (equal tag "<none>")) 166 id 167 (format "%s:%s" repo tag)))) 168 (list new-id rest))) 169 170 (aio-defun docker-image-entries (&rest args) 171 "Return the docker images data for `tabulated-list-entries'." 172 (let* ((fmt (docker-utils-make-format-string docker-image-id-template docker-image-columns)) 173 (data (aio-await (docker-run-docker-async "image" "ls" args (format "--format=\"%s\"" fmt)))) 174 (lines (s-split "\n" data t))) 175 (--map (docker-image-make-id (docker-utils-parse docker-image-columns it)) lines))) 176 177 (aio-defun docker-image-entries-propertized (&rest args) 178 "Return the propertized docker images data for `tabulated-list-entries'." 179 (let ((entries (aio-await (docker-image-entries args))) 180 (dangling (aio-await (docker-image-entries args "--filter dangling=true")))) 181 (--map-when (-contains? dangling it) (docker-image-entry-set-dangling it) entries))) 182 183 (defun docker-image-dangling-p (entry-id) ; 184 "Predicate for if ENTRY-ID is dangling. 185 186 For example (docker-image-dangling-p (tabulated-list-get-id)) is t when the entry under point is dangling." 187 (get-text-property 0 'docker-image-dangling entry-id)) 188 189 (defun docker-image-entry-set-dangling (entry) 190 "Mark ENTRY (output of `docker-image-entries') as dangling. 191 192 The result is the tabulated list id for an entry is propertized with 193 'docker-image-dangling and the entry is fontified with 'docker-face-dangling." 194 (list (propertize (car entry) 'docker-image-dangling t) 195 (apply #'vector (--map (propertize it 'font-lock-face 'docker-face-dangling) (cadr entry))))) 196 197 (aio-defun docker-image-update-status-async () 198 "Write the status to `docker-status-strings'." 199 (plist-put docker-status-strings :images "Images") 200 (when (or (eq docker-show-status t) (and (eq docker-show-status 'local-only) (not (file-remote-p default-directory)))) 201 (let* ((entries (aio-await (docker-image-entries-propertized (docker-image-ls-arguments)))) 202 (dangling (--filter (docker-image-dangling-p (car it)) entries))) 203 (plist-put docker-status-strings 204 :images 205 (format "Images (%s total, %s dangling)" 206 (number-to-string (length entries)) 207 (propertize (number-to-string (length dangling)) 'face 'docker-face-dangling))) 208 (transient--redisplay)))) 209 210 (add-hook 'docker-open-hook #'docker-image-update-status-async) 211 212 (aio-defun docker-image-refresh () 213 "Refresh the images list." 214 (docker-utils-refresh-entries 215 (docker-image-entries-propertized (docker-image-ls-arguments)))) 216 217 (defun docker-image-read-name () 218 "Read an image name." 219 (completing-read "Image: " (-map #'car (aio-wait-for (docker-image-entries))))) 220 221 (defvar-local docker-image-history-image nil 222 "Image name used by the current history buffer.") 223 224 (defvar-local docker-image-history-args nil 225 "Arguments used by the current history buffer.") 226 227 (aio-defun docker-image-history-entries (image &rest args) 228 "Return the docker image history data for `tabulated-list-entries'." 229 (let* ((fmt (docker-utils-make-format-string docker-image-history-id-template docker-image-history-columns)) 230 (data (aio-await (docker-run-docker-async "image" "history" args (format "--format=\"%s\"" fmt) image))) 231 (lines (s-split "\n" data t))) 232 (-map (-partial #'docker-utils-parse docker-image-history-columns) lines))) 233 234 (aio-defun docker-image-history-refresh () 235 "Refresh the image history list." 236 (docker-utils-refresh-entries 237 (apply #'docker-image-history-entries docker-image-history-image docker-image-history-args))) 238 239 (defun docker-image-history-show (image &optional args) 240 "Display history for IMAGE." 241 (let ((buffer (docker-utils-generate-new-buffer "docker-image-history" image))) 242 (with-current-buffer buffer 243 (docker-image-history-mode) 244 (setq docker-image-history-image image) 245 (setq docker-image-history-args args) 246 (tablist-revert)) 247 (pop-to-buffer buffer))) 248 249 (defun docker-image-history-selection () 250 "Show image history for the selection." 251 (interactive) 252 (docker-utils-ensure-items) 253 (let ((args (transient-args 'docker-image-history))) 254 (--each (docker-utils-get-marked-items-ids) 255 (docker-image-history-show it args)))) 256 257 ;;;###autoload (autoload 'docker-image-pull-one "docker-image" nil t) 258 (aio-defun docker-image-pull-one (name &optional all) 259 "Pull the image named NAME. If ALL is set, use \"-a\"." 260 (interactive (list (docker-image-read-name) current-prefix-arg)) 261 (aio-await (docker-run-docker-async "pull" (when all "-a") name)) 262 (tablist-revert)) 263 264 (defun docker-image-run-selection (command) 265 "Run \"docker image run\" with COMMAND on the images selection." 266 (interactive "sCommand: ") 267 (docker-utils-ensure-items) 268 (--each (docker-utils-get-marked-items-ids) 269 (docker-run-docker-async-with-buffer-interactive "container" "run" (transient-args 'docker-image-run) it command))) 270 271 (aio-defun docker-image-tag-selection () 272 "Tag images." 273 (interactive) 274 (docker-utils-ensure-items) 275 (let* ((ids (docker-utils-get-marked-items-ids)) 276 (promises (--map (docker-run-docker-async "tag" it (read-string (format "Tag for %s: " it))) ids))) 277 (aio-await (aio-all promises)) 278 (tablist-revert))) 279 280 (defun docker-image-mark-dangling () 281 "Mark only the dangling images listed in *docker-images*. 282 283 This clears any user marks first and respects any tablist filters 284 applied to the buffer." 285 (interactive) 286 (switch-to-buffer "*docker-images*") 287 (tablist-unmark-all-marks) 288 (save-excursion 289 (goto-char (point-min)) 290 (while (not (eobp)) 291 (when (docker-image-dangling-p (tabulated-list-get-id)) 292 (tablist-put-mark)) 293 (forward-line)))) 294 295 (docker-utils-define-transient-arguments docker-image-ls) 296 297 (transient-define-prefix docker-image-ls () 298 "Transient for listing images." 299 :man-page "docker-image-ls" 300 ["Arguments" 301 ("a" "All" "--all") 302 ("d" "Dangling" "--filter dangling=true") 303 ("f" "Filter" "--filter " read-string) 304 ("n" "Don't truncate" "--no-trunc")] 305 ["Actions" 306 ("l" "List" tablist-revert)]) 307 308 (docker-utils-define-transient-arguments docker-image-history) 309 310 (docker-utils-transient-define-prefix docker-image-history () 311 "Transient for showing image history." 312 :man-page "docker-history" 313 ["Arguments" 314 ("n" "Don't truncate" "--no-trunc") 315 ("r" "Raw sizes" "--human=false")] 316 [:description docker-generic-action-description 317 ("H" "History" docker-image-history-selection)]) 318 319 (transient-define-prefix docker-image-pull () 320 "Transient for pulling images." 321 :man-page "docker-image-pull" 322 ["Arguments" 323 ("a" "All" "-a")] 324 [:description docker-generic-action-description 325 ("F" "Pull selection" docker-generic-action) 326 ("N" "Pull a new image" docker-image-pull-one)]) 327 328 (docker-utils-transient-define-prefix docker-image-push () 329 "Transient for pushing images." 330 :man-page "docker-image-push" 331 [:description docker-generic-action-description 332 ("P" "Push" docker-generic-action)]) 333 334 (docker-utils-transient-define-prefix docker-image-rm () 335 "Transient for removing images." 336 :man-page "docker-image-rm" 337 ["Arguments" 338 ("-f" "Force" "-f") 339 ("-n" "Don't prune" "--no-prune")] 340 [:description docker-generic-action-description 341 ("D" "Remove" docker-generic-action-multiple-ids)]) 342 343 (defclass docker-run-prefix (transient-prefix) nil) 344 345 (cl-defmethod transient-init-value ((obj docker-run-prefix)) 346 "Helper that modify OBJ DOCKER-RUN-PREFIX to handle `docker-image-run-custom-args'." 347 (oset obj value 348 (let* ((images (tablist-get-marked-items)) 349 (matched-args (let ((repo-name (caar images))) 350 (if repo-name 351 (--first (string-match (car it) repo-name) 352 docker-image-run-custom-args) 353 nil)))) 354 (if matched-args 355 (cadr matched-args) 356 docker-image-run-default-args)))) 357 358 (docker-utils-transient-define-prefix docker-image-run () 359 "Transient for running images." 360 :man-page "docker-image-run" 361 :class 'docker-run-prefix 362 ["Arguments" 363 ("D" "With display" "-v /tmp/.X11-unix:/tmp/.X11-unix -e DISPLAY") 364 ("M" "Mount volume" "--mount " read-string) 365 ("N" "Network" "--network " read-string) 366 ("P" "Privileged" "--privileged") 367 ("T" "Synchronize time" "-v /etc/localtime:/etc/localtime:ro") 368 ("W" "Web ports" "-p 80:80 -p 443:443 -p 8080:8080") 369 ("d" "Detach" "-d") 370 ("e" "Environment" "-e " read-string) 371 ("i" "Interactive" "-i") 372 ("l" "Link" "--link " read-string) 373 ("m" "Name" "--name " read-string) 374 ("n" "Entrypoint" "--entrypoint " read-string) 375 ("o" "Read only" "--read-only") 376 ("p" "Port" "-p " read-string) 377 ("r" "Remove container when it exits" "--rm") 378 ("t" "TTY" "-t") 379 ("u" "User" "-u " read-string) 380 ("v" "Volume" "-v " read-string) 381 ("w" "Workdir" "-w " read-string)] 382 [:description docker-generic-action-description 383 ("R" "Run" docker-image-run-selection)]) 384 385 (transient-define-prefix docker-image-help () 386 "Help transient for docker images." 387 ["Docker images help" 388 ("D" "Remove" docker-image-rm) 389 ("F" "Pull" docker-image-pull) 390 ("H" "History" docker-image-history) 391 ("I" "Inspect" docker-image-inspect) 392 ("P" "Push" docker-image-push) 393 ("R" "Run" docker-image-run) 394 ("T" "Tag" docker-image-tag-selection) 395 ("d" "Mark Dangling" docker-image-mark-dangling) 396 ("l" "List" docker-image-ls)]) 397 398 (defvar docker-image-mode-map 399 (let ((map (make-sparse-keymap))) 400 (define-key map "?" 'docker-image-help) 401 (define-key map "D" 'docker-image-rm) 402 (define-key map "F" 'docker-image-pull) 403 (define-key map "H" 'docker-image-history) 404 (define-key map "I" 'docker-image-inspect) 405 (define-key map "P" 'docker-image-push) 406 (define-key map "R" 'docker-image-run) 407 (define-key map "T" 'docker-image-tag-selection) 408 (define-key map "d" 'docker-image-mark-dangling) 409 (define-key map "l" 'docker-image-ls) 410 map) 411 "Keymap for `docker-image-mode'.") 412 413 ;;;###autoload (autoload 'docker-images "docker-image" nil t) 414 (defun docker-images () 415 "List docker images." 416 (interactive) 417 (docker-utils-pop-to-buffer "*docker-images*") 418 (docker-image-mode) 419 (tablist-revert)) 420 421 (define-derived-mode docker-image-mode tabulated-list-mode "Images Menu" 422 "Major mode for handling a list of docker images." 423 (setq tabulated-list-format (docker-utils-columns-list-format docker-image-columns)) 424 (setq tabulated-list-padding 2) 425 (setq tabulated-list-sort-key docker-image-default-sort-key) 426 (add-hook 'tabulated-list-revert-hook 'docker-image-refresh nil t) 427 (tabulated-list-init-header) 428 (tablist-minor-mode)) 429 430 (define-derived-mode docker-image-history-mode tabulated-list-mode "Image History" 431 "Major mode for handling docker image history." 432 (setq tabulated-list-format (docker-utils-columns-list-format docker-image-history-columns)) 433 (setq tabulated-list-padding 2) 434 (setq tabulated-list-sort-key docker-image-history-default-sort-key) 435 (add-hook 'tabulated-list-revert-hook 'docker-image-history-refresh nil t) 436 (tabulated-list-init-header) 437 (tablist-minor-mode)) 438 439 (provide 'docker-image) 440 441 ;;; docker-image.el ends here