summaryrefslogtreecommitdiff
path: root/lisp/net
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/net')
-rw-r--r--lisp/net/browse-url.el16
-rw-r--r--lisp/net/dbus.el22
-rw-r--r--lisp/net/dns.el23
-rw-r--r--lisp/net/eww.el10
-rw-r--r--lisp/net/gnutls.el2
-rw-r--r--lisp/net/rcirc.el275
-rw-r--r--lisp/net/shr.el10
-rw-r--r--lisp/net/tramp-adb.el18
-rw-r--r--lisp/net/tramp-cache.el25
-rw-r--r--lisp/net/tramp-ftp.el18
-rw-r--r--lisp/net/tramp-gvfs.el37
-rw-r--r--lisp/net/tramp-sh.el332
-rw-r--r--lisp/net/tramp-smb.el191
-rw-r--r--lisp/net/tramp.el64
-rw-r--r--lisp/net/trampver.el6
15 files changed, 624 insertions, 425 deletions
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el
index 9644a509b22..09d84795f4f 100644
--- a/lisp/net/browse-url.el
+++ b/lisp/net/browse-url.el
@@ -1343,16 +1343,12 @@ used instead of `browse-url-new-window-flag'."
"newwin\n"
"goto\n")
url "\n")
- (let ((umask (default-file-modes)))
- (unwind-protect
- (progn
- (set-default-file-modes ?\700)
- (if (file-exists-p
- (setq pidfile (format "/tmp/Mosaic.%d" pid)))
- (delete-file pidfile))
- ;; http://debbugs.gnu.org/17428. Use O_EXCL.
- (write-region nil nil pidfile nil 'silent nil 'excl))
- (set-default-file-modes umask))))
+ (with-file-modes ?\700
+ (if (file-exists-p
+ (setq pidfile (format "/tmp/Mosaic.%d" pid)))
+ (delete-file pidfile))
+ ;; http://debbugs.gnu.org/17428. Use O_EXCL.
+ (write-region nil nil pidfile nil 'silent nil 'excl)))
;; Send signal SIGUSR to Mosaic
(message "Signaling Mosaic...")
(signal-process pid 'SIGUSR1)
diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el
index 66170dafef8..582f54faf4e 100644
--- a/lisp/net/dbus.el
+++ b/lisp/net/dbus.el
@@ -544,6 +544,10 @@ placed in the queue.
`:already-owner': Service is already the primary owner."
+ ;; Add Peer handler.
+ (dbus-register-method
+ bus service nil dbus-interface-peer "Ping" 'dbus-peer-handler 'dont-register)
+
;; Add ObjectManager handler.
(dbus-register-method
bus service nil dbus-interface-objectmanager "GetManagedObjects"
@@ -1151,6 +1155,22 @@ apply
bus service dbus-path-dbus dbus-interface-peer "Ping")))
(dbus-error nil)))
+(defun dbus-peer-handler ()
+ "Default handler for the \"org.freedesktop.DBus.Peer\" interface.
+It will be registered for all objects created by `dbus-register-service'."
+ (let* ((last-input-event last-input-event)
+ (method (dbus-event-member-name last-input-event)))
+ (cond
+ ;; "Ping" does not return an output parameter.
+ ((string-equal method "Ping")
+ :ignore)
+ ;; "GetMachineId" returns "s".
+ ((string-equal method "GetMachineId")
+ (signal
+ 'dbus-error
+ (list
+ (format "%s.GetMachineId not implemented" dbus-interface-peer)))))))
+
;;; D-Bus introspection.
@@ -1672,7 +1692,7 @@ and \"org.freedesktop.DBus.Properties.GetAll\", which is slow."
(defun dbus-managed-objects-handler ()
"Default handler for the \"org.freedesktop.DBus.ObjectManager\" interface.
-It will be registered for all objects created by `dbus-register-method'."
+It will be registered for all objects created by `dbus-register-service'."
(let* ((last-input-event last-input-event)
(bus (dbus-event-bus-name last-input-event))
(path (dbus-event-path-name last-input-event)))
diff --git a/lisp/net/dns.el b/lisp/net/dns.el
index e52ead1fb72..ea1c805c6b9 100644
--- a/lisp/net/dns.el
+++ b/lisp/net/dns.el
@@ -31,6 +31,12 @@
"List of DNS servers to query.
If nil, /etc/resolv.conf and nslookup will be consulted.")
+(defvar dns-servers-valid-for-interfaces nil
+ "The return value of `network-interface-list' when `dns-servers' was set.
+If the set of network interfaces and/or their IP addresses
+change, then presumably the list of DNS servers needs to be
+updated. Set this variable to t to disable the check.")
+
;;; Internal code:
(defvar dns-query-types
@@ -297,6 +303,17 @@ If TCP-P, the first two bytes of the package with be the length field."
(t string)))
(goto-char point))))
+(declare-function network-interface-list "process.c")
+
+(defun dns-servers-up-to-date-p ()
+ "Return false if we need to recheck the list of DNS servers."
+ (and dns-servers
+ (or (eq dns-servers-valid-for-interfaces t)
+ ;; `network-interface-list' was introduced in Emacs 22.1.
+ (not (fboundp 'network-interface-list))
+ (equal dns-servers-valid-for-interfaces
+ (network-interface-list)))))
+
(defun dns-set-servers ()
"Set `dns-servers' to a list of DNS servers or nil if none are found.
Parses \"/etc/resolv.conf\" or calls \"nslookup\"."
@@ -314,7 +331,9 @@ Parses \"/etc/resolv.conf\" or calls \"nslookup\"."
(goto-char (point-min))
(re-search-forward
"^Address:[ \t]*\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)" nil t)
- (setq dns-servers (list (match-string 1)))))))
+ (setq dns-servers (list (match-string 1))))))
+ (when (fboundp 'network-interface-list)
+ (setq dns-servers-valid-for-interfaces (network-interface-list))))
(defun dns-read-txt (string)
(if (> (length string) 1)
@@ -378,7 +397,7 @@ Parses \"/etc/resolv.conf\" or calls \"nslookup\"."
If FULLP, return the entire record returned.
If REVERSEP, look up an IP address."
(setq type (or type 'A))
- (unless dns-servers
+ (unless (dns-servers-up-to-date-p)
(dns-set-servers))
(when reversep
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index 02fc575c261..f99148162e4 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -57,6 +57,12 @@
:group 'eww
:type 'string)
+(defcustom eww-bookmarks-directory user-emacs-directory
+ "Directory where bookmark files will be stored."
+ :version "24.5"
+ :group 'eww
+ :type 'string)
+
(defcustom eww-use-external-browser-for-content-type
"\\`\\(video/\\|audio/\\|application/ogg\\)"
"Always use external browser for specified content-type."
@@ -1118,12 +1124,12 @@ Differences in #targets are ignored."
(message "Bookmarked %s (%s)" eww-current-url eww-current-title))))
(defun eww-write-bookmarks ()
- (with-temp-file (expand-file-name "eww-bookmarks" user-emacs-directory)
+ (with-temp-file (expand-file-name "eww-bookmarks" eww-bookmarks-directory)
(insert ";; Auto-generated file; don't edit\n")
(pp eww-bookmarks (current-buffer))))
(defun eww-read-bookmarks ()
- (let ((file (expand-file-name "eww-bookmarks" user-emacs-directory)))
+ (let ((file (expand-file-name "eww-bookmarks" eww-bookmarks-directory)))
(setq eww-bookmarks
(unless (zerop (or (nth 7 (file-attributes file)) 0))
(with-temp-buffer
diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el
index ea4c0351be7..0c650f38d95 100644
--- a/lisp/net/gnutls.el
+++ b/lisp/net/gnutls.el
@@ -214,7 +214,7 @@ defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
(cl-mapcan
(lambda (check)
(when (string-match (car check) hostname)
- (cdr check)))
+ (copy-sequence (cdr check))))
gnutls-verify-error))
;; else it's nil
(t nil))))
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index 2591fc83e84..f06f8bd292e 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -1,10 +1,10 @@
-;;; rcirc.el --- default, simple IRC client.
+;;; rcirc.el --- default, simple IRC client -*- lexical-binding: t; -*-
;; Copyright (C) 2005-2014 Free Software Foundation, Inc.
;; Author: Ryan Yeske <rcyeske@gmail.com>
;; Maintainers: Ryan Yeske <rcyeske@gmail.com>,
-;; Deniz Dogan <deniz@dogan.se>
+;; Leo Liu <sdl.web@gmail.com>
;; Keywords: comm
;; This file is part of GNU Emacs.
@@ -43,9 +43,9 @@
;;; Code:
+(require 'cl-lib)
(require 'ring)
(require 'time-date)
-(eval-when-compile (require 'cl))
(defgroup rcirc nil
"Simple IRC client."
@@ -489,7 +489,7 @@ If ARG is non-nil, instead prompt for connection parameters."
(when (string= server (process-name p))
(setq connected p)))
(if (not connected)
- (condition-case e
+ (condition-case nil
(rcirc-connect server port nick user-name
full-name channels password encryption)
(quit (message "Quit connecting to %s" server)))
@@ -521,6 +521,7 @@ If ARG is non-nil, instead prompt for connection parameters."
(defvar rcirc-user-authenticated nil)
(defvar rcirc-user-disconnect nil)
(defvar rcirc-connecting nil)
+(defvar rcirc-connection-info nil)
(defvar rcirc-process nil)
;;;###autoload
@@ -549,22 +550,23 @@ If ARG is non-nil, instead prompt for connection parameters."
(set-process-sentinel process 'rcirc-sentinel)
(set-process-filter process 'rcirc-filter)
- (set (make-local-variable 'rcirc-process) process)
- (set (make-local-variable 'rcirc-server) server)
- (set (make-local-variable 'rcirc-server-name) server) ; Update when we get 001 response.
- (set (make-local-variable 'rcirc-buffer-alist) nil)
- (set (make-local-variable 'rcirc-nick-table)
- (make-hash-table :test 'equal))
- (set (make-local-variable 'rcirc-nick) nick)
- (set (make-local-variable 'rcirc-process-output) nil)
- (set (make-local-variable 'rcirc-startup-channels) startup-channels)
- (set (make-local-variable 'rcirc-last-server-message-time)
- (current-time))
-
- (set (make-local-variable 'rcirc-timeout-timer) nil)
- (set (make-local-variable 'rcirc-user-disconnect) nil)
- (set (make-local-variable 'rcirc-user-authenticated) nil)
- (set (make-local-variable 'rcirc-connecting) t)
+ (setq-local rcirc-connection-info
+ (list server port nick user-name full-name startup-channels
+ password encryption))
+ (setq-local rcirc-process process)
+ (setq-local rcirc-server server)
+ (setq-local rcirc-server-name server) ; Update when we get 001 response.
+ (setq-local rcirc-buffer-alist nil)
+ (setq-local rcirc-nick-table (make-hash-table :test 'equal))
+ (setq-local rcirc-nick nick)
+ (setq-local rcirc-process-output nil)
+ (setq-local rcirc-startup-channels startup-channels)
+ (setq-local rcirc-last-server-message-time (current-time))
+
+ (setq-local rcirc-timeout-timer nil)
+ (setq-local rcirc-user-disconnect nil)
+ (setq-local rcirc-user-authenticated nil)
+ (setq-local rcirc-connecting t)
(add-hook 'auto-save-hook 'rcirc-log-write)
@@ -629,7 +631,7 @@ last ping."
(cancel-timer rcirc-keepalive-timer))
(setq rcirc-keepalive-timer nil)))
-(defun rcirc-handler-ctcp-KEEPALIVE (process target sender message)
+(defun rcirc-handler-ctcp-KEEPALIVE (process _target _sender message)
(with-rcirc-process-buffer process
(setq header-line-format (format "%f" (- (rcirc-float-time)
(string-to-number message))))))
@@ -656,6 +658,16 @@ is non-nil."
"Hook functions called when the process sentinel is called.
Functions are called with PROCESS and SENTINEL arguments.")
+(defcustom rcirc-reconnect-delay 0
+ "The minimum interval in seconds between reconnect attempts.
+When 0, do not auto-reconnect."
+ :version "24.5"
+ :type 'integer
+ :group 'rcirc)
+
+(defvar rcirc-last-connect-time nil
+ "The last time the buffer was connected.")
+
(defun rcirc-sentinel (process sentinel)
"Called when PROCESS receives SENTINEL."
(let ((sentinel (replace-regexp-in-string "\n" "" sentinel)))
@@ -667,8 +679,17 @@ Functions are called with PROCESS and SENTINEL arguments.")
(format "%s: %s (%S)"
(process-name process)
sentinel
- (process-status process)) (not rcirc-target))
+ (process-status process))
+ (not rcirc-target))
(rcirc-disconnect-buffer)))
+ (when (and (string= sentinel "deleted")
+ (< 0 rcirc-reconnect-delay))
+ (let ((now (current-time)))
+ (when (or (null rcirc-last-connect-time)
+ (< rcirc-reconnect-delay
+ (float-time (time-subtract now rcirc-last-connect-time))))
+ (setq rcirc-last-connect-time now)
+ (rcirc-cmd-reconnect nil))))
(run-hook-with-args 'rcirc-sentinel-functions process sentinel))))
(defun rcirc-disconnect-buffer (&optional buffer)
@@ -752,7 +773,7 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.")
(defvar rcirc-responses-no-activity '("305" "306")
"Responses that don't trigger activity in the mode-line indicator.")
-(defun rcirc-handler-generic (process response sender args text)
+(defun rcirc-handler-generic (process response sender args _text)
"Generic server response handler."
(rcirc-print process sender response nil
(mapconcat 'identity (cdr args) " ")
@@ -782,11 +803,11 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.")
(defun rcirc-buffer-process (&optional buffer)
"Return the process associated with channel BUFFER.
With no argument or nil as argument, use the current buffer."
- (or (get-buffer-process (if buffer
- (with-current-buffer buffer
- rcirc-server-buffer)
- rcirc-server-buffer))
- rcirc-process))
+ (let ((buffer (or buffer (and (buffer-live-p rcirc-server-buffer)
+ rcirc-server-buffer))))
+ (if buffer
+ (with-current-buffer buffer rcirc-process)
+ rcirc-process)))
(defun rcirc-server-name (process)
"Return PROCESS server name, given by the 001 response."
@@ -928,12 +949,12 @@ IRC command completion is performed only if '/' is the first input char."
(defun set-rcirc-decode-coding-system (coding-system)
"Set the decode coding system used in this channel."
(interactive "zCoding system for incoming messages: ")
- (set (make-local-variable 'rcirc-decode-coding-system) coding-system))
+ (setq-local rcirc-decode-coding-system coding-system))
(defun set-rcirc-encode-coding-system (coding-system)
"Set the encode coding system used in this channel."
(interactive "zCoding system for outgoing messages: ")
- (set (make-local-variable 'rcirc-encode-coding-system) coding-system))
+ (setq-local rcirc-encode-coding-system coding-system))
(defvar rcirc-mode-map
(let ((map (make-sparse-keymap)))
@@ -990,25 +1011,26 @@ This number is independent of the number of lines in the buffer.")
(setq major-mode 'rcirc-mode)
(setq mode-line-process nil)
- (set (make-local-variable 'rcirc-input-ring)
- ;; If rcirc-input-ring is already a ring with desired size do
- ;; not re-initialize.
- (if (and (ring-p rcirc-input-ring)
- (= (ring-size rcirc-input-ring)
- rcirc-input-ring-size))
- rcirc-input-ring
- (make-ring rcirc-input-ring-size)))
- (set (make-local-variable 'rcirc-server-buffer) (process-buffer process))
- (set (make-local-variable 'rcirc-target) target)
- (set (make-local-variable 'rcirc-topic) nil)
- (set (make-local-variable 'rcirc-last-post-time) (current-time))
- (set (make-local-variable 'fill-paragraph-function) 'rcirc-fill-paragraph)
- (set (make-local-variable 'rcirc-recent-quit-alist) nil)
- (set (make-local-variable 'rcirc-current-line) 0)
+ (setq-local rcirc-input-ring
+ ;; If rcirc-input-ring is already a ring with desired
+ ;; size do not re-initialize.
+ (if (and (ring-p rcirc-input-ring)
+ (= (ring-size rcirc-input-ring)
+ rcirc-input-ring-size))
+ rcirc-input-ring
+ (make-ring rcirc-input-ring-size)))
+ (setq-local rcirc-server-buffer (process-buffer process))
+ (setq-local rcirc-target target)
+ (setq-local rcirc-topic nil)
+ (setq-local rcirc-last-post-time (current-time))
+ (setq-local fill-paragraph-function 'rcirc-fill-paragraph)
+ (setq-local rcirc-recent-quit-alist nil)
+ (setq-local rcirc-current-line 0)
+ (setq-local rcirc-last-connect-time (current-time))
(use-hard-newlines t)
- (set (make-local-variable 'rcirc-short-buffer-name) nil)
- (set (make-local-variable 'rcirc-urls) nil)
+ (setq-local rcirc-short-buffer-name nil)
+ (setq-local rcirc-urls nil)
;; setup for omitting responses
(setq buffer-invisibility-spec '())
@@ -1023,18 +1045,18 @@ This number is independent of the number of lines in the buffer.")
(serv (if (consp (car i)) (cdar i) "")))
(when (and (string-match chan (or target ""))
(string-match serv (rcirc-server-name process)))
- (set (make-local-variable 'rcirc-decode-coding-system)
- (if (consp (cdr i)) (cadr i) (cdr i)))
- (set (make-local-variable 'rcirc-encode-coding-system)
- (if (consp (cdr i)) (cddr i) (cdr i))))))
+ (setq-local rcirc-decode-coding-system
+ (if (consp (cdr i)) (cadr i) (cdr i)))
+ (setq-local rcirc-encode-coding-system
+ (if (consp (cdr i)) (cddr i) (cdr i))))))
;; setup the prompt and markers
- (set (make-local-variable 'rcirc-prompt-start-marker) (point-max-marker))
- (set (make-local-variable 'rcirc-prompt-end-marker) (point-max-marker))
+ (setq-local rcirc-prompt-start-marker (point-max-marker))
+ (setq-local rcirc-prompt-end-marker (point-max-marker))
(rcirc-update-prompt)
(goto-char rcirc-prompt-end-marker)
- (set (make-local-variable 'overlay-arrow-position) (make-marker))
+ (setq-local overlay-arrow-position (make-marker))
;; if the user changes the major mode or kills the buffer, there is
;; cleanup work to do
@@ -1222,13 +1244,13 @@ Create the buffer if it doesn't exist."
(ring-insert rcirc-input-ring input)
(setq rcirc-input-ring-index 0))))))
-(defun rcirc-fill-paragraph (&optional arg)
- (interactive "p")
+(defun rcirc-fill-paragraph (&optional justify)
+ (interactive "P")
(when (> (point) rcirc-prompt-end-marker)
(save-restriction
(narrow-to-region rcirc-prompt-end-marker (point-max))
(let ((fill-column rcirc-max-message-length))
- (fill-region (point-min) (point-max))))))
+ (fill-region (point-min) (point-max) justify)))))
(defun rcirc-process-input-line (line)
(if (string-match "^/\\([^ ]+\\) ?\\(.*\\)$" line)
@@ -1393,9 +1415,9 @@ is found by looking up RESPONSE in `rcirc-response-formats'."
(rcirc-add-face start (match-beginning 0) face)
(setq start (match-beginning 0))
(replace-match
- (case (aref (match-string 1) 0)
+ (cl-case (aref (match-string 1) 0)
(?f (setq face
- (case (string-to-char (match-string 3))
+ (cl-case (string-to-char (match-string 3))
(?w 'font-lock-warning-face)
(?p 'rcirc-server-prefix)
(?s 'rcirc-server)
@@ -1431,9 +1453,9 @@ is found by looking up RESPONSE in `rcirc-response-formats'."
(rcirc-add-face start (match-beginning 0) face))
(buffer-substring (point-min) (point-max))))
-(defun rcirc-target-buffer (process sender response target text)
+(defun rcirc-target-buffer (process sender response target _text)
"Return a buffer to print the server response."
- (assert (not (bufferp target)))
+ (cl-assert (not (bufferp target)))
(with-rcirc-process-buffer process
(cond ((not target)
(rcirc-any-buffer process))
@@ -1474,11 +1496,10 @@ Returns nil if the information is not recorded."
(defun rcirc-last-line (process nick target)
"Return the line from the last activity from NICK in TARGET."
- (let* ((chanbuf (rcirc-get-buffer process target))
- (line (or (cdr (assoc-string target
- (gethash nick (with-rcirc-server-buffer
- rcirc-nick-table)) t))
- (rcirc-last-quit-line process nick target))))
+ (let ((line (or (cdr (assoc-string target
+ (gethash nick (with-rcirc-server-buffer
+ rcirc-nick-table)) t))
+ (rcirc-last-quit-line process nick target))))
(if line
line
;;(message "line is nil for %s in %s" nick target)
@@ -1883,7 +1904,9 @@ Uninteresting lines are those whose responses are listed in
(message "Rcirc-Omit mode enabled"))
(remove-from-invisibility-spec '(rcirc-omit . nil))
(message "Rcirc-Omit mode disabled"))
- (recenter (when (> (point) rcirc-prompt-start-marker) -1)))
+ (dolist (window (get-buffer-window-list (current-buffer)))
+ (with-selected-window window
+ (recenter (when (> (point) rcirc-prompt-start-marker) -1)))))
(defun rcirc-switch-to-server-buffer ()
"Switch to the server buffer associated with current channel buffer."
@@ -1956,7 +1979,7 @@ activity. Only run if the buffer is not visible and
(let ((t1 (with-current-buffer b1 rcirc-last-post-time))
(t2 (with-current-buffer b2 rcirc-last-post-time)))
(time-less-p t2 t1)))))
- (pushnew type rcirc-activity-types)
+ (cl-pushnew type rcirc-activity-types)
(unless (and (equal rcirc-activity old-activity)
(member type old-types))
(rcirc-update-activity-string)))))
@@ -1977,13 +2000,13 @@ activity. Only run if the buffer is not visible and
(defun rcirc-split-activity (activity)
"Return a cons cell with ACTIVITY split into (lopri . hipri)."
(let (lopri hipri)
- (dolist (buf rcirc-activity)
+ (dolist (buf activity)
(with-current-buffer buf
(if (and rcirc-low-priority-flag
(not (member 'nick rcirc-activity-types)))
- (add-to-list 'lopri buf t)
- (add-to-list 'hipri buf t))))
- (cons lopri hipri)))
+ (push buf lopri)
+ (push buf hipri))))
+ (cons (nreverse lopri) (nreverse hipri))))
(defvar rcirc-update-activity-string-hook nil
"Hook run whenever the activity string is updated.")
@@ -2015,7 +2038,7 @@ activity. Only run if the buffer is not visible and
(with-current-buffer b
(dolist (type rcirc-activity-types)
(rcirc-add-face 0 (length s)
- (case type
+ (cl-case type
(nick 'rcirc-track-nick)
(keyword 'rcirc-track-keyword))
s)))
@@ -2123,7 +2146,7 @@ activity. Only run if the buffer is not visible and
(when (and (listp x) (listp (cadr x)))
(setcdr x (if (> (length (cdr x)) 1)
(rcirc-make-trees (cdr x))
- (setcdr x (list (cdadr x)))))))
+ (setcdr x (list (cl-cdadr x)))))))
alist)))
;;; /commands these are called with 3 args: PROCESS, TARGET, which is
@@ -2211,6 +2234,19 @@ CHANNELS is a comma- or space-separated string of channel names."
reason
rcirc-id-string))))
+(defun-rcirc-command reconnect (_)
+ "Reconnect to current server."
+ (interactive "i")
+ (with-rcirc-server-buffer
+ (cond
+ (rcirc-connecting (message "Already connecting"))
+ ((process-live-p process) (message "Server process is alive"))
+ (t (let ((conn-info rcirc-connection-info))
+ (setf (nth 5 conn-info)
+ (cl-remove-if-not #'rcirc-channel-p
+ (mapcar #'car rcirc-buffer-alist)))
+ (apply #'rcirc-connect conn-info))))))
+
(defun-rcirc-command nick (nick)
"Change nick to NICK."
(interactive "i")
@@ -2281,7 +2317,7 @@ With a prefix arg, prompt for new topic."
(mapconcat 'identity (cdr arglist) " "))))
(rcirc-send-string process (concat "KICK " target " " argstring))))
-(defun rcirc-cmd-ctcp (args &optional process target)
+(defun rcirc-cmd-ctcp (args &optional process _target)
(if (string-match "^\\([^ ]+\\)\\s-+\\(.+\\)$" args)
(let* ((target (match-string 1 args))
(request (upcase (match-string 2 args)))
@@ -2292,7 +2328,7 @@ With a prefix arg, prompt for new topic."
(rcirc-print process (rcirc-nick process) "ERROR" nil
"usage: /ctcp NICK REQUEST")))
-(defun rcirc-ctcp-sender-PING (process target request)
+(defun rcirc-ctcp-sender-PING (process target _request)
"Send a CTCP PING message to TARGET."
(let ((timestamp (format "%.0f" (rcirc-float-time))))
(rcirc-send-ctcp process target "PING" timestamp)))
@@ -2412,21 +2448,20 @@ If ARG is given, opens the URL in a new browser window."
(lambda (x) (>= point (cdr x)))
rcirc-urls))
(completions (mapcar (lambda (x) (car x)) filtered))
- (initial-input (caar filtered))
- (history (mapcar (lambda (x) (car x)) (cdr filtered))))
- (browse-url (completing-read "rcirc browse-url: "
- completions nil nil initial-input 'history)
+ (defaults (mapcar (lambda (x) (car x)) filtered)))
+ (browse-url (completing-read "Rcirc browse-url: "
+ completions nil nil (car defaults) nil defaults)
arg)))
-(defun rcirc-markup-timestamp (sender response)
+(defun rcirc-markup-timestamp (_sender _response)
(goto-char (point-min))
(insert (rcirc-facify (format-time-string rcirc-time-format)
'rcirc-timestamp)))
-(defun rcirc-markup-attributes (sender response)
+(defun rcirc-markup-attributes (_sender _response)
(while (re-search-forward "\\([\C-b\C-_\C-v]\\).*?\\(\\1\\|\C-o\\)" nil t)
(rcirc-add-face (match-beginning 0) (match-end 0)
- (case (char-after (match-beginning 1))
+ (cl-case (char-after (match-beginning 1))
(?\C-b 'bold)
(?\C-v 'italic)
(?\C-_ 'underline)))
@@ -2440,7 +2475,7 @@ If ARG is given, opens the URL in a new browser window."
(while (re-search-forward "\C-o+" nil t)
(delete-region (match-beginning 0) (match-end 0))))
-(defun rcirc-markup-my-nick (sender response)
+(defun rcirc-markup-my-nick (_sender response)
(with-syntax-table rcirc-nick-syntax-table
(while (re-search-forward (concat "\\b"
(regexp-quote (rcirc-nick
@@ -2454,7 +2489,7 @@ If ARG is given, opens the URL in a new browser window."
'rcirc-nick-in-message-full-line)
(rcirc-record-activity (current-buffer) 'nick)))))
-(defun rcirc-markup-urls (sender response)
+(defun rcirc-markup-urls (_sender _response)
(while (and rcirc-url-regexp ;; nil means disable URL catching
(re-search-forward rcirc-url-regexp nil t))
(let* ((start (match-beginning 0))
@@ -2485,7 +2520,7 @@ If ARG is given, opens the URL in a new browser window."
(rcirc-add-face (match-beginning 0) (match-end 0) 'rcirc-keyword)
(rcirc-record-activity (current-buffer) 'keyword))))))
-(defun rcirc-markup-bright-nicks (sender response)
+(defun rcirc-markup-bright-nicks (_sender response)
(when (and rcirc-bright-nicks
(string= response "NAMES"))
(with-syntax-table rcirc-nick-syntax-table
@@ -2493,7 +2528,7 @@ If ARG is given, opens the URL in a new browser window."
(rcirc-add-face (match-beginning 0) (match-end 0)
'rcirc-bright-nick)))))
-(defun rcirc-markup-fill (sender response)
+(defun rcirc-markup-fill (_sender response)
(when (not (string= response "372")) ; /motd
(let ((fill-prefix
(or rcirc-fill-prefix
@@ -2574,7 +2609,7 @@ If ARG is given, opens the URL in a new browser window."
sender)))
message t))))
-(defun rcirc-check-auth-status (process sender args text)
+(defun rcirc-check-auth-status (process sender args _text)
"Check if the user just authenticated.
If authenticated, runs `rcirc-authenticated-hook' with PROCESS as
the only argument."
@@ -2602,10 +2637,10 @@ the only argument."
(run-hook-with-args 'rcirc-authenticated-hook process)
(remove-hook 'rcirc-authenticated-hook 'rcirc-join-channels-post-auth t))))))
-(defun rcirc-handler-WALLOPS (process sender args text)
+(defun rcirc-handler-WALLOPS (process sender args _text)
(rcirc-print process sender "WALLOPS" sender (car args) t))
-(defun rcirc-handler-JOIN (process sender args text)
+(defun rcirc-handler-JOIN (process sender args _text)
(let ((channel (car args)))
(with-current-buffer (rcirc-get-buffer-create process channel)
;; when recently rejoining, restore the linestamp
@@ -2626,7 +2661,7 @@ the only argument."
(rcirc-print process sender "JOIN" sender channel))))
;; PART and KICK are handled the same way
-(defun rcirc-handler-PART-or-KICK (process response channel sender nick args)
+(defun rcirc-handler-PART-or-KICK (process _response channel _sender nick _args)
(rcirc-ignore-update-automatic nick)
(if (not (string= nick (rcirc-nick process)))
;; this is someone else leaving
@@ -2643,7 +2678,7 @@ the only argument."
(when buffer
(rcirc-disconnect-buffer buffer)))))
-(defun rcirc-handler-PART (process sender args text)
+(defun rcirc-handler-PART (process sender args _text)
(let* ((channel (car args))
(reason (cadr args))
(message (concat channel " " reason)))
@@ -2654,10 +2689,10 @@ the only argument."
(rcirc-handler-PART-or-KICK process "PART" channel sender sender reason)))
-(defun rcirc-handler-KICK (process sender args text)
+(defun rcirc-handler-KICK (process sender args _text)
(let* ((channel (car args))
(nick (cadr args))
- (reason (caddr args))
+ (reason (cl-caddr args))
(message (concat nick " " channel " " reason)))
(rcirc-print process sender "KICK" channel message t)
;; print in private chat buffer if it exists
@@ -2682,7 +2717,7 @@ the only argument."
(cons (cons nick line)
rcirc-recent-quit-alist))))))))))
-(defun rcirc-handler-QUIT (process sender args text)
+(defun rcirc-handler-QUIT (process sender args _text)
(rcirc-ignore-update-automatic sender)
(mapc (lambda (channel)
;; broadcast quit message each channel
@@ -2692,7 +2727,7 @@ the only argument."
(rcirc-nick-channels process sender))
(rcirc-nick-remove process sender))
-(defun rcirc-handler-NICK (process sender args text)
+(defun rcirc-handler-NICK (process sender args _text)
(let* ((old-nick sender)
(new-nick (car args))
(channels (rcirc-nick-channels process old-nick)))
@@ -2723,25 +2758,25 @@ the only argument."
;; reauthenticate
(when rcirc-auto-authenticate-flag (rcirc-authenticate))))))
-(defun rcirc-handler-PING (process sender args text)
+(defun rcirc-handler-PING (process _sender args _text)
(rcirc-send-string process (concat "PONG :" (car args))))
-(defun rcirc-handler-PONG (process sender args text)
+(defun rcirc-handler-PONG (_process _sender _args _text)
;; do nothing
)
-(defun rcirc-handler-TOPIC (process sender args text)
+(defun rcirc-handler-TOPIC (process sender args _text)
(let ((topic (cadr args)))
(rcirc-print process sender "TOPIC" (car args) topic)
(with-current-buffer (rcirc-get-buffer process (car args))
(setq rcirc-topic topic))))
(defvar rcirc-nick-away-alist nil)
-(defun rcirc-handler-301 (process sender args text)
+(defun rcirc-handler-301 (process _sender args text)
"RPL_AWAY"
(let* ((nick (cadr args))
(rec (assoc-string nick rcirc-nick-away-alist))
- (away-message (caddr args)))
+ (away-message (cl-caddr args)))
(when (or (not rec)
(not (string= (cdr rec) away-message)))
;; away message has changed
@@ -2751,7 +2786,7 @@ the only argument."
(setq rcirc-nick-away-alist (cons (cons nick away-message)
rcirc-nick-away-alist))))))
-(defun rcirc-handler-317 (process sender args text)
+(defun rcirc-handler-317 (process sender args _text)
"RPL_WHOISIDLE"
(let* ((nick (nth 1 args))
(idle-secs (string-to-number (nth 2 args)))
@@ -2765,31 +2800,31 @@ the only argument."
nick idle-string signon-string)))
(rcirc-print process sender "317" nil message t)))
-(defun rcirc-handler-332 (process sender args text)
+(defun rcirc-handler-332 (process _sender args _text)
"RPL_TOPIC"
(let ((buffer (or (rcirc-get-buffer process (cadr args))
(rcirc-get-temp-buffer-create process (cadr args)))))
(with-current-buffer buffer
- (setq rcirc-topic (caddr args)))))
+ (setq rcirc-topic (cl-caddr args)))))
-(defun rcirc-handler-333 (process sender args text)
+(defun rcirc-handler-333 (process sender args _text)
"333 says who set the topic and when.
Not in rfc1459.txt"
(let ((buffer (or (rcirc-get-buffer process (cadr args))
(rcirc-get-temp-buffer-create process (cadr args)))))
(with-current-buffer buffer
- (let ((setter (caddr args))
+ (let ((setter (cl-caddr args))
(time (current-time-string
(seconds-to-time
- (string-to-number (cadddr args))))))
+ (string-to-number (cl-cadddr args))))))
(rcirc-print process sender "TOPIC" (cadr args)
(format "%s (%s on %s)" rcirc-topic setter time))))))
-(defun rcirc-handler-477 (process sender args text)
+(defun rcirc-handler-477 (process sender args _text)
"ERR_NOCHANMODES"
- (rcirc-print process sender "477" (cadr args) (caddr args)))
+ (rcirc-print process sender "477" (cadr args) (cl-caddr args)))
-(defun rcirc-handler-MODE (process sender args text)
+(defun rcirc-handler-MODE (process sender args _text)
(let ((target (car args))
(msg (mapconcat 'identity (cdr args) " ")))
(rcirc-print process sender "MODE"
@@ -2809,7 +2844,7 @@ Not in rfc1459.txt"
(let ((tmpnam (concat " " (downcase channel) "TMP" (process-name process))))
(get-buffer-create tmpnam)))
-(defun rcirc-handler-353 (process sender args text)
+(defun rcirc-handler-353 (process _sender args _text)
"RPL_NAMREPLY"
(let ((channel (nth 2 args))
(names (or (nth 3 args) "")))
@@ -2822,7 +2857,7 @@ Not in rfc1459.txt"
(goto-char (point-max))
(insert (car (last args)) " "))))
-(defun rcirc-handler-366 (process sender args text)
+(defun rcirc-handler-366 (process sender args _text)
"RPL_ENDOFNAMES"
(let* ((channel (cadr args))
(buffer (rcirc-get-temp-buffer-create process channel)))
@@ -2847,14 +2882,14 @@ Passwords are stored in `rcirc-authinfo' (which see)."
(dolist (i rcirc-authinfo)
(let ((process (rcirc-buffer-process))
(server (car i))
- (nick (caddr i))
+ (nick (cl-caddr i))
(method (cadr i))
- (args (cdddr i)))
+ (args (cl-cdddr i)))
(when (and (string-match server rcirc-server))
(if (and (memq method '(nickserv chanserv bitlbee))
(string-match nick rcirc-nick))
;; the following methods rely on the user's nickname.
- (case method
+ (cl-case method
(nickserv
(rcirc-send-privmsg
process
@@ -2878,10 +2913,10 @@ Passwords are stored in `rcirc-authinfo' (which see)."
"Q@CServe.quakenet.org"
(format "AUTH %s %s" nick (car args))))))))))
-(defun rcirc-handler-INVITE (process sender args text)
+(defun rcirc-handler-INVITE (process sender args _text)
(rcirc-print process sender "INVITE" nil (mapconcat 'identity args " ") t))
-(defun rcirc-handler-ERROR (process sender args text)
+(defun rcirc-handler-ERROR (process sender args _text)
(rcirc-print process sender "ERROR" nil (mapconcat 'identity args " ")))
(defun rcirc-handler-CTCP (process target sender text)
@@ -2899,7 +2934,7 @@ Passwords are stored in `rcirc-authinfo' (which see)."
(rcirc-print process sender "CTCP" target
(format "%s" text) t))))))
-(defun rcirc-handler-ctcp-VERSION (process target sender args)
+(defun rcirc-handler-ctcp-VERSION (process _target sender _args)
(rcirc-send-string process
(concat "NOTICE " sender
" :\C-aVERSION " rcirc-id-string
@@ -2908,12 +2943,12 @@ Passwords are stored in `rcirc-authinfo' (which see)."
(defun rcirc-handler-ctcp-ACTION (process target sender args)
(rcirc-print process sender "ACTION" target args t))
-(defun rcirc-handler-ctcp-TIME (process target sender args)
+(defun rcirc-handler-ctcp-TIME (process _target sender _args)
(rcirc-send-string process
(concat "NOTICE " sender
" :\C-aTIME " (current-time-string) "\C-a")))
-(defun rcirc-handler-CTCP-response (process target sender message)
+(defun rcirc-handler-CTCP-response (process _target sender message)
(rcirc-print process sender "CTCP" nil message t))
(defgroup rcirc-faces nil
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 58442575ad2..5e2e1eadf86 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -214,12 +214,16 @@ DOM should be a parse tree as generated by
(overlay-put overlay 'before-string nil))))
(forward-line 1)))))
-(defun shr-copy-url ()
+(defun shr-copy-url (&optional image-url)
"Copy the URL under point to the kill ring.
+If IMAGE-URL (the prefix) is non-nil, or there is no link under
+point, but there is an image under point then copy the URL of the
+image under point instead.
If called twice, then try to fetch the URL and see whether it
redirects somewhere else."
- (interactive)
- (let ((url (get-text-property (point) 'shr-url)))
+ (interactive "P")
+ (let ((url (or (get-text-property (point) 'shr-url)
+ (get-text-property (point) 'image-url))))
(cond
((not url)
(message "No URL under point"))
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index c21f2907720..16017eebba3 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -458,9 +458,7 @@ Emacs dired can't find files."
(insert " " (mapconcat 'identity sorted-lines "\n ")))
;; Add final newline.
(goto-char (point-max))
- (unless (= (point) (line-beginning-position))
- (insert "\n"))))
-
+ (unless (bolp) (insert "\n"))))
(defun tramp-adb-ls-output-time-less-p (a b)
"Sort \"ls\" output by time, descending."
@@ -609,10 +607,10 @@ But handle the case, if the \"test\" command is not available."
'write-region
(list start end tmpfile append 'no-message lockname confirm))
(with-tramp-progress-reporter
- v 3 (format "Moving tmp file %s to %s" tmpfile filename)
+ v 3 (format "Moving tmp file `%s' to `%s'" tmpfile filename)
(unwind-protect
(when (tramp-adb-execute-adb-command v "push" tmpfile localname)
- (tramp-error v 'file-error "Cannot write: `%s' filename"))
+ (tramp-error v 'file-error "Cannot write: `%s'" filename))
(delete-file tmpfile)))
(when (or (eq visit t) (stringp visit))
@@ -998,7 +996,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(with-temp-buffer
(prog1
(unless
- (zerop (apply 'tramp-call-process tramp-adb-program nil t nil args))
+ (zerop
+ (apply 'tramp-call-process vec tramp-adb-program nil t nil args))
(buffer-string))
(tramp-message vec 6 "%s" (buffer-string)))))
@@ -1031,7 +1030,7 @@ This happens for Android >= 4.0."
(defun tramp-adb-send-command-and-check
(vec command)
- "Run COMMAND and and check its exit status.
+ "Run COMMAND and check its exit status.
Sends `echo $?' along with the COMMAND for checking the exit status. If
COMMAND is nil, just sends `echo $?'. Returns the exit status found."
(tramp-adb-send-command
@@ -1107,10 +1106,7 @@ connection if a previous connection has died for some reason."
(and p (processp p) (memq (process-status p) '(run open)))
(save-match-data
(when (and p (processp p)) (delete-process p))
- (setq tramp-current-method (tramp-file-name-method vec)
- tramp-current-user (tramp-file-name-user vec)
- tramp-current-host (tramp-file-name-host vec)
- devices (mapcar 'cadr (tramp-adb-parse-device-names nil)))
+ (setq devices (mapcar 'cadr (tramp-adb-parse-device-names nil)))
(if (not devices)
(tramp-error vec 'file-error "No device connected"))
(if (and (> (length host) 0) (not (member host devices)))
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index be66f18d9e4..bdcbba85960 100644
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -201,15 +201,24 @@ Remove also properties of all files in subdirectories."
;; Reverting or killing a buffer should also flush file properties.
;; They could have been changed outside Tramp. In eshell, "ls" would
;; not show proper directory contents when a file has been copied or
-;; deleted before.
+;; deleted before. We must apply `save-match-data', because it would
+;; corrupt other packages otherwise (reported from org).
(defun tramp-flush-file-function ()
- "Flush all Tramp cache properties from `buffer-file-name'."
- (let ((bfn (if (stringp (buffer-file-name))
- (buffer-file-name)
- default-directory)))
- (when (tramp-tramp-file-p bfn)
- (with-parsed-tramp-file-name bfn nil
- (tramp-flush-file-property v localname)))))
+ "Flush all Tramp cache properties from `buffer-file-name'.
+This is suppressed for temporary buffers."
+ (save-match-data
+ (unless
+ (string-match
+ (concat
+ "^" (regexp-opt '("*tramp/" "*debug tramp/" " *temp*") 'paren))
+ (or (buffer-name) ""))
+
+ (let ((bfn (if (stringp (buffer-file-name))
+ (buffer-file-name)
+ default-directory)))
+ (when (tramp-tramp-file-p bfn)
+ (with-parsed-tramp-file-name bfn nil
+ (tramp-flush-file-property v localname)))))))
(add-hook 'before-revert-hook 'tramp-flush-file-function)
(add-hook 'eshell-pre-command-hook 'tramp-flush-file-function)
diff --git a/lisp/net/tramp-ftp.el b/lisp/net/tramp-ftp.el
index dc84a524ba0..a723e57f296 100644
--- a/lisp/net/tramp-ftp.el
+++ b/lisp/net/tramp-ftp.el
@@ -120,17 +120,6 @@ present for backward compatibility."
tramp-ftp-method
'((tramp-parse-netrc "~/.netrc"))))
-;; If there is URL syntax, `substitute-in-file-name' needs special
-;; handling.
-(put 'substitute-in-file-name 'ange-ftp 'tramp-handle-substitute-in-file-name)
-(add-hook 'tramp-ftp-unload-hook
- (lambda ()
- (setplist 'substitute-in-file-name
- (delete 'ange-ftp
- (delete 'tramp-handle-substitute-in-file-name
- (symbol-plist
- 'substitute-in-file-name))))))
-
;;;###tramp-autoload
(defun tramp-ftp-file-name-handler (operation &rest args)
"Invoke the Ange-FTP handler for OPERATION.
@@ -189,12 +178,7 @@ pass to the OPERATION."
(ignore-errors (delete-file tmpfile)))))
;; Normally, the handlers must be discarded.
- ;; `inhibit-file-name-handlers' isn't sufficient, because the
- ;; local file name could be in Tramp syntax as well (for
- ;; example, returning VMS file names like "/DISK$CAM:/AAA").
- ;; That's why we set also `tramp-mode' to nil.
- (t (let* (;(tramp-mode nil)
- (inhibit-file-name-handlers
+ (t (let* ((inhibit-file-name-handlers
(list 'tramp-file-name-handler
'tramp-completion-file-name-handler
(and (eq inhibit-file-name-operation operation)
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 52189e091fb..5d6447609fa 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -49,14 +49,14 @@
;; The customer option `tramp-gvfs-methods' contains the list of
;; supported connection methods. Per default, these are "dav",
-;; "davs", "obex" and "synce". Note that with "obex" it might be
-;; necessary to pair with the other bluetooth device, if it hasn't
+;; "davs", "obex", "sftp" and "synce". Note that with "obex" it might
+;; be necessary to pair with the other bluetooth device, if it hasn't
;; been done already. There might be also some few seconds delay in
;; discovering available bluetooth devices.
-;; Other possible connection methods are "ftp", "sftp" and "smb".
-;; When one of these methods is added to the list, the remote access
-;; for that method is performed via GVFS instead of the native Tramp
+;; Other possible connection methods are "ftp" and "smb". When one of
+;; these methods is added to the list, the remote access for that
+;; method is performed via GVFS instead of the native Tramp
;; implementation.
;; GVFS offers even more connection methods. The complete list of
@@ -110,7 +110,7 @@
(require 'custom))
;;;###tramp-autoload
-(defcustom tramp-gvfs-methods '("dav" "davs" "obex" "synce")
+(defcustom tramp-gvfs-methods '("dav" "davs" "obex" "sftp" "synce")
"List of methods for remote files, accessed with GVFS."
:group 'tramp
:version "23.2"
@@ -661,7 +661,7 @@ is no information where to trace the message.")
"Like `delete-file' for Tramp files."
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-property v (file-name-directory localname))
- (tramp-flush-directory-property v localname)
+ (tramp-flush-file-property v localname)
(unless
(tramp-gvfs-send-command
v (if (and trash delete-by-moving-to-trash) "gvfs-trash" "gvfs-rm")
@@ -794,7 +794,8 @@ is no information where to trace the message.")
(goto-char (point-min))
(setq res-filemodes
(if (re-search-forward "unix::mode:\\s-+\\([0-9]+\\)" nil t)
- (tramp-file-mode-from-int (match-string 1))
+ (tramp-file-mode-from-int
+ (string-to-number (match-string 1)))
(if dirp "drwx------" "-rwx------")))
;; ... inode and device
(goto-char (point-min))
@@ -899,7 +900,7 @@ is no information where to trace the message.")
entry)
;; Get a list of directories and files.
(tramp-gvfs-send-command
- v "gvfs-ls" (tramp-gvfs-url-file-name directory))
+ v "gvfs-ls" "-h" (tramp-gvfs-url-file-name directory))
;; Now grab the output.
(with-temp-buffer
@@ -1118,9 +1119,9 @@ is no information where to trace the message.")
(setq user
(concat (match-string 2 user) ";" (match-string 1 user))))
(url-parse-make-urlobj
- method (url-hexify-string user) nil
+ method (and user (url-hexify-string user)) nil
(tramp-file-name-real-host v) (tramp-file-name-port v)
- (url-hexify-string localname) nil nil t))
+ (and localname (url-hexify-string localname)) nil nil t))
(url-parse-make-urlobj
"file" nil nil nil nil
(url-hexify-string (file-truename filename)) nil nil t))))
@@ -1555,14 +1556,10 @@ connection if a previous connection has died for some reason."
"Send the COMMAND with its ARGS to connection VEC.
COMMAND is usually a command from the gvfs-* utilities.
`call-process' is applied, and it returns `t' if the return code is zero."
- (let (result)
- (with-current-buffer (tramp-get-connection-buffer vec)
- (tramp-gvfs-maybe-open-connection vec)
- (erase-buffer)
- (tramp-message vec 6 "%s %s" command (mapconcat 'identity args " "))
- (setq result (apply 'tramp-call-process command nil t nil args))
- (tramp-message vec 6 "\n%s" (buffer-string))
- (zerop result))))
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (tramp-gvfs-maybe-open-connection vec)
+ (erase-buffer)
+ (zerop (apply 'tramp-call-process vec command nil t nil args))))
;; D-Bus BLUEZ functions.
@@ -1671,7 +1668,7 @@ be used."
(list user host)))
(zeroconf-list-services "_webdav._tcp")))
-;; Add completion function for DAV and DAVS methods.
+;; Add completion function for SFTP, DAV and DAVS methods.
(when (and tramp-gvfs-enabled
(member zeroconf-service-avahi (dbus-list-known-names :system)))
(zeroconf-init tramp-gvfs-zeroconf-domain)
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 6f55b86e9e5..569d3473532 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -35,6 +35,10 @@
(defvar directory-sep-char)
(defvar tramp-gw-tunnel-method)
(defvar tramp-gw-socks-method)
+(defvar vc-handled-backends)
+(defvar vc-bzr-program)
+(defvar vc-git-program)
+(defvar vc-hg-program)
(defcustom tramp-inline-compress-start-size 4096
"The minimum size of compressing where inline transfer.
@@ -142,17 +146,6 @@ detected as prompt when being sent on echoing hosts, therefore.")
(tramp-default-port 22)))
;;;###tramp-autoload
(add-to-list 'tramp-methods
- '("sftp"
- (tramp-login-program "ssh")
- (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c")
- ("-e" "none") ("%h")))
- (tramp-async-args (("-q")))
- (tramp-remote-shell "/bin/sh")
- (tramp-remote-shell-args ("-c"))
- (tramp-copy-program "sftp")
- (tramp-copy-args ("%c"))))
- ;;;###tramp-autoload
-(add-to-list 'tramp-methods
'("rsync"
(tramp-login-program "ssh")
(tramp-login-args (("-l" "%u") ("-p" "%p") ("%c")
@@ -210,12 +203,28 @@ detected as prompt when being sent on echoing hosts, therefore.")
(add-to-list 'tramp-methods
'("telnet"
(tramp-login-program "telnet")
- (tramp-login-args (("%h") ("%p")))
+ (tramp-login-args (("%h") ("%p") ("2>/dev/null")))
(tramp-remote-shell "/bin/sh")
(tramp-remote-shell-args ("-c"))
(tramp-default-port 23)))
;;;###tramp-autoload
(add-to-list 'tramp-methods
+ '("nc"
+ (tramp-login-program "telnet")
+ (tramp-login-args (("%h") ("%p") ("2>/dev/null")))
+ (tramp-remote-shell "/bin/sh")
+ (tramp-remote-shell-args ("-c"))
+ (tramp-copy-program "nc")
+ ;; We use "-v" for better error tracking.
+ (tramp-copy-args (("-w" "1") ("-v") ("%h") ("%r")))
+ (tramp-remote-copy-program "nc")
+ ;; We use "-p" as required for newer busyboxes. For older
+ ;; busybox/nc versions, the value must be (("-l") ("%r")). This
+ ;; can be achieved by tweaking `tramp-connection-properties'.
+ (tramp-remote-copy-args (("-l") ("-p" "%r")))
+ (tramp-default-port 23)))
+;;;###tramp-autoload
+(add-to-list 'tramp-methods
'("su"
(tramp-login-program "su")
(tramp-login-args (("-") ("%u")))
@@ -249,9 +258,16 @@ detected as prompt when being sent on echoing hosts, therefore.")
(tramp-remote-shell-args ("-c"))))
;;;###tramp-autoload
(add-to-list 'tramp-methods
- '("plink"
+ `("plink"
(tramp-login-program "plink")
- (tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh") ("%h")))
+ ;; ("%h") must be a single element, see `tramp-compute-multi-hops'.
+ (tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh") ("-t")
+ ("%h") ("\"")
+ (,(format
+ "env 'TERM=%s' 'PROMPT_COMMAND=' 'PS1=%s'"
+ tramp-terminal-type
+ tramp-initial-end-of-output))
+ ("/bin/sh") ("\"")))
(tramp-remote-shell "/bin/sh")
(tramp-remote-shell-args ("-c"))
(tramp-default-port 22)))
@@ -259,21 +275,25 @@ detected as prompt when being sent on echoing hosts, therefore.")
(add-to-list 'tramp-methods
`("plinkx"
(tramp-login-program "plink")
- ;; ("%h") must be a single element, see
- ;; `tramp-compute-multi-hops'.
- (tramp-login-args (("-load") ("%h") ("-t")
+ (tramp-login-args (("-load") ("%h") ("-t") ("\"")
(,(format
"env 'TERM=%s' 'PROMPT_COMMAND=' 'PS1=%s'"
tramp-terminal-type
tramp-initial-end-of-output))
- ("/bin/sh")))
+ ("/bin/sh") ("\"")))
(tramp-remote-shell "/bin/sh")
(tramp-remote-shell-args ("-c"))))
;;;###tramp-autoload
(add-to-list 'tramp-methods
- '("pscp"
+ `("pscp"
(tramp-login-program "plink")
- (tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh") ("%h")))
+ (tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh") ("-t")
+ ("%h") ("\"")
+ (,(format
+ "env 'TERM=%s' 'PROMPT_COMMAND=' 'PS1=%s'"
+ tramp-terminal-type
+ tramp-initial-end-of-output))
+ ("/bin/sh") ("\"")))
(tramp-remote-shell "/bin/sh")
(tramp-remote-shell-args ("-c"))
(tramp-copy-program "pscp")
@@ -284,9 +304,15 @@ detected as prompt when being sent on echoing hosts, therefore.")
(tramp-default-port 22)))
;;;###tramp-autoload
(add-to-list 'tramp-methods
- '("psftp"
+ `("psftp"
(tramp-login-program "plink")
- (tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh") ("%h")))
+ (tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh") ("-t")
+ ("%h") ("\"")
+ (,(format
+ "env 'TERM=%s' 'PROMPT_COMMAND=' 'PS1=%s'"
+ tramp-terminal-type
+ tramp-initial-end-of-output))
+ ("/bin/sh") ("\"")))
(tramp-remote-shell "/bin/sh")
(tramp-remote-shell-args ("-c"))
(tramp-copy-program "pscp")
@@ -319,7 +345,8 @@ detected as prompt when being sent on echoing hosts, therefore.")
(add-to-list 'tramp-default-user-alist
`(,(concat
"\\`"
- (regexp-opt '("rcp" "remcp" "rsh" "telnet" "krlogin" "fcp"))
+ (regexp-opt
+ '("rcp" "remcp" "rsh" "telnet" "nc" "krlogin" "fcp"))
"\\'")
nil ,(user-login-name)))
@@ -370,7 +397,6 @@ detected as prompt when being sent on echoing hosts, therefore.")
(tramp-set-completion-function "remcp" tramp-completion-function-alist-rsh)
(tramp-set-completion-function "scp" tramp-completion-function-alist-ssh)
(tramp-set-completion-function "scpx" tramp-completion-function-alist-ssh)
- (tramp-set-completion-function "sftp" tramp-completion-function-alist-ssh)
(tramp-set-completion-function "rsync" tramp-completion-function-alist-ssh)
(tramp-set-completion-function "rsh" tramp-completion-function-alist-rsh)
(tramp-set-completion-function "remsh" tramp-completion-function-alist-rsh)
@@ -378,6 +404,7 @@ detected as prompt when being sent on echoing hosts, therefore.")
(tramp-set-completion-function "sshx" tramp-completion-function-alist-ssh)
(tramp-set-completion-function
"telnet" tramp-completion-function-alist-telnet)
+ (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 "ksu" tramp-completion-function-alist-su)
@@ -387,6 +414,7 @@ detected as prompt when being sent on echoing hosts, therefore.")
(tramp-set-completion-function
"plinkx" tramp-completion-function-alist-putty)
(tramp-set-completion-function "pscp" tramp-completion-function-alist-ssh)
+ (tramp-set-completion-function "psftp" tramp-completion-function-alist-ssh)
(tramp-set-completion-function "fcp" tramp-completion-function-alist-ssh)))
;; "getconf PATH" yields:
@@ -1239,8 +1267,7 @@ target of the symlink differ."
(format "%s -ild %s"
(tramp-get-ls-command v)
(tramp-shell-quote-argument localname)))
- (setq attr (buffer-substring (point)
- (progn (end-of-line) (point)))))
+ (setq attr (buffer-substring (point) (point-at-eol))))
(tramp-set-file-property
v localname "visited-file-modtime-ild" attr))
(when (boundp 'last-coding-system-used)
@@ -1291,8 +1318,7 @@ of."
(tramp-get-ls-command v)
(tramp-shell-quote-argument localname)))
(with-current-buffer (tramp-get-buffer v)
- (setq attr (buffer-substring
- (point) (progn (end-of-line) (point)))))
+ (setq attr (buffer-substring (point) (point-at-eol))))
(equal
attr
(tramp-get-file-property
@@ -1346,7 +1372,7 @@ of."
;; We are local, so we don't need the UTC settings.
(zerop
(tramp-call-process
- "touch" nil nil nil "-t"
+ nil "touch" nil nil nil "-t"
(format-time-string "%Y%m%d%H%M.%S" time)
(tramp-shell-quote-argument filename)))))
@@ -1380,7 +1406,7 @@ be non-negative integers."
(let ((uid (or (and (natnump uid) uid) (tramp-get-local-uid 'integer)))
(gid (or (and (natnump gid) gid) (tramp-get-local-gid 'integer))))
(tramp-call-process
- "chown" nil nil nil
+ nil "chown" nil nil nil
(format "%d:%d" uid gid) (tramp-shell-quote-argument filename))))))
(defun tramp-remote-selinux-p (vec)
@@ -1542,7 +1568,7 @@ be non-negative integers."
(defun tramp-sh-handle-file-directory-p (filename)
"Like `file-directory-p' for Tramp files."
(with-parsed-tramp-file-name filename nil
- ;; `file-directory-p' is used as predicate for filename completion.
+ ;; `file-directory-p' is used as predicate for file name completion.
;; Sometimes, when a connection is not established yet, it is
;; desirable to return t immediately for "/method:foo:". It can
;; be expected that this is always a directory.
@@ -1644,10 +1670,10 @@ be non-negative integers."
vec
(format
(concat
- ;; We must care about filenames with spaces, or starting with
+ ;; We must care about file names with spaces, or starting with
;; "-"; this would confuse xargs. "ls -aQ" might be a solution,
;; but it does not work on all remote systems. Therefore, we
- ;; quote the filenames via sed.
+ ;; quote the file names via sed.
"cd %s; echo \"(\"; (%s -a | sed -e s/\\$/\\\"/g -e s/^/\\\"/g | "
"xargs %s -c "
"'(\"%%n\" (\"%%N\") %%h %s %s %%Xe0 %%Ye0 %%Ze0 %%se0 \"%%A\" t %%ie0 -1)'"
@@ -1670,15 +1696,15 @@ be non-negative integers."
(mapcar
'list
(or
- ;; Try cache entries for filename, filename with last
- ;; character removed, filename with last two characters
+ ;; Try cache entries for `filename', `filename' with last
+ ;; character removed, `filename' with last two characters
;; removed, ..., and finally the empty string - all
;; concatenated to the local directory name.
(let ((remote-file-name-inhibit-cache
(or remote-file-name-inhibit-cache
tramp-completion-reread-directory-timeout)))
- ;; This is inefficient for very long filenames, pity
+ ;; This is inefficient for very long file names, pity
;; `reduce' is not available...
(car
(apply
@@ -1742,7 +1768,7 @@ be non-negative integers."
(tramp-shell-quote-argument localname)
(tramp-get-ls-command v)
;; When `filename' is empty, just `ls' without
- ;; filename argument is more efficient than `ls *'
+ ;; `filename' argument is more efficient than `ls *'
;; for very large directories and might avoid the
;; `Argument list too long' error.
;;
@@ -1981,7 +2007,7 @@ file names."
;; create a new buffer, insert the contents of the
;; source file into it, then write out the buffer to
;; the target file. The advantage is that it doesn't
- ;; matter which filename handlers are used for the
+ ;; matter which file name handlers are used for the
;; source and target file.
(t
(tramp-do-copy-or-rename-file-via-buffer
@@ -2212,19 +2238,19 @@ the uid and gid from FILENAME."
(set-file-modes newname file-modes))))))
(defun tramp-do-copy-or-rename-file-out-of-band (op filename newname keep-date)
- "Invoke rcp program to copy.
+ "Invoke `scp' program to copy.
The method used must be an out-of-band method."
(let* ((t1 (tramp-tramp-file-p filename))
(t2 (tramp-tramp-file-p newname))
(orig-vec (tramp-dissect-file-name (if t1 filename newname)))
- copy-program copy-args copy-env copy-keep-date port spec
- options source target)
+ copy-program copy-args copy-env copy-keep-date port listener spec
+ options source target remote-copy-program remote-copy-args)
(with-parsed-tramp-file-name (if t1 filename newname) nil
(if (and t1 t2)
;; Both are Tramp files. We shall optimize it when the
- ;; methods for filename and newname are the same.
+ ;; methods for FILENAME and NEWNAME are the same.
(let* ((dir-flag (file-directory-p filename))
(tmpfile (tramp-compat-make-temp-file localname dir-flag)))
(if dir-flag
@@ -2285,6 +2311,13 @@ The method used must be an out-of-band method."
(setq user (or (tramp-file-name-user v)
(tramp-get-connection-property v "login-as" nil)))
+ ;; Check for listener port.
+ (when (tramp-get-method-parameter method 'tramp-remote-copy-args)
+ (setq listener (number-to-string (+ 50000 (random 10000))))
+ (while
+ (zerop (tramp-call-process v "nc" nil nil nil "-z" host listener))
+ (setq listener (number-to-string (+ 50000 (random 10000))))))
+
;; Compose copy command.
(setq host (or host "")
user (or user "")
@@ -2297,12 +2330,13 @@ The method used must be an out-of-band method."
tramp-ssh-controlmaster-options "")
spec)
spec (format-spec-make
- ?h host ?u user ?p port ?c options
+ ?h host ?u user ?p port ?r listener ?c options
?k (if keep-date " " ""))
copy-program (tramp-get-method-parameter
method 'tramp-copy-program)
copy-keep-date (tramp-get-method-parameter
method 'tramp-copy-keep-date)
+
copy-args
(delete
;; " " has either been a replacement of "%k" (when
@@ -2318,6 +2352,7 @@ The method used must be an out-of-band method."
copy-args
(let ((y (mapcar (lambda (z) (format-spec z spec)) x)))
(if (member "" y) '(" ") y))))))
+
copy-env
(delq
nil
@@ -2325,12 +2360,54 @@ The method used must be an out-of-band method."
(lambda (x)
(setq x (mapcar (lambda (y) (format-spec y spec)) x))
(unless (member "" x) (mapconcat 'identity x " ")))
- (tramp-get-method-parameter method 'tramp-copy-env))))
+ (tramp-get-method-parameter method 'tramp-copy-env)))
+
+ remote-copy-program
+ (tramp-get-method-parameter method 'tramp-remote-copy-program))
- ;; Check for program.
+ (dolist
+ (x
+ (or
+ (tramp-get-connection-property v "remote-copy-args" nil)
+ (tramp-get-method-parameter method 'tramp-remote-copy-args)))
+ (setq remote-copy-args
+ (append
+ remote-copy-args
+ (let ((y (mapcar (lambda (z) (format-spec z spec)) x)))
+ (if (member "" y) '(" ") y)))))
+
+ ;; Check for local copy program.
(unless (executable-find copy-program)
(tramp-error
- v 'file-error "Cannot find copy program: %s" copy-program))
+ v 'file-error "Cannot find local copy program: %s" copy-program))
+
+ ;; Install listener on the remote side. The prompt must be
+ ;; consumed later on, when the process does not listen anymore.
+ (when remote-copy-program
+ (unless (with-tramp-connection-property
+ v (concat "remote-copy-program-" remote-copy-program)
+ (tramp-find-executable
+ v remote-copy-program (tramp-get-remote-path v)))
+ (tramp-error
+ v 'file-error
+ "Cannot find remote listener: %s" remote-copy-program))
+ (setq remote-copy-program
+ (mapconcat
+ 'identity
+ (append
+ (list remote-copy-program) remote-copy-args
+ (list (if t1 (concat "<" source) (concat ">" target)) "&"))
+ " "))
+ (tramp-send-command v remote-copy-program)
+ (with-timeout
+ (1 (tramp-error
+ v 'file-error
+ "Listener process not running on remote host: `%s'"
+ remote-copy-program))
+ (tramp-send-command v (format "netstat -l | grep -q :%s" listener))
+ (while (not (tramp-send-command-and-check v nil))
+ (tramp-send-command
+ v (format "netstat -l | grep -q :%s" listener)))))
(with-temp-buffer
(unwind-protect
@@ -2347,24 +2424,26 @@ The method used must be an out-of-band method."
(tramp-message
orig-vec 6 "%s=\"%s\"" (car copy-env) (cadr copy-env))
(setenv (pop copy-env) (pop copy-env)))
+ (setq
+ copy-args
+ (append
+ copy-args
+ (if remote-copy-program
+ (list (if t1 (concat ">" target) (concat "<" source)))
+ (list source target))))
;; Use an asynchronous process. By this, password can
- ;; be handled. The default directory must be local, in
- ;; order to apply the correct `copy-program'. We don't
- ;; set a timeout, because the copying of large files can
- ;; last longer than 60 secs.
- (let ((p (let ((default-directory
- (tramp-compat-temporary-file-directory)))
- (apply 'start-process-shell-command
- (tramp-get-connection-name v)
- (tramp-get-connection-buffer v)
- copy-program
- (append
- copy-args
- (list
- source target
- "&&" "echo" "tramp_exit_status" "0"
- "||" "echo" "tramp_exit_status" "1"))))))
+ ;; be handled. We don't set a timeout, because the
+ ;; copying of large files can last longer than 60
+ ;; secs.
+ (let ((p (apply 'start-process-shell-command
+ (tramp-get-connection-name v)
+ (tramp-get-connection-buffer v)
+ copy-program
+ (append
+ copy-args
+ (list "&&" "echo" "tramp_exit_status" "0"
+ "||" "echo" "tramp_exit_status" "1")))))
(tramp-message
orig-vec 6 "%s"
(mapconcat 'identity (process-command p) " "))
@@ -2391,7 +2470,14 @@ The method used must be an out-of-band method."
;; Reset the transfer process properties.
(tramp-set-connection-property v "process-name" nil)
- (tramp-set-connection-property v "process-buffer" nil)))
+ (tramp-set-connection-property v "process-buffer" nil)
+ ;; Clear the remote prompt.
+ (when (and remote-copy-program
+ (not (tramp-send-command-and-check v nil)))
+ ;; Houston, we have a problem! Likely, the listener is
+ ;; still running, so let's clear everything (but the
+ ;; cached password).
+ (tramp-cleanup-connection v 'keep-debug 'keep-password))))
;; Handle KEEP-DATE argument.
(when (and keep-date (not copy-keep-date))
@@ -2621,7 +2707,8 @@ This is like `dired-recursive-delete-directory' for Tramp files."
(delete-region (match-beginning 0) (point)))
;; Some busyboxes are reluctant to discard colors.
- (unless (string-match "color" (tramp-get-connection-property v "ls" ""))
+ (unless
+ (string-match "color" (tramp-get-connection-property v "ls" ""))
(goto-char beg)
(while (re-search-forward tramp-color-escape-sequence-regexp nil t)
(replace-match "")))
@@ -2651,9 +2738,9 @@ This is like `dired-recursive-delete-directory' for Tramp files."
(defun tramp-sh-handle-expand-file-name (name &optional dir)
"Like `expand-file-name' for Tramp files.
-If the localname part of the given filename starts with \"/../\" then
-the result will be a local, non-Tramp, filename."
- ;; If DIR is not given, use DEFAULT-DIRECTORY or "/".
+If the localname part of the given file name starts with \"/../\" then
+the result will be a local, non-Tramp, file name."
+ ;; If DIR is not given, use `default-directory' or "/".
(setq dir (or dir default-directory "/"))
;; Unless NAME is absolute, concat DIR and NAME.
(unless (file-name-absolute-p name)
@@ -3133,7 +3220,7 @@ the result will be a local, non-Tramp, filename."
(symbol-value 'last-coding-system-used))))
;; The permissions of the temporary file should be set. If
- ;; filename does not exist (eq modes nil) it has been
+ ;; FILENAME does not exist (eq modes nil) it has been
;; renamed to the backup file. This case `save-buffer'
;; handles permissions.
;; Ensure that it is still readable.
@@ -3144,7 +3231,7 @@ the result will be a local, non-Tramp, filename."
;; This is a bit lengthy due to the different methods
;; possible for file transfer. First, we check whether the
- ;; method uses an rcp program. If so, we call it.
+ ;; method uses an scp program. If so, we call it.
;; Otherwise, both encoding and decoding command must be
;; specified. However, if the method _also_ specifies an
;; encoding function, then that is used for encoding the
@@ -3238,7 +3325,7 @@ the result will be a local, non-Tramp, filename."
(erase-buffer)
(and
;; cksum runs locally, if possible.
- (zerop (tramp-call-process "cksum" tmpfile t))
+ (zerop (tramp-call-process v "cksum" tmpfile t))
;; cksum runs remotely.
(tramp-send-command-and-check
v
@@ -3264,7 +3351,7 @@ the result will be a local, non-Tramp, filename."
(tramp-error
v 'file-error
(concat "Method `%s' should specify both encoding and "
- "decoding command or an rcp program")
+ "decoding command or an scp program")
method))))
;; Make `last-coding-system-used' have the right value.
@@ -3281,7 +3368,7 @@ the result will be a local, non-Tramp, filename."
(when (or (eq visit t) (stringp visit))
(let ((file-attr (tramp-compat-file-attributes filename 'integer)))
(set-visited-file-modtime
- ;; We must pass modtime explicitly, because filename can
+ ;; We must pass modtime explicitly, because FILENAME can
;; be different from (buffer-file-name), f.e. if
;; `file-precious-flag' is set.
(nth 5 file-attr))
@@ -3369,7 +3456,28 @@ the result will be a local, non-Tramp, filename."
;; calls shall be answered from the file cache. We unset
;; `process-file-side-effects' and `remote-file-name-inhibit-cache'
;; in order to keep the cache.
- (let (remote-file-name-inhibit-cache process-file-side-effects)
+ (let ((vc-handled-backends vc-handled-backends)
+ remote-file-name-inhibit-cache process-file-side-effects)
+ ;; Reduce `vc-handled-backends' in order to minimize process calls.
+ (when (and (memq 'Bzr vc-handled-backends)
+ (boundp 'vc-bzr-program)
+ (not (with-tramp-connection-property v vc-bzr-program
+ (tramp-find-executable
+ v vc-bzr-program (tramp-get-remote-path v)))))
+ (setq vc-handled-backends (delq 'Bzr vc-handled-backends)))
+ (when (and (memq 'Git vc-handled-backends)
+ (boundp 'vc-git-program)
+ (not (with-tramp-connection-property v vc-git-program
+ (tramp-find-executable
+ v vc-git-program (tramp-get-remote-path v)))))
+ (setq vc-handled-backends (delq 'Git vc-handled-backends)))
+ (when (and (memq 'Hg vc-handled-backends)
+ (boundp 'vc-hg-program)
+ (not (with-tramp-connection-property v vc-hg-program
+ (tramp-find-executable
+ v vc-hg-program (tramp-get-remote-path v)))))
+ (setq vc-handled-backends (delq 'Hg vc-handled-backends)))
+ ;; Run.
(ignore-errors
(tramp-run-real-handler 'vc-registered (list file))))))))
@@ -3855,15 +3963,16 @@ process to set up. VEC specifies the connection."
;; Try to set up the coding system correctly.
;; CCC this can't be the right way to do it. Hm.
(tramp-message vec 5 "Determining coding system")
- (tramp-send-command vec "echo foo ; echo bar" t)
(with-current-buffer (process-buffer proc)
- (goto-char (point-min))
(if (featurep 'mule)
;; Use MULE to select the right EOL convention for communicating
;; with the process.
- (let* ((cs (or (tramp-compat-funcall 'process-coding-system proc)
- (cons 'undecided 'undecided)))
- cs-decode cs-encode)
+ (let ((cs (or (when (string-match
+ "utf8" (or (tramp-get-remote-locale vec) ""))
+ (cons 'utf-8 'utf-8))
+ (tramp-compat-funcall 'process-coding-system proc)
+ (cons 'undecided 'undecided)))
+ cs-decode cs-encode)
(when (symbolp cs) (setq cs (cons cs cs)))
(setq cs-decode (car cs))
(setq cs-encode (cdr cs))
@@ -3871,6 +3980,8 @@ process to set up. VEC specifies the connection."
(unless cs-encode (setq cs-encode 'undecided))
(setq cs-encode (tramp-compat-coding-system-change-eol-conversion
cs-encode 'unix))
+ (tramp-send-command vec "echo foo ; echo bar" t)
+ (goto-char (point-min))
(when (search-forward "\r" nil t)
(setq cs-decode (tramp-compat-coding-system-change-eol-conversion
cs-decode 'dos)))
@@ -4010,7 +4121,7 @@ FORMAT is symbol describing the encoding/decoding format. It can be
ENCODING and DECODING can be strings, giving commands, or symbols,
giving functions. If they are strings, then they can contain
the \"%s\" format specifier. If that specifier is present, the input
-filename will be put into the command line at that spot. If the
+file name will be put into the command line at that spot. If the
specifier is not present, the input should be read from standard
input.
@@ -4045,7 +4156,7 @@ FORMAT is a symbol describing the encoding/decoding format. It can be
ENCODING and DECODING can be strings, giving commands, or symbols,
giving variables. If they are strings, then they can contain
the \"%s\" format specifier. If that specifier is present, the input
-filename will be put into the command line at that spot. If the
+file name will be put into the command line at that spot. If the
specifier is not present, the input should be read from standard
input.
@@ -4171,32 +4282,28 @@ Goes through the list `tramp-local-coding-commands' and
(setq rem-dec (nth 2 ritem))
(setq found t)))))))
- ;; Did we find something?
- (unless found
- (tramp-error
- vec 'file-error "Couldn't find an inline transfer encoding"))
-
- ;; Set connection properties. Since the commands are risky (due
- ;; to output direction), we cache them in the process cache.
- (tramp-message vec 5 "Using local encoding `%s'" loc-enc)
- (tramp-set-connection-property p "local-encoding" loc-enc)
- (tramp-message vec 5 "Using local decoding `%s'" loc-dec)
- (tramp-set-connection-property p "local-decoding" loc-dec)
- (tramp-message vec 5 "Using remote encoding `%s'" rem-enc)
- (tramp-set-connection-property p "remote-encoding" rem-enc)
- (tramp-message vec 5 "Using remote decoding `%s'" rem-dec)
- (tramp-set-connection-property p "remote-decoding" rem-dec))))
+ (when found
+ ;; Set connection properties. Since the commands are risky
+ ;; (due to output direction), we cache them in the process cache.
+ (tramp-message vec 5 "Using local encoding `%s'" loc-enc)
+ (tramp-set-connection-property p "local-encoding" loc-enc)
+ (tramp-message vec 5 "Using local decoding `%s'" loc-dec)
+ (tramp-set-connection-property p "local-decoding" loc-dec)
+ (tramp-message vec 5 "Using remote encoding `%s'" rem-enc)
+ (tramp-set-connection-property p "remote-encoding" rem-enc)
+ (tramp-message vec 5 "Using remote decoding `%s'" rem-dec)
+ (tramp-set-connection-property p "remote-decoding" rem-dec)))))
(defun tramp-call-local-coding-command (cmd input output)
"Call the local encoding or decoding command.
If CMD contains \"%s\", provide input file INPUT there in command.
Otherwise, INPUT is passed via standard input.
INPUT can also be nil which means `/dev/null'.
-OUTPUT can be a string (which specifies a filename), or t (which
+OUTPUT can be a string (which specifies a file name), or t (which
means standard output and thus the current buffer), or nil (which
means discard it)."
(tramp-call-process
- tramp-encoding-shell
+ nil tramp-encoding-shell
(when (and input (not (string-match "%s" cmd))) input)
(if (eq output t) t nil)
nil
@@ -4844,15 +4951,18 @@ Return ATTR."
""))
(defun tramp-make-copy-program-file-name (vec)
- "Create a file name suitable to be passed to `rcp' and workalikes."
- (let ((user (tramp-file-name-user vec))
+ "Create a file name suitable to be passed to `scp' or `nc' and workalikes."
+ (let ((method (tramp-file-name-method vec))
+ (user (tramp-file-name-user vec))
(host (tramp-file-name-real-host vec))
(localname (tramp-shell-quote-argument
(tramp-file-name-localname vec))))
- (shell-quote-argument
- (if (not (zerop (length user)))
- (format "%s@%s:%s" user host localname)
- (format "%s:%s" host localname)))))
+ (cond
+ ((tramp-get-method-parameter method 'tramp-remote-copy-program)
+ localname)
+ ((not (zerop (length user)))
+ (shell-quote-argument (format "%s@%s:%s" user host localname)))
+ (t (shell-quote-argument (format "%s:%s" host localname))))))
(defun tramp-method-out-of-band-p (vec size)
"Return t if this is an out-of-band method, nil otherwise."
@@ -5147,7 +5257,9 @@ Return ATTR."
(defun tramp-get-remote-python (vec)
(with-tramp-connection-property vec "python"
(tramp-message vec 5 "Finding a suitable `python' command")
- (tramp-find-executable vec "python" (tramp-get-remote-path vec))))
+ (or (tramp-find-executable vec "python" (tramp-get-remote-path vec))
+ (tramp-find-executable vec "python2" (tramp-get-remote-path vec))
+ (tramp-find-executable vec "python3" (tramp-get-remote-path vec)))))
(defun tramp-get-remote-uid-with-python (vec id-format)
(tramp-send-command-and-read
@@ -5155,8 +5267,8 @@ Return ATTR."
(format "%s -c \"%s\""
(tramp-get-remote-python vec)
(if (equal id-format 'integer)
- "import os; print os.getuid()"
- "import os, pwd; print '\\\"' + pwd.getpwuid(os.getuid())[0] + '\\\"'"))))
+ "import os; print (os.getuid())"
+ "import os, pwd; print ('\\\"' + pwd.getpwuid(os.getuid())[0] + '\\\"')"))))
(defun tramp-get-remote-uid (vec id-format)
(with-tramp-connection-property vec (format "uid-%s" id-format)
@@ -5196,8 +5308,8 @@ Return ATTR."
(format "%s -c \"%s\""
(tramp-get-remote-python vec)
(if (equal id-format 'integer)
- "import os; print os.getgid()"
- "import os, grp; print '\\\"' + grp.getgrgid(os.getgid())[0] + '\\\"'"))))
+ "import os; print (os.getgid())"
+ "import os, grp; print ('\\\"' + grp.getgrgid(os.getgid())[0] + '\\\"')"))))
(defun tramp-get-remote-gid (vec id-format)
(with-tramp-connection-property vec (format "gid-%s" id-format)
@@ -5371,9 +5483,5 @@ function cell is returned to be applied on a buffer."
;; rsync).
;; * Keep a second connection open for out-of-band methods like scp or
;; rsync.
-;; * Try telnet+curl as new method. It might be useful for busybox,
-;; without built-in uuencode/uudecode.
-;; * Try telnet+nc as new method. It might be useful for busybox,
-;; without built-in uuencode/uudecode.
;;; tramp-sh.el ends here
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index fa5e72dfb3e..15ae9ed6fa8 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -447,8 +447,7 @@ pass to the OPERATION."
(expand-file-name
tramp-temp-name-prefix
(tramp-compat-temporary-file-directory))))
- (args (list tramp-smb-program
- (concat "//" real-host "/" share) "-E")))
+ (args (list (concat "//" real-host "/" share) "-E")))
(if (not (zerop (length real-user)))
(setq args (append args (list "-U" real-user)))
@@ -495,10 +494,11 @@ pass to the OPERATION."
;; Use an asynchronous processes. By this,
;; password can be handled.
(let* ((default-directory tmpdir)
- (p (start-process-shell-command
+ (p (apply
+ 'start-process
(tramp-get-connection-name v)
(tramp-get-connection-buffer v)
- (mapconcat 'identity args " "))))
+ tramp-smb-program args)))
(tramp-message
v 6 "%s" (mapconcat 'identity (process-command p) " "))
@@ -938,99 +938,100 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(setq filename (file-name-as-directory filename))
(setq filename (directory-file-name filename)))
(with-parsed-tramp-file-name filename nil
- (save-match-data
- (let ((base (file-name-nondirectory filename))
- ;; We should not destroy the cache entry.
- (entries (copy-sequence
- (tramp-smb-get-file-entries
- (file-name-directory filename)))))
-
- (when wildcard
- (string-match "\\." base)
- (setq base (replace-match "\\\\." nil nil base))
- (string-match "\\*" base)
- (setq base (replace-match ".*" nil nil base))
- (string-match "\\?" base)
- (setq base (replace-match ".?" nil nil base)))
-
- ;; Filter entries.
- (setq entries
- (delq
- nil
- (if (or wildcard (zerop (length base)))
- ;; Check for matching entries.
- (mapcar
- (lambda (x)
- (when (string-match
- (format "^%s" base) (nth 0 x))
- x))
- entries)
- ;; We just need the only and only entry FILENAME.
- (list (assoc base entries)))))
-
- ;; Sort entries.
- (setq entries
- (sort
- entries
- (lambda (x y)
- (if (string-match "t" switches)
- ;; Sort by date.
- (tramp-time-less-p (nth 3 y) (nth 3 x))
- ;; Sort by name.
- (string-lessp (nth 0 x) (nth 0 y))))))
-
- ;; Handle "-F" switch.
- (when (string-match "F" switches)
+ (with-tramp-progress-reporter v 0 (format "Opening directory %s" filename)
+ (save-match-data
+ (let ((base (file-name-nondirectory filename))
+ ;; We should not destroy the cache entry.
+ (entries (copy-sequence
+ (tramp-smb-get-file-entries
+ (file-name-directory filename)))))
+
+ (when wildcard
+ (string-match "\\." base)
+ (setq base (replace-match "\\\\." nil nil base))
+ (string-match "\\*" base)
+ (setq base (replace-match ".*" nil nil base))
+ (string-match "\\?" base)
+ (setq base (replace-match ".?" nil nil base)))
+
+ ;; Filter entries.
+ (setq entries
+ (delq
+ nil
+ (if (or wildcard (zerop (length base)))
+ ;; Check for matching entries.
+ (mapcar
+ (lambda (x)
+ (when (string-match
+ (format "^%s" base) (nth 0 x))
+ x))
+ entries)
+ ;; We just need the only and only entry FILENAME.
+ (list (assoc base entries)))))
+
+ ;; Sort entries.
+ (setq entries
+ (sort
+ entries
+ (lambda (x y)
+ (if (string-match "t" switches)
+ ;; Sort by date.
+ (tramp-time-less-p (nth 3 y) (nth 3 x))
+ ;; Sort by name.
+ (string-lessp (nth 0 x) (nth 0 y))))))
+
+ ;; Handle "-F" switch.
+ (when (string-match "F" switches)
+ (mapc
+ (lambda (x)
+ (when (not (zerop (length (car x))))
+ (cond
+ ((char-equal ?d (string-to-char (nth 1 x)))
+ (setcar x (concat (car x) "/")))
+ ((char-equal ?x (string-to-char (nth 1 x)))
+ (setcar x (concat (car x) "*"))))))
+ entries))
+
+ ;; Print entries.
(mapc
(lambda (x)
- (when (not (zerop (length (car x))))
- (cond
- ((char-equal ?d (string-to-char (nth 1 x)))
- (setcar x (concat (car x) "/")))
- ((char-equal ?x (string-to-char (nth 1 x)))
- (setcar x (concat (car x) "*"))))))
- entries))
-
- ;; Print entries.
- (mapc
- (lambda (x)
- (when (not (zerop (length (nth 0 x))))
- (when (string-match "l" switches)
- (let ((attr
- (when (tramp-smb-get-stat-capability v)
- (ignore-errors
- (file-attributes filename 'string)))))
+ (when (not (zerop (length (nth 0 x))))
+ (when (string-match "l" switches)
+ (let ((attr
+ (when (tramp-smb-get-stat-capability v)
+ (ignore-errors
+ (file-attributes filename 'string)))))
+ (insert
+ (format
+ "%10s %3d %-8s %-8s %8s %s "
+ (or (nth 8 attr) (nth 1 x)) ; mode
+ (or (nth 1 attr) 1) ; inode
+ (or (nth 2 attr) "nobody") ; uid
+ (or (nth 3 attr) "nogroup") ; gid
+ (or (nth 7 attr) (nth 2 x)) ; size
+ (format-time-string
+ (if (tramp-time-less-p
+ (tramp-time-subtract (current-time) (nth 3 x))
+ tramp-half-a-year)
+ "%b %e %R"
+ "%b %e %Y")
+ (nth 3 x)))))) ; date
+
+ ;; We mark the file name. The inserted name could be
+ ;; from somewhere else, so we use the relative file name
+ ;; of `default-directory'.
+ (let ((start (point)))
(insert
(format
- "%10s %3d %-8s %-8s %8s %s "
- (or (nth 8 attr) (nth 1 x)) ; mode
- (or (nth 1 attr) 1) ; inode
- (or (nth 2 attr) "nobody") ; uid
- (or (nth 3 attr) "nogroup") ; gid
- (or (nth 7 attr) (nth 2 x)) ; size
- (format-time-string
- (if (tramp-time-less-p
- (tramp-time-subtract (current-time) (nth 3 x))
- tramp-half-a-year)
- "%b %e %R"
- "%b %e %Y")
- (nth 3 x)))))) ; date
-
- ;; We mark the file name. The inserted name could be
- ;; from somewhere else, so we use the relative file name
- ;; of `default-directory'.
- (let ((start (point)))
- (insert
- (format
- "%s\n"
- (file-relative-name
- (expand-file-name
- (nth 0 x) (file-name-directory filename))
- (when full-directory-p (file-name-directory filename)))))
- (put-text-property start (1- (point)) 'dired-filename t))
- (forward-line)
- (beginning-of-line)))
- entries)))))
+ "%s\n"
+ (file-relative-name
+ (expand-file-name
+ (nth 0 x) (file-name-directory filename))
+ (when full-directory-p (file-name-directory filename)))))
+ (put-text-property start (1- (point)) 'dired-filename t))
+ (forward-line)
+ (beginning-of-line)))
+ entries))))))
(defun tramp-smb-handle-make-directory (dir &optional parents)
"Like `make-directory' for Tramp files."
@@ -1277,6 +1278,8 @@ target of the symlink differ."
;; We must also flush the cache of the directory, because
;; `file-attributes' reads the values from there.
+ (tramp-flush-file-property v1 (file-name-directory v1-localname))
+ (tramp-flush-file-property v1 v1-localname)
(tramp-flush-file-property v2 (file-name-directory v2-localname))
(tramp-flush-file-property v2 v2-localname)
(unless (tramp-smb-get-share v2)
@@ -1349,7 +1352,7 @@ target of the symlink differ."
;; Use an asynchronous processes. By this, password can
;; be handled.
(let ((p (apply
- 'start-process-shell-command
+ 'start-process
(tramp-get-connection-name v)
(tramp-get-connection-buffer v)
tramp-smb-acl-program args)))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 9a97d824528..17259c69159 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -240,7 +240,7 @@ pair of the form (KEY VALUE). The following KEYs are defined:
tamper the process output.
* `tramp-copy-program'
This specifies the name of the program to use for remotely copying
- the file; this might be the absolute filename of rcp or the name of
+ the file; this might be the absolute filename of scp or the name of
a workalike program. It is always applied on the local host.
* `tramp-copy-args'
This specifies the list of parameters to pass to the above mentioned
@@ -248,6 +248,13 @@ pair of the form (KEY VALUE). The following KEYs are defined:
* `tramp-copy-env'
A list of environment variables and their values, which will
be set when calling `tramp-copy-program'.
+ * `tramp-remote-copy-program'
+ The listener program to be applied on remote side, if needed.
+ * `tramp-remote-copy-args'
+ The list of parameters to pass to the listener program, the hints
+ for `tramp-login-args' also apply here. Additionally, \"%r\" could
+ be used here and in `tramp-copy-args'. It denotes a randomly
+ chosen port for the remote listener.
* `tramp-copy-keep-date'
This specifies whether the copying program when the preserves the
timestamp of the original file.
@@ -275,7 +282,7 @@ pair of the form (KEY VALUE). The following KEYs are defined:
What does all this mean? Well, you should specify `tramp-login-program'
for all methods; this program is used to log in to the remote site. Then,
there are two ways to actually transfer the files between the local and the
-remote side. One way is using an additional rcp-like program. If you want
+remote side. One way is using an additional scp-like program. If you want
to do this, set `tramp-copy-program' in the method.
Another possibility for file transfer is inline transfer, i.e. the
@@ -1762,7 +1769,7 @@ Example:
(and (memq system-type '(cygwin windows-nt))
(zerop
(tramp-call-process
- "reg" nil nil nil "query" (nth 1 (car v)))))
+ v "reg" nil nil nil "query" (nth 1 (car v)))))
;; Configuration file.
(file-exists-p (nth 1 (car v)))))
(setq r (delete (car v) r)))
@@ -2816,7 +2823,7 @@ User is always nil."
(if (memq system-type '(windows-nt))
(with-temp-buffer
(when (zerop (tramp-call-process
- "reg" nil t nil "query" registry-or-dirname))
+ nil "reg" nil t nil "query" registry-or-dirname))
(goto-char (point-min))
(loop while (not (eobp)) collect
(tramp-parse-putty-group registry-or-dirname))))
@@ -2895,7 +2902,7 @@ User is always nil."
(defun tramp-handle-file-accessible-directory-p (filename)
"Like `file-accessible-directory-p' for Tramp files."
(and (file-directory-p filename)
- (file-executable-p filename)))
+ (file-readable-p filename)))
(defun tramp-handle-file-exists-p (filename)
"Like `file-exists-p' for Tramp files."
@@ -2991,8 +2998,6 @@ User is always nil."
(with-parsed-tramp-file-name filename nil
(let ((x (car (file-attributes filename))))
(when (stringp x)
- ;; When Tramp is running on VMS, then `file-name-absolute-p'
- ;; might do weird things.
(if (file-name-absolute-p x)
(tramp-make-tramp-file-name method user host x)
x)))))
@@ -3333,8 +3338,9 @@ User is always nil."
(defun tramp-handle-unhandled-file-name-directory (_filename)
"Like `unhandled-file-name-directory' for Tramp files."
;; With Emacs 23, we could simply return `nil'. But we must keep it
- ;; for backward compatibility.
- (expand-file-name "~/"))
+ ;; for backward compatibility. "~/" cannot be returned, because
+ ;; there might be machines without a HOME directory (like hydra).
+ "/")
(defun tramp-handle-set-visited-file-modtime (&optional time-list)
"Like `set-visited-file-modtime' for Tramp files."
@@ -3905,7 +3911,7 @@ be granted."
(tramp-get-file-property
vec (tramp-file-name-localname vec)
(concat "file-attributes-" suffix) nil)
- (file-attributes
+ (tramp-compat-file-attributes
(tramp-make-tramp-file-name
(tramp-file-name-method vec)
(tramp-file-name-user vec)
@@ -4117,18 +4123,34 @@ ALIST is of the form ((FROM . TO) ...)."
;;; Compatibility functions section:
(defun tramp-call-process
- (program &optional infile destination display &rest args)
+ (vec program &optional infile destination display &rest args)
"Calls `call-process' on the local host.
-This is needed because for some Emacs flavors Tramp has
-defadvised `call-process' to behave like `process-file'. The
-Lisp error raised when PROGRAM is nil is trapped also, returning 1.
-Furthermore, traces are written with verbosity of 6."
- (tramp-message
- (vector tramp-current-method tramp-current-user tramp-current-host nil nil)
- 6 "`%s %s' %s %s" program (mapconcat 'identity args " ") infile destination)
- (if (executable-find program)
- (apply 'call-process program infile destination display args)
- 1))
+It always returns a return code. The Lisp error raised when
+PROGRAM is nil is trapped also, returning 1. Furthermore, traces
+are written with verbosity of 6."
+ (let ((v (or vec
+ (vector tramp-current-method tramp-current-user
+ tramp-current-host nil nil)))
+ (destination (if (eq destination t) (current-buffer) destination))
+ result)
+ (tramp-message
+ v 6 "`%s %s' %s %s"
+ program (mapconcat 'identity args " ") infile destination)
+ (condition-case err
+ (with-temp-buffer
+ (setq result
+ (apply
+ 'call-process program infile (or destination t) display args))
+ ;; `result' could also be an error string.
+ (when (stringp result)
+ (signal 'file-error (list result)))
+ (with-current-buffer
+ (if (bufferp destination) destination (current-buffer))
+ (tramp-message v 6 "%d\n%s" result (buffer-string))))
+ (error
+ (setq result 1)
+ (tramp-message v 6 "%d\n%s" result (error-message-string err))))
+ result))
;;;###tramp-autoload
(defun tramp-read-passwd (proc &optional prompt)
diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el
index 1ee6e6ad025..065c3f33ebe 100644
--- a/lisp/net/trampver.el
+++ b/lisp/net/trampver.el
@@ -24,14 +24,14 @@
;;; Code:
-;; In the Tramp CVS repository, the version number and the bug report
+;; In the Tramp GIT repository, the version number and the bug report
;; address are auto-frobbed from configure.ac, so you should edit that
;; file and run "autoconf && ./configure" to change them. (X)Emacs
;; version check is defined in macro AC_EMACS_INFO of aclocal.m4;
;; should be changed only there.
;;;###tramp-autoload
-(defconst tramp-version "2.2.9-24.4"
+(defconst tramp-version "2.2.11-pre"
"This version of Tramp.")
;;;###tramp-autoload
@@ -44,7 +44,7 @@
(= emacs-major-version 21)
(>= emacs-minor-version 4)))
"ok"
- (format "Tramp 2.2.9-24.4 is not fit for %s"
+ (format "Tramp 2.2.11-pre is not fit for %s"
(when (string-match "^.*$" (emacs-version))
(match-string 0 (emacs-version)))))))
(unless (string-match "\\`ok\\'" x) (error "%s" x)))
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-22 20:54:08 +0000