Mercurial > emacs

comparison lisp/net/tramp-smb.el @ 105690:8d8fc5285759

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
* net/tramp-smb.el (tramp-smb-get-stat-capability): New defun. (tramp-smb-handle-file-attributes): Use it. (tramp-smb-do-file-attributes-with-stat): Don't raise an error. (tramp-smb-handle-insert-directory): Use `mapc' rather than `mapcar'. Use `tramp-smb-get-stat-capability'. Add `dired-filename' text properties. (tramp-smb-get-cifs-capabilities): Apply `save-match-data'. (tramp-smb-maybe-open-connection): Simplify check for smbclient version.
author Michael Albinus <michael.albinus@gmx.de>
date Wed, 21 Oct 2009 11:27:26 +0000
parents 75fb0870b7e0
children d8ba90718d44
comparison
equal deleted inserted replaced
105689:d81a8bc83c5e 105690:8d8fc5285759
479 (defun tramp-smb-handle-file-attributes (filename &optional id-format) 479 (defun tramp-smb-handle-file-attributes (filename &optional id-format)
480 "Like `file-attributes' for Tramp files." 480 "Like `file-attributes' for Tramp files."
481 (unless id-format (setq id-format 'integer)) 481 (unless id-format (setq id-format 'integer))
482 (with-parsed-tramp-file-name filename nil 482 (with-parsed-tramp-file-name filename nil
483 (with-file-property v localname (format "file-attributes-%s" id-format) 483 (with-file-property v localname (format "file-attributes-%s" id-format)
484 (if (and (tramp-smb-get-share v) (tramp-smb-get-cifs-capabilities v)) 484 (if (and (tramp-smb-get-share v) (tramp-smb-get-stat-capability v))
485 (tramp-smb-do-file-attributes-with-stat v id-format) 485 (tramp-smb-do-file-attributes-with-stat v id-format)
486 ;; Reading just the filename entry via "dir localname" is not 486 ;; Reading just the filename entry via "dir localname" is not
487 ;; possible, because when filename is a directory, some 487 ;; possible, because when filename is a directory, some
488 ;; smbclient versions return the content of the directory, and 488 ;; smbclient versions return the content of the directory, and
489 ;; other versions don't. Therefore, the whole content of the 489 ;; other versions don't. Therefore, the whole content of the
517 "Implement `file-attributes' for Tramp files using stat command." 517 "Implement `file-attributes' for Tramp files using stat command."
518 (tramp-message 518 (tramp-message
519 vec 5 "file attributes with stat: %s" (tramp-file-name-localname vec)) 519 vec 5 "file attributes with stat: %s" (tramp-file-name-localname vec))
520 (with-current-buffer (tramp-get-buffer vec) 520 (with-current-buffer (tramp-get-buffer vec)
521 (let* (size id link uid gid atime mtime ctime mode inode) 521 (let* (size id link uid gid atime mtime ctime mode inode)
522 (unless 522 (when (tramp-smb-send-command
523 (tramp-smb-send-command 523 vec (format "stat \"%s\"" (tramp-smb-get-localname vec)))
524 vec (format "stat \"%s\"" (tramp-smb-get-localname vec))) 524
525 ;; Error. 525 ;; Loop the listing.
526 (with-current-buffer (tramp-get-connection-buffer vec) 526 (goto-char (point-min))
527 (goto-char (point-min)) 527 (unless (re-search-forward tramp-smb-errors nil t)
528 (search-forward-regexp tramp-smb-errors nil t) 528 (while (not (eobp))
529 (tramp-error 529 (cond
530 vec 'file-error "%s" (match-string 0)))) 530 ((looking-at
531 531 "Size:\\s-+\\([0-9]+\\)\\s-+Blocks:\\s-+[0-9]+\\s-+\\(\\w+\\)")
532 ;; Loop the listing. 532 (setq size (string-to-number (match-string 1))
533 (goto-char (point-min)) 533 id (if (string-equal "directory" (match-string 2)) t
534 (unless (re-search-forward tramp-smb-errors nil t) 534 (if (string-equal "symbolic" (match-string 2)) ""))))
535 (while (not (eobp)) 535 ((looking-at
536 (cond 536 "Inode:\\s-+\\([0-9]+\\)\\s-+Links:\\s-+\\([0-9]+\\)")
537 ((looking-at 537 (setq inode (string-to-number (match-string 1))
538 "Size:\\s-+\\([0-9]+\\)\\s-+Blocks:\\s-+[0-9]+\\s-+\\(\\w+\\)") 538 link (string-to-number (match-string 2))))
539 (setq size (string-to-number (match-string 1)) 539 ((looking-at
540 id (if (string-equal "directory" (match-string 2)) t 540 "Access:\\s-+([0-9]+/\\(\\S-+\\))\\s-+Uid:\\s-+\\([0-9]+\\)\\s-+Gid:\\s-+\\([0-9]+\\)")
541 (if (string-equal "symbolic" (match-string 2)) "")))) 541 (setq mode (match-string 1)
542 ((looking-at 542 uid (if (equal id-format 'string) (match-string 2)
543 "Inode:\\s-+\\([0-9]+\\)\\s-+Links:\\s-+\\([0-9]+\\)") 543 (string-to-number (match-string 2)))
544 (setq inode (string-to-number (match-string 1)) 544 gid (if (equal id-format 'string) (match-string 3)
545 link (string-to-number (match-string 2)))) 545 (string-to-number (match-string 3)))))
546 ((looking-at 546 ((looking-at
547 "Access:\\s-+([0-9]+/\\(\\S-+\\))\\s-+Uid:\\s-+\\([0-9]+\\)\\s-+Gid:\\s-+\\([0-9]+\\)") 547 "Access:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)")
548 (setq mode (match-string 1) 548 (setq atime
549 uid (if (equal id-format 'string) (match-string 2) 549 (encode-time
550 (string-to-number (match-string 2))) 550 (string-to-number (match-string 6)) ;; sec
551 gid (if (equal id-format 'string) (match-string 3) 551 (string-to-number (match-string 5)) ;; min
552 (string-to-number (match-string 3))))) 552 (string-to-number (match-string 4)) ;; hour
553 ((looking-at 553 (string-to-number (match-string 3)) ;; day
554 "Access:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)") 554 (string-to-number (match-string 2)) ;; month
555 (setq atime 555 (string-to-number (match-string 1))))) ;; year
556 (encode-time 556 ((looking-at
557 (string-to-number (match-string 6)) ;; sec 557 "Modify:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)")
558 (string-to-number (match-string 5)) ;; min 558 (setq mtime
559 (string-to-number (match-string 4)) ;; hour 559 (encode-time
560 (string-to-number (match-string 3)) ;; day 560 (string-to-number (match-string 6)) ;; sec
561 (string-to-number (match-string 2)) ;; month 561 (string-to-number (match-string 5)) ;; min
562 (string-to-number (match-string 1))))) ;; year 562 (string-to-number (match-string 4)) ;; hour
563 ((looking-at 563 (string-to-number (match-string 3)) ;; day
564 "Modify:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)") 564 (string-to-number (match-string 2)) ;; month
565 (setq mtime 565 (string-to-number (match-string 1))))) ;; year
566 (encode-time 566 ((looking-at
567 (string-to-number (match-string 6)) ;; sec 567 "Change:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)")
568 (string-to-number (match-string 5)) ;; min 568 (setq ctime
569 (string-to-number (match-string 4)) ;; hour 569 (encode-time
570 (string-to-number (match-string 3)) ;; day 570 (string-to-number (match-string 6)) ;; sec
571 (string-to-number (match-string 2)) ;; month 571 (string-to-number (match-string 5)) ;; min
572 (string-to-number (match-string 1))))) ;; year 572 (string-to-number (match-string 4)) ;; hour
573 ((looking-at 573 (string-to-number (match-string 3)) ;; day
574 "Change:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)") 574 (string-to-number (match-string 2)) ;; month
575 (setq ctime 575 (string-to-number (match-string 1)))))) ;; year
576 (encode-time 576 (forward-line))
577 (string-to-number (match-string 6)) ;; sec 577 ;; Return the result.
578 (string-to-number (match-string 5)) ;; min 578 (list id link uid gid atime mtime ctime size mode nil inode
579 (string-to-number (match-string 4)) ;; hour 579 (tramp-get-device vec)))))))
580 (string-to-number (match-string 3)) ;; day
581 (string-to-number (match-string 2)) ;; month
582 (string-to-number (match-string 1)))))) ;; year
583 (forward-line))
584 ;; Return the result.
585 (list id link uid gid atime mtime ctime size mode nil inode
586 (tramp-get-device vec))))))
587 580
588 (defun tramp-smb-handle-file-directory-p (filename) 581 (defun tramp-smb-handle-file-directory-p (filename)
589 "Like `file-directory-p' for Tramp files." 582 "Like `file-directory-p' for Tramp files."
590 (and (file-exists-p filename) 583 (and (file-exists-p filename)
591 (eq ?d (aref (nth 8 (file-attributes filename)) 0)))) 584 (eq ?d (aref (nth 8 (file-attributes filename)) 0))))
707 ((char-equal ?x (string-to-char (nth 1 x))) 700 ((char-equal ?x (string-to-char (nth 1 x)))
708 (setcar x (concat (car x) "*")))))) 701 (setcar x (concat (car x) "*"))))))
709 entries)) 702 entries))
710 703
711 ;; Print entries. 704 ;; Print entries.
712 (mapcar 705 (mapc
713 (lambda (x) 706 (lambda (x)
714 (when (not (zerop (length (nth 0 x)))) 707 (when (not (zerop (length (nth 0 x))))
715 (let ((attr 708 (let ((attr
716 (when (tramp-smb-get-cifs-capabilities v) 709 (when (tramp-smb-get-stat-capability v)
717 (ignore-errors 710 (ignore-errors
718 (file-attributes 711 (file-attributes
719 (expand-file-name (nth 0 x)) 'string))))) 712 (expand-file-name (nth 0 x)) 'string)))))
720 (insert 713 (insert
721 (format 714 (format
722 "%10s %3d %-8s %-8s %8s %s %s\n" 715 "%10s %3d %-8s %-8s %8s %s "
723 (or (nth 8 attr) (nth 1 x)) ; mode 716 (or (nth 8 attr) (nth 1 x)) ; mode
724 (or (nth 1 attr) 1) ; link 717 (or (nth 1 attr) 1) ; inode
725 (or (nth 2 attr) "nobody") ; uid 718 (or (nth 2 attr) "nobody") ; uid
726 (or (nth 3 attr) "nogroup") ; gid 719 (or (nth 3 attr) "nogroup") ; gid
727 (nth 2 x) ; size 720 (or (nth 7 attr) (nth 2 x)) ; size
728 (format-time-string 721 (format-time-string
729 (if (tramp-time-less-p 722 (if (tramp-time-less-p
730 (tramp-time-subtract (current-time) (nth 3 x)) 723 (tramp-time-subtract (current-time) (nth 3 x))
731 tramp-half-a-year) 724 tramp-half-a-year)
732 "%b %e %R" 725 "%b %e %R"
733 "%b %e %Y") 726 "%b %e %Y")
734 (nth 3 x)) ; date 727 (nth 3 x)))) ; date
735 (nth 0 x))) ; file name 728 ;; We mark the filename.
729 (let ((start (point)))
730 (insert (format "%s\n" (nth 0 x))) ; file name
731 (put-text-property start (1- (point)) 'dired-filename t))
736 (forward-line) 732 (forward-line)
737 (beginning-of-line)))) 733 (beginning-of-line))))
738 entries))))) 734 entries)))))
739 735
740 (defun tramp-smb-handle-make-directory (dir &optional parents) 736 (defun tramp-smb-handle-make-directory (dir &optional parents)
1169 ;; When we are not logged in yet, we return nil. 1165 ;; When we are not logged in yet, we return nil.
1170 (if (let ((p (tramp-get-connection-process vec))) 1166 (if (let ((p (tramp-get-connection-process vec)))
1171 (and p (processp p) (memq (process-status p) '(run open)))) 1167 (and p (processp p) (memq (process-status p) '(run open))))
1172 (with-connection-property 1168 (with-connection-property
1173 (tramp-get-connection-process vec) "cifs-capabilities" 1169 (tramp-get-connection-process vec) "cifs-capabilities"
1174 (when (tramp-smb-send-command vec "posix") 1170 (save-match-data
1175 (with-current-buffer (tramp-get-buffer vec) 1171 (when (tramp-smb-send-command vec "posix")
1176 (goto-char (point-min)) 1172 (with-current-buffer (tramp-get-buffer vec)
1177 (when (re-search-forward "Server supports CIFS capabilities" nil t) 1173 (goto-char (point-min))
1178 (member 1174 (when
1179 "pathnames" 1175 (re-search-forward "Server supports CIFS capabilities" nil t)
1180 (split-string 1176 (member
1181 (buffer-substring 1177 "pathnames"
1182 (point) (tramp-compat-line-end-position)) nil t)))))))) 1178 (split-string
1179 (buffer-substring
1180 (point) (tramp-compat-line-end-position)) nil t)))))))))
1181
1182 (defun tramp-smb-get-stat-capability (vec)
1183 "Check, whether the SMB server supports the STAT command."
1184 ;; When we are not logged in yet, we return nil.
1185 (if (let ((p (tramp-get-connection-process vec)))
1186 (and p (processp p) (memq (process-status p) '(run open))))
1187 (with-connection-property
1188 (tramp-get-connection-process vec) "stat-capability"
1189 (tramp-smb-send-command vec "stat ."))))
1183 1190
1184 1191
1185 ;; Connection functions. 1192 ;; Connection functions.
1186 1193
1187 (defun tramp-smb-send-command (vec command) 1194 (defun tramp-smb-send-command (vec command)
1202 1209
1203 ;; Check whether we still have the same smbclient version. 1210 ;; Check whether we still have the same smbclient version.
1204 ;; Otherwise, we must delete the connection cache, because 1211 ;; Otherwise, we must delete the connection cache, because
1205 ;; capabilities migh have changed. 1212 ;; capabilities migh have changed.
1206 (unless (processp p) 1213 (unless (processp p)
1207 (unless (let ((default-directory 1214 (let ((default-directory (tramp-compat-temporary-file-directory))
1208 (tramp-compat-temporary-file-directory))) 1215 (command (concat tramp-smb-program " -V")))
1209 (executable-find tramp-smb-program)) 1216
1210 (tramp-error 1217 (unless tramp-smb-version
1211 vec 'file-error 1218 (unless (executable-find tramp-smb-program)
1212 "Cannot find command %s in %s" tramp-smb-program exec-path)) 1219 (tramp-error
1213 1220 vec 'file-error
1214 (let* ((default-directory (tramp-compat-temporary-file-directory)) 1221 "Cannot find command %s in %s" tramp-smb-program exec-path))
1215 (smbclient-version tramp-smb-version)) 1222 (setq tramp-smb-version (shell-command-to-string command))
1216 (unless smbclient-version 1223 (tramp-message vec 6 command)
1217 (setq smbclient-version 1224 (tramp-message vec 6 "\n%s" tramp-smb-version)
1218 (shell-command-to-string (concat tramp-smb-program " -V"))) 1225 (if (string-match "[ \t\n\r]+\\'" tramp-smb-version)
1219 (tramp-message vec 6 (concat tramp-smb-program " -V")) 1226 (setq tramp-smb-version
1220 (tramp-message vec 6 "\n%s" smbclient-version) 1227 (replace-match "" nil nil tramp-smb-version))))
1221 (if (string-match "[ \t\n\r]+\\'" smbclient-version) 1228
1222 (setq smbclient-version 1229 (unless (string-equal
1223 (replace-match "" nil nil smbclient-version)))) 1230 tramp-smb-version
1224 (unless 1231 (tramp-get-connection-property
1225 (string-equal 1232 vec "smbclient-version" tramp-smb-version))
1226 smbclient-version
1227 (tramp-get-connection-property
1228 vec "smbclient-version" smbclient-version))
1229 (tramp-flush-directory-property vec "") 1233 (tramp-flush-directory-property vec "")
1230 (tramp-flush-connection-property vec)) 1234 (tramp-flush-connection-property vec))
1231 (setq tramp-smb-version 1235
1232 (tramp-set-connection-property 1236 (tramp-set-connection-property
1233 vec "smbclient-version" smbclient-version)))) 1237 vec "smbclient-version" tramp-smb-version)))
1234 1238
1235 ;; If too much time has passed since last command was sent, look 1239 ;; If too much time has passed since last command was sent, look
1236 ;; whether there has been an error message; maybe due to 1240 ;; whether there has been an error message; maybe due to
1237 ;; connection timeout. 1241 ;; connection timeout.
1238 (with-current-buffer buf 1242 (with-current-buffer buf