12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084 |
- ;;; tramp-smb.el --- Tramp access functions for SMB servers -*- lexical-binding:t -*-
- ;; Copyright (C) 2002-2017 Free Software Foundation, Inc.
- ;; Author: Michael Albinus <michael.albinus@gmx.de>
- ;; Keywords: comm, processes
- ;; Package: tramp
- ;; This file is part of GNU Emacs.
- ;; GNU Emacs is free software: you can redistribute it and/or modify
- ;; it under the terms of the GNU General Public License as published by
- ;; the Free Software Foundation, either version 3 of the License, or
- ;; (at your option) any later version.
- ;; GNU Emacs is distributed in the hope that it will be useful,
- ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
- ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- ;; GNU General Public License for more details.
- ;; You should have received a copy of the GNU General Public License
- ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
- ;;; Commentary:
- ;; Access functions for SMB servers like SAMBA or M$ Windows from Tramp.
- ;;; Code:
- (require 'tramp)
- ;; Define SMB method ...
- ;;;###tramp-autoload
- (defconst tramp-smb-method "smb"
- "Method to connect SAMBA and M$ SMB servers.")
- ;; ... and add it to the method list.
- ;;;###tramp-autoload
- (unless (memq system-type '(cygwin windows-nt))
- (add-to-list 'tramp-methods
- `(,tramp-smb-method
- ;; We define an empty command, because `tramp-smb-call-winexe'
- ;; opens already the powershell. Used in `tramp-handle-shell-command'.
- (tramp-remote-shell "")
- ;; This is just a guess. We don't know whether the share "C$"
- ;; is available for public use, and whether the user has write
- ;; access.
- (tramp-tmpdir "/C$/Temp")
- ;; Another guess. We might implement a better check later on.
- (tramp-case-insensitive t))))
- ;; Add a default for `tramp-default-user-alist'. Rule: For the SMB method,
- ;; the anonymous user is chosen.
- ;;;###tramp-autoload
- (add-to-list 'tramp-default-user-alist
- `(,(concat "\\`" tramp-smb-method "\\'") nil nil))
- ;; Add completion function for SMB method.
- ;;;###tramp-autoload
- (eval-after-load 'tramp
- '(tramp-set-completion-function
- tramp-smb-method
- '((tramp-parse-netrc "~/.netrc"))))
- ;;;###tramp-autoload
- (defcustom tramp-smb-program "smbclient"
- "Name of SMB client to run."
- :group 'tramp
- :type 'string
- :require 'tramp)
- ;;;###tramp-autoload
- (defcustom tramp-smb-acl-program "smbcacls"
- "Name of SMB acls to run."
- :group 'tramp
- :type 'string
- :version "24.4"
- :require 'tramp)
- ;;;###tramp-autoload
- (defcustom tramp-smb-conf "/dev/null"
- "Path of the smb.conf file.
- If it is nil, no smb.conf will be added to the `tramp-smb-program'
- call, letting the SMB client use the default one."
- :group 'tramp
- :type '(choice (const nil) (file :must-match t))
- :require 'tramp)
- (defvar tramp-smb-version nil
- "Version string of the SMB client.")
- (defconst tramp-smb-server-version
- "Domain=\\[[^]]*\\] OS=\\[[^]]*\\] Server=\\[[^]]*\\]"
- "Regexp of SMB server identification.")
- (defconst tramp-smb-prompt "^\\(smb:\\|PS\\) .+> \\|^\\s-+Server\\s-+Comment$"
- "Regexp used as prompt in smbclient or powershell.")
- (defconst tramp-smb-wrong-passwd-regexp
- (regexp-opt
- '("NT_STATUS_LOGON_FAILURE"
- "NT_STATUS_WRONG_PASSWORD"))
- "Regexp for login error strings of SMB servers.")
- (defconst tramp-smb-errors
- (mapconcat
- 'identity
- `(;; Connection error / timeout / unknown command.
- "Connection\\( to \\S-+\\)? failed"
- "Read from server failed, maybe it closed the connection"
- "Call timed out: server did not respond"
- "\\S-+: command not found"
- "Server doesn't support UNIX CIFS calls"
- ,(regexp-opt
- '(;; Samba.
- "ERRDOS"
- "ERRHRD"
- "ERRSRV"
- "ERRbadfile"
- "ERRbadpw"
- "ERRfilexists"
- "ERRnoaccess"
- "ERRnomem"
- "ERRnosuchshare"
- ;; Windows 4.0 (Windows NT), Windows 5.0 (Windows 2000),
- ;; Windows 5.1 (Windows XP), Windows 5.2 (Windows Server 2003),
- ;; Windows 6.0 (Windows Vista), Windows 6.1 (Windows 7),
- ;; Windows 6.3 (Windows Server 2012, Windows 10).
- "NT_STATUS_ACCESS_DENIED"
- "NT_STATUS_ACCOUNT_LOCKED_OUT"
- "NT_STATUS_BAD_NETWORK_NAME"
- "NT_STATUS_CANNOT_DELETE"
- "NT_STATUS_CONNECTION_REFUSED"
- "NT_STATUS_DIRECTORY_NOT_EMPTY"
- "NT_STATUS_DUPLICATE_NAME"
- "NT_STATUS_FILE_IS_A_DIRECTORY"
- "NT_STATUS_HOST_UNREACHABLE"
- "NT_STATUS_IMAGE_ALREADY_LOADED"
- "NT_STATUS_INVALID_LEVEL"
- "NT_STATUS_INVALID_PARAMETER_MIX"
- "NT_STATUS_IO_TIMEOUT"
- "NT_STATUS_LOGON_FAILURE"
- "NT_STATUS_NETWORK_ACCESS_DENIED"
- "NT_STATUS_NOT_IMPLEMENTED"
- "NT_STATUS_NO_LOGON_SERVERS"
- "NT_STATUS_NO_SUCH_FILE"
- "NT_STATUS_NO_SUCH_USER"
- "NT_STATUS_OBJECT_NAME_COLLISION"
- "NT_STATUS_OBJECT_NAME_INVALID"
- "NT_STATUS_OBJECT_NAME_NOT_FOUND"
- "NT_STATUS_PASSWORD_MUST_CHANGE"
- "NT_STATUS_SHARING_VIOLATION"
- "NT_STATUS_TRUSTED_RELATIONSHIP_FAILURE"
- "NT_STATUS_UNSUCCESSFUL"
- "NT_STATUS_WRONG_PASSWORD")))
- "\\|")
- "Regexp for possible error strings of SMB servers.
- Used instead of analyzing error codes of commands.")
- (defconst tramp-smb-actions-with-share
- '((tramp-smb-prompt tramp-action-succeed)
- (tramp-password-prompt-regexp tramp-action-password)
- (tramp-wrong-passwd-regexp tramp-action-permission-denied)
- (tramp-smb-errors tramp-action-permission-denied)
- (tramp-process-alive-regexp tramp-action-process-alive))
- "List of pattern/action pairs.
- This list is used for login to SMB servers.
- See `tramp-actions-before-shell' for more info.")
- (defconst tramp-smb-actions-without-share
- '((tramp-password-prompt-regexp tramp-action-password)
- (tramp-wrong-passwd-regexp tramp-action-permission-denied)
- (tramp-smb-errors tramp-action-permission-denied)
- (tramp-process-alive-regexp tramp-action-out-of-band))
- "List of pattern/action pairs.
- This list is used for login to SMB servers.
- See `tramp-actions-before-shell' for more info.")
- (defconst tramp-smb-actions-with-tar
- '((tramp-password-prompt-regexp tramp-action-password)
- (tramp-wrong-passwd-regexp tramp-action-permission-denied)
- (tramp-smb-errors tramp-action-permission-denied)
- (tramp-process-alive-regexp tramp-smb-action-with-tar))
- "List of pattern/action pairs.
- This list is used for tar-like copy of directories.
- See `tramp-actions-before-shell' for more info.")
- (defconst tramp-smb-actions-get-acl
- '((tramp-password-prompt-regexp tramp-action-password)
- (tramp-wrong-passwd-regexp tramp-action-permission-denied)
- (tramp-smb-errors tramp-action-permission-denied)
- (tramp-process-alive-regexp tramp-smb-action-get-acl))
- "List of pattern/action pairs.
- This list is used for smbcacls actions.
- See `tramp-actions-before-shell' for more info.")
- (defconst tramp-smb-actions-set-acl
- '((tramp-password-prompt-regexp tramp-action-password)
- (tramp-wrong-passwd-regexp tramp-action-permission-denied)
- (tramp-smb-errors tramp-action-permission-denied)
- (tramp-process-alive-regexp tramp-smb-action-set-acl))
- "List of pattern/action pairs.
- This list is used for smbcacls actions.
- See `tramp-actions-before-shell' for more info.")
- ;; New handlers should be added here.
- ;;;###tramp-autoload
- (defconst tramp-smb-file-name-handler-alist
- '(;; `access-file' performed by default handler.
- (add-name-to-file . tramp-smb-handle-add-name-to-file)
- ;; `byte-compiler-base-file-name' performed by default handler.
- (copy-directory . tramp-smb-handle-copy-directory)
- (copy-file . tramp-smb-handle-copy-file)
- (delete-directory . tramp-smb-handle-delete-directory)
- (delete-file . tramp-smb-handle-delete-file)
- ;; `diff-latest-backup-file' performed by default handler.
- (directory-file-name . tramp-handle-directory-file-name)
- (directory-files . tramp-smb-handle-directory-files)
- (directory-files-and-attributes
- . tramp-handle-directory-files-and-attributes)
- (dired-compress-file . ignore)
- (dired-uncache . tramp-handle-dired-uncache)
- (expand-file-name . tramp-smb-handle-expand-file-name)
- (file-accessible-directory-p . tramp-smb-handle-file-directory-p)
- (file-acl . tramp-smb-handle-file-acl)
- (file-attributes . tramp-smb-handle-file-attributes)
- (file-directory-p . tramp-smb-handle-file-directory-p)
- (file-file-equal-p . tramp-handle-file-equal-p)
- (file-executable-p . tramp-handle-file-exists-p)
- (file-exists-p . tramp-handle-file-exists-p)
- (file-in-directory-p . tramp-handle-file-in-directory-p)
- (file-local-copy . tramp-smb-handle-file-local-copy)
- (file-modes . tramp-handle-file-modes)
- (file-name-all-completions . tramp-smb-handle-file-name-all-completions)
- (file-name-as-directory . tramp-handle-file-name-as-directory)
- (file-name-case-insensitive-p . tramp-handle-file-name-case-insensitive-p)
- (file-name-completion . tramp-handle-file-name-completion)
- (file-name-directory . tramp-handle-file-name-directory)
- (file-name-nondirectory . tramp-handle-file-name-nondirectory)
- ;; `file-name-sans-versions' performed by default handler.
- (file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
- (file-notify-add-watch . tramp-handle-file-notify-add-watch)
- (file-notify-rm-watch . tramp-handle-file-notify-rm-watch)
- (file-notify-valid-p . tramp-handle-file-notify-valid-p)
- (file-ownership-preserved-p . ignore)
- (file-readable-p . tramp-handle-file-exists-p)
- (file-regular-p . tramp-handle-file-regular-p)
- (file-remote-p . tramp-handle-file-remote-p)
- ;; `file-selinux-context' performed by default handler.
- (file-symlink-p . tramp-handle-file-symlink-p)
- (file-truename . tramp-smb-handle-file-truename)
- (file-writable-p . tramp-smb-handle-file-writable-p)
- (find-backup-file-name . tramp-handle-find-backup-file-name)
- ;; `find-file-noselect' performed by default handler.
- ;; `get-file-buffer' performed by default handler.
- (insert-directory . tramp-smb-handle-insert-directory)
- (insert-file-contents . tramp-handle-insert-file-contents)
- (load . tramp-handle-load)
- (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
- (make-directory . tramp-smb-handle-make-directory)
- (make-directory-internal . tramp-smb-handle-make-directory-internal)
- (make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
- (make-symbolic-link . tramp-smb-handle-make-symbolic-link)
- (process-file . tramp-smb-handle-process-file)
- (rename-file . tramp-smb-handle-rename-file)
- (set-file-acl . tramp-smb-handle-set-file-acl)
- (set-file-modes . tramp-smb-handle-set-file-modes)
- (set-file-selinux-context . ignore)
- (set-file-times . ignore)
- (set-visited-file-modtime . tramp-handle-set-visited-file-modtime)
- (shell-command . tramp-handle-shell-command)
- (start-file-process . tramp-smb-handle-start-file-process)
- (substitute-in-file-name . tramp-smb-handle-substitute-in-file-name)
- (temporary-file-directory . tramp-handle-temporary-file-directory)
- (unhandled-file-name-directory . ignore)
- (vc-registered . ignore)
- (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
- (write-region . tramp-smb-handle-write-region))
- "Alist of handler functions for Tramp SMB method.
- Operations not mentioned here will be handled by the default Emacs primitives.")
- ;; Options for remote processes via winexe.
- ;;;###tramp-autoload
- (defcustom tramp-smb-winexe-program "winexe"
- "Name of winexe client to run.
- If it isn't found in the local $PATH, the absolute path of winexe
- shall be given. This is needed for remote processes."
- :group 'tramp
- :type 'string
- :version "24.3"
- :require 'tramp)
- ;;;###tramp-autoload
- (defcustom tramp-smb-winexe-shell-command "powershell.exe"
- "Shell to be used for processes on remote machines.
- This must be Powershell V2 compatible."
- :group 'tramp
- :type 'string
- :version "24.3"
- :require 'tramp)
- ;;;###tramp-autoload
- (defcustom tramp-smb-winexe-shell-command-switch "-file -"
- "Command switch used together with `tramp-smb-winexe-shell-command'.
- This can be used to disable echo etc."
- :group 'tramp
- :type 'string
- :version "24.3"
- :require 'tramp)
- ;; It must be a `defsubst' in order to push the whole code into
- ;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading.
- ;;;###tramp-autoload
- (defsubst tramp-smb-file-name-p (filename)
- "Check if it's a filename for SMB servers."
- (string= (tramp-file-name-method (tramp-dissect-file-name filename))
- tramp-smb-method))
- ;;;###tramp-autoload
- (defun tramp-smb-file-name-handler (operation &rest args)
- "Invoke the SMB related OPERATION.
- First arg specifies the OPERATION, second arg is a list of arguments to
- pass to the OPERATION."
- (let ((fn (assoc operation tramp-smb-file-name-handler-alist)))
- (if fn
- (save-match-data (apply (cdr fn) args))
- (tramp-run-real-handler operation args))))
- ;;;###tramp-autoload
- (unless (memq system-type '(cygwin windows-nt))
- (tramp-register-foreign-file-name-handler
- 'tramp-smb-file-name-p 'tramp-smb-file-name-handler))
- ;; File name primitives.
- (defun tramp-smb-handle-add-name-to-file
- (filename newname &optional ok-if-already-exists)
- "Like `add-name-to-file' for Tramp files."
- (unless (tramp-equal-remote filename newname)
- (with-parsed-tramp-file-name
- (if (tramp-tramp-file-p filename) filename newname) nil
- (tramp-error
- v 'file-error
- "add-name-to-file: %s"
- "only implemented for same method, same user, same host")))
- (with-parsed-tramp-file-name filename v1
- (with-parsed-tramp-file-name newname v2
- (when (file-directory-p filename)
- (tramp-error
- v2 'file-error
- "add-name-to-file: %s must not be a directory" filename))
- ;; Do the 'confirm if exists' thing.
- (when (file-exists-p newname)
- ;; What to do?
- (if (or (null ok-if-already-exists) ; not allowed to exist
- (and (numberp ok-if-already-exists)
- (not (yes-or-no-p
- (format
- "File %s already exists; make it a link anyway? "
- v2-localname)))))
- (tramp-error v2 'file-already-exists newname)
- (delete-file newname)))
- ;; We must also flush the cache of the directory, because
- ;; `file-attributes' reads the values from there.
- (tramp-flush-file-property v2 (file-name-directory v2-localname))
- (tramp-flush-file-property v2 v2-localname)
- (unless
- (tramp-smb-send-command
- v1
- (format
- "%s \"%s\" \"%s\""
- (if (tramp-smb-get-cifs-capabilities v1) "link" "hardlink")
- (tramp-smb-get-localname v1)
- (tramp-smb-get-localname v2)))
- (tramp-error
- v2 'file-error
- "error with add-name-to-file, see buffer `%s' for details"
- (buffer-name))))))
- (defun tramp-smb-action-with-tar (proc vec)
- "Untar from connection buffer."
- (if (not (process-live-p proc))
- (throw 'tramp-action 'process-died)
- (with-current-buffer (tramp-get-connection-buffer vec)
- (goto-char (point-min))
- (when (search-forward-regexp tramp-smb-server-version nil t)
- ;; There might be a hidden password prompt.
- (widen)
- (forward-line)
- (tramp-message vec 6 (buffer-substring (point-min) (point)))
- (delete-region (point-min) (point))
- (throw 'tramp-action 'ok)))))
- (defun tramp-smb-handle-copy-directory
- (dirname newname &optional keep-date parents copy-contents)
- "Like `copy-directory' for Tramp files."
- (if copy-contents
- ;; We must do it file-wise.
- (tramp-run-real-handler
- 'copy-directory (list dirname newname keep-date parents copy-contents))
- (setq dirname (expand-file-name dirname)
- newname (expand-file-name newname))
- (let ((t1 (tramp-tramp-file-p dirname))
- (t2 (tramp-tramp-file-p newname)))
- (with-parsed-tramp-file-name (if t1 dirname newname) nil
- (with-tramp-progress-reporter
- v 0 (format "Copying %s to %s" dirname newname)
- (cond
- ;; We must use a local temporary directory.
- ((and t1 t2)
- (let ((tmpdir
- (make-temp-name
- (expand-file-name
- tramp-temp-name-prefix
- (tramp-compat-temporary-file-directory)))))
- (unwind-protect
- (progn
- (make-directory tmpdir)
- (copy-directory dirname tmpdir keep-date 'parents)
- (copy-directory
- (expand-file-name (file-name-nondirectory dirname) tmpdir)
- newname keep-date parents))
- (delete-directory tmpdir 'recursive))))
- ;; We can copy recursively.
- ;; Does not work reliably.
- (nil ;(and (or t1 t2) (tramp-smb-get-cifs-capabilities v))
- (when (and (file-directory-p newname)
- (not (string-equal (file-name-nondirectory dirname)
- (file-name-nondirectory newname))))
- (setq newname
- (expand-file-name
- (file-name-nondirectory dirname) newname))
- (if t2 (setq v (tramp-dissect-file-name newname))))
- (if (not (file-directory-p newname))
- (make-directory newname parents))
- ;; Set variables for computing the prompt for reading password.
- (setq tramp-current-method method
- tramp-current-user user
- tramp-current-domain domain
- tramp-current-host host
- tramp-current-port port)
- (let* ((share (tramp-smb-get-share v))
- (localname (file-name-as-directory
- (replace-regexp-in-string
- "\\\\" "/" (tramp-smb-get-localname v))))
- (tmpdir (make-temp-name
- (expand-file-name
- tramp-temp-name-prefix
- (tramp-compat-temporary-file-directory))))
- (args (list (concat "//" host "/" share) "-E")))
- (if (not (zerop (length user)))
- (setq args (append args (list "-U" user)))
- (setq args (append args (list "-N"))))
- (when domain (setq args (append args (list "-W" domain))))
- (when port (setq args (append args (list "-p" port))))
- (when tramp-smb-conf
- (setq args (append args (list "-s" tramp-smb-conf))))
- (setq args
- (if t1
- ;; Source is remote.
- (append args
- (list "-D" (tramp-unquote-shell-quote-argument
- localname)
- "-c" (shell-quote-argument "tar qc - *")
- "|" "tar" "xfC" "-"
- (tramp-unquote-shell-quote-argument
- tmpdir)))
- ;; Target is remote.
- (append (list "tar" "cfC" "-"
- (tramp-unquote-shell-quote-argument dirname)
- "." "|")
- args
- (list "-D" (tramp-unquote-shell-quote-argument
- localname)
- "-c" (shell-quote-argument "tar qx -")))))
- (unwind-protect
- (with-temp-buffer
- ;; Set the transfer process properties.
- (tramp-set-connection-property
- v "process-name" (buffer-name (current-buffer)))
- (tramp-set-connection-property
- v "process-buffer" (current-buffer))
- (when t1
- ;; The smbclient tar command creates always
- ;; complete paths. We must emulate the
- ;; directory structure, and symlink to the real
- ;; target.
- (make-directory
- (expand-file-name
- ".." (concat tmpdir localname))
- 'parents)
- (make-symbolic-link
- newname (directory-file-name (concat tmpdir localname))))
- ;; Use an asynchronous processes. By this,
- ;; password can be handled.
- (let* ((default-directory tmpdir)
- (p (apply
- 'start-process
- (tramp-get-connection-name v)
- (tramp-get-connection-buffer v)
- tramp-smb-program args)))
- (tramp-message
- v 6 "%s" (mapconcat 'identity (process-command p) " "))
- (tramp-set-connection-property p "vector" v)
- (process-put p 'adjust-window-size-function 'ignore)
- (set-process-query-on-exit-flag p nil)
- (tramp-process-actions p v nil tramp-smb-actions-with-tar)
- (while (process-live-p p)
- (sit-for 0.1))
- (tramp-message v 6 "\n%s" (buffer-string))))
- ;; Reset the transfer process properties.
- (tramp-set-connection-property v "process-name" nil)
- (tramp-set-connection-property v "process-buffer" nil)
- (when t1 (delete-directory tmpdir 'recurse))))
- ;; Handle KEEP-DATE argument.
- (when keep-date
- (set-file-times
- newname
- (tramp-compat-file-attribute-modification-time
- (file-attributes dirname))))
- ;; Set the mode.
- (unless keep-date
- (set-file-modes newname (tramp-default-file-modes dirname)))
- ;; When newname did exist, we have wrong cached values.
- (when t2
- (with-parsed-tramp-file-name newname nil
- (tramp-flush-file-property v (file-name-directory localname))
- (tramp-flush-file-property v localname))))
- ;; We must do it file-wise.
- (t
- (tramp-run-real-handler
- 'copy-directory (list dirname newname keep-date parents)))))))))
- (defun tramp-smb-handle-copy-file
- (filename newname &optional ok-if-already-exists keep-date
- _preserve-uid-gid _preserve-extended-attributes)
- "Like `copy-file' for Tramp files.
- KEEP-DATE has no effect in case NEWNAME resides on an SMB server.
- PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
- (setq filename (expand-file-name filename)
- newname (expand-file-name newname))
- (with-tramp-progress-reporter
- (tramp-dissect-file-name
- (if (tramp-tramp-file-p filename) filename newname))
- 0 (format "Copying %s to %s" filename newname)
- (if (file-directory-p filename)
- (copy-directory
- filename newname keep-date 'parents 'copy-contents)
- (let ((tmpfile (file-local-copy filename)))
- (if tmpfile
- ;; Remote filename.
- (condition-case err
- (rename-file tmpfile newname ok-if-already-exists)
- ((error quit)
- (delete-file tmpfile)
- (signal (car err) (cdr err))))
- ;; Remote newname.
- (when (file-directory-p newname)
- (setq newname
- (expand-file-name (file-name-nondirectory filename) newname)))
- (with-parsed-tramp-file-name newname nil
- (when (and (not ok-if-already-exists)
- (file-exists-p newname))
- (tramp-error v 'file-already-exists newname))
- ;; We must also flush the cache of the directory, because
- ;; `file-attributes' reads the values from there.
- (tramp-flush-file-property v (file-name-directory localname))
- (tramp-flush-file-property v localname)
- (unless (tramp-smb-get-share v)
- (tramp-error
- v 'file-error "Target `%s' must contain a share name" newname))
- (unless (tramp-smb-send-command
- v (format "put \"%s\" \"%s\""
- (tramp-compat-file-name-unquote filename)
- (tramp-smb-get-localname v)))
- (tramp-error
- v 'file-error "Cannot copy `%s' to `%s'" filename newname))))))
- ;; KEEP-DATE handling.
- (when keep-date
- (set-file-times
- newname
- (tramp-compat-file-attribute-modification-time
- (file-attributes filename))))))
- (defun tramp-smb-handle-delete-directory (directory &optional recursive _trash)
- "Like `delete-directory' for Tramp files."
- (setq directory (directory-file-name (expand-file-name directory)))
- (when (file-exists-p directory)
- (when recursive
- (mapc
- (lambda (file)
- (if (file-directory-p file)
- (delete-directory file recursive)
- (delete-file file)))
- ;; We do not want to delete "." and "..".
- (directory-files directory 'full directory-files-no-dot-files-regexp)))
- (with-parsed-tramp-file-name directory nil
- ;; We must also flush the cache of the directory, because
- ;; `file-attributes' reads the values from there.
- (tramp-flush-file-property v (file-name-directory localname))
- (tramp-flush-directory-property v localname)
- (unless (tramp-smb-send-command
- v (format
- "%s \"%s\""
- (if (tramp-smb-get-cifs-capabilities v) "posix_rmdir" "rmdir")
- (tramp-smb-get-localname v)))
- ;; Error.
- (with-current-buffer (tramp-get-connection-buffer v)
- (goto-char (point-min))
- (search-forward-regexp tramp-smb-errors nil t)
- (tramp-error
- v 'file-error "%s `%s'" (match-string 0) directory))))))
- (defun tramp-smb-handle-delete-file (filename &optional _trash)
- "Like `delete-file' for Tramp files."
- (setq filename (expand-file-name filename))
- (when (file-exists-p filename)
- (with-parsed-tramp-file-name filename nil
- ;; We must also flush the cache of the directory, because
- ;; `file-attributes' reads the values from there.
- (tramp-flush-file-property v (file-name-directory localname))
- (tramp-flush-file-property v localname)
- (unless (tramp-smb-send-command
- v (format
- "%s \"%s\""
- (if (tramp-smb-get-cifs-capabilities v) "posix_unlink" "rm")
- (tramp-smb-get-localname v)))
- ;; Error.
- (with-current-buffer (tramp-get-connection-buffer v)
- (goto-char (point-min))
- (search-forward-regexp tramp-smb-errors nil t)
- (tramp-error
- v 'file-error "%s `%s'" (match-string 0) filename))))))
- (defun tramp-smb-handle-directory-files
- (directory &optional full match nosort)
- "Like `directory-files' for Tramp files."
- (let ((result (mapcar 'directory-file-name
- (file-name-all-completions "" directory))))
- ;; Discriminate with regexp.
- (when match
- (setq result
- (delete nil
- (mapcar (lambda (x) (when (string-match match x) x))
- result))))
- ;; Append directory.
- (when full
- (setq result
- (mapcar
- (lambda (x) (format "%s/%s" directory x))
- result)))
- ;; Sort them if necessary.
- (unless nosort (setq result (sort result 'string-lessp)))
- result))
- (defun tramp-smb-handle-expand-file-name (name &optional dir)
- "Like `expand-file-name' for Tramp files."
- ;; If DIR is not given, use DEFAULT-DIRECTORY or "/".
- (setq dir (or dir default-directory "/"))
- ;; Unless NAME is absolute, concat DIR and NAME.
- (unless (file-name-absolute-p name)
- (setq name (concat (file-name-as-directory dir) name)))
- ;; If NAME is not a Tramp file, run the real handler.
- (if (not (tramp-tramp-file-p name))
- (tramp-run-real-handler 'expand-file-name (list name nil))
- ;; Dissect NAME.
- (with-parsed-tramp-file-name name nil
- ;; Tilde expansion if necessary. We use the user name as share,
- ;; which is often the case in domains.
- (when (string-match "\\`/?~\\([^/]*\\)" localname)
- (setq localname
- (replace-match
- (if (zerop (length (match-string 1 localname)))
- user
- (match-string 1 localname))
- nil nil localname)))
- ;; Make the file name absolute.
- (unless (tramp-run-real-handler 'file-name-absolute-p (list localname))
- (setq localname (concat "/" localname)))
- ;; No tilde characters in file name, do normal
- ;; `expand-file-name' (this does "/./" and "/../").
- (tramp-make-tramp-file-name
- method user domain host port
- (tramp-run-real-handler 'expand-file-name (list localname))))))
- (defun tramp-smb-action-get-acl (proc vec)
- "Read ACL data from connection buffer."
- (unless (process-live-p proc)
- ;; Accept pending output.
- (while (tramp-accept-process-output proc 0.1))
- (with-current-buffer (tramp-get-connection-buffer vec)
- ;; There might be a hidden password prompt.
- (widen)
- (tramp-message vec 10 "\n%s" (buffer-string))
- (goto-char (point-min))
- (while (and (not (eobp)) (not (looking-at "^REVISION:")))
- (forward-line)
- (delete-region (point-min) (point)))
- (while (and (not (eobp)) (looking-at "^.+:.+"))
- (forward-line))
- (delete-region (point) (point-max))
- (throw 'tramp-action 'ok))))
- (defun tramp-smb-handle-file-acl (filename)
- "Like `file-acl' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (with-tramp-file-property v localname "file-acl"
- (when (executable-find tramp-smb-acl-program)
- ;; Set variables for computing the prompt for reading password.
- (setq tramp-current-method method
- tramp-current-user user
- tramp-current-domain domain
- tramp-current-host host
- tramp-current-port port)
- (let* ((share (tramp-smb-get-share v))
- (localname (replace-regexp-in-string
- "\\\\" "/" (tramp-smb-get-localname v)))
- (args (list (concat "//" host "/" share) "-E")))
- (if (not (zerop (length user)))
- (setq args (append args (list "-U" user)))
- (setq args (append args (list "-N"))))
- (when domain (setq args (append args (list "-W" domain))))
- (when port (setq args (append args (list "-p" port))))
- (when tramp-smb-conf
- (setq args (append args (list "-s" tramp-smb-conf))))
- (setq
- args
- (append args (list (tramp-unquote-shell-quote-argument localname)
- "2>/dev/null")))
- (unwind-protect
- (with-temp-buffer
- ;; Set the transfer process properties.
- (tramp-set-connection-property
- v "process-name" (buffer-name (current-buffer)))
- (tramp-set-connection-property
- v "process-buffer" (current-buffer))
- ;; Use an asynchronous processes. By this, password
- ;; can be handled.
- (let ((p (apply
- 'start-process
- (tramp-get-connection-name v)
- (tramp-get-connection-buffer v)
- tramp-smb-acl-program args)))
- (tramp-message
- v 6 "%s" (mapconcat 'identity (process-command p) " "))
- (tramp-set-connection-property p "vector" v)
- (process-put p 'adjust-window-size-function 'ignore)
- (set-process-query-on-exit-flag p nil)
- (tramp-process-actions p v nil tramp-smb-actions-get-acl)
- (when (> (point-max) (point-min))
- (substring-no-properties (buffer-string)))))
- ;; Reset the transfer process properties.
- (tramp-set-connection-property v "process-name" nil)
- (tramp-set-connection-property v "process-buffer" nil)))))))
- (defun tramp-smb-handle-file-attributes (filename &optional id-format)
- "Like `file-attributes' for Tramp files."
- (unless id-format (setq id-format 'integer))
- (ignore-errors
- (with-parsed-tramp-file-name filename nil
- (with-tramp-file-property
- v localname (format "file-attributes-%s" id-format)
- (if (tramp-smb-get-stat-capability v)
- (tramp-smb-do-file-attributes-with-stat v id-format)
- ;; Reading just the filename entry via "dir localname" is not
- ;; possible, because when filename is a directory, some
- ;; smbclient versions return the content of the directory, and
- ;; other versions don't. Therefore, the whole content of the
- ;; upper directory is retrieved, and the entry of the filename
- ;; is extracted from.
- (let* ((entries (tramp-smb-get-file-entries
- (file-name-directory filename)))
- (entry (assoc (file-name-nondirectory filename) entries))
- (uid (if (equal id-format 'string) "nobody" -1))
- (gid (if (equal id-format 'string) "nogroup" -1))
- (inode (tramp-get-inode v))
- (device (tramp-get-device v)))
- ;; Check result.
- (when entry
- (list (and (string-match "d" (nth 1 entry))
- t) ;0 file type
- -1 ;1 link count
- uid ;2 uid
- gid ;3 gid
- '(0 0) ;4 atime
- (nth 3 entry) ;5 mtime
- '(0 0) ;6 ctime
- (nth 2 entry) ;7 size
- (nth 1 entry) ;8 mode
- nil ;9 gid weird
- inode ;10 inode number
- device)))))))) ;11 file system number
- (defun tramp-smb-do-file-attributes-with-stat (vec &optional id-format)
- "Implement `file-attributes' for Tramp files using stat command."
- (tramp-message
- vec 5 "file attributes with stat: %s" (tramp-file-name-localname vec))
- (with-current-buffer (tramp-get-connection-buffer vec)
- (let* (size id link uid gid atime mtime ctime mode inode)
- (when (tramp-smb-send-command
- vec (format "stat \"%s\"" (tramp-smb-get-localname vec)))
- ;; Loop the listing.
- (goto-char (point-min))
- (unless (re-search-forward tramp-smb-errors nil t)
- (while (not (eobp))
- (cond
- ((looking-at
- "Size:\\s-+\\([0-9]+\\)\\s-+Blocks:\\s-+[0-9]+\\s-+\\(\\w+\\)")
- (setq size (string-to-number (match-string 1))
- id (if (string-equal "directory" (match-string 2)) t
- (if (string-equal "symbolic" (match-string 2)) ""))))
- ((looking-at
- "Inode:\\s-+\\([0-9]+\\)\\s-+Links:\\s-+\\([0-9]+\\)")
- (setq inode (string-to-number (match-string 1))
- link (string-to-number (match-string 2))))
- ((looking-at
- "Access:\\s-+([0-9]+/\\(\\S-+\\))\\s-+Uid:\\s-+\\([0-9]+\\)\\s-+Gid:\\s-+\\([0-9]+\\)")
- (setq mode (match-string 1)
- uid (if (equal id-format 'string) (match-string 2)
- (string-to-number (match-string 2)))
- gid (if (equal id-format 'string) (match-string 3)
- (string-to-number (match-string 3)))))
- ((looking-at
- "Access:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)")
- (setq atime
- (encode-time
- (string-to-number (match-string 6)) ;; sec
- (string-to-number (match-string 5)) ;; min
- (string-to-number (match-string 4)) ;; hour
- (string-to-number (match-string 3)) ;; day
- (string-to-number (match-string 2)) ;; month
- (string-to-number (match-string 1))))) ;; year
- ((looking-at
- "Modify:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)")
- (setq mtime
- (encode-time
- (string-to-number (match-string 6)) ;; sec
- (string-to-number (match-string 5)) ;; min
- (string-to-number (match-string 4)) ;; hour
- (string-to-number (match-string 3)) ;; day
- (string-to-number (match-string 2)) ;; month
- (string-to-number (match-string 1))))) ;; year
- ((looking-at
- "Change:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)")
- (setq ctime
- (encode-time
- (string-to-number (match-string 6)) ;; sec
- (string-to-number (match-string 5)) ;; min
- (string-to-number (match-string 4)) ;; hour
- (string-to-number (match-string 3)) ;; day
- (string-to-number (match-string 2)) ;; month
- (string-to-number (match-string 1)))))) ;; year
- (forward-line))
- ;; Resolve symlink.
- (when (and (stringp id)
- (tramp-smb-send-command
- vec
- (format "readlink \"%s\"" (tramp-smb-get-localname vec))))
- (goto-char (point-min))
- (and (looking-at ".+ -> \\(.+\\)")
- (setq id (match-string 1))))
- ;; Return the result.
- (list id link uid gid atime mtime ctime size mode nil inode
- (tramp-get-device vec)))))))
- (defun tramp-smb-handle-file-directory-p (filename)
- "Like `file-directory-p' for Tramp files."
- (and (file-exists-p filename)
- (eq ?d
- (aref (tramp-compat-file-attribute-modes (file-attributes filename))
- 0))))
- (defun tramp-smb-handle-file-local-copy (filename)
- "Like `file-local-copy' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (unless (file-exists-p filename)
- (tramp-error
- v tramp-file-missing
- "Cannot make local copy of non-existing file `%s'" filename))
- (let ((tmpfile (tramp-compat-make-temp-file filename)))
- (with-tramp-progress-reporter
- v 3 (format "Fetching %s to tmp file %s" filename tmpfile)
- (unless (tramp-smb-send-command
- v (format "get \"%s\" \"%s\""
- (tramp-smb-get-localname v) tmpfile))
- ;; Oops, an error. We shall cleanup.
- (delete-file tmpfile)
- (tramp-error
- v 'file-error "Cannot make local copy of file `%s'" filename)))
- tmpfile)))
- ;; This function should return "foo/" for directories and "bar" for
- ;; files.
- (defun tramp-smb-handle-file-name-all-completions (filename directory)
- "Like `file-name-all-completions' for Tramp files."
- (all-completions
- filename
- (with-parsed-tramp-file-name (expand-file-name directory) nil
- (with-tramp-file-property v localname "file-name-all-completions"
- (save-match-data
- (delete-dups
- (mapcar
- (lambda (x)
- (list
- (if (string-match "d" (nth 1 x))
- (file-name-as-directory (nth 0 x))
- (nth 0 x))))
- (tramp-smb-get-file-entries directory))))))))
- (defun tramp-smb-handle-file-truename (filename)
- "Like `file-truename' for Tramp files."
- (format
- "%s%s"
- (with-parsed-tramp-file-name (expand-file-name filename) nil
- (tramp-make-tramp-file-name
- method user domain host port
- (with-tramp-file-property v localname "file-truename"
- (funcall
- (if (tramp-compat-file-name-quoted-p localname)
- 'tramp-compat-file-name-quote 'identity)
- ;; We don't follow symlink of symlink.
- (or (file-symlink-p filename) localname)))))
- ;; Preserve trailing "/".
- (if (string-equal (file-name-nondirectory filename) "") "/" "")))
- (defun tramp-smb-handle-file-writable-p (filename)
- "Like `file-writable-p' for Tramp files."
- (if (file-exists-p filename)
- (string-match
- "w"
- (or (tramp-compat-file-attribute-modes (file-attributes filename)) ""))
- (let ((dir (file-name-directory filename)))
- (and (file-exists-p dir)
- (file-writable-p dir)))))
- (defun tramp-smb-handle-insert-directory
- (filename switches &optional wildcard full-directory-p)
- "Like `insert-directory' for Tramp files."
- (setq filename (expand-file-name filename))
- (unless switches (setq switches ""))
- ;; Mark trailing "/".
- (when (and (zerop (length (file-name-nondirectory filename)))
- (not full-directory-p))
- (setq switches (concat switches "F")))
- (if full-directory-p
- ;; Called from `dired-add-entry'.
- (setq filename (file-name-as-directory filename))
- (setq filename (directory-file-name filename)))
- (with-parsed-tramp-file-name filename nil
- (with-tramp-progress-reporter v 0 (format "Opening directory %s" filename)
- (save-match-data
- (let ((base (file-name-nondirectory filename))
- ;; We should not destroy the cache entry.
- (entries (copy-sequence
- (tramp-smb-get-file-entries
- (file-name-directory filename)))))
- (when wildcard
- (string-match "\\." base)
- (setq base (replace-match "\\\\." nil nil base))
- (string-match "\\*" base)
- (setq base (replace-match ".*" nil nil base))
- (string-match "\\?" base)
- (setq base (replace-match ".?" nil nil base)))
- ;; Filter entries.
- (setq entries
- (delq
- nil
- (if (or wildcard (zerop (length base)))
- ;; Check for matching entries.
- (mapcar
- (lambda (x)
- (when (string-match
- (format "^%s" base) (nth 0 x))
- x))
- entries)
- ;; We just need the only and only entry FILENAME.
- (list (assoc base entries)))))
- ;; Sort entries.
- (setq entries
- (sort
- entries
- (lambda (x y)
- (if (string-match "t" switches)
- ;; Sort by date.
- (time-less-p (nth 3 y) (nth 3 x))
- ;; Sort by name.
- (string-lessp (nth 0 x) (nth 0 y))))))
- ;; Handle "-F" switch.
- (when (string-match "F" switches)
- (mapc
- (lambda (x)
- (when (not (zerop (length (car x))))
- (cond
- ((char-equal ?d (string-to-char (nth 1 x)))
- (setcar x (concat (car x) "/")))
- ((char-equal ?x (string-to-char (nth 1 x)))
- (setcar x (concat (car x) "*"))))))
- entries))
- ;; Print entries.
- (mapc
- (lambda (x)
- (when (not (zerop (length (nth 0 x))))
- (when (string-match "l" switches)
- (let ((attr
- (when (tramp-smb-get-stat-capability v)
- (ignore-errors
- (file-attributes filename 'string)))))
- (insert
- (format
- "%10s %3d %-8s %-8s %8s %s "
- (or (tramp-compat-file-attribute-modes attr) (nth 1 x))
- (or (tramp-compat-file-attribute-link-number attr) 1)
- (or (tramp-compat-file-attribute-user-id attr) "nobody")
- (or (tramp-compat-file-attribute-group-id attr) "nogroup")
- (or (tramp-compat-file-attribute-size attr) (nth 2 x))
- (format-time-string
- (if (time-less-p (time-subtract (current-time) (nth 3 x))
- tramp-half-a-year)
- "%b %e %R"
- "%b %e %Y")
- (nth 3 x)))))) ; date
- ;; We mark the file name. The inserted name could be
- ;; from somewhere else, so we use the relative file name
- ;; of `default-directory'.
- (let ((start (point)))
- (insert
- (format
- "%s\n"
- (file-relative-name
- (expand-file-name
- (nth 0 x) (file-name-directory filename))
- (when full-directory-p (file-name-directory filename)))))
- (put-text-property start (1- (point)) 'dired-filename t))
- (forward-line)
- (beginning-of-line)))
- entries))))))
- (defun tramp-smb-handle-make-directory (dir &optional parents)
- "Like `make-directory' for Tramp files."
- (setq dir (directory-file-name (expand-file-name dir)))
- (unless (file-name-absolute-p dir)
- (setq dir (expand-file-name dir default-directory)))
- (with-parsed-tramp-file-name dir nil
- (save-match-data
- (let* ((ldir (file-name-directory dir)))
- ;; Make missing directory parts.
- (when (and parents
- (tramp-smb-get-share v)
- (not (file-directory-p ldir)))
- (make-directory ldir parents))
- ;; Just do it.
- (when (file-directory-p ldir)
- (make-directory-internal dir))
- (unless (file-directory-p dir)
- (tramp-error v 'file-error "Couldn't make directory %s" dir))))))
- (defun tramp-smb-handle-make-directory-internal (directory)
- "Like `make-directory-internal' for Tramp files."
- (setq directory (directory-file-name (expand-file-name directory)))
- (unless (file-name-absolute-p directory)
- (setq directory (expand-file-name directory default-directory)))
- (with-parsed-tramp-file-name directory nil
- (save-match-data
- (let* ((file (tramp-smb-get-localname v)))
- (when (file-directory-p (file-name-directory directory))
- (tramp-smb-send-command
- v
- (if (tramp-smb-get-cifs-capabilities v)
- (format "posix_mkdir \"%s\" %o" file (default-file-modes))
- (format "mkdir \"%s\"" file)))
- ;; We must also flush the cache of the directory, because
- ;; `file-attributes' reads the values from there.
- (tramp-flush-file-property v (file-name-directory localname))
- (tramp-flush-file-property v localname))
- (unless (file-directory-p directory)
- (tramp-error
- v 'file-error "Couldn't make directory %s" directory))))))
- (defun tramp-smb-handle-make-symbolic-link
- (target linkname &optional ok-if-already-exists)
- "Like `make-symbolic-link' for Tramp files.
- If TARGET is a non-Tramp file, it is used verbatim as the target
- of the symlink. If TARGET is a Tramp file, only the localname
- component is used as the target of the symlink."
- (if (not (tramp-tramp-file-p (expand-file-name linkname)))
- (tramp-run-real-handler
- 'make-symbolic-link (list target linkname ok-if-already-exists))
- (with-parsed-tramp-file-name linkname nil
- ;; Do the 'confirm if exists' thing.
- (when (file-exists-p linkname)
- ;; What to do?
- (if (or (null ok-if-already-exists) ; not allowed to exist
- (and (numberp ok-if-already-exists)
- (not (yes-or-no-p
- (format
- "File %s already exists; make it a link anyway? "
- localname)))))
- (tramp-error v 'file-already-exists localname)
- (delete-file linkname)))
- (unless (tramp-smb-get-cifs-capabilities v)
- (tramp-error v 'file-error "make-symbolic-link not supported"))
- ;; If TARGET is a Tramp name, use just the localname component.
- (when (and (tramp-tramp-file-p target)
- (tramp-file-name-equal-p
- v (tramp-dissect-file-name (expand-file-name target))))
- (setq target
- (tramp-file-name-localname
- (tramp-dissect-file-name (expand-file-name target)))))
- ;; We must also flush the cache of the directory, because
- ;; `file-attributes' reads the values from there.
- (tramp-flush-file-property v (file-name-directory localname))
- (tramp-flush-file-property v localname)
- (unless
- (tramp-smb-send-command
- v (format "symlink \"%s\" \"%s\""
- (tramp-compat-file-name-unquote target)
- (tramp-smb-get-localname v)))
- (tramp-error
- v 'file-error
- "error with make-symbolic-link, see buffer `%s' for details"
- (buffer-name))))))
- (defun tramp-smb-handle-process-file
- (program &optional infile destination display &rest args)
- "Like `process-file' for Tramp files."
- ;; The implementation is not complete yet.
- (when (and (numberp destination) (zerop destination))
- (error "Implementation does not handle immediate return"))
- (with-parsed-tramp-file-name default-directory nil
- (let* ((name (file-name-nondirectory program))
- (name1 name)
- (i 0)
- input tmpinput outbuf command ret)
- ;; Determine input.
- (when infile
- (setq infile (expand-file-name infile))
- (if (tramp-equal-remote default-directory infile)
- ;; INFILE is on the same remote host.
- (setq input (with-parsed-tramp-file-name infile nil localname))
- ;; INFILE must be copied to remote host.
- (setq input (tramp-make-tramp-temp-file v)
- tmpinput
- (tramp-make-tramp-file-name method user domain host port input))
- (copy-file infile tmpinput t))
- ;; Transform input into a filename powershell does understand.
- (setq input (format "//%s%s" host input)))
- ;; Determine output.
- (cond
- ;; Just a buffer.
- ((bufferp destination)
- (setq outbuf destination))
- ;; A buffer name.
- ((stringp destination)
- (setq outbuf (get-buffer-create destination)))
- ;; (REAL-DESTINATION ERROR-DESTINATION)
- ((consp destination)
- ;; output.
- (cond
- ((bufferp (car destination))
- (setq outbuf (car destination)))
- ((stringp (car destination))
- (setq outbuf (get-buffer-create (car destination))))
- ((car destination)
- (setq outbuf (current-buffer))))
- ;; stderr.
- (tramp-message v 2 "%s" "STDERR not supported"))
- ;; 't
- (destination
- (setq outbuf (current-buffer))))
- ;; Construct command.
- (setq command (mapconcat 'identity (cons program args) " ")
- command (if input
- (format
- "get-content %s | & %s"
- (tramp-smb-shell-quote-argument input) command)
- (format "& %s" command)))
- (while (get-process name1)
- ;; NAME must be unique as process name.
- (setq i (1+ i)
- name1 (format "%s<%d>" name i)))
- ;; Set the new process properties.
- (tramp-set-connection-property v "process-name" name1)
- (tramp-set-connection-property
- v "process-buffer"
- (or outbuf (generate-new-buffer tramp-temp-buffer-name)))
- ;; Call it.
- (condition-case nil
- (with-current-buffer (tramp-get-connection-buffer v)
- ;; Preserve buffer contents.
- (narrow-to-region (point-max) (point-max))
- (tramp-smb-call-winexe v)
- (when (tramp-smb-get-share v)
- (tramp-smb-send-command
- v (format "cd \"//%s%s\"" host (file-name-directory localname))))
- (tramp-smb-send-command v command)
- ;; Preserve command output.
- (narrow-to-region (point-max) (point-max))
- (let ((p (tramp-get-connection-process v)))
- (tramp-smb-send-command v "exit $lasterrorcode")
- (while (process-live-p p)
- (sleep-for 0.1)
- (setq ret (process-exit-status p))))
- (delete-region (point-min) (point-max))
- (widen))
- ;; When the user did interrupt, we should do it also. We use
- ;; return code -1 as marker.
- (quit
- (setq ret -1))
- ;; Handle errors.
- (error
- (setq ret 1)))
- ;; We should redisplay the output.
- (when (and display outbuf (get-buffer-window outbuf t)) (redisplay))
- ;; Cleanup. We remove all file cache values for the connection,
- ;; because the remote process could have changed them.
- (tramp-set-connection-property v "process-name" nil)
- (tramp-set-connection-property v "process-buffer" nil)
- (when tmpinput (delete-file tmpinput))
- (unless outbuf
- (kill-buffer (tramp-get-connection-property v "process-buffer" nil)))
- (unless process-file-side-effects
- (tramp-flush-directory-property v ""))
- ;; Return exit status.
- (if (equal ret -1)
- (keyboard-quit)
- ret))))
- (defun tramp-smb-handle-rename-file
- (filename newname &optional ok-if-already-exists)
- "Like `rename-file' for Tramp files."
- (setq filename (expand-file-name filename)
- newname (expand-file-name newname))
- (when (and (not ok-if-already-exists)
- (file-exists-p newname))
- (tramp-error
- (tramp-dissect-file-name
- (if (tramp-tramp-file-p filename) filename newname))
- 'file-already-exists newname))
- (with-tramp-progress-reporter
- (tramp-dissect-file-name
- (if (tramp-tramp-file-p filename) filename newname))
- 0 (format "Renaming %s to %s" filename newname)
- (if (and (not (file-exists-p newname))
- (tramp-equal-remote filename newname)
- (string-equal
- (tramp-smb-get-share (tramp-dissect-file-name filename))
- (tramp-smb-get-share (tramp-dissect-file-name newname))))
- ;; We can rename directly.
- (with-parsed-tramp-file-name filename v1
- (with-parsed-tramp-file-name newname v2
- ;; We must also flush the cache of the directory, because
- ;; `file-attributes' reads the values from there.
- (tramp-flush-file-property v1 (file-name-directory v1-localname))
- (tramp-flush-file-property v1 v1-localname)
- (tramp-flush-file-property v2 (file-name-directory v2-localname))
- (tramp-flush-file-property v2 v2-localname)
- (unless (tramp-smb-get-share v2)
- (tramp-error
- v2 'file-error "Target `%s' must contain a share name" newname))
- (unless (tramp-smb-send-command
- v2 (format "rename \"%s\" \"%s\""
- (tramp-smb-get-localname v1)
- (tramp-smb-get-localname v2)))
- (tramp-error v2 'file-error "Cannot rename `%s'" filename))))
- ;; We must rename via copy.
- (copy-file
- filename newname ok-if-already-exists 'keep-time 'preserve-uid-gid)
- (if (file-directory-p filename)
- (delete-directory filename 'recursive)
- (delete-file filename)))))
- (defun tramp-smb-action-set-acl (proc vec)
- "Read ACL data from connection buffer."
- (unless (process-live-p proc)
- ;; Accept pending output.
- (while (tramp-accept-process-output proc 0.1))
- (with-current-buffer (tramp-get-connection-buffer vec)
- (tramp-message vec 10 "\n%s" (buffer-string))
- (throw 'tramp-action 'ok))))
- (defun tramp-smb-handle-set-file-acl (filename acl-string)
- "Like `set-file-acl' for Tramp files."
- (ignore-errors
- (with-parsed-tramp-file-name filename nil
- (when (and (stringp acl-string) (executable-find tramp-smb-acl-program))
- ;; Set variables for computing the prompt for reading password.
- (setq tramp-current-method method
- tramp-current-user user
- tramp-current-domain domain
- tramp-current-host host
- tramp-current-port port)
- (tramp-set-file-property v localname "file-acl" 'undef)
- (let* ((share (tramp-smb-get-share v))
- (localname (replace-regexp-in-string
- "\\\\" "/" (tramp-smb-get-localname v)))
- (args (list (concat "//" host "/" share) "-E" "-S"
- (replace-regexp-in-string
- "\n" "," acl-string))))
- (if (not (zerop (length user)))
- (setq args (append args (list "-U" user)))
- (setq args (append args (list "-N"))))
- (when domain (setq args (append args (list "-W" domain))))
- (when port (setq args (append args (list "-p" port))))
- (when tramp-smb-conf
- (setq args (append args (list "-s" tramp-smb-conf))))
- (setq
- args
- (append args (list (tramp-unquote-shell-quote-argument localname)
- "&&" "echo" "tramp_exit_status" "0"
- "||" "echo" "tramp_exit_status" "1")))
- (unwind-protect
- (with-temp-buffer
- ;; Set the transfer process properties.
- (tramp-set-connection-property
- v "process-name" (buffer-name (current-buffer)))
- (tramp-set-connection-property
- v "process-buffer" (current-buffer))
- ;; Use an asynchronous processes. By this, password can
- ;; be handled.
- (let ((p (apply
- 'start-process
- (tramp-get-connection-name v)
- (tramp-get-connection-buffer v)
- tramp-smb-acl-program args)))
- (tramp-message
- v 6 "%s" (mapconcat 'identity (process-command p) " "))
- (tramp-set-connection-property p "vector" v)
- (process-put p 'adjust-window-size-function 'ignore)
- (set-process-query-on-exit-flag p nil)
- (tramp-process-actions p v nil tramp-smb-actions-set-acl)
- (goto-char (point-max))
- (unless (re-search-backward "tramp_exit_status [0-9]+" nil t)
- (tramp-error
- v 'file-error
- "Couldn't find exit status of `%s'" tramp-smb-acl-program))
- (skip-chars-forward "^ ")
- (when (zerop (read (current-buffer)))
- ;; Success.
- (tramp-set-file-property v localname "file-acl" acl-string)
- t)))
- ;; Reset the transfer process properties.
- (tramp-set-connection-property v "process-name" nil)
- (tramp-set-connection-property v "process-buffer" nil)))))))
- (defun tramp-smb-handle-set-file-modes (filename mode)
- "Like `set-file-modes' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (when (tramp-smb-get-cifs-capabilities v)
- (tramp-flush-file-property v localname)
- (unless (tramp-smb-send-command
- v (format "chmod \"%s\" %o" (tramp-smb-get-localname v) mode))
- (tramp-error
- v 'file-error "Error while changing file's mode %s" filename)))))
- ;; We use BUFFER also as connection buffer during setup. Because of
- ;; this, its original contents must be saved, and restored once
- ;; connection has been setup.
- (defun tramp-smb-handle-start-file-process (name buffer program &rest args)
- "Like `start-file-process' for Tramp files."
- (with-parsed-tramp-file-name default-directory nil
- (let* ((buffer
- (if buffer
- (get-buffer-create buffer)
- ;; BUFFER can be nil. We use a temporary buffer.
- (generate-new-buffer tramp-temp-buffer-name)))
- (command (mapconcat 'identity (cons program args) " "))
- (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
- (name1 name)
- (i 0))
- (unwind-protect
- (save-excursion
- (save-restriction
- (while (get-process name1)
- ;; NAME must be unique as process name.
- (setq i (1+ i)
- name1 (format "%s<%d>" name i)))
- ;; Set the new process properties.
- (tramp-set-connection-property v "process-name" name1)
- (tramp-set-connection-property v "process-buffer" buffer)
- ;; Activate narrowing in order to save BUFFER contents.
- (with-current-buffer (tramp-get-connection-buffer v)
- (let ((buffer-undo-list t))
- (narrow-to-region (point-max) (point-max))
- (tramp-smb-call-winexe v)
- (when (tramp-smb-get-share v)
- (tramp-smb-send-command
- v (format
- "cd \"//%s%s\""
- host (file-name-directory localname))))
- (tramp-message v 6 "(%s); exit" command)
- (tramp-send-string v command)))
- ;; Return value.
- (tramp-get-connection-process v)))
- ;; Save exit.
- (with-current-buffer (tramp-get-connection-buffer v)
- (if (string-match tramp-temp-buffer-name (buffer-name))
- (progn
- (set-process-buffer (tramp-get-connection-process v) nil)
- (kill-buffer (current-buffer)))
- (set-buffer-modified-p bmp)))
- (tramp-set-connection-property v "process-name" nil)
- (tramp-set-connection-property v "process-buffer" nil)))))
- (defun tramp-smb-handle-substitute-in-file-name (filename)
- "Like `handle-substitute-in-file-name' for Tramp files.
- \"//\" substitutes only in the local filename part. Catches
- errors for shares like \"C$/\", which are common in Microsoft Windows."
- ;; Check, whether the local part is a quoted file name.
- (if (tramp-compat-file-name-quoted-p filename)
- filename
- (with-parsed-tramp-file-name filename nil
- ;; Ignore in LOCALNAME everything before "//".
- (when (and (stringp localname) (string-match ".+?/\\(/\\|~\\)" localname))
- (setq filename
- (concat (file-remote-p filename)
- (replace-match "\\1" nil nil localname)))))
- (condition-case nil
- (tramp-run-real-handler 'substitute-in-file-name (list filename))
- (error filename))))
- (defun tramp-smb-handle-write-region
- (start end filename &optional append visit lockname mustbenew)
- "Like `write-region' for Tramp files."
- (setq filename (expand-file-name filename))
- (with-parsed-tramp-file-name filename nil
- (when (and mustbenew (file-exists-p filename)
- (or (eq mustbenew 'excl)
- (not
- (y-or-n-p
- (format "File %s exists; overwrite anyway? " filename)))))
- (tramp-error v 'file-already-exists filename))
- ;; We must also flush the cache of the directory, because
- ;; `file-attributes' reads the values from there.
- (tramp-flush-file-property v (file-name-directory localname))
- (tramp-flush-file-property v localname)
- (let ((curbuf (current-buffer))
- (tmpfile (tramp-compat-make-temp-file filename)))
- (when (and append (file-exists-p filename))
- (copy-file filename tmpfile 'ok))
- ;; We say `no-message' here because we don't want the visited file
- ;; modtime data to be clobbered from the temp file. We call
- ;; `set-visited-file-modtime' ourselves later on.
- (tramp-run-real-handler
- 'write-region (list start end tmpfile append 'no-message lockname))
- (with-tramp-progress-reporter
- v 3 (format "Moving tmp file %s to %s" tmpfile filename)
- (unwind-protect
- (unless (tramp-smb-send-command
- v (format "put %s \"%s\""
- tmpfile (tramp-smb-get-localname v)))
- (tramp-error v 'file-error "Cannot write `%s'" filename))
- (delete-file tmpfile)))
- (unless (equal curbuf (current-buffer))
- (tramp-error
- v 'file-error
- "Buffer has changed from `%s' to `%s'" curbuf (current-buffer)))
- (when (eq visit t)
- (set-visited-file-modtime)))))
- ;; Internal file name functions.
- (defun tramp-smb-get-share (vec)
- "Returns the share name of LOCALNAME."
- (save-match-data
- (let ((localname (tramp-file-name-unquote-localname vec)))
- (when (string-match "^/?\\([^/]+\\)/" localname)
- (match-string 1 localname)))))
- (defun tramp-smb-get-localname (vec)
- "Returns the file name of LOCALNAME.
- If VEC has no cifs capabilities, exchange \"/\" by \"\\\\\"."
- (save-match-data
- (let ((localname (tramp-file-name-unquote-localname vec)))
- (setq
- localname
- (if (string-match "^/?[^/]+\\(/.*\\)" localname)
- ;; There is a share, separated by "/".
- (if (not (tramp-smb-get-cifs-capabilities vec))
- (mapconcat
- (lambda (x) (if (equal x ?/) "\\" (char-to-string x)))
- (match-string 1 localname) "")
- (match-string 1 localname))
- ;; There is just a share.
- (if (string-match "^/?\\([^/]+\\)$" localname)
- (match-string 1 localname)
- "")))
- ;; Sometimes we have discarded `substitute-in-file-name'.
- (when (string-match "\\(\\$\\$\\)\\(/\\|$\\)" localname)
- (setq localname (replace-match "$" nil nil localname 1)))
- localname)))
- ;; Share names of a host are cached. It is very unlikely that the
- ;; shares do change during connection.
- (defun tramp-smb-get-file-entries (directory)
- "Read entries which match DIRECTORY.
- Either the shares are listed, or the `dir' command is executed.
- Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)."
- (with-parsed-tramp-file-name (file-name-as-directory directory) nil
- (setq localname (or localname "/"))
- (with-tramp-file-property v localname "file-entries"
- (with-current-buffer (tramp-get-connection-buffer v)
- (let* ((share (tramp-smb-get-share v))
- (cache (tramp-get-connection-property v "share-cache" nil))
- res entry)
- (if (and (not share) cache)
- ;; Return cached shares.
- (setq res cache)
- ;; Read entries.
- (if share
- (tramp-smb-send-command
- v (format "dir \"%s*\"" (tramp-smb-get-localname v)))
- ;; `tramp-smb-maybe-open-connection' lists also the share names.
- (tramp-smb-maybe-open-connection v))
- ;; Loop the listing.
- (goto-char (point-min))
- (if (re-search-forward tramp-smb-errors nil t)
- (tramp-error v 'file-error "%s `%s'" (match-string 0) directory)
- (while (not (eobp))
- (setq entry (tramp-smb-read-file-entry share))
- (forward-line)
- (when entry (push entry res))))
- ;; Cache share entries.
- (unless share
- (tramp-set-connection-property v "share-cache" res)))
- ;; Add directory itself.
- (push '("" "drwxrwxrwx" 0 (0 0)) res)
- ;; Return entries.
- (delq nil res))))))
- ;; Return either a share name (if SHARE is nil), or a file name.
- ;;
- ;; If shares are listed, the following format is expected:
- ;;
- ;; Disk| - leading spaces
- ;; [^|]+| - share name, 14 char
- ;; .* - comment
- ;;
- ;; Entries provided by smbclient DIR aren't fully regular.
- ;; They should have the format
- ;;
- ;; \s-\{2,2} - leading spaces
- ;; \S-\(.*\S-\)\s-* - file name, 30 chars, left bound
- ;; \s-+[ADHRSV]* - permissions, 7 chars, right bound
- ;; \s- - space delimiter
- ;; \s-+[0-9]+ - size, 8 chars, right bound
- ;; \s-\{2,2\} - space delimiter
- ;; \w\{3,3\} - weekday
- ;; \s- - space delimiter
- ;; \w\{3,3\} - month
- ;; \s- - space delimiter
- ;; [ 12][0-9] - day
- ;; \s- - space delimiter
- ;; [0-9]\{2,2\}:[0-9]\{2,2\}:[0-9]\{2,2\} - time
- ;; \s- - space delimiter
- ;; [0-9]\{4,4\} - year
- ;;
- ;; samba/src/client.c (http://samba.org/doxygen/samba/client_8c-source.html)
- ;; has function display_finfo:
- ;;
- ;; d_printf(" %-30s%7.7s %8.0f %s",
- ;; finfo->name,
- ;; attrib_string(finfo->mode),
- ;; (double)finfo->size,
- ;; asctime(LocalTime(&t)));
- ;;
- ;; in Samba 1.9, there's the following code:
- ;;
- ;; DEBUG(0,(" %-30s%7.7s%10d %s",
- ;; CNV_LANG(finfo->name),
- ;; attrib_string(finfo->mode),
- ;; finfo->size,
- ;; asctime(LocalTime(&t))));
- ;;
- ;; Problems:
- ;; * Modern regexp constructs, like spy groups and counted repetitions, aren't
- ;; available in older Emacsen.
- ;; * The length of constructs (file name, size) might exceed the default.
- ;; * File names might contain spaces.
- ;; * Permissions might be empty.
- ;;
- ;; So we try to analyze backwards.
- (defun tramp-smb-read-file-entry (share)
- "Parse entry in SMB output buffer.
- If SHARE is result, entries are of type dir. Otherwise, shares are listed.
- Result is the list (LOCALNAME MODE SIZE MTIME)."
- ;; We are called from `tramp-smb-get-file-entries', which sets the
- ;; current buffer.
- (let ((line (buffer-substring (point) (point-at-eol)))
- localname mode size month day hour min sec year mtime)
- (if (not share)
- ;; Read share entries.
- (when (string-match "^Disk|\\([^|]+\\)|" line)
- (setq localname (match-string 1 line)
- mode "dr-xr-xr-x"
- size 0))
- ;; Real listing.
- (cl-block nil
- ;; year.
- (if (string-match "\\([0-9]+\\)$" line)
- (setq year (string-to-number (match-string 1 line))
- line (substring line 0 -5))
- (cl-return))
- ;; time.
- (if (string-match "\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)$" line)
- (setq hour (string-to-number (match-string 1 line))
- min (string-to-number (match-string 2 line))
- sec (string-to-number (match-string 3 line))
- line (substring line 0 -9))
- (cl-return))
- ;; day.
- (if (string-match "\\([0-9]+\\)$" line)
- (setq day (string-to-number (match-string 1 line))
- line (substring line 0 -3))
- (cl-return))
- ;; month.
- (if (string-match "\\(\\w+\\)$" line)
- (setq month (match-string 1 line)
- line (substring line 0 -4))
- (cl-return))
- ;; weekday.
- (if (string-match "\\(\\w+\\)$" line)
- (setq line (substring line 0 -5))
- (cl-return))
- ;; size.
- (if (string-match "\\([0-9]+\\)$" line)
- (let ((length (- (max 10 (1+ (length (match-string 1 line)))))))
- (setq size (string-to-number (match-string 1 line)))
- (when (string-match "\\([ADHRSV]+\\)" (substring line length))
- (setq length (+ length (match-end 0))))
- (setq line (substring line 0 length)))
- (cl-return))
- ;; mode: ARCH, DIR, HIDDEN, RONLY, SYSTEM, VOLID.
- (if (string-match "\\([ADHRSV]+\\)?$" line)
- (setq
- mode (or (match-string 1 line) "")
- mode (save-match-data (format
- "%s%s"
- (if (string-match "D" mode) "d" "-")
- (mapconcat
- (lambda (_x) "") " "
- (concat "r" (if (string-match "R" mode) "-" "w") "x"))))
- line (substring line 0 -6))
- (cl-return))
- ;; localname.
- (if (string-match "^\\s-+\\(\\S-\\(.*\\S-\\)?\\)\\s-*$" line)
- (setq localname (match-string 1 line))
- (cl-return))))
- (when (and localname mode size)
- (setq mtime
- (if (and sec min hour day month year)
- (encode-time
- sec min hour day
- (cdr (assoc (downcase month) parse-time-months))
- year)
- '(0 0)))
- (list localname mode size mtime))))
- (defun tramp-smb-get-cifs-capabilities (vec)
- "Check, whether the SMB server supports POSIX commands."
- ;; When we are not logged in yet, we return nil.
- (if (process-live-p (tramp-get-connection-process vec))
- (with-tramp-connection-property
- (tramp-get-connection-process vec) "cifs-capabilities"
- (save-match-data
- (when (tramp-smb-send-command vec "posix")
- (with-current-buffer (tramp-get-connection-buffer vec)
- (goto-char (point-min))
- (when
- (re-search-forward "Server supports CIFS capabilities" nil t)
- (member
- "pathnames"
- (split-string
- (buffer-substring (point) (point-at-eol)) nil 'omit)))))))))
- (defun tramp-smb-get-stat-capability (vec)
- "Check, whether the SMB server supports the STAT command."
- ;; When we are not logged in yet, we return nil.
- (if (and (tramp-smb-get-share vec)
- (process-live-p (tramp-get-connection-process vec)))
- (with-tramp-connection-property
- (tramp-get-connection-process vec) "stat-capability"
- (tramp-smb-send-command vec "stat \"/\""))))
- ;; Connection functions.
- (defun tramp-smb-send-command (vec command)
- "Send the COMMAND to connection VEC.
- Returns nil if there has been an error message from smbclient."
- (tramp-smb-maybe-open-connection vec)
- (tramp-message vec 6 "%s" command)
- (tramp-send-string vec command)
- (tramp-smb-wait-for-output vec))
- (defun tramp-smb-maybe-open-connection (vec &optional argument)
- "Maybe open a connection to HOST, log in as USER, using `tramp-smb-program'.
- Does not do anything if a connection is already open, but re-opens the
- connection if a previous connection has died for some reason.
- If ARGUMENT is non-nil, use it as argument for
- `tramp-smb-winexe-program', and suppress any checks."
- (let* ((share (tramp-smb-get-share vec))
- (buf (tramp-get-connection-buffer vec))
- (p (get-buffer-process buf)))
- ;; Check whether we still have the same smbclient version.
- ;; Otherwise, we must delete the connection cache, because
- ;; capabilities migh have changed.
- (unless (or argument (processp p))
- (let ((default-directory (tramp-compat-temporary-file-directory))
- (command (concat tramp-smb-program " -V")))
- (unless tramp-smb-version
- (unless (executable-find tramp-smb-program)
- (tramp-error
- vec 'file-error
- "Cannot find command %s in %s" tramp-smb-program exec-path))
- (setq tramp-smb-version (shell-command-to-string command))
- (tramp-message vec 6 command)
- (tramp-message vec 6 "\n%s" tramp-smb-version)
- (if (string-match "[ \t\n\r]+\\'" tramp-smb-version)
- (setq tramp-smb-version
- (replace-match "" nil nil tramp-smb-version))))
- (unless (string-equal
- tramp-smb-version
- (tramp-get-connection-property
- vec "smbclient-version" tramp-smb-version))
- (tramp-flush-directory-property vec "")
- (tramp-flush-connection-property vec))
- (tramp-set-connection-property
- vec "smbclient-version" tramp-smb-version)))
- ;; If too much time has passed since last command was sent, look
- ;; whether there has been an error message; maybe due to
- ;; connection timeout.
- (with-current-buffer buf
- (goto-char (point-min))
- (when (and (> (tramp-time-diff
- (current-time)
- (tramp-get-connection-property
- p "last-cmd-time" '(0 0 0)))
- 60)
- (process-live-p p)
- (re-search-forward tramp-smb-errors nil t))
- (delete-process p)
- (setq p nil)))
- ;; Check whether it is still the same share.
- (unless (and (process-live-p p)
- (or argument
- (string-equal
- share
- (tramp-get-connection-property p "smb-share" ""))))
- (save-match-data
- ;; There might be unread output from checking for share names.
- (when buf (with-current-buffer buf (erase-buffer)))
- (when (and p (processp p)) (delete-process p))
- (let* ((user (tramp-file-name-user vec))
- (host (tramp-file-name-host vec))
- (domain (tramp-file-name-domain vec))
- (port (tramp-file-name-port vec))
- args)
- (cond
- (argument
- (setq args (list (concat "//" host))))
- (share
- (setq args (list (concat "//" host "/" share))))
- (t
- (setq args (list "-g" "-L" host ))))
- (if (not (zerop (length user)))
- (setq args (append args (list "-U" user)))
- (setq args (append args (list "-N"))))
- (when domain (setq args (append args (list "-W" domain))))
- (when port (setq args (append args (list "-p" port))))
- (when tramp-smb-conf
- (setq args (append args (list "-s" tramp-smb-conf))))
- (when argument
- (setq args (append args (list argument))))
- ;; OK, let's go.
- (with-tramp-progress-reporter
- vec 3
- (format "Opening connection for //%s%s/%s"
- (if (not (zerop (length user))) (concat user "@") "")
- host (or share ""))
- (let* ((coding-system-for-read nil)
- (process-connection-type tramp-process-connection-type)
- (p (let ((default-directory
- (tramp-compat-temporary-file-directory)))
- (apply #'start-process
- (tramp-get-connection-name vec)
- (tramp-get-connection-buffer vec)
- (if argument
- tramp-smb-winexe-program tramp-smb-program)
- args))))
- (tramp-message
- vec 6 "%s" (mapconcat 'identity (process-command p) " "))
- (tramp-set-connection-property p "vector" vec)
- (process-put p 'adjust-window-size-function 'ignore)
- (set-process-query-on-exit-flag p nil)
- ;; Set variables for computing the prompt for reading password.
- (setq tramp-current-method tramp-smb-method
- tramp-current-user user
- tramp-current-domain domain
- tramp-current-host host
- tramp-current-port port)
- (condition-case err
- (let (tramp-message-show-message)
- ;; Play login scenario.
- (tramp-process-actions
- p vec nil
- (if (or argument share)
- tramp-smb-actions-with-share
- tramp-smb-actions-without-share))
- ;; Check server version.
- (unless argument
- (with-current-buffer (tramp-get-connection-buffer vec)
- (goto-char (point-min))
- (search-forward-regexp tramp-smb-server-version nil t)
- (let ((smbserver-version (match-string 0)))
- (unless
- (string-equal
- smbserver-version
- (tramp-get-connection-property
- vec "smbserver-version" smbserver-version))
- (tramp-flush-directory-property vec "")
- (tramp-flush-connection-property vec))
- (tramp-set-connection-property
- vec "smbserver-version" smbserver-version))))
- ;; Set chunksize to 1. smbclient reads its input
- ;; character by character; if we send the string
- ;; at once, it is read painfully slow.
- (tramp-set-connection-property p "smb-share" share)
- (tramp-set-connection-property p "chunksize" 1)
- ;; Set connection-local variables.
- (tramp-set-connection-local-variables vec)
- ;; Mark it as connected.
- (tramp-set-connection-property p "connected" t))
- ;; Check for the error reason. If it was due to wrong
- ;; password, reestablish the connection. We cannot
- ;; handle this in `tramp-process-actions', because
- ;; smbclient does not ask for the password, again.
- (error
- (with-current-buffer (tramp-get-connection-buffer vec)
- (goto-char (point-min))
- (if (and (bound-and-true-p auth-sources)
- (search-forward-regexp
- tramp-smb-wrong-passwd-regexp nil t))
- ;; Disable `auth-source' and `password-cache'.
- (let (auth-sources)
- (tramp-message
- vec 3 "Retry connection with new password")
- (tramp-cleanup-connection vec t)
- (tramp-smb-maybe-open-connection vec argument))
- ;; Propagate the error.
- (signal (car err) (cdr err)))))))))))))
- ;; We don't use timeouts. If needed, the caller shall wrap around.
- (defun tramp-smb-wait-for-output (vec)
- "Wait for output from smbclient command.
- Returns nil if an error message has appeared."
- (with-current-buffer (tramp-get-connection-buffer vec)
- (let ((p (get-buffer-process (current-buffer)))
- (found (progn (goto-char (point-min))
- (re-search-forward tramp-smb-prompt nil t)))
- (err (progn (goto-char (point-min))
- (re-search-forward tramp-smb-errors nil t)))
- buffer-read-only)
- ;; Algorithm: get waiting output. See if last line contains
- ;; `tramp-smb-prompt' sentinel or `tramp-smb-errors' strings.
- ;; If not, wait a bit and again get waiting output.
- (while (and (not found) (not err) (process-live-p p))
- ;; Accept pending output.
- (tramp-accept-process-output p 0.1)
- ;; Search for prompt.
- (goto-char (point-min))
- (setq found (re-search-forward tramp-smb-prompt nil t))
- ;; Search for errors.
- (goto-char (point-min))
- (setq err (re-search-forward tramp-smb-errors nil t)))
- ;; When the process is still alive, read pending output.
- (while (and (not found) (process-live-p p))
- ;; Accept pending output.
- (tramp-accept-process-output p 0.1)
- ;; Search for prompt.
- (goto-char (point-min))
- (setq found (re-search-forward tramp-smb-prompt nil t)))
- (tramp-message vec 6 "\n%s" (buffer-string))
- ;; Remove prompt.
- (when found
- (goto-char (point-max))
- (re-search-backward tramp-smb-prompt nil t)
- (delete-region (point) (point-max)))
- ;; Return value is whether no error message has appeared.
- (not err))))
- (defun tramp-smb-kill-winexe-function ()
- "Send SIGKILL to the winexe process."
- (ignore-errors
- (let ((p (get-buffer-process (current-buffer))))
- (when (process-live-p p)
- (signal-process (process-id p) 'SIGINT)))))
- (defun tramp-smb-call-winexe (vec)
- "Apply a remote command, if possible, using `tramp-smb-winexe-program'."
- ;; Check for program.
- (unless (executable-find tramp-smb-winexe-program)
- (tramp-error
- vec 'file-error "Cannot find program: %s" tramp-smb-winexe-program))
- ;; winexe does not supports ports.
- (when (tramp-file-name-port vec)
- (tramp-error vec 'file-error "Port not supported for remote processes"))
- (tramp-smb-maybe-open-connection
- vec
- (format
- "%s %s"
- tramp-smb-winexe-shell-command tramp-smb-winexe-shell-command-switch))
- (set (make-local-variable 'kill-buffer-hook)
- '(tramp-smb-kill-winexe-function))
- ;; Suppress "^M". Shouldn't we specify utf8?
- (set-process-coding-system (tramp-get-connection-process vec) 'raw-text-dos)
- ;; Set width to 128. This avoids mixing prompt and long error messages.
- (tramp-smb-send-command vec "$rawui = (Get-Host).UI.RawUI")
- (tramp-smb-send-command vec "$bufsize = $rawui.BufferSize")
- (tramp-smb-send-command vec "$winsize = $rawui.WindowSize")
- (tramp-smb-send-command vec "$bufsize.Width = 128")
- (tramp-smb-send-command vec "$winsize.Width = 128")
- (tramp-smb-send-command vec "$rawui.BufferSize = $bufsize")
- (tramp-smb-send-command vec "$rawui.WindowSize = $winsize"))
- (defun tramp-smb-shell-quote-argument (s)
- "Similar to `shell-quote-argument', but uses windows cmd syntax."
- (let ((system-type 'ms-dos))
- (tramp-unquote-shell-quote-argument s)))
- (add-hook 'tramp-unload-hook
- (lambda ()
- (unload-feature 'tramp-smb 'force)))
- (provide 'tramp-smb)
- ;;; TODO:
- ;; * Return more comprehensive file permission string.
- ;;
- ;; * Try to remove the inclusion of dummy "" directory. Seems to be at
- ;; several places, especially in `tramp-smb-handle-insert-directory'.
- ;;
- ;; * Ignore case in file names.
- ;;; tramp-smb.el ends here
|