PageRenderTime 59ms CodeModel.GetById 23ms RepoModel.GetById 0ms app.codeStats 1ms

/alcobot/branches/xml-config/libs/libFtp.tcl

http://nxscripts.googlecode.com/
TCL | 499 lines | 265 code | 46 blank | 188 comment | 52 complexity | 56339c97346e51599d1296f167af5a60 MD5 | raw file
Possible License(s): LGPL-2.1, BSD-3-Clause
  1. #
  2. # AlcoBot - Alcoholicz site bot.
  3. # Copyright (c) 2005-2006 Alcoholicz Scripting Team
  4. #
  5. # Module Name:
  6. # FTP Client Library
  7. #
  8. # Author:
  9. # neoxed (neoxed@gmail.com) Oct 10, 2005
  10. #
  11. # Abstract:
  12. # Implements a FTP client library to interact with FTP servers.
  13. #
  14. # Exported Procedures:
  15. # FtpOpen <host> <port> <user> <passwd> [-notify <script>] [-secure <type>]
  16. # FtpClose <handle>
  17. # FtpGetError <handle>
  18. # FtpGetStatus <handle>
  19. # FtpConnect <handle>
  20. # FtpDisconnect <handle>
  21. # FtpCommand <handle> <command> [callback]
  22. #
  23. namespace eval ::ftp {
  24. variable nextHandle
  25. if {![info exists nextHandle]} {
  26. set nextHandle 0
  27. }
  28. namespace export FtpOpen FtpClose FtpGetError FtpGetStatus \
  29. FtpConnect FtpDisconnect FtpCommand
  30. }
  31. ####
  32. # FtpOpen
  33. #
  34. # Creates a new FTP client handle. This handle is used by every FTP procedure
  35. # and must be closed using FtpClose.
  36. #
  37. # Secure Options:
  38. # none - Regular connection.
  39. # implicit - Implicit SSL connection.
  40. # ssl - Explicit SSL connection (AUTH SSL).
  41. # tls - Explicit TLS connection (AUTH TLS).
  42. #
  43. proc ::ftp::FtpOpen {host port user passwd args} {
  44. variable nextHandle
  45. set notify ""; set secure ""
  46. foreach {option value} $args {
  47. if {$option eq "-notify"} {
  48. set notify $value
  49. } elseif {$option eq "-secure"} {
  50. switch -- $value {
  51. {} {}
  52. none {set value ""}
  53. implicit - ssl - tls {
  54. # Make sure the TLS package (http://tls.sf.net) is present.
  55. if {[catch {package present tls} message]} {
  56. error "SSL/TLS support not available, install the Tcl-TLS package"
  57. }
  58. }
  59. default {
  60. error "invalid value \"$value\": must be none, implicit, ssl, or tls"
  61. }
  62. }
  63. set secure $value
  64. } elseif {$option eq "-timeout"} {
  65. # TODO: connection timeout
  66. error "not implemented"
  67. } else {
  68. error "invalid switch \"$option\": must be -notify, -secure, or -timeout"
  69. }
  70. }
  71. set handle "ftp$nextHandle"
  72. upvar [namespace current]::$handle ftp
  73. #
  74. # FTP Handle Contents
  75. #
  76. # ftp(host) - Remote server host.
  77. # ftp(port) - Remote server port.
  78. # ftp(user) - Client user name.
  79. # ftp(passwd) - Client password.
  80. # ftp(notify) - Callback to notify when connected.
  81. # ftp(secure) - Connect securely, using SSL or TLS.
  82. # ftp(error) - Last error message.
  83. # ftp(queue) - Event queue (FIFO).
  84. # ftp(sock) - Socket channel.
  85. # ftp(status) - Connection status (0=disconnected, 1=connecting, 2=connected).
  86. #
  87. array set ftp [list \
  88. host $host \
  89. port $port \
  90. user $user \
  91. passwd $passwd \
  92. notify $notify \
  93. secure $secure \
  94. error "" \
  95. queue [list] \
  96. sock "" \
  97. status 0 \
  98. ]
  99. incr nextHandle
  100. return $handle
  101. }
  102. ####
  103. # FtpClose
  104. #
  105. # Closes and invalidates the specified handle.
  106. #
  107. proc ::ftp::FtpClose {handle} {
  108. Acquire $handle ftp
  109. Shutdown $handle
  110. unset -nocomplain ftp
  111. return
  112. }
  113. ####
  114. # FtpGetError
  115. #
  116. # Returns the last error message.
  117. #
  118. proc ::ftp::FtpGetError {handle} {
  119. Acquire $handle ftp
  120. return $ftp(error)
  121. }
  122. ####
  123. # FtpGetStatus
  124. #
  125. # Returns the connection status.
  126. #
  127. proc ::ftp::FtpGetStatus {handle} {
  128. Acquire $handle ftp
  129. return $ftp(status)
  130. }
  131. ####
  132. # FtpConnect
  133. #
  134. # Connects to the FTP server.
  135. #
  136. proc ::ftp::FtpConnect {handle} {
  137. Acquire $handle ftp
  138. if {$ftp(sock) ne ""} {
  139. error "ftp connection open, disconnect first"
  140. }
  141. set ftp(error) ""
  142. set ftp(status) 1
  143. # Asynchronous sockets in Tcl are created immediately but may not be
  144. # connected yet. The writable channel event callback is executed when
  145. # the socket is connected or if the connection failed.
  146. set ftp(sock) [socket -async $ftp(host) $ftp(port)]
  147. fileevent $ftp(sock) writable [list [namespace current]::Verify $handle]
  148. return
  149. }
  150. ####
  151. # FtpDisconnect
  152. #
  153. # Disconnects from the FTP server.
  154. #
  155. proc ::ftp::FtpDisconnect {handle} {
  156. Acquire $handle ftp
  157. Shutdown $handle
  158. return
  159. }
  160. ####
  161. # FtpCommand
  162. #
  163. # Sends a command to the FTP server. The server's response can be retrieved
  164. # by specifying a callback, since this library operates asynchronously.
  165. # For example:
  166. #
  167. # proc SiteWhoCallback {handle response} {
  168. # foreach {code text} $response {
  169. # putlog "$code: $text"
  170. # }
  171. # }
  172. #
  173. # set handle [FtpOpen localhost 21 user pass]
  174. # FtpConnect $handle
  175. # FtpCommand $handle "SITE WHO" SiteWhoCallback
  176. # FtpClose $handle
  177. #
  178. proc ::ftp::FtpCommand {handle command {callback ""}} {
  179. Acquire $handle ftp
  180. if {$ftp(status) != 2} {
  181. error "not connected"
  182. }
  183. lappend ftp(queue) [list quote $command $callback]
  184. # If there's only event in queue, invoke the handler directly.
  185. if {[llength $ftp(queue)] == 1} {
  186. Handler $handle 1
  187. }
  188. return
  189. }
  190. ####
  191. # Acquire
  192. #
  193. # Validate and acquire a FTP handle.
  194. #
  195. proc ::ftp::Acquire {handle handleVar} {
  196. if {![regexp -- {ftp\d+} $handle] || ![array exists [namespace current]::$handle]} {
  197. error "invalid ftp handle \"$handle\""
  198. }
  199. uplevel 1 [list upvar [namespace current]::$handle $handleVar]
  200. }
  201. ####
  202. # Debug
  203. #
  204. # Logs a debug message.
  205. #
  206. proc ::ftp::Debug {function message} {
  207. ::alcoholicz::LogDebug $function $message
  208. }
  209. ####
  210. # Evaluate
  211. #
  212. # Evaluates a callback script.
  213. #
  214. proc ::ftp::Evaluate {script args} {
  215. if {$script ne "" && [catch {eval $script $args} message]} {
  216. Debug FtpEvaluate $message
  217. }
  218. }
  219. ####
  220. # Send
  221. #
  222. # Sends a command to the FTP control channel.
  223. #
  224. proc ::ftp::Send {handle command} {
  225. upvar [namespace current]::$handle ftp
  226. Debug FtpSend "Sending command \"$command\" ($handle)."
  227. if {[info exists ftp]} {
  228. if {[catch {puts $ftp(sock) $command} message]} {
  229. Shutdown $handle "unable to send command - $message"
  230. } else {
  231. catch {flush $ftp(sock)}
  232. }
  233. }
  234. return
  235. }
  236. ####
  237. # Shutdown
  238. #
  239. # Shuts down the FTP connection. The error parameter is an empty string
  240. # when the connection is closed intentionally with FtpClose or FtpDisconnect.
  241. #
  242. proc ::ftp::Shutdown {handle {error ""}} {
  243. upvar [namespace current]::$handle ftp
  244. Debug FtpShutdown "Connection closed ($handle): $error"
  245. if {[info exists ftp]} {
  246. # Remove channel events before closing the channel.
  247. catch {fileevent $ftp(sock) readable {}}
  248. catch {fileevent $ftp(sock) writable {}}
  249. # Send the QUIT command and terminate the socket.
  250. catch {puts $ftp(sock) "QUIT"}
  251. catch {flush $ftp(sock)}
  252. catch {close $ftp(sock)}
  253. set ftp(sock) ""
  254. # Update connection status, error message, and evaluate the notify callback.
  255. set ftp(status) 0
  256. if {$error ne ""} {
  257. set ftp(error) $error
  258. Evaluate $ftp(notify) $handle 0
  259. }
  260. }
  261. }
  262. ####
  263. # Verify
  264. #
  265. # Verifies the connection's state and begins the SSL negotiation for
  266. # FTP servers using implicit SSL.
  267. #
  268. proc ::ftp::Verify {handle} {
  269. upvar [namespace current]::$handle ftp
  270. if {![info exists ftp]} {
  271. Debug FtpVerify "Handle \"$handle\" does not exist."
  272. return
  273. }
  274. # Disable the writable channel event.
  275. fileevent $ftp(sock) writable {}
  276. set message [fconfigure $ftp(sock) -error]
  277. if {$message ne ""} {
  278. Shutdown $handle "unable to connect - $message"
  279. return
  280. }
  281. set peer [fconfigure $ftp(sock) -peername]
  282. Debug FtpVerify "Connected to [lindex $peer 0]:[lindex $peer 2] ($handle)."
  283. # Perform SSL negotiation for FTP servers using implicit SSL.
  284. # TODO: Implicit is broken.
  285. if {$ftp(secure) eq "implicit" && [catch {tls::import $ftp(sock) -ssl2 1 -ssl3 1 -tls1 1} message]} {
  286. Shutdown $handle "SSL negotiation failed - $message"
  287. return
  288. }
  289. # Initialise event queue.
  290. if {$ftp(secure) eq "ssl" || $ftp(secure) eq "tls"} {
  291. set ftp(queue) auth
  292. } else {
  293. set ftp(queue) user
  294. }
  295. # Set channel options and event handlers.
  296. fconfigure $ftp(sock) -buffering line -blocking 0 -translation {auto crlf}
  297. fileevent $ftp(sock) readable [list [namespace current]::Handler $handle]
  298. return
  299. }
  300. ####
  301. # Handler
  302. #
  303. # FTP client event handler.
  304. #
  305. proc ::ftp::Handler {handle {direct 0}} {
  306. upvar [namespace current]::$handle ftp
  307. if {![info exists ftp]} {
  308. Debug FtpHandler "Handle \"$handle\" does not exist."
  309. return
  310. }
  311. set replyCode 0
  312. set replyBase 0
  313. set buffer [list]
  314. set message ""
  315. if {[gets $ftp(sock) line] > 0} {
  316. #
  317. # Multi-line responses have a hyphen after the reply code for
  318. # each line until the last line is reached. For example:
  319. #
  320. # 200-blah
  321. # 200-blah
  322. # 200-blah
  323. # 200 Command successful.
  324. #
  325. if {[regexp -- {^([0-9]+)( |-)?(.*)$} $line result replyCode multi message]} {
  326. lappend buffer $replyCode $message
  327. } else {
  328. Debug FtpHandler "Invalid server response \"$line\"."
  329. set multi ""
  330. }
  331. #
  332. # The "STAT -al" response differs substantially, all subsequent lines
  333. # after the initial response do not have a reply code until the last line.
  334. #
  335. # 211-Status of .:
  336. # drwxrwxrwx 22 user group 0 Oct 07 03:49 .
  337. # drwxrwxrwx 5 user group 0 Apr 02 02:59 blah1
  338. # drwxrwxrwx 25 user group 0 Oct 11 00:00 blah2
  339. # drwxrwxrwx 22 user group 0 Sep 27 22:52 blah3
  340. # drwxrwxrwx 37 user group 0 Jun 06 03:39 blah4
  341. # 211 End of Status
  342. #
  343. # Because of this, the line is appended to the response buffer
  344. # regardless of whether or not it matches the regular expression.
  345. #
  346. while {$multi eq "-" && [gets $ftp(sock) line] > 0} {
  347. regexp -- {^([0-9]+)( |-)?(.*)$} $line result replyCode multi line
  348. lappend buffer $replyCode $line
  349. }
  350. } elseif {[eof $ftp(sock)]} {
  351. # The remote server has closed the control connection.
  352. Shutdown $handle "server closed connection"
  353. return
  354. } elseif {!$direct} {
  355. # No response from the server. Return if the handler was not
  356. # invoked directly (i.e. not by a channel writable event).
  357. return
  358. }
  359. Debug FtpHandler "Reply code \"$replyCode\" and message \"$message\" ($handle)."
  360. #
  361. # Variables:
  362. # replyCode - Reply code (e.g. 200).
  363. # replyBase - Base reply code (e.g. 2).
  364. # buffer - List of reply codes and text messages.
  365. # message - Text from the first line (lindex $buffer 1).
  366. #
  367. set replyBase [string index $replyCode 0]
  368. while {[llength $ftp(queue)]} {
  369. set nextEvent 0
  370. # The first list element of an event must be its name, the
  371. # remaining elements are optional and vary between event types.
  372. set event [lindex $ftp(queue) 0]
  373. set eventName [lindex $event 0]
  374. # Pop the event from queue.
  375. set ftp(queue) [lrange $ftp(queue) 1 end]
  376. Debug FtpHandler "Event: $eventName ($handle)"
  377. switch -- $eventName {
  378. auth {
  379. # Receive hello response and send AUTH.
  380. if {$replyBase == 2} {
  381. Send $handle "AUTH [string toupper $ftp(secure)]"
  382. set ftp(queue) auth_sent
  383. } else {
  384. Shutdown $handle "unable to login - $message"
  385. return
  386. }
  387. }
  388. auth_sent {
  389. # Receive AUTH response and send PBSZ.
  390. if {$replyBase == 2} {
  391. if {[catch {tls::import $ftp(sock) -ssl2 1 -ssl3 1 -tls1 1} message]} {
  392. Shutdown $handle "SSL negotiation failed - $message"
  393. return
  394. }
  395. # Set channel options again, in case the TLS module changes them.
  396. fconfigure $ftp(sock) -buffering line -blocking 0 -translation {auto crlf}
  397. Send $handle "PBSZ 0"
  398. set ftp(queue) user
  399. } else {
  400. Shutdown $handle "unable to login - $message"
  401. return
  402. }
  403. }
  404. user {
  405. # Receive hello or PBSZ response and send USER.
  406. if {$replyBase == 2} {
  407. Send $handle "USER $ftp(user)"
  408. set ftp(queue) user_sent
  409. } else {
  410. Shutdown $handle "unable to login - $message"
  411. return
  412. }
  413. }
  414. user_sent {
  415. # Receive USER response and send PASS.
  416. if {$replyBase == 3} {
  417. Send $handle "PASS $ftp(passwd)"
  418. set ftp(queue) pass_sent
  419. } else {
  420. Shutdown $handle "unable to login - $message"
  421. return
  422. }
  423. }
  424. pass_sent {
  425. # Receive PASS response.
  426. if {$replyBase == 2} {
  427. set ftp(status) 2
  428. Evaluate $ftp(notify) $handle 1
  429. set nextEvent 1
  430. } else {
  431. Shutdown $handle "unable to login - $message"
  432. return
  433. }
  434. }
  435. quote {
  436. # Send command.
  437. Send $handle [lindex $event 1]
  438. set ftp(queue) [linsert $ftp(queue) 0 [list quote_sent [lindex $event 2]]]
  439. }
  440. quote_sent {
  441. # Receive command.
  442. Evaluate [lindex $event 1] $handle $buffer
  443. set nextEvent 1
  444. }
  445. default {
  446. Debug FtpHandler "Invalid event name \"$eventName\"."
  447. }
  448. }
  449. # Proceed to the next event?
  450. if {!$nextEvent} {break}
  451. }
  452. return
  453. }