]> code.delx.au - gnu-emacs/blobdiff - lisp/net/tramp-sh.el
Merge from origin/emacs-25
[gnu-emacs] / lisp / net / tramp-sh.el
index ab4f07fc020a514889f37e7994cac5657376ced5..b2293a2b014e0e13c9b2b7696427913b5877ba25 100644 (file)
@@ -307,6 +307,14 @@ The string is used in `tramp-methods'.")
     (tramp-remote-shell-args    ("-c"))
     (tramp-connection-timeout   10)))
 ;;;###tramp-autoload
+(add-to-list 'tramp-methods
+  '("doas"
+    (tramp-login-program        "doas")
+    (tramp-login-args           (("-u" "%u") ("-s")))
+    (tramp-remote-shell         "/bin/sh")
+    (tramp-remote-shell-args    ("-c"))
+    (tramp-connection-timeout   10)))
+;;;###tramp-autoload
 (add-to-list 'tramp-methods
   '("ksu"
     (tramp-login-program        "ksu")
@@ -408,7 +416,7 @@ The string is used in `tramp-methods'.")
 
 ;;;###tramp-autoload
 (add-to-list 'tramp-default-user-alist
-            `(,(concat "\\`" (regexp-opt '("su" "sudo" "ksu")) "\\'")
+            `(,(concat "\\`" (regexp-opt '("su" "sudo" "doas" "ksu")) "\\'")
               nil "root"))
 ;; Do not add "ssh" based methods, otherwise ~/.ssh/config would be ignored.
 ;; Do not add "plink" based methods, they ask interactively for the user.
@@ -483,6 +491,7 @@ The string is used in `tramp-methods'.")
      (tramp-set-completion-function "nc" tramp-completion-function-alist-telnet)
      (tramp-set-completion-function "su" tramp-completion-function-alist-su)
      (tramp-set-completion-function "sudo" tramp-completion-function-alist-su)
+     (tramp-set-completion-function "doas" tramp-completion-function-alist-su)
      (tramp-set-completion-function "ksu" tramp-completion-function-alist-su)
      (tramp-set-completion-function "sg" tramp-completion-function-alist-sg)
      (tramp-set-completion-function
@@ -497,7 +506,7 @@ The string is used in `tramp-methods'.")
 ;; "getconf PATH" yields:
 ;; HP-UX: /usr/bin:/usr/ccs/bin:/opt/ansic/bin:/opt/langtools/bin:/opt/fortran/bin
 ;; Solaris: /usr/xpg4/bin:/usr/ccs/bin:/usr/bin:/opt/SUNWspro/bin
-;; GNU/Linux (Debian, Suse): /bin:/usr/bin
+;; GNU/Linux (Debian, Suse, RHEL): /bin:/usr/bin
 ;; FreeBSD: /usr/bin:/bin:/usr/sbin:/sbin: - beware trailing ":"!
 ;; Darwin: /usr/bin:/bin:/usr/sbin:/sbin
 ;; IRIX64: /usr/bin
@@ -2797,7 +2806,7 @@ The method used must be an out-of-band method."
          (narrow-to-region (point) (point))
          ;; We cannot use `insert-buffer-substring' because the Tramp
          ;; buffer changes its contents before insertion due to calling
-         ;; `expand-file' and alike.
+         ;; `expand-file-name' and alike.
          (insert
           (with-current-buffer (tramp-get-buffer v)
             (buffer-string)))
@@ -2860,9 +2869,10 @@ the result will be a local, non-Tramp, file name."
   ;; Unless NAME is absolute, concat DIR and NAME.
   (unless (file-name-absolute-p name)
     (setq name (concat (file-name-as-directory dir) name)))
-  ;; If NAME is not a Tramp file, run the real handler.
+  ;; If connection is not established yet, run the real handler.
   (if (not (tramp-connectable-p name))
-      (tramp-run-real-handler 'expand-file-name (list name nil))
+      (tramp-drop-volume-letter
+       (tramp-run-real-handler 'expand-file-name (list name nil)))
     ;; Dissect NAME.
     (with-parsed-tramp-file-name name nil
       (unless (tramp-run-real-handler 'file-name-absolute-p (list localname))
@@ -3664,7 +3674,12 @@ Fall back to normal file name handler if no Tramp handler exists."
                (concat "create,modify,move,moved_from,moved_to,move_self,"
                        "delete,delete_self,ignored"))
               ((memq 'attribute-change flags) "attrib,ignored"))
-             sequence `(,command "-mq" "-e" ,events ,localname)))
+             sequence `(,command "-mq" "-e" ,events ,localname)
+             ;; Make events a list of symbols.
+             events
+             (mapcar
+              (lambda (x) (intern-soft (replace-regexp-in-string "_" "-" x)))
+              (split-string events "," 'omit))))
        ;; None.
        (t (tramp-error
           v 'file-notify-error
@@ -3685,7 +3700,7 @@ Fall back to normal file name handler if no Tramp handler exists."
           (mapconcat 'identity sequence " "))
        (tramp-message v 6 "Run `%s', %S" (mapconcat 'identity sequence " ") p)
        (tramp-set-connection-property p "vector" v)
