Mercurial > emacs
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). |