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

Tramp: sync with upstream version 2.0.39.
author Kai Großjohann <kgrossjo@eu.uu.net>
date Sun, 29 Feb 2004 17:52:17 +0000
parents 0c19f1a19b2b
children c44f9de543e3
comparison
equal deleted inserted replaced
54197:1d368b60d965 54198:c1bfc266f10a
1 ;;; tramp-smb.el --- Tramp access functions for SMB servers -*- coding: iso-8859-1; -*- 1 ;;; tramp-smb.el --- Tramp access functions for SMB servers -*- coding: iso-8859-1; -*-
2 2
3 ;; Copyright (C) 2002, 2003 Free Software Foundation, Inc. 3 ;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
4 4
5 ;; Author: Michael Albinus <Michael.Albinus@alcatel.de> 5 ;; Author: Michael Albinus <Michael.Albinus@alcatel.de>
6 ;; Keywords: comm, processes 6 ;; Keywords: comm, processes
7 7
8 ;; This file is part of GNU Emacs. 8 ;; This file is part of GNU Emacs.
48 (add-to-list 'tramp-methods (cons tramp-smb-method nil)) 48 (add-to-list 'tramp-methods (cons tramp-smb-method nil))
49 49
50 ;; Add a default for `tramp-default-method-alist'. Rule: If there is 50 ;; Add a default for `tramp-default-method-alist'. Rule: If there is
51 ;; a domain in USER, it must be the SMB method. 51 ;; a domain in USER, it must be the SMB method.
52 (add-to-list 'tramp-default-method-alist 52 (add-to-list 'tramp-default-method-alist
53 (list "%" "" tramp-smb-method)) 53 (list "" "%" tramp-smb-method))
54 54
55 ;; Add completion function for SMB method. 55 ;; Add completion function for SMB method.
56 (tramp-set-completion-function 56 (tramp-set-completion-function
57 tramp-smb-method 57 tramp-smb-method
58 '((tramp-parse-netrc "~/.netrc"))) 58 '((tramp-parse-netrc "~/.netrc")))
60 (defcustom tramp-smb-program "smbclient" 60 (defcustom tramp-smb-program "smbclient"
61 "*Name of SMB client to run." 61 "*Name of SMB client to run."
62 :group 'tramp 62 :group 'tramp
63 :type 'string) 63 :type 'string)
64 64
65 (defconst tramp-smb-prompt "^smb: \\S-+> " 65 (defconst tramp-smb-prompt "^smb: \\S-+> \\|^\\s-+Server\\s-+Comment$"
66 "Regexp used as prompt in smbclient.") 66 "Regexp used as prompt in smbclient.")
67 67
68 (defconst tramp-smb-errors 68 (defconst tramp-smb-errors
69 (mapconcat 69 (mapconcat
70 'identity 70 'identity
71 '(; Connection error 71 '(; Connection error
72 "Connection to \\S-+ failed" 72 "Connection to \\S-+ failed"
73 ; Samba 73 ; Samba
74 "ERRDOS"
74 "ERRSRV" 75 "ERRSRV"
75 "ERRDOS"
76 "ERRbadfile" 76 "ERRbadfile"
77 "ERRbadpw" 77 "ERRbadpw"
78 "ERRfilexists" 78 "ERRfilexists"
79 "ERRnoaccess" 79 "ERRnoaccess"
80 "ERRnomem" 80 "ERRnomem"
81 "ERRnosuchshare" 81 "ERRnosuchshare"
82 ; Windows NT 4.0, Windows 5.0 (Windows 2000), Windows 5.1 (Windows XP) 82 ; Windows NT 4.0, Windows 5.0 (Windows 2000), Windows 5.1 (Windows XP)
83 "NT_STATUS_ACCESS_DENIED" 83 "NT_STATUS_ACCESS_DENIED"
84 "NT_STATUS_ACCOUNT_LOCKED_OUT"
84 "NT_STATUS_BAD_NETWORK_NAME" 85 "NT_STATUS_BAD_NETWORK_NAME"
85 "NT_STATUS_CANNOT_DELETE" 86 "NT_STATUS_CANNOT_DELETE"
86 "NT_STATUS_LOGON_FAILURE" 87 "NT_STATUS_LOGON_FAILURE"
88 "NT_STATUS_NETWORK_ACCESS_DENIED"
87 "NT_STATUS_NO_SUCH_FILE" 89 "NT_STATUS_NO_SUCH_FILE"
88 "NT_STATUS_OBJECT_NAME_INVALID" 90 "NT_STATUS_OBJECT_NAME_INVALID"
89 "NT_STATUS_OBJECT_NAME_NOT_FOUND" 91 "NT_STATUS_OBJECT_NAME_NOT_FOUND"
90 "NT_STATUS_SHARING_VIOLATION") 92 "NT_STATUS_SHARING_VIOLATION"
93 "NT_STATUS_WRONG_PASSWORD")
91 "\\|") 94 "\\|")
92 "Regexp for possible error strings of SMB servers. 95 "Regexp for possible error strings of SMB servers.
93 Used instead of analyzing error codes of commands.") 96 Used instead of analyzing error codes of commands.")
94 97
95 (defvar tramp-smb-share nil 98 (defvar tramp-smb-share nil
99 102
100 (defvar tramp-smb-share-cache nil 103 (defvar tramp-smb-share-cache nil
101 "Caches the share names accessible to host related to the current buffer. 104 "Caches the share names accessible to host related to the current buffer.
102 This variable is local to each buffer.") 105 This variable is local to each buffer.")
103 (make-variable-buffer-local 'tramp-smb-share-cache) 106 (make-variable-buffer-local 'tramp-smb-share-cache)
104
105 (defvar tramp-smb-process-running nil
106 "Flag whether a corresponding process is still running.
107 Will be changed by corresponding `process-sentinel'.
108 This variable is local to each buffer.")
109 (make-variable-buffer-local 'tramp-smb-process-running)
110 107
111 (defvar tramp-smb-inodes nil 108 (defvar tramp-smb-inodes nil
112 "Keeps virtual inodes numbers for SMB files.") 109 "Keeps virtual inodes numbers for SMB files.")
113 110
114 ;; New handlers should be added here. 111 ;; New handlers should be added here.
450 (t (tramp-smb-time-less-p (file-attributes file2) 447 (t (tramp-smb-time-less-p (file-attributes file2)
451 (file-attributes file1))))) 448 (file-attributes file1)))))
452 449
453 (defun tramp-smb-handle-file-writable-p (filename) 450 (defun tramp-smb-handle-file-writable-p (filename)
454 "Like `file-writable-p' for tramp files." 451 "Like `file-writable-p' for tramp files."
455 ; (with-parsed-tramp-file-name filename nil 452 (if (not (file-exists-p filename))
456 (let (user host localname) 453 (let ((dir (file-name-directory filename)))
457 (with-parsed-tramp-file-name filename l 454 (and (file-exists-p dir)
458 (setq user l-user host l-host localname l-localname)) 455 (file-writable-p dir)))
459 (save-excursion 456 ; (with-parsed-tramp-file-name filename nil
460 (let* ((share (tramp-smb-get-share localname)) 457 (let (user host localname)
461 (file (tramp-smb-get-localname localname nil)) 458 (with-parsed-tramp-file-name filename l
462 (entries (tramp-smb-get-file-entries user host share file)) 459 (setq user l-user host l-host localname l-localname))
463 (entry (and entries 460 (save-excursion
464 (assoc (file-name-nondirectory file) entries)))) 461 (let* ((share (tramp-smb-get-share localname))
465 (and entry 462 (file (tramp-smb-get-localname localname nil))
466 (string-match "w" (nth 1 entry)) 463 (entries (tramp-smb-get-file-entries user host share file))
467 t))))) 464 (entry (and entries
465 (assoc (file-name-nondirectory file) entries))))
466 (and share entry
467 (string-match "w" (nth 1 entry))
468 t))))))
468 469
469 (defun tramp-smb-handle-insert-directory 470 (defun tramp-smb-handle-insert-directory
470 (filename switches &optional wildcard full-directory-p) 471 (filename switches &optional wildcard full-directory-p)
471 "Like `insert-directory' for tramp files. 472 "Like `insert-directory' for tramp files.
472 WILDCARD and FULL-DIRECTORY-P are not handled." 473 WILDCARD and FULL-DIRECTORY-P are not handled."
731 (when entry (add-to-list 'res entry)))) 732 (when entry (add-to-list 'res entry))))
732 (unless share 733 (unless share
733 ;; Cache share entries 734 ;; Cache share entries
734 (setq tramp-smb-share-cache res))) 735 (setq tramp-smb-share-cache res)))
735 736
736
737 ;; Add directory itself 737 ;; Add directory itself
738 (add-to-list 'res '("" "dr-xr-xr-x" 0 (0 0))) 738 (add-to-list 'res '("" "drwxrwxrwx" 0 (0 0)))
739
740 ;; There's a very strange error (debugged with XEmacs 21.4.14)
741 ;; If there's no short delay, it returns nil. No idea about
742 (when (featurep 'xemacs) (sleep-for 0.01))
739 743
740 ;; Check for matching entries 744 ;; Check for matching entries
741 (delq nil (mapcar 745 (delq nil (mapcar
742 (lambda (x) (and (string-match base (nth 0 x)) x)) 746 (lambda (x) (and (string-match base (nth 0 x)) x))
743 res)))))) 747 res))))))
911 915
912 (defun tramp-smb-maybe-open-connection (user host share) 916 (defun tramp-smb-maybe-open-connection (user host share)
913 "Maybe open a connection to HOST, logging in as USER, using `tramp-smb-program'. 917 "Maybe open a connection to HOST, logging in as USER, using `tramp-smb-program'.
914 Does not do anything if a connection is already open, but re-opens the 918 Does not do anything if a connection is already open, but re-opens the
915 connection if a previous connection has died for some reason." 919 connection if a previous connection has died for some reason."
916 (let ((p (get-buffer-process 920 (let ((process-connection-type tramp-process-connection-type)
921 (p (get-buffer-process
917 (tramp-get-buffer nil tramp-smb-method user host)))) 922 (tramp-get-buffer nil tramp-smb-method user host))))
918 (save-excursion 923 (save-excursion
919 (set-buffer (tramp-get-buffer nil tramp-smb-method user host)) 924 (set-buffer (tramp-get-buffer nil tramp-smb-method user host))
920 ;; Check whether it is still the same share 925 ;; Check whether it is still the same share
921 (unless (and p (processp p) (string-equal tramp-smb-share share)) 926 (unless (and p (processp p) (string-equal tramp-smb-share share))
985 tramp-smb-program args))) 990 tramp-smb-program args)))
986 991
987 (tramp-message 9 "Started process %s" (process-command p)) 992 (tramp-message 9 "Started process %s" (process-command p))
988 (process-kill-without-query p) 993 (process-kill-without-query p)
989 (set-buffer buffer) 994 (set-buffer buffer)
990 (set-process-sentinel 995 (setq tramp-smb-share share)
991 p (lambda (proc str) (setq tramp-smb-process-running nil)))
992 ; If no share is given, the process will terminate
993 (setq tramp-smb-process-running share
994 tramp-smb-share share)
995 996
996 ; send password 997 ; send password
997 (when real-user 998 (when real-user
998 (let ((pw-prompt "Password:")) 999 (let ((pw-prompt "Password:"))
999 (tramp-message 9 "Sending password") 1000 (tramp-message 9 "Sending password")
1000 (tramp-enter-password p pw-prompt))) 1001 (tramp-enter-password p pw-prompt)))
1001 1002
1002 (unless (tramp-smb-wait-for-output user host) 1003 (unless (tramp-smb-wait-for-output user host)
1004 (tramp-clear-passwd user host)
1003 (error "Cannot open connection //%s@%s/%s" 1005 (error "Cannot open connection //%s@%s/%s"
1004 user host (or share ""))))))) 1006 user host (or share "")))))))
1005 1007
1006 ;; We don't use timeouts. If needed, the caller shall wrap around. 1008 ;; We don't use timeouts. If needed, the caller shall wrap around.
1007 (defun tramp-smb-wait-for-output (user host) 1009 (defun tramp-smb-wait-for-output (user host)
1008 "Wait for output from smbclient command. 1010 "Wait for output from smbclient command.
1009 Sets position to begin of buffer.
1010 Returns nil if an error message has appeared." 1011 Returns nil if an error message has appeared."
1011 (save-excursion 1012 (let ((proc (get-buffer-process (current-buffer)))
1012 (let ((proc (get-buffer-process (current-buffer))) 1013 (found (progn (goto-char (point-min))
1013 (found (progn (goto-char (point-max)) 1014 (re-search-forward tramp-smb-prompt nil t)))
1014 (beginning-of-line) 1015 (err (progn (goto-char (point-min))
1015 (looking-at tramp-smb-prompt))) 1016 (re-search-forward tramp-smb-errors nil t))))
1016 err) 1017
1017 (save-match-data 1018 ;; Algorithm: get waiting output. See if last line contains
1018 ;; Algorithm: get waiting output. See if last line contains 1019 ;; tramp-smb-prompt sentinel or tramp-smb-errors strings.
1019 ;; tramp-smb-prompt sentinel, or process has exited. 1020 ;; If not, wait a bit and again get waiting output.
1020 ;; If not, wait a bit and again get waiting output. 1021 (while (and (not found) (not err))
1021 (while (and (not found) tramp-smb-process-running) 1022
1022 (accept-process-output proc) 1023 ;; Accept pending output.
1023 (goto-char (point-max)) 1024 (accept-process-output proc)
1024 (beginning-of-line) 1025
1025 (setq found (looking-at tramp-smb-prompt))) 1026 ;; Search for prompt.
1026
1027 ;; There might be pending output. If tramp-smb-prompt sentinel
1028 ;; hasn't been found, the process has died already. We should
1029 ;; give it a chance.
1030 (when (not found) (accept-process-output nil 1))
1031
1032 ;; Search for errors.
1033 (goto-char (point-min))
1034 (setq err (re-search-forward tramp-smb-errors nil t)))
1035
1036 ;; Add output to debug buffer if appropriate.
1037 (when tramp-debug-buffer
1038 (append-to-buffer
1039 (tramp-get-debug-buffer nil tramp-smb-method user host)
1040 (point-min) (point-max))
1041 (when (and (not found) tramp-smb-process-running)
1042 (save-excursion
1043 (set-buffer
1044 (tramp-get-debug-buffer nil tramp-smb-method user host))
1045 (goto-char (point-max))
1046 (insert (format "[[Remote prompt `%s' not found]]\n"
1047 tramp-smb-prompt)))))
1048 (goto-char (point-min)) 1027 (goto-char (point-min))
1049 ;; Return value is whether no error message has appeared. 1028 (setq found (re-search-forward tramp-smb-prompt nil t))
1050 (not err)))) 1029
1030 ;; Search for errors.
1031 (goto-char (point-min))
1032 (setq err (re-search-forward tramp-smb-errors nil t)))
1033
1034 ;; Add output to debug buffer if appropriate.
1035 (when tramp-debug-buffer
1036 (append-to-buffer
1037 (tramp-get-debug-buffer nil tramp-smb-method user host)
1038 (point-min) (point-max)))
1039
1040 ;; Return value is whether no error message has appeared.
1041 (not err)))
1051 1042
1052 1043
1053 ;; Snarfed code from time-date.el and parse-time.el 1044 ;; Snarfed code from time-date.el and parse-time.el
1054 1045
1055 (defconst tramp-smb-half-a-year '(241 17024) 1046 (defconst tramp-smb-half-a-year '(241 17024)
1123 ;;; TODO: 1114 ;;; TODO:
1124 1115
1125 ;; * Provide a local smb.conf. The default one might not be readable. 1116 ;; * Provide a local smb.conf. The default one might not be readable.
1126 ;; * Error handling in case password is wrong. 1117 ;; * Error handling in case password is wrong.
1127 ;; * Read password from "~/.netrc". 1118 ;; * Read password from "~/.netrc".
1128 ;; * Use different buffers for different shares. By this, the password
1129 ;; won't be requested again when changing shares on the same host.
1130 ;; * Return more comprehensive file permission string. Think whether it is 1119 ;; * Return more comprehensive file permission string. Think whether it is
1131 ;; possible to implement `set-file-modes'. 1120 ;; possible to implement `set-file-modes'.
1132 ;; * Handle WILDCARD and FULL-DIRECTORY-P in 1121 ;; * Handle WILDCARD and FULL-DIRECTORY-P in
1133 ;; `tramp-smb-handle-insert-directory'. 1122 ;; `tramp-smb-handle-insert-directory'.
1134 ;; * Handle links (FILENAME.LNK). 1123 ;; * Handle links (FILENAME.LNK).