-       ;; Needed for `tramp-sh-gvfs-monitor-dir-process-filter'.
+       ;; Needed for process filter.
        (process-put p 'events events)
        (process-put p 'watch-name localname)
        (set-process-query-on-exit-flag p nil)
@@ -3701,7 +3716,8 @@ Fall back to normal file name handler if no Tramp handler exists."
 (defun tramp-sh-gvfs-monitor-dir-process-filter (proc string)
   "Read output from \"gvfs-monitor-dir\" and add corresponding \
 file-notify events."
-  (let ((remote-prefix
+  (let ((events (process-get proc 'events))
+       (remote-prefix
         (with-current-buffer (process-buffer proc)
           (file-remote-p default-directory)))
        (rest-string (process-get proc 'rest-string)))
@@ -3727,23 +3743,26 @@ file-notify events."
             (object
              (list
               proc
-              (intern-soft
-               (replace-regexp-in-string
-                "_" "-" (downcase (match-string 4 string))))
+              (list
+               (intern-soft
+                (replace-regexp-in-string
+                 "_" "-" (downcase (match-string 4 string)))))
               ;; File names are returned as absolute paths.  We must
               ;; add the remote prefix.
               (concat remote-prefix file)
               (when file1 (concat remote-prefix file1)))))
        (setq string (replace-match "" nil nil string))
        ;; Remove watch when file or directory to be watched is deleted.
-       (when (and (member (cadr object) '(moved deleted))
+       (when (and (member (caadr object) '(moved deleted))
                   (string-equal file (process-get proc 'watch-name)))
          (delete-process proc))
        ;; Usually, we would add an Emacs event now.  Unfortunately,
        ;; `unread-command-events' does not accept several events at
