Posted By

reboltutorial on 12/11/10


Tagged


Versions (?)

ftp patch


 / Published in: R
 

URL: http://rebol.wik.is/Protocols/Ftp

  1. REBOL [
  2. Title: "REBOL Protocols: FTP"
  3. Version: 2.7.6
  4. Rights: "Copyright REBOL Technologies 2008. All rights reserved."
  5. Home: http://www.rebol.com
  6. Date: 14-Mar-2008
  7.  
  8. ; You are free to use, modify, and distribute this file as long as the
  9. ; above header, copyright, and this entire comment remains intact.
  10. ; This software is provided "as is" without warranties of any kind.
  11. ; In no event shall REBOL Technologies or source contributors be liable
  12. ; for any damages of any kind, even if advised of the possibility of such
  13. ; damage. See license for more information.
  14.  
  15. ; Please help us to improve this software by contributing changes and
  16. ; fixes. See http://www.rebol.com/support.html for details.
  17. ]
  18.  
  19. make root-protocol [
  20. spick: sremove: scopy: sclose: sopen: sget-modes: none
  21. set [spick sremove scopy sclose sopen sget-modes]
  22. reduce bind [:pick :remove :copy :close :open :get-modes] 'system
  23. connections: make block! 5
  24.  
  25. open-check: [none ["220" "230"] ["USER" dehex port/user] "331" ["PASS" port/pass] "230" "SYST" "*"]
  26. close-check: ["QUIT" ["221" "421"]]
  27. write-check: ["TYPE I" "200" ["STOR" port/target] ["150" "125"]]
  28.  
  29. active-check: [["PORT" port/locals/active-check] "200"]
  30. read-check: [["RETR" port/target] ["150" "125"]]
  31. restart-check: [["REST" port/state/index] "350"]
  32. chdir-check: [["CWD" port/path] ["25" "200"]]
  33. root-check: [["CWD" port/locals/home-dir] ["25" "200"]]
  34. list-check: ["TYPE A" "200" "LIST" ["150" "125"]]
  35. nlst-check: ["TYPE A" "200" "NLST" ["150" "125" ]]
  36. binary-type-check: ["TYPE I" "200"]
  37. append-check: ["TYPE I" "200" ["APPE" port/target] ["150" "125"]]
  38. mkdir-check: [["MKD" port/locals/file] "25"]
  39. rmdir-check: [["RMD" port/locals/file] "250"]
  40. rmfile-check: [["DELE" port/locals/file] "250"]
  41. rename-check: [["RNFR" port/locals/file] "350" ["RNTO" port/locals/to-name] "250"]
  42. transfer-check: [none ["226" "250"]]
  43. passive-check: ["PASV" "227"]
  44. pwd-check: ["PWD" "25"]
  45.  
  46. port-locals: make object! [dir-cache: listen-port: passive: cmd-port: none]
  47. cmd-port-locals: make object! [active-check: file: to-name: home-dir: updated: tuple: none]
  48.  
  49. error-try?: func [blk][error? try blk]
  50. confirm-cmd: func [port [port!] check [block!]] [
  51. net-utils/confirm/multiline port/locals/cmd-port check
  52. ]
  53. close-cmd: func [cmd-port] [
  54. net-utils/net-log reform ["Closing cmd port" cmd-port/local-port cmd-port/remote-port]
  55. error-try? [sclose cmd-port]
  56. ]
  57. close-listen: func [port] [
  58. if port? port/locals/listen-port [
  59. net-utils/net-log reform ["Closing listen port" port/locals/listen-port/local-port]
  60. error-try? [sclose port/locals/listen-port]
  61. ]
  62. ]
  63. close-on-fail: func [port blk /local res] [
  64. if error? set/any 'res try blk [
  65. if port/locals [
  66. close-cmd port/locals/cmd-port
  67. close-listen port
  68. ]
  69. ]
  70. all [value? 'res res]
  71. ]
  72. append-active: func [check [string!] id] [
  73. insert tail check rejoin ["." to-integer id / 256 "." id // 256]
  74. replace/all check #"." #","
  75. ]
  76. dir-read?: func [port] [empty? port/target]
  77. parse-cur-dir: func [str] [
  78. replace/all second
  79. parse/all
  80. replace/all str {""} "^/"
  81. " ^-"
  82. "^/" {"}
  83. ]
  84. parse-files: func [
  85. str type {none (=list) or 'nlst depending on what list op was performed}
  86. /local result digit char space attrs chars new-line sp ftp-list ftp-dir vars
  87. attr owner group size date time file pdate month info-block
  88. loc ftp-nlst msftp-list msftp-dir dir file-rule
  89. no-space nosp
  90. add-date digits no-newline ftp-nlist reduced
  91. ] [
  92. result: scopy []
  93. digit: charset "0123456789"
  94. char: charset [#"a" - #"z" #"A" - #"Z" #"0" - #"9" "=+-_.:&$*',"]
  95. space: charset " ^-"
  96. no-space: complement space
  97. nosp: [any no-space]
  98. no-newline: complement charset "^M^/"
  99. attrs: charset "-dlrwxXsStT"
  100. chars: [any char]
  101. digits: [any digit]
  102. new-line: [newline | "^M^/"]
  103. sp: [any space]
  104. add-date: func [] [
  105. month: first pdate
  106. sremove pdate
  107. insert next pdate month
  108. if 3 > length? pdate [
  109. insert tail pdate now/year
  110. insert tail pdate to-time time
  111. ]
  112. loop length? loc: pdate [insert loc "/" loc: skip loc 2]
  113. sremove pdate
  114. if (now + 1) < loc: to-date rejoin pdate [loc/year: loc/year - 1]
  115. insert tail info-block loc
  116. ]
  117. ftp-list: [
  118. ftp-dir
  119. (
  120. type: 'file
  121. reduced: reduce vars
  122. append result to-file rejoin [
  123. either #"l" = first attr [type: 'link scopy/part file find file " ->"] [file]
  124. either #"d" = first attr [type: 'directory "/"] [""]
  125. ]
  126. insert/only tail result info-block: reduce [type to-integer size]
  127. pdate: parse date none
  128. add-date
  129. )
  130. new-line
  131. ]
  132. file-rule: [copy file [some no-newline | to "^M^/"]]
  133. ftp-dir: [
  134. copy attr 10 attrs sp
  135. digits sp
  136. copy owner nosp sp
  137. copy group nosp sp
  138. copy size digits sp
  139. copy date [chars sp digits sp [digits some space | none]]
  140. copy time [[digits ":" digits sp] | none]
  141. file-rule
  142. ]
  143. msftp-list: [
  144. msftp-dir
  145. (
  146. insert tail result to-file file
  147. insert/only tail result info-block: reduce [type to-integer size]
  148. pdate: parse date "-"
  149. add-date
  150. )
  151. new-line
  152. ]
  153. msftp-dir: [
  154. copy date to " " sp
  155. copy time [digits ":" digits] (time: to-time time)
  156. copy ampm to " " sp (if ampm = "PM" [time: time + 12:00])
  157. [<DIR> (type: 'directory size: 0) | copy size digits (trim/tail size type: 'file)]
  158. sp file-rule (if type = 'directory [insert tail file "/"])
  159. ]
  160. ftp-nlist: [
  161. file-rule (
  162. insert tail result reduce [to-file file reduce ['file none none]]
  163. )
  164. new-line
  165. ]
  166. vars: [attr owner group size date time file]
  167. set vars none
  168. either type <> 'nlst [
  169. if not parse/all str ["total" sp digits sp new-line some ftp-list | some ftp-list] [
  170. parse/all str [some msftp-list]
  171. ]
  172. ] [
  173. parse/all str [some ftp-nlist]
  174. ]
  175. result
  176. ]
  177. get-cur-dir: func [cmd-port] [
  178. parse-cur-dir net-utils/confirm cmd-port pwd-check
  179. ]
  180. parse-dir-list: func [port /local file-list line dir-cache tmp] [
  181. file-list: make string! 2000
  182. while [line: spick port/sub-port 1] [insert insert tail file-list line newline]
  183. ;debug
  184. ;print ["Raw-lst:" newline mold file-list]
  185. confirm-transfer port
  186. port/locals/dir-cache: dir-cache: parse-files file-list port/algorithm ;none or 'nlst
  187. foreach item [%./ %../] [sremove/part find dir-cache item 2]
  188. if port/algorithm = 'nlst [
  189. tmp: get-cur-dir port/locals/cmd-port
  190. if slash <> spick tail tmp -1 [insert tail tmp slash]
  191. foreach [name blk] dir-cache [
  192. if not error? try [
  193. confirm-cmd port [[join "CWD " [tmp name]] ["25" "200"]]
  194. ][insert tail name slash blk/1: 'directory]
  195. ]
  196. confirm-cmd port [[join "CWD " tmp] ["25" "200"]]
  197. ]
  198. (length? dir-cache) / 2
  199. ]
  200. confirm-transfer: func [port] [
  201. net-utils/net-log reform ["Closing data port" port/sub-port/host port/sub-port/local-port port/sub-port/remote-port]
  202. sclose port/sub-port
  203. confirm-cmd port transfer-check
  204. ]
  205. data-connect: func [
  206. port
  207. /local a-check info num tmp
  208. locals proxy cmd-port x
  209. ] [
  210. proxy: all [port/proxy/host port/proxy]
  211. locals: port/locals
  212. cmd-port: port/locals/cmd-port
  213. if any [
  214. all [proxy proxy/type <> 'socks5 proxy/type <> 'socks]
  215. all [
  216. not locals/passive
  217. not proxy
  218. error-try? [
  219. locals/listen-port: sopen/lines [
  220. scheme: 'tcp
  221. port-id: 0
  222. timeout: port/timeout
  223. ]
  224. net-utils/net-log reform ["Opening listen port" locals/listen-port/port-id]
  225. a-check: form reduce either zero? locals/listen-port/local-ip [
  226. cmd-port/local-ip
  227. ][
  228. locals/listen-port/local-ip
  229. ]
  230. cmd-port/locals/active-check: append-active a-check locals/listen-port/port-id
  231. confirm-cmd port active-check
  232. ]
  233. ]
  234. ] [locals/passive: true]
  235. if all [proxy not locals/passive] [
  236. cmd-port/host: port/host
  237. cmd-port/proxy: proxy
  238. port/sub-port: net-utils/connect-proxy cmd-port 'bind
  239. cmd-port/locals/active-check: append-active reform port/sub-port/host port/sub-port/port-id
  240. if error-try? [confirm-cmd port active-check] [locals/passive: true]
  241. ]
  242. if locals/passive [
  243. info: make string! 16
  244. if not parse tmp: confirm-cmd port passive-check [
  245. thru #"("
  246. 4 [copy x integer! #"," (insert insert tail info x #".")]
  247. (sremove back tail info)
  248. [copy x integer! (num: 256 * to-integer x) #"," copy x integer! (num: num + to-integer x) #")"]
  249. to end
  250. ] [
  251. net-error join "Invalid port or id number string: " mold tmp
  252. ]
  253. cmd-port/host: info
  254. cmd-port/port-id: num
  255. cmd-port/proxy: proxy
  256. port/sub-port: either all [proxy proxy/type <> 'generic] [
  257. net-utils/connect-proxy cmd-port 'connect
  258. ][
  259. sopen/lines [
  260. scheme: 'tcp
  261. host: cmd-port/host
  262. port-id: num
  263. timeout: port/timeout
  264. ]
  265. ]
  266. ]
  267. ]
  268. accept-connect: func [port type][
  269. if not port/locals/passive [
  270. either port/locals/listen-port [
  271. if type <> 'new-dir [port/sub-port: first port/locals/listen-port]
  272. close-listen port
  273. port/locals/listen-port: none
  274. ][
  275. net-utils/accept-proxy port/sub-port
  276. ]
  277. ]
  278. ]
  279. open: func [
  280. port
  281. /local type tmp new-dir? proxy conn
  282. locals conns cache-size cached
  283. new? cmd-port
  284. ] [
  285. close-on-fail port [
  286. proxy: found? port/proxy/host
  287. any [port/user port/user: "anonymous"]
  288. any [port/pass port/pass: [email protected]]
  289. if error-try? [to-tuple tmp: port/host] [tmp: form system/words/read join dns:// port/host]
  290. conns: connections
  291. while [not empty? conns] [
  292. conn: first conns
  293. either all [conn/host = tmp conn/user = port/user] [
  294. sremove conns
  295. either error-try? [
  296. net-utils/confirm/multiline conn root-check
  297. ] [
  298. close-cmd conn
  299. ] [
  300. port/locals: make port-locals [cmd-port: conn]
  301. port/state/flags: port/state/flags or port-flags
  302. net-utils/net-log reform ["Using the cached port" conn/host conn/local-port conn/remote-port]
  303. break
  304. ]
  305. ] [conns: next conns]
  306. ]
  307. locals: port/locals
  308. if none? locals [
  309. open-proto port
  310. locals: port/locals: make port-locals [cmd-port: port/sub-port]
  311. port/sub-port: none
  312. locals/cmd-port/locals: make cmd-port-locals [
  313. tuple: tmp
  314. home-dir: get-cur-dir locals/cmd-port
  315. ]
  316. ]
  317. locals/passive: system/schemes/ftp/passive
  318. cmd-port: locals/cmd-port
  319. cmd-port/path: port/path: any [port/path scopy ""]
  320. cmd-port/target: port/target: any [port/target scopy ""]
  321. if dir-read? port [
  322. all [
  323. sget-modes port 'direct
  324. net-error "Cannot open a dir port in direct mode"
  325. ]
  326. port/state/flags: port/state/flags or system/standard/port-flags/pass-thru
  327. ]
  328. all [
  329. port/state/index <> 0
  330. any [not sget-modes port 'binary dir-read? port]
  331. net-error "Cannot skip a not binary file port"
  332. ]
  333. data-connect port
  334. new?: port/state/flags and system/standard/port-flags/open-new <> 0
  335. if not empty? port/path [
  336. if new-dir?: all [dir-read? port new?][
  337. cmd-port/path: first tmp: split-path to-file cmd-port/path
  338. cmd-port/locals/file: second tmp
  339. if 1 < length? cmd-port/locals/file [
  340. sremove back tail cmd-port/locals/file
  341. ]
  342. ]
  343. if cmd-port/path <> %./ [
  344. confirm-cmd port chdir-check
  345. ]
  346. ]
  347. net-utils/net-log join "Type: " type: any [
  348. all [new-dir? 'new-dir]
  349. all [new? 'new]
  350. all [dir-read? port 'dir]
  351. all [port/state/flags and system/standard/port-flags/open-append <> 0 'app]
  352. 'file
  353. ]
  354. do select [
  355. file [
  356. confirm-cmd port either port/algorithm = 'nlst [nlst-check][list-check]
  357. accept-connect port type
  358. parse-dir-list port
  359. if tmp: select locals/dir-cache to-file port/target [
  360. port/status: first tmp
  361. port/date: third tmp
  362. if any [none? port/size: second tmp 1024 > port/size] [port/size: 0]
  363. ]
  364. data-connect port
  365. confirm-cmd port binary-type-check
  366. if 0 < cmd-port/state/index: port/state/index [
  367. confirm-cmd port restart-check
  368. ]
  369. confirm-cmd port read-check
  370. ]
  371. new [confirm-cmd port write-check]
  372. new-dir [confirm-cmd port mkdir-check]
  373. dir [confirm-cmd port either port/algorithm = 'nlst [nlst-check][list-check]]
  374. app [confirm-cmd port append-check]
  375. ] type
  376. accept-connect port type
  377. if type = 'dir [
  378. port/size: port/state/tail: parse-dir-list port
  379. ]
  380. ]
  381. port
  382. ]
  383. close: func [port /local cmd-port cache-size] [
  384. cmd-port: port/locals/cmd-port
  385. if not dir-read? port [error-try? [confirm-transfer port]]
  386. net-utils/net-log reform ["Caching cmd-port" cmd-port/host cmd-port/local-port cmd-port/remote-port]
  387. cmd-port/host: cmd-port/locals/tuple
  388. cmd-port/locals/updated: now/time
  389. append connections cmd-port
  390. any [integer? cache-size: system/schemes/ftp/cache-size cache-size: 0]
  391. while [cache-size < length? connections] [
  392. close-cmd first connections
  393. sremove connections
  394. ]
  395. ]
  396. query: func [port /local info file path err dir-cache] [
  397. either not port/locals [
  398. if port/target [
  399. file: to-file port/target
  400. port/target: none
  401. ]
  402. open port
  403. close port
  404. dir-cache: port/locals/dir-cache
  405. either none? file [
  406. port/status: 'directory
  407. port/size: port/state/tail
  408. ] [
  409. either info: select dir-cache file [
  410. port/status: first info
  411. port/size: second info
  412. port/date: third info
  413. ] [
  414. if info: select dir-cache join file slash [
  415. port/date: third info
  416. port/path: join port/path file slash
  417. port/target: port/locals: none
  418. query port
  419. ]
  420. ]
  421. ]
  422. ] [
  423. port/status: spick [directory file] dir-read? port
  424. port/size: port/state/tail
  425. ]
  426. none
  427. ]
  428. change: func [port new-name /local cmd-port] [
  429. cmd-port: port/locals/cmd-port
  430. cmd-port/locals/file: to-string spick port/locals/dir-cache 2 * port/state/index + 1
  431. cmd-port/locals/to-name: either all [
  432. slash = last cmd-port/locals/file
  433. slash <> last new-name
  434. ] [new-name: join new-name slash] [scopy new-name]
  435. close-on-fail port [confirm-cmd port rename-check]
  436. poke port/locals/dir-cache 2 * port/state/index + 1 to-file new-name
  437. port
  438. ]
  439. copy: func [port /local out num index value] [
  440. out: make block! num: port/state/num
  441. index: port/state/index
  442. parse port/locals/dir-cache [index [2 skip] num [set value skip skip (insert tail out scopy value)]]
  443. out
  444. ]
  445. pick: func [port] [
  446. spick port/locals/dir-cache 2 * port/state/index + 1
  447. ]
  448. remove: func [port /local cmd-port dir-cache] [
  449. cmd-port: port/locals/cmd-port
  450. dir-cache: skip port/locals/dir-cache 2 * port/state/index
  451. loop port/state/num [
  452. cmd-port/locals/file: to string! first dir-cache
  453. close-on-fail port [confirm-cmd port either slash = last cmd-port/locals/file [rmdir-check] [rmfile-check]]
  454. sremove/part dir-cache 2
  455. port/state/tail: port/state/tail - 1
  456. ]
  457. ]
  458. net-utils/net-install 'FTP self 21
  459. ]

Report this snippet  

You need to login to post a comment.