├── test-resources ├── sample2.pdf ├── spacer.jpg └── sample.kml ├── .gitignore ├── project.clj ├── test └── miner │ ├── mock_ftp.clj │ └── ftp_test.clj ├── README.md └── src └── miner └── ftp.clj /test-resources/sample2.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/miner/clj-ftp/HEAD/test-resources/sample2.pdf -------------------------------------------------------------------------------- /test-resources/spacer.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/miner/clj-ftp/HEAD/test-resources/spacer.jpg -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | pom.xml 6 | *.jar 7 | *.class 8 | .lein-deps-sum 9 | .lein-failures 10 | .lein-plugins 11 | .lein 12 | .idea 13 | *.iml -------------------------------------------------------------------------------- /test-resources/sample.kml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | Everest 5 | 8.848m/20.209ft high. 6 | 7 | 27.988232096332762,86.92526578903198 8 | 9 | 10 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject com.velisco/clj-ftp "1.2.0" 2 | :description "Clojure wrapper on Apache Commons Net for FTP" 3 | :url "http://github.com/miner/clj-ftp" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :min-lein-version "2.0" 7 | :deploy-repositories [["releases" :clojars] 8 | ["clojars" {:url "https://repo.clojars.org" 9 | :sign-releases false}]] 10 | :dependencies [[org.clojure/clojure "1.8.0"] 11 | [clj-commons/fs "1.6.311"] 12 | [commons-net "3.11.1"]] 13 | :profiles {:test {:resource-paths ["test-resources"] 14 | :dependencies [[org.mockftpserver/MockFtpServer "3.2.0"] 15 | [org.slf4j/slf4j-jdk14 "2.0.16"] 16 | [digest "1.4.10"]]}}) 17 | 18 | -------------------------------------------------------------------------------- /test/miner/mock_ftp.clj: -------------------------------------------------------------------------------- 1 | (ns miner.mock-ftp 2 | (:import 3 | (org.mockftpserver.fake UserAccount) 4 | (org.mockftpserver.fake.filesystem UnixFakeFileSystem DirectoryEntry) 5 | (org.mockftpserver.fake.command AbstractFakeCommandHandler) 6 | (org.mockftpserver.core.command CommandNames) 7 | (org.mockftpserver.fake FakeFtpServer))) 8 | 9 | (def control-connection-timeout 10 | (-> (proxy [AbstractFakeCommandHandler] [] 11 | (handle [cmd session] 12 | (while true 13 | (Thread/sleep 60000)))))) 14 | 15 | 16 | ;; Note that the mock account password is "#password". The first character is the "hash" 17 | ;; character (a.k.a. number sign or octothorp), which requires percent encoding in URLs. 18 | ;; The equivalent is "%23". 19 | ;; https://www.w3schools.com/tags/ref_urlencode.ASP 20 | 21 | (defn build 22 | (^FakeFtpServer [control-port] 23 | (build control-port nil)) 24 | (^FakeFtpServer [control-port handler] 25 | (let [mock-server (new FakeFtpServer) 26 | filesystem (new UnixFakeFileSystem)] 27 | (.addUserAccount mock-server (new UserAccount "username" "#password" "/home/username")) 28 | (.add filesystem (new DirectoryEntry "/home/username")) 29 | (.setFileSystem mock-server filesystem) 30 | (.setServerControlPort mock-server control-port) 31 | (when handler 32 | (.setCommandHandler mock-server CommandNames/PASV handler)) 33 | mock-server))) 34 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # clj-ftp 2 | 3 | Wrapper over [Apache Commons Net][apache] to provide easy access from Clojure. 4 | 5 | [apache]: https://commons.apache.org/proper/commons-net/ "Apache Commons Net" 6 | 7 | Note: FTP is considered insecure. Data and passwords are sent in the 8 | clear so someone could sniff packets on your network and discover 9 | your password. Nevertheless, FTP access is useful for dealing with anonymous 10 | FTP servers and situations where security is not an issue. 11 | 12 | ## Leiningen 13 | 14 | *clj-ftp* is available from Clojars. Add the following dependency to your *project.clj*: 15 | 16 | [![clj-ftp on clojars.org][latest]][clojar] 17 | 18 | [latest]: https://clojars.org/com.velisco/clj-ftp/latest-version.svg "clj-ftp on clojars.org" 19 | [clojar]: https://clojars.org/com.velisco/clj-ftp 20 | 21 | 22 | ## Usage 23 | 24 | (require '[miner.ftp :as ftp]) 25 | 26 | (ftp/with-ftp [client "ftp://anonymous:pwd@ftp.example.com/pub"] 27 | (ftp/client-get client "interesting.txt" "stuff.txt")) 28 | 29 | By default, we use a passive local data connection. You can override that by passing an option 30 | after the URL. Use :local-data-connection-mode :active if you don't want passive mode. For 31 | example: 32 | 33 | (ftp/with-ftp [client "ftp://anonymous:pwd@ftp.example.com/pub" 34 | :local-data-connection-mode :active] 35 | (ftp/client-get client "interesting.txt" "stuff.txt")) 36 | 37 | The default file-type for transfers is :ascii, but you can change it with the option `:file-type 38 | :binary` in `with-ftp`. Use `client-set-file-type` to set it appropriately before each transfer. 39 | 40 | The options for `with-ftp` are: 41 | - `:default-timeout-ms` (not set by default) 42 | - `:connect-timeout-ms` (default to 30000) 43 | - `:data-timeout-ms` (default infinite) 44 | - `:control-keep-alive-timeout-sec` (default 300) 45 | - `:control-keep-alive-reply-timeout-ms` (default 1000) 46 | - `:control-encoding` (default "UTF-8") 47 | - `:file-type` (default :ascii) 48 | - `:local-data-connection-mode` (default :passive) 49 | - `:security-mode` (default :explicit) 50 | - `:strict-parsing-mode` (default: true) 51 | - `:username` (plain string without percent encoding) 52 | - `:password` (plain string without percent encoding) 53 | 54 | 55 | Note: when `:username` and `:password` are specified as options, the URL should not have 56 | those values embedded. Also, the given values are plain text and should not use percent 57 | encoding for special characters as required with the URL value. The following two examples 58 | are equivalent: 59 | 60 | (ftp/with-ftp [client "ftp://foo:%23%20pwd%21@ftp.example.com/pub"] 61 | (ftp/client-get client "interesting.txt" "stuff.txt")) 62 | 63 | (ftp/with-ftp [client "ftp://ftp.example.com/pub" 64 | :username "foo" 65 | :password "# pwd!"] 66 | (ftp/client-get client "interesting.txt" "stuff.txt")) 67 | 68 | 69 | ## License 70 | 71 | Copyright © 2012-23 Stephen E. Miner 72 | 73 | Distributed under the Eclipse Public License, the same as Clojure. 74 | 75 | [![clj-ftp](https://img.shields.io/clojars/v/com.velisco/clj-ftp.svg)](https://clojars.org/com.velisco/clj-ftp) 76 | 77 | -------------------------------------------------------------------------------- /test/miner/ftp_test.clj: -------------------------------------------------------------------------------- 1 | (ns miner.ftp-test 2 | (:use clojure.test 3 | miner.ftp) 4 | (:require [me.raynes.fs :as fs] 5 | [digest :as dig] 6 | [clojure.java.io :as io] 7 | [miner.mock-ftp :as mock-ftp]) 8 | (:import (org.apache.commons.net.ftp FTPFile))) 9 | 10 | ;;; Note to future testers: many of these tests are using public FTP servers that were 11 | ;;; documented to be available at the time these tests were written. However, there's no 12 | ;;; guarantee that they will continue to be in service and publicly open. If tests fail, we 13 | ;;; may have to try a different server or just temporarily disable the test. 14 | 15 | (def test-ftp-url 16 | "ftp://anonymous:joe%40mailinator.com@ftp.swfwmd.state.fl.us/pub/gisdata") 17 | 18 | (def test-ftp-writeable-url 19 | "ftp://anonymous:joe%40mailinator.com@ftp.swfwmd.state.fl.us/pub/incoming") 20 | 21 | (deftest listing 22 | (is (pos? (count (list-files test-ftp-url))))) 23 | 24 | (deftest retrieve-file-one-shot 25 | (let [tmp (fs/temp-file "ftp-")] 26 | (retrieve-file test-ftp-url "message" tmp) 27 | (is (fs/exists? tmp)) 28 | (when (fs/exists? tmp) 29 | (fs/delete tmp)))) 30 | 31 | (defn get-file-guts [client tmpfile] 32 | (client-cd client "..") 33 | (is (.endsWith ^String (client-pwd client) "pub")) 34 | (is (pos? (count (client-all-names client)))) 35 | (client-cd client "gisdata") 36 | (is (.endsWith ^String (client-pwd client) "data")) 37 | (client-get client "message" tmpfile) 38 | (is (fs/exists? tmpfile))) 39 | 40 | (deftest get-file-client 41 | (let [tmp (fs/temp-file "ftp-") 42 | tmp2 (fs/temp-file "ftp-") 43 | url test-ftp-url] 44 | (with-ftp [client url] 45 | (get-file-guts client tmp)) 46 | (with-ftp [client2 url :local-data-connection-mode :active] 47 | (get-file-guts client2 tmp2)) 48 | (is (fs/size tmp) (fs/size tmp2)) 49 | (when (fs/exists? tmp) 50 | (fs/delete tmp)) 51 | (when (fs/exists? tmp2) 52 | (fs/delete tmp2)))) 53 | 54 | (deftest set-connect-timeout 55 | (let [url "ftp://anonymous@google.com:81"] 56 | (is (thrown? java.io.IOException (open url "UTF-8" {:connect-timeout-ms 1}))))) 57 | 58 | (deftest get-stream-client 59 | (let [tmp (fs/temp-file "ftp-")] 60 | (with-ftp [client test-ftp-url] 61 | (is (instance? java.io.InputStream 62 | (client-get-stream client "message")))))) 63 | 64 | (deftest get-stream-client-two-files 65 | (let [tmp (fs/temp-file "ftp-")] 66 | (with-ftp [client test-ftp-url] 67 | (with-open [s1 (client-get-stream client "message")] 68 | (is (instance? java.io.InputStream s1)) 69 | (io/copy s1 tmp) 70 | (client-complete-pending-command client)) 71 | (with-open [s2 (client-get-stream client "message")] 72 | (is (instance? java.io.InputStream s2)) 73 | (io/copy s2 tmp) 74 | (client-complete-pending-command client))))) 75 | 76 | (deftest get-all 77 | (with-ftp [client test-ftp-url 78 | :data-timeout-ms 50000, :control-keep-alive-timeout-sec 10 79 | :control-keep-alive-reply-timeout-ms 500] 80 | (is (mapv #(.getName ^FTPFile %) (client-FTPFiles client)) (client-all-names client)))) 81 | 82 | (defn print-FTPFiles-list [label ftpfiles] 83 | (println) 84 | (println label) 85 | (doseq [^FTPFile f ftpfiles] 86 | (print (.getName f)) 87 | (when (.isDirectory f) (print "/")) 88 | (println)) 89 | (println)) 90 | 91 | (comment 92 | (with-ftp [client "ftp://anonymous:user%40example.com@ftp.gnu.org/gnu"] 93 | (print-FTPFiles-list "files only" (client-FTPFiles client)) 94 | (print-FTPFiles-list "dirs only" (client-FTPFile-directories client)) 95 | (print-FTPFiles-list "all" (client-FTPFiles-all client))) 96 | ) 97 | 98 | ;; Writable FTP server usage: http://www.swfwmd.state.fl.us/data/ftp/ 99 | 100 | (deftest write-file 101 | (with-ftp [client test-ftp-writeable-url] 102 | (let [source (.getFile (io/resource "sample.kml"))] 103 | ;;(println "write-file source = " (when source (.getFile source))) 104 | (client-put client source (str "s" (System/currentTimeMillis) ".kml"))))) 105 | 106 | ;; FTP server usage: http://cs.brown.edu/system/ftp.html 107 | ;; But doesn't seem to work anymore. 108 | ;; Switch to DLPTest which allows writes. See https://dlptest.com/ftp-test/ 109 | 110 | (deftest write-file2 111 | (with-ftp [client "ftp://dlpuser:rNrKYTX9g7z3RgJRmxWuGHbeu@ftp.dlptest.com/"] 112 | (let [source (java.io.FileInputStream. (io/file (io/resource "sample.kml")))] 113 | ;;(println "write-file source = " (when source (.getFile source))) 114 | (client-put-stream client source (str "s" (System/currentTimeMillis) ".kml"))))) 115 | 116 | ;; not in service, but http might work? ftp://anonymous:anything@speedtest.tele2.net 117 | 118 | ;; old host fails, connection closed, 119 | ;; "ftp://wrong-username:wrong-password@ftp.cs.brown.edu/incoming" 120 | 121 | ;;; BAD part is bogus, rest of URL should work and allow writing temporary file 122 | (deftest invalid-login-fails 123 | (try 124 | (with-ftp [client "ftp://BADdlpuser:rNrKYTX9g7z3RgJRmxWuGHbeu@ftp.dlptest.com/"] 125 | ;; try connecting with an invalid pw/username, to trigger the exception 126 | ) 127 | (catch Exception e 128 | (is (= "Unable to login with username: \"BADdlpuser\"." 129 | (.getMessage e))) 130 | (is (= (:invalid-user (ex-data e)) "BADdlpuser"))))) 131 | 132 | ;; failing probably due to overuse 133 | ;; "ftp://anonymous:brown%40mailinator.com@ftp.cs.brown.edu/MISSING" 134 | 135 | (deftest invalid-path-fails 136 | (try 137 | (with-ftp [client "ftp://dlpuser:rNrKYTX9g7z3RgJRmxWuGHbeu@ftp.dlptest.com/MISSING"] 138 | ;; try connecting with an invalid path, to trigger the exception 139 | ) 140 | (catch Exception e 141 | (is (= "Unable to change working directory to \"/MISSING\"." 142 | (.getMessage e))) 143 | (is (= (:invalid-path (ex-data e)) "/MISSING"))))) 144 | 145 | (defn sha1 [file-or-url] 146 | (let [file (io/as-file file-or-url)] 147 | (if (fs/readable? file) 148 | (dig/sha-1 file) 149 | (throw (ex-info (str "Unreadable file " (pr-str file-or-url)) {:file file-or-url}))))) 150 | 151 | ;;; failing write "ftp://anonymous:joe%40mailinator.com@ftp.swfwmd.state.fl.us/pub/incoming" 152 | ;;; switch to DLPTest.com 153 | (deftest write-file-binary 154 | (with-ftp [client "ftp://dlpuser:rNrKYTX9g7z3RgJRmxWuGHbeu@ftp.dlptest.com/" 155 | :file-type :binary] 156 | (let [source (io/resource "spacer.jpg") 157 | dest (str "sp" (System/currentTimeMillis) ".jpg") 158 | tmp (fs/temp-file "spacer") 159 | guess (guess-file-type source)] 160 | (is (= guess :binary)) 161 | (client-set-file-type client guess) 162 | ;; (println "write-file-binary source = " (when source (.getFile source))) 163 | ;; (println "write-file-binray source = " dest) 164 | ;; (println "write-file-binary tmp = " (str tmp)) 165 | (client-put client source dest) 166 | (client-get client dest tmp) 167 | (is (= (fs/size source) (fs/size tmp))) 168 | ;; test for file corruption that can result from wrong file type 169 | (is (= (sha1 source) (sha1 tmp))) 170 | (fs/delete tmp)))) 171 | 172 | 173 | ;; ftp://ftp4.us.freebsd.org/pub/FreeBSD/ works for read-only 174 | 175 | ;; Another possibility: http://user.agu.org/ishelp/ftp.html 176 | ;; ftp://ftp.agu.org/incoming/test/ 177 | ;; pub is the only readable dir but you have to know full filename 178 | 179 | 180 | (deftest ftps 181 | ;; Per http://www.sftp.net/public-online-sftp-servers, which is apparently 182 | ;; maintained by Rebex developers. 183 | (is (= ::success 184 | (with-ftp [client "ftps://demo:password@test.rebex.net:21" 185 | :data-timeout-ms 10000, :control-keep-alive-timeout-sec 10 186 | :control-keep-alive-reply-timeout-ms 500] 187 | ::success)))) 188 | 189 | 190 | (deftest user-info-percent-encoding 191 | (are [x y] (= x (user-info y "UTF-8")) 192 | nil "ftp://example.com" 193 | ["foo" "bar"] "ftp://foo:bar@example.com" 194 | ["foo" "bar"] "ftps://foo:bar@example.com" 195 | 196 | ["foo" nil] "ftp://foo@example.com" 197 | ["" "bar"] "ftp://:bar@example.com" 198 | 199 | ["foo:bar" "baz"] "ftp://foo%3abar:baz@example.com" 200 | ["foo:bar" "baz"] "ftp://foo%3Abar:baz@example.com" 201 | ["foo" "bar:baz"] "ftp://foo:bar%3abaz@example.com" 202 | ["foo" "bar:baz"] "ftp://foo:bar%3Abaz@example.com" 203 | 204 | ["foo@bar" "baz@quux"] "ftp://foo%40bar:baz%40quux@example.com" 205 | ["foo%bar" "baz%quux"] "ftp://foo%25bar:baz%25quux@example.com" 206 | 207 | ["foo++bar" "baz"] "ftp://foo++bar:baz@example.com" 208 | ["foo+++" "baz"] "ftp://foo+++:baz@example.com" 209 | 210 | ["çåƒé" "ßåßê"] "ftp://%c3%a7%c3%a5%c6%92%c3%a9:%c3%9f%c3%a5%c3%9f%c3%aa@example.com")) 211 | 212 | 213 | ;; Note that the mock account password is "#password". The first character is the "hash" 214 | ;; character (a.k.a. number sign or octothorp), which requires percent encoding in URLs. 215 | ;; The equivalent is "%23". 216 | ;; https://www.w3schools.com/tags/ref_urlencode.ASP 217 | 218 | (deftest default-timeout 219 | (let [mock-ftp-port 2021 220 | mock-server (mock-ftp/build mock-ftp-port mock-ftp/control-connection-timeout)] 221 | (.start mock-server) 222 | (with-ftp [client (str "ftp://username:%23password@localhost:" mock-ftp-port) :default-timeout-ms 200] 223 | (is (thrown? java.io.IOException (client-file-names client)))) 224 | (.stop mock-server))) 225 | 226 | (deftest explicit-user-credentials 227 | (let [mock-ftp-port 2021 228 | mock-server (mock-ftp/build mock-ftp-port)] 229 | (.start mock-server) 230 | (with-ftp [client (str "ftp://localhost:" mock-ftp-port) :username "username" :password "#password"] 231 | (is (empty? (client-file-names client)))) 232 | (.stop mock-server))) 233 | 234 | (deftest url-user-credentials 235 | (let [mock-ftp-port 2021 236 | mock-server (mock-ftp/build mock-ftp-port)] 237 | (.start mock-server) 238 | (with-ftp [client (str "ftp://username:%23password@localhost:" mock-ftp-port)] 239 | (is (empty? (client-file-names client)))) 240 | (.stop mock-server))) 241 | -------------------------------------------------------------------------------- /src/miner/ftp.clj: -------------------------------------------------------------------------------- 1 | ;; Apache Commons Net API: 2 | ;; https://commons.apache.org/proper/commons-net/apidocs/index.html 3 | 4 | ;; Uses Apache Commons Net 3.9. Does not support SFTP, but does support FTPS. 5 | 6 | ;; FTP is considered insecure. Data and passwords are sent in the 7 | ;; clear so someone could sniff packets on your network and discover 8 | ;; your password. Nevertheless, FTP access is useful for dealing with anonymous 9 | ;; FTP servers and situations where security is not an issue. 10 | 11 | (ns miner.ftp 12 | (:import [org.apache.commons.net.ftp FTP FTPClient FTPSClient FTPFile FTPReply] 13 | [java.net URI URL] 14 | [java.io File IOException FileOutputStream OutputStream FileInputStream InputStream]) 15 | (:require [me.raynes.fs :as fs] 16 | [clojure.string :as str] 17 | [clojure.java.io :as io])) 18 | 19 | (defn as-uri ^URI [url] 20 | (cond (instance? URL url) (.toURI ^URL url) 21 | (instance? URI url) url 22 | :else (URI. url))) 23 | 24 | (defn open 25 | ([url] (open url "UTF-8" {})) 26 | ([url control-encoding] (open url control-encoding {})) 27 | ([url control-encoding 28 | {:keys [strict-reply-parsing 29 | security-mode 30 | data-timeout-ms 31 | connect-timeout-ms 32 | default-timeout-ms 33 | control-keep-alive-timeout-sec 34 | control-keep-alive-reply-timeout-ms] 35 | :or {strict-reply-parsing true 36 | security-mode :explicit 37 | data-timeout-ms -1 38 | connect-timeout-ms 30000 39 | control-keep-alive-timeout-sec 300 40 | control-keep-alive-reply-timeout-ms 1000}}] 41 | (let [implicit? (not= :explicit security-mode) 42 | ^URI uri (as-uri url) 43 | ^FTPClient client (case (.getScheme uri) 44 | "ftp" (FTPClient.) 45 | "ftps" (FTPSClient. implicit?) 46 | (throw (Exception. (str "unexpected protocol " (.getScheme uri) " in FTP url, need \"ftp\" or \"ftps\""))))] 47 | ;; (.setAutodetectUTF8 client true) 48 | (when default-timeout-ms (.setDefaultTimeout client default-timeout-ms)) 49 | (.setStrictReplyParsing client strict-reply-parsing) 50 | (.setControlEncoding client control-encoding) 51 | (.setConnectTimeout client connect-timeout-ms) 52 | (.setDataTimeout client ^int data-timeout-ms) 53 | (.setControlKeepAliveTimeout client ^int control-keep-alive-timeout-sec) 54 | (.setControlKeepAliveReplyTimeout client ^int control-keep-alive-reply-timeout-ms) 55 | (.connect client 56 | (.getHost uri) 57 | (if (= -1 (.getPort uri)) (int 21) (.getPort uri))) 58 | (let [reply (.getReplyCode client)] 59 | (when-not (FTPReply/isPositiveCompletion reply) 60 | (.disconnect client) 61 | (throw (ex-info "Connection failed" {:reply-code reply 62 | :reply-string (.getReplyString client)})))) 63 | client))) 64 | 65 | (defn guess-file-type [file-name] 66 | "Best guess about the file type to use when transferring a given file based on the extension. 67 | Returns either :binary or :ascii (the default). If you don't know what you're dealing with, 68 | this might help, but don't bet the server farm on it. See also `client-set-file-type`." 69 | (case (str/lower-case (fs/extension file-name)) 70 | (".jpg" ".jpeg" ".zip" ".mov" ".bin" ".exe" ".pdf" ".gz" ".tar" ".dmg" ".jar" ".tgz" ".war" 71 | ".lz" ".mp3" ".mp4" ".sit" ".z" ".dat" ".o" ".app" ".png" ".gif" ".class" ".avi" ".m4v" 72 | ".mpg" ".mpeg" ".swf" ".wmv" ".ogg") :binary 73 | :ascii)) 74 | 75 | (defn client-set-file-type [^FTPClient client filetype] 76 | "Set the file type for transfers to either :binary or :ascii (the default)" 77 | (if (= filetype :binary) 78 | (.setFileType client FTP/BINARY_FILE_TYPE) 79 | (.setFileType client FTP/ASCII_FILE_TYPE)) 80 | filetype) 81 | 82 | (defn user-info 83 | "Decode the user info part of a URL to extract the username and password. 84 | 85 | Note that URI#getUserInfo() isn't used because if the result of that method 86 | contains more than one ':' character, we can't determine which ':' is the 87 | separator. At the same time, we can't easily use URLDecoder, because it 88 | converts '+' into spaces. So we have to do the percent-decoding ourselves." 89 | [url control-encoding] 90 | (letfn [(decode [s] 91 | (when s 92 | (str/replace s 93 | #"(%[0-9a-fA-F]{2})+" 94 | (fn [[match & _]] 95 | (String. ^bytes (->> (.split (subs match 1) "%") 96 | (map #(.byteValue (Integer/decode (str "0x" %)))) 97 | (byte-array)) 98 | ^String control-encoding)))))] 99 | (when-let [[encoded-uname encoded-pass] (when-let [ui (.getRawUserInfo (as-uri url))] 100 | (.split ui ":" 2))] 101 | [(decode encoded-uname) (decode encoded-pass)]))) 102 | 103 | (defn login* [^FTPClient client url username password] 104 | (when-not (.login client username password) 105 | (throw (ex-info (format "Unable to login with username: \"%s\"." username) 106 | {:url url 107 | :invalid-user username})))) 108 | 109 | (defmacro with-ftp 110 | "Establish an FTP connection, bound to client, for the FTP url, and execute the body with 111 | access to that client connection. Closes connection at end of body. Keyword 112 | options can follow the url in the binding vector. By default, uses a passive local data 113 | connection mode and ASCII file type. 114 | Use [client url :local-data-connection-mode :active 115 | :file-type :binary 116 | :security-mode :explicit] to override. 117 | 118 | Allows to override the following timeouts: 119 | - `connect-timeout-ms` - The timeout used when opening a socket. Default 30000 120 | - `data-timeout-ms` - the underlying socket timeout. Default - infinite (< 1). 121 | - `control-keep-alive-timeout-sec` - control channel keep alive message 122 | timeout. Default 300 seconds. 123 | - `control-keep-alive-reply-timeout-ms` - how long to wait for the control 124 | channel keep alive replies. Default 1000 ms. 125 | - `control-encoding` - The new character encoding for the control connection. Default - UTF-8 126 | - `username` - FTP username (if not supplying credentials via the URL) 127 | - `password` - FTP password (if not supplying credentials via the URL)" 128 | [[client url & {:keys [local-data-connection-mode file-type 129 | control-encoding 130 | username password] 131 | :as params 132 | :or {control-encoding "UTF-8"}}] & body] 133 | `(let [local-mode# ~local-data-connection-mode 134 | u# (as-uri ~url) 135 | ~client ^FTPClient (open u# ~control-encoding ~params) 136 | file-type# ~file-type] 137 | (try 138 | (if-let [[uname# pass#] (user-info u# ~control-encoding)] 139 | (login* ~client u# uname# pass#) ;; URL embedded credentials 140 | (login* ~client u# ~username ~password)) ;; Explicit credentials via params 141 | (let [path# (.getPath u#)] 142 | (when-not (or (str/blank? path#) (= path# "/")) 143 | (when-not (.changeWorkingDirectory ~client (subs path# 1)) 144 | (throw (ex-info (format "Unable to change working directory to \"%s\"." 145 | path#) 146 | {:url u# 147 | :invalid-path path#}))))) 148 | (client-set-file-type ~client file-type#) 149 | ;; by default (when nil) use passive mode 150 | (if (= local-mode# :active) 151 | (.enterLocalActiveMode ~client) 152 | (.enterLocalPassiveMode ~client)) 153 | ~@body 154 | (finally (when (.isConnected ~client) 155 | (try 156 | (.disconnect ~client) 157 | (catch IOException e# nil))))))) 158 | 159 | 160 | (defn client-FTPFiles-all [^FTPClient client] 161 | (vec (.listFiles client))) 162 | 163 | (defn client-FTPFiles [^FTPClient client] 164 | (filterv (fn [f] (and f (.isFile ^FTPFile f))) (.listFiles client))) 165 | 166 | (defn client-FTPFile-directories [^FTPClient client] 167 | (vec (.listDirectories client))) 168 | 169 | (defn client-all-names [^FTPClient client] 170 | (vec (.listNames client))) 171 | 172 | (defn client-file-names [^FTPClient client] 173 | (mapv #(.getName ^FTPFile %) (client-FTPFiles client))) 174 | 175 | (defn client-directory-names [^FTPClient client] 176 | (mapv #(.getName ^FTPFile %) (client-FTPFile-directories client))) 177 | 178 | (defn client-complete-pending-command 179 | "Complete the previous command and check the reply code. Throw an exception if 180 | reply code is not a positive completion" 181 | [^FTPClient client] 182 | (.completePendingCommand client) 183 | (let [reply-code (.getReplyCode client)] 184 | (when-not (FTPReply/isPositiveCompletion reply-code) 185 | (throw (ex-info "Not a Positive completion of last command" {:reply-code reply-code 186 | :reply-string (.getReplyString client)}))))) 187 | 188 | (defn client-get 189 | "Get a file and write to local file-system (must be within a with-ftp)" 190 | ([client fname] (client-get client fname (fs/base-name fname))) 191 | 192 | ([client fname local-name] 193 | (with-open [outstream (FileOutputStream. (io/as-file local-name))] 194 | (.retrieveFile ^FTPClient client ^String fname ^OutputStream outstream)))) 195 | 196 | (defn client-get-stream 197 | "Get a file and return InputStream (must be within a with-ftp). Note that it's necessary to complete 198 | this command with a call to `client-complete-pending-command` after using the stream." 199 | ^InputStream [client fname] 200 | (.retrieveFileStream ^FTPClient client ^String fname)) 201 | 202 | (defn client-put 203 | "Put a file (must be within a with-ftp)" 204 | ([client fname] (client-put client fname (fs/base-name fname))) 205 | 206 | ([client fname remote] (with-open [instream (FileInputStream. (io/as-file fname))] 207 | (.storeFile ^FTPClient client ^String remote ^InputStream instream)))) 208 | 209 | (defn client-put-stream 210 | "Put an InputStream (must be within a with-ftp)" 211 | [client instream remote] 212 | (.storeFile ^FTPClient client ^String remote ^InputStream instream)) 213 | 214 | (defn client-cd [client dir] 215 | (.changeWorkingDirectory ^FTPClient client ^String dir)) 216 | 217 | (defn- strip-double-quotes [^String s] 218 | (let [len (count s)] 219 | (cond (<= len 2) s 220 | (and (= (.charAt s 0) \") 221 | (= (.charAt s (dec len)) \")) (subs s 1 (dec len)) 222 | :else s))) 223 | 224 | (defn client-pwd [client] 225 | (strip-double-quotes (.printWorkingDirectory ^FTPClient client))) 226 | 227 | (defn client-mkdir [client subdir] 228 | (.makeDirectory ^FTPClient client ^String subdir)) 229 | 230 | ;; Regular mkdir can only make one level at a time; mkdirs makes nested paths in the correct order 231 | (defn client-mkdirs [client subpath] 232 | (doseq [d (reductions (fn [path item] (str path File/separator item)) (fs/split subpath))] 233 | (client-mkdir client d))) 234 | 235 | (defn client-delete [client fname] 236 | "Delete a file (must be within a with-ftp)" 237 | (.deleteFile ^FTPClient client ^String fname)) 238 | 239 | (defn client-rename [client from to] 240 | "Rename a remote file (must be within a with-ftp" 241 | (.rename ^FTPClient client ^String from ^String to)) 242 | 243 | 244 | (defn client-send-site-command [client sitecmd ] 245 | "Send Site Command must be within with-ftp" 246 | (.sendSiteCommand ^FTPClient client ^String sitecmd)) 247 | 248 | ;; convenience methods for one-shot results 249 | 250 | (defn rename-file [url from to] 251 | (with-ftp [client url] 252 | (client-rename client from to))) 253 | 254 | (defn retrieve-file 255 | ([url fname] (retrieve-file url fname (fs/base-name fname))) 256 | ([url fname local-file] 257 | (with-ftp [client url] 258 | (client-get client fname (io/as-file local-file))))) 259 | 260 | (defn list-all [url] 261 | (with-ftp [client url] 262 | (seq (client-all-names client)))) 263 | 264 | (defn list-files [url] 265 | (with-ftp [client url] 266 | (seq (client-file-names client)))) 267 | 268 | (defn list-directories [url] 269 | (with-ftp [client url] 270 | (seq (client-directory-names client)))) 271 | 272 | ;; this method encrypts the channel when you are using ftps. 273 | ;; to avoid error : 274 | ;; 425-Server requires protected data connection. 275 | ;; 425 Can't open data connection. 276 | ;; you must call this before doing a transfer 277 | 278 | (defn encrypt-channel [client ] 279 | (do (.execPBSZ ^FTPSClient client 0) 280 | (.execPROT ^FTPSClient client "P"))) 281 | 282 | --------------------------------------------------------------------------------