]> code.delx.au - gnu-emacs/blobdiff - lisp/net/tramp-smb.el
Doc fixes and refactorings based on comments from Eli Zaretskii
[gnu-emacs] / lisp / net / tramp-smb.el
index e322b6764a11d270acf45eb86e475f375a074ee9..2a38b0ef2f9bac5ddfe02944be12e27477920dec 100644 (file)
@@ -1,6 +1,6 @@
 ;;; tramp-smb.el --- Tramp access functions for SMB servers
 
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2016 Free Software Foundation, Inc.
 
 ;; Author: Michael Albinus <michael.albinus@gmx.de>
 ;; Keywords: comm, processes
     tramp-smb-method
     '((tramp-parse-netrc "~/.netrc"))))
 
+;;;###tramp-autoload
 (defcustom tramp-smb-program "smbclient"
   "Name of SMB client to run."
   :group 'tramp
   :type 'string)
 
+;;;###tramp-autoload
 (defcustom tramp-smb-acl-program "smbcacls"
   "Name of SMB acls to run."
   :group 'tramp
   :type 'string
   :version "24.4")
 
+;;;###tramp-autoload
 (defcustom tramp-smb-conf "/dev/null"
   "Path of the smb.conf file.
 If it is nil, no smb.conf will be added to the `tramp-smb-program'
@@ -221,7 +224,6 @@ See `tramp-actions-before-shell' for more info.")
     (directory-files . tramp-smb-handle-directory-files)
     (directory-files-and-attributes
      . tramp-handle-directory-files-and-attributes)
-    (dired-call-process . ignore)
     (dired-compress-file . ignore)
     (dired-uncache . tramp-handle-dired-uncache)
     (expand-file-name . tramp-smb-handle-expand-file-name)
@@ -229,10 +231,10 @@ See `tramp-actions-before-shell' for more info.")
     (file-acl . tramp-smb-handle-file-acl)
     (file-attributes . tramp-smb-handle-file-attributes)
     (file-directory-p .  tramp-smb-handle-file-directory-p)
-    ;; `file-equal-p' performed by default handler.
+    (file-file-equal-p . tramp-handle-file-equal-p)
     (file-executable-p . tramp-handle-file-exists-p)
     (file-exists-p . tramp-handle-file-exists-p)
-    ;; `file-in-directory-p' performed by default handler.
+    (file-in-directory-p . tramp-handle-file-in-directory-p)
     (file-local-copy . tramp-smb-handle-file-local-copy)
     (file-modes . tramp-handle-file-modes)
     (file-name-all-completions . tramp-smb-handle-file-name-all-completions)
@@ -244,6 +246,7 @@ See `tramp-actions-before-shell' for more info.")
     (file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
     (file-notify-add-watch . tramp-handle-file-notify-add-watch)
     (file-notify-rm-watch . tramp-handle-file-notify-rm-watch)
+    (file-notify-valid-p . tramp-handle-file-notify-valid-p)
     (file-ownership-preserved-p . ignore)
     (file-readable-p . tramp-handle-file-exists-p)
     (file-regular-p . tramp-handle-file-regular-p)
@@ -272,7 +275,7 @@ See `tramp-actions-before-shell' for more info.")
     (shell-command . tramp-handle-shell-command)
     (start-file-process . tramp-smb-handle-start-file-process)
     (substitute-in-file-name . tramp-smb-handle-substitute-in-file-name)
-    (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory)
+    (unhandled-file-name-directory . ignore)
     (vc-registered . ignore)
     (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
     (write-region . tramp-smb-handle-write-region))
@@ -280,6 +283,7 @@ See `tramp-actions-before-shell' for more info.")
 Operations not mentioned here will be handled by the default Emacs primitives.")
 
 ;; Options for remote processes via winexe.
+;;;###tramp-autoload
 (defcustom tramp-smb-winexe-program "winexe"
   "Name of winexe client to run.
 If it isn't found in the local $PATH, the absolute path of winexe
@@ -288,6 +292,7 @@ shall be given.  This is needed for remote processes."
   :type 'string
   :version "24.3")
 
+;;;###tramp-autoload
 (defcustom tramp-smb-winexe-shell-command "powershell.exe"
   "Shell to be used for processes on remote machines.
 This must be Powershell V2 compatible."
@@ -295,6 +300,7 @@ This must be Powershell V2 compatible."
   :type 'string
   :version "24.3")
 
+;;;###tramp-autoload
 (defcustom tramp-smb-winexe-shell-command-switch "-file -"
   "Command switch used together with `tramp-smb-winexe-shell-command'.
 This can be used to disable echo etc."
@@ -412,12 +418,11 @@ pass to the OPERATION."
              (unwind-protect
                  (progn
                    (make-directory tmpdir)
-                   (tramp-compat-copy-directory
-                    dirname tmpdir keep-date 'parents)
-                   (tramp-compat-copy-directory
+                   (copy-directory dirname tmpdir keep-date 'parents)
+                   (copy-directory
                     (expand-file-name (file-name-nondirectory dirname) tmpdir)
                     newname keep-date parents))
-               (tramp-compat-delete-directory tmpdir 'recursive))))
+               (delete-directory tmpdir 'recursive))))
 
           ;; We can copy recursively.
           ((or t1 t2)
@@ -441,14 +446,13 @@ pass to the OPERATION."
                   (port      (tramp-file-name-port v))
                   (share     (tramp-smb-get-share v))
                   (localname (file-name-as-directory
-                              (tramp-compat-replace-regexp-in-string
+                              (replace-regexp-in-string
                                "\\\\" "/" (tramp-smb-get-localname v))))
                   (tmpdir    (make-temp-name
                               (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,15 +499,16 @@ 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) " "))
                      (tramp-set-connection-property p "vector" v)
-                     (tramp-compat-set-process-query-on-exit-flag p nil)
+                     (set-process-query-on-exit-flag p nil)
                      (tramp-process-actions p v nil tramp-smb-actions-with-tar)
 
                      (while (memq (process-status p) '(run open))
@@ -548,7 +553,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
       0 (format "Copying %s to %s" filename newname)
 
     (if (file-directory-p filename)
-       (tramp-compat-copy-directory filename newname keep-date t t)
+       (tramp-compat-copy-directory
+        filename newname keep-date 'parents 'copy-contents)
 
       (let ((tmpfile (file-local-copy filename)))
        (if tmpfile
@@ -594,7 +600,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
        (mapc
         (lambda (file)
           (if (file-directory-p file)
-              (tramp-compat-delete-directory file recursive)
+              (delete-directory file recursive)
             (delete-file file)))
         ;; We do not want to delete "." and "..".
         (directory-files
@@ -642,8 +648,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
   (directory &optional full match nosort)
   "Like `directory-files' for Tramp files."
   (let ((result (mapcar 'directory-file-name
-                       (file-name-all-completions "" directory)))
-       res)
+                       (file-name-all-completions "" directory))))
     ;; Discriminate with regexp.
     (when match
       (setq result
@@ -659,8 +664,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
     ;; Sort them if necessary.
     (unless nosort (setq result (sort result 'string-lessp)))
     ;; Remove double entries.
-    (dolist (elt result res)
-      (add-to-list 'res elt 'append))))
+    (delete-dups result)))
 
 (defun tramp-smb-handle-expand-file-name (name &optional dir)
   "Like `expand-file-name' for Tramp files."
@@ -725,7 +729,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
               (domain    (tramp-file-name-domain v))
               (port      (tramp-file-name-port v))
               (share     (tramp-smb-get-share v))
-              (localname (tramp-compat-replace-regexp-in-string
+              (localname (replace-regexp-in-string
                           "\\\\" "/" (tramp-smb-get-localname v)))
               (args      (list (concat "//" real-host "/" share) "-E")))
 
@@ -760,11 +764,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
                  (tramp-message
                   v 6 "%s" (mapconcat 'identity (process-command p) " "))
                  (tramp-set-connection-property p "vector" v)
-                 (tramp-compat-set-process-query-on-exit-flag p nil)
+                 (set-process-query-on-exit-flag p nil)
                  (tramp-process-actions p v nil tramp-smb-actions-get-acl)
                  (when (> (point-max) (point-min))
-                   (tramp-compat-funcall
-                    'substring-no-properties (buffer-string)))))
+                   (substring-no-properties (buffer-string)))))
 
            ;; Reset the transfer process properties.
            (tramp-set-connection-property v "process-name" nil)
@@ -929,101 +932,108 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
   "Like `insert-directory' for Tramp files."
   (setq filename (expand-file-name filename))
   (unless switches (setq switches ""))
+  ;; Mark trailing "/".
+  (when (and (zerop (length (file-name-nondirectory filename)))
+            (not full-directory-p))
+    (setq switches (concat switches "F")))
   (if full-directory-p
       ;; Called from `dired-add-entry'.
       (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.
+                      (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))))
-            (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
+            (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 (time-less-p (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'.
+              ;; 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)))))
+                    (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)))))
+              (beginning-of-line)))
+          entries))))))
 
 (defun tramp-smb-handle-make-directory (dir &optional parents)
   "Like `make-directory' for Tramp files."
@@ -1056,9 +1066,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
          (tramp-smb-send-command
           v
           (if (tramp-smb-get-cifs-capabilities v)
-              (format
-               "posix_mkdir \"%s\" %s"
-               file (tramp-compat-decimal-to-octal (default-file-modes)))
+              (format "posix_mkdir \"%s\" %o" file (default-file-modes))
             (format "mkdir \"%s\"" file)))
          ;; We must also flush the cache of the directory, because
          ;; `file-attributes' reads the values from there.
@@ -1217,8 +1225,8 @@ target of the symlink differ."
        (error
         (setq ret 1)))
 
-      ;; We should show the output anyway.
-      (when (and outbuf display) (display-buffer outbuf))
+      ;; We should redisplay the output.
+      (when (and display outbuf (get-buffer-window outbuf t)) (redisplay))
 
       ;; Cleanup.  We remove all file cache values for the connection,
       ;; because the remote process could have changed them.
@@ -1228,12 +1236,7 @@ target of the symlink differ."
       (unless outbuf
        (kill-buffer (tramp-get-connection-property v "process-buffer" nil)))
 
-      ;; `process-file-side-effects' has been introduced with GNU
-      ;; Emacs 23.2.  If set to `nil', no remote file will be changed
-      ;; by `program'.  If it doesn't exist, we assume its default
-      ;; value `t'.
-      (unless (and (boundp 'process-file-side-effects)
-                  (not (symbol-value 'process-file-side-effects)))
+      (unless process-file-side-effects
        (tramp-flush-directory-property v ""))
 
       ;; Return exit status.
@@ -1270,6 +1273,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)
@@ -1282,9 +1287,10 @@ target of the symlink differ."
              (tramp-error v2 'file-error "Cannot rename `%s'" filename))))
 
       ;; We must rename via copy.
-      (tramp-compat-copy-file filename newname ok-if-already-exists t t t)
+      (copy-file
+       filename newname ok-if-already-exists 'keep-time 'preserve-uid-gid)
       (if (file-directory-p filename)
-         (tramp-compat-delete-directory filename 'recursive)
+         (delete-directory filename 'recursive)
        (delete-file filename)))))
 
 (defun tramp-smb-action-set-acl (proc vec)
@@ -1311,10 +1317,10 @@ target of the symlink differ."
               (domain    (tramp-file-name-domain v))
               (port      (tramp-file-name-port v))
               (share     (tramp-smb-get-share v))
-              (localname (tramp-compat-replace-regexp-in-string
+              (localname (replace-regexp-in-string
                           "\\\\" "/" (tramp-smb-get-localname v)))
               (args      (list (concat "//" real-host "/" share) "-E" "-S"
-                               (tramp-compat-replace-regexp-in-string
+                               (replace-regexp-in-string
                                 "\n" "," acl-string))))
 
          (if (not (zerop (length real-user)))
@@ -1342,7 +1348,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)))
@@ -1350,7 +1356,7 @@ target of the symlink differ."
                  (tramp-message
                   v 6 "%s" (mapconcat 'identity (process-command p) " "))
                  (tramp-set-connection-property p "vector" v)
-                 (tramp-compat-set-process-query-on-exit-flag p nil)
+                 (set-process-query-on-exit-flag p nil)
                  (tramp-process-actions p v nil tramp-smb-actions-set-acl)
                  (goto-char (point-max))
                  (unless (re-search-backward "tramp_exit_status [0-9]+" nil t)
@@ -1373,9 +1379,7 @@ target of the symlink differ."
     (when (tramp-smb-get-cifs-capabilities v)
       (tramp-flush-file-property v localname)
       (unless (tramp-smb-send-command
-              v (format "chmod \"%s\" %s"
-                        (tramp-smb-get-localname v)
-                        (tramp-compat-decimal-to-octal mode)))
+              v (format "chmod \"%s\" %o" (tramp-smb-get-localname v) mode))
        (tramp-error
         v 'file-error "Error while changing file's mode %s" filename)))))
 
@@ -1446,9 +1450,7 @@ errors for shares like \"C$/\", which are common in Microsoft Windows."
   "Like `write-region' for Tramp files."
   (setq filename (expand-file-name filename))
   (with-parsed-tramp-file-name filename nil
-    ;; XEmacs takes a coding system as the seventh argument, not `confirm'.
-    (when (and (not (featurep 'xemacs))
-              confirm (file-exists-p filename))
+    (when (and confirm (file-exists-p filename))
       (unless (y-or-n-p (format "File %s exists; overwrite anyway? "
                                filename))
        (tramp-error v 'file-error "File not overwritten")))
@@ -1561,10 +1563,6 @@ Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)."
          ;; Add directory itself.
          (push '("" "drwxrwxrwx" 0 (0 0)) res)
 
-         ;; There's a very strange error (debugged with XEmacs 21.4.14)
-         ;; If there's no short delay, it returns nil.  No idea about.
-         (when (featurep 'xemacs) (sleep-for 0.01))
-
          ;; Return entries.
          (delq nil res))))))
 
@@ -1724,7 +1722,7 @@ Result is the list (LOCALNAME MODE SIZE MTIME)."
                (member
                 "pathnames"
                 (split-string
-                 (buffer-substring (point) (point-at-eol)) nil t)))))))))
+                 (buffer-substring (point) (point-at-eol)) nil 'omit)))))))))
 
 (defun tramp-smb-get-stat-capability (vec)
   "Check, whether the SMB server supports the STAT command."
@@ -1864,7 +1862,7 @@ If ARGUMENT is non-nil, use it as argument for
              (tramp-message
               vec 6 "%s" (mapconcat 'identity (process-command p) " "))
              (tramp-set-connection-property p "vector" vec)
-             (tramp-compat-set-process-query-on-exit-flag p nil)
+             (set-process-query-on-exit-flag p nil)
 
              ;; Set variables for computing the prompt for reading password.
              (setq tramp-current-method tramp-smb-method