tramp-smb.el 74 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084
  1. ;;; tramp-smb.el --- Tramp access functions for SMB servers -*- lexical-binding:t -*-
  2. ;; Copyright (C) 2002-2017 Free Software Foundation, Inc.
  3. ;; Author: Michael Albinus <michael.albinus@gmx.de>
  4. ;; Keywords: comm, processes
  5. ;; Package: tramp
  6. ;; This file is part of GNU Emacs.
  7. ;; GNU Emacs is free software: you can redistribute it and/or modify
  8. ;; it under the terms of the GNU General Public License as published by
  9. ;; the Free Software Foundation, either version 3 of the License, or
  10. ;; (at your option) any later version.
  11. ;; GNU Emacs is distributed in the hope that it will be useful,
  12. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14. ;; GNU General Public License for more details.
  15. ;; You should have received a copy of the GNU General Public License
  16. ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
  17. ;;; Commentary:
  18. ;; Access functions for SMB servers like SAMBA or M$ Windows from Tramp.
  19. ;;; Code:
  20. (require 'tramp)
  21. ;; Define SMB method ...
  22. ;;;###tramp-autoload
  23. (defconst tramp-smb-method "smb"
  24. "Method to connect SAMBA and M$ SMB servers.")
  25. ;; ... and add it to the method list.
  26. ;;;###tramp-autoload
  27. (unless (memq system-type '(cygwin windows-nt))
  28. (add-to-list 'tramp-methods
  29. `(,tramp-smb-method
  30. ;; We define an empty command, because `tramp-smb-call-winexe'
  31. ;; opens already the powershell. Used in `tramp-handle-shell-command'.
  32. (tramp-remote-shell "")
  33. ;; This is just a guess. We don't know whether the share "C$"
  34. ;; is available for public use, and whether the user has write
  35. ;; access.
  36. (tramp-tmpdir "/C$/Temp")
  37. ;; Another guess. We might implement a better check later on.
  38. (tramp-case-insensitive t))))
  39. ;; Add a default for `tramp-default-user-alist'. Rule: For the SMB method,
  40. ;; the anonymous user is chosen.
  41. ;;;###tramp-autoload
  42. (add-to-list 'tramp-default-user-alist
  43. `(,(concat "\\`" tramp-smb-method "\\'") nil nil))
  44. ;; Add completion function for SMB method.
  45. ;;;###tramp-autoload
  46. (eval-after-load 'tramp
  47. '(tramp-set-completion-function
  48. tramp-smb-method
  49. '((tramp-parse-netrc "~/.netrc"))))
  50. ;;;###tramp-autoload
  51. (defcustom tramp-smb-program "smbclient"
  52. "Name of SMB client to run."
  53. :group 'tramp
  54. :type 'string
  55. :require 'tramp)
  56. ;;;###tramp-autoload
  57. (defcustom tramp-smb-acl-program "smbcacls"
  58. "Name of SMB acls to run."
  59. :group 'tramp
  60. :type 'string
  61. :version "24.4"
  62. :require 'tramp)
  63. ;;;###tramp-autoload
  64. (defcustom tramp-smb-conf "/dev/null"
  65. "Path of the smb.conf file.
  66. If it is nil, no smb.conf will be added to the `tramp-smb-program'
  67. call, letting the SMB client use the default one."
  68. :group 'tramp
  69. :type '(choice (const nil) (file :must-match t))
  70. :require 'tramp)
  71. (defvar tramp-smb-version nil
  72. "Version string of the SMB client.")
  73. (defconst tramp-smb-server-version
  74. "Domain=\\[[^]]*\\] OS=\\[[^]]*\\] Server=\\[[^]]*\\]"
  75. "Regexp of SMB server identification.")
  76. (defconst tramp-smb-prompt "^\\(smb:\\|PS\\) .+> \\|^\\s-+Server\\s-+Comment$"
  77. "Regexp used as prompt in smbclient or powershell.")
  78. (defconst tramp-smb-wrong-passwd-regexp
  79. (regexp-opt
  80. '("NT_STATUS_LOGON_FAILURE"
  81. "NT_STATUS_WRONG_PASSWORD"))
  82. "Regexp for login error strings of SMB servers.")
  83. (defconst tramp-smb-errors
  84. (mapconcat
  85. 'identity
  86. `(;; Connection error / timeout / unknown command.
  87. "Connection\\( to \\S-+\\)? failed"
  88. "Read from server failed, maybe it closed the connection"
  89. "Call timed out: server did not respond"
  90. "\\S-+: command not found"
  91. "Server doesn't support UNIX CIFS calls"
  92. ,(regexp-opt
  93. '(;; Samba.
  94. "ERRDOS"
  95. "ERRHRD"
  96. "ERRSRV"
  97. "ERRbadfile"
  98. "ERRbadpw"
  99. "ERRfilexists"
  100. "ERRnoaccess"
  101. "ERRnomem"
  102. "ERRnosuchshare"
  103. ;; Windows 4.0 (Windows NT), Windows 5.0 (Windows 2000),
  104. ;; Windows 5.1 (Windows XP), Windows 5.2 (Windows Server 2003),
  105. ;; Windows 6.0 (Windows Vista), Windows 6.1 (Windows 7),
  106. ;; Windows 6.3 (Windows Server 2012, Windows 10).
  107. "NT_STATUS_ACCESS_DENIED"
  108. "NT_STATUS_ACCOUNT_LOCKED_OUT"
  109. "NT_STATUS_BAD_NETWORK_NAME"
  110. "NT_STATUS_CANNOT_DELETE"
  111. "NT_STATUS_CONNECTION_REFUSED"
  112. "NT_STATUS_DIRECTORY_NOT_EMPTY"
  113. "NT_STATUS_DUPLICATE_NAME"
  114. "NT_STATUS_FILE_IS_A_DIRECTORY"
  115. "NT_STATUS_HOST_UNREACHABLE"
  116. "NT_STATUS_IMAGE_ALREADY_LOADED"
  117. "NT_STATUS_INVALID_LEVEL"
  118. "NT_STATUS_INVALID_PARAMETER_MIX"
  119. "NT_STATUS_IO_TIMEOUT"
  120. "NT_STATUS_LOGON_FAILURE"
  121. "NT_STATUS_NETWORK_ACCESS_DENIED"
  122. "NT_STATUS_NOT_IMPLEMENTED"
  123. "NT_STATUS_NO_LOGON_SERVERS"
  124. "NT_STATUS_NO_SUCH_FILE"
  125. "NT_STATUS_NO_SUCH_USER"
  126. "NT_STATUS_OBJECT_NAME_COLLISION"
  127. "NT_STATUS_OBJECT_NAME_INVALID"
  128. "NT_STATUS_OBJECT_NAME_NOT_FOUND"
  129. "NT_STATUS_PASSWORD_MUST_CHANGE"
  130. "NT_STATUS_SHARING_VIOLATION"
  131. "NT_STATUS_TRUSTED_RELATIONSHIP_FAILURE"
  132. "NT_STATUS_UNSUCCESSFUL"
  133. "NT_STATUS_WRONG_PASSWORD")))
  134. "\\|")
  135. "Regexp for possible error strings of SMB servers.
  136. Used instead of analyzing error codes of commands.")
  137. (defconst tramp-smb-actions-with-share
  138. '((tramp-smb-prompt tramp-action-succeed)
  139. (tramp-password-prompt-regexp tramp-action-password)
  140. (tramp-wrong-passwd-regexp tramp-action-permission-denied)
  141. (tramp-smb-errors tramp-action-permission-denied)
  142. (tramp-process-alive-regexp tramp-action-process-alive))
  143. "List of pattern/action pairs.
  144. This list is used for login to SMB servers.
  145. See `tramp-actions-before-shell' for more info.")
  146. (defconst tramp-smb-actions-without-share
  147. '((tramp-password-prompt-regexp tramp-action-password)
  148. (tramp-wrong-passwd-regexp tramp-action-permission-denied)
  149. (tramp-smb-errors tramp-action-permission-denied)
  150. (tramp-process-alive-regexp tramp-action-out-of-band))
  151. "List of pattern/action pairs.
  152. This list is used for login to SMB servers.
  153. See `tramp-actions-before-shell' for more info.")
  154. (defconst tramp-smb-actions-with-tar
  155. '((tramp-password-prompt-regexp tramp-action-password)
  156. (tramp-wrong-passwd-regexp tramp-action-permission-denied)
  157. (tramp-smb-errors tramp-action-permission-denied)
  158. (tramp-process-alive-regexp tramp-smb-action-with-tar))
  159. "List of pattern/action pairs.
  160. This list is used for tar-like copy of directories.
  161. See `tramp-actions-before-shell' for more info.")
  162. (defconst tramp-smb-actions-get-acl
  163. '((tramp-password-prompt-regexp tramp-action-password)
  164. (tramp-wrong-passwd-regexp tramp-action-permission-denied)
  165. (tramp-smb-errors tramp-action-permission-denied)
  166. (tramp-process-alive-regexp tramp-smb-action-get-acl))
  167. "List of pattern/action pairs.
  168. This list is used for smbcacls actions.
  169. See `tramp-actions-before-shell' for more info.")
  170. (defconst tramp-smb-actions-set-acl
  171. '((tramp-password-prompt-regexp tramp-action-password)
  172. (tramp-wrong-passwd-regexp tramp-action-permission-denied)
  173. (tramp-smb-errors tramp-action-permission-denied)
  174. (tramp-process-alive-regexp tramp-smb-action-set-acl))
  175. "List of pattern/action pairs.
  176. This list is used for smbcacls actions.
  177. See `tramp-actions-before-shell' for more info.")
  178. ;; New handlers should be added here.
  179. ;;;###tramp-autoload
  180. (defconst tramp-smb-file-name-handler-alist
  181. '(;; `access-file' performed by default handler.
  182. (add-name-to-file . tramp-smb-handle-add-name-to-file)
  183. ;; `byte-compiler-base-file-name' performed by default handler.
  184. (copy-directory . tramp-smb-handle-copy-directory)
  185. (copy-file . tramp-smb-handle-copy-file)
  186. (delete-directory . tramp-smb-handle-delete-directory)
  187. (delete-file . tramp-smb-handle-delete-file)
  188. ;; `diff-latest-backup-file' performed by default handler.
  189. (directory-file-name . tramp-handle-directory-file-name)
  190. (directory-files . tramp-smb-handle-directory-files)
  191. (directory-files-and-attributes
  192. . tramp-handle-directory-files-and-attributes)
  193. (dired-compress-file . ignore)
  194. (dired-uncache . tramp-handle-dired-uncache)
  195. (expand-file-name . tramp-smb-handle-expand-file-name)
  196. (file-accessible-directory-p . tramp-smb-handle-file-directory-p)
  197. (file-acl . tramp-smb-handle-file-acl)
  198. (file-attributes . tramp-smb-handle-file-attributes)
  199. (file-directory-p . tramp-smb-handle-file-directory-p)
  200. (file-file-equal-p . tramp-handle-file-equal-p)
  201. (file-executable-p . tramp-handle-file-exists-p)
  202. (file-exists-p . tramp-handle-file-exists-p)
  203. (file-in-directory-p . tramp-handle-file-in-directory-p)
  204. (file-local-copy . tramp-smb-handle-file-local-copy)
  205. (file-modes . tramp-handle-file-modes)
  206. (file-name-all-completions . tramp-smb-handle-file-name-all-completions)
  207. (file-name-as-directory . tramp-handle-file-name-as-directory)
  208. (file-name-case-insensitive-p . tramp-handle-file-name-case-insensitive-p)
  209. (file-name-completion . tramp-handle-file-name-completion)
  210. (file-name-directory . tramp-handle-file-name-directory)
  211. (file-name-nondirectory . tramp-handle-file-name-nondirectory)
  212. ;; `file-name-sans-versions' performed by default handler.
  213. (file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
  214. (file-notify-add-watch . tramp-handle-file-notify-add-watch)
  215. (file-notify-rm-watch . tramp-handle-file-notify-rm-watch)
  216. (file-notify-valid-p . tramp-handle-file-notify-valid-p)
  217. (file-ownership-preserved-p . ignore)
  218. (file-readable-p . tramp-handle-file-exists-p)
  219. (file-regular-p . tramp-handle-file-regular-p)
  220. (file-remote-p . tramp-handle-file-remote-p)
  221. ;; `file-selinux-context' performed by default handler.
  222. (file-symlink-p . tramp-handle-file-symlink-p)
  223. (file-truename . tramp-smb-handle-file-truename)
  224. (file-writable-p . tramp-smb-handle-file-writable-p)
  225. (find-backup-file-name . tramp-handle-find-backup-file-name)
  226. ;; `find-file-noselect' performed by default handler.
  227. ;; `get-file-buffer' performed by default handler.
  228. (insert-directory . tramp-smb-handle-insert-directory)
  229. (insert-file-contents . tramp-handle-insert-file-contents)
  230. (load . tramp-handle-load)
  231. (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
  232. (make-directory . tramp-smb-handle-make-directory)
  233. (make-directory-internal . tramp-smb-handle-make-directory-internal)
  234. (make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
  235. (make-symbolic-link . tramp-smb-handle-make-symbolic-link)
  236. (process-file . tramp-smb-handle-process-file)
  237. (rename-file . tramp-smb-handle-rename-file)
  238. (set-file-acl . tramp-smb-handle-set-file-acl)
  239. (set-file-modes . tramp-smb-handle-set-file-modes)
  240. (set-file-selinux-context . ignore)
  241. (set-file-times . ignore)
  242. (set-visited-file-modtime . tramp-handle-set-visited-file-modtime)
  243. (shell-command . tramp-handle-shell-command)
  244. (start-file-process . tramp-smb-handle-start-file-process)
  245. (substitute-in-file-name . tramp-smb-handle-substitute-in-file-name)
  246. (temporary-file-directory . tramp-handle-temporary-file-directory)
  247. (unhandled-file-name-directory . ignore)
  248. (vc-registered . ignore)
  249. (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
  250. (write-region . tramp-smb-handle-write-region))
  251. "Alist of handler functions for Tramp SMB method.
  252. Operations not mentioned here will be handled by the default Emacs primitives.")
  253. ;; Options for remote processes via winexe.
  254. ;;;###tramp-autoload
  255. (defcustom tramp-smb-winexe-program "winexe"
  256. "Name of winexe client to run.
  257. If it isn't found in the local $PATH, the absolute path of winexe
  258. shall be given. This is needed for remote processes."
  259. :group 'tramp
  260. :type 'string
  261. :version "24.3"
  262. :require 'tramp)
  263. ;;;###tramp-autoload
  264. (defcustom tramp-smb-winexe-shell-command "powershell.exe"
  265. "Shell to be used for processes on remote machines.
  266. This must be Powershell V2 compatible."
  267. :group 'tramp
  268. :type 'string
  269. :version "24.3"
  270. :require 'tramp)
  271. ;;;###tramp-autoload
  272. (defcustom tramp-smb-winexe-shell-command-switch "-file -"
  273. "Command switch used together with `tramp-smb-winexe-shell-command'.
  274. This can be used to disable echo etc."
  275. :group 'tramp
  276. :type 'string
  277. :version "24.3"
  278. :require 'tramp)
  279. ;; It must be a `defsubst' in order to push the whole code into
  280. ;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading.
  281. ;;;###tramp-autoload
  282. (defsubst tramp-smb-file-name-p (filename)
  283. "Check if it's a filename for SMB servers."
  284. (string= (tramp-file-name-method (tramp-dissect-file-name filename))
  285. tramp-smb-method))
  286. ;;;###tramp-autoload
  287. (defun tramp-smb-file-name-handler (operation &rest args)
  288. "Invoke the SMB related OPERATION.
  289. First arg specifies the OPERATION, second arg is a list of arguments to
  290. pass to the OPERATION."
  291. (let ((fn (assoc operation tramp-smb-file-name-handler-alist)))
  292. (if fn
  293. (save-match-data (apply (cdr fn) args))
  294. (tramp-run-real-handler operation args))))
  295. ;;;###tramp-autoload
  296. (unless (memq system-type '(cygwin windows-nt))
  297. (tramp-register-foreign-file-name-handler
  298. 'tramp-smb-file-name-p 'tramp-smb-file-name-handler))
  299. ;; File name primitives.
  300. (defun tramp-smb-handle-add-name-to-file
  301. (filename newname &optional ok-if-already-exists)
  302. "Like `add-name-to-file' for Tramp files."
  303. (unless (tramp-equal-remote filename newname)
  304. (with-parsed-tramp-file-name
  305. (if (tramp-tramp-file-p filename) filename newname) nil
  306. (tramp-error
  307. v 'file-error
  308. "add-name-to-file: %s"
  309. "only implemented for same method, same user, same host")))
  310. (with-parsed-tramp-file-name filename v1
  311. (with-parsed-tramp-file-name newname v2
  312. (when (file-directory-p filename)
  313. (tramp-error
  314. v2 'file-error
  315. "add-name-to-file: %s must not be a directory" filename))
  316. ;; Do the 'confirm if exists' thing.
  317. (when (file-exists-p newname)
  318. ;; What to do?
  319. (if (or (null ok-if-already-exists) ; not allowed to exist
  320. (and (numberp ok-if-already-exists)
  321. (not (yes-or-no-p
  322. (format
  323. "File %s already exists; make it a link anyway? "
  324. v2-localname)))))
  325. (tramp-error v2 'file-already-exists newname)
  326. (delete-file newname)))
  327. ;; We must also flush the cache of the directory, because
  328. ;; `file-attributes' reads the values from there.
  329. (tramp-flush-file-property v2 (file-name-directory v2-localname))
  330. (tramp-flush-file-property v2 v2-localname)
  331. (unless
  332. (tramp-smb-send-command
  333. v1
  334. (format
  335. "%s \"%s\" \"%s\""
  336. (if (tramp-smb-get-cifs-capabilities v1) "link" "hardlink")
  337. (tramp-smb-get-localname v1)
  338. (tramp-smb-get-localname v2)))
  339. (tramp-error
  340. v2 'file-error
  341. "error with add-name-to-file, see buffer `%s' for details"
  342. (buffer-name))))))
  343. (defun tramp-smb-action-with-tar (proc vec)
  344. "Untar from connection buffer."
  345. (if (not (process-live-p proc))
  346. (throw 'tramp-action 'process-died)
  347. (with-current-buffer (tramp-get-connection-buffer vec)
  348. (goto-char (point-min))
  349. (when (search-forward-regexp tramp-smb-server-version nil t)
  350. ;; There might be a hidden password prompt.
  351. (widen)
  352. (forward-line)
  353. (tramp-message vec 6 (buffer-substring (point-min) (point)))
  354. (delete-region (point-min) (point))
  355. (throw 'tramp-action 'ok)))))
  356. (defun tramp-smb-handle-copy-directory
  357. (dirname newname &optional keep-date parents copy-contents)
  358. "Like `copy-directory' for Tramp files."
  359. (if copy-contents
  360. ;; We must do it file-wise.
  361. (tramp-run-real-handler
  362. 'copy-directory (list dirname newname keep-date parents copy-contents))
  363. (setq dirname (expand-file-name dirname)
  364. newname (expand-file-name newname))
  365. (let ((t1 (tramp-tramp-file-p dirname))
  366. (t2 (tramp-tramp-file-p newname)))
  367. (with-parsed-tramp-file-name (if t1 dirname newname) nil
  368. (with-tramp-progress-reporter
  369. v 0 (format "Copying %s to %s" dirname newname)
  370. (cond
  371. ;; We must use a local temporary directory.
  372. ((and t1 t2)
  373. (let ((tmpdir
  374. (make-temp-name
  375. (expand-file-name
  376. tramp-temp-name-prefix
  377. (tramp-compat-temporary-file-directory)))))
  378. (unwind-protect
  379. (progn
  380. (make-directory tmpdir)
  381. (copy-directory dirname tmpdir keep-date 'parents)
  382. (copy-directory
  383. (expand-file-name (file-name-nondirectory dirname) tmpdir)
  384. newname keep-date parents))
  385. (delete-directory tmpdir 'recursive))))
  386. ;; We can copy recursively.
  387. ;; Does not work reliably.
  388. (nil ;(and (or t1 t2) (tramp-smb-get-cifs-capabilities v))
  389. (when (and (file-directory-p newname)
  390. (not (string-equal (file-name-nondirectory dirname)
  391. (file-name-nondirectory newname))))
  392. (setq newname
  393. (expand-file-name
  394. (file-name-nondirectory dirname) newname))
  395. (if t2 (setq v (tramp-dissect-file-name newname))))
  396. (if (not (file-directory-p newname))
  397. (make-directory newname parents))
  398. ;; Set variables for computing the prompt for reading password.
  399. (setq tramp-current-method method
  400. tramp-current-user user
  401. tramp-current-domain domain
  402. tramp-current-host host
  403. tramp-current-port port)
  404. (let* ((share (tramp-smb-get-share v))
  405. (localname (file-name-as-directory
  406. (replace-regexp-in-string
  407. "\\\\" "/" (tramp-smb-get-localname v))))
  408. (tmpdir (make-temp-name
  409. (expand-file-name
  410. tramp-temp-name-prefix
  411. (tramp-compat-temporary-file-directory))))
  412. (args (list (concat "//" host "/" share) "-E")))
  413. (if (not (zerop (length user)))
  414. (setq args (append args (list "-U" user)))
  415. (setq args (append args (list "-N"))))
  416. (when domain (setq args (append args (list "-W" domain))))
  417. (when port (setq args (append args (list "-p" port))))
  418. (when tramp-smb-conf
  419. (setq args (append args (list "-s" tramp-smb-conf))))
  420. (setq args
  421. (if t1
  422. ;; Source is remote.
  423. (append args
  424. (list "-D" (tramp-unquote-shell-quote-argument
  425. localname)
  426. "-c" (shell-quote-argument "tar qc - *")
  427. "|" "tar" "xfC" "-"
  428. (tramp-unquote-shell-quote-argument
  429. tmpdir)))
  430. ;; Target is remote.
  431. (append (list "tar" "cfC" "-"
  432. (tramp-unquote-shell-quote-argument dirname)
  433. "." "|")
  434. args
  435. (list "-D" (tramp-unquote-shell-quote-argument
  436. localname)
  437. "-c" (shell-quote-argument "tar qx -")))))
  438. (unwind-protect
  439. (with-temp-buffer
  440. ;; Set the transfer process properties.
  441. (tramp-set-connection-property
  442. v "process-name" (buffer-name (current-buffer)))
  443. (tramp-set-connection-property
  444. v "process-buffer" (current-buffer))
  445. (when t1
  446. ;; The smbclient tar command creates always
  447. ;; complete paths. We must emulate the
  448. ;; directory structure, and symlink to the real
  449. ;; target.
  450. (make-directory
  451. (expand-file-name
  452. ".." (concat tmpdir localname))
  453. 'parents)
  454. (make-symbolic-link
  455. newname (directory-file-name (concat tmpdir localname))))
  456. ;; Use an asynchronous processes. By this,
  457. ;; password can be handled.
  458. (let* ((default-directory tmpdir)
  459. (p (apply
  460. 'start-process
  461. (tramp-get-connection-name v)
  462. (tramp-get-connection-buffer v)
  463. tramp-smb-program args)))
  464. (tramp-message
  465. v 6 "%s" (mapconcat 'identity (process-command p) " "))
  466. (tramp-set-connection-property p "vector" v)
  467. (process-put p 'adjust-window-size-function 'ignore)
  468. (set-process-query-on-exit-flag p nil)
  469. (tramp-process-actions p v nil tramp-smb-actions-with-tar)
  470. (while (process-live-p p)
  471. (sit-for 0.1))
  472. (tramp-message v 6 "\n%s" (buffer-string))))
  473. ;; Reset the transfer process properties.
  474. (tramp-set-connection-property v "process-name" nil)
  475. (tramp-set-connection-property v "process-buffer" nil)
  476. (when t1 (delete-directory tmpdir 'recurse))))
  477. ;; Handle KEEP-DATE argument.
  478. (when keep-date
  479. (set-file-times
  480. newname
  481. (tramp-compat-file-attribute-modification-time
  482. (file-attributes dirname))))
  483. ;; Set the mode.
  484. (unless keep-date
  485. (set-file-modes newname (tramp-default-file-modes dirname)))
  486. ;; When newname did exist, we have wrong cached values.
  487. (when t2
  488. (with-parsed-tramp-file-name newname nil
  489. (tramp-flush-file-property v (file-name-directory localname))
  490. (tramp-flush-file-property v localname))))
  491. ;; We must do it file-wise.
  492. (t
  493. (tramp-run-real-handler
  494. 'copy-directory (list dirname newname keep-date parents)))))))))
  495. (defun tramp-smb-handle-copy-file
  496. (filename newname &optional ok-if-already-exists keep-date
  497. _preserve-uid-gid _preserve-extended-attributes)
  498. "Like `copy-file' for Tramp files.
  499. KEEP-DATE has no effect in case NEWNAME resides on an SMB server.
  500. PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
  501. (setq filename (expand-file-name filename)
  502. newname (expand-file-name newname))
  503. (with-tramp-progress-reporter
  504. (tramp-dissect-file-name
  505. (if (tramp-tramp-file-p filename) filename newname))
  506. 0 (format "Copying %s to %s" filename newname)
  507. (if (file-directory-p filename)
  508. (copy-directory
  509. filename newname keep-date 'parents 'copy-contents)
  510. (let ((tmpfile (file-local-copy filename)))
  511. (if tmpfile
  512. ;; Remote filename.
  513. (condition-case err
  514. (rename-file tmpfile newname ok-if-already-exists)
  515. ((error quit)
  516. (delete-file tmpfile)
  517. (signal (car err) (cdr err))))
  518. ;; Remote newname.
  519. (when (file-directory-p newname)
  520. (setq newname
  521. (expand-file-name (file-name-nondirectory filename) newname)))
  522. (with-parsed-tramp-file-name newname nil
  523. (when (and (not ok-if-already-exists)
  524. (file-exists-p newname))
  525. (tramp-error v 'file-already-exists newname))
  526. ;; We must also flush the cache of the directory, because
  527. ;; `file-attributes' reads the values from there.
  528. (tramp-flush-file-property v (file-name-directory localname))
  529. (tramp-flush-file-property v localname)
  530. (unless (tramp-smb-get-share v)
  531. (tramp-error
  532. v 'file-error "Target `%s' must contain a share name" newname))
  533. (unless (tramp-smb-send-command
  534. v (format "put \"%s\" \"%s\""
  535. (tramp-compat-file-name-unquote filename)
  536. (tramp-smb-get-localname v)))
  537. (tramp-error
  538. v 'file-error "Cannot copy `%s' to `%s'" filename newname))))))
  539. ;; KEEP-DATE handling.
  540. (when keep-date
  541. (set-file-times
  542. newname
  543. (tramp-compat-file-attribute-modification-time
  544. (file-attributes filename))))))
  545. (defun tramp-smb-handle-delete-directory (directory &optional recursive _trash)
  546. "Like `delete-directory' for Tramp files."
  547. (setq directory (directory-file-name (expand-file-name directory)))
  548. (when (file-exists-p directory)
  549. (when recursive
  550. (mapc
  551. (lambda (file)
  552. (if (file-directory-p file)
  553. (delete-directory file recursive)
  554. (delete-file file)))
  555. ;; We do not want to delete "." and "..".
  556. (directory-files directory 'full directory-files-no-dot-files-regexp)))
  557. (with-parsed-tramp-file-name directory nil
  558. ;; We must also flush the cache of the directory, because
  559. ;; `file-attributes' reads the values from there.
  560. (tramp-flush-file-property v (file-name-directory localname))
  561. (tramp-flush-directory-property v localname)
  562. (unless (tramp-smb-send-command
  563. v (format
  564. "%s \"%s\""
  565. (if (tramp-smb-get-cifs-capabilities v) "posix_rmdir" "rmdir")
  566. (tramp-smb-get-localname v)))
  567. ;; Error.
  568. (with-current-buffer (tramp-get-connection-buffer v)
  569. (goto-char (point-min))
  570. (search-forward-regexp tramp-smb-errors nil t)
  571. (tramp-error
  572. v 'file-error "%s `%s'" (match-string 0) directory))))))
  573. (defun tramp-smb-handle-delete-file (filename &optional _trash)
  574. "Like `delete-file' for Tramp files."
  575. (setq filename (expand-file-name filename))
  576. (when (file-exists-p filename)
  577. (with-parsed-tramp-file-name filename nil
  578. ;; We must also flush the cache of the directory, because
  579. ;; `file-attributes' reads the values from there.
  580. (tramp-flush-file-property v (file-name-directory localname))
  581. (tramp-flush-file-property v localname)
  582. (unless (tramp-smb-send-command
  583. v (format
  584. "%s \"%s\""
  585. (if (tramp-smb-get-cifs-capabilities v) "posix_unlink" "rm")
  586. (tramp-smb-get-localname v)))
  587. ;; Error.
  588. (with-current-buffer (tramp-get-connection-buffer v)
  589. (goto-char (point-min))
  590. (search-forward-regexp tramp-smb-errors nil t)
  591. (tramp-error
  592. v 'file-error "%s `%s'" (match-string 0) filename))))))
  593. (defun tramp-smb-handle-directory-files
  594. (directory &optional full match nosort)
  595. "Like `directory-files' for Tramp files."
  596. (let ((result (mapcar 'directory-file-name
  597. (file-name-all-completions "" directory))))
  598. ;; Discriminate with regexp.
  599. (when match
  600. (setq result
  601. (delete nil
  602. (mapcar (lambda (x) (when (string-match match x) x))
  603. result))))
  604. ;; Append directory.
  605. (when full
  606. (setq result
  607. (mapcar
  608. (lambda (x) (format "%s/%s" directory x))
  609. result)))
  610. ;; Sort them if necessary.
  611. (unless nosort (setq result (sort result 'string-lessp)))
  612. result))
  613. (defun tramp-smb-handle-expand-file-name (name &optional dir)
  614. "Like `expand-file-name' for Tramp files."
  615. ;; If DIR is not given, use DEFAULT-DIRECTORY or "/".
  616. (setq dir (or dir default-directory "/"))
  617. ;; Unless NAME is absolute, concat DIR and NAME.
  618. (unless (file-name-absolute-p name)
  619. (setq name (concat (file-name-as-directory dir) name)))
  620. ;; If NAME is not a Tramp file, run the real handler.
  621. (if (not (tramp-tramp-file-p name))
  622. (tramp-run-real-handler 'expand-file-name (list name nil))
  623. ;; Dissect NAME.
  624. (with-parsed-tramp-file-name name nil
  625. ;; Tilde expansion if necessary. We use the user name as share,
  626. ;; which is often the case in domains.
  627. (when (string-match "\\`/?~\\([^/]*\\)" localname)
  628. (setq localname
  629. (replace-match
  630. (if (zerop (length (match-string 1 localname)))
  631. user
  632. (match-string 1 localname))
  633. nil nil localname)))
  634. ;; Make the file name absolute.
  635. (unless (tramp-run-real-handler 'file-name-absolute-p (list localname))
  636. (setq localname (concat "/" localname)))
  637. ;; No tilde characters in file name, do normal
  638. ;; `expand-file-name' (this does "/./" and "/../").
  639. (tramp-make-tramp-file-name
  640. method user domain host port
  641. (tramp-run-real-handler 'expand-file-name (list localname))))))
  642. (defun tramp-smb-action-get-acl (proc vec)
  643. "Read ACL data from connection buffer."
  644. (unless (process-live-p proc)
  645. ;; Accept pending output.
  646. (while (tramp-accept-process-output proc 0.1))
  647. (with-current-buffer (tramp-get-connection-buffer vec)
  648. ;; There might be a hidden password prompt.
  649. (widen)
  650. (tramp-message vec 10 "\n%s" (buffer-string))
  651. (goto-char (point-min))
  652. (while (and (not (eobp)) (not (looking-at "^REVISION:")))
  653. (forward-line)
  654. (delete-region (point-min) (point)))
  655. (while (and (not (eobp)) (looking-at "^.+:.+"))
  656. (forward-line))
  657. (delete-region (point) (point-max))
  658. (throw 'tramp-action 'ok))))
  659. (defun tramp-smb-handle-file-acl (filename)
  660. "Like `file-acl' for Tramp files."
  661. (with-parsed-tramp-file-name filename nil
  662. (with-tramp-file-property v localname "file-acl"
  663. (when (executable-find tramp-smb-acl-program)
  664. ;; Set variables for computing the prompt for reading password.
  665. (setq tramp-current-method method
  666. tramp-current-user user
  667. tramp-current-domain domain
  668. tramp-current-host host
  669. tramp-current-port port)
  670. (let* ((share (tramp-smb-get-share v))
  671. (localname (replace-regexp-in-string
  672. "\\\\" "/" (tramp-smb-get-localname v)))
  673. (args (list (concat "//" host "/" share) "-E")))
  674. (if (not (zerop (length user)))
  675. (setq args (append args (list "-U" user)))
  676. (setq args (append args (list "-N"))))
  677. (when domain (setq args (append args (list "-W" domain))))
  678. (when port (setq args (append args (list "-p" port))))
  679. (when tramp-smb-conf
  680. (setq args (append args (list "-s" tramp-smb-conf))))
  681. (setq
  682. args
  683. (append args (list (tramp-unquote-shell-quote-argument localname)
  684. "2>/dev/null")))
  685. (unwind-protect
  686. (with-temp-buffer
  687. ;; Set the transfer process properties.
  688. (tramp-set-connection-property
  689. v "process-name" (buffer-name (current-buffer)))
  690. (tramp-set-connection-property
  691. v "process-buffer" (current-buffer))
  692. ;; Use an asynchronous processes. By this, password
  693. ;; can be handled.
  694. (let ((p (apply
  695. 'start-process
  696. (tramp-get-connection-name v)
  697. (tramp-get-connection-buffer v)
  698. tramp-smb-acl-program args)))
  699. (tramp-message
  700. v 6 "%s" (mapconcat 'identity (process-command p) " "))
  701. (tramp-set-connection-property p "vector" v)
  702. (process-put p 'adjust-window-size-function 'ignore)
  703. (set-process-query-on-exit-flag p nil)
  704. (tramp-process-actions p v nil tramp-smb-actions-get-acl)
  705. (when (> (point-max) (point-min))
  706. (substring-no-properties (buffer-string)))))
  707. ;; Reset the transfer process properties.
  708. (tramp-set-connection-property v "process-name" nil)
  709. (tramp-set-connection-property v "process-buffer" nil)))))))
  710. (defun tramp-smb-handle-file-attributes (filename &optional id-format)
  711. "Like `file-attributes' for Tramp files."
  712. (unless id-format (setq id-format 'integer))
  713. (ignore-errors
  714. (with-parsed-tramp-file-name filename nil
  715. (with-tramp-file-property
  716. v localname (format "file-attributes-%s" id-format)
  717. (if (tramp-smb-get-stat-capability v)
  718. (tramp-smb-do-file-attributes-with-stat v id-format)
  719. ;; Reading just the filename entry via "dir localname" is not
  720. ;; possible, because when filename is a directory, some
  721. ;; smbclient versions return the content of the directory, and
  722. ;; other versions don't. Therefore, the whole content of the
  723. ;; upper directory is retrieved, and the entry of the filename
  724. ;; is extracted from.
  725. (let* ((entries (tramp-smb-get-file-entries
  726. (file-name-directory filename)))
  727. (entry (assoc (file-name-nondirectory filename) entries))
  728. (uid (if (equal id-format 'string) "nobody" -1))
  729. (gid (if (equal id-format 'string) "nogroup" -1))
  730. (inode (tramp-get-inode v))
  731. (device (tramp-get-device v)))
  732. ;; Check result.
  733. (when entry
  734. (list (and (string-match "d" (nth 1 entry))
  735. t) ;0 file type
  736. -1 ;1 link count
  737. uid ;2 uid
  738. gid ;3 gid
  739. '(0 0) ;4 atime
  740. (nth 3 entry) ;5 mtime
  741. '(0 0) ;6 ctime
  742. (nth 2 entry) ;7 size
  743. (nth 1 entry) ;8 mode
  744. nil ;9 gid weird
  745. inode ;10 inode number
  746. device)))))))) ;11 file system number
  747. (defun tramp-smb-do-file-attributes-with-stat (vec &optional id-format)
  748. "Implement `file-attributes' for Tramp files using stat command."
  749. (tramp-message
  750. vec 5 "file attributes with stat: %s" (tramp-file-name-localname vec))
  751. (with-current-buffer (tramp-get-connection-buffer vec)
  752. (let* (size id link uid gid atime mtime ctime mode inode)
  753. (when (tramp-smb-send-command
  754. vec (format "stat \"%s\"" (tramp-smb-get-localname vec)))
  755. ;; Loop the listing.
  756. (goto-char (point-min))
  757. (unless (re-search-forward tramp-smb-errors nil t)
  758. (while (not (eobp))
  759. (cond
  760. ((looking-at
  761. "Size:\\s-+\\([0-9]+\\)\\s-+Blocks:\\s-+[0-9]+\\s-+\\(\\w+\\)")
  762. (setq size (string-to-number (match-string 1))
  763. id (if (string-equal "directory" (match-string 2)) t
  764. (if (string-equal "symbolic" (match-string 2)) ""))))
  765. ((looking-at
  766. "Inode:\\s-+\\([0-9]+\\)\\s-+Links:\\s-+\\([0-9]+\\)")
  767. (setq inode (string-to-number (match-string 1))
  768. link (string-to-number (match-string 2))))
  769. ((looking-at
  770. "Access:\\s-+([0-9]+/\\(\\S-+\\))\\s-+Uid:\\s-+\\([0-9]+\\)\\s-+Gid:\\s-+\\([0-9]+\\)")
  771. (setq mode (match-string 1)
  772. uid (if (equal id-format 'string) (match-string 2)
  773. (string-to-number (match-string 2)))
  774. gid (if (equal id-format 'string) (match-string 3)
  775. (string-to-number (match-string 3)))))
  776. ((looking-at
  777. "Access:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)")
  778. (setq atime
  779. (encode-time
  780. (string-to-number (match-string 6)) ;; sec
  781. (string-to-number (match-string 5)) ;; min
  782. (string-to-number (match-string 4)) ;; hour
  783. (string-to-number (match-string 3)) ;; day
  784. (string-to-number (match-string 2)) ;; month
  785. (string-to-number (match-string 1))))) ;; year
  786. ((looking-at
  787. "Modify:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)")
  788. (setq mtime
  789. (encode-time
  790. (string-to-number (match-string 6)) ;; sec
  791. (string-to-number (match-string 5)) ;; min
  792. (string-to-number (match-string 4)) ;; hour
  793. (string-to-number (match-string 3)) ;; day
  794. (string-to-number (match-string 2)) ;; month
  795. (string-to-number (match-string 1))))) ;; year
  796. ((looking-at
  797. "Change:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)")
  798. (setq ctime
  799. (encode-time
  800. (string-to-number (match-string 6)) ;; sec
  801. (string-to-number (match-string 5)) ;; min
  802. (string-to-number (match-string 4)) ;; hour
  803. (string-to-number (match-string 3)) ;; day
  804. (string-to-number (match-string 2)) ;; month
  805. (string-to-number (match-string 1)))))) ;; year
  806. (forward-line))
  807. ;; Resolve symlink.
  808. (when (and (stringp id)
  809. (tramp-smb-send-command
  810. vec
  811. (format "readlink \"%s\"" (tramp-smb-get-localname vec))))
  812. (goto-char (point-min))
  813. (and (looking-at ".+ -> \\(.+\\)")
  814. (setq id (match-string 1))))
  815. ;; Return the result.
  816. (list id link uid gid atime mtime ctime size mode nil inode
  817. (tramp-get-device vec)))))))
  818. (defun tramp-smb-handle-file-directory-p (filename)
  819. "Like `file-directory-p' for Tramp files."
  820. (and (file-exists-p filename)
  821. (eq ?d
  822. (aref (tramp-compat-file-attribute-modes (file-attributes filename))
  823. 0))))
  824. (defun tramp-smb-handle-file-local-copy (filename)
  825. "Like `file-local-copy' for Tramp files."
  826. (with-parsed-tramp-file-name filename nil
  827. (unless (file-exists-p filename)
  828. (tramp-error
  829. v tramp-file-missing
  830. "Cannot make local copy of non-existing file `%s'" filename))
  831. (let ((tmpfile (tramp-compat-make-temp-file filename)))
  832. (with-tramp-progress-reporter
  833. v 3 (format "Fetching %s to tmp file %s" filename tmpfile)
  834. (unless (tramp-smb-send-command
  835. v (format "get \"%s\" \"%s\""
  836. (tramp-smb-get-localname v) tmpfile))
  837. ;; Oops, an error. We shall cleanup.
  838. (delete-file tmpfile)
  839. (tramp-error
  840. v 'file-error "Cannot make local copy of file `%s'" filename)))
  841. tmpfile)))
  842. ;; This function should return "foo/" for directories and "bar" for
  843. ;; files.
  844. (defun tramp-smb-handle-file-name-all-completions (filename directory)
  845. "Like `file-name-all-completions' for Tramp files."
  846. (all-completions
  847. filename
  848. (with-parsed-tramp-file-name (expand-file-name directory) nil
  849. (with-tramp-file-property v localname "file-name-all-completions"
  850. (save-match-data
  851. (delete-dups
  852. (mapcar
  853. (lambda (x)
  854. (list
  855. (if (string-match "d" (nth 1 x))
  856. (file-name-as-directory (nth 0 x))
  857. (nth 0 x))))
  858. (tramp-smb-get-file-entries directory))))))))
  859. (defun tramp-smb-handle-file-truename (filename)
  860. "Like `file-truename' for Tramp files."
  861. (format
  862. "%s%s"
  863. (with-parsed-tramp-file-name (expand-file-name filename) nil
  864. (tramp-make-tramp-file-name
  865. method user domain host port
  866. (with-tramp-file-property v localname "file-truename"
  867. (funcall
  868. (if (tramp-compat-file-name-quoted-p localname)
  869. 'tramp-compat-file-name-quote 'identity)
  870. ;; We don't follow symlink of symlink.
  871. (or (file-symlink-p filename) localname)))))
  872. ;; Preserve trailing "/".
  873. (if (string-equal (file-name-nondirectory filename) "") "/" "")))
  874. (defun tramp-smb-handle-file-writable-p (filename)
  875. "Like `file-writable-p' for Tramp files."
  876. (if (file-exists-p filename)
  877. (string-match
  878. "w"
  879. (or (tramp-compat-file-attribute-modes (file-attributes filename)) ""))
  880. (let ((dir (file-name-directory filename)))
  881. (and (file-exists-p dir)
  882. (file-writable-p dir)))))
  883. (defun tramp-smb-handle-insert-directory
  884. (filename switches &optional wildcard full-directory-p)
  885. "Like `insert-directory' for Tramp files."
  886. (setq filename (expand-file-name filename))
  887. (unless switches (setq switches ""))
  888. ;; Mark trailing "/".
  889. (when (and (zerop (length (file-name-nondirectory filename)))
  890. (not full-directory-p))
  891. (setq switches (concat switches "F")))
  892. (if full-directory-p
  893. ;; Called from `dired-add-entry'.
  894. (setq filename (file-name-as-directory filename))
  895. (setq filename (directory-file-name filename)))
  896. (with-parsed-tramp-file-name filename nil
  897. (with-tramp-progress-reporter v 0 (format "Opening directory %s" filename)
  898. (save-match-data
  899. (let ((base (file-name-nondirectory filename))
  900. ;; We should not destroy the cache entry.
  901. (entries (copy-sequence
  902. (tramp-smb-get-file-entries
  903. (file-name-directory filename)))))
  904. (when wildcard
  905. (string-match "\\." base)
  906. (setq base (replace-match "\\\\." nil nil base))
  907. (string-match "\\*" base)
  908. (setq base (replace-match ".*" nil nil base))
  909. (string-match "\\?" base)
  910. (setq base (replace-match ".?" nil nil base)))
  911. ;; Filter entries.
  912. (setq entries
  913. (delq
  914. nil
  915. (if (or wildcard (zerop (length base)))
  916. ;; Check for matching entries.
  917. (mapcar
  918. (lambda (x)
  919. (when (string-match
  920. (format "^%s" base) (nth 0 x))
  921. x))
  922. entries)
  923. ;; We just need the only and only entry FILENAME.
  924. (list (assoc base entries)))))
  925. ;; Sort entries.
  926. (setq entries
  927. (sort
  928. entries
  929. (lambda (x y)
  930. (if (string-match "t" switches)
  931. ;; Sort by date.
  932. (time-less-p (nth 3 y) (nth 3 x))
  933. ;; Sort by name.
  934. (string-lessp (nth 0 x) (nth 0 y))))))
  935. ;; Handle "-F" switch.
  936. (when (string-match "F" switches)
  937. (mapc
  938. (lambda (x)
  939. (when (not (zerop (length (car x))))
  940. (cond
  941. ((char-equal ?d (string-to-char (nth 1 x)))
  942. (setcar x (concat (car x) "/")))
  943. ((char-equal ?x (string-to-char (nth 1 x)))
  944. (setcar x (concat (car x) "*"))))))
  945. entries))
  946. ;; Print entries.
  947. (mapc
  948. (lambda (x)
  949. (when (not (zerop (length (nth 0 x))))
  950. (when (string-match "l" switches)
  951. (let ((attr
  952. (when (tramp-smb-get-stat-capability v)
  953. (ignore-errors
  954. (file-attributes filename 'string)))))
  955. (insert
  956. (format
  957. "%10s %3d %-8s %-8s %8s %s "
  958. (or (tramp-compat-file-attribute-modes attr) (nth 1 x))
  959. (or (tramp-compat-file-attribute-link-number attr) 1)
  960. (or (tramp-compat-file-attribute-user-id attr) "nobody")
  961. (or (tramp-compat-file-attribute-group-id attr) "nogroup")
  962. (or (tramp-compat-file-attribute-size attr) (nth 2 x))
  963. (format-time-string
  964. (if (time-less-p (time-subtract (current-time) (nth 3 x))
  965. tramp-half-a-year)
  966. "%b %e %R"
  967. "%b %e %Y")
  968. (nth 3 x)))))) ; date
  969. ;; We mark the file name. The inserted name could be
  970. ;; from somewhere else, so we use the relative file name
  971. ;; of `default-directory'.
  972. (let ((start (point)))
  973. (insert
  974. (format
  975. "%s\n"
  976. (file-relative-name
  977. (expand-file-name
  978. (nth 0 x) (file-name-directory filename))
  979. (when full-directory-p (file-name-directory filename)))))
  980. (put-text-property start (1- (point)) 'dired-filename t))
  981. (forward-line)
  982. (beginning-of-line)))
  983. entries))))))
  984. (defun tramp-smb-handle-make-directory (dir &optional parents)
  985. "Like `make-directory' for Tramp files."
  986. (setq dir (directory-file-name (expand-file-name dir)))
  987. (unless (file-name-absolute-p dir)
  988. (setq dir (expand-file-name dir default-directory)))
  989. (with-parsed-tramp-file-name dir nil
  990. (save-match-data
  991. (let* ((ldir (file-name-directory dir)))
  992. ;; Make missing directory parts.
  993. (when (and parents
  994. (tramp-smb-get-share v)
  995. (not (file-directory-p ldir)))
  996. (make-directory ldir parents))
  997. ;; Just do it.
  998. (when (file-directory-p ldir)
  999. (make-directory-internal dir))
  1000. (unless (file-directory-p dir)
  1001. (tramp-error v 'file-error "Couldn't make directory %s" dir))))))
  1002. (defun tramp-smb-handle-make-directory-internal (directory)
  1003. "Like `make-directory-internal' for Tramp files."
  1004. (setq directory (directory-file-name (expand-file-name directory)))
  1005. (unless (file-name-absolute-p directory)
  1006. (setq directory (expand-file-name directory default-directory)))
  1007. (with-parsed-tramp-file-name directory nil
  1008. (save-match-data
  1009. (let* ((file (tramp-smb-get-localname v)))
  1010. (when (file-directory-p (file-name-directory directory))
  1011. (tramp-smb-send-command
  1012. v
  1013. (if (tramp-smb-get-cifs-capabilities v)
  1014. (format "posix_mkdir \"%s\" %o" file (default-file-modes))
  1015. (format "mkdir \"%s\"" file)))
  1016. ;; We must also flush the cache of the directory, because
  1017. ;; `file-attributes' reads the values from there.
  1018. (tramp-flush-file-property v (file-name-directory localname))
  1019. (tramp-flush-file-property v localname))
  1020. (unless (file-directory-p directory)
  1021. (tramp-error
  1022. v 'file-error "Couldn't make directory %s" directory))))))
  1023. (defun tramp-smb-handle-make-symbolic-link
  1024. (target linkname &optional ok-if-already-exists)
  1025. "Like `make-symbolic-link' for Tramp files.
  1026. If TARGET is a non-Tramp file, it is used verbatim as the target
  1027. of the symlink. If TARGET is a Tramp file, only the localname
  1028. component is used as the target of the symlink."
  1029. (if (not (tramp-tramp-file-p (expand-file-name linkname)))
  1030. (tramp-run-real-handler
  1031. 'make-symbolic-link (list target linkname ok-if-already-exists))
  1032. (with-parsed-tramp-file-name linkname nil
  1033. ;; Do the 'confirm if exists' thing.
  1034. (when (file-exists-p linkname)
  1035. ;; What to do?
  1036. (if (or (null ok-if-already-exists) ; not allowed to exist
  1037. (and (numberp ok-if-already-exists)
  1038. (not (yes-or-no-p
  1039. (format
  1040. "File %s already exists; make it a link anyway? "
  1041. localname)))))
  1042. (tramp-error v 'file-already-exists localname)
  1043. (delete-file linkname)))
  1044. (unless (tramp-smb-get-cifs-capabilities v)
  1045. (tramp-error v 'file-error "make-symbolic-link not supported"))
  1046. ;; If TARGET is a Tramp name, use just the localname component.
  1047. (when (and (tramp-tramp-file-p target)
  1048. (tramp-file-name-equal-p
  1049. v (tramp-dissect-file-name (expand-file-name target))))
  1050. (setq target
  1051. (tramp-file-name-localname
  1052. (tramp-dissect-file-name (expand-file-name target)))))
  1053. ;; We must also flush the cache of the directory, because
  1054. ;; `file-attributes' reads the values from there.
  1055. (tramp-flush-file-property v (file-name-directory localname))
  1056. (tramp-flush-file-property v localname)
  1057. (unless
  1058. (tramp-smb-send-command
  1059. v (format "symlink \"%s\" \"%s\""
  1060. (tramp-compat-file-name-unquote target)
  1061. (tramp-smb-get-localname v)))
  1062. (tramp-error
  1063. v 'file-error
  1064. "error with make-symbolic-link, see buffer `%s' for details"
  1065. (buffer-name))))))
  1066. (defun tramp-smb-handle-process-file
  1067. (program &optional infile destination display &rest args)
  1068. "Like `process-file' for Tramp files."
  1069. ;; The implementation is not complete yet.
  1070. (when (and (numberp destination) (zerop destination))
  1071. (error "Implementation does not handle immediate return"))
  1072. (with-parsed-tramp-file-name default-directory nil
  1073. (let* ((name (file-name-nondirectory program))
  1074. (name1 name)
  1075. (i 0)
  1076. input tmpinput outbuf command ret)
  1077. ;; Determine input.
  1078. (when infile
  1079. (setq infile (expand-file-name infile))
  1080. (if (tramp-equal-remote default-directory infile)
  1081. ;; INFILE is on the same remote host.
  1082. (setq input (with-parsed-tramp-file-name infile nil localname))
  1083. ;; INFILE must be copied to remote host.
  1084. (setq input (tramp-make-tramp-temp-file v)
  1085. tmpinput
  1086. (tramp-make-tramp-file-name method user domain host port input))
  1087. (copy-file infile tmpinput t))
  1088. ;; Transform input into a filename powershell does understand.
  1089. (setq input (format "//%s%s" host input)))
  1090. ;; Determine output.
  1091. (cond
  1092. ;; Just a buffer.
  1093. ((bufferp destination)
  1094. (setq outbuf destination))
  1095. ;; A buffer name.
  1096. ((stringp destination)
  1097. (setq outbuf (get-buffer-create destination)))
  1098. ;; (REAL-DESTINATION ERROR-DESTINATION)
  1099. ((consp destination)
  1100. ;; output.
  1101. (cond
  1102. ((bufferp (car destination))
  1103. (setq outbuf (car destination)))
  1104. ((stringp (car destination))
  1105. (setq outbuf (get-buffer-create (car destination))))
  1106. ((car destination)
  1107. (setq outbuf (current-buffer))))
  1108. ;; stderr.
  1109. (tramp-message v 2 "%s" "STDERR not supported"))
  1110. ;; 't
  1111. (destination
  1112. (setq outbuf (current-buffer))))
  1113. ;; Construct command.
  1114. (setq command (mapconcat 'identity (cons program args) " ")
  1115. command (if input
  1116. (format
  1117. "get-content %s | & %s"
  1118. (tramp-smb-shell-quote-argument input) command)
  1119. (format "& %s" command)))
  1120. (while (get-process name1)
  1121. ;; NAME must be unique as process name.
  1122. (setq i (1+ i)
  1123. name1 (format "%s<%d>" name i)))
  1124. ;; Set the new process properties.
  1125. (tramp-set-connection-property v "process-name" name1)
  1126. (tramp-set-connection-property
  1127. v "process-buffer"
  1128. (or outbuf (generate-new-buffer tramp-temp-buffer-name)))
  1129. ;; Call it.
  1130. (condition-case nil
  1131. (with-current-buffer (tramp-get-connection-buffer v)
  1132. ;; Preserve buffer contents.
  1133. (narrow-to-region (point-max) (point-max))
  1134. (tramp-smb-call-winexe v)
  1135. (when (tramp-smb-get-share v)
  1136. (tramp-smb-send-command
  1137. v (format "cd \"//%s%s\"" host (file-name-directory localname))))
  1138. (tramp-smb-send-command v command)
  1139. ;; Preserve command output.
  1140. (narrow-to-region (point-max) (point-max))
  1141. (let ((p (tramp-get-connection-process v)))
  1142. (tramp-smb-send-command v "exit $lasterrorcode")
  1143. (while (process-live-p p)
  1144. (sleep-for 0.1)
  1145. (setq ret (process-exit-status p))))
  1146. (delete-region (point-min) (point-max))
  1147. (widen))
  1148. ;; When the user did interrupt, we should do it also. We use
  1149. ;; return code -1 as marker.
  1150. (quit
  1151. (setq ret -1))
  1152. ;; Handle errors.
  1153. (error
  1154. (setq ret 1)))
  1155. ;; We should redisplay the output.
  1156. (when (and display outbuf (get-buffer-window outbuf t)) (redisplay))
  1157. ;; Cleanup. We remove all file cache values for the connection,
  1158. ;; because the remote process could have changed them.
  1159. (tramp-set-connection-property v "process-name" nil)
  1160. (tramp-set-connection-property v "process-buffer" nil)
  1161. (when tmpinput (delete-file tmpinput))
  1162. (unless outbuf
  1163. (kill-buffer (tramp-get-connection-property v "process-buffer" nil)))
  1164. (unless process-file-side-effects
  1165. (tramp-flush-directory-property v ""))
  1166. ;; Return exit status.
  1167. (if (equal ret -1)
  1168. (keyboard-quit)
  1169. ret))))
  1170. (defun tramp-smb-handle-rename-file
  1171. (filename newname &optional ok-if-already-exists)
  1172. "Like `rename-file' for Tramp files."
  1173. (setq filename (expand-file-name filename)
  1174. newname (expand-file-name newname))
  1175. (when (and (not ok-if-already-exists)
  1176. (file-exists-p newname))
  1177. (tramp-error
  1178. (tramp-dissect-file-name
  1179. (if (tramp-tramp-file-p filename) filename newname))
  1180. 'file-already-exists newname))
  1181. (with-tramp-progress-reporter
  1182. (tramp-dissect-file-name
  1183. (if (tramp-tramp-file-p filename) filename newname))
  1184. 0 (format "Renaming %s to %s" filename newname)
  1185. (if (and (not (file-exists-p newname))
  1186. (tramp-equal-remote filename newname)
  1187. (string-equal
  1188. (tramp-smb-get-share (tramp-dissect-file-name filename))
  1189. (tramp-smb-get-share (tramp-dissect-file-name newname))))
  1190. ;; We can rename directly.
  1191. (with-parsed-tramp-file-name filename v1
  1192. (with-parsed-tramp-file-name newname v2
  1193. ;; We must also flush the cache of the directory, because
  1194. ;; `file-attributes' reads the values from there.
  1195. (tramp-flush-file-property v1 (file-name-directory v1-localname))
  1196. (tramp-flush-file-property v1 v1-localname)
  1197. (tramp-flush-file-property v2 (file-name-directory v2-localname))
  1198. (tramp-flush-file-property v2 v2-localname)
  1199. (unless (tramp-smb-get-share v2)
  1200. (tramp-error
  1201. v2 'file-error "Target `%s' must contain a share name" newname))
  1202. (unless (tramp-smb-send-command
  1203. v2 (format "rename \"%s\" \"%s\""
  1204. (tramp-smb-get-localname v1)
  1205. (tramp-smb-get-localname v2)))
  1206. (tramp-error v2 'file-error "Cannot rename `%s'" filename))))
  1207. ;; We must rename via copy.
  1208. (copy-file
  1209. filename newname ok-if-already-exists 'keep-time 'preserve-uid-gid)
  1210. (if (file-directory-p filename)
  1211. (delete-directory filename 'recursive)
  1212. (delete-file filename)))))
  1213. (defun tramp-smb-action-set-acl (proc vec)
  1214. "Read ACL data from connection buffer."
  1215. (unless (process-live-p proc)
  1216. ;; Accept pending output.
  1217. (while (tramp-accept-process-output proc 0.1))
  1218. (with-current-buffer (tramp-get-connection-buffer vec)
  1219. (tramp-message vec 10 "\n%s" (buffer-string))
  1220. (throw 'tramp-action 'ok))))
  1221. (defun tramp-smb-handle-set-file-acl (filename acl-string)
  1222. "Like `set-file-acl' for Tramp files."
  1223. (ignore-errors
  1224. (with-parsed-tramp-file-name filename nil
  1225. (when (and (stringp acl-string) (executable-find tramp-smb-acl-program))
  1226. ;; Set variables for computing the prompt for reading password.
  1227. (setq tramp-current-method method
  1228. tramp-current-user user
  1229. tramp-current-domain domain
  1230. tramp-current-host host
  1231. tramp-current-port port)
  1232. (tramp-set-file-property v localname "file-acl" 'undef)
  1233. (let* ((share (tramp-smb-get-share v))
  1234. (localname (replace-regexp-in-string
  1235. "\\\\" "/" (tramp-smb-get-localname v)))
  1236. (args (list (concat "//" host "/" share) "-E" "-S"
  1237. (replace-regexp-in-string
  1238. "\n" "," acl-string))))
  1239. (if (not (zerop (length user)))
  1240. (setq args (append args (list "-U" user)))
  1241. (setq args (append args (list "-N"))))
  1242. (when domain (setq args (append args (list "-W" domain))))
  1243. (when port (setq args (append args (list "-p" port))))
  1244. (when tramp-smb-conf
  1245. (setq args (append args (list "-s" tramp-smb-conf))))
  1246. (setq
  1247. args
  1248. (append args (list (tramp-unquote-shell-quote-argument localname)
  1249. "&&" "echo" "tramp_exit_status" "0"
  1250. "||" "echo" "tramp_exit_status" "1")))
  1251. (unwind-protect
  1252. (with-temp-buffer
  1253. ;; Set the transfer process properties.
  1254. (tramp-set-connection-property
  1255. v "process-name" (buffer-name (current-buffer)))
  1256. (tramp-set-connection-property
  1257. v "process-buffer" (current-buffer))
  1258. ;; Use an asynchronous processes. By this, password can
  1259. ;; be handled.
  1260. (let ((p (apply
  1261. 'start-process
  1262. (tramp-get-connection-name v)
  1263. (tramp-get-connection-buffer v)
  1264. tramp-smb-acl-program args)))
  1265. (tramp-message
  1266. v 6 "%s" (mapconcat 'identity (process-command p) " "))
  1267. (tramp-set-connection-property p "vector" v)
  1268. (process-put p 'adjust-window-size-function 'ignore)
  1269. (set-process-query-on-exit-flag p nil)
  1270. (tramp-process-actions p v nil tramp-smb-actions-set-acl)
  1271. (goto-char (point-max))
  1272. (unless (re-search-backward "tramp_exit_status [0-9]+" nil t)
  1273. (tramp-error
  1274. v 'file-error
  1275. "Couldn't find exit status of `%s'" tramp-smb-acl-program))
  1276. (skip-chars-forward "^ ")
  1277. (when (zerop (read (current-buffer)))
  1278. ;; Success.
  1279. (tramp-set-file-property v localname "file-acl" acl-string)
  1280. t)))
  1281. ;; Reset the transfer process properties.
  1282. (tramp-set-connection-property v "process-name" nil)
  1283. (tramp-set-connection-property v "process-buffer" nil)))))))
  1284. (defun tramp-smb-handle-set-file-modes (filename mode)
  1285. "Like `set-file-modes' for Tramp files."
  1286. (with-parsed-tramp-file-name filename nil
  1287. (when (tramp-smb-get-cifs-capabilities v)
  1288. (tramp-flush-file-property v localname)
  1289. (unless (tramp-smb-send-command
  1290. v (format "chmod \"%s\" %o" (tramp-smb-get-localname v) mode))
  1291. (tramp-error
  1292. v 'file-error "Error while changing file's mode %s" filename)))))
  1293. ;; We use BUFFER also as connection buffer during setup. Because of
  1294. ;; this, its original contents must be saved, and restored once
  1295. ;; connection has been setup.
  1296. (defun tramp-smb-handle-start-file-process (name buffer program &rest args)
  1297. "Like `start-file-process' for Tramp files."
  1298. (with-parsed-tramp-file-name default-directory nil
  1299. (let* ((buffer
  1300. (if buffer
  1301. (get-buffer-create buffer)
  1302. ;; BUFFER can be nil. We use a temporary buffer.
  1303. (generate-new-buffer tramp-temp-buffer-name)))
  1304. (command (mapconcat 'identity (cons program args) " "))
  1305. (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
  1306. (name1 name)
  1307. (i 0))
  1308. (unwind-protect
  1309. (save-excursion
  1310. (save-restriction
  1311. (while (get-process name1)
  1312. ;; NAME must be unique as process name.
  1313. (setq i (1+ i)
  1314. name1 (format "%s<%d>" name i)))
  1315. ;; Set the new process properties.
  1316. (tramp-set-connection-property v "process-name" name1)
  1317. (tramp-set-connection-property v "process-buffer" buffer)
  1318. ;; Activate narrowing in order to save BUFFER contents.
  1319. (with-current-buffer (tramp-get-connection-buffer v)
  1320. (let ((buffer-undo-list t))
  1321. (narrow-to-region (point-max) (point-max))
  1322. (tramp-smb-call-winexe v)
  1323. (when (tramp-smb-get-share v)
  1324. (tramp-smb-send-command
  1325. v (format
  1326. "cd \"//%s%s\""
  1327. host (file-name-directory localname))))
  1328. (tramp-message v 6 "(%s); exit" command)
  1329. (tramp-send-string v command)))
  1330. ;; Return value.
  1331. (tramp-get-connection-process v)))
  1332. ;; Save exit.
  1333. (with-current-buffer (tramp-get-connection-buffer v)
  1334. (if (string-match tramp-temp-buffer-name (buffer-name))
  1335. (progn
  1336. (set-process-buffer (tramp-get-connection-process v) nil)
  1337. (kill-buffer (current-buffer)))
  1338. (set-buffer-modified-p bmp)))
  1339. (tramp-set-connection-property v "process-name" nil)
  1340. (tramp-set-connection-property v "process-buffer" nil)))))
  1341. (defun tramp-smb-handle-substitute-in-file-name (filename)
  1342. "Like `handle-substitute-in-file-name' for Tramp files.
  1343. \"//\" substitutes only in the local filename part. Catches
  1344. errors for shares like \"C$/\", which are common in Microsoft Windows."
  1345. ;; Check, whether the local part is a quoted file name.
  1346. (if (tramp-compat-file-name-quoted-p filename)
  1347. filename
  1348. (with-parsed-tramp-file-name filename nil
  1349. ;; Ignore in LOCALNAME everything before "//".
  1350. (when (and (stringp localname) (string-match ".+?/\\(/\\|~\\)" localname))
  1351. (setq filename
  1352. (concat (file-remote-p filename)
  1353. (replace-match "\\1" nil nil localname)))))
  1354. (condition-case nil
  1355. (tramp-run-real-handler 'substitute-in-file-name (list filename))
  1356. (error filename))))
  1357. (defun tramp-smb-handle-write-region
  1358. (start end filename &optional append visit lockname mustbenew)
  1359. "Like `write-region' for Tramp files."
  1360. (setq filename (expand-file-name filename))
  1361. (with-parsed-tramp-file-name filename nil
  1362. (when (and mustbenew (file-exists-p filename)
  1363. (or (eq mustbenew 'excl)
  1364. (not
  1365. (y-or-n-p
  1366. (format "File %s exists; overwrite anyway? " filename)))))
  1367. (tramp-error v 'file-already-exists filename))
  1368. ;; We must also flush the cache of the directory, because
  1369. ;; `file-attributes' reads the values from there.
  1370. (tramp-flush-file-property v (file-name-directory localname))
  1371. (tramp-flush-file-property v localname)
  1372. (let ((curbuf (current-buffer))
  1373. (tmpfile (tramp-compat-make-temp-file filename)))
  1374. (when (and append (file-exists-p filename))
  1375. (copy-file filename tmpfile 'ok))
  1376. ;; We say `no-message' here because we don't want the visited file
  1377. ;; modtime data to be clobbered from the temp file. We call
  1378. ;; `set-visited-file-modtime' ourselves later on.
  1379. (tramp-run-real-handler
  1380. 'write-region (list start end tmpfile append 'no-message lockname))
  1381. (with-tramp-progress-reporter
  1382. v 3 (format "Moving tmp file %s to %s" tmpfile filename)
  1383. (unwind-protect
  1384. (unless (tramp-smb-send-command
  1385. v (format "put %s \"%s\""
  1386. tmpfile (tramp-smb-get-localname v)))
  1387. (tramp-error v 'file-error "Cannot write `%s'" filename))
  1388. (delete-file tmpfile)))
  1389. (unless (equal curbuf (current-buffer))
  1390. (tramp-error
  1391. v 'file-error
  1392. "Buffer has changed from `%s' to `%s'" curbuf (current-buffer)))
  1393. (when (eq visit t)
  1394. (set-visited-file-modtime)))))
  1395. ;; Internal file name functions.
  1396. (defun tramp-smb-get-share (vec)
  1397. "Returns the share name of LOCALNAME."
  1398. (save-match-data
  1399. (let ((localname (tramp-file-name-unquote-localname vec)))
  1400. (when (string-match "^/?\\([^/]+\\)/" localname)
  1401. (match-string 1 localname)))))
  1402. (defun tramp-smb-get-localname (vec)
  1403. "Returns the file name of LOCALNAME.
  1404. If VEC has no cifs capabilities, exchange \"/\" by \"\\\\\"."
  1405. (save-match-data
  1406. (let ((localname (tramp-file-name-unquote-localname vec)))
  1407. (setq
  1408. localname
  1409. (if (string-match "^/?[^/]+\\(/.*\\)" localname)
  1410. ;; There is a share, separated by "/".
  1411. (if (not (tramp-smb-get-cifs-capabilities vec))
  1412. (mapconcat
  1413. (lambda (x) (if (equal x ?/) "\\" (char-to-string x)))
  1414. (match-string 1 localname) "")
  1415. (match-string 1 localname))
  1416. ;; There is just a share.
  1417. (if (string-match "^/?\\([^/]+\\)$" localname)
  1418. (match-string 1 localname)
  1419. "")))
  1420. ;; Sometimes we have discarded `substitute-in-file-name'.
  1421. (when (string-match "\\(\\$\\$\\)\\(/\\|$\\)" localname)
  1422. (setq localname (replace-match "$" nil nil localname 1)))
  1423. localname)))
  1424. ;; Share names of a host are cached. It is very unlikely that the
  1425. ;; shares do change during connection.
  1426. (defun tramp-smb-get-file-entries (directory)
  1427. "Read entries which match DIRECTORY.
  1428. Either the shares are listed, or the `dir' command is executed.
  1429. Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)."
  1430. (with-parsed-tramp-file-name (file-name-as-directory directory) nil
  1431. (setq localname (or localname "/"))
  1432. (with-tramp-file-property v localname "file-entries"
  1433. (with-current-buffer (tramp-get-connection-buffer v)
  1434. (let* ((share (tramp-smb-get-share v))
  1435. (cache (tramp-get-connection-property v "share-cache" nil))
  1436. res entry)
  1437. (if (and (not share) cache)
  1438. ;; Return cached shares.
  1439. (setq res cache)
  1440. ;; Read entries.
  1441. (if share
  1442. (tramp-smb-send-command
  1443. v (format "dir \"%s*\"" (tramp-smb-get-localname v)))
  1444. ;; `tramp-smb-maybe-open-connection' lists also the share names.
  1445. (tramp-smb-maybe-open-connection v))
  1446. ;; Loop the listing.
  1447. (goto-char (point-min))
  1448. (if (re-search-forward tramp-smb-errors nil t)
  1449. (tramp-error v 'file-error "%s `%s'" (match-string 0) directory)
  1450. (while (not (eobp))
  1451. (setq entry (tramp-smb-read-file-entry share))
  1452. (forward-line)
  1453. (when entry (push entry res))))
  1454. ;; Cache share entries.
  1455. (unless share
  1456. (tramp-set-connection-property v "share-cache" res)))
  1457. ;; Add directory itself.
  1458. (push '("" "drwxrwxrwx" 0 (0 0)) res)
  1459. ;; Return entries.
  1460. (delq nil res))))))
  1461. ;; Return either a share name (if SHARE is nil), or a file name.
  1462. ;;
  1463. ;; If shares are listed, the following format is expected:
  1464. ;;
  1465. ;; Disk| - leading spaces
  1466. ;; [^|]+| - share name, 14 char
  1467. ;; .* - comment
  1468. ;;
  1469. ;; Entries provided by smbclient DIR aren't fully regular.
  1470. ;; They should have the format
  1471. ;;
  1472. ;; \s-\{2,2} - leading spaces
  1473. ;; \S-\(.*\S-\)\s-* - file name, 30 chars, left bound
  1474. ;; \s-+[ADHRSV]* - permissions, 7 chars, right bound
  1475. ;; \s- - space delimiter
  1476. ;; \s-+[0-9]+ - size, 8 chars, right bound
  1477. ;; \s-\{2,2\} - space delimiter
  1478. ;; \w\{3,3\} - weekday
  1479. ;; \s- - space delimiter
  1480. ;; \w\{3,3\} - month
  1481. ;; \s- - space delimiter
  1482. ;; [ 12][0-9] - day
  1483. ;; \s- - space delimiter
  1484. ;; [0-9]\{2,2\}:[0-9]\{2,2\}:[0-9]\{2,2\} - time
  1485. ;; \s- - space delimiter
  1486. ;; [0-9]\{4,4\} - year
  1487. ;;
  1488. ;; samba/src/client.c (http://samba.org/doxygen/samba/client_8c-source.html)
  1489. ;; has function display_finfo:
  1490. ;;
  1491. ;; d_printf(" %-30s%7.7s %8.0f %s",
  1492. ;; finfo->name,
  1493. ;; attrib_string(finfo->mode),
  1494. ;; (double)finfo->size,
  1495. ;; asctime(LocalTime(&t)));
  1496. ;;
  1497. ;; in Samba 1.9, there's the following code:
  1498. ;;
  1499. ;; DEBUG(0,(" %-30s%7.7s%10d %s",
  1500. ;; CNV_LANG(finfo->name),
  1501. ;; attrib_string(finfo->mode),
  1502. ;; finfo->size,
  1503. ;; asctime(LocalTime(&t))));
  1504. ;;
  1505. ;; Problems:
  1506. ;; * Modern regexp constructs, like spy groups and counted repetitions, aren't
  1507. ;; available in older Emacsen.
  1508. ;; * The length of constructs (file name, size) might exceed the default.
  1509. ;; * File names might contain spaces.
  1510. ;; * Permissions might be empty.
  1511. ;;
  1512. ;; So we try to analyze backwards.
  1513. (defun tramp-smb-read-file-entry (share)
  1514. "Parse entry in SMB output buffer.
  1515. If SHARE is result, entries are of type dir. Otherwise, shares are listed.
  1516. Result is the list (LOCALNAME MODE SIZE MTIME)."
  1517. ;; We are called from `tramp-smb-get-file-entries', which sets the
  1518. ;; current buffer.
  1519. (let ((line (buffer-substring (point) (point-at-eol)))
  1520. localname mode size month day hour min sec year mtime)
  1521. (if (not share)
  1522. ;; Read share entries.
  1523. (when (string-match "^Disk|\\([^|]+\\)|" line)
  1524. (setq localname (match-string 1 line)
  1525. mode "dr-xr-xr-x"
  1526. size 0))
  1527. ;; Real listing.
  1528. (cl-block nil
  1529. ;; year.
  1530. (if (string-match "\\([0-9]+\\)$" line)
  1531. (setq year (string-to-number (match-string 1 line))
  1532. line (substring line 0 -5))
  1533. (cl-return))
  1534. ;; time.
  1535. (if (string-match "\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)$" line)
  1536. (setq hour (string-to-number (match-string 1 line))
  1537. min (string-to-number (match-string 2 line))
  1538. sec (string-to-number (match-string 3 line))
  1539. line (substring line 0 -9))
  1540. (cl-return))
  1541. ;; day.
  1542. (if (string-match "\\([0-9]+\\)$" line)
  1543. (setq day (string-to-number (match-string 1 line))
  1544. line (substring line 0 -3))
  1545. (cl-return))
  1546. ;; month.
  1547. (if (string-match "\\(\\w+\\)$" line)
  1548. (setq month (match-string 1 line)
  1549. line (substring line 0 -4))
  1550. (cl-return))
  1551. ;; weekday.
  1552. (if (string-match "\\(\\w+\\)$" line)
  1553. (setq line (substring line 0 -5))
  1554. (cl-return))
  1555. ;; size.
  1556. (if (string-match "\\([0-9]+\\)$" line)
  1557. (let ((length (- (max 10 (1+ (length (match-string 1 line)))))))
  1558. (setq size (string-to-number (match-string 1 line)))
  1559. (when (string-match "\\([ADHRSV]+\\)" (substring line length))
  1560. (setq length (+ length (match-end 0))))
  1561. (setq line (substring line 0 length)))
  1562. (cl-return))
  1563. ;; mode: ARCH, DIR, HIDDEN, RONLY, SYSTEM, VOLID.
  1564. (if (string-match "\\([ADHRSV]+\\)?$" line)
  1565. (setq
  1566. mode (or (match-string 1 line) "")
  1567. mode (save-match-data (format
  1568. "%s%s"
  1569. (if (string-match "D" mode) "d" "-")
  1570. (mapconcat
  1571. (lambda (_x) "") " "
  1572. (concat "r" (if (string-match "R" mode) "-" "w") "x"))))
  1573. line (substring line 0 -6))
  1574. (cl-return))
  1575. ;; localname.
  1576. (if (string-match "^\\s-+\\(\\S-\\(.*\\S-\\)?\\)\\s-*$" line)
  1577. (setq localname (match-string 1 line))
  1578. (cl-return))))
  1579. (when (and localname mode size)
  1580. (setq mtime
  1581. (if (and sec min hour day month year)
  1582. (encode-time
  1583. sec min hour day
  1584. (cdr (assoc (downcase month) parse-time-months))
  1585. year)
  1586. '(0 0)))
  1587. (list localname mode size mtime))))
  1588. (defun tramp-smb-get-cifs-capabilities (vec)
  1589. "Check, whether the SMB server supports POSIX commands."
  1590. ;; When we are not logged in yet, we return nil.
  1591. (if (process-live-p (tramp-get-connection-process vec))
  1592. (with-tramp-connection-property
  1593. (tramp-get-connection-process vec) "cifs-capabilities"
  1594. (save-match-data
  1595. (when (tramp-smb-send-command vec "posix")
  1596. (with-current-buffer (tramp-get-connection-buffer vec)
  1597. (goto-char (point-min))
  1598. (when
  1599. (re-search-forward "Server supports CIFS capabilities" nil t)
  1600. (member
  1601. "pathnames"
  1602. (split-string
  1603. (buffer-substring (point) (point-at-eol)) nil 'omit)))))))))
  1604. (defun tramp-smb-get-stat-capability (vec)
  1605. "Check, whether the SMB server supports the STAT command."
  1606. ;; When we are not logged in yet, we return nil.
  1607. (if (and (tramp-smb-get-share vec)
  1608. (process-live-p (tramp-get-connection-process vec)))
  1609. (with-tramp-connection-property
  1610. (tramp-get-connection-process vec) "stat-capability"
  1611. (tramp-smb-send-command vec "stat \"/\""))))
  1612. ;; Connection functions.
  1613. (defun tramp-smb-send-command (vec command)
  1614. "Send the COMMAND to connection VEC.
  1615. Returns nil if there has been an error message from smbclient."
  1616. (tramp-smb-maybe-open-connection vec)
  1617. (tramp-message vec 6 "%s" command)
  1618. (tramp-send-string vec command)
  1619. (tramp-smb-wait-for-output vec))
  1620. (defun tramp-smb-maybe-open-connection (vec &optional argument)
  1621. "Maybe open a connection to HOST, log in as USER, using `tramp-smb-program'.
  1622. Does not do anything if a connection is already open, but re-opens the
  1623. connection if a previous connection has died for some reason.
  1624. If ARGUMENT is non-nil, use it as argument for
  1625. `tramp-smb-winexe-program', and suppress any checks."
  1626. (let* ((share (tramp-smb-get-share vec))
  1627. (buf (tramp-get-connection-buffer vec))
  1628. (p (get-buffer-process buf)))
  1629. ;; Check whether we still have the same smbclient version.
  1630. ;; Otherwise, we must delete the connection cache, because
  1631. ;; capabilities migh have changed.
  1632. (unless (or argument (processp p))
  1633. (let ((default-directory (tramp-compat-temporary-file-directory))
  1634. (command (concat tramp-smb-program " -V")))
  1635. (unless tramp-smb-version
  1636. (unless (executable-find tramp-smb-program)
  1637. (tramp-error
  1638. vec 'file-error
  1639. "Cannot find command %s in %s" tramp-smb-program exec-path))
  1640. (setq tramp-smb-version (shell-command-to-string command))
  1641. (tramp-message vec 6 command)
  1642. (tramp-message vec 6 "\n%s" tramp-smb-version)
  1643. (if (string-match "[ \t\n\r]+\\'" tramp-smb-version)
  1644. (setq tramp-smb-version
  1645. (replace-match "" nil nil tramp-smb-version))))
  1646. (unless (string-equal
  1647. tramp-smb-version
  1648. (tramp-get-connection-property
  1649. vec "smbclient-version" tramp-smb-version))
  1650. (tramp-flush-directory-property vec "")
  1651. (tramp-flush-connection-property vec))
  1652. (tramp-set-connection-property
  1653. vec "smbclient-version" tramp-smb-version)))
  1654. ;; If too much time has passed since last command was sent, look
  1655. ;; whether there has been an error message; maybe due to
  1656. ;; connection timeout.
  1657. (with-current-buffer buf
  1658. (goto-char (point-min))
  1659. (when (and (> (tramp-time-diff
  1660. (current-time)
  1661. (tramp-get-connection-property
  1662. p "last-cmd-time" '(0 0 0)))
  1663. 60)
  1664. (process-live-p p)
  1665. (re-search-forward tramp-smb-errors nil t))
  1666. (delete-process p)
  1667. (setq p nil)))
  1668. ;; Check whether it is still the same share.
  1669. (unless (and (process-live-p p)
  1670. (or argument
  1671. (string-equal
  1672. share
  1673. (tramp-get-connection-property p "smb-share" ""))))
  1674. (save-match-data
  1675. ;; There might be unread output from checking for share names.
  1676. (when buf (with-current-buffer buf (erase-buffer)))
  1677. (when (and p (processp p)) (delete-process p))
  1678. (let* ((user (tramp-file-name-user vec))
  1679. (host (tramp-file-name-host vec))
  1680. (domain (tramp-file-name-domain vec))
  1681. (port (tramp-file-name-port vec))
  1682. args)
  1683. (cond
  1684. (argument
  1685. (setq args (list (concat "//" host))))
  1686. (share
  1687. (setq args (list (concat "//" host "/" share))))
  1688. (t
  1689. (setq args (list "-g" "-L" host ))))
  1690. (if (not (zerop (length user)))
  1691. (setq args (append args (list "-U" user)))
  1692. (setq args (append args (list "-N"))))
  1693. (when domain (setq args (append args (list "-W" domain))))
  1694. (when port (setq args (append args (list "-p" port))))
  1695. (when tramp-smb-conf
  1696. (setq args (append args (list "-s" tramp-smb-conf))))
  1697. (when argument
  1698. (setq args (append args (list argument))))
  1699. ;; OK, let's go.
  1700. (with-tramp-progress-reporter
  1701. vec 3
  1702. (format "Opening connection for //%s%s/%s"
  1703. (if (not (zerop (length user))) (concat user "@") "")
  1704. host (or share ""))
  1705. (let* ((coding-system-for-read nil)
  1706. (process-connection-type tramp-process-connection-type)
  1707. (p (let ((default-directory
  1708. (tramp-compat-temporary-file-directory)))
  1709. (apply #'start-process
  1710. (tramp-get-connection-name vec)
  1711. (tramp-get-connection-buffer vec)
  1712. (if argument
  1713. tramp-smb-winexe-program tramp-smb-program)
  1714. args))))
  1715. (tramp-message
  1716. vec 6 "%s" (mapconcat 'identity (process-command p) " "))
  1717. (tramp-set-connection-property p "vector" vec)
  1718. (process-put p 'adjust-window-size-function 'ignore)
  1719. (set-process-query-on-exit-flag p nil)
  1720. ;; Set variables for computing the prompt for reading password.
  1721. (setq tramp-current-method tramp-smb-method
  1722. tramp-current-user user
  1723. tramp-current-domain domain
  1724. tramp-current-host host
  1725. tramp-current-port port)
  1726. (condition-case err
  1727. (let (tramp-message-show-message)
  1728. ;; Play login scenario.
  1729. (tramp-process-actions
  1730. p vec nil
  1731. (if (or argument share)
  1732. tramp-smb-actions-with-share
  1733. tramp-smb-actions-without-share))
  1734. ;; Check server version.
  1735. (unless argument
  1736. (with-current-buffer (tramp-get-connection-buffer vec)
  1737. (goto-char (point-min))
  1738. (search-forward-regexp tramp-smb-server-version nil t)
  1739. (let ((smbserver-version (match-string 0)))
  1740. (unless
  1741. (string-equal
  1742. smbserver-version
  1743. (tramp-get-connection-property
  1744. vec "smbserver-version" smbserver-version))
  1745. (tramp-flush-directory-property vec "")
  1746. (tramp-flush-connection-property vec))
  1747. (tramp-set-connection-property
  1748. vec "smbserver-version" smbserver-version))))
  1749. ;; Set chunksize to 1. smbclient reads its input
  1750. ;; character by character; if we send the string
  1751. ;; at once, it is read painfully slow.
  1752. (tramp-set-connection-property p "smb-share" share)
  1753. (tramp-set-connection-property p "chunksize" 1)
  1754. ;; Set connection-local variables.
  1755. (tramp-set-connection-local-variables vec)
  1756. ;; Mark it as connected.
  1757. (tramp-set-connection-property p "connected" t))
  1758. ;; Check for the error reason. If it was due to wrong
  1759. ;; password, reestablish the connection. We cannot
  1760. ;; handle this in `tramp-process-actions', because
  1761. ;; smbclient does not ask for the password, again.
  1762. (error
  1763. (with-current-buffer (tramp-get-connection-buffer vec)
  1764. (goto-char (point-min))
  1765. (if (and (bound-and-true-p auth-sources)
  1766. (search-forward-regexp
  1767. tramp-smb-wrong-passwd-regexp nil t))
  1768. ;; Disable `auth-source' and `password-cache'.
  1769. (let (auth-sources)
  1770. (tramp-message
  1771. vec 3 "Retry connection with new password")
  1772. (tramp-cleanup-connection vec t)
  1773. (tramp-smb-maybe-open-connection vec argument))
  1774. ;; Propagate the error.
  1775. (signal (car err) (cdr err)))))))))))))
  1776. ;; We don't use timeouts. If needed, the caller shall wrap around.
  1777. (defun tramp-smb-wait-for-output (vec)
  1778. "Wait for output from smbclient command.
  1779. Returns nil if an error message has appeared."
  1780. (with-current-buffer (tramp-get-connection-buffer vec)
  1781. (let ((p (get-buffer-process (current-buffer)))
  1782. (found (progn (goto-char (point-min))
  1783. (re-search-forward tramp-smb-prompt nil t)))
  1784. (err (progn (goto-char (point-min))
  1785. (re-search-forward tramp-smb-errors nil t)))
  1786. buffer-read-only)
  1787. ;; Algorithm: get waiting output. See if last line contains
  1788. ;; `tramp-smb-prompt' sentinel or `tramp-smb-errors' strings.
  1789. ;; If not, wait a bit and again get waiting output.
  1790. (while (and (not found) (not err) (process-live-p p))
  1791. ;; Accept pending output.
  1792. (tramp-accept-process-output p 0.1)
  1793. ;; Search for prompt.
  1794. (goto-char (point-min))
  1795. (setq found (re-search-forward tramp-smb-prompt nil t))
  1796. ;; Search for errors.
  1797. (goto-char (point-min))
  1798. (setq err (re-search-forward tramp-smb-errors nil t)))
  1799. ;; When the process is still alive, read pending output.
  1800. (while (and (not found) (process-live-p p))
  1801. ;; Accept pending output.
  1802. (tramp-accept-process-output p 0.1)
  1803. ;; Search for prompt.
  1804. (goto-char (point-min))
  1805. (setq found (re-search-forward tramp-smb-prompt nil t)))
  1806. (tramp-message vec 6 "\n%s" (buffer-string))
  1807. ;; Remove prompt.
  1808. (when found
  1809. (goto-char (point-max))
  1810. (re-search-backward tramp-smb-prompt nil t)
  1811. (delete-region (point) (point-max)))
  1812. ;; Return value is whether no error message has appeared.
  1813. (not err))))
  1814. (defun tramp-smb-kill-winexe-function ()
  1815. "Send SIGKILL to the winexe process."
  1816. (ignore-errors
  1817. (let ((p (get-buffer-process (current-buffer))))
  1818. (when (process-live-p p)
  1819. (signal-process (process-id p) 'SIGINT)))))
  1820. (defun tramp-smb-call-winexe (vec)
  1821. "Apply a remote command, if possible, using `tramp-smb-winexe-program'."
  1822. ;; Check for program.
  1823. (unless (executable-find tramp-smb-winexe-program)
  1824. (tramp-error
  1825. vec 'file-error "Cannot find program: %s" tramp-smb-winexe-program))
  1826. ;; winexe does not supports ports.
  1827. (when (tramp-file-name-port vec)
  1828. (tramp-error vec 'file-error "Port not supported for remote processes"))
  1829. (tramp-smb-maybe-open-connection
  1830. vec
  1831. (format
  1832. "%s %s"
  1833. tramp-smb-winexe-shell-command tramp-smb-winexe-shell-command-switch))
  1834. (set (make-local-variable 'kill-buffer-hook)
  1835. '(tramp-smb-kill-winexe-function))
  1836. ;; Suppress "^M". Shouldn't we specify utf8?
  1837. (set-process-coding-system (tramp-get-connection-process vec) 'raw-text-dos)
  1838. ;; Set width to 128. This avoids mixing prompt and long error messages.
  1839. (tramp-smb-send-command vec "$rawui = (Get-Host).UI.RawUI")
  1840. (tramp-smb-send-command vec "$bufsize = $rawui.BufferSize")
  1841. (tramp-smb-send-command vec "$winsize = $rawui.WindowSize")
  1842. (tramp-smb-send-command vec "$bufsize.Width = 128")
  1843. (tramp-smb-send-command vec "$winsize.Width = 128")
  1844. (tramp-smb-send-command vec "$rawui.BufferSize = $bufsize")
  1845. (tramp-smb-send-command vec "$rawui.WindowSize = $winsize"))
  1846. (defun tramp-smb-shell-quote-argument (s)
  1847. "Similar to `shell-quote-argument', but uses windows cmd syntax."
  1848. (let ((system-type 'ms-dos))
  1849. (tramp-unquote-shell-quote-argument s)))
  1850. (add-hook 'tramp-unload-hook
  1851. (lambda ()
  1852. (unload-feature 'tramp-smb 'force)))
  1853. (provide 'tramp-smb)
  1854. ;;; TODO:
  1855. ;; * Return more comprehensive file permission string.
  1856. ;;
  1857. ;; * Try to remove the inclusion of dummy "" directory. Seems to be at
  1858. ;; several places, especially in `tramp-smb-handle-insert-directory'.
  1859. ;;
  1860. ;; * Ignore case in file names.
  1861. ;;; tramp-smb.el ends here