diff lisp/net/tramp-smb.el @ 54198:c1bfc266f10a

Tramp: sync with upstream version 2.0.39.

--- a/lisp/net/tramp-smb.el	Sun Feb 29 17:13:24 2004 +0000
+++ b/lisp/net/tramp-smb.el	Sun Feb 29 17:52:17 2004 +0000
@@ -1,6 +1,6 @@
 ;;; tramp-smb.el --- Tramp access functions for SMB servers -*- coding: iso-8859-1; -*-
 
-;; Copyright (C) 2002, 2003 Free Software Foundation, Inc.
+;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
 
 ;; Author: Michael Albinus <[e-mail]>
 ;; Keywords: comm, processes
@@ -50,7 +50,7 @@
 ;; Add a default for `tramp-default-method-alist'. Rule: If there is
 ;; a domain in USER, it must be the SMB method.
 (add-to-list 'tramp-default-method-alist
-	     (list "%" "" tramp-smb-method))
+	     (list "" "%" tramp-smb-method))
 
 ;; Add completion function for SMB method.
 (tramp-set-completion-function
@@ -62,7 +62,7 @@
   :group 'tramp
   :type 'string)
 
-(defconst tramp-smb-prompt "^smb: \\S-+> "
+(defconst tramp-smb-prompt "^smb: \\S-+> \\|^\\s-+Server\\s-+Comment$"
   "Regexp used as prompt in smbclient.")
 
 (defconst tramp-smb-errors
@@ -71,8 +71,8 @@
    '(; Connection error
      "Connection to \\S-+ failed"
      ; Samba
+     "ERRDOS"
      "ERRSRV"
-     "ERRDOS"
      "ERRbadfile"
      "ERRbadpw"
      "ERRfilexists"
@@ -81,13 +81,16 @@
      "ERRnosuchshare"
      ; Windows NT 4.0, Windows 5.0 (Windows 2000), Windows 5.1 (Windows XP)
      "NT_STATUS_ACCESS_DENIED"
+     "NT_STATUS_ACCOUNT_LOCKED_OUT"
      "NT_STATUS_BAD_NETWORK_NAME"
      "NT_STATUS_CANNOT_DELETE"
      "NT_STATUS_LOGON_FAILURE"
+     "NT_STATUS_NETWORK_ACCESS_DENIED"
      "NT_STATUS_NO_SUCH_FILE"
      "NT_STATUS_OBJECT_NAME_INVALID"
      "NT_STATUS_OBJECT_NAME_NOT_FOUND"
-     "NT_STATUS_SHARING_VIOLATION")
+     "NT_STATUS_SHARING_VIOLATION"
+     "NT_STATUS_WRONG_PASSWORD")
    "\\|")
   "Regexp for possible error strings of SMB servers.
 Used instead of analyzing error codes of commands.")
@@ -102,12 +105,6 @@
 This variable is local to each buffer.")
 (make-variable-buffer-local 'tramp-smb-share-cache)
 
-(defvar tramp-smb-process-running nil
-  "Flag whether a corresponding process is still running.
-Will be changed by corresponding `process-sentinel'.
-This variable is local to each buffer.")
-(make-variable-buffer-local 'tramp-smb-process-running)
-
 (defvar tramp-smb-inodes nil
   "Keeps virtual inodes numbers for SMB files.")
 
@@ -452,19 +449,23 @@
 
 (defun tramp-smb-handle-file-writable-p (filename)
   "Like `file-writable-p' for tramp files."
-;  (with-parsed-tramp-file-name filename nil
-  (let 	(user host localname)
-    (with-parsed-tramp-file-name filename l
-      (setq user l-user host l-host localname l-localname))
-    (save-excursion
-      (let* ((share (tramp-smb-get-share localname))
-	     (file (tramp-smb-get-localname localname nil))
-	     (entries (tramp-smb-get-file-entries user host share file))
-	     (entry (and entries
-			 (assoc (file-name-nondirectory file) entries))))
-	(and entry
-	     (string-match "w" (nth 1 entry))
-	     t)))))
+  (if (not (file-exists-p filename))
+      (let ((dir (file-name-directory filename)))
+	(and (file-exists-p dir)
+	     (file-writable-p dir)))
+;    (with-parsed-tramp-file-name filename nil
+    (let (user host localname)
+      (with-parsed-tramp-file-name filename l
+	(setq user l-user host l-host localname l-localname))
+      (save-excursion
+	(let* ((share (tramp-smb-get-share localname))
+	       (file (tramp-smb-get-localname localname nil))
+	       (entries (tramp-smb-get-file-entries user host share file))
+	       (entry (and entries
+			   (assoc (file-name-nondirectory file) entries))))
+	  (and share entry
+	       (string-match "w" (nth 1 entry))
+	       t))))))
 
 (defun tramp-smb-handle-insert-directory
   (filename switches &optional wildcard full-directory-p)
@@ -733,9 +734,12 @@
 	    ;; Cache share entries
 	    (setq tramp-smb-share-cache res)))
 
+	;; Add directory itself
+	(add-to-list 'res '("" "drwxrwxrwx" 0 (0 0)))
 
-	;; Add directory itself
-	(add-to-list 'res '("" "dr-xr-xr-x" 0 (0 0)))
+	;; 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))
 
 	;; Check for matching entries
 	(delq nil (mapcar
@@ -913,7 +917,8 @@
   "Maybe open a connection to HOST, logging in as USER, using `tramp-smb-program'.
 Does not do anything if a connection is already open, but re-opens the
 connection if a previous connection has died for some reason."
-  (let ((p (get-buffer-process
+  (let ((process-connection-type tramp-process-connection-type)
+	(p (get-buffer-process
 	    (tramp-get-buffer nil tramp-smb-method user host))))
     (save-excursion
       (set-buffer (tramp-get-buffer nil tramp-smb-method user host))
@@ -987,11 +992,7 @@
 	(tramp-message 9 "Started process %s" (process-command p))
 	(process-kill-without-query p)
 	(set-buffer buffer)
-	(set-process-sentinel
-	 p (lambda (proc str) (setq tramp-smb-process-running nil)))
-	; If no share is given, the process will terminate
-	(setq tramp-smb-process-running share
-	      tramp-smb-share share)
+	(setq tramp-smb-share share)
 
         ; send password
 	(when real-user
@@ -1000,54 +1001,44 @@
 	    (tramp-enter-password p pw-prompt)))
 
 	(unless (tramp-smb-wait-for-output user host)
+	  (tramp-clear-passwd user host)
 	  (error "Cannot open connection //%s@%s/%s"
 		 user host (or share "")))))))
 
 ;; We don't use timeouts.  If needed, the caller shall wrap around.
 (defun tramp-smb-wait-for-output (user host)
   "Wait for output from smbclient command.
-Sets position to begin of buffer.
 Returns nil if an error message has appeared."
-  (save-excursion
-    (let ((proc (get-buffer-process (current-buffer)))
-	  (found (progn (goto-char (point-max))
-			(beginning-of-line)
-			(looking-at tramp-smb-prompt)))
-	  err)
-      (save-match-data
-	;; Algorithm: get waiting output.  See if last line contains
-	;; tramp-smb-prompt sentinel, or process has exited.
-	;; If not, wait a bit and again get waiting output.
-	(while (and (not found) tramp-smb-process-running)
-	  (accept-process-output proc)
-	  (goto-char (point-max))
-	  (beginning-of-line)
-	  (setq found (looking-at tramp-smb-prompt)))
+  (let ((proc (get-buffer-process (current-buffer)))
+	(found (progn (goto-char (point-min))
+		      (re-search-forward tramp-smb-prompt nil t)))
+	(err   (progn (goto-char (point-min))
+		      (re-search-forward tramp-smb-errors nil t))))
+
+    ;; Algorithm: get waiting output.  See if last line contains
+    ;; tramp-smb-prompt sentinel or tramp-smb-errors strings.
+    ;; If not, wait a bit and again get waiting output.
+    (while (and (not found) (not err))
+
+      ;; Accept pending output.
+      (accept-process-output proc)
 
-	;; There might be pending output.  If tramp-smb-prompt sentinel
-	;; hasn't been found, the process has died already.  We should
-	;; give it a chance.
-	(when (not found) (accept-process-output nil 1))
+      ;; Search for prompt.
+      (goto-char (point-min))
+      (setq found (re-search-forward tramp-smb-prompt nil t))
 
-	;; Search for errors.
-	(goto-char (point-min))
-	(setq err (re-search-forward tramp-smb-errors nil t)))
+      ;; Search for errors.
+      (goto-char (point-min))
+      (setq err (re-search-forward tramp-smb-errors nil t)))
 
-      ;; Add output to debug buffer if appropriate.
-      (when tramp-debug-buffer
-	(append-to-buffer
-	 (tramp-get-debug-buffer nil tramp-smb-method user host)
-	 (point-min) (point-max))
-	(when (and (not found) tramp-smb-process-running)
-	  (save-excursion
-	    (set-buffer
-	     (tramp-get-debug-buffer nil tramp-smb-method user host))
-	    (goto-char (point-max))
-	    (insert (format "[[Remote prompt `%s' not found]]\n"
-			    tramp-smb-prompt)))))
-      (goto-char (point-min))
-      ;; Return value is whether no error message has appeared.
-      (not err))))
+    ;; Add output to debug buffer if appropriate.
+    (when tramp-debug-buffer
+      (append-to-buffer
+       (tramp-get-debug-buffer nil tramp-smb-method user host)
+       (point-min) (point-max)))
+
+    ;; Return value is whether no error message has appeared.
+    (not err)))
 
 
 ;; Snarfed code from time-date.el and parse-time.el
@@ -1125,8 +1116,6 @@
 ;; * Provide a local smb.conf. The default one might not be readable.
 ;; * Error handling in case password is wrong.
 ;; * Read password from "~/.netrc".
-;; * Use different buffers for different shares.  By this, the password
-;;   won't be requested again when changing shares on the same host.
 ;; * Return more comprehensive file permission string.  Think whether it is
 ;;   possible to implement `set-file-modes'.
 ;; * Handle WILDCARD and FULL-DIRECTORY-P in