├── .circleci └── config.yml ├── .github └── CODEOWNERS ├── .gitignore ├── ORIGINATOR ├── README.markdown ├── project.clj ├── src └── me │ └── raynes │ ├── fs.clj │ └── fs │ ├── compression.clj │ └── feature_flags.clj ├── test └── me │ └── raynes │ ├── core_test.clj │ └── testfiles │ ├── bar │ ├── bbb.bz2 │ ├── foo │ ├── ggg.gz │ ├── ggg.tar │ ├── ggg.zip │ ├── xxx.xz │ ├── zip-slip.tar │ └── zip-slip.zip └── version.edn /.circleci/config.yml: -------------------------------------------------------------------------------- 1 | # Clojure CircleCI 2.0 configuration file 2 | # 3 | # Check https://circleci.com/docs/2.0/language-clojure/ for more details 4 | # 5 | version: 2.1 6 | 7 | workflows: 8 | build-deploy: 9 | jobs: 10 | - build: 11 | filters: 12 | tags: 13 | only: /.*/ 14 | 15 | - deploy: 16 | requires: 17 | - build 18 | filters: 19 | tags: 20 | only: /Release-.*/ 21 | branches: 22 | only: 23 | - master 24 | context: 25 | - CLOJARS_DEPLOY 26 | 27 | jobs: 28 | build: 29 | docker: 30 | # specify the version you desire here 31 | - image: circleci/clojure:lein-2.9.1 32 | # Specify service dependencies here if necessary 33 | # CircleCI maintains a library of pre-built images 34 | # documented at https://circleci.com/docs/2.0/circleci-images/ 35 | # - image: circleci/postgres:9.4 36 | 37 | working_directory: ~/repo 38 | 39 | environment: 40 | LEIN_ROOT: "true" 41 | # Customize the JVM maximum heap limit 42 | JVM_OPTS: -Xmx3200m 43 | 44 | steps: 45 | - checkout 46 | 47 | # Download and cache dependencies 48 | - restore_cache: 49 | keys: 50 | - v1-dependencies-{{ checksum "project.clj" }} 51 | # fallback to using the latest cache if no exact match is found 52 | - v1-dependencies- 53 | 54 | - run: lein deps 55 | 56 | - save_cache: 57 | paths: 58 | - ~/.m2 59 | key: v1-dependencies-{{ checksum "project.clj" }} 60 | - run: 61 | name: Ensure No Reflection Warnings 62 | command: "! lein check 2>&1 | grep 'Reflection warning'" 63 | # run tests! 64 | - run: lein midje 65 | 66 | deploy: 67 | docker: 68 | # specify the version you desire here 69 | - image: circleci/clojure:lein-2.9.1 70 | # Specify service dependencies here if necessary 71 | # CircleCI maintains a library of pre-built images 72 | # documented at https://circleci.com/docs/2.0/circleci-images/ 73 | # - image: circleci/postgres:9.4 74 | 75 | working_directory: ~/repo 76 | 77 | environment: 78 | LEIN_ROOT: "true" 79 | # Customize the JVM maximum heap limit 80 | JVM_OPTS: -Xmx3200m 81 | 82 | steps: 83 | - checkout 84 | 85 | # Download and cache dependencies 86 | - restore_cache: 87 | keys: 88 | - v1-dependencies-{{ checksum "project.clj" }} 89 | # fallback to using the latest cache if no exact match is found 90 | - v1-dependencies- 91 | 92 | - run: 93 | name: Install babashka 94 | command: | 95 | curl -s https://raw.githubusercontent.com/borkdude/babashka/master/install -o install.sh 96 | sudo bash install.sh 97 | rm install.sh 98 | - run: 99 | name: Install deployment-script 100 | command: | 101 | curl -s https://raw.githubusercontent.com/clj-commons/infra/main/deployment/circle-maybe-deploy.bb -o circle-maybe-deploy.bb 102 | chmod a+x circle-maybe-deploy.bb 103 | 104 | - run: lein deps 105 | 106 | - run: 107 | name: Setup GPG signing key 108 | command: | 109 | GNUPGHOME="$HOME/.gnupg" 110 | export GNUPGHOME 111 | mkdir -p "$GNUPGHOME" 112 | chmod 0700 "$GNUPGHOME" 113 | 114 | echo "$GPG_KEY" \ 115 | | base64 --decode --ignore-garbage \ 116 | | gpg --batch --allow-secret-key-import --import 117 | 118 | gpg --keyid-format LONG --list-secret-keys 119 | 120 | - save_cache: 121 | paths: 122 | - ~/.m2 123 | key: v1-dependencies-{{ checksum "project.clj" }} 124 | - run: 125 | name: Deploy 126 | command: | 127 | GPG_TTY=$(tty) 128 | export GPG_TTY 129 | echo $GPG_TTY 130 | ./circle-maybe-deploy.bb lein deploy clojars 131 | 132 | -------------------------------------------------------------------------------- /.github/CODEOWNERS: -------------------------------------------------------------------------------- 1 | * @slipset 2 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .lein* 2 | *.jar 3 | lib 4 | classes 5 | pom.xml 6 | README.html 7 | docs 8 | target 9 | pom.xml* 10 | doc 11 | test/me/raynes/testfiles/round* -------------------------------------------------------------------------------- /ORIGINATOR: -------------------------------------------------------------------------------- 1 | @raynes 2 | -------------------------------------------------------------------------------- /README.markdown: -------------------------------------------------------------------------------- 1 | # fs - File system utilities for Clojure 2 | 3 | [![Clojars Project](https://img.shields.io/clojars/v/clj-commons/fs.svg)](https://clojars.org/clj-commons/fs) 4 | [![cljdoc badge](https://cljdoc.org/badge/clj-commons/fs)](https://cljdoc.org/d/clj-commons/fs) 5 | [![CircleCI](https://circleci.com/gh/clj-commons/fs.svg?style=svg)](https://circleci.com/gh/clj-commons/fs) 6 | 7 | This library defines some utilities for working with the file system in Clojure. Mostly, it wants to fill the gap that 8 | `clojure.java.io` leaves and add on (and prettify) what `java.io.File` provides. 9 | 10 | This library is the continuation of Raynes/fs. Sadly Raynes passed away in 2016 so the clj-commons clojure organisation has taken over maintenance of this excellent library to keep it alive. 11 | 12 | ## Maintenance mode 13 | 14 | This library is in maintenance mode. That means that it's no longer actively developed, but we still provide maintenance. If you're looking for an actively developed fs lib, please consider using [babashka/fs](https://github.com/babashka/fs) 15 | 16 | ## Usage 17 | 18 | This library is simple. It is just a collection of functions that do things with the file system. The one thing 19 | you should understand is `*cwd*`. This library wraps a lot of built-in Java file systemy things because it 20 | pays attention to the `*cwd*` as the current working directory. Java has no way to change the cwd of a JVM so 21 | if you want that behavior, you have to simulate it. This library tries to do that. 22 | 23 | The foundation of the library is the `file` function. It is just like `clojure.java.io/file`, but it pays 24 | attention to the value of `*cwd*`. 25 | 26 | This is 100% a utility library. If you have something useful that it doesn't already have, open a pull request, 27 | because I probably want it. Make sure you include tests. Also, make sure they pass. 28 | 29 | fs is *not* an I/O utility library. We should try to keep things limited to file system activities. 30 | 31 | ## Artifacts 32 | 33 | Library artifacts are [released to Clojars](https://clojars.org/clj-commons/fs). If you are using Maven, add the following repository 34 | definition to your `pom.xml`: 35 | 36 | ``` xml 37 | 38 | clojars.org 39 | http://clojars.org/repo 40 | 41 | ``` 42 | 43 | ### The Most Recent Release 44 | 45 | With Leiningen: 46 | 47 | [clj-commons/fs "1.6.307"] 48 | 49 | 50 | With Maven: 51 | 52 | 53 | clj-commons 54 | fs 55 | 1.6.307 56 | 57 | 58 | ## License 59 | 60 | Copyright (C) 2010-2013 Miki Tebeka, Anthony Grimes 61 | 62 | Distributed under the Eclipse Public License, the same as Clojure. 63 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject clj-commons/fs (or (System/getenv "PROJECT_VERSION") "0.1.0-SNAPSHOT") 2 | :description "File system utilities for clojure" 3 | :license {:name "Eclipse Public License - v 1.0" 4 | :url "http://www.eclipse.org/legal/epl-v10.html"} 5 | :url "https://github.com/clj-commons/fs" 6 | :deploy-repositories [["clojars" {:url "https://repo.clojars.org" 7 | :username :env/clojars_username 8 | :password :env/clojars_password 9 | :sign-releases true}]] 10 | 11 | :dependencies [[org.clojure/clojure "1.9.0" :scope "provided"] 12 | [org.apache.commons/commons-compress "1.26.0"] 13 | ;; this lib is marked as optional in 14 | ;; commons-compress, so we need to import it 15 | ;; explicitly 16 | [org.tukaani/xz "1.9"]] 17 | :plugins [[lein-midje "3.1.3"] 18 | [codox "0.8.10"] 19 | [lein-ancient "0.6.15"]] 20 | :codox {:src-dir-uri "https://github.com/clj-commons/fs/blob/master/" 21 | :src-linenum-anchor-prefix "L" 22 | :defaults {:doc/format :markdown}} 23 | :profiles {:dev {:dependencies [[midje "1.9.4"]]}}) 24 | -------------------------------------------------------------------------------- /src/me/raynes/fs.clj: -------------------------------------------------------------------------------- 1 | (ns me.raynes.fs 2 | "File system utilities in Clojure" 3 | (:refer-clojure :exclude [name parents]) 4 | (:require [clojure.zip :as zip] 5 | [clojure.java.io :as io] 6 | [clojure.java.shell :as sh] 7 | [me.raynes.fs.feature-flags :as feature-flags]) 8 | (:import [java.io File FilenameFilter] 9 | [java.nio.file Files Path LinkOption CopyOption] 10 | [java.nio.file.attribute FileAttribute])) 11 | 12 | ;; Once you've started a JVM, that JVM's working directory is set in stone 13 | ;; and cannot be changed. This library will provide a way to simulate a 14 | ;; working directory change. `cwd` is considered to be the current working 15 | ;; directory for functions in this library. Unfortunately, this will only 16 | ;; apply to functions inside this library since we can't change the JVM's 17 | ;; actual working directory. 18 | (def ^{:doc "Current working directory. This cannot be changed in the JVM. 19 | Changing this will only change the working directory for functions 20 | in this library." 21 | :dynamic true} 22 | *cwd* (.getCanonicalFile (io/file "."))) 23 | 24 | (let [homedir (io/file (System/getProperty "user.home")) 25 | usersdir (.getParent homedir)] 26 | (defn home 27 | "With no arguments, returns the current value of the `user.home` system 28 | property. If a `user` is passed, returns that user's home directory. It 29 | is naively assumed to be a directory with the same name as the `user` 30 | located relative to the parent of the current value of `user.home`." 31 | ([] homedir) 32 | ([user] (if (empty? user) homedir (io/file usersdir user))))) 33 | 34 | (defn expand-home 35 | "If `path` begins with a tilde (`~`), expand the tilde to the value 36 | of the `user.home` system property. If the `path` begins with a 37 | tilde immediately followed by some characters, they are assumed to 38 | be a username. This is expanded to the path to that user's home 39 | directory. This is (naively) assumed to be a directory with the same 40 | name as the user relative to the parent of the current value of 41 | `user.home`." 42 | [path] 43 | (let [path (str path)] 44 | (if (.startsWith path "~") 45 | (let [sep (.indexOf path File/separator)] 46 | (if (neg? sep) 47 | (home (subs path 1)) 48 | (io/file (home (subs path 1 sep)) (subs path (inc sep))))) 49 | (io/file path)))) 50 | 51 | ;; Library functions will call this function on paths/files so that 52 | ;; we get the cwd effect on them. 53 | (defn ^File file 54 | "If `path` is a period, replaces it with cwd and creates a new File object 55 | out of it and `paths`. Or, if the resulting File object does not constitute 56 | an absolute path, makes it absolutely by creating a new File object out of 57 | the `paths` and cwd." 58 | [path & paths] 59 | (when-let [path (apply 60 | io/file (if (= path ".") 61 | *cwd* 62 | path) 63 | paths)] 64 | (if (.isAbsolute ^File path) 65 | path 66 | (io/file *cwd* path)))) 67 | 68 | (defn list-dir 69 | "List files and directories under `path`." 70 | [path] 71 | (seq (.listFiles (file path)))) 72 | 73 | (defmacro ^:private predicate [s path] 74 | `(if ~path 75 | (. ~path ~s) 76 | false)) 77 | 78 | (defn absolute? 79 | "Return true if `path` is absolute." 80 | [path] 81 | (predicate isAbsolute (io/file path))) 82 | 83 | (defn executable? 84 | "Return true if `path` is executable." 85 | [path] 86 | (predicate canExecute (file path))) 87 | 88 | (defn readable? 89 | "Return true if `path` is readable." 90 | [path] 91 | (predicate canRead (file path))) 92 | 93 | (defn writeable? 94 | "Return true if `path` is writeable." 95 | [path] 96 | (predicate canWrite (file path))) 97 | 98 | (defn delete 99 | "Delete `path`." 100 | [path] 101 | (predicate delete (file path))) 102 | 103 | (defn exists? 104 | "Return true if `path` exists." 105 | [path] 106 | (predicate exists (file path))) 107 | 108 | (defn absolute 109 | "Return absolute file." 110 | [path] 111 | (.getAbsoluteFile (file path))) 112 | 113 | (defn normalized 114 | "Return normalized (canonical) file." 115 | [path] 116 | (.getCanonicalFile (file path))) 117 | 118 | (defn ^String base-name 119 | "Return the base name (final segment/file part) of a `path`. 120 | 121 | If optional `trim-ext` is a string and the `path` ends with that 122 | string, it is trimmed. 123 | 124 | If `trim-ext` is true, any extension is trimmed." 125 | ([path] (.getName (file path))) 126 | ([path trim-ext] 127 | (let [base (.getName (file path))] 128 | (cond (string? trim-ext) (if (.endsWith base trim-ext) 129 | (subs base 0 (- (count base) (count trim-ext))) 130 | base) 131 | trim-ext (let [dot (.lastIndexOf base ".")] 132 | (if (pos? dot) (subs base 0 dot) base)) 133 | :else base)))) 134 | 135 | (defn file? 136 | "Return true if `path` is a file." 137 | [path] 138 | (predicate isFile (file path))) 139 | 140 | (defn ^Boolean hidden? 141 | "Return true if `path` is hidden." 142 | [path] 143 | (predicate isHidden (file path))) 144 | 145 | (when feature-flags/extend-coercions? 146 | (extend-protocol io/Coercions 147 | Path 148 | (as-file [this] (.toFile this)) 149 | (as-url [this] (.. this (toFile) (toURL))))) 150 | 151 | (defn- ^Path as-path 152 | "Convert `path` to a `java.nio.file.Path`. 153 | Requires Java version 7 or greater." 154 | [path] 155 | (.toPath (file path))) 156 | 157 | (defn ^Boolean link? 158 | "Return true if `path` is a link." 159 | [path] 160 | (Files/isSymbolicLink (as-path path))) 161 | 162 | (defn ^File link 163 | "Create a \"hard\" link from path to target. The arguments 164 | are in the opposite order from the link(2) system call." 165 | [new-file existing-file] 166 | (file (Files/createLink (as-path new-file) (as-path existing-file)))) 167 | 168 | (defn ^File sym-link 169 | "Create a \"soft\" link from `path` to `target`." 170 | [path target] 171 | (file (Files/createSymbolicLink 172 | (as-path path) 173 | (as-path target) 174 | (make-array FileAttribute 0)))) 175 | 176 | (defn ^File read-sym-link 177 | "Return the target of a 'soft' link." 178 | [path] 179 | (file (Files/readSymbolicLink (as-path path)))) 180 | 181 | ;; Rewrite directory? and delete-dir to include LinkOptions. 182 | (defn directory? 183 | "Return true if `path` is a directory, false otherwise. Optional 184 | [link-options](http://docs.oracle.com/javase/7/docs/api/java/nio/file/LinkOption.html) 185 | may be provided to determine whether or not to follow symbolic 186 | links." 187 | [path & link-options] 188 | (Files/isDirectory (as-path path) 189 | (into-array LinkOption link-options))) 190 | 191 | (defn delete-dir 192 | "Delete a directory tree. Optional 193 | [link-options](http://docs.oracle.com/javase/7/docs/api/java/nio/file/LinkOption.html) 194 | may be provided to determine whether or not to follow symbolic links." 195 | [root & link-options] 196 | (when (apply directory? root link-options) 197 | (doseq [path (.listFiles (file root))] 198 | (apply delete-dir path link-options))) 199 | (delete root)) 200 | 201 | (defn move 202 | "Move or rename a file to a target file. Optional 203 | [copy-options](http://docs.oracle.com/javase/7/docs/api/java/nio/file/CopyOption.html) 204 | may be provided." 205 | [source target & copy-options] 206 | (Files/move (as-path source) (as-path target) (into-array CopyOption copy-options))) 207 | 208 | (defn split-ext 209 | "Returns a vector of `[name extension]`." 210 | [path] 211 | (let [base (base-name path) 212 | i (.lastIndexOf base ".")] 213 | (if (pos? i) 214 | [(subs base 0 i) (subs base i)] 215 | [base nil]))) 216 | 217 | (defn extension 218 | "Return the extension part of a file." 219 | [path] (last (split-ext path))) 220 | 221 | (defn name 222 | "Return the name part of a file." 223 | [path] (first (split-ext path))) 224 | 225 | (defn parent 226 | "Return the parent path." 227 | [path] 228 | (.getParentFile (file path))) 229 | 230 | (defn mod-time 231 | "Return file modification time." 232 | [path] 233 | (.lastModified (file path))) 234 | 235 | (defn size 236 | "Return size (in bytes) of file." 237 | [path] 238 | (.length (file path))) 239 | 240 | (defn mkdir 241 | "Create a directory." 242 | [path] 243 | (.mkdir (file path))) 244 | 245 | (defn mkdirs 246 | "Make directory tree." 247 | [path] 248 | (.mkdirs (file path))) 249 | 250 | (def ^{:doc "The root of a unix system is `/`, `nil` on Windows"} 251 | unix-root (when (= File/separator "/") File/separator)) 252 | 253 | (defn split 254 | "Split `path` to components." 255 | [path] 256 | (let [pathstr (str path) 257 | jregx (str "\\Q" File/separator "\\E")] 258 | (cond (= pathstr unix-root) (list unix-root) 259 | (and unix-root (.startsWith pathstr unix-root)) 260 | ;; unix absolute path 261 | (cons unix-root (seq (.split (subs pathstr 1) jregx))) 262 | :else (seq (.split pathstr jregx))))) 263 | 264 | (defn rename 265 | "Rename `old-path` to `new-path`. Only works on files." 266 | [old-path new-path] 267 | (.renameTo (file old-path) (file new-path))) 268 | 269 | (defn create 270 | "Create a new file." 271 | [^File f] 272 | (.createNewFile f)) 273 | 274 | (defn- assert-exists [path] 275 | (when-not (exists? path) 276 | (throw (IllegalArgumentException. (str path " not found"))))) 277 | 278 | (defn copy 279 | "Copy a file from `from` to `to`. Return `to`." 280 | [from to] 281 | (assert-exists from) 282 | (io/copy (file from) (file to)) 283 | to) 284 | 285 | (defn tmpdir 286 | "The temporary file directory looked up via the `java.io.tmpdir` 287 | system property. Does not create a temporary directory." 288 | [] 289 | (System/getProperty "java.io.tmpdir")) 290 | 291 | (defn temp-name 292 | "Create a temporary file name like what is created for [[temp-file]] 293 | and [[temp-dir]]." 294 | ([prefix] (temp-name prefix "")) 295 | ([prefix suffix] 296 | (format "%s%s-%s%s" prefix (System/currentTimeMillis) 297 | (long (rand 0x100000000)) suffix))) 298 | 299 | (defn- temp-create 300 | "Create a temporary file or dir, trying n times before giving up." 301 | ^File [prefix suffix tries f] 302 | (let [tmp (file (tmpdir) (temp-name prefix suffix))] 303 | (when (pos? tries) 304 | (if (f tmp) 305 | tmp 306 | (recur prefix suffix (dec tries) f))))) 307 | 308 | (defn temp-file 309 | "Create a temporary file. Returns nil if file could not be created 310 | even after n tries (default 10)." 311 | ([prefix] (temp-file prefix "" 10)) 312 | ([prefix suffix] (temp-file prefix suffix 10)) 313 | ([prefix suffix tries] (temp-create prefix suffix tries create))) 314 | 315 | (defn temp-dir 316 | "Create a temporary directory. Returns nil if dir could not be created 317 | even after n tries (default 10)." 318 | ([prefix] (temp-dir prefix "" 10)) 319 | ([prefix suffix] (temp-dir prefix suffix 10)) 320 | ([prefix suffix tries] (temp-create prefix suffix tries mkdirs))) 321 | 322 | (defn ephemeral-file 323 | "Create an ephemeral file (will be deleted on JVM exit). 324 | Returns nil if file could not be created even after n tries 325 | (default 10)." 326 | ([prefix] (ephemeral-file prefix "" 10)) 327 | ([prefix suffix] (ephemeral-file prefix suffix 10)) 328 | ([prefix suffix tries] (when-let [created (temp-create prefix suffix tries create)] 329 | (doto created .deleteOnExit)))) 330 | 331 | (defn ephemeral-dir 332 | "Create an ephemeral directory (will be deleted on JVM exit). 333 | Returns nil if dir could not be created even after n tries 334 | (default 10)." 335 | ([prefix] (ephemeral-dir prefix "" 10)) 336 | ([prefix suffix] (ephemeral-dir prefix suffix 10)) 337 | ([prefix suffix tries] (when-let [created (temp-create prefix suffix tries mkdirs)] 338 | (doto created .deleteOnExit)))) 339 | 340 | ; Taken from https://github.com/jkk/clj-glob. (thanks Justin!) 341 | (defn- glob->regex 342 | "Takes a glob-format string and returns a regex." 343 | [s] 344 | (loop [stream s 345 | re "" 346 | curly-depth 0] 347 | (let [[c j] stream] 348 | (cond 349 | (nil? c) (re-pattern 350 | ; We add ^ and $ since we check only for file names 351 | (str "^" (if (= \. (first s)) "" "(?=[^\\.])") re "$")) 352 | (= c \\) (recur (nnext stream) (str re c c) curly-depth) 353 | (= c \/) (recur (next stream) (str re (if (= \. j) c "/(?=[^\\.])")) 354 | curly-depth) 355 | (= c \*) (recur (next stream) (str re "[^/]*") curly-depth) 356 | (= c \?) (recur (next stream) (str re "[^/]") curly-depth) 357 | (= c \{) (recur (next stream) (str re \() (inc curly-depth)) 358 | (= c \}) (recur (next stream) (str re \)) (dec curly-depth)) 359 | (and (= c \,) (< 0 curly-depth)) (recur (next stream) (str re \|) 360 | curly-depth) 361 | (#{\. \( \) \| \+ \^ \$ \@ \%} c) (recur (next stream) (str re \\ c) 362 | curly-depth) 363 | :else (recur (next stream) (str re c) curly-depth))))) 364 | 365 | (defn glob 366 | "Returns files matching glob pattern." 367 | ([pattern] 368 | (let [parts (split pattern) 369 | root (apply file (if (= (count parts) 1) ["."] (butlast parts)))] 370 | (glob root (last parts)))) 371 | ([^File root pattern] 372 | (let [regex (glob->regex pattern)] 373 | (seq (.listFiles 374 | root 375 | (reify FilenameFilter 376 | (accept [_ _ filename] 377 | (boolean (re-find regex filename))))))))) 378 | 379 | (defn- iterzip 380 | "Iterate over a zip, returns a sequence of the nodes with a nil suffix" 381 | [z] 382 | (when-not (zip/end? z) 383 | (cons (zip/node z) (lazy-seq (iterzip (zip/next z)))))) 384 | 385 | (defn- f-dir? [^File f] 386 | (when f (.isDirectory f))) 387 | 388 | (defn- f-children [^File f] 389 | (.listFiles f)) 390 | 391 | (defn- iterate-dir* [path] 392 | (let [root (file path) 393 | nodes (butlast (iterzip (zip/zipper f-dir? f-children nil root)))] 394 | (filter f-dir? nodes))) 395 | 396 | (defn- walk-map-fn [root] 397 | (let [kids (f-children root) 398 | dirs (set (map base-name (filter f-dir? kids))) 399 | files (set (map base-name (filter (complement f-dir?) kids)))] 400 | [root dirs files])) 401 | 402 | (defn iterate-dir 403 | "Return a sequence `[root dirs files]`, starting from `path` in depth-first order" 404 | [path] 405 | (map walk-map-fn (iterate-dir* path))) 406 | 407 | (defn walk 408 | "Lazily walk depth-first over the directory structure starting at 409 | `path` calling `func` with three arguments `[root dirs files]`. 410 | Returns a sequence of the results." 411 | [func path] 412 | (map #(apply func %) (iterate-dir path))) 413 | 414 | (defn touch 415 | "Set file modification time (default to now). Returns `path`." 416 | [path & [time]] 417 | (let [f (file path)] 418 | (when-not (create f) 419 | (.setLastModified f (or time (System/currentTimeMillis)))) 420 | f)) 421 | 422 | (defn- char-to-int 423 | [c] 424 | (- (int c) 48)) 425 | 426 | (defn- chmod-octal-digit 427 | [^File f i user?] 428 | (if (> i 7) 429 | (throw (IllegalArgumentException. "Bad mode")) 430 | (do (.setReadable f (pos? (bit-and i 4)) user?) 431 | (.setWritable f (pos? (bit-and i 2)) user?) 432 | (.setExecutable f (pos? (bit-and i 1)) user?)))) 433 | 434 | (defn- chmod-octal 435 | [mode path] 436 | (let [[user group world] (map char-to-int mode) 437 | f (file path)] 438 | (if (not= group world) 439 | (throw (IllegalArgumentException. 440 | "Bad mode. Group permissions must be equal to world permissions")) 441 | (do (chmod-octal-digit f world false) 442 | (chmod-octal-digit f user true) 443 | path)))) 444 | 445 | (defn chmod 446 | "Change file permissions. Returns path. 447 | 448 | `mode` can be a permissions string in octal or symbolic format. 449 | Symbolic: any combination of `r` (readable) `w` (writable) and 450 | `x` (executable). It should be prefixed with `+` to set or `-` to 451 | unset. And optional prefix of `u` causes the permissions to be set 452 | for the owner only. 453 | Octal: a string of three octal digits representing user, group, and 454 | world permissions. The three bits of each digit signify read, write, 455 | and execute permissions (in order of significance). Note that group 456 | and world permissions must be equal. 457 | 458 | Examples: 459 | 460 | ``` 461 | (chmod \"+x\" \"/tmp/foo\") ; Sets executable for everyone 462 | (chmod \"u-wx\" \"/tmp/foo\") ; Unsets owner write and executable 463 | ```" 464 | [mode path] 465 | (assert-exists path) 466 | (if (re-matches #"^\d{3}$" mode) 467 | (chmod-octal mode path) 468 | (let [[_ u op permissions] (re-find #"^(u?)([+-])([rwx]{1,3})$" mode)] 469 | (when (nil? op) (throw (IllegalArgumentException. "Bad mode"))) 470 | (let [perm-set (set permissions) 471 | f (file path) 472 | flag (= op "+") 473 | user (not (empty? u))] 474 | (when (perm-set \r) (.setReadable f flag user)) 475 | (when (perm-set \w) (.setWritable f flag user)) 476 | (when (perm-set \x) (.setExecutable f flag user))) 477 | path))) 478 | 479 | (defn copy+ 480 | "Copy `src` to `dest`, create directories if needed." 481 | [src dest] 482 | (mkdirs (parent dest)) 483 | (copy src dest)) 484 | 485 | (defn copy-dir 486 | "Copy a directory from `from` to `to`. If `to` already exists, copy the directory 487 | to a directory with the same name as `from` within the `to` directory." 488 | [from to] 489 | (when (exists? from) 490 | (if (file? to) 491 | (throw (IllegalArgumentException. (str to " is a file"))) 492 | (let [from (file from) 493 | to (if (exists? to) 494 | (file to (base-name from)) 495 | (file to)) 496 | trim-size (-> from str count inc) 497 | dest #(file to (subs (str %) trim-size))] 498 | (mkdirs to) 499 | (dorun 500 | (walk (fn [root dirs files] 501 | (doseq [dir dirs] 502 | (when-not (directory? dir) 503 | (-> root (file dir) dest mkdirs))) 504 | (doseq [f files] 505 | (copy+ (file root f) (dest (file root f))))) 506 | from)) 507 | to)))) 508 | 509 | (defn copy-dir-into 510 | "Copy directory into another directory if destination already exists." 511 | [from to] 512 | (if-not (exists? to) 513 | (copy-dir from to) 514 | (doseq [file (list-dir from)] 515 | (if (directory? file) 516 | (copy-dir file to) 517 | (copy file (io/file to (base-name file))))))) 518 | 519 | (defn parents 520 | "Get all the parent directories of a path." 521 | [f] 522 | (when-let [parent (parent (file f))] 523 | (cons parent (lazy-seq (parents parent))))) 524 | 525 | (defn child-of? 526 | "Takes two paths and checks to see if the first path is a parent 527 | of the second." 528 | [p c] (some #{(file p)} (parents c))) 529 | 530 | (defn ns-path 531 | "Takes a namespace symbol and creates a path to it. Replaces hyphens with 532 | underscores. Assumes the path should be relative to cwd." 533 | [n] 534 | (file 535 | (str (.. (str n) 536 | (replace \- \_) 537 | (replace \. \/)) 538 | ".clj"))) 539 | 540 | (defn path-ns 541 | "Takes a `path` to a Clojure file and constructs a namespace symbol 542 | out of the path." 543 | [path] 544 | (symbol 545 | (.. (.replaceAll (str path) "\\.clj" "") 546 | (replace \_ \-) 547 | (replace \/ \.)))) 548 | 549 | (defn find-files* 550 | "Find files in `path` by `pred`." 551 | [path pred] 552 | (filter pred (-> path file file-seq))) 553 | 554 | (defn find-files 555 | "Find files matching given `pattern`." 556 | [path pattern] 557 | (find-files* path #(re-matches pattern (.getName ^File %)))) 558 | 559 | (defn exec 560 | "Execute a shell command in the current directory" 561 | [& body] 562 | (sh/with-sh-dir *cwd* (apply sh/sh body))) 563 | 564 | (defmacro with-cwd 565 | "Execute `body` with a changed working directory." 566 | [cwd & body] 567 | `(binding [*cwd* (file ~cwd)] 568 | ~@body)) 569 | 570 | (defmacro with-mutable-cwd 571 | "Execute the `body` in a binding with `*cwd*` bound to `*cwd*`. 572 | This allows you to change `*cwd*` with `set!`." 573 | [& body] 574 | `(binding [*cwd* *cwd*] 575 | ~@body)) 576 | 577 | (defn chdir 578 | "set!s the value of `*cwd*` to `path`. Only works inside of 579 | [[with-mutable-cwd]]" 580 | [path] 581 | (set! *cwd* (file path))) 582 | -------------------------------------------------------------------------------- /src/me/raynes/fs/compression.clj: -------------------------------------------------------------------------------- 1 | (ns me.raynes.fs.compression 2 | "Compression utilities." 3 | (:require [clojure.java.io :as io] 4 | [me.raynes.fs :as fs]) 5 | (:import (java.util.zip ZipFile GZIPInputStream ZipOutputStream ZipEntry) 6 | (org.apache.commons.compress.archivers.tar 7 | TarArchiveInputStream 8 | TarArchiveEntry) 9 | (java.io ByteArrayOutputStream File PrintStream PipedInputStream PipedOutputStream) 10 | (org.apache.commons.compress.compressors.bzip2 BZip2CompressorInputStream) 11 | (org.apache.commons.compress.compressors.xz XZCompressorInputStream))) 12 | 13 | (defn- check-final-path-inside-target-dir! [^File f ^File target-dir entry] 14 | (when-not (-> f .getCanonicalPath (.startsWith (str (.getCanonicalPath target-dir) File/separator))) 15 | (throw (ex-info "Expanding entry would be created outside target dir" 16 | {:entry entry 17 | :entry-final-path f 18 | :target-dir target-dir})))) 19 | 20 | (defn unzip 21 | "Takes the path to a zipfile `source` and unzips it to target-dir." 22 | ([source] 23 | (unzip source (name source))) 24 | ([source target-dir] 25 | (with-open [zip (ZipFile. (fs/file source))] 26 | (let [entries (enumeration-seq (.entries zip)) 27 | target-dir-as-file (fs/file target-dir) 28 | target-file #(fs/file target-dir (str %))] 29 | (doseq [entry entries :when (not (.isDirectory ^ZipEntry entry)) 30 | :let [^File f (target-file entry)]] 31 | (check-final-path-inside-target-dir! f target-dir-as-file entry) 32 | (fs/mkdirs (fs/parent f)) 33 | (io/copy (.getInputStream zip entry) f)))) 34 | target-dir)) 35 | 36 | (defn- add-zip-entry 37 | "Add a zip entry. Works for strings and byte-arrays." 38 | [^ZipOutputStream zip-output-stream [^String name content & remain]] 39 | (.putNextEntry zip-output-stream (ZipEntry. name)) 40 | (if (string? content) ;string and byte-array must have different methods 41 | (doto (PrintStream. zip-output-stream true) 42 | (.print content)) 43 | (.write zip-output-stream ^bytes content)) 44 | (.closeEntry zip-output-stream) 45 | (when (seq (drop 1 remain)) 46 | (recur zip-output-stream remain))) 47 | 48 | (defn make-zip-stream 49 | "Create zip file(s) stream. You must provide a vector of the 50 | following form: 51 | 52 | ```[[filename1 content1][filename2 content2]...]```. 53 | 54 | You can provide either strings or byte-arrays as content. 55 | 56 | The piped streams are used to create content on the fly, which means 57 | this can be used to make compressed files without even writing them 58 | to disk." 59 | [& filename-content-pairs] 60 | (let [file 61 | (let [pipe-in (PipedInputStream.) 62 | pipe-out (PipedOutputStream. pipe-in)] 63 | (future 64 | (with-open [zip (ZipOutputStream. pipe-out)] 65 | (add-zip-entry zip (flatten filename-content-pairs)))) 66 | pipe-in)] 67 | (io/input-stream file))) 68 | 69 | (defn zip 70 | "Create zip file(s) on the fly. You must provide a vector of the 71 | following form: 72 | 73 | ```[[filename1 content1][filename2 content2]...]```. 74 | 75 | You can provide either strings or byte-arrays as content." 76 | [filename & filename-content-pairs] 77 | (io/copy (make-zip-stream filename-content-pairs) 78 | (fs/file filename))) 79 | 80 | (defn- slurp-bytes [fpath] 81 | (with-open [data (io/input-stream (fs/file fpath))] 82 | (with-open [out (ByteArrayOutputStream.)] 83 | (io/copy data out) 84 | (.toByteArray out)))) 85 | 86 | (defn make-zip-stream-from-files 87 | "Like make-zip-stream but takes a sequential of file paths and builds filename-content-pairs 88 | based on those" 89 | [fpaths] 90 | (let [filename-content-pairs (map (juxt fs/base-name slurp-bytes) fpaths)] 91 | (make-zip-stream filename-content-pairs))) 92 | 93 | (defn zip-files 94 | "Zip files provided in argument vector to a single zip. Converts the argument list: 95 | 96 | ```(fpath1 fpath2...)``` 97 | 98 | into filename-content -pairs, using the original file's basename as the filename in zip`and slurping the content: 99 | 100 | ```([fpath1-basename fpath1-content] [fpath2-basename fpath2-content]...)``" 101 | [filename fpaths] 102 | (io/copy (make-zip-stream-from-files fpaths) 103 | (fs/file filename))) 104 | 105 | (defn- tar-entries 106 | "Get a lazy-seq of entries in a tarfile." 107 | [^TarArchiveInputStream tin] 108 | (when-let [entry (.getNextTarEntry tin)] 109 | (cons entry (lazy-seq (tar-entries tin))))) 110 | 111 | (defn untar 112 | "Takes a tarfile `source` and untars it to `target`." 113 | ([source] (untar source (name source))) 114 | ([source target] 115 | (with-open [tin (TarArchiveInputStream. (io/input-stream (fs/file source)))] 116 | (let [target-dir-as-file (fs/file target)] 117 | (doseq [^TarArchiveEntry entry (tar-entries tin) :when (not (.isDirectory entry)) 118 | :let [output-file (fs/file target (.getName entry))]] 119 | (check-final-path-inside-target-dir! output-file target-dir-as-file entry) 120 | (fs/mkdirs (fs/parent output-file)) 121 | (io/copy tin output-file) 122 | (when (.isFile entry) 123 | (fs/chmod (apply str (take-last 124 | 3 (format "%05o" (.getMode entry)))) 125 | (.getPath output-file)))))))) 126 | 127 | (defn gunzip 128 | "Takes a path to a gzip file `source` and unzips it." 129 | ([source] (gunzip source (name source))) 130 | ([source target] 131 | (io/copy (-> source fs/file io/input-stream GZIPInputStream.) 132 | (fs/file target)))) 133 | 134 | (defn bunzip2 135 | "Takes a path to a bzip2 file `source` and uncompresses it." 136 | ([source] (bunzip2 source (name source))) 137 | ([source target] 138 | (io/copy (-> source fs/file io/input-stream BZip2CompressorInputStream.) 139 | (fs/file target)))) 140 | 141 | (defn unxz 142 | "Takes a path to a xz file `source` and uncompresses it." 143 | ([source] (unxz source (name source))) 144 | ([source target] 145 | (io/copy (-> source fs/file io/input-stream XZCompressorInputStream.) 146 | (fs/file target)))) 147 | -------------------------------------------------------------------------------- /src/me/raynes/fs/feature_flags.clj: -------------------------------------------------------------------------------- 1 | (ns me.raynes.fs.feature-flags 2 | "Compile-time feature flags. 3 | 4 | In order to use them: 5 | 6 | * `require` this ns before any other ns from this lib. 7 | * `alter-var-root` a given feature flag within this ns to a different, desired value 8 | * proceed to `require` the rest of this library.") 9 | 10 | (def extend-coercions? 11 | "Should the clojure.java.io/Coercions protocol be extended by this library?" 12 | true) 13 | -------------------------------------------------------------------------------- /test/me/raynes/core_test.clj: -------------------------------------------------------------------------------- 1 | (ns me.raynes.core-test 2 | (:refer-clojure :exclude [name parents]) 3 | (:require [me.raynes.fs :refer :all] 4 | [me.raynes.fs.compression :refer :all] 5 | [midje.sweet :refer :all] 6 | [clojure.java.io :as io] 7 | [clojure.string :as string]) 8 | (:import java.io.File)) 9 | 10 | (def system-tempdir (System/getProperty "java.io.tmpdir")) 11 | 12 | (def fs-supports-symlinks? (not (.startsWith (System/getProperty "os.name") "Windows"))) 13 | 14 | (defn create-walk-dir [] 15 | (let [root (temp-dir "fs-")] 16 | (mkdir (file root "a")) 17 | (mkdir (file root "b")) 18 | (spit (file root "1") "1") 19 | (spit (file root "a" "2") "1") 20 | (spit (file root "b" "3") "1") 21 | root)) 22 | 23 | (fact "Makes paths absolute." 24 | (file ".") => *cwd* 25 | (file "foo") => (io/file *cwd* "foo")) 26 | 27 | (fact "Expands path to current user." 28 | (let [user (System/getProperty "user.home")] 29 | (expand-home "~") => (file user) 30 | (expand-home (str "~" File/separator "foo")) => (file user "foo"))) 31 | 32 | (fact "Expands to given user." 33 | (let [user (System/getProperty "user.home") 34 | name (System/getProperty "user.name")] 35 | (expand-home (str "~" name)) => (file user) 36 | (expand-home (format "~%s/foo" name)) => (file user "foo"))) 37 | 38 | (fact "Expand a path w/o tilde just returns path" 39 | (let [user (System/getProperty "user.home")] 40 | (expand-home (str user File/separator "foo")) => (io/file user "foo"))) 41 | 42 | (fact (list-dir ".") => (has every? #(instance? File %))) 43 | 44 | ;; Want to change these files to be tempfiles at some point. 45 | (when unix-root (against-background 46 | [(around :contents (let [f (io/file "test/me/raynes/testfiles/bar")] 47 | (.setExecutable f false) 48 | (.setReadable f false) 49 | (.setWritable f false) 50 | ?form 51 | (.setExecutable f true) 52 | (.setReadable f true) 53 | (.setWritable f true)))] 54 | (fact 55 | (executable? "test/me/raynes/testfiles/foo") => true 56 | (executable? "test/me/raynes/testfiles/bar") => false) 57 | 58 | (fact 59 | (readable? "test/me/raynes/testfiles/foo") => true 60 | (readable? "test/me/raynes/testfiles/bar") => false) 61 | 62 | (fact 63 | (writeable? "test/me/raynes/testfiles/foo") => true 64 | (writeable? "test/me/raynes/testfiles/bar") => false))) 65 | 66 | (fact 67 | (file? "test/me/raynes/testfiles/foo") => true 68 | (file? ".") => false) 69 | 70 | (fact 71 | (exists? "test/me/raynes/testfiles/foo") => true 72 | (exists? "ewjgnr4ig43j") => false) 73 | 74 | (fact 75 | (let [f (io/file "test/me/raynes/testfiles/baz")] 76 | (.createNewFile f) 77 | (delete f) 78 | (exists? f) => false)) 79 | 80 | (fact 81 | (directory? ".") => true 82 | (directory? "test/me/raynes/testfiles/foo") => false) 83 | 84 | (fact 85 | (file? ".") => false 86 | (file? "test/me/raynes/testfiles/foo") => true) 87 | 88 | (fact 89 | (let [tmp (temp-file "fs-")] 90 | (exists? tmp) => true 91 | (file? tmp) => true 92 | (delete tmp))) 93 | 94 | (fact 95 | (let [tmp (temp-dir "fs-")] 96 | (exists? tmp) => true 97 | (directory? tmp) => true 98 | (delete tmp))) 99 | 100 | (fact 101 | (let [tmp (ephemeral-file "fs-")] 102 | (exists? tmp) => true 103 | (file? tmp) => true)) ;; is deleted on JVM exit 104 | 105 | (fact 106 | (let [tmp (ephemeral-dir "fs-")] 107 | (exists? tmp) => true 108 | (directory? tmp) => true)) ;; is deleted on JVM exit 109 | 110 | (fact 111 | (absolute "foo") => (io/file *cwd* "foo")) 112 | 113 | (fact 114 | (normalized ".") => *cwd*) 115 | 116 | (fact 117 | (base-name "foo/bar") => "bar" 118 | (base-name "foo/bar.txt" true) => "bar" 119 | (base-name "bar.txt" ".txt") => "bar" 120 | (base-name "foo/bar.txt" ".png") => "bar.txt") 121 | 122 | (fact 123 | (let [tmp (temp-file "fs-")] 124 | (> (mod-time tmp) 0) => true 125 | (delete tmp))) 126 | 127 | (fact 128 | (let [f (temp-file "fs-")] 129 | (spit f "abc") 130 | (size f) => 3 131 | (delete f))) 132 | 133 | (fact 134 | (let [root (create-walk-dir) 135 | result (delete-dir root)] 136 | (exists? root) => false)) 137 | 138 | (fact 139 | (let [f (temp-file "fs-")] 140 | (delete f) 141 | (mkdir f) 142 | (directory? f) => true 143 | (delete-dir f))) 144 | 145 | (fact 146 | (let [f (temp-file "fs-") 147 | sub (file f "a" "b")] 148 | (delete f) 149 | (mkdirs sub) 150 | (directory? sub) => true 151 | (delete-dir f))) 152 | 153 | (fact 154 | (split (file "test/fs")) => (has-suffix ["test" "fs"])) 155 | 156 | (when unix-root 157 | (fact 158 | (split (file "/tmp/foo/bar.txt")) => '("/" "tmp" "foo" "bar.txt") 159 | (split (file "/")) => '("/") 160 | (split "/") => '("/") 161 | (split "") => '(""))) 162 | 163 | (fact 164 | (let [f (temp-file "fs-") 165 | new-f (str f "-new")] 166 | (rename f new-f) 167 | (exists? f) => false 168 | (exists? new-f) => true 169 | (delete new-f))) 170 | 171 | (fact 172 | (let [root (create-walk-dir)] 173 | (walk vector root) => (contains [[root #{"b" "a"} #{"1"}] 174 | [(file root "a") #{} #{"2"}] 175 | [(file root "b") #{} #{"3"}]] 176 | :in-any-order) 177 | (delete-dir root))) 178 | 179 | (fact 180 | (let [from (temp-file "fs-") 181 | to (temp-file "fs-") 182 | data "What's up Doc?"] 183 | (delete to) 184 | (spit from data) 185 | (copy from to) 186 | (slurp from) => (slurp to) 187 | (delete from) 188 | (delete to))) 189 | 190 | (fact 191 | (let [f (temp-file "fs-") 192 | t (mod-time f)] 193 | (Thread/sleep 1000) 194 | (touch f) 195 | (> (mod-time f) t) => true 196 | (let [t2 3000] 197 | (touch f t2) 198 | (mod-time f) => t2) 199 | (delete f))) 200 | 201 | (fact 202 | (let [f (temp-file "fs-")] 203 | (chmod "+x" f) 204 | (executable? f) => true 205 | (when-not (re-find #"Windows" (System/getProperty "os.name")) 206 | (chmod "-x" f) 207 | (executable? f) => false) 208 | (delete f))) 209 | 210 | (fact 211 | (let [f (temp-file "fs-")] 212 | (chmod "777" f) 213 | (executable? f) => true 214 | (readable? f) => true 215 | (writeable? f) => true 216 | (chmod "000" f) 217 | (when-not (re-find #"Windows" (System/getProperty "os.name")) 218 | (chmod "-x" f) 219 | (executable? f) => false 220 | (readable? f) => false 221 | (writeable? f) => false) 222 | (delete f))) 223 | 224 | (fact 225 | (let [from (create-walk-dir) 226 | to (temp-dir "fs-") 227 | path (copy-dir from to) 228 | dest (file to (base-name from))] 229 | path => dest 230 | (walk vector to) => (contains [[to #{(base-name from)} #{}] 231 | [dest #{"b" "a"} #{"1"}] 232 | [(file dest "a") #{} #{"2"}] 233 | [(file dest "b") #{} #{"3"}]] 234 | :in-any-order) 235 | (delete-dir from) 236 | (delete-dir to))) 237 | 238 | (fact "copy-dir-into works as expected." 239 | (let [from (create-walk-dir) 240 | to (temp-dir "fs-")] 241 | (copy-dir-into from to) 242 | (walk vector to) => (contains [[(file to) #{"a" "b"} #{"1"}] 243 | [(file to "a") #{} #{"2"}] 244 | [(file to "b") #{} #{"3"}]] 245 | :in-any-order) 246 | (delete-dir from) 247 | (delete-dir to))) 248 | 249 | (when (System/getenv "HOME") 250 | (fact 251 | (let [env-home (io/file (System/getenv "HOME"))] 252 | (home) => env-home 253 | (home "") => env-home 254 | (home (System/getProperty "user.name")) => env-home))) 255 | 256 | (tabular 257 | (fact (split-ext ?file) => ?ext) 258 | 259 | ?file ?ext 260 | "fs.clj" ["fs" ".clj"] 261 | "fs." ["fs" "."] 262 | "fs.clj.bak" ["fs.clj" ".bak"] 263 | "/path/to/fs" ["fs" nil] 264 | "" [(base-name (System/getProperty "user.dir")) nil] 265 | "~user/.bashrc" [".bashrc" nil]) 266 | 267 | (tabular 268 | (fact (extension ?file) => ?ext) 269 | 270 | ?file ?ext 271 | "fs.clj" ".clj" 272 | "fs." "." 273 | "fs.clj.bak" ".bak" 274 | "/path/to/fs" nil 275 | "" nil 276 | ".bashrc" nil) 277 | 278 | (tabular 279 | (fact (name ?file) => ?ext) 280 | 281 | ?file ?ext 282 | "fs.clj" "fs" 283 | "fs." "fs" 284 | "fs.clj.bak" "fs.clj" 285 | "/path/to/fs" "fs" 286 | "" (base-name (System/getProperty "user.dir")) 287 | ".bashrc" ".bashrc") 288 | 289 | (fact "Can change cwd with with-cwd." 290 | (let [old *cwd*] 291 | (with-cwd "foo" 292 | *cwd* => (io/file old "foo")))) 293 | 294 | (fact "Can change cwd mutably with with-mutable-cwd" 295 | (let [old *cwd*] 296 | (with-mutable-cwd 297 | (chdir "foo") 298 | *cwd* => (io/file old "foo")))) 299 | 300 | (with-cwd "test/me/raynes/testfiles" 301 | (fact 302 | (unzip "ggg.zip" "zggg") 303 | (exists? "zggg/ggg") => true 304 | (exists? "zggg/hhh/jjj") => true 305 | (delete-dir "zggg")) 306 | 307 | (fact (zip "fro.zip" ["bbb.txt" "bbb"]) 308 | (exists? "fro.zip") => true 309 | (unzip "fro.zip" "fro") 310 | (exists? "fro/bbb.txt") => true 311 | (rename "fro.zip" "fro2.zip") => true 312 | (delete "fro2.zip") 313 | (delete-dir "fro")) 314 | 315 | (fact "about zip round trip" 316 | (zip "round.zip" ["some.txt" "some text"]) 317 | (unzip "round.zip" "round") 318 | (slurp (file "round/some.txt")) => "some text") 319 | 320 | (fact "zip-files" 321 | (zip-files "foobar.zip" ["foo" "bar"]) 322 | (exists? "foobar.zip") 323 | (unzip "foobar.zip" "foobar") 324 | (exists? "foobar/foo") => true 325 | (exists? "foobar/bar") => true 326 | (delete "foobar.zip") 327 | (delete-dir "foobar")) 328 | 329 | (fact 330 | (untar "ggg.tar" "zggg") 331 | (exists? "zggg/ggg") => true 332 | (exists? "zggg/hhh/jjj") => true 333 | (delete-dir "zggg")) 334 | 335 | (fact 336 | (gunzip "ggg.gz" "ggg") 337 | (exists? "ggg") => true 338 | (delete "ggg")) 339 | 340 | (fact 341 | (bunzip2 "bbb.bz2" "bbb") 342 | (exists? "bbb") => true 343 | (delete "bbb")) 344 | 345 | (fact 346 | (unxz "xxx.xz" "xxx") 347 | (exists? "xxx") => true 348 | (delete "xxx")) 349 | 350 | (fact "zip-slip vulnerability" 351 | (unzip "zip-slip.zip" "zip-slip") => (throws Exception "Expanding entry would be created outside target dir") 352 | (untar "zip-slip.tar" "zip-slip") => (throws Exception "Expanding entry would be created outside target dir") 353 | (exists? "/tmp/evil.txt") => false 354 | (delete-dir "zip-slip"))) 355 | 356 | (let [win-root (when-not unix-root "c:")] 357 | (fact 358 | (parents (str win-root "/foo/bar/baz")) => (just [(file (str win-root "/foo")) 359 | (file (str win-root "/foo/bar")) 360 | (file (str win-root "/"))] 361 | :in-any-order) 362 | (parents (str win-root "/")) => nil)) 363 | 364 | (fact 365 | (child-of? "/foo/bar" "/foo/bar/baz") => truthy 366 | (child-of? "/foo/bar/baz" "/foo/bar") => falsey) 367 | 368 | (fact 369 | (path-ns "foo/bar/baz_quux.clj") => 'foo.bar.baz-quux) 370 | 371 | (fact 372 | (str (ns-path 'foo.bar.baz-quux)) => (has-suffix (string/join File/separator ["foo" "bar" "baz_quux.clj"]))) 373 | 374 | (fact 375 | (let [win-root (when-not unix-root "c:")] 376 | (absolute? (str win-root "/foo/bar")) => true 377 | (absolute? (str win-root "/foo/")) => true 378 | (absolute? "foo/bar") => false 379 | (absolute? "foo/") => false)) 380 | 381 | (defmacro run-java-7-tests [] 382 | (when (try (import '[java.nio.file Files Path LinkOption StandardCopyOption FileAlreadyExistsException] 383 | '[java.nio.file.attribute FileAttribute]) 384 | (catch Exception _ nil)) 385 | '(do 386 | (def test-files-path "test/me/raynes/testfiles") 387 | 388 | (fact 389 | (let [files (find-files test-files-path #"ggg\.*") 390 | gggs (map #(file (str test-files-path "/ggg." %)) '(gz tar zip))] 391 | (every? (set gggs) files) => true)) 392 | 393 | (fact 394 | (let [fs1 (find-files test-files-path #"ggg\.*") 395 | fs2 (find-files* test-files-path #(re-matches #"ggg\.*" (.getName %)))] 396 | (= fs1 fs2) => true)) 397 | 398 | (fact 399 | (let [f (touch (io/file test-files-path ".hidden"))] 400 | (hidden? f) 401 | (delete f))) 402 | 403 | (fact 404 | (let [target (io/file test-files-path "ggg.tar") 405 | hard (link (io/file test-files-path "hard.link") target)] 406 | (file? hard) => true 407 | (delete hard))) 408 | 409 | (when fs-supports-symlinks? 410 | (fact 411 | (let [target (io/file test-files-path "ggg.tar") 412 | soft (sym-link (io/file test-files-path "soft.link") target)] 413 | (file? soft) => true 414 | (link? soft) => true 415 | (= (read-sym-link soft) target) 416 | (delete soft))) 417 | 418 | (fact 419 | (let [soft (sym-link (io/file test-files-path "soft.link") test-files-path)] 420 | (link? soft) => true 421 | (file? soft) => false 422 | (directory? soft) => true 423 | (directory? soft LinkOption/NOFOLLOW_LINKS) => false 424 | (delete soft))) 425 | 426 | (fact 427 | (let [root (create-walk-dir) 428 | soft-a (sym-link (io/file root "soft-a.link") (io/file root "a")) 429 | soft-b (sym-link (io/file root "soft-b.link") (io/file root "b"))] 430 | (delete-dir soft-a LinkOption/NOFOLLOW_LINKS) 431 | (exists? (io/file root "a" "2")) => true 432 | (delete-dir soft-b) 433 | (exists? (io/file root "b" "3")) => false 434 | (delete-dir root) 435 | (exists? root) => false))) 436 | 437 | (fact "`move` moves files" 438 | (let [source (io/file test-files-path "foo") 439 | target (io/file test-files-path "foo.moved") 440 | existing-target (io/file test-files-path "bar")] 441 | (move source target) 442 | (exists? target) => true 443 | (exists? source) => false 444 | (move target source) 445 | (exists? target) => false 446 | (exists? source) => true 447 | (move source existing-target) => (throws FileAlreadyExistsException) 448 | (copy source target) 449 | (move source target StandardCopyOption/REPLACE_EXISTING) 450 | (exists? target) => true 451 | (exists? source) => false 452 | (move target source)))))) 453 | 454 | (run-java-7-tests) 455 | -------------------------------------------------------------------------------- /test/me/raynes/testfiles/bar: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clj-commons/fs/742c19d616401ab4ef61bb8f225c71744c4a506a/test/me/raynes/testfiles/bar -------------------------------------------------------------------------------- /test/me/raynes/testfiles/bbb.bz2: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clj-commons/fs/742c19d616401ab4ef61bb8f225c71744c4a506a/test/me/raynes/testfiles/bbb.bz2 -------------------------------------------------------------------------------- /test/me/raynes/testfiles/foo: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clj-commons/fs/742c19d616401ab4ef61bb8f225c71744c4a506a/test/me/raynes/testfiles/foo -------------------------------------------------------------------------------- /test/me/raynes/testfiles/ggg.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clj-commons/fs/742c19d616401ab4ef61bb8f225c71744c4a506a/test/me/raynes/testfiles/ggg.gz -------------------------------------------------------------------------------- /test/me/raynes/testfiles/ggg.tar: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clj-commons/fs/742c19d616401ab4ef61bb8f225c71744c4a506a/test/me/raynes/testfiles/ggg.tar -------------------------------------------------------------------------------- /test/me/raynes/testfiles/ggg.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clj-commons/fs/742c19d616401ab4ef61bb8f225c71744c4a506a/test/me/raynes/testfiles/ggg.zip -------------------------------------------------------------------------------- /test/me/raynes/testfiles/xxx.xz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clj-commons/fs/742c19d616401ab4ef61bb8f225c71744c4a506a/test/me/raynes/testfiles/xxx.xz -------------------------------------------------------------------------------- /test/me/raynes/testfiles/zip-slip.tar: -------------------------------------------------------------------------------- 1 | good.txt000644 000766 000024 00000000023 13264721075 013337 0ustar00granderstaff000000 000000 this is a good one 2 | ././@LongLink0000000000000000000000000000020500000000000011212 Lustar 00000000000000../../../../../../../../../../../../../../../../../../../../../../../../../../../../../../../../../../../../../../../../tmp/evil.txt../../../../../../../../../../../../../../../../../../../../../../../../../../../../../../../../../.0000644000076600000240000000002413304770721022657 0ustar granderstaff00000000000000this is an evil one 3 | -------------------------------------------------------------------------------- /test/me/raynes/testfiles/zip-slip.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clj-commons/fs/742c19d616401ab4ef61bb8f225c71744c4a506a/test/me/raynes/testfiles/zip-slip.zip -------------------------------------------------------------------------------- /version.edn: -------------------------------------------------------------------------------- 1 | "1.6" 2 | --------------------------------------------------------------------------------