Mercurial > emacs
comparison lisp/net/tramp-smb.el @ 105690:8d8fc5285759
* 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 |