magit-process.el (52062B)
1 ;;; magit-process.el --- process functionality -*- lexical-binding: t -*- 2 3 ;; Copyright (C) 2010-2021 The Magit Project Contributors 4 ;; 5 ;; You should have received a copy of the AUTHORS.md file which 6 ;; lists all contributors. If not, see http://magit.vc/authors. 7 8 ;; Author: Jonas Bernoulli <jonas@bernoul.li> 9 ;; Maintainer: Jonas Bernoulli <jonas@bernoul.li> 10 11 ;; SPDX-License-Identifier: GPL-3.0-or-later 12 13 ;; Magit is free software; you can redistribute it and/or modify it 14 ;; under the terms of the GNU General Public License as published by 15 ;; the Free Software Foundation; either version 3, or (at your option) 16 ;; any later version. 17 ;; 18 ;; Magit is distributed in the hope that it will be useful, but WITHOUT 19 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY 20 ;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public 21 ;; License for more details. 22 ;; 23 ;; You should have received a copy of the GNU General Public License 24 ;; along with Magit. If not, see http://www.gnu.org/licenses. 25 26 ;;; Commentary: 27 28 ;; This library implements the tools used to run Git for side-effects. 29 30 ;; Note that the functions used to run Git and then consume its 31 ;; output, are defined in `magit-git.el'. There's a bit of overlap 32 ;; though. 33 34 ;;; Code: 35 36 (require 'magit-utils) 37 (require 'magit-section) 38 (require 'magit-git) 39 (require 'magit-mode) 40 41 (require 'ansi-color) 42 (require 'with-editor) 43 44 (declare-function auth-source-search "auth-source" 45 (&rest spec &key max require create delete &allow-other-keys)) 46 47 ;;; Options 48 49 (defcustom magit-process-connection-type (not (eq system-type 'cygwin)) 50 "Connection type used for the Git process. 51 52 If nil, use pipes: this is usually more efficient, and works on Cygwin. 53 If t, use ptys: this enables Magit to prompt for passphrases when needed." 54 :group 'magit-process 55 :type '(choice (const :tag "pipe" nil) 56 (const :tag "pty" t))) 57 58 (defcustom magit-need-cygwin-noglob 59 (and (eq system-type 'windows-nt) 60 (with-temp-buffer 61 (let ((process-environment 62 (append magit-git-environment process-environment))) 63 (condition-case e 64 (process-file magit-git-executable 65 nil (current-buffer) nil 66 "-c" "alias.echo=!echo" "echo" "x{0}") 67 (file-error 68 (lwarn 'magit-process :warning 69 "Could not run Git: %S" e)))) 70 (equal "x0\n" (buffer-string)))) 71 "Whether to use a workaround for Cygwin's globbing behavior. 72 73 If non-nil, add environment variables to `process-environment' to 74 prevent the git.exe distributed by Cygwin and MSYS2 from 75 attempting to perform glob expansion when called from a native 76 Windows build of Emacs. See #2246." 77 :package-version '(magit . "2.3.0") 78 :group 'magit-process 79 :type '(choice (const :tag "Yes" t) 80 (const :tag "No" nil))) 81 82 (defcustom magit-process-popup-time -1 83 "Popup the process buffer if a command takes longer than this many seconds." 84 :group 'magit-process 85 :type '(choice (const :tag "Never" -1) 86 (const :tag "Immediately" 0) 87 (integer :tag "After this many seconds"))) 88 89 (defcustom magit-process-log-max 32 90 "Maximum number of sections to keep in a process log buffer. 91 When adding a new section would go beyond the limit set here, 92 then the older half of the sections are remove. Sections that 93 belong to processes that are still running are never removed. 94 When this is nil, no sections are ever removed." 95 :package-version '(magit . "2.1.0") 96 :group 'magit-process 97 :type '(choice (const :tag "Never remove old sections" nil) integer)) 98 99 (defvar magit-process-extreme-logging nil 100 "Whether `magit-process-file' logs to the *Messages* buffer. 101 102 Only intended for temporary use when you try to figure out how 103 Magit uses Git behind the scene. Output that normally goes to 104 the magit-process buffer continues to go there. Not all output 105 goes to either of these two buffers. 106 107 Also see `magit-git-debug'.") 108 109 (defcustom magit-process-error-tooltip-max-lines 20 110 "The number of lines for `magit-process-error-lines' to return. 111 112 These are displayed in a tooltip for `mode-line-process' errors. 113 114 If `magit-process-error-tooltip-max-lines' is nil, the tooltip 115 displays the text of `magit-process-error-summary' instead." 116 :package-version '(magit . "2.12.0") 117 :group 'magit-process 118 :type '(choice (const :tag "Use summary line" nil) 119 integer)) 120 121 (defcustom magit-credential-cache-daemon-socket 122 (--some (pcase-let ((`(,prog . ,args) (split-string it))) 123 (if (and prog 124 (string-match-p 125 "\\`\\(?:\\(?:/.*/\\)?git-credential-\\)?cache\\'" prog)) 126 (or (cl-loop for (opt val) on args 127 if (string= opt "--socket") 128 return val) 129 (expand-file-name "~/.git-credential-cache/socket")))) 130 ;; Note: `magit-process-file' is not yet defined when 131 ;; evaluating this form, so we use `process-lines'. 132 (ignore-errors 133 (let ((process-environment 134 (append magit-git-environment process-environment))) 135 (process-lines magit-git-executable 136 "config" "--get-all" "credential.helper")))) 137 "If non-nil, start a credential cache daemon using this socket. 138 139 When using Git's cache credential helper in the normal way, Emacs 140 sends a SIGHUP to the credential daemon after the git subprocess 141 has exited, causing the daemon to also quit. This can be avoided 142 by starting the `git-credential-cache--daemon' process directly 143 from Emacs. 144 145 The function `magit-maybe-start-credential-cache-daemon' takes 146 care of starting the daemon if necessary, using the value of this 147 option as the socket. If this option is nil, then it does not 148 start any daemon. Likewise if another daemon is already running, 149 then it starts no new daemon. This function has to be a member 150 of the hook variable `magit-credential-hook' for this to work. 151 If an error occurs while starting the daemon, most likely because 152 the necessary executable is missing, then the function removes 153 itself from the hook, to avoid further futile attempts." 154 :package-version '(magit . "2.3.0") 155 :group 'magit-process 156 :type '(choice (file :tag "Socket") 157 (const :tag "Don't start a cache daemon" nil))) 158 159 (defcustom magit-process-yes-or-no-prompt-regexp 160 (concat " [\[(]" 161 "\\([Yy]\\(?:es\\)?\\)" 162 "[/|]" 163 "\\([Nn]o?\\)" 164 ;; OpenSSH v8 prints this. See #3969. 165 "\\(?:/\\[fingerprint\\]\\)?" 166 "[\])] ?[?:]? ?$") 167 "Regexp matching Yes-or-No prompts of Git and its subprocesses." 168 :package-version '(magit . "2.1.0") 169 :group 'magit-process 170 :type 'regexp) 171 172 (defcustom magit-process-password-prompt-regexps 173 '("^\\(Enter \\)?[Pp]assphrase\\( for \\(RSA \\)?key '.*'\\)?: ?$" 174 ;; Match-group 99 is used to identify the "user@host" part. 175 "^\\(Enter \\)?[Pp]assword\\( for '?\\(https?://\\)?\\(?99:[^']*\\)'?\\)?: ?$" 176 "Please enter the passphrase for the ssh key" 177 "Please enter the passphrase to unlock the OpenPGP secret key" 178 "^.*'s password: ?$" 179 "^Token: $" ; For git-credential-manager-core (#4318). 180 "^Yubikey for .*: ?$" 181 "^Enter PIN for .*: ?$") 182 "List of regexps matching password prompts of Git and its subprocesses. 183 Also see `magit-process-find-password-functions'." 184 :package-version '(magit . "3.0.0") 185 :group 'magit-process 186 :type '(repeat (regexp))) 187 188 (defcustom magit-process-find-password-functions nil 189 "List of functions to try in sequence to get a password. 190 191 These functions may be called when git asks for a password, which 192 is detected using `magit-process-password-prompt-regexps'. They 193 are called if and only if matching the prompt resulted in the 194 value of the 99th submatch to be non-nil. Therefore users can 195 control for which prompts these functions should be called by 196 putting the host name in the 99th submatch, or not. 197 198 If the functions are called, then they are called in the order 199 given, with the host name as only argument, until one of them 200 returns non-nil. If they are not called or none of them returns 201 non-nil, then the password is read from the user instead." 202 :package-version '(magit . "2.3.0") 203 :group 'magit-process 204 :type 'hook 205 :options '(magit-process-password-auth-source)) 206 207 (defcustom magit-process-username-prompt-regexps 208 '("^Username for '.*': ?$") 209 "List of regexps matching username prompts of Git and its subprocesses." 210 :package-version '(magit . "2.1.0") 211 :group 'magit-process 212 :type '(repeat (regexp))) 213 214 (defcustom magit-process-prompt-functions nil 215 "List of functions used to forward arbitrary questions to the user. 216 217 Magit has dedicated support for forwarding username and password 218 prompts and Yes-or-No questions asked by Git and its subprocesses 219 to the user. This can be customized using other options in the 220 `magit-process' customization group. 221 222 If you encounter a new question that isn't handled by default, 223 then those options should be used instead of this hook. 224 225 However subprocesses may also ask questions that differ too much 226 from what the code related to the above options assume, and this 227 hook allows users to deal with such questions explicitly. 228 229 Each function is called with the process and the output string 230 as arguments until one of the functions returns non-nil. The 231 function is responsible for asking the user the appropriate 232 question using e.g. `read-char-choice' and then forwarding the 233 answer to the process using `process-send-string'. 234 235 While functions such as `magit-process-yes-or-no-prompt' may not 236 be sufficient to handle some prompt, it may still be of benefit 237 to look at the implementations to gain some insights on how to 238 implement such functions." 239 :package-version '(magit . "3.0.0") 240 :group 'magit-process 241 :type 'hook) 242 243 (defcustom magit-process-ensure-unix-line-ending t 244 "Whether Magit should ensure a unix coding system when talking to Git." 245 :package-version '(magit . "2.6.0") 246 :group 'magit-process 247 :type 'boolean) 248 249 (defcustom magit-process-display-mode-line-error t 250 "Whether Magit should retain and highlight process errors in the mode line." 251 :package-version '(magit . "2.12.0") 252 :group 'magit-process 253 :type 'boolean) 254 255 (defface magit-process-ok 256 '((t :inherit magit-section-heading :foreground "green")) 257 "Face for zero exit-status." 258 :group 'magit-faces) 259 260 (defface magit-process-ng 261 '((t :inherit magit-section-heading :foreground "red")) 262 "Face for non-zero exit-status." 263 :group 'magit-faces) 264 265 (defface magit-mode-line-process 266 '((t :inherit mode-line-emphasis)) 267 "Face for `mode-line-process' status when Git is running for side-effects." 268 :group 'magit-faces) 269 270 (defface magit-mode-line-process-error 271 '((t :inherit error)) 272 "Face for `mode-line-process' error status. 273 274 Used when `magit-process-display-mode-line-error' is non-nil." 275 :group 'magit-faces) 276 277 ;;; Process Mode 278 279 (defvar magit-process-mode-map 280 (let ((map (make-sparse-keymap))) 281 (set-keymap-parent map magit-mode-map) 282 map) 283 "Keymap for `magit-process-mode'.") 284 285 (define-derived-mode magit-process-mode magit-mode "Magit Process" 286 "Mode for looking at Git process output." 287 :group 'magit-process 288 (hack-dir-local-variables-non-file-buffer) 289 (setq imenu-prev-index-position-function 290 'magit-imenu--process-prev-index-position-function) 291 (setq imenu-extract-index-name-function 292 'magit-imenu--process-extract-index-name-function)) 293 294 (defun magit-process-buffer (&optional nodisplay) 295 "Display the current repository's process buffer. 296 297 If that buffer doesn't exist yet, then create it. 298 Non-interactively return the buffer and unless 299 optional NODISPLAY is non-nil also display it." 300 (interactive) 301 (let ((topdir (magit-toplevel))) 302 (unless topdir 303 (magit--with-safe-default-directory nil 304 (setq topdir default-directory) 305 (let (prev) 306 (while (not (equal topdir prev)) 307 (setq prev topdir) 308 (setq topdir (file-name-directory (directory-file-name topdir))))))) 309 (let ((buffer (or (--first (with-current-buffer it 310 (and (eq major-mode 'magit-process-mode) 311 (equal default-directory topdir))) 312 (buffer-list)) 313 (let ((default-directory topdir)) 314 (magit-generate-new-buffer 'magit-process-mode))))) 315 (with-current-buffer buffer 316 (if magit-root-section 317 (when magit-process-log-max 318 (magit-process-truncate-log)) 319 (magit-process-mode) 320 (let ((inhibit-read-only t) 321 (magit-insert-section--parent nil) 322 (magit-insert-section--oldroot nil)) 323 (make-local-variable 'text-property-default-nonsticky) 324 (magit-insert-section (processbuf) 325 (insert "\n"))))) 326 (unless nodisplay 327 (magit-display-buffer buffer)) 328 buffer))) 329 330 (defun magit-process-kill () 331 "Kill the process at point." 332 (interactive) 333 (when-let ((process (magit-section-value-if 'process))) 334 (unless (eq (process-status process) 'run) 335 (user-error "Process isn't running")) 336 (magit-confirm 'kill-process) 337 (kill-process process))) 338 339 ;;; Synchronous Processes 340 341 (defvar magit-process-raise-error nil) 342 343 (defun magit-git (&rest args) 344 "Call Git synchronously in a separate process, for side-effects. 345 346 Option `magit-git-executable' specifies the Git executable. 347 The arguments ARGS specify arguments to Git, they are flattened 348 before use. 349 350 Process output goes into a new section in the buffer returned by 351 `magit-process-buffer'. If Git exits with a non-zero status, 352 then raise an error." 353 (let ((magit-process-raise-error t)) 354 (magit-call-git args))) 355 356 (defun magit-run-git (&rest args) 357 "Call Git synchronously in a separate process, and refresh. 358 359 Function `magit-git-executable' specifies the Git executable and 360 option `magit-git-global-arguments' specifies constant arguments. 361 The arguments ARGS specify arguments to Git, they are flattened 362 before use. 363 364 After Git returns, the current buffer (if it is a Magit buffer) 365 as well as the current repository's status buffer are refreshed. 366 367 Process output goes into a new section in the buffer returned by 368 `magit-process-buffer'." 369 (let ((magit--refresh-cache (list (cons 0 0)))) 370 (magit-call-git args) 371 (when (member (car args) '("init" "clone")) 372 ;; Creating a new repository invalidates the cache. 373 (setq magit--refresh-cache nil)) 374 (magit-refresh))) 375 376 (defvar magit-pre-call-git-hook nil) 377 378 (defun magit-call-git (&rest args) 379 "Call Git synchronously in a separate process. 380 381 Function `magit-git-executable' specifies the Git executable and 382 option `magit-git-global-arguments' specifies constant arguments. 383 The arguments ARGS specify arguments to Git, they are flattened 384 before use. 385 386 Process output goes into a new section in the buffer returned by 387 `magit-process-buffer'." 388 (run-hooks 'magit-pre-call-git-hook) 389 (let ((default-process-coding-system (magit--process-coding-system))) 390 (apply #'magit-call-process 391 (magit-git-executable) 392 (magit-process-git-arguments args)))) 393 394 (defun magit-call-process (program &rest args) 395 "Call PROGRAM synchronously in a separate process. 396 Process output goes into a new section in the buffer returned by 397 `magit-process-buffer'." 398 (pcase-let ((`(,process-buf . ,section) 399 (magit-process-setup program args))) 400 (magit-process-finish 401 (let ((inhibit-read-only t)) 402 (apply #'magit-process-file program nil process-buf nil args)) 403 process-buf (current-buffer) default-directory section))) 404 405 (defun magit-process-git (destination &rest args) 406 "Call Git synchronously in a separate process, returning its exit code. 407 DESTINATION specifies how to handle the output, like for 408 `call-process', except that file handlers are supported. 409 Enable Cygwin's \"noglob\" option during the call and 410 ensure unix eol conversion." 411 (apply #'magit-process-file 412 (magit-git-executable) 413 nil destination nil 414 (magit-process-git-arguments args))) 415 416 (defun magit-process-file (process &optional infile buffer display &rest args) 417 "Process files synchronously in a separate process. 418 Identical to `process-file' but temporarily enable Cygwin's 419 \"noglob\" option during the call and ensure unix eol 420 conversion." 421 (when magit-process-extreme-logging 422 (let ((inhibit-message t)) 423 (message "$ %s" (magit-process--format-arguments process args)))) 424 (let ((process-environment (magit-process-environment)) 425 (default-process-coding-system (magit--process-coding-system))) 426 (apply #'process-file process infile buffer display args))) 427 428 (defun magit-process-environment () 429 ;; The various w32 hacks are only applicable when running on the 430 ;; local machine. As of Emacs 25.1, a local binding of 431 ;; process-environment different from the top-level value affects 432 ;; the environment used in 433 ;; tramp-sh-handle-{start-file-process,process-file}. 434 (let ((local (not (file-remote-p default-directory)))) 435 (append magit-git-environment 436 (and local 437 (cdr (assoc magit-git-executable magit-git-w32-path-hack))) 438 (and local magit-need-cygwin-noglob 439 (mapcar (lambda (var) 440 (concat var "=" (--if-let (getenv var) 441 (concat it " noglob") 442 "noglob"))) 443 '("CYGWIN" "MSYS"))) 444 process-environment))) 445 446 (defvar magit-this-process nil) 447 448 (defun magit-run-git-with-input (&rest args) 449 "Call Git in a separate process. 450 ARGS is flattened and then used as arguments to Git. 451 452 The current buffer's content is used as the process's standard 453 input. The buffer is assumed to be temporary and thus OK to 454 modify. 455 456 Function `magit-git-executable' specifies the Git executable and 457 option `magit-git-global-arguments' specifies constant arguments. 458 The remaining arguments ARGS specify arguments to Git, they are 459 flattened before use." 460 (when (eq system-type 'windows-nt) 461 ;; On w32, git expects UTF-8 encoded input, ignore any user 462 ;; configuration telling us otherwise (see #3250). 463 (encode-coding-region (point-min) (point-max) 'utf-8-unix)) 464 (if (file-remote-p default-directory) 465 ;; We lack `process-file-region', so fall back to asynch + 466 ;; waiting in remote case. 467 (progn 468 (magit-start-git (current-buffer) args) 469 (while (and magit-this-process 470 (eq (process-status magit-this-process) 'run)) 471 (sleep-for 0.005))) 472 (run-hooks 'magit-pre-call-git-hook) 473 (pcase-let* ((process-environment (magit-process-environment)) 474 (default-process-coding-system (magit--process-coding-system)) 475 (flat-args (magit-process-git-arguments args)) 476 (`(,process-buf . ,section) 477 (magit-process-setup (magit-git-executable) flat-args)) 478 (inhibit-read-only t)) 479 (magit-process-finish 480 (apply #'call-process-region (point-min) (point-max) 481 (magit-git-executable) nil process-buf nil flat-args) 482 process-buf nil default-directory section)))) 483 484 ;;; Asynchronous Processes 485 486 (defun magit-run-git-async (&rest args) 487 "Start Git, prepare for refresh, and return the process object. 488 ARGS is flattened and then used as arguments to Git. 489 490 Display the command line arguments in the echo area. 491 492 After Git returns some buffers are refreshed: the buffer that was 493 current when this function was called (if it is a Magit buffer 494 and still alive), as well as the respective Magit status buffer. 495 496 See `magit-start-process' for more information." 497 (message "Running %s %s" (magit-git-executable) 498 (let ((m (mapconcat #'identity (-flatten args) " "))) 499 (remove-list-of-text-properties 0 (length m) '(face) m) 500 m)) 501 (magit-start-git nil args)) 502 503 (defun magit-run-git-with-editor (&rest args) 504 "Export GIT_EDITOR and start Git. 505 Also prepare for refresh and return the process object. 506 ARGS is flattened and then used as arguments to Git. 507 508 Display the command line arguments in the echo area. 509 510 After Git returns some buffers are refreshed: the buffer that was 511 current when this function was called (if it is a Magit buffer 512 and still alive), as well as the respective Magit status buffer. 513 514 See `magit-start-process' and `with-editor' for more information." 515 (magit--record-separated-gitdir) 516 (magit-with-editor (magit-run-git-async args))) 517 518 (defun magit-run-git-sequencer (&rest args) 519 "Export GIT_EDITOR and start Git. 520 Also prepare for refresh and return the process object. 521 ARGS is flattened and then used as arguments to Git. 522 523 Display the command line arguments in the echo area. 524 525 After Git returns some buffers are refreshed: the buffer that was 526 current when this function was called (if it is a Magit buffer 527 and still alive), as well as the respective Magit status buffer. 528 If the sequence stops at a commit, make the section representing 529 that commit the current section by moving `point' there. 530 531 See `magit-start-process' and `with-editor' for more information." 532 (apply #'magit-run-git-with-editor args) 533 (set-process-sentinel magit-this-process #'magit-sequencer-process-sentinel) 534 magit-this-process) 535 536 (defvar magit-pre-start-git-hook nil) 537 538 (defun magit-start-git (input &rest args) 539 "Start Git, prepare for refresh, and return the process object. 540 541 If INPUT is non-nil, it has to be a buffer or the name of an 542 existing buffer. The buffer content becomes the processes 543 standard input. 544 545 Function `magit-git-executable' specifies the Git executable and 546 option `magit-git-global-arguments' specifies constant arguments. 547 The remaining arguments ARGS specify arguments to Git, they are 548 flattened before use. 549 550 After Git returns some buffers are refreshed: the buffer that was 551 current when this function was called (if it is a Magit buffer 552 and still alive), as well as the respective Magit status buffer. 553 554 See `magit-start-process' for more information." 555 (run-hooks 'magit-pre-start-git-hook) 556 (let ((default-process-coding-system (magit--process-coding-system))) 557 (apply #'magit-start-process (magit-git-executable) input 558 (magit-process-git-arguments args)))) 559 560 (defun magit-start-process (program &optional input &rest args) 561 "Start PROGRAM, prepare for refresh, and return the process object. 562 563 If optional argument INPUT is non-nil, it has to be a buffer or 564 the name of an existing buffer. The buffer content becomes the 565 processes standard input. 566 567 The process is started using `start-file-process' and then setup 568 to use the sentinel `magit-process-sentinel' and the filter 569 `magit-process-filter'. Information required by these functions 570 is stored in the process object. When this function returns the 571 process has not started to run yet so it is possible to override 572 the sentinel and filter. 573 574 After the process returns, `magit-process-sentinel' refreshes the 575 buffer that was current when `magit-start-process' was called (if 576 it is a Magit buffer and still alive), as well as the respective 577 Magit status buffer." 578 (pcase-let* 579 ((`(,process-buf . ,section) 580 (magit-process-setup program args)) 581 (process 582 (let ((process-connection-type 583 ;; Don't use a pty, because it would set icrnl 584 ;; which would modify the input (issue #20). 585 (and (not input) magit-process-connection-type)) 586 (process-environment (magit-process-environment)) 587 (default-process-coding-system (magit--process-coding-system))) 588 (apply #'start-file-process 589 (file-name-nondirectory program) 590 process-buf program args)))) 591 (with-editor-set-process-filter process #'magit-process-filter) 592 (set-process-sentinel process #'magit-process-sentinel) 593 (set-process-buffer process process-buf) 594 (when (eq system-type 'windows-nt) 595 ;; On w32, git expects UTF-8 encoded input, ignore any user 596 ;; configuration telling us otherwise. 597 (set-process-coding-system process nil 'utf-8-unix)) 598 (process-put process 'section section) 599 (process-put process 'command-buf (current-buffer)) 600 (process-put process 'default-dir default-directory) 601 (when magit-inhibit-refresh 602 (process-put process 'inhibit-refresh t)) 603 (oset section process process) 604 (with-current-buffer process-buf 605 (set-marker (process-mark process) (point))) 606 (when input 607 (with-current-buffer input 608 (process-send-region process (point-min) (point-max)) 609 (process-send-eof process))) 610 (setq magit-this-process process) 611 (oset section value process) 612 (magit-process-display-buffer process) 613 process)) 614 615 (defun magit-parse-git-async (&rest args) 616 (setq args (magit-process-git-arguments args)) 617 (let ((command-buf (current-buffer)) 618 (process-buf (generate-new-buffer " *temp*")) 619 (toplevel (magit-toplevel))) 620 (with-current-buffer process-buf 621 (setq default-directory toplevel) 622 (let ((process 623 (let ((process-connection-type nil) 624 (process-environment (magit-process-environment)) 625 (default-process-coding-system 626 (magit--process-coding-system))) 627 (apply #'start-file-process "git" process-buf 628 (magit-git-executable) args)))) 629 (process-put process 'command-buf command-buf) 630 (process-put process 'parsed (point)) 631 (setq magit-this-process process) 632 process)))) 633 634 ;;; Process Internals 635 636 (defun magit-process-setup (program args) 637 (magit-process-set-mode-line program args) 638 (let ((pwd default-directory) 639 (buf (magit-process-buffer t))) 640 (cons buf (with-current-buffer buf 641 (prog1 (magit-process-insert-section pwd program args nil nil) 642 (backward-char 1)))))) 643 644 (defun magit-process-insert-section (pwd program args &optional errcode errlog) 645 (let ((inhibit-read-only t) 646 (magit-insert-section--parent magit-root-section) 647 (magit-insert-section--oldroot nil)) 648 (goto-char (1- (point-max))) 649 (magit-insert-section (process) 650 (insert (if errcode 651 (format "%3s " (propertize (number-to-string errcode) 652 'font-lock-face 'magit-process-ng)) 653 "run ")) 654 (unless (equal (expand-file-name pwd) 655 (expand-file-name default-directory)) 656 (insert (file-relative-name pwd default-directory) ?\s)) 657 (insert (magit-process--format-arguments program args)) 658 (magit-insert-heading) 659 (when errlog 660 (if (bufferp errlog) 661 (insert (with-current-buffer errlog 662 (buffer-substring-no-properties (point-min) (point-max)))) 663 (insert-file-contents errlog) 664 (goto-char (1- (point-max))))) 665 (insert "\n")))) 666 667 (defun magit-process--format-arguments (program args) 668 (cond 669 ((and args (equal program (magit-git-executable))) 670 (setq args (-split-at (length magit-git-global-arguments) args)) 671 (concat (propertize (file-name-nondirectory program) 672 'font-lock-face 'magit-section-heading) 673 " " 674 (propertize (if (stringp magit-ellipsis) 675 magit-ellipsis 676 ;; For backward compatibility. 677 (char-to-string magit-ellipsis)) 678 'font-lock-face 'magit-section-heading 679 'help-echo (mapconcat #'identity (car args) " ")) 680 " " 681 (propertize (mapconcat #'shell-quote-argument (cadr args) " ") 682 'font-lock-face 'magit-section-heading))) 683 ((and args (equal program shell-file-name)) 684 (propertize (cadr args) 685 'font-lock-face 'magit-section-heading)) 686 (t 687 (concat (propertize (file-name-nondirectory program) 688 'font-lock-face 'magit-section-heading) 689 " " 690 (propertize (mapconcat #'shell-quote-argument args " ") 691 'font-lock-face 'magit-section-heading))))) 692 693 (defun magit-process-truncate-log () 694 (let* ((head nil) 695 (tail (oref magit-root-section children)) 696 (count (length tail))) 697 (when (> (1+ count) magit-process-log-max) 698 (while (and (cdr tail) 699 (> count (/ magit-process-log-max 2))) 700 (let* ((inhibit-read-only t) 701 (section (car tail)) 702 (process (oref section process))) 703 (cond ((not process)) 704 ((memq (process-status process) '(exit signal)) 705 (delete-region (oref section start) 706 (1+ (oref section end))) 707 (cl-decf count)) 708 (t 709 (push section head)))) 710 (pop tail)) 711 (oset magit-root-section children 712 (nconc (reverse head) tail))))) 713 714 (defun magit-process-sentinel (process event) 715 "Default sentinel used by `magit-start-process'." 716 (when (memq (process-status process) '(exit signal)) 717 (setq event (substring event 0 -1)) 718 (when (string-match "^finished" event) 719 (message (concat (capitalize (process-name process)) " finished"))) 720 (magit-process-finish process) 721 (when (eq process magit-this-process) 722 (setq magit-this-process nil)) 723 (unless (process-get process 'inhibit-refresh) 724 (let ((command-buf (process-get process 'command-buf))) 725 (if (buffer-live-p command-buf) 726 (with-current-buffer command-buf 727 (magit-refresh)) 728 (with-temp-buffer 729 (setq default-directory (process-get process 'default-dir)) 730 (magit-refresh))))))) 731 732 (defun magit-sequencer-process-sentinel (process event) 733 "Special sentinel used by `magit-run-git-sequencer'." 734 (when (memq (process-status process) '(exit signal)) 735 (magit-process-sentinel process event) 736 (when-let ((process-buf (process-buffer process))) 737 (when (buffer-live-p process-buf) 738 (when-let ((status-buf (with-current-buffer process-buf 739 (magit-get-mode-buffer 'magit-status-mode)))) 740 (with-current-buffer status-buf 741 (--when-let 742 (magit-get-section 743 `((commit . ,(magit-rev-parse "HEAD")) 744 (,(pcase (car (cadr (-split-at 745 (1+ (length magit-git-global-arguments)) 746 (process-command process)))) 747 ((or "rebase" "am") 'rebase-sequence) 748 ((or "cherry-pick" "revert") 'sequence))) 749 (status))) 750 (goto-char (oref it start)) 751 (magit-section-update-highlight)))))))) 752 753 (defun magit-process-filter (proc string) 754 "Default filter used by `magit-start-process'." 755 (with-current-buffer (process-buffer proc) 756 (let ((inhibit-read-only t)) 757 (goto-char (process-mark proc)) 758 ;; Find last ^M in string. If one was found, ignore 759 ;; everything before it and delete the current line. 760 (when-let ((ret-pos (cl-position ?\r string :from-end t))) 761 (cl-callf substring string (1+ ret-pos)) 762 (delete-region (line-beginning-position) (point))) 763 (insert (propertize string 'magit-section 764 (process-get proc 'section))) 765 (set-marker (process-mark proc) (point)) 766 ;; Make sure prompts are matched after removing ^M. 767 (magit-process-yes-or-no-prompt proc string) 768 (magit-process-username-prompt proc string) 769 (magit-process-password-prompt proc string) 770 (run-hook-with-args-until-success 'magit-process-prompt-functions 771 proc string)))) 772 773 (defmacro magit-process-kill-on-abort (proc &rest body) 774 (declare (indent 1) (debug (form body))) 775 (let ((map (cl-gensym))) 776 `(let ((,map (make-sparse-keymap))) 777 (set-keymap-parent ,map minibuffer-local-map) 778 ;; Note: Leaving (kbd ...) unevaluated leads to the 779 ;; magit-process:password-prompt test failing. 780 (define-key ,map ,(kbd "C-g") 781 (lambda () 782 (interactive) 783 (ignore-errors (kill-process ,proc)) 784 (abort-recursive-edit))) 785 (let ((minibuffer-local-map ,map)) 786 ,@body)))) 787 788 (defun magit-process-yes-or-no-prompt (process string) 789 "Forward Yes-or-No prompts to the user." 790 (when-let ((beg (string-match magit-process-yes-or-no-prompt-regexp string))) 791 (let ((max-mini-window-height 30)) 792 (process-send-string 793 process 794 (downcase 795 (concat 796 (match-string 797 (if (save-match-data 798 (magit-process-kill-on-abort process 799 (yes-or-no-p (substring string 0 beg)))) 1 2) 800 string) 801 "\n")))))) 802 803 (defun magit-process-password-auth-source (key) 804 "Use `auth-source-search' to get a password. 805 If found, return the password. Otherwise, return nil. 806 807 To use this function add it to the appropriate hook 808 (add-hook 'magit-process-find-password-functions 809 'magit-process-password-auth-source) 810 811 KEY typically derives from a prompt such as: 812 Password for 'https://yourname@github.com' 813 in which case it would be the string 814 yourname@github.com 815 which matches the ~/.authinfo.gpg entry 816 machine github.com login yourname password 12345 817 or iff that is undefined, for backward compatibility 818 machine yourname@github.com password 12345 819 820 On github.com you should not use your password but a 821 personal access token, see [1]. For information about 822 the peculiarities of other forges, please consult the 823 respective documentation. 824 825 After manually editing ~/.authinfo.gpg you must reset 826 the cache using 827 M-x auth-source-forget-all-cached RET 828 829 The above will save you from having to repeatedly type 830 your token or password, but you might still repeatedly 831 be asked for your username. To prevent that, change an 832 URL like 833 https://github.com/foo/bar.git 834 to 835 https://yourname@github.com/foo/bar.git 836 837 Instead of changing all such URLs manually, they can 838 be translated on the fly by doing this once 839 git config --global \ 840 url.https://yourname@github.com.insteadOf \ 841 https://github.com 842 843 [1]: https://docs.github.com/en/github/authenticating-to-github/creating-a-personal-access-token." 844 (require 'auth-source) 845 (and (string-match "\\`\\(.+\\)@\\([^@]+\\)\\'" key) 846 (let* ((user (match-string 1 key)) 847 (host (match-string 2 key)) 848 (secret 849 (plist-get 850 (car (or (auth-source-search :max 1 :host host :user user) 851 (auth-source-search :max 1 :host key))) 852 :secret))) 853 (if (functionp secret) 854 (funcall secret) 855 secret)))) 856 857 (defun magit-process-git-credential-manager-core (process string) 858 "Authenticate using `git-credential-manager-core'. 859 860 To use this function add it to the appropriate hook 861 (add-hook \\='magit-process-prompt-functions 862 \\='magit-process-git-credential-manager-core)" 863 (and (string-match "^option (enter for default): $" string) 864 (progn 865 (magit-process-buffer) 866 (let ((option (format "%c\n" 867 (read-char-choice "Option: " '(?\r ?\j ?1 ?2))))) 868 (insert-before-markers-and-inherit option) 869 (process-send-string process option))))) 870 871 (defun magit-process-password-prompt (process string) 872 "Find a password based on prompt STRING and send it to git. 873 Use `magit-process-password-prompt-regexps' to find a known 874 prompt. If and only if one is found, then call functions in 875 `magit-process-find-password-functions' until one of them returns 876 the password. If all functions return nil, then read the password 877 from the user." 878 (when-let ((prompt (magit-process-match-prompt 879 magit-process-password-prompt-regexps string))) 880 (process-send-string 881 process (magit-process-kill-on-abort process 882 (concat (or (when-let ((key (match-string 99 string))) 883 (run-hook-with-args-until-success 884 'magit-process-find-password-functions key)) 885 (read-passwd prompt)) 886 "\n"))))) 887 888 (defun magit-process-username-prompt (process string) 889 "Forward username prompts to the user." 890 (--when-let (magit-process-match-prompt 891 magit-process-username-prompt-regexps string) 892 (process-send-string 893 process (magit-process-kill-on-abort process 894 (concat (read-string it nil nil (user-login-name)) "\n"))))) 895 896 (defun magit-process-match-prompt (prompts string) 897 "Match STRING against PROMPTS and set match data. 898 Return the matched string suffixed with \": \", if needed." 899 (when (--any-p (string-match it string) prompts) 900 (let ((prompt (match-string 0 string))) 901 (cond ((string-suffix-p ": " prompt) prompt) 902 ((string-suffix-p ":" prompt) (concat prompt " ")) 903 (t (concat prompt ": ")))))) 904 905 (defun magit--process-coding-system () 906 (let ((fro (or magit-git-output-coding-system 907 (car default-process-coding-system))) 908 (to (cdr default-process-coding-system))) 909 (if magit-process-ensure-unix-line-ending 910 (cons (coding-system-change-eol-conversion fro 'unix) 911 (coding-system-change-eol-conversion to 'unix)) 912 (cons fro to)))) 913 914 (defvar magit-credential-hook nil 915 "Hook run before Git needs credentials.") 916 917 (defvar magit-credential-cache-daemon-process nil) 918 919 (defun magit-maybe-start-credential-cache-daemon () 920 "Maybe start a `git-credential-cache--daemon' process. 921 922 If such a process is already running or if the value of option 923 `magit-credential-cache-daemon-socket' is nil, then do nothing. 924 Otherwise start the process passing the value of that options 925 as argument." 926 (unless (or (not magit-credential-cache-daemon-socket) 927 (process-live-p magit-credential-cache-daemon-process) 928 (memq magit-credential-cache-daemon-process 929 (list-system-processes))) 930 (setq magit-credential-cache-daemon-process 931 (or (--first (let* ((attr (process-attributes it)) 932 (comm (cdr (assq 'comm attr))) 933 (user (cdr (assq 'user attr)))) 934 (and (string= comm "git-credential-cache--daemon") 935 (string= user user-login-name))) 936 (list-system-processes)) 937 (condition-case nil 938 (start-process "git-credential-cache--daemon" 939 " *git-credential-cache--daemon*" 940 (magit-git-executable) 941 "credential-cache--daemon" 942 magit-credential-cache-daemon-socket) 943 ;; Some Git implementations (e.g. Windows) won't have 944 ;; this program; if we fail the first time, stop trying. 945 ((debug error) 946 (remove-hook 'magit-credential-hook 947 #'magit-maybe-start-credential-cache-daemon))))))) 948 949 (add-hook 'magit-credential-hook #'magit-maybe-start-credential-cache-daemon) 950 951 (defun tramp-sh-handle-start-file-process--magit-tramp-process-environment 952 (fn name buffer program &rest args) 953 (if magit-tramp-process-environment 954 (apply fn name buffer 955 (car magit-tramp-process-environment) 956 (append (cdr magit-tramp-process-environment) 957 (cons program args))) 958 (apply fn name buffer program args))) 959 960 (advice-add 'tramp-sh-handle-start-file-process :around 961 'tramp-sh-handle-start-file-process--magit-tramp-process-environment) 962 963 (defun tramp-sh-handle-process-file--magit-tramp-process-environment 964 (fn program &optional infile destination display &rest args) 965 (if magit-tramp-process-environment 966 (apply fn "env" infile destination display 967 (append magit-tramp-process-environment 968 (cons program args))) 969 (apply fn program infile destination display args))) 970 971 (advice-add 'tramp-sh-handle-process-file :around 972 'tramp-sh-handle-process-file--magit-tramp-process-environment) 973 974 (defvar magit-mode-line-process-map 975 (let ((map (make-sparse-keymap))) 976 (define-key map (kbd "<mode-line> <mouse-1>") 977 'magit-process-buffer) 978 map) 979 "Keymap for `mode-line-process'.") 980 981 (defun magit-process-set-mode-line (program args) 982 "Display the git command (sans arguments) in the mode line." 983 (when (equal program (magit-git-executable)) 984 (setq args (nthcdr (length magit-git-global-arguments) args))) 985 (let ((str (concat " " (propertize 986 (concat (file-name-nondirectory program) 987 (and args (concat " " (car args)))) 988 'mouse-face 'highlight 989 'keymap magit-mode-line-process-map 990 'help-echo "mouse-1: Show process buffer" 991 'font-lock-face 'magit-mode-line-process)))) 992 (magit-repository-local-set 'mode-line-process str) 993 (dolist (buf (magit-mode-get-buffers)) 994 (with-current-buffer buf 995 (setq mode-line-process str))) 996 (force-mode-line-update t))) 997 998 (defun magit-process-set-mode-line-error-status (&optional error str) 999 "Apply an error face to the string set by `magit-process-set-mode-line'. 1000 1001 If ERROR is supplied, include it in the `mode-line-process' tooltip. 1002 1003 If STR is supplied, it replaces the `mode-line-process' text." 1004 (setq str (or str (magit-repository-local-get 'mode-line-process))) 1005 (when str 1006 (setq error (format "%smouse-1: Show process buffer" 1007 (if (stringp error) 1008 (concat error "\n\n") 1009 ""))) 1010 (setq str (concat " " (propertize 1011 (substring-no-properties str 1) 1012 'mouse-face 'highlight 1013 'keymap magit-mode-line-process-map 1014 'help-echo error 1015 'font-lock-face 'magit-mode-line-process-error))) 1016 (magit-repository-local-set 'mode-line-process str) 1017 (dolist (buf (magit-mode-get-buffers)) 1018 (with-current-buffer buf 1019 (setq mode-line-process str))) 1020 (force-mode-line-update t) 1021 ;; We remove any error status from the mode line when a magit 1022 ;; buffer is refreshed (see `magit-refresh-buffer'), but we must 1023 ;; ensure that we ignore any refreshes during the remainder of the 1024 ;; current command -- otherwise a newly-set error status would be 1025 ;; removed before it was seen. We set a flag which prevents the 1026 ;; status from being removed prior to the next command, so that 1027 ;; the error status is guaranteed to remain visible until then. 1028 (let ((repokey (magit-repository-local-repository))) 1029 ;; The following closure captures the repokey value, and is 1030 ;; added to `pre-command-hook'. 1031 (cl-labels ((enable-magit-process-unset-mode-line 1032 () ;;; Remove ourself from the hook variable, so 1033 ;;; that we only run once. 1034 (remove-hook 'pre-command-hook 1035 #'enable-magit-process-unset-mode-line) 1036 ;; Clear the inhibit flag for the repository in 1037 ;; which we set it. 1038 (magit-repository-local-set 1039 'inhibit-magit-process-unset-mode-line nil repokey))) 1040 ;; Set the inhibit flag until the next command is invoked. 1041 (magit-repository-local-set 1042 'inhibit-magit-process-unset-mode-line t repokey) 1043 (add-hook 'pre-command-hook 1044 #'enable-magit-process-unset-mode-line))))) 1045 1046 (defun magit-process-unset-mode-line-error-status () 1047 "Remove any current error status from the mode line." 1048 (let ((status (or mode-line-process 1049 (magit-repository-local-get 'mode-line-process)))) 1050 (when (and status 1051 (eq (get-text-property 1 'font-lock-face status) 1052 'magit-mode-line-process-error)) 1053 (magit-process-unset-mode-line)))) 1054 1055 (defun magit-process-unset-mode-line (&optional directory) 1056 "Remove the git command from the mode line." 1057 (let ((default-directory (or directory default-directory))) 1058 (unless (magit-repository-local-get 'inhibit-magit-process-unset-mode-line) 1059 (magit-repository-local-set 'mode-line-process nil) 1060 (dolist (buf (magit-mode-get-buffers)) 1061 (with-current-buffer buf (setq mode-line-process nil))) 1062 (force-mode-line-update t)))) 1063 1064 (defvar magit-process-error-message-regexps 1065 (list "^\\*ERROR\\*: Canceled by user$" 1066 "^\\(?:error\\|fatal\\|git\\): \\(.*\\)$" 1067 "^\\(Cannot rebase:.*\\)$")) 1068 1069 (define-error 'magit-git-error "Git error") 1070 1071 (defun magit-process-error-summary (process-buf section) 1072 "A one-line error summary from the given SECTION." 1073 (or (and (buffer-live-p process-buf) 1074 (with-current-buffer process-buf 1075 (and (oref section content) 1076 (save-excursion 1077 (goto-char (oref section end)) 1078 (run-hook-wrapped 1079 'magit-process-error-message-regexps 1080 (lambda (re) 1081 (save-excursion 1082 (and (re-search-backward 1083 re (oref section start) t) 1084 (or (match-string-no-properties 1) 1085 (and (not magit-process-raise-error) 1086 'suppressed)))))))))) 1087 "Git failed")) 1088 1089 (defun magit-process-error-tooltip (process-buf section) 1090 "Returns the text from SECTION of the PROCESS-BUF buffer. 1091 1092 Limited by `magit-process-error-tooltip-max-lines'." 1093 (and (integerp magit-process-error-tooltip-max-lines) 1094 (> magit-process-error-tooltip-max-lines 0) 1095 (buffer-live-p process-buf) 1096 (with-current-buffer process-buf 1097 (save-excursion 1098 (goto-char (or (oref section content) 1099 (oref section start))) 1100 (buffer-substring-no-properties 1101 (point) 1102 (save-excursion 1103 (forward-line magit-process-error-tooltip-max-lines) 1104 (goto-char 1105 (if (> (point) (oref section end)) 1106 (oref section end) 1107 (point))) 1108 ;; Remove any trailing whitespace. 1109 (when (re-search-backward "[^[:space:]\n]" 1110 (oref section start) t) 1111 (forward-char 1)) 1112 (point))))))) 1113 1114 (defvar-local magit-this-error nil) 1115 1116 (defvar magit-process-finish-apply-ansi-colors nil) 1117 1118 (defun magit-process-finish (arg &optional process-buf command-buf 1119 default-dir section) 1120 (unless (integerp arg) 1121 (setq process-buf (process-buffer arg)) 1122 (setq command-buf (process-get arg 'command-buf)) 1123 (setq default-dir (process-get arg 'default-dir)) 1124 (setq section (process-get arg 'section)) 1125 (setq arg (process-exit-status arg))) 1126 (when (fboundp 'dired-uncache) 1127 (dired-uncache default-dir)) 1128 (when (buffer-live-p process-buf) 1129 (with-current-buffer process-buf 1130 (let ((inhibit-read-only t) 1131 (marker (oref section start))) 1132 (goto-char marker) 1133 (save-excursion 1134 (delete-char 3) 1135 (set-marker-insertion-type marker nil) 1136 (insert (propertize (format "%3s" arg) 1137 'magit-section section 1138 'font-lock-face (if (= arg 0) 1139 'magit-process-ok 1140 'magit-process-ng))) 1141 (set-marker-insertion-type marker t)) 1142 (when magit-process-finish-apply-ansi-colors 1143 (ansi-color-apply-on-region (oref section content) 1144 (oref section end))) 1145 (if (= (oref section end) 1146 (+ (line-end-position) 2)) 1147 (save-excursion 1148 (goto-char (1+ (line-end-position))) 1149 (delete-char -1) 1150 (oset section content nil)) 1151 (let ((buf (magit-process-buffer t))) 1152 (when (and (= arg 0) 1153 (not (--any-p (eq (window-buffer it) buf) 1154 (window-list)))) 1155 (magit-section-hide section))))))) 1156 (if (= arg 0) 1157 ;; Unset the `mode-line-process' value upon success. 1158 (magit-process-unset-mode-line default-dir) 1159 ;; Otherwise process the error. 1160 (let ((msg (magit-process-error-summary process-buf section))) 1161 ;; Change `mode-line-process' to an error face upon failure. 1162 (if magit-process-display-mode-line-error 1163 (magit-process-set-mode-line-error-status 1164 (or (magit-process-error-tooltip process-buf section) 1165 msg)) 1166 (magit-process-unset-mode-line default-dir)) 1167 ;; Either signal the error, or else display the error summary in 1168 ;; the status buffer and with a message in the echo area. 1169 (cond 1170 (magit-process-raise-error 1171 (signal 'magit-git-error (list (format "%s (in %s)" msg default-dir)))) 1172 ((not (eq msg 'suppressed)) 1173 (when (buffer-live-p process-buf) 1174 (with-current-buffer process-buf 1175 (when-let ((status-buf (magit-get-mode-buffer 'magit-status-mode))) 1176 (with-current-buffer status-buf 1177 (setq magit-this-error msg))))) 1178 (message "%s ... [%s buffer %s for details]" msg 1179 (if-let ((key (and (buffer-live-p command-buf) 1180 (with-current-buffer command-buf 1181 (car (where-is-internal 1182 'magit-process-buffer)))))) 1183 (format "Hit %s to see" (key-description key)) 1184 "See") 1185 (buffer-name process-buf)))))) 1186 arg) 1187 1188 (defun magit-process-display-buffer (process) 1189 (when (process-live-p process) 1190 (let ((buf (process-buffer process))) 1191 (cond ((not (buffer-live-p buf))) 1192 ((= magit-process-popup-time 0) 1193 (if (minibufferp) 1194 (switch-to-buffer-other-window buf) 1195 (pop-to-buffer buf))) 1196 ((> magit-process-popup-time 0) 1197 (run-with-timer magit-process-popup-time nil 1198 (lambda (p) 1199 (when (eq (process-status p) 'run) 1200 (let ((buf (process-buffer p))) 1201 (when (buffer-live-p buf) 1202 (if (minibufferp) 1203 (switch-to-buffer-other-window buf) 1204 (pop-to-buffer buf)))))) 1205 process)))))) 1206 1207 (defun magit--log-action (summary line list) 1208 (let (heading lines) 1209 (if (cdr list) 1210 (progn (setq heading (funcall summary list)) 1211 (setq lines (mapcar line list))) 1212 (setq heading (funcall line (car list)))) 1213 (with-current-buffer (magit-process-buffer t) 1214 (goto-char (1- (point-max))) 1215 (let ((inhibit-read-only t)) 1216 (magit-insert-section (message) 1217 (magit-insert-heading (concat " * " heading)) 1218 (when lines 1219 (dolist (line lines) 1220 (insert line "\n")) 1221 (insert "\n")))) 1222 (let ((inhibit-message t)) 1223 (when heading 1224 (setq lines (cons heading lines))) 1225 (message (mapconcat #'identity lines "\n")))))) 1226 1227 ;;; _ 1228 (provide 'magit-process) 1229 ;;; magit-process.el ends here