-       ;; once.  Therefore, we apply the callback directly.
-       (when (member (cadr object) (process-get proc 'events))
-         (tramp-compat-funcall 'file-notify-callback object))))
+       ;; once.  Therefore, we apply the handler directly.
+       (when (member (caadr object) events)
+         (tramp-compat-funcall
+          'file-notify-handle-event
+          `(file-notify ,object file-notify-callback)))))
 
     ;; Save rest of the string.
     (when (zerop (length string)) (setq string nil))
@@ -3752,33 +3771,37 @@ file-notify events."
 
 (defun tramp-sh-inotifywait-process-filter (proc string)
   "Read output from \"inotifywait\" and add corresponding file-notify events."
-  (tramp-message proc 6 "%S\n%s" proc string)
-  (dolist (line (split-string string "[\n\r]+" 'omit))
-    ;; Check, whether there is a problem.
-    (unless
-       (string-match
-        (concat "^[^[:blank:]]+"
-                "[[:blank:]]+\\([^[:blank:]]+\\)+"
-                "\\([[:blank:]]+\\([^\n\r]+\\)\\)?")
-        line)
-      (tramp-error proc 'file-notify-error "%s" line))
-
-    (let ((object
-          (list
-           proc
-           (mapcar
-            (lambda (x)
-              (intern-soft
-               (replace-regexp-in-string "_" "-" (downcase x))))
-            (split-string (match-string 1 line) "," 'omit))
-           (match-string 3 line))))
-      ;; Remove watch when file or directory to be watched is deleted.
-      (when (equal (cadr object) 'ignored)
-       (delete-process proc))
-      ;; Usually, we would add an Emacs event now.  Unfortunately,
-      ;; `unread-command-events' does not accept several events at
-      ;; once.  Therefore, we apply the callback directly.
-      (tramp-compat-funcall 'file-notify-callback object))))
+  (let ((events (process-get proc 'events)))
+    (tramp-message proc 6 "%S\n%s" proc string)
+    (dolist (line (split-string string "[\n\r]+" 'omit))
+      ;; Check, whether there is a problem.
+      (unless
+         (string-match
+          (concat "^[^[:blank:]]+"
+                  "[[:blank:]]+\\([^[:blank:]]+\\)+"
+                  "\\([[:blank:]]+\\([^\n\r]+\\)\\)?")
+          line)
+       (tramp-error proc 'file-notify-error "%s" line))
+
+      (let ((object
+            (list
+             proc
+             (mapcar
+              (lambda (x)
+                (intern-soft
+                 (replace-regexp-in-string "_" "-" (downcase x))))
+              (split-string (match-string 1 line) "," 'omit))
+             (match-string 3 line))))
+       ;; Remove watch when file or directory to be watched is deleted.
+       (when (member (caadr object) '(move-self delete-self ignored))
+         (delete-process proc))
+       ;; Usually, we would add an Emacs event now.  Unfortunately,
+       ;; `unread-command-events' does not accept several events at
+       ;; once.  Therefore, we apply the handler directly.
+       (when (member (caadr object) events)
+         (tramp-compat-funcall
+          'file-notify-handle-event
+          `(file-notify ,object file-notify-callback)))))))
 
 ;;; Internal Functions:
 
@@ -4110,44 +4133,36 @@ process to set up.  VEC specifies the connection."
   ;; CCC this can't be the right way to do it.  Hm.
   (tramp-message vec 5 "Determining coding system")
   (with-current-buffer (process-buffer proc)
-    (if (featurep 'mule)
-       ;; Use MULE to select the right EOL convention for communicating
-       ;; with the process.
-       (let ((cs (or (and (memq 'utf-8 (coding-system-list))
-                          (string-match "utf-?8" (tramp-get-remote-locale vec))
-                          (cons 'utf-8 'utf-8))
-                     (process-coding-system proc)
-                     (cons 'undecided 'undecided)))
-             cs-decode cs-encode)
-         (when (symbolp cs) (setq cs (cons cs cs)))
-         (setq cs-decode (or (car cs) 'undecided)
-                cs-encode (or (cdr cs) 'undecided))
-         (setq cs-encode
-               (coding-system-change-eol-conversion
-                cs-encode
-                (if (string-match
-                     "^Darwin" (tramp-get-connection-property vec "uname" ""))
-                    'mac 'unix)))
-         (tramp-send-command vec "echo foo ; echo bar" t)
-         (goto-char (point-min))
-         (when (search-forward "\r" nil t)
-           (setq cs-decode (coding-system-change-eol-conversion
-                            cs-decode 'dos)))
-          ;; Special setting for Mac OS X.
-          (when (and (string-match
-                      "^Darwin" (tramp-get-connection-property vec "uname" ""))
-                     (memq 'utf-8-hfs (coding-system-list)))
-            (setq cs-decode 'utf-8-hfs
-                  cs-encode 'utf-8-hfs))
-         (set-buffer-process-coding-system cs-decode cs-encode)
-         (tramp-message
-          vec 5 "Setting coding system to `%s' and `%s'" cs-decode cs-encode))
-      ;; Look for ^M and do something useful if found.
+    ;; Use MULE to select the right EOL convention for communicating
+    ;; with the process.
+    (let ((cs (or (and (memq 'utf-8 (coding-system-list))
+                      (string-match "utf-?8" (tramp-get-remote-locale vec))
+                      (cons 'utf-8 'utf-8))
+                 (process-coding-system proc)
+                 (cons 'undecided 'undecided)))
+         cs-decode cs-encode)
+      (when (symbolp cs) (setq cs (cons cs cs)))
+      (setq cs-decode (or (car cs) 'undecided)
+           cs-encode (or (cdr cs) 'undecided)
+           cs-encode
+           (coding-system-change-eol-conversion
+            cs-encode
+            (if (string-match
+                 "^Darwin" (tramp-get-connection-property vec "uname" ""))
+                'mac 'unix)))
+      (tramp-send-command vec "echo foo ; echo bar" t)
+      (goto-char (point-min))
       (when (search-forward "\r" nil t)
-       ;; We have found a ^M but cannot frob the process coding system
-       ;; because we're running on a non-MULE Emacs.  Let's try
-       ;; stty, instead.
-       (tramp-send-command vec "stty -onlcr" t))))
+       (setq cs-decode (coding-system-change-eol-conversion cs-decode 'dos)))
+      ;; Special setting for Mac OS X.
+      (when (and (string-match
+                 "^Darwin" (tramp-get-connection-property vec "uname" ""))
+                (memq 'utf-8-hfs (coding-system-list)))
+       (setq cs-decode 'utf-8-hfs
+             cs-encode 'utf-8-hfs))
+      (set-buffer-process-coding-system cs-decode cs-encode)
+      (tramp-message
+       vec 5 "Setting coding system to `%s' and `%s'" cs-decode cs-encode)))
 
   (tramp-send-command vec "set +o vi +o emacs" t)
 
@@ -4757,7 +4772,7 @@ connection if a previous connection has died for some reason."
              (when (and p (processp p))
                (delete-process p))
              (setenv "TERM" tramp-terminal-type)
-             (setenv "LC_ALL" "en_US.utf8")
+             (setenv "LC_ALL" (tramp-get-local-locale vec))
              (if (stringp tramp-histfile-override)
                  (setenv "HISTFILE" tramp-histfile-override)
                (if tramp-histfile-override
@@ -4767,6 +4782,8 @@ connection if a previous connection has died for some reason."
                      (setenv "HISTSIZE" "0"))))
              (setenv "PROMPT_COMMAND")
              (setenv "PS1" tramp-initial-end-of-output)
+              (unless (stringp tramp-encoding-shell)
+                (tramp-error vec 'file-error "`tramp-encoding-shell' not set"))
              (let* ((target-alist (tramp-compute-multi-hops vec))
                     ;; We will apply `tramp-ssh-controlmaster-options'
                     ;; only for the first hop.
@@ -4933,7 +4950,10 @@ connection if a previous connection has died for some reason."
                        target-alist (cdr target-alist)))
 
                ;; Make initial shell settings.
-               (tramp-open-connection-setup-interactive-shell p vec)))))
+               (tramp-open-connection-setup-interactive-shell p vec)
+
+               ;; Mark it as connected.
+               (tramp-set-connection-property p "connected" t)))))
 
       ;; When the user did interrupt, we must cleanup.
       (quit