/[emacs]/emacs/lisp/net/tramp-smb.el
ViewVC logotype

Diff of /emacs/lisp/net/tramp-smb.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.15 by kfstorm, Wed Feb 9 15:50:37 2005 UTC revision 1.16 by albinus, Sun Mar 20 20:00:20 2005 UTC
# Line 1  Line 1 
1  ;;; tramp-smb.el --- Tramp access functions for SMB servers -*- coding: iso-8859-1; -*-  ;;; tramp-smb.el --- Tramp access functions for SMB servers -*- coding: iso-8859-1; -*-
2    
3  ;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.  ;; Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
4    
5  ;; Author: Michael Albinus <Michael.Albinus@alcatel.de>  ;; Author: Michael Albinus <michael.albinus@gmx.de>
6  ;; Keywords: comm, processes  ;; Keywords: comm, processes
7    
8  ;; This file is part of GNU Emacs.  ;; This file is part of GNU Emacs.
# Line 75  Line 75 
75    :group 'tramp    :group 'tramp
76    :type 'string)    :type 'string)
77    
78  (defconst tramp-smb-prompt "^smb: \\S-+> \\|^\\s-+Server\\s-+Comment$"  (defconst tramp-smb-prompt "^smb: .+> \\|^\\s-+Server\\s-+Comment$"
79    "Regexp used as prompt in smbclient.")    "Regexp used as prompt in smbclient.")
80    
81  (defconst tramp-smb-errors  (defconst tramp-smb-errors
# Line 235  KEEP-DATE is not handled in case NEWNAME Line 235  KEEP-DATE is not handled in case NEWNAME
235                   (file-exists-p newname))                   (file-exists-p newname))
236          (error "copy-file: file %s already exists" newname))          (error "copy-file: file %s already exists" newname))
237    
238  ;      (with-parsed-tramp-file-name newname nil        (with-parsed-tramp-file-name newname nil
       (let (user host localname)  
         (with-parsed-tramp-file-name newname l  
           (setq user l-user host l-host localname l-localname))  
239          (save-excursion          (save-excursion
240            (let ((share (tramp-smb-get-share localname))            (let ((share (tramp-smb-get-share localname))
241                  (file (tramp-smb-get-localname localname t)))                  (file (tramp-smb-get-localname localname t)))
# Line 258  KEEP-DATE is not handled in case NEWNAME Line 255  KEEP-DATE is not handled in case NEWNAME
255  (defun tramp-smb-handle-delete-directory (directory)  (defun tramp-smb-handle-delete-directory (directory)
256    "Like `delete-directory' for tramp files."    "Like `delete-directory' for tramp files."
257    (setq directory (directory-file-name (expand-file-name directory)))    (setq directory (directory-file-name (expand-file-name directory)))
258    (unless (file-exists-p directory)    (when (file-exists-p directory)
259      (error "Cannot delete non-existing directory `%s'" directory))      (with-parsed-tramp-file-name directory nil
260  ;  (with-parsed-tramp-file-name directory nil        (save-excursion
261    (let (user host localname)          (let ((share (tramp-smb-get-share localname))
262      (with-parsed-tramp-file-name directory l                (dir (tramp-smb-get-localname (file-name-directory localname) t))
263        (setq user l-user host l-host localname l-localname))                (file (file-name-nondirectory localname)))
264      (save-excursion            (tramp-smb-maybe-open-connection user host share)
265        (let ((share (tramp-smb-get-share localname))            (if (and
266              (dir (tramp-smb-get-localname (file-name-directory localname) t))                 (tramp-smb-send-command user host (format "cd \"%s\"" dir))
267              (file (file-name-nondirectory localname)))                 (tramp-smb-send-command user host (format "rmdir \"%s\"" file)))
268          (tramp-smb-maybe-open-connection user host share)                ;; Go Home
269          (if (and                (tramp-smb-send-command user host (format "cd \\"))
270               (tramp-smb-send-command user host (format "cd \"%s\"" dir))              ;; Error
              (tramp-smb-send-command user host (format "rmdir \"%s\"" file)))  
             ;; Go Home  
271              (tramp-smb-send-command user host (format "cd \\"))              (tramp-smb-send-command user host (format "cd \\"))
272            ;; Error              (error "Cannot delete directory `%s'" directory)))))))
           (tramp-smb-send-command user host (format "cd \\"))  
           (error "Cannot delete directory `%s'" directory))))))  
273    
274  (defun tramp-smb-handle-delete-file (filename)  (defun tramp-smb-handle-delete-file (filename)
275    "Like `delete-file' for tramp files."    "Like `delete-file' for tramp files."
276    (setq filename (expand-file-name filename))    (setq filename (expand-file-name filename))
277    (unless (file-exists-p filename)    (when (file-exists-p filename)
278      (error "Cannot delete non-existing file `%s'" filename))      (with-parsed-tramp-file-name filename nil
279  ;  (with-parsed-tramp-file-name filename nil        (save-excursion
280    (let (user host localname)          (let ((share (tramp-smb-get-share localname))
281      (with-parsed-tramp-file-name filename l                (dir (tramp-smb-get-localname (file-name-directory localname) t))
282        (setq user l-user host l-host localname l-localname))                (file (file-name-nondirectory localname)))
283      (save-excursion            (tramp-smb-maybe-open-connection user host share)
284        (let ((share (tramp-smb-get-share localname))            (if (and
285              (dir (tramp-smb-get-localname (file-name-directory localname) t))                 (tramp-smb-send-command user host (format "cd \"%s\"" dir))
286              (file (file-name-nondirectory localname)))                 (tramp-smb-send-command user host (format "rm \"%s\"" file)))
287          (unless (file-exists-p filename)                ;; Go Home
288            (error "Cannot delete non-existing file `%s'" filename))                (tramp-smb-send-command user host (format "cd \\"))
289          (tramp-smb-maybe-open-connection user host share)              ;; Error
         (if (and  
              (tramp-smb-send-command user host (format "cd \"%s\"" dir))  
              (tramp-smb-send-command user host (format "rm \"%s\"" file)))  
             ;; Go Home  
290              (tramp-smb-send-command user host (format "cd \\"))              (tramp-smb-send-command user host (format "cd \\"))
291            ;; Error              (error "Cannot delete file `%s'" filename)))))))
           (tramp-smb-send-command user host (format "cd \\"))  
           (error "Cannot delete file `%s'" filename))))))  
292    
293  (defun tramp-smb-handle-directory-files  (defun tramp-smb-handle-directory-files
294    (directory &optional full match nosort)    (directory &optional full match nosort)
295    "Like `directory-files' for tramp files."    "Like `directory-files' for tramp files."
296    (setq directory (directory-file-name (expand-file-name directory)))    (setq directory (directory-file-name (expand-file-name directory)))
297  ;  (with-parsed-tramp-file-name directory nil    (with-parsed-tramp-file-name directory nil
   (let (user host localname)  
     (with-parsed-tramp-file-name directory l  
       (setq user l-user host l-host localname l-localname))  
298      (save-excursion      (save-excursion
299        (let* ((share (tramp-smb-get-share localname))        (let* ((share (tramp-smb-get-share localname))
300               (file (tramp-smb-get-localname localname nil))               (file (tramp-smb-get-localname localname nil))
# Line 340  KEEP-DATE is not handled in case NEWNAME Line 324  KEEP-DATE is not handled in case NEWNAME
324    (mapcar    (mapcar
325     (lambda (x)     (lambda (x)
326       ;; We cannot call `file-attributes' for backward compatibility reasons.       ;; We cannot call `file-attributes' for backward compatibility reasons.
327       ;; Its optional parameter ID-FORMAT is introduced with Emacs 22.1.       ;; Its optional parameter ID-FORMAT is introduced with Emacs 22.
328       (cons x (tramp-smb-handle-file-attributes       (cons x (tramp-smb-handle-file-attributes
329          (if full x (concat (file-name-as-directory directory) x)) id-format)))          (if full x (concat (file-name-as-directory directory) x)) id-format)))
330     (directory-files directory full match nosort)))     (directory-files directory full match nosort)))
331    
332  (defun tramp-smb-handle-file-attributes (filename &optional id-format)  (defun tramp-smb-handle-file-attributes (filename &optional id-format)
333    "Like `file-attributes' for tramp files."    "Like `file-attributes' for tramp files."
334  ;  (with-parsed-tramp-file-name filename nil    (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))  
335      (save-excursion      (save-excursion
336        (let* ((share (tramp-smb-get-share localname))        (let* ((share (tramp-smb-get-share localname))
337               (file (tramp-smb-get-localname localname nil))               (file (tramp-smb-get-localname localname nil))
# Line 380  KEEP-DATE is not handled in case NEWNAME Line 361  KEEP-DATE is not handled in case NEWNAME
361    
362  (defun tramp-smb-handle-file-directory-p (filename)  (defun tramp-smb-handle-file-directory-p (filename)
363    "Like `file-directory-p' for tramp files."    "Like `file-directory-p' for tramp files."
364  ;  (with-parsed-tramp-file-name filename nil    (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))  
365      (save-excursion      (save-excursion
366        (let* ((share (tramp-smb-get-share localname))        (let* ((share (tramp-smb-get-share localname))
367               (file (tramp-smb-get-localname localname nil))               (file (tramp-smb-get-localname localname nil))
# Line 396  KEEP-DATE is not handled in case NEWNAME Line 374  KEEP-DATE is not handled in case NEWNAME
374    
375  (defun tramp-smb-handle-file-exists-p (filename)  (defun tramp-smb-handle-file-exists-p (filename)
376    "Like `file-exists-p' for tramp files."    "Like `file-exists-p' for tramp files."
377  ;  (with-parsed-tramp-file-name filename nil    (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))  
378      (save-excursion      (save-excursion
379        (let* ((share (tramp-smb-get-share localname))        (let* ((share (tramp-smb-get-share localname))
380               (file (tramp-smb-get-localname localname nil))               (file (tramp-smb-get-localname localname nil))
# Line 433  KEEP-DATE is not handled in case NEWNAME Line 408  KEEP-DATE is not handled in case NEWNAME
408  ;; files.  ;; files.
409  (defun tramp-smb-handle-file-name-all-completions (filename directory)  (defun tramp-smb-handle-file-name-all-completions (filename directory)
410    "Like `file-name-all-completions' for tramp files."    "Like `file-name-all-completions' for tramp files."
411  ;  (with-parsed-tramp-file-name directory nil    (with-parsed-tramp-file-name directory nil
   (let (user host localname)  
     (with-parsed-tramp-file-name directory l  
       (setq user l-user host l-host localname l-localname))  
412      (save-match-data      (save-match-data
413        (save-excursion        (save-excursion
414          (let* ((share (tramp-smb-get-share localname))          (let* ((share (tramp-smb-get-share localname))
# Line 467  KEEP-DATE is not handled in case NEWNAME Line 439  KEEP-DATE is not handled in case NEWNAME
439        (let ((dir (file-name-directory filename)))        (let ((dir (file-name-directory filename)))
440          (and (file-exists-p dir)          (and (file-exists-p dir)
441               (file-writable-p dir)))               (file-writable-p dir)))
442  ;    (with-parsed-tramp-file-name filename nil      (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))  
443        (save-excursion        (save-excursion
444          (let* ((share (tramp-smb-get-share localname))          (let* ((share (tramp-smb-get-share localname))
445                 (file (tramp-smb-get-localname localname nil))                 (file (tramp-smb-get-localname localname nil))
# Line 490  WILDCARD and FULL-DIRECTORY-P are not ha Line 459  WILDCARD and FULL-DIRECTORY-P are not ha
459      ;; This check is a little bit strange, but in `dired-add-entry'      ;; This check is a little bit strange, but in `dired-add-entry'
460      ;; this function is called with a non-directory ...      ;; this function is called with a non-directory ...
461      (setq filename (file-name-as-directory filename)))      (setq filename (file-name-as-directory filename)))
462  ;  (with-parsed-tramp-file-name filename nil    (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))  
463      (save-match-data      (save-match-data
464        (let* ((share (tramp-smb-get-share localname))        (let* ((share (tramp-smb-get-share localname))
465               (file (tramp-smb-get-localname localname nil))               (file (tramp-smb-get-localname localname nil))
# Line 543  WILDCARD and FULL-DIRECTORY-P are not ha Line 509  WILDCARD and FULL-DIRECTORY-P are not ha
509    (setq dir (directory-file-name (expand-file-name dir)))    (setq dir (directory-file-name (expand-file-name dir)))
510    (unless (file-name-absolute-p dir)    (unless (file-name-absolute-p dir)
511      (setq dir (concat default-directory dir)))      (setq dir (concat default-directory dir)))
512  ;  (with-parsed-tramp-file-name dir nil    (with-parsed-tramp-file-name dir nil
   (let  (user host localname)  
     (with-parsed-tramp-file-name dir l  
       (setq user l-user host l-host localname l-localname))  
513      (save-match-data      (save-match-data
514        (let* ((share (tramp-smb-get-share localname))        (let* ((share (tramp-smb-get-share localname))
515               (ldir (file-name-directory dir)))               (ldir (file-name-directory dir)))
# Line 564  WILDCARD and FULL-DIRECTORY-P are not ha Line 527  WILDCARD and FULL-DIRECTORY-P are not ha
527    (setq directory (directory-file-name (expand-file-name directory)))    (setq directory (directory-file-name (expand-file-name directory)))
528    (unless (file-name-absolute-p directory)    (unless (file-name-absolute-p directory)
529      (setq directory (concat default-directory directory)))      (setq directory (concat default-directory directory)))
530  ;  (with-parsed-tramp-file-name directory nil    (with-parsed-tramp-file-name directory nil
   (let  (user host localname)  
     (with-parsed-tramp-file-name directory l  
       (setq user l-user host l-host localname l-localname))  
531      (save-match-data      (save-match-data
532        (let* ((share (tramp-smb-get-share localname))        (let* ((share (tramp-smb-get-share localname))
533               (file (tramp-smb-get-localname localname nil)))               (file (tramp-smb-get-localname localname nil)))
# Line 597  WILDCARD and FULL-DIRECTORY-P are not ha Line 557  WILDCARD and FULL-DIRECTORY-P are not ha
557                   (file-exists-p newname))                   (file-exists-p newname))
558            (error "rename-file: file %s already exists" newname))            (error "rename-file: file %s already exists" newname))
559    
560  ;      (with-parsed-tramp-file-name newname nil        (with-parsed-tramp-file-name newname nil
       (let (user host localname)  
         (with-parsed-tramp-file-name newname l  
           (setq user l-user host l-host localname l-localname))  
561          (save-excursion          (save-excursion
562            (let ((share (tramp-smb-get-share localname))            (let ((share (tramp-smb-get-share localname))
563                  (file (tramp-smb-get-localname localname t)))                  (file (tramp-smb-get-localname localname t)))
# Line 636  Catches errors for shares like \"C$/\", Line 593  Catches errors for shares like \"C$/\",
593      (unless (y-or-n-p (format "File %s exists; overwrite anyway? "      (unless (y-or-n-p (format "File %s exists; overwrite anyway? "
594                                filename))                                filename))
595        (error "File not overwritten")))        (error "File not overwritten")))
596  ;  (with-parsed-tramp-file-name filename nil    (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))  
597      (save-excursion      (save-excursion
598        (let ((share (tramp-smb-get-share localname))        (let ((share (tramp-smb-get-share localname))
599              (file (tramp-smb-get-localname localname t))              (file (tramp-smb-get-localname localname t))
# Line 969  then sends the password to the remote ho Line 923  then sends the password to the remote ho
923    
924  Domain names in USER and port numbers in HOST are acknowledged."  Domain names in USER and port numbers in HOST are acknowledged."
925    
926      (when (and (fboundp 'executable-find)
927                 (not (funcall 'executable-find tramp-smb-program)))
928        (error "Cannot find command %s in %s" tramp-smb-program exec-path))
929    
930    (save-match-data    (save-match-data
931      (let* ((buffer (tramp-get-buffer nil tramp-smb-method user host))      (let* ((buffer (tramp-get-buffer nil tramp-smb-method user host))
932             (real-user user)             (real-user user)

Legend:
Removed from v.1.15  
changed lines
  Added in v.1.16

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26