Mercurial > emacs
comparison lisp/net/tramp-smb.el @ 60763:3ba8f94e9cfa
Sync with Tramp 2.0.48.
| author | Michael Albinus <michael.albinus@gmx.de> |
|---|---|
| date | Sun, 20 Mar 2005 20:00:20 +0000 |
| parents | aac0a33f5772 |
| children | 8032449c46c0 13796b0653c7 |
comparison
equal
deleted
inserted
replaced
| 60762:9d474a03949a | 60763:3ba8f94e9cfa |
|---|---|
| 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, 2004 Free Software Foundation, Inc. | 3 ;; Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc. |
| 4 | 4 |
| 5 ;; Author: Michael Albinus <Michael.Albinus@alcatel.de> | 5 ;; Author: Michael Albinus <michael.albinus@gmx.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. |
| 9 | 9 |
| 10 ;; GNU Emacs is free software; you can redistribute it and/or modify | 10 ;; GNU Emacs is free software; you can redistribute it and/or modify |
| 73 (defcustom tramp-smb-program "smbclient" | 73 (defcustom tramp-smb-program "smbclient" |
| 74 "*Name of SMB client to run." | 74 "*Name of SMB client to run." |
| 75 :group 'tramp | 75 :group 'tramp |
| 76 :type 'string) | 76 :type 'string) |
| 77 | 77 |
| 78 (defconst tramp-smb-prompt "^smb: \\S-+> \\|^\\s-+Server\\s-+Comment$" | 78 (defconst tramp-smb-prompt "^smb: .+> \\|^\\s-+Server\\s-+Comment$" |
| 79 "Regexp used as prompt in smbclient.") | 79 "Regexp used as prompt in smbclient.") |
| 80 | 80 |
| 81 (defconst tramp-smb-errors | 81 (defconst tramp-smb-errors |
| 82 (mapconcat | 82 (mapconcat |
| 83 'identity | 83 'identity |
| 233 (file-name-nondirectory filename) newname))) | 233 (file-name-nondirectory filename) newname))) |
| 234 (when (and (not ok-if-already-exists) | 234 (when (and (not ok-if-already-exists) |
| 235 (file-exists-p newname)) | 235 (file-exists-p newname)) |
| 236 (error "copy-file: file %s already exists" newname)) | 236 (error "copy-file: file %s already exists" newname)) |
| 237 | 237 |
| 238 ; (with-parsed-tramp-file-name newname nil | 238 (with-parsed-tramp-file-name newname nil |
| 239 (let (user host localname) | |
| 240 (with-parsed-tramp-file-name newname l | |
| 241 (setq user l-user host l-host localname l-localname)) | |
| 242 (save-excursion | 239 (save-excursion |
| 243 (let ((share (tramp-smb-get-share localname)) | 240 (let ((share (tramp-smb-get-share localname)) |
| 244 (file (tramp-smb-get-localname localname t))) | 241 (file (tramp-smb-get-localname localname t))) |
| 245 (unless share | 242 (unless share |
| 246 (error "Target `%s' must contain a share name" filename)) | 243 (error "Target `%s' must contain a share name" filename)) |
| 256 (error "Cannot copy `%s'" filename)))))))) | 253 (error "Cannot copy `%s'" filename)))))))) |
| 257 | 254 |
| 258 (defun tramp-smb-handle-delete-directory (directory) | 255 (defun tramp-smb-handle-delete-directory (directory) |
| 259 "Like `delete-directory' for tramp files." | 256 "Like `delete-directory' for tramp files." |
| 260 (setq directory (directory-file-name (expand-file-name directory))) | 257 (setq directory (directory-file-name (expand-file-name directory))) |
| 261 (unless (file-exists-p directory) | 258 (when (file-exists-p directory) |
| 262 (error "Cannot delete non-existing directory `%s'" directory)) | 259 (with-parsed-tramp-file-name directory nil |
| 263 ; (with-parsed-tramp-file-name directory nil | 260 (save-excursion |
| 264 (let (user host localname) | 261 (let ((share (tramp-smb-get-share localname)) |
| 265 (with-parsed-tramp-file-name directory l | 262 (dir (tramp-smb-get-localname (file-name-directory localname) t)) |
| 266 (setq user l-user host l-host localname l-localname)) | 263 (file (file-name-nondirectory localname))) |
| 267 (save-excursion | 264 (tramp-smb-maybe-open-connection user host share) |
| 268 (let ((share (tramp-smb-get-share localname)) | 265 (if (and |
| 269 (dir (tramp-smb-get-localname (file-name-directory localname) t)) | 266 (tramp-smb-send-command user host (format "cd \"%s\"" dir)) |
| 270 (file (file-name-nondirectory localname))) | 267 (tramp-smb-send-command user host (format "rmdir \"%s\"" file))) |
| 271 (tramp-smb-maybe-open-connection user host share) | 268 ;; Go Home |
| 272 (if (and | 269 (tramp-smb-send-command user host (format "cd \\")) |
| 273 (tramp-smb-send-command user host (format "cd \"%s\"" dir)) | 270 ;; Error |
| 274 (tramp-smb-send-command user host (format "rmdir \"%s\"" file))) | |
| 275 ;; Go Home | |
| 276 (tramp-smb-send-command user host (format "cd \\")) | 271 (tramp-smb-send-command user host (format "cd \\")) |
| 277 ;; Error | 272 (error "Cannot delete directory `%s'" directory))))))) |
| 278 (tramp-smb-send-command user host (format "cd \\")) | |
| 279 (error "Cannot delete directory `%s'" directory)))))) | |
| 280 | 273 |
| 281 (defun tramp-smb-handle-delete-file (filename) | 274 (defun tramp-smb-handle-delete-file (filename) |
| 282 "Like `delete-file' for tramp files." | 275 "Like `delete-file' for tramp files." |
| 283 (setq filename (expand-file-name filename)) | 276 (setq filename (expand-file-name filename)) |
| 284 (unless (file-exists-p filename) | 277 (when (file-exists-p filename) |
| 285 (error "Cannot delete non-existing file `%s'" filename)) | 278 (with-parsed-tramp-file-name filename nil |
| 286 ; (with-parsed-tramp-file-name filename nil | 279 (save-excursion |
| 287 (let (user host localname) | 280 (let ((share (tramp-smb-get-share localname)) |
| 288 (with-parsed-tramp-file-name filename l | 281 (dir (tramp-smb-get-localname (file-name-directory localname) t)) |
| 289 (setq user l-user host l-host localname l-localname)) | 282 (file (file-name-nondirectory localname))) |
| 290 (save-excursion | 283 (tramp-smb-maybe-open-connection user host share) |
| 291 (let ((share (tramp-smb-get-share localname)) | 284 (if (and |
| 292 (dir (tramp-smb-get-localname (file-name-directory localname) t)) | 285 (tramp-smb-send-command user host (format "cd \"%s\"" dir)) |
| 293 (file (file-name-nondirectory localname))) | 286 (tramp-smb-send-command user host (format "rm \"%s\"" file))) |
| 294 (unless (file-exists-p filename) | 287 ;; Go Home |
| 295 (error "Cannot delete non-existing file `%s'" filename)) | 288 (tramp-smb-send-command user host (format "cd \\")) |
| 296 (tramp-smb-maybe-open-connection user host share) | 289 ;; Error |
| 297 (if (and | |
| 298 (tramp-smb-send-command user host (format "cd \"%s\"" dir)) | |
| 299 (tramp-smb-send-command user host (format "rm \"%s\"" file))) | |
| 300 ;; Go Home | |
| 301 (tramp-smb-send-command user host (format "cd \\")) | 290 (tramp-smb-send-command user host (format "cd \\")) |
| 302 ;; Error | 291 (error "Cannot delete file `%s'" filename))))))) |
| 303 (tramp-smb-send-command user host (format "cd \\")) | |
| 304 (error "Cannot delete file `%s'" filename)))))) | |
| 305 | 292 |
| 306 (defun tramp-smb-handle-directory-files | 293 (defun tramp-smb-handle-directory-files |
| 307 (directory &optional full match nosort) | 294 (directory &optional full match nosort) |
| 308 "Like `directory-files' for tramp files." | 295 "Like `directory-files' for tramp files." |
| 309 (setq directory (directory-file-name (expand-file-name directory))) | 296 (setq directory (directory-file-name (expand-file-name directory))) |
| 310 ; (with-parsed-tramp-file-name directory nil | 297 (with-parsed-tramp-file-name directory nil |
| 311 (let (user host localname) | |
| 312 (with-parsed-tramp-file-name directory l | |
| 313 (setq user l-user host l-host localname l-localname)) | |
| 314 (save-excursion | 298 (save-excursion |
| 315 (let* ((share (tramp-smb-get-share localname)) | 299 (let* ((share (tramp-smb-get-share localname)) |
| 316 (file (tramp-smb-get-localname localname nil)) | 300 (file (tramp-smb-get-localname localname nil)) |
| 317 (entries (tramp-smb-get-file-entries user host share file))) | 301 (entries (tramp-smb-get-file-entries user host share file))) |
| 318 ;; Just the file names are needed | 302 ;; Just the file names are needed |
| 338 (directory &optional full match nosort id-format) | 322 (directory &optional full match nosort id-format) |
| 339 "Like `directory-files-and-attributes' for tramp files." | 323 "Like `directory-files-and-attributes' for tramp files." |
| 340 (mapcar | 324 (mapcar |
| 341 (lambda (x) | 325 (lambda (x) |
| 342 ;; We cannot call `file-attributes' for backward compatibility reasons. | 326 ;; We cannot call `file-attributes' for backward compatibility reasons. |
| 343 ;; Its optional parameter ID-FORMAT is introduced with Emacs 22.1. | 327 ;; Its optional parameter ID-FORMAT is introduced with Emacs 22. |
| 344 (cons x (tramp-smb-handle-file-attributes | 328 (cons x (tramp-smb-handle-file-attributes |
| 345 (if full x (concat (file-name-as-directory directory) x)) id-format))) | 329 (if full x (concat (file-name-as-directory directory) x)) id-format))) |
| 346 (directory-files directory full match nosort))) | 330 (directory-files directory full match nosort))) |
| 347 | 331 |
| 348 (defun tramp-smb-handle-file-attributes (filename &optional id-format) | 332 (defun tramp-smb-handle-file-attributes (filename &optional id-format) |
| 349 "Like `file-attributes' for tramp files." | 333 "Like `file-attributes' for tramp files." |
| 350 ; (with-parsed-tramp-file-name filename nil | 334 (with-parsed-tramp-file-name filename nil |
| 351 (let (user host localname) | |
| 352 (with-parsed-tramp-file-name filename l | |
| 353 (setq user l-user host l-host localname l-localname)) | |
| 354 (save-excursion | 335 (save-excursion |
| 355 (let* ((share (tramp-smb-get-share localname)) | 336 (let* ((share (tramp-smb-get-share localname)) |
| 356 (file (tramp-smb-get-localname localname nil)) | 337 (file (tramp-smb-get-localname localname nil)) |
| 357 (entries (tramp-smb-get-file-entries user host share file)) | 338 (entries (tramp-smb-get-file-entries user host share file)) |
| 358 (entry (and entries | 339 (entry (and entries |
| 378 inode ;10 inode number | 359 inode ;10 inode number |
| 379 device)))))) ;11 file system number | 360 device)))))) ;11 file system number |
| 380 | 361 |
| 381 (defun tramp-smb-handle-file-directory-p (filename) | 362 (defun tramp-smb-handle-file-directory-p (filename) |
| 382 "Like `file-directory-p' for tramp files." | 363 "Like `file-directory-p' for tramp files." |
| 383 ; (with-parsed-tramp-file-name filename nil | 364 (with-parsed-tramp-file-name filename nil |
| 384 (let (user host localname) | |
| 385 (with-parsed-tramp-file-name filename l | |
| 386 (setq user l-user host l-host localname l-localname)) | |
| 387 (save-excursion | 365 (save-excursion |
| 388 (let* ((share (tramp-smb-get-share localname)) | 366 (let* ((share (tramp-smb-get-share localname)) |
| 389 (file (tramp-smb-get-localname localname nil)) | 367 (file (tramp-smb-get-localname localname nil)) |
| 390 (entries (tramp-smb-get-file-entries user host share file)) | 368 (entries (tramp-smb-get-file-entries user host share file)) |
| 391 (entry (and entries | 369 (entry (and entries |
| 394 (string-match "d" (nth 1 entry)) | 372 (string-match "d" (nth 1 entry)) |
| 395 t))))) | 373 t))))) |
| 396 | 374 |
| 397 (defun tramp-smb-handle-file-exists-p (filename) | 375 (defun tramp-smb-handle-file-exists-p (filename) |
| 398 "Like `file-exists-p' for tramp files." | 376 "Like `file-exists-p' for tramp files." |
| 399 ; (with-parsed-tramp-file-name filename nil | 377 (with-parsed-tramp-file-name filename nil |
| 400 (let (user host localname) | |
| 401 (with-parsed-tramp-file-name filename l | |
| 402 (setq user l-user host l-host localname l-localname)) | |
| 403 (save-excursion | 378 (save-excursion |
| 404 (let* ((share (tramp-smb-get-share localname)) | 379 (let* ((share (tramp-smb-get-share localname)) |
| 405 (file (tramp-smb-get-localname localname nil)) | 380 (file (tramp-smb-get-localname localname nil)) |
| 406 (entries (tramp-smb-get-file-entries user host share file))) | 381 (entries (tramp-smb-get-file-entries user host share file))) |
| 407 (and entries | 382 (and entries |
| 431 | 406 |
| 432 ;; This function should return "foo/" for directories and "bar" for | 407 ;; This function should return "foo/" for directories and "bar" for |
| 433 ;; files. | 408 ;; files. |
| 434 (defun tramp-smb-handle-file-name-all-completions (filename directory) | 409 (defun tramp-smb-handle-file-name-all-completions (filename directory) |
| 435 "Like `file-name-all-completions' for tramp files." | 410 "Like `file-name-all-completions' for tramp files." |
| 436 ; (with-parsed-tramp-file-name directory nil | 411 (with-parsed-tramp-file-name directory nil |
| 437 (let (user host localname) | |
| 438 (with-parsed-tramp-file-name directory l | |
| 439 (setq user l-user host l-host localname l-localname)) | |
| 440 (save-match-data | 412 (save-match-data |
| 441 (save-excursion | 413 (save-excursion |
| 442 (let* ((share (tramp-smb-get-share localname)) | 414 (let* ((share (tramp-smb-get-share localname)) |
| 443 (file (tramp-smb-get-localname localname nil)) | 415 (file (tramp-smb-get-localname localname nil)) |
| 444 (entries (tramp-smb-get-file-entries user host share file))) | 416 (entries (tramp-smb-get-file-entries user host share file))) |
| 465 "Like `file-writable-p' for tramp files." | 437 "Like `file-writable-p' for tramp files." |
| 466 (if (not (file-exists-p filename)) | 438 (if (not (file-exists-p filename)) |
| 467 (let ((dir (file-name-directory filename))) | 439 (let ((dir (file-name-directory filename))) |
| 468 (and (file-exists-p dir) | 440 (and (file-exists-p dir) |
| 469 (file-writable-p dir))) | 441 (file-writable-p dir))) |
| 470 ; (with-parsed-tramp-file-name filename nil | 442 (with-parsed-tramp-file-name filename nil |
| 471 (let (user host localname) | |
| 472 (with-parsed-tramp-file-name filename l | |
| 473 (setq user l-user host l-host localname l-localname)) | |
| 474 (save-excursion | 443 (save-excursion |
| 475 (let* ((share (tramp-smb-get-share localname)) | 444 (let* ((share (tramp-smb-get-share localname)) |
| 476 (file (tramp-smb-get-localname localname nil)) | 445 (file (tramp-smb-get-localname localname nil)) |
| 477 (entries (tramp-smb-get-file-entries user host share file)) | 446 (entries (tramp-smb-get-file-entries user host share file)) |
| 478 (entry (and entries | 447 (entry (and entries |
| 488 (setq filename (expand-file-name filename)) | 457 (setq filename (expand-file-name filename)) |
| 489 (when (file-directory-p filename) | 458 (when (file-directory-p filename) |
| 490 ;; This check is a little bit strange, but in `dired-add-entry' | 459 ;; This check is a little bit strange, but in `dired-add-entry' |
| 491 ;; this function is called with a non-directory ... | 460 ;; this function is called with a non-directory ... |
| 492 (setq filename (file-name-as-directory filename))) | 461 (setq filename (file-name-as-directory filename))) |
| 493 ; (with-parsed-tramp-file-name filename nil | 462 (with-parsed-tramp-file-name filename nil |
| 494 (let (user host localname) | |
| 495 (with-parsed-tramp-file-name filename l | |
| 496 (setq user l-user host l-host localname l-localname)) | |
| 497 (save-match-data | 463 (save-match-data |
| 498 (let* ((share (tramp-smb-get-share localname)) | 464 (let* ((share (tramp-smb-get-share localname)) |
| 499 (file (tramp-smb-get-localname localname nil)) | 465 (file (tramp-smb-get-localname localname nil)) |
| 500 (entries (tramp-smb-get-file-entries user host share file))) | 466 (entries (tramp-smb-get-file-entries user host share file))) |
| 501 | 467 |
| 541 (defun tramp-smb-handle-make-directory (dir &optional parents) | 507 (defun tramp-smb-handle-make-directory (dir &optional parents) |
| 542 "Like `make-directory' for tramp files." | 508 "Like `make-directory' for tramp files." |
| 543 (setq dir (directory-file-name (expand-file-name dir))) | 509 (setq dir (directory-file-name (expand-file-name dir))) |
| 544 (unless (file-name-absolute-p dir) | 510 (unless (file-name-absolute-p dir) |
| 545 (setq dir (concat default-directory dir))) | 511 (setq dir (concat default-directory dir))) |
| 546 ; (with-parsed-tramp-file-name dir nil | 512 (with-parsed-tramp-file-name dir nil |
| 547 (let (user host localname) | |
| 548 (with-parsed-tramp-file-name dir l | |
| 549 (setq user l-user host l-host localname l-localname)) | |
| 550 (save-match-data | 513 (save-match-data |
| 551 (let* ((share (tramp-smb-get-share localname)) | 514 (let* ((share (tramp-smb-get-share localname)) |
| 552 (ldir (file-name-directory dir))) | 515 (ldir (file-name-directory dir))) |
| 553 ;; Make missing directory parts | 516 ;; Make missing directory parts |
| 554 (when (and parents share (not (file-directory-p ldir))) | 517 (when (and parents share (not (file-directory-p ldir))) |
| 562 (defun tramp-smb-handle-make-directory-internal (directory) | 525 (defun tramp-smb-handle-make-directory-internal (directory) |
| 563 "Like `make-directory-internal' for tramp files." | 526 "Like `make-directory-internal' for tramp files." |
| 564 (setq directory (directory-file-name (expand-file-name directory))) | 527 (setq directory (directory-file-name (expand-file-name directory))) |
| 565 (unless (file-name-absolute-p directory) | 528 (unless (file-name-absolute-p directory) |
| 566 (setq directory (concat default-directory directory))) | 529 (setq directory (concat default-directory directory))) |
| 567 ; (with-parsed-tramp-file-name directory nil | 530 (with-parsed-tramp-file-name directory nil |
| 568 (let (user host localname) | |
| 569 (with-parsed-tramp-file-name directory l | |
| 570 (setq user l-user host l-host localname l-localname)) | |
| 571 (save-match-data | 531 (save-match-data |
| 572 (let* ((share (tramp-smb-get-share localname)) | 532 (let* ((share (tramp-smb-get-share localname)) |
| 573 (file (tramp-smb-get-localname localname nil))) | 533 (file (tramp-smb-get-localname localname nil))) |
| 574 (when (file-directory-p (file-name-directory directory)) | 534 (when (file-directory-p (file-name-directory directory)) |
| 575 (tramp-smb-maybe-open-connection user host share) | 535 (tramp-smb-maybe-open-connection user host share) |
| 595 (file-name-nondirectory filename) newname))) | 555 (file-name-nondirectory filename) newname))) |
| 596 (when (and (not ok-if-already-exists) | 556 (when (and (not ok-if-already-exists) |
| 597 (file-exists-p newname)) | 557 (file-exists-p newname)) |
| 598 (error "rename-file: file %s already exists" newname)) | 558 (error "rename-file: file %s already exists" newname)) |
| 599 | 559 |
| 600 ; (with-parsed-tramp-file-name newname nil | 560 (with-parsed-tramp-file-name newname nil |
| 601 (let (user host localname) | |
| 602 (with-parsed-tramp-file-name newname l | |
| 603 (setq user l-user host l-host localname l-localname)) | |
| 604 (save-excursion | 561 (save-excursion |
| 605 (let ((share (tramp-smb-get-share localname)) | 562 (let ((share (tramp-smb-get-share localname)) |
| 606 (file (tramp-smb-get-localname localname t))) | 563 (file (tramp-smb-get-localname localname t))) |
| 607 (tramp-smb-maybe-open-connection user host share) | 564 (tramp-smb-maybe-open-connection user host share) |
| 608 (tramp-message-for-buffer | 565 (tramp-message-for-buffer |
| 634 (when (and (not (featurep 'xemacs)) | 591 (when (and (not (featurep 'xemacs)) |
| 635 confirm (file-exists-p filename)) | 592 confirm (file-exists-p filename)) |
| 636 (unless (y-or-n-p (format "File %s exists; overwrite anyway? " | 593 (unless (y-or-n-p (format "File %s exists; overwrite anyway? " |
| 637 filename)) | 594 filename)) |
| 638 (error "File not overwritten"))) | 595 (error "File not overwritten"))) |
| 639 ; (with-parsed-tramp-file-name filename nil | 596 (with-parsed-tramp-file-name filename nil |
| 640 (let (user host localname) | |
| 641 (with-parsed-tramp-file-name filename l | |
| 642 (setq user l-user host l-host localname l-localname)) | |
| 643 (save-excursion | 597 (save-excursion |
| 644 (let ((share (tramp-smb-get-share localname)) | 598 (let ((share (tramp-smb-get-share localname)) |
| 645 (file (tramp-smb-get-localname localname t)) | 599 (file (tramp-smb-get-localname localname t)) |
| 646 (curbuf (current-buffer)) | 600 (curbuf (current-buffer)) |
| 647 ;; We use this to save the value of `last-coding-system-used' | 601 ;; We use this to save the value of `last-coding-system-used' |
| 967 for a remote password prompt. It queries the user for the password, | 921 for a remote password prompt. It queries the user for the password, |
| 968 then sends the password to the remote host. | 922 then sends the password to the remote host. |
| 969 | 923 |
| 970 Domain names in USER and port numbers in HOST are acknowledged." | 924 Domain names in USER and port numbers in HOST are acknowledged." |
| 971 | 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 | |
| 972 (save-match-data | 930 (save-match-data |
| 973 (let* ((buffer (tramp-get-buffer nil tramp-smb-method user host)) | 931 (let* ((buffer (tramp-get-buffer nil tramp-smb-method user host)) |
| 974 (real-user user) | 932 (real-user user) |
| 975 (real-host host) | 933 (real-host host) |
| 976 domain port args) | 934 domain port args) |