pax_global_header00006660000000000000000000000064130735252110014511gustar00rootroot0000000000000052 comment=17309a1dad8c9a352546ef1e270917c39306bbe2 clj-kitchensink-2.3.0/000077500000000000000000000000001307352521100145735ustar00rootroot00000000000000clj-kitchensink-2.3.0/.gitignore000066400000000000000000000001041307352521100165560ustar00rootroot00000000000000pom.xml *jar /lib/ /classes/ /target/ .lein-deps-sum .lein-failures clj-kitchensink-2.3.0/.travis.yml000066400000000000000000000010141307352521100167000ustar00rootroot00000000000000language: clojure lein: 2.7.1 jdk: - oraclejdk7 - openjdk7 - openjdk6 script: ./ext/travisci/test.sh notifications: email: false hipchat: rooms: secure: ASvt1XwEYbgkKuYZjZHytwg/6Y53Tg4T7QhohiDB4Xb1dmJueqPFpV2ko/VjHCa18JjLiUq0nWcDpRjsqaGGvJ5FSxTyyWDKtZsg1sUf4F+7aZ5vq0Dzg8Uzvdu7m9X1Uszvs9zf6wJ+Jobq4xck1xpPYxFT/+ei2Q2STrJ9xwQ= template: - "%{repository}#%{build_number} (%{branch} - %{commit} : %{author}): %{message}" - "Change view: %{compare_url}" - "Build details: %{build_url}" clj-kitchensink-2.3.0/CHANGELOG.md000066400000000000000000000103661307352521100164120ustar00rootroot00000000000000## 2.3.0 This is a minor feature release. Features: * add a parser for period strings (7d, 12h, etc) into Joda Periods * fix file connection leaks in the functions 'lines' and 'ini-to-map' ## 2.2.0 This is a minor feature release. Features: * Add an `assoc-if-new` macro, which associates a map key to a value only if the key does not already exist in the map. * Add a `deref-swap!` function, which behaves like deref but returns the old value instead of the new one. * Add a `rand-str` function, for generating random strings from various character sets. Maintenance: * Update to dynapath 0.2.5, to address some compatability issues with Java 9. ## 2.1.1 The 2.1.1 release was burned and folded into 2.2.0. ## 2.1.0 This is a minor feature release. Features: * Add an `open-port-num` function, which returns a currently open port. Tests that bind services to ports can use this to guard against chance port collisions. ## 2.0.0 This is a bugfix release which contains one backward incompatible change. Bug fix: * Changes all of the maps in various slingshot errors thrown to use `:kind` and `:msg` in place of `:type` and `:message`, respectively. ## 1.4.0 This is a minor feature release, which also includes some bugfixes and maintenance work. Features: * Add `uuid?` predicate function for determining whether a string is a valid UUID. Bug fixes: * Fix an issue in `with-additional-classpath-entries` wherein it's pre/post-conditions were not handling arguments properly. Maintenance: * Reduce use of reflection * Remove unused plugins and jenkins scripts * Switch to `lein-parent` for managing dependency versions ## 1.3.1 This is a maintenance release. * Remove retired :flag option from cli tooling, to eliminate warnings on CLI invocations. * Bump to org.clojure/tools.cli 0.3.3. ## 1.3.0 This is a maintenance / minor feature release. * [TK-315](https://tickets.puppetlabs.com/browse/TK-315) - update to latest version of `raynes.fs` to reduce downstream dependency conflicts. * Add an `absolute-path` fn to replace the one that was removed from raynes.fs * Add a `normalized-path` fn to replace the one that was removed from raynes.fs ## 1.2.0 * Add `temp-file-name` function, which returns a unique name to a temporary file, but does not actually create the file. * Add `with-timeout` macro, which returns a default value if executing an arbitrary block of code takes longer than a specified timeout. ## 1.1.0 * Add new `walk-leaves` function for applying a function to all of the leaf nodes of a map * Add new `zipper?` predicate which can be used to assert that an object is a clojure zipper. * Add new `while-let` macro * Add new `rand-weighted-selection` function * Add new `to-sentence` variant of string join ## 1.0.0 * Promoting previous release to 1.0.0 so that we can be more deliberate about adhering to semver from now on. ## 0.7.3 * Add 'filter-map' function that can be used to filter maps ## 0.7.2 * Change `mkdirs!` to allow string as path arg (7097bb3) * Add a new `dissoc-in` function, for removing data from nested maps. ## 0.7.1 * Add a new `to-bool` function, which provides a more tolerant way to coerce data to booleans ## 0.7.0 * Upgrade fs dependency to 1.4.5 (to standardize across projects) * Add mkdirs! function to create parent directories with better failure reporting * Move temp file functions from testutils to core ## 0.6.0 * Remove SSL utility code, which is now available in [puppetlabs/certificate-authority](https://github.com/puppetlabs/jvm-certificate-authority). ## 0.5.4 * Upgrade cheshire dependency to version 5.3.1. ## 0.5.3 * .ini parsing utilities now throw an Exception if a key appears in the file(s) more than once. * Added a `with-no-jvm-shutdown-hooks` macro for running a block of code without any JVM shutdown hooks. ## 0.5.2 * Minor change to the cli! function so that, in addition to the data that it already returned, it now also returns a string representation of a banner/usage summary. Callers can use this to display a help message if additional validation of the cli args fails. * Utility functions added to ssl namespace that allow creation of an SSLContext or a KeyStore/TrustStore directly from the pem files. * Added some JSON utility functions * Added a deep-merge utility function clj-kitchensink-2.3.0/CONTRIBUTING.md000066400000000000000000000026231307352521100170270ustar00rootroot00000000000000# Puppet Labs: Clojure 'kitchensink' Library This library contains general-purpose utility code that can be used across all other apps and projects. When considering submitting or reviewing contributions to this library, please try to make sure that the additions are truly general purpose and likely to be reasonable candidates for re-use in just about any other project. Things that are domain-specific for any subset of other Puppet Labs projects should probably not be included in this library. Another consideration: the `core` namespace is prety large an unwieldy in its current form, and should probably be broken into smaller, more specific namespaces. If you are contributing new code and see a reasonable way to break it off into a different namespace (perhaps moving some of the existing code from core along to the new namespace with it), please consider doing so. # General PL Contribution Guidelines Third-party patches are essential for keeping puppet open-source projects great. We want to keep it as easy as possible to contribute changes that allow you to get the most out of our projects. There are a few guidelines that we need contributors to follow so that we can have a chance of keeping on top of things. For more info, see our canonical guide to contributing: [https://github.com/puppetlabs/puppet/blob/master/CONTRIBUTING.md](https://github.com/puppetlabs/puppet/blob/master/CONTRIBUTING.md) clj-kitchensink-2.3.0/LICENSE000066400000000000000000000260751307352521100156120ustar00rootroot00000000000000Apache License Version 2.0, January 2004 http://www.apache.org/licenses/ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 1. Definitions. "License" shall mean the terms and conditions for use, reproduction, and distribution as defined by Sections 1 through 9 of this document. "Licensor" shall mean the copyright owner or entity authorized by the copyright owner that is granting the License. "Legal Entity" shall mean the union of the acting entity and all other entities that control, are controlled by, or are under common control with that entity. For the purposes of this definition, "control" means (i) the power, direct or indirect, to cause the direction or management of such entity, whether by contract or otherwise, or (ii) ownership of fifty percent (50%) or more of the outstanding shares, or (iii) beneficial ownership of such entity. "You" (or "Your") shall mean an individual or Legal Entity exercising permissions granted by this License. "Source" form shall mean the preferred form for making modifications, including but not limited to software source code, documentation source, and configuration files. "Object" form shall mean any form resulting from mechanical transformation or translation of a Source form, including but not limited to compiled object code, generated documentation, and conversions to other media types. "Work" shall mean the work of authorship, whether in Source or Object form, made available under the License, as indicated by a copyright notice that is included in or attached to the work (an example is provided in the Appendix below). "Derivative Works" shall mean any work, whether in Source or Object form, that is based on (or derived from) the Work and for which the editorial revisions, annotations, elaborations, or other modifications represent, as a whole, an original work of authorship. For the purposes of this License, Derivative Works shall not include works that remain separable from, or merely link (or bind by name) to the interfaces of, the Work and Derivative Works thereof. "Contribution" shall mean any work of authorship, including the original version of the Work and any modifications or additions to that Work or Derivative Works thereof, that is intentionally submitted to Licensor for inclusion in the Work by the copyright owner or by an individual or Legal Entity authorized to submit on behalf of the copyright owner. For the purposes of this definition, "submitted" means any form of electronic, verbal, or written communication sent to the Licensor or its representatives, including but not limited to communication on electronic mailing lists, source code control systems, and issue tracking systems that are managed by, or on behalf of, the Licensor for the purpose of discussing and improving the Work, but excluding communication that is conspicuously marked or otherwise designated in writing by the copyright owner as "Not a Contribution." "Contributor" shall mean Licensor and any individual or Legal Entity on behalf of whom a Contribution has been received by Licensor and subsequently incorporated within the Work. 2. Grant of Copyright License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable copyright license to reproduce, prepare Derivative Works of, publicly display, publicly perform, sublicense, and distribute the Work and such Derivative Works in Source or Object form. 3. Grant of Patent License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable (except as stated in this section) patent license to make, have made, use, offer to sell, sell, import, and otherwise transfer the Work, where such license applies only to those patent claims licensable by such Contributor that are necessarily infringed by their Contribution(s) alone or by combination of their Contribution(s) with the Work to which such Contribution(s) was submitted. If You institute patent litigation against any entity (including a cross-claim or counterclaim in a lawsuit) alleging that the Work or a Contribution incorporated within the Work constitutes direct or contributory patent infringement, then any patent licenses granted to You under this License for that Work shall terminate as of the date such litigation is filed. 4. Redistribution. You may reproduce and distribute copies of the Work or Derivative Works thereof in any medium, with or without modifications, and in Source or Object form, provided that You meet the following conditions: (a) You must give any other recipients of the Work or Derivative Works a copy of this License; and (b) You must cause any modified files to carry prominent notices stating that You changed the files; and (c) You must retain, in the Source form of any Derivative Works that You distribute, all copyright, patent, trademark, and attribution notices from the Source form of the Work, excluding those notices that do not pertain to any part of the Derivative Works; and (d) If the Work includes a "NOTICE" text file as part of its distribution, then any Derivative Works that You distribute must include a readable copy of the attribution notices contained within such NOTICE file, excluding those notices that do not pertain to any part of the Derivative Works, in at least one of the following places: within a NOTICE text file distributed as part of the Derivative Works; within the Source form or documentation, if provided along with the Derivative Works; or, within a display generated by the Derivative Works, if and wherever such third-party notices normally appear. The contents of the NOTICE file are for informational purposes only and do not modify the License. You may add Your own attribution notices within Derivative Works that You distribute, alongside or as an addendum to the NOTICE text from the Work, provided that such additional attribution notices cannot be construed as modifying the License. You may add Your own copyright statement to Your modifications and may provide additional or different license terms and conditions for use, reproduction, or distribution of Your modifications, or for any such Derivative Works as a whole, provided Your use, reproduction, and distribution of the Work otherwise complies with the conditions stated in this License. 5. Submission of Contributions. Unless You explicitly state otherwise, any Contribution intentionally submitted for inclusion in the Work by You to the Licensor shall be under the terms and conditions of this License, without any additional terms or conditions. Notwithstanding the above, nothing herein shall supersede or modify the terms of any separate license agreement you may have executed with Licensor regarding such Contributions. 6. Trademarks. This License does not grant permission to use the trade names, trademarks, service marks, or product names of the Licensor, except as required for reasonable and customary use in describing the origin of the Work and reproducing the content of the NOTICE file. 7. Disclaimer of Warranty. Unless required by applicable law or agreed to in writing, Licensor provides the Work (and each Contributor provides its Contributions) on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied, including, without limitation, any warranties or conditions of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A PARTICULAR PURPOSE. You are solely responsible for determining the appropriateness of using or redistributing the Work and assume any risks associated with Your exercise of permissions under this License. 8. Limitation of Liability. In no event and under no legal theory, whether in tort (including negligence), contract, or otherwise, unless required by applicable law (such as deliberate and grossly negligent acts) or agreed to in writing, shall any Contributor be liable to You for damages, including any direct, indirect, special, incidental, or consequential damages of any character arising as a result of this License or out of the use or inability to use the Work (including but not limited to damages for loss of goodwill, work stoppage, computer failure or malfunction, or any and all other commercial damages or losses), even if such Contributor has been advised of the possibility of such damages. 9. Accepting Warranty or Additional Liability. While redistributing the Work or Derivative Works thereof, You may choose to offer, and charge a fee for, acceptance of support, warranty, indemnity, or other liability obligations and/or rights consistent with this License. However, in accepting such obligations, You may act only on Your own behalf and on Your sole responsibility, not on behalf of any other Contributor, and only if You agree to indemnify, defend, and hold each Contributor harmless for any liability incurred by, or claims asserted against, such Contributor by reason of your accepting any such warranty or additional liability. END OF TERMS AND CONDITIONS APPENDIX: How to apply the Apache License to your work. To apply the Apache License to your work, attach the following boilerplate notice, with the fields enclosed by brackets "{}" replaced with your own identifying information. (Don't include the brackets!) The text should be enclosed in the appropriate comment syntax for the file format. We also recommend that a file or class name and description of purpose be included on the same "printed page" as the copyright notice for easier identification within third-party archives. Copyright {yyyy} {name of copyright owner} Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0 Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. clj-kitchensink-2.3.0/MAINTAINERS000066400000000000000000000011741307352521100162730ustar00rootroot00000000000000{ "version": 1, "file_format": "This MAINTAINERS file format is described at http://pup.pt/maintainers", "issues": "https://tickets.puppetlabs.com/browse/TK", "internal_list": "https://groups.google.com/a/puppet.com/forum/?hl=en#!forum/discuss-trapperkeeper-maintainers", "people": [ { "github": "senior", "email": "ryan.senior@puppet.com", "name": "Ryan Senior" }, { "github": "pcarlisle", "email": "pcarlisle@puppet.com", "name": "Patrick Carlisle" }, { "github": "camlow325", "email": "jeremy.barlow@puppet.com", "name": "Jeremy Barlow" } ] } clj-kitchensink-2.3.0/README.md000066400000000000000000000016671307352521100160640ustar00rootroot00000000000000# puppetlabs/kitchensink A library of utility functions that are common to several Puppet Labs clojure projects. ## Installation Add the following dependency to your `project.clj` file: [![Clojars Project](http://clojars.org/puppetlabs/kitchensink/latest-version.svg)](http://clojars.org/puppetlabs/kitchensink) ## Using Our Test Utils Kitchensink provides [utility code](./test/puppetlabs/kitchensink/) for use in tests. The code is available in a separate "test" jar that you may depend on by using a classifier in your project dependencies. ```clojure (defproject yourproject "1.0.0" ... :profiles {:test {:dependencies [[puppetlabs/kitchensink "x.y.z" :classifier "test"]]}}) ``` ## License Copyright © 2013 Puppet Labs Distributed under the [Apache License, version 2](http://www.apache.org/licenses/). ## Support Please log tickets and issues at our [Trapperkeeper JIRA tracker](https://tickets.puppetlabs.com/browse/TK). clj-kitchensink-2.3.0/doc/000077500000000000000000000000001307352521100153405ustar00rootroot00000000000000clj-kitchensink-2.3.0/doc/intro.md000066400000000000000000000001771307352521100170220ustar00rootroot00000000000000# Introduction to clj-utils TODO: write [great documentation](http://jacobian.org/writing/great-documentation/what-to-write/) clj-kitchensink-2.3.0/ext/000077500000000000000000000000001307352521100153735ustar00rootroot00000000000000clj-kitchensink-2.3.0/ext/travisci/000077500000000000000000000000001307352521100172175ustar00rootroot00000000000000clj-kitchensink-2.3.0/ext/travisci/test.sh000077500000000000000000000000301307352521100205260ustar00rootroot00000000000000#!/bin/bash lein2 test clj-kitchensink-2.3.0/project.clj000066400000000000000000000035321307352521100167360ustar00rootroot00000000000000(defproject puppetlabs/kitchensink "2.3.0" :description "Clojure utility functions" :license {:name "Apache License, Version 2.0" :url "http://www.apache.org/licenses/LICENSE-2.0.html"} :min-lein-version "2.7.1" :parent-project {:coords [puppetlabs/clj-parent "0.1.3"] :inherit [:managed-dependencies]} ;; Abort when version ranges or version conflicts are detected in ;; dependencies. Also supports :warn to simply emit warnings. ;; requires lein 2.2.0+. :pedantic? :abort :dependencies [[org.clojure/clojure] [org.clojure/tools.logging] [org.clojure/tools.cli] [clj-time] [me.raynes/fs] [slingshot] [cheshire] [org.ini4j/ini4j "0.5.2"] [org.tcrawley/dynapath "0.2.5"] [digest "1.4.3"] ] ;; By declaring a classifier here and a corresponding profile below we'll get an additional jar ;; during `lein jar` that has all the code in the test/ directory. Downstream projects can then ;; depend on this test jar using a :classifier in their :dependencies to reuse the test utility ;; code that we have. :classifiers [["test" :testutils]] :profiles {:testutils {:source-paths ^:replace ["test"]}} ;; this plugin is used by jenkins jobs to interrogate the project version :plugins [[lein-project-version "0.1.0"] [lein-parent "0.3.1"]] :deploy-repositories [["releases" {:url "https://clojars.org/repo" :username :env/clojars_jenkins_username :password :env/clojars_jenkins_password :sign-releases false}] ["snapshots" "http://nexus.delivery.puppetlabs.net/content/repositories/snapshots/"]]) clj-kitchensink-2.3.0/src/000077500000000000000000000000001307352521100153625ustar00rootroot00000000000000clj-kitchensink-2.3.0/src/puppetlabs/000077500000000000000000000000001307352521100175415ustar00rootroot00000000000000clj-kitchensink-2.3.0/src/puppetlabs/kitchensink/000077500000000000000000000000001307352521100220535ustar00rootroot00000000000000clj-kitchensink-2.3.0/src/puppetlabs/kitchensink/classpath.clj000066400000000000000000000107061307352521100245330ustar00rootroot00000000000000(ns puppetlabs.kitchensink.classpath (:import (java.net URLClassLoader URL)) (:require [clojure.java.io :refer [file Coercions]] [dynapath.util :as dp]) (:refer-clojure :exclude (add-classpath))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; Here, we have copied `add-classpath` out of pomegranate ;;;; (https://github.com/cemerick/pomegranate). ;;;; ;;;; We did this because we needed a corollary to the (deprecated) ;;;; `add-classpath` function in clojure.core, ;;;; but we did not want to pull pomegranate's rather large dependency tree ;;;; (we tried excluding as many of its dependencies as possible, but only ;;;; a small part of its dependency tree was exclude-able). ;;;; ;;;; There are no tests for these functions because pomegranate does not ;;;; contain any tests for them. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn- classloader-hierarchy "Returns a seq of classloaders, with the tip of the hierarchy first. Uses the current thread context ClassLoader as the tip ClassLoader if one is not provided." ([] (classloader-hierarchy (.. Thread currentThread getContextClassLoader))) ([tip] (->> tip (iterate #(.getParent %)) (take-while boolean)))) (defn- modifiable-classloader? "Returns true iff the given ClassLoader is of a type that satisfies the dynapath.dynamic-classpath/DynamicClasspath protocol, and it can be modified." [cl] (dp/addable-classpath? cl)) (defn add-classpath "A corollary to the (deprecated) `add-classpath` in clojure.core. This implementation requires a java.io.File or String path to a jar file or directory, and will attempt to add that path to the right classloader (with the search rooted at the current thread's context classloader). Because this function is a replacement for `add-classpath` in clojure.core, if you simply `:require` this namespace and then `:refer` to this function, you will get the following warning: WARNING: add-classpath already refers to: #'clojure.core/add-classpath in namespace: [...], being replaced by: #'puppetlabs.kitchensink.classpath/add-classpath You can avoid this by referencing this function through its namespace. This function is copied out of the 'pomegranate' library (https://github.com/cemerick/pomegranate)." ([jar-or-dir classloader] (if-not (dp/add-classpath-url classloader (.toURL (file jar-or-dir))) (throw (IllegalStateException. (str classloader " is not a modifiable classloader"))))) ([jar-or-dir] (let [classloaders (classloader-hierarchy)] (if-let [cl (last (filter modifiable-classloader? classloaders))] (add-classpath jar-or-dir cl) (throw (IllegalStateException. (str "Could not find a suitable classloader to modify from " classloaders))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; end of functions copied from pomegranate (see note above) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn jar-or-dir-to-url "Given the path to a jar file or a directory, return a `java.net.URL` object suitable for using with a `URLClassLoader`" [jar-or-dir] {:pre [(satisfies? Coercions jar-or-dir)] :post [(instance? URL %)]} ;; explicitly calling `getAbsoluteFile` causes relative file paths to ;; be evaluated relative to the system property `user.dir` (which is ;; usually set to the current working directory). This is useful for ;; tests and other code that wants to emulated changing the working ;; directory. (.. (file jar-or-dir) getAbsoluteFile toURL)) (defmacro with-additional-classpath-entries "This macro takes a list of paths as an argument. It then temporarily overrides the classpath to include the specified paths; the original classpath is restored prior to returning." [jars-and-dirs & body] `{:pre [(coll? ~jars-and-dirs) (every? (partial satisfies? Coercions) ~jars-and-dirs)]} `(let [orig-loader# (.. Thread currentThread getContextClassLoader) temp-loader# (URLClassLoader. (into-array URL (map jar-or-dir-to-url ~jars-and-dirs)) orig-loader#)] (try (.. Thread currentThread (setContextClassLoader temp-loader#)) ~@body (finally (.. Thread currentThread (setContextClassLoader orig-loader#)))))) clj-kitchensink-2.3.0/src/puppetlabs/kitchensink/core.clj000066400000000000000000001065141307352521100235040ustar00rootroot00000000000000;; ## "The Kitchen Sink" ;; ;; Pretty much everything in here should _probably_ be organized into ;; proper namespaces, or perhaps even separate libraries ;; altogether. But who has time for that? (ns puppetlabs.kitchensink.core (:import [org.ini4j Ini Config BasicProfileSection] [javax.naming.ldap LdapName] [java.io StringWriter Reader File]) (:require [clojure.tools.logging :as log] [clojure.string :as string] [clojure.tools.cli :as cli] [clojure.java.io :as io] [digest] [slingshot.slingshot :refer [throw+]] [me.raynes.fs :as fs]) (:use [clojure.java.io :only (reader)] [clojure.set :only (difference union)] [clojure.string :only (split)] [clojure.stacktrace :only (print-cause-trace)] [clojure.pprint :only [pprint]] [clj-time.core :only [now seconds minutes hours days years]] [clj-time.coerce :only [ICoerce to-date-time]] [clj-time.format :only [formatters unparse]])) (defn error-map [kind message] {:kind kind :msg message}) ;; ## Type checking (defn array? "Returns true if `x` is an array" [x] (some-> x (class) (.isArray))) (defn datetime? "Predicate returning whether or not the supplied object is convertible to a Joda DateTime" [x] (and (satisfies? ICoerce x) (to-date-time x))) (defn boolean? "Returns true if the value is a boolean" [value] (instance? Boolean value)) (defn regexp? "Returns true if the type is a regexp pattern" [regexp] {:post [(boolean? %)]} (instance? java.util.regex.Pattern regexp)) (defn zipper? "Checks to see if the object has zip/make-node metadata on it (confirming it to be a zipper." [obj] (contains? (meta obj) :zip/make-node)) ;; ## String utilities (defn strict-parse-bool "Parse a string and return its boolean value; throws an exception if the String does not match `\"true\"` or `\"false\"` (case-insensitive)." [^String s] {:pre [(string? s)] :post [(boolean? %)]} (condp = (.toLowerCase s) "true" true "false" false (throw+ (error-map ::parse-error (format "Unable to parse '%s' to a boolean" s))))) (defn parse-bool "Parse a string and return its boolean value." [s] {:pre [(or (nil? s) (string? s))] :post [(boolean? %)]} (Boolean/parseBoolean s)) (defn to-bool "Converts the argument to a boolean. The behavior is as follows: * If the argument is a Boolean, it is simply returned. * If the argument is a String, returns the Boolean `true` if the String matches `\"true\"` (case insensitive), or `false` if the String matches `\"false\"` (case insensitive). Throws an exception otherwise. * If the argument is `nil`, returns false." [val] {:pre [((some-fn boolean? string? nil?) val)] :post [(boolean? %)]} (cond (boolean? val) val (string? val) (strict-parse-bool val) (nil? val) false)) (defn string-contains? "Returns true if `s` has the `substring` in it" [^String substring ^String s] {:pre [(string? s) (string? substring)]} (>= (.indexOf s substring) 0)) (defn true-str? "Return true if the string contains true" [^String s] (.equalsIgnoreCase "true" s)) (defn pprint-to-string [x] (let [w (StringWriter.)] (pprint x w) (.toString w))) (defn to-sentence "Join the given strings as they would be listed in a sentence (using an Oxford comma if there are three or more strings). Examples: [\"apple\"] => \"apple\" [\"apple\" \"orange\"] => \"apple and orange\" [\"apple\" \"orange\" \"banana\"] => \"apple, orange, and banana\"" [strings] (let [num-strings (count strings)] (cond (empty? strings) "" (= num-strings 1) (first strings) (= num-strings 2) (str (first strings) " and " (second strings)) (= num-strings 3) (let [[s0 s1 s2] strings] (str s0 ", " s1 ", and " s2)) (> num-strings 3) (str (first strings) ", " (to-sentence (rest strings)))))) ;; ## I/O (defn lines "Returns a sequence of lines from the given filename" [filename] (with-open [file-reader (reader (fs/file filename))] ;; line seq is lazy and file-reader gets closed (doall (line-seq file-reader)))) (defn mkdirs! "Given a path (may be a File or a string), creates a directory (including any missing parent directories). Throws a slingshot exception with a meaningful error message if the directory cannot be created. (The reason for the existence of this function is that the Java File.mkdirs method only returns a boolean indicating whether the directory was created; if you get back a `false`, you have no idea whether it failed due to permission errors, or the path being invalid in some way, or the directory already exists.) The slingshot exception will look like this: `{:kind :puppetlabs.kitchensink.core/io-error :msg \"Parent directory '/foo/bar' is not writable\"}`" [path] {:pre [((some-fn #(instance? File %) string?) path)] :post [(fs/directory? path)]} (let [path-as-file (fs/file path)] (if (fs/file? path-as-file) (throw+ (error-map ::io-error (format "Path '%s' is a file" path))) (doseq [^File dir (reverse (cons path-as-file (fs/parents path-as-file)))] (when-not (fs/exists? dir) (let [parent (.getParentFile dir)] (when (fs/file? parent) (throw+ (error-map ::io-error (format "Parent directory '%s' is a file" parent)))) (when-not (.canWrite parent) (throw+ (error-map ::io-error (format "Parent directory '%s' is not writable" parent)))) (let [success (.mkdir dir)] (when-not success (throw+ (error-map ::io-error (format "Unable to create directory '%s'" parent))))))))))) ;; ## Math (defn quotient "Performs division on the supplied arguments, substituting `default` when the divisor is 0" ([dividend divisor] (quotient dividend divisor 0)) ([dividend divisor default] (if (zero? divisor) default (/ dividend divisor)))) ;; ## Numerics (defn parse-int "Parse a string `s` as an integer, returning nil if the string doesn't contain an integer." [s] {:pre [(string? s)] :post [(or (integer? %) (nil? %))]} (try (Integer/parseInt s) (catch java.lang.NumberFormatException e nil))) (defn parse-float "Parse a string `s` as a float, returning nil if the string doesn't contain a float" [s] {:pre [(string? s)] :post [(or (float? %) (nil? %))]} (try (Float/parseFloat s) (catch java.lang.NumberFormatException e nil))) (defn parse-number "Converts a string `s` to a number, by attempting to parse it as an integer and then as a float. Returns nil if the string isn't numeric." [s] {:pre [(string? s)] :post [(or (number? %) (nil? %))]} ((some-fn parse-int parse-float) s)) ;; ## Randomness (defn rand-weighted-selection "Given alternating numeric weights and values, produces a randomly-selected value according to the weights, which should sum to one. If the weights sum to less than one, then the last value will have its weight adjusted upwards accordingly. If the weights sum to more than one, then values after the cumulative sum of the weights exceeds one will never be selected." [& weights-and-values] {:pre [(even? (count weights-and-values)) (every? number? (take-nth 2 weights-and-values))]} (let [weights (take-nth 2 weights-and-values) values (-> (take-nth 2 (drop 1 weights-and-values)) butlast) cutoffs (-> (reductions + weights) butlast) selected? (let [selected-cutoff (rand)] #(>= % selected-cutoff)) selected (filter (comp selected? first) (map vector cutoffs values))] (if (empty? selected) (last weights-and-values) (-> (first selected) second)))) (def ascii-character-sets (let [concatv (comp vec concat) ALPHA (mapv char (range 65 91)) alpha (mapv char (range 97 123)) digits (mapv char (range 48 58)) symbols (concatv (map char (range 33 48)) (map char (range 91 97)) (map char (range 123 127)))] {:alpha (concatv alpha ALPHA) :alpha-lower alpha :alpha-upper ALPHA :alpha-digits (concatv alpha ALPHA digits) :alpha-digits-symbols (concatv alpha ALPHA digits symbols) :symbols symbols :digits digits})) (defn rand-str "Produces a random string of length n, drawn from the given collection of characters. The following keywords may be used in place of a character collection: :alpha - [a-zA-Z] :alpha-lower - [a-z] :alpha-upper - [A-Z] :alpha-digits - [a-zA-Z0-9] :alpha-digits-symbols - all printable ASCII characters besides space :symbols - all visible, non-alpha-numeric ASCII characters (no space) :digits - [0-9] If no character collection or keyword is provided, :alpha-digits-symbols is used by default." ([n] (rand-str :alpha-digits-symbols n)) ([characters n] (let [char-coll (cond (and (keyword? characters) (contains? ascii-character-sets characters)) (get ascii-character-sets characters) (keyword? characters) (throw (IllegalArgumentException. (str characters " is not a recognized character collection keyword"))) :else (vec characters))] (apply str (repeatedly n #(rand-nth char-coll)))))) ;; ## Collection operations (defn symmetric-difference "Computes the symmetric difference between 2 sets" [s1 s2] (union (difference s1 s2) (difference s2 s1))) (defn as-collection "Returns the item wrapped in a collection, if it's not one already. Returns a list by default, or you can use a constructor func as the second arg." ([item] (as-collection item list)) ([item constructor] {:post [(coll? %)]} (if (coll? item) item (constructor item)))) (defn seq-contains? "True if seq contains elm" [seq elm] (some #(= elm %) seq)) (defn enumerate "Returns a lazy sequence consisting of 0 and the first item of coll, followed by 1 and the second item in coll, etc, until coll is exhausted." [coll] (map-indexed vector coll)) (def excludes? "Inverse of `contains?`. Returns false if key is present in the given collectoin, otherwise returns true." (complement contains?)) (defn contains-some "If coll `contains?` any of the keys in ks, returns the first such key. Otherwise returns nil." [coll ks] (some #(if (contains? coll %) %) ks)) (defn excludes-some "If coll `excludes?` any of the keys in ks, returns the first such key. Otherwise returns nil." [coll ks] (some #(if (excludes? coll %) %) ks)) (defn mapvals "Return map `m`, with each value transformed by function `f`. You may also provide an optional list of keys `ks`; if provided, only the specified keys will be modified." ([f m] (into {} (for [[k v] m] [k (f v)]))) ([f ks m] ;; would prefer to share code between the two implementations here, but ;; the `into` is much faster for the base case and the reduce is much ;; faster for any case where we're operating on a subset of the keys. ;; It seems like `select-keys` is fairly expensive. (reduce (fn [m k] (update-in m [k] f)) m ks))) (defn mapkeys "Return map `m`, with each key transformed by function `f`" [f m] (into {} (concat (for [[k v] m] [(f k) v])))) (defn maptrans "Return map `m`, with values transformed according to the key-to-function mappings specified in `keys-fns`. `keys-fns` should be a map whose keys are lists of keys from `m`, and whose values are functions to apply to those keys. Example: `(maptrans {[:a, :b] inc [:c] dec} {:a 1 :b 1 :c 1})` yields `{:a 2, :c 0, :b 2}`" [keys-fns m] {:pre [(map? keys-fns) (every? (fn [[ks fn]] (and (coll? ks) (ifn? fn))) keys-fns) (map? m)]} (let [ks (keys keys-fns)] (reduce (fn [m k] (mapvals (keys-fns k) k m)) m ks))) (defn dissoc-if-nil "Given a map and a key, checks to see if the value for the key is `nil`; if so, returns a modified map with the specified key removed. If the value is not `nil`, simply returns the original map." ([m k] {:pre [(map? m)] :post [(map? %)]} (if (nil? (m k)) (dissoc m k) m)) ([m k & ks] (let [ret (dissoc-if-nil m k)] (if ks (recur ret (first ks) (next ks)) ret)))) (defn dissoc-in "Dissociates an entry from a nested map. ks is a sequence of keys. Any empty maps that result will not be present in the new map." [m [k & ks]] (when m (if-let [res (and ks (dissoc-in (m k) ks))] (assoc m k res) (let [res (dissoc m k)] (when-not (empty? res) res))))) (defn walk-leaves "Walk a map applying a function to all leaf nodes" [m f] (mapvals #(if (map? %) (walk-leaves % f) (f %)) m)) (defn merge-with-key "Returns a map that consists of the rest of the maps conj-ed onto the first. If a key `k` occurs in more than one map, the mapping(s) from the latter (left-to-right) will be combined with the mapping in the result by calling (f k val-in-result val-in-latter)." {:added "1.0" :static true} [f & maps] (when (some identity maps) (let [merge-entry (fn [m e] (let [k (key e) v (val e)] (if (contains? m k) (assoc m k (f k (get m k) v)) (assoc m k v)))) merge2 (fn [m1 m2] (reduce merge-entry (or m1 {}) (seq m2)))] (reduce merge2 maps)))) (defn deep-merge "Deeply merges maps so that nested maps are combined rather than replaced. For example: (deep-merge {:foo {:bar :baz}} {:foo {:fuzz :buzz}}) ;;=> {:foo {:bar :baz, :fuzz :buzz}} ;; contrast with clojure.core/merge (merge {:foo {:bar :baz}} {:foo {:fuzz :buzz}}) ;;=> {:foo {:fuzz :quzz}} ; note how last value for :foo wins" [& vs] (if (every? map? vs) (apply merge-with deep-merge vs) (last vs))) (defn deep-merge-with "Deeply merges like `deep-merge`, but uses `f` to produce a value from the conflicting values for a key in multiple maps." [f & vs] (if (every? map? vs) (apply merge-with (partial deep-merge-with f) vs) (apply f vs))) (defn deep-merge-with-keys* "Helper function for deep-merge-with-keys" [f ks & vs] (if (every? map? vs) (apply merge-with-key (fn [k & vs] (apply deep-merge-with-keys* f (conj ks k) vs)) vs) (apply f ks vs))) (defn deep-merge-with-keys "Deeply merges like `deep-merge`, but uses `f` to produce a value from the conflicting values for a key path `ks` that appears in multiple maps, by calling `(f ks val-in-result val-in-latter)`." [f & vs] (apply deep-merge-with-keys* f [] vs)) (defn keyset "Returns the set of keys from the supplied map" [m] {:pre [(map? m)] :post [(set? %)]} (set (keys m))) (defn valset "Returns the set of values from the supplied map" [m] {:pre [(map? m)] :post [(set? %)]} (set (vals m))) (def select-values "Returns the sequence of values from the map for the entries with the specified keys" (comp vals select-keys)) (defn filter-map "Like 'filter', but works on maps. Returns a map containing the key-value pairs in 'm' for which 'pred' returns a truth-y value. 'pred' must be a function which takes two arguments." [pred m] (reduce (fn [result [key value]] (if (pred key value) (assoc result key value) result)) {} m)) (defn missing? "Inverse of contains? that supports multiple keys. Will return true if all items are missing from the collection, false otherwise. Example: ;; Returns true, as :z :f :h are all missing (missing? {:a 'a' :b 'b' :c 'c'} :z :f :h) ;; Returns false, as :a is in the collection (missing? {:a 'a' :b 'b' :c 'c'} :z :b)" [coll & keys] {:pre [(coll? coll)] :post [(boolean? %)]} (reduce (fn [_ key] (if (contains? coll key) (reduced false) true)) nil keys)) (defn ordered-comparator "Given a function and an order (:ascending or :descending), return a comparator function that takes two objects and compares them in ascending or descending order based on the value of applying the function to each." [f order] {:pre [(ifn? f) (contains? #{:ascending :descending} order)] :post [(fn? %)]} (fn [x y] (if (= order :ascending) (compare (f x) (f y)) (compare (f y) (f x))))) (defn compose-comparators "Composes two comparator functions into a single comparator function which will call the first comparator and return the result if it is non-zero; otherwise it will call the second comparator and return its result." [comp-fn1 comp-fn2] {:pre [(fn? comp-fn1) (fn? comp-fn2)] :post [(fn? %)]} (fn [x y] (let [val1 (comp-fn1 x y)] (if (= val1 0) (comp-fn2 x y) val1)))) (defn order-by-expr? "Predicate that returns true if the argument is a valid expression for use with the `order-by` function; in other words, returns true if the argument is a 2-item vector whose first element is an `ifn` and whose second element is either `:ascending` or `:descending`." [x] (and (vector? x) (ifn? (first x)) (contains? #{:ascending :descending} (second x)))) (defn order-by "Sorts a collection based on a sequence of 'order by' expressions. Each expression is a tuple containing a fn followed by either `:ascending` or `:descending`; returns a collection that is sorted based on the values of the 'order by' fns being applied to the elements in the original collection. If multiple 'order by' expressions are passed in, their precedence is determined by their order in the argument list." [order-bys coll] {:pre [(sequential? order-bys) (every? order-by-expr? order-bys) (coll? coll)]} (let [comp-fns (map (fn [[f order]] (ordered-comparator f order)) order-bys) final-comp (reduce compose-comparators comp-fns)] (sort final-comp coll))) (defn sort-nested-maps "For a data structure, recursively sort any nested maps and sets descending into map values, lists, vectors and set members as well. The result should be that all maps in the data structure become explicitly sorted with natural ordering. This can be used before serialization to ensure predictable serialization. The returned data structure is not a transient so it is still able to be modified, therefore caution should be taken to avoid modification else the data will lose its sorted status." [data] (cond (map? data) (into (sorted-map) (for [[k v] data] [k (sort-nested-maps v)])) (sequential? data) (map sort-nested-maps data) :else data)) ;; ## Date and Time (defn timestamp "Returns a timestamp string for the given `time`, or the current time if none is provided. The format of the timestamp is eg. 2012-02-23T22:01:39.539Z." ([] (timestamp (now))) ([time] (unparse (formatters :date-time) time))) ;; ## Exception handling (defn without-ns "Given a clojure keyword that is optionally namespaced, returns a keyword with the same name but with no namespace." [kw] {:pre [(keyword? kw)] :post [(keyword? %) (nil? (namespace %))]} (keyword (name kw))) (defn keep-going* "Executes the supplied fn repeatedly. Execution may be stopped with an InterruptedException." [f on-error] (if (try (f) true (catch InterruptedException e false) (catch Throwable e (on-error e) true)) (recur f on-error))) (defmacro keep-going "Executes body, repeating the execution of body even if an exception is thrown" [on-error & body] `(keep-going* (fn [] ~@body) ~on-error)) (defmacro with-error-delivery "Executes body, and delivers an exception to the provided promise if one is thrown." [error & body] `(try ~@body (catch Throwable e# (deliver ~error e#)))) (defmacro with-timeout [timeout-s default & body] `(let [f# (future (do ~@body)) result# (deref f# (* 1000 ~timeout-s) ~default)] (future-cancel f#) result#)) ;; ## File paths (defn absolute-path "Replacement for raynes.fs/absolute-path, which was removed in raynes.fs 1.4.6. Returns string representation of absolute path, as opposed to fs/absolute, which returns a File object." [path] (.getPath ^File (fs/absolute path))) (defn normalized-path "Replacement for raynes.fs/normalized-path, which was removed in raynes.fs 1.4.6. Returns string representation of absolute path, as opposed to fs/normalized, which returns a File object." [path] (.getPath ^File (fs/normalized path))) ;; ## Temp files (defn temp-file-name "Returns a unique name to a temporary file, but does not actually create the file." [file-name-prefix] (io/file (fs/tmpdir) (fs/temp-name file-name-prefix))) (defn delete-on-exit "Will delete `f` on shutdown of the JVM" [f] (.deleteOnExit (fs/file f)) f) (defn temp-file "Creates a temporary file that will be deleted on JVM shutdown. Supported arguments are the same as for me.raynes.fs/temp-file: [prefix] [prefix suffix] [prefix suffix tries] You may also call with no arguments, in which case the prefix string will be empty." [& args] (if (empty? args) (delete-on-exit (fs/temp-file nil)) (delete-on-exit (apply fs/temp-file args)))) (defn temp-dir "Creates a temporary directory that will be deleted on JVM shutdown. Supported arguments are the same as for me.raynes.fs/temp-dir: [prefix] [prefix suffix] [prefix suffix tries] You may also call with no arguments, in which case the prefix string will be empty." [& args] temp-dir (if (empty? args) (delete-on-exit (fs/temp-dir nil)) (delete-on-exit (apply fs/temp-dir args)))) ;; ## Configuration files (def keywordize "Normalize INI keys by ensuring they're lower-case and keywords" (comp keyword string/lower-case)) (defn fetch-int "Fetch a key from the INI section and convert it to an integer if it parses, otherwise return the string" [^BasicProfileSection section key] (let [val (.fetch section key)] (or (parse-int val) val))) (defn create-section-map "Given an INI section, create a clojure map of it's key/values" [^BasicProfileSection section] (reduce (fn [acc [key _]] (if (> (.length section key) 1) (throw (IllegalArgumentException. (str "Duplicate configuration entry: " (mapv keyword [(.getName section) key])))) (assoc acc (keywordize key) (fetch-int section key)))) {} section)) (defn parse-ini "Takes a reader that contains an ini file, and returns an Ini object containing the parsed results" [^Reader ini-reader] {:pre [(instance? Reader ini-reader)] :post [(instance? Ini %)]} (let [config (Config.) ini (Ini.)] (.setMultiOption config true) (.setConfig ini config) (.load ini ini-reader) ini)) (defn ini-to-map "Takes a .ini filename and returns a nested map of fully-interpolated values. Strings that look like integers are returned as integers, and all section names and keys are returned as symbols." [filename] {:pre [(or (string? filename) (instance? java.io.File filename))] :post [(map? %) (every? keyword? (keys %)) (every? map? (vals %))]} (with-open [ini (reader filename)] (reduce (fn [acc [name section]] (assoc acc (keywordize name) (create-section-map section))) {} (parse-ini ini)))) (defn inis-to-map "Takes a path and converts the pointed-at .ini files into a nested map (see `ini-to-map` for details). If `path` is a file, the behavior is exactly the same as `ini-to-map`. If `path` is a directory, we return a merged version of parsing all the .ini files in the directory (we do not do a recursive find of .ini files)." ([path] (inis-to-map path "*.ini")) ([path glob-pattern] {:pre [(or (string? path) (instance? java.io.File path))] :post [(map? %)]} (let [files (if-not (fs/directory? path) [path] (fs/glob (fs/file path glob-pattern)))] (->> files (map fs/absolute) (map ini-to-map) (apply deep-merge-with-keys (fn [ks & _] (throw (IllegalArgumentException. (str "Duplicate configuration entry: " ks))))) (merge {}))))) (defn spit-ini "Writes the `ini-map` to the Ini file at `file`. `ini-map` should a map similar to the ones created by ini-to-map. The keys are keywords for the sections and their values are maps of config keypairs." [^File file ini-map] (let [ini (org.ini4j.Ini. file)] (doseq [[section-key section] ini-map [k v] section] (.put ini (name section-key) (name k) v)) (.store ini))) (defn add-shutdown-hook! "Adds a shutdown hook to the JVM runtime. `f` is a function that takes 0 arguments; the return value is ignored. This function will be called if the JVM receiveds an interrupt signal (e.g. from `kill` or CTRL-C); you can use it to log shutdown messages, handle state cleanup, etc." [^Runnable f] {:pre [(fn? f)]} (.addShutdownHook (Runtime/getRuntime) (Thread. f))) (defmacro demarcate "Executes `body`, but logs `msg` to info before and after `body` is executed. `body` is executed in an implicit do, and the last expression's return value is returned by `demarcate`. user> (demarcate \"reticulating splines\" (+ 1 2 3)) \"Starting reticulating splines\" \"Finished reticulating splines\" 6 " [msg & body] `(do (log/info (str "Starting " ~msg)) (let [result# (do ~@body)] (log/info (str "Finished " ~msg)) result#))) ;; ## Command-line parsing (defn cli! "Validates that required command-line arguments are present. If they are not, throws a map** with an error message that is intended to be displayed to the user. Also checks to see whether the user has passed the `--help` flag. Input: - args : the command line arguments passed in by the user - specs : an array of supported argument specifications, as accepted by `clojure.tools.cli` - required : an array of keywords (using the long form of the argument spec) specifying which of the `specs` are required. If any of the `required` options are not present, the function will cause the program to exit and display the help message. ** The map is thrown using 'slingshot' (https://github.com/scgilardi/slingshot). It contains a `:kind` and `:msg`, where type is either `:error` or `:help`, and the message is either the error message or a help banner. Returns a three-item vector, containing: * a map of the parsed options * a vector containing the remaining cli arguments that were not parsed * a string containing a summary of all of the options that are available; for use in printing help messages if the user detects that the arguments are still invalid in some way." ([args specs] (cli! args specs nil)) ([args specs required-args] (let [specs (conj specs ["-h" "--help" "Show help" :default false]) {:keys [options arguments summary errors]} (cli/parse-opts args specs)] (when errors (let [msg (str "\n\n" "Error(s) occurred while parsing command-line arguments: " (apply str errors) "\n\n" summary)] (throw+ (error-map ::cli-error msg)))) (when (:help options) (throw+ (error-map ::cli-help summary))) (when-let [missing-field (some #(if (not (contains? options %)) %) required-args)] (let [msg (str "\n\n" (format "Missing required argument '--%s'!" (name missing-field)) "\n\n" summary)] (throw+ (error-map ::cli-error msg)))) [options arguments summary]))) ;; ## SSL Certificate handling ;; ;; NOTE: Prefer functions provided by the jvm-certificate-authority library over these. ;; ;; These functions are only used by PuppetDB and they should likely move back into that ;; project until they can be refactored away over functions from the jvm-ca library. (defn cn-for-dn "Deprecated. Use functions from `jvm-certificate-authority`. Extracts the CN (common name) from an LDAP DN (distinguished name). If more than one CN entry exists in the given DN, we return the most-specific one (the one that comes last, textually). If no CN is present in the DN, we return nil. Example: (cn-for-dn \"CN=foo.bar.com,OU=meh,C=us\") \"foo.bar.com\" (cn-for-dn \"CN=foo.bar.com,CN=baz.goo.com,OU=meh,C=us\") \"baz.goo.com\" (cn-for-dn \"OU=meh,C=us\") nil" [^String dn] {:pre [(string? dn)]} (some->> dn (LdapName.) (.getRdns) (filter #(= "CN" (.getType %))) (first) (.getValue) (str))) (defn cn-for-cert "Deprecated. Use functions from `jvm-certificate-authority`. Extract the CN from the DN of an x509 certificate. See `cn-for-dn` for details on how extraction is performed. If no CN exists in the certificate DN, nil is returned." [^java.security.cert.X509Certificate cert] (-> cert (.getSubjectDN) (.getName) (cn-for-dn))) ;; ## Ring helpers (defn cn-whitelist->authorizer "Given a 'whitelist' file containing allowed CNs (one per line), build a function that takes a Ring request and returns true if the CN contained in the client certificate appears in the whitelist. `whitelist` can be either a local filename or a File object. This makes use of the `:ssl-client-cn` request parameter. See `com.puppetlabs.middleware/wrap-with-certificate-cn`." [whitelist] {:pre [(or (string? whitelist) (instance? java.io.File whitelist))] :post [(fn? %)]} (let [allowed? (set (lines whitelist))] (fn [{:keys [ssl-client-cn scheme] :as req}] (or (= scheme :http) (allowed? ssl-client-cn))))) ;; ## Hashing (defn utf8-string->sha1 "Compute a SHA-1 hash for the UTF-8 encoded version of the supplied string" [^String s] {:pre [(string? s)] :post [(string? %)]} (let [bytes (.getBytes s "UTF-8")] (digest/sha-1 [bytes]))) (defn bounded-memoize "Similar to memoize, but the cache will be reset if the number of entries exceeds the specified `bound`." [f bound] {:pre [(integer? bound) (pos? bound)]} (let [cache (atom {})] (fn [& args] (if-let [e (find @cache args)] (val e) (let [v (apply f args)] (when (> (count @cache) bound) (reset! cache {})) (swap! cache assoc args v) v))))) ;; ## UUID handling (defn uuid "Generate a random UUID and return its string representation" [] (str (java.util.UUID/randomUUID))) (defn uuid? "Verifies whether a string is a valid UUID" [uuid] (try (java.util.UUID/fromString uuid) true (catch IllegalArgumentException e false))) ;; ## System interface (defn num-cpus "Grabs the number of available CPUs for the local host" [] {:post [(pos? %)]} (.availableProcessors (Runtime/getRuntime))) ;; Comparison of JVM versions (defn compare-jvm-versions "Same behavior as `compare`, but specifically for JVM version strings. Because Java versions don't follow semver or anything, we need to do some massaging of the input first: http://www.oracle.com/technetwork/java/javase/versioning-naming-139433.html" [a b] {:pre [(string? a) (string? b)] :post [(number? %)]} (let [parse #(mapv parse-int (-> % (split #"-") (first) (split #"[\\._]")))] (compare (parse a) (parse b)))) (def java-version "Returns a string of the currently running java version" (System/getProperty "java.version")) ;; control flow (defmacro cond-let "Takes a binding-form and a set of test/expr pairs. Evaluates each test one at a time. If a test returns logical true, cond-let evaluates and returns expr with binding-form bound to the value of test and doesn't evaluate any of the other tests or exprs. To provide a default value either provide a literal that evaluates to logical true and is binding-compatible with binding-form, or use :else as the test and don't refer to any parts of binding-form in the expr. (cond-let binding-form) returns nil." [bindings & clauses] (let [binding (first bindings)] (when-let [[test expr & more] clauses] (if (= test :else) expr `(if-let [~binding ~test] ~expr (cond-let ~bindings ~@more)))))) (defmacro while-let "Repeatedly executes body while test expression is true, evaluating the body with binding-form bound to the value of test." [bindings & body] (let [form (first bindings) test (second bindings)] `(loop [~form ~test] (when ~form ~@body (recur ~test))))) (defmacro some-pred->> "When expr does not satisfy pred, threads it into the first form (via ->>), and when that result does not satisfy pred, through the next etc" [pred expr & forms] (let [g (gensym) pstep (fn [step] `(if (~pred ~g) ~g (->> ~g ~step)))] `(let [~g ~expr ~@(interleave (repeat g) (map pstep forms))] ~g))) (defn open-port-num "Returns a currently open port number" [] (with-open [s (java.net.ServerSocket. 0)] (.getLocalPort s))) (defmacro assoc-if-new "Assocs the provided values with the corresponding keys if and only if the key is not already present in map." [map key val & kvs] {:pre [(even? (count kvs))]} (let [deferred-kvs (vec (for [[k v] (cons [key val] (partition 2 kvs))] [k `(fn [] ~v)]))] `(let [updates# (for [[k# v#] ~deferred-kvs :when (= ::not-found (get ~map k# ::not-found))] [k# (v#)])] (merge ~map (into {} updates#))))) (defn deref-swap! "Like swap! but returns the old value. Adapted from http://stackoverflow.com/a/15442107." [atom f & args] (loop [] (let [old @atom new (apply f old args)] (if (compare-and-set! atom old new) old (recur))))) (defn parse-interval "Given a time string of the form \"\", or \"\", this function parses this time amount and returns a joda time Period instance. If the unit is left off, the units are assumed to be seconds Example: \"12h\" -> (clj-time.core/hours 12) Example: \"12\" -> (clj-time.core/seconds 12) Possible units: s(econds), m(inutes), h(ours), d(ays), y(ears) Returns nil if the time string cannot be parsed." [time-str] (when-not (nil? time-str) (when-let [[_ num unit] (re-matches #"^(\d+)([smhdy]?)$" time-str)] (let [num (parse-int num) time-fn (case unit "s" seconds "m" minutes "h" hours "d" days "y" years "" seconds)] (time-fn num))))) clj-kitchensink-2.3.0/src/puppetlabs/kitchensink/json.clj000066400000000000000000000061051307352521100235200ustar00rootroot00000000000000(ns puppetlabs.kitchensink.json "Cheshire related functions This front-ends the common set of core cheshire functions: * generate-string * generate-stream * parse-string * parse-stream This namespace when 'required' will also setup some common JSON encoders globally, so you can avoid doing this for each call." (:require [cheshire.core :as core] [cheshire.generate :as generate] [clj-time.coerce :as coerce] [clj-time.core :as clj-time] [clojure.java.io :as io] [clojure.tools.logging :as log]) (:import com.fasterxml.jackson.core.JsonGenerator)) (defn- clj-time-encoder [data jsonGenerator] (.writeString ^JsonGenerator jsonGenerator ^String (coerce/to-string data))) (def ^:dynamic *datetime-encoder* clj-time-encoder) (defn add-common-json-encoders!* "Non-memoize version of add-common-json-encoders!" [] (when (satisfies? generate/JSONable (clj-time/date-time 1999)) (log/warn "Overriding existing JSONable protocol implementation for org.joda.time.DateTime")) (generate/add-encoder org.joda.time.DateTime (fn [data jsonGenerator] (*datetime-encoder* data jsonGenerator)))) (def ^{:doc "Registers some common encoders for cheshire JSON encoding. This is a memoize function, to avoid unnecessary calls to add-encoder. Ideally this function should be called once in your apply, for example your main class. Encoders currently include: * org.joda.time.DateTime - handled with to-string"} add-common-json-encoders! (memoize add-common-json-encoders!*)) (defmacro with-datetime-encoder "Evaluates the body using the given encoder to serialize DateTime objects to JSON. Requires that `add-common-json-encoders!` from this namespace has already been called, and that nobody else has re-extended org.joda.date.DateTime to cheshire's JSONable protocol in the meantime." [encoder & body] `(binding [*datetime-encoder* ~encoder] ~@body)) (def default-pretty-opts {:date-format "yyyy-MM-dd'T'HH:mm:ss.SSS'Z'" :pretty true}) (def ^String generate-string core/generate-string) (def ^String generate-stream core/generate-stream) (defn generate-pretty-string "Thinly wraps cheshire.core/generate-string, adding the clj-time default date format and pretty printing from `default-pretty-opts`" ([obj] (generate-pretty-string obj default-pretty-opts)) ([obj opts] (generate-string obj (merge default-pretty-opts opts)))) (defn generate-pretty-stream "Thinly wraps cheshire.core/generate-stream, adding the clj-time default date format and pretty printing from `default-pretty-opts`" ([obj writer] (generate-pretty-stream obj writer default-pretty-opts)) ([obj writer opts] (generate-stream obj writer (merge default-pretty-opts opts)))) (def parse-string core/parse-string) (def parse-stream core/parse-stream) (defn spit-json "Similar to clojure.core/spit, but writes the Clojure datastructure as JSON to `f`" [f obj & options] (with-open [writer ^java.io.BufferedWriter (apply io/writer f options)] (generate-pretty-stream obj writer)) nil) clj-kitchensink-2.3.0/test/000077500000000000000000000000001307352521100155525ustar00rootroot00000000000000clj-kitchensink-2.3.0/test/puppetlabs/000077500000000000000000000000001307352521100177315ustar00rootroot00000000000000clj-kitchensink-2.3.0/test/puppetlabs/kitchensink/000077500000000000000000000000001307352521100222435ustar00rootroot00000000000000clj-kitchensink-2.3.0/test/puppetlabs/kitchensink/classpath_test.clj000066400000000000000000000015151307352521100257600ustar00rootroot00000000000000(ns puppetlabs.kitchensink.classpath-test (:require [clojure.test :refer :all] [puppetlabs.kitchensink.classpath :refer [with-additional-classpath-entries]]) (:import (java.net URL))) (deftest with-additional-classpath-entries-test (let [paths ["/foo" "/bar"] get-urls #(into #{} (.getURLs (.getContextClassLoader (Thread/currentThread))))] (with-additional-classpath-entries paths (testing "classloader now includes the new paths" (let [urls (get-urls)] (is (contains? urls (URL. "file:/foo"))) (is (contains? urls (URL. "file:/bar")))))) (testing "classloader has been restored to its previous state" (let [urls (get-urls)] (is (not (contains? urls (URL. "file:/foo")))) (is (not (contains? urls (URL. "file:/bar")))))))) clj-kitchensink-2.3.0/test/puppetlabs/kitchensink/core_test.clj000066400000000000000000000755301307352521100247360ustar00rootroot00000000000000(ns puppetlabs.kitchensink.core-test (:require [clojure.test :refer :all] [puppetlabs.kitchensink.core :refer :all] [me.raynes.fs :as fs] [slingshot.slingshot :refer [try+]] [clojure.string :as string] [clj-time.core :as t] [puppetlabs.kitchensink.testutils :as testutils] [clojure.zip :as zip]) (:import (java.util ArrayList))) (deftest array?-test (testing "array?" (testing "should work for nil input" (is (nil? (array? nil)))) (testing "should detect primitive arrays" (doseq [f #{object-array boolean-array byte-array short-array char-array int-array long-array float-array double-array}] (is (true? (array? (f 1)))))) (testing "should return nil for non-array objects" (doseq [x ['() [] {} "foo" 123 456.789 1/3]] (is (false? (array? x))))))) (deftest boolean?-test (testing "should return true if true" (is (boolean? true))) (testing "should return true if false" (is (boolean? false))) (testing "should return false if string" (is (not (boolean? "test")))) (testing "should return false if nil" (is (not (boolean? nil))))) (deftest regexp?-test (testing "should return true if pattern" (is (regexp? (re-pattern "test")))) (is (regexp? #"test")) (testing "should return false if string" (is (not (regexp? "test"))))) (deftest datetime?-test (testing "should return false for non-coercible types" (is (not (datetime? 2.0)))) (testing "should return false for nil" (is (not (datetime? nil)))) (testing "should return true for a valid string" (is (datetime? "2011-01-01T12:00:00-03:00"))) (testing "should return false for an invalid string" (is (not (datetime? "foobar")))) (testing "should return true for a valid integer" (is (datetime? 20))) (testing "should return false for an invalid integer") (is (not (datetime? -9999999999999999999999999999999)))) (deftest zipper?-test (testing "should return true for zippers" (is (true? (zipper? (zip/vector-zip [:foo :bar]))))) (testing "should return false for non-zippers" (is (false? (zipper? "hi"))) (is (false? (zipper? 42))) (is (false? (zipper? :foo))) (is (false? (zipper? [:foo :bar]))) (is (false? (zipper? {:foo :bar}))))) (deftest to-bool-test (testing "should return the same value when passed a Boolean" (is (true? (to-bool true))) (is (false? (to-bool false)))) (testing "should return true or false when passed a string representation of same" (is (true? (to-bool "true"))) (is (true? (to-bool "TRUE"))) (is (true? (to-bool "tRuE"))) (is (false? (to-bool "false"))) (is (false? (to-bool "FALSE"))) (is (false? (to-bool "fAlSe")))) (testing "should return false when passed nil" (is (false? (to-bool nil)))) (testing "should throw an exception when passed a string other than true or false" (try+ (to-bool "hi") (is (not true) "Expected exception to be thrown by to-bool when an invalid string is passed") (catch map? m (is (contains? m :kind)) (is (= :puppetlabs.kitchensink.core/parse-error (:kind m))) (is (= :parse-error (without-ns (:kind m)))) (is (contains? m :msg)) (is (re-find #"Unable to parse 'hi' to a boolean" (:msg m))))))) (deftest test-true-str? (are [t-or-f? str-val] (t-or-f? (true-str? str-val)) true? "true" true? "TRUE" true? "TrUe" false? "false" false? nil false? "FALSE")) (deftest to-sentence-test (are [coll string] (= string (to-sentence coll)) [] "" ["foo"] "foo" ["foo" "bar"] "foo and bar" ["foo" "bar" "baz"] "foo, bar, and baz" ["foo" "bar" "baz" "qux"] "foo, bar, baz, and qux")) (deftest mkdirs-test (testing "creates all specified directories that don't exist for File arg" (let [tmpdir (temp-dir)] (fs/mkdirs (fs/file tmpdir "foo")) (mkdirs! (fs/file tmpdir "foo" "bar" "baz")) (is (fs/directory? (fs/file tmpdir "foo" "bar" "baz"))))) (testing "creates all specified directories that don't exist for String arg" (let [tmpdir (temp-dir)] (fs/mkdirs (fs/file tmpdir "foo")) (mkdirs! (.getPath (fs/file tmpdir "foo" "bar" "baz"))) (is (fs/directory? (fs/file tmpdir "foo" "bar" "baz"))))) (testing "throws exception if one of the elements of the path exists and is a file" (let [tmpdir (temp-dir)] (fs/mkdirs (fs/file tmpdir "foo")) (fs/touch (fs/file tmpdir "foo" "bar")) (try+ (mkdirs! (fs/file tmpdir "foo" "bar" "baz")) (is (not true) "Expected exception to be thrown by mkdirs! when one of the elements of the path already exists and is a file") (catch map? m (is (contains? m :kind)) (is (= :puppetlabs.kitchensink.core/io-error (:kind m))) (is (= :io-error (without-ns (:kind m)))) (is (contains? m :msg)) (is (re-find #"foo/bar' is a file" (:msg m))))))) (testing "throws exception if the path exists and is a file" (let [tmpdir (temp-dir)] (fs/mkdirs (fs/file tmpdir "foo")) (fs/touch (fs/file tmpdir "foo" "bar")) (try+ (mkdirs! (fs/file tmpdir "foo" "bar")) (is (not true) (str "Expected exception to be thrown by mkdirs! when " "the path already exists and is a file")) (catch map? m (is (contains? m :kind)) (is (= :puppetlabs.kitchensink.core/io-error (:kind m))) (is (= :io-error (without-ns (:kind m)))) (is (contains? m :msg)) (is (re-find #"foo/bar' is a file" (:msg m))))))) (testing "Permission denied on some directory in the hierarchy" (let [tmpdir (temp-dir)] (fs/mkdirs (fs/file tmpdir "foo")) (fs/chmod "-w" (fs/file tmpdir "foo")) (try+ (mkdirs! (fs/file tmpdir "foo" "bar" "baz")) (is (not true) "Expected exception to be thrown by mkdirs! when a permissions error occurs") (catch map? m (is (contains? m :kind)) (is (= :puppetlabs.kitchensink.core/io-error (:kind m))) (is (= :io-error (without-ns (:kind m)))) (is (contains? m :msg)) (is (re-find #"foo' is not writable" (:msg m)))))))) (deftest quotient-test (testing "quotient" (testing "should behave like '/' when divisor is non-zero" (is (= 22/7 (quotient 22 7)))) (testing "should return default when divisor is zero" (is (= 0 (quotient 1 0))) (is (= 10 (quotient 1 0 10)))))) (deftest rand-weighted-selection-test (testing "rand-weighted-selection" (testing "should make selections within 1% of expected values when n=100k" (let [make-selection #(rand-weighted-selection 0.1 :foo 0.3 :bar 0.4 :baz 0.19 :quux 0.01 :waffle) n (int 1e5) freqs (frequencies (repeatedly n make-selection)) expected-freqs {:foo 10000 :bar 30000 :baz 40000 :quux 19000 :waffle 1000}] (doseq [[value actual] freqs :let [expected (get expected-freqs value)]] (is (< (Math/abs (- expected actual)) (/ n 100)))))) (testing "adjusts the weight of the last value when the weights sum to less than 1" (is (= :foo (rand-weighted-selection 0.0 :foo)))) (testing "doesn't select values whose weights come after prior weights have sum to 1" (dotimes [_ 1e3] (is (not= :bar (rand-weighted-selection 1.0 :foo 10.0 :bar))))) (testing "throws an error when" (testing "a weight does not have a value" (is (thrown? AssertionError (rand-weighted-selection 0.0)))) (testing "a weight is not numeric" (is (thrown? AssertionError (rand-weighted-selection :foo :bar))))))) (deftest rand-str-test (testing "rand-str" (testing "throws an IllegalArgumentException when given an unknown characters keyword" (is (thrown-with-msg? IllegalArgumentException #":CJK" (rand-str :CJK 42)))) (doseq [[kw cs] ascii-character-sets :let [cs (set cs)]] (testing (str "recognizes the " kw " character set keyword") (dotimes [_ 10] (is (every? cs (rand-str kw 1000)))))) (testing "uses collections of strings & characters as character sets" (let [as ["a" \a]] (dotimes [_ 100] (is (every? #(= % \a) (rand-str as 100)))))))) (deftest excludes?-test (testing "should return true if coll does not contain key" (is (excludes? {:foo 1} :bar))) (testing "should return false if coll does contain key" (is (not (excludes? {:foo 1} :foo))))) (deftest contains-some-test (testing "should return nil if coll doesn't contain any of the keys" (is (= nil (contains-some {:foo 1} [:bar :baz :bam])))) (testing "should return the first key that coll does contain" (is (= :baz (contains-some {:foo 1 :baz 2 :bam 3} [:bar :baz :bam]))))) (deftest excludes-some-test (testing "should return nil if coll does `contain?` all of the keys" (is (= nil (excludes-some {:bar 1 :baz 2} [:bar :baz])))) (testing "should return the first key that coll does *not* `contain?`" (is (= :baz (excludes-some {:bar 1 :foo 2} [:foo :baz :bam]))))) (deftest mapvals-test (testing "should default to applying a function to all of the keys" (is (= {:a 2 :b 3} (mapvals inc {:a 1 :b 2})))) (testing "should support applying a function to a subset of the keys" (is (= {:a 2 :b 2} (mapvals inc [:a] {:a 1 :b 2})))) (testing "should support keywords as the function to apply to all of the keys" (is (= {:a 1 :b 2} (mapvals :foo {:a {:foo 1} :b {:foo 2}})))) (testing "should support keywords as the function to apply to a subset of the keys" (is (= {:a 1 :b {:foo 2}} (mapvals :foo [:a] {:a {:foo 1} :b {:foo 2}}))))) (deftest maptrans-test (testing "should fail if the keys-fns param isn't valid" (is (thrown? AssertionError (maptrans "blah" {:a 1 :b 1})))) (testing "should transform a map based on the given functions" (is (= {:a 3 :b 3 :c 3 :d 3} (maptrans {[:a :b] inc [:d] dec} {:a 2 :b 2 :c 3 :d 4})))) (testing "should accept keywords as functions in the keys-fns param" (is (= {:a 3 :b 3} (maptrans {[:a :b] :foo} {:a {:foo 3} :b {:foo 3}}))))) (deftest dissoc-if-nil-test (let [testmap {:a 1 :b nil}] (testing "should remove the key if the value is nil" (is (= (dissoc testmap :b) (dissoc-if-nil testmap :b)))) (testing "should not remove the key if the value is not nil" (is (= testmap (dissoc-if-nil testmap :a)))))) (deftest dissoc-in-test (let [testmap {:a {:b 1 :c {:d 2}}}] (testing "should remove the key" (is (= {:a {:c {:d 2}}} (dissoc-in testmap [:a :b])))) (testing "should remove the empty map" (is (= {:a {:b 1}} (dissoc-in testmap [:a :c :d])))))) (deftest walk-leaves-test (testing "should apply a function to all of the leaves" (is (= {:a 2 :b {:c 5}} (walk-leaves {:a 1 :b {:c 4}} inc))))) (deftest merge-with-key-test (let [m1 {:a 1 :b 2} m2 {:a 3 :b 4} merge-fn (fn [k v1 v2] (if (= k :a) (+ v1 v2) v2))] (is (= {:a 4 :b 4} (merge-with-key merge-fn m1 m2))))) (deftest deep-merge-test (testing "should deeply nest duplicate keys that both have map values" (let [testmap-1 {:foo {:bar :baz}, :pancake :flapjack} testmap-2 {:foo {:fuzz {:buzz :quux}}}] (is (= {:foo {:bar :baz, :fuzz {:buzz :quux}}, :pancake :flapjack} (deep-merge testmap-1 testmap-2))))) (testing "should combine duplicate keys' values that aren't all maps by calling the provided function" (let [testmap-1 {:foo {:bars 2}} testmap-2 {:foo {:bars 3, :bazzes 4}}] (is (= {:foo {:bars 5, :bazzes 4}} (deep-merge-with + testmap-1 testmap-2))))) (testing "deep-merge-with-keys should pass keys to specified fn" (let [m1 {:a {:b 1 :c 2}} m2 {:a {:b 3 :c 4}} merge-fn (fn [ks v1 v2] (if (= ks [:a :b]) (+ v1 v2) v2))] (is (= {:a {:b 4 :c 4}} (deep-merge-with-keys merge-fn m1 m2)))))) (deftest filter-map-test (testing "should filter based on a given predicate" (let [test-map {:dog 5 :cat 4 :mouse 7 :cow 6}] (is (= (filter-map (fn [k v] (even? v)) test-map) {:cat 4, :cow 6})) (is (= (filter-map (fn [k v] (= 3 (count (name k)))) test-map) {:dog 5, :cat 4, :cow 6})) (is (= (filter-map (fn [k v] (and (= 3 (count (name k))) (> v 5))) test-map) {:cow 6})) (is (= (filter-map (fn [k v] true) test-map) test-map)) (is (= (filter-map (fn [k v] false) test-map) {})))) (testing "should return empty map if given nil" (is (= {} (filter-map nil nil))))) (deftest missing?-test (let [sample {:a "asdf" :b "asdf" :c "asdf"}] (testing "should return true for single key items if they don't exist in the coll" (is (true? (missing? sample :n)))) (testing "should return false for single key items if they exist in the coll" (is (false? (missing? sample :c)))) (testing "should return true for multiple key items if they all don't exist in the coll" (is (true? (missing? sample :n :f :g :z :h)))) (testing "should return false for multiple key items if one item exists in the coll" (is (false? (missing? sample :n :b :f))) (is (false? (missing? sample :a :h :f)))) (testing "should return false for multiple key items if all items exist in the coll" (is (false? (missing? sample :a :b :c)))))) (deftest order-by-test (let [test-data [{:id 1 :k1 "ALPHA" :k2 "BETA" :k3 "GAMMA"} {:id 2 :k1 "ALPHA" :k2 "BETA" :k3 "EPSILON"} {:id 3 :k1 "ALPHA" :k2 "CHARLIE" :k3 "DELTA"} {:id 4 :k1 "ALPHA" :k2 "CHARLIE" :k3 "FOXTROT"} {:id 5 :k1 "alpha" :k2 "beta" :k3 "alpha"}]] (testing "single field, ascending order-by" (is (= [3 2 4 1 5] (map :id (order-by [[:k3 :ascending]] test-data))))) (testing "single field, descending order-by" (is (= [5 1 4 2 3] (map :id (order-by [[:k3 :descending]] test-data))))) (testing "single function, descending order-by" (is (= [1 4 2 3 5] (map :id (order-by [[#(string/lower-case (:k3 %)) :descending]] test-data))))) (testing "multiple order-bys" (is (= [5 3 4 2 1] (map :id (order-by [[#(string/upper-case (:k1 %)) :ascending] [:k2 :descending] [:k3 :ascending]] test-data))))))) (deftest sort-nested-maps-test (testing "with nested structure" (let [input {:b "asdf" :a {:z "asdf" :k [:z {:z 26 :a 1} :c] :a {:m 12 :a 1} :b "asdf"}} output (sort-nested-maps input)] (testing "after sorting, maps should still match" (is (= input output))) (testing "all maps levels of output should be sorted" (is (sorted? output)) (is (sorted? (:a output))) (is (sorted? (get (vec (get-in output [:a :k])) 1))) (is (sorted? (get-in output [:a :a])))))) (testing "with a string" (let [input "string here" output (sort-nested-maps input)] (testing "should match" (is (= input output))))) (testing "with a list" (let [input '(:a :b :c) output (sort-nested-maps input)] (testing "should still match" (is (= input output)))))) (deftest without-ns-test (testing "removes namespace from a namespaced keyword" (is (= :foo (without-ns :foo/foo))) (is (= :foo (without-ns ::foo)))) (testing "doesn't alter non-namespaced keyword" (let [kw :foo] (is (= kw (without-ns kw)))))) (deftest string-hashing (testing "Computing a SHA-1 for a UTF-8 string" (testing "should fail if not passed a string" (is (thrown? AssertionError (utf8-string->sha1 1234)))) (testing "should produce a stable hash" (is (= (utf8-string->sha1 "foobar") (utf8-string->sha1 "foobar")))) (testing "should produce the correct hash" (is (= "8843d7f92416211de9ebb963ff4ce28125932878" (utf8-string->sha1 "foobar")))))) (deftest temp-file-name-test (testing "The file should not exist." (is (not (fs/exists? (temp-file-name "foo"))))) (testing "It should be possible to create a file at the given path." (is (fs/create (temp-file-name "foo"))))) (deftest temp-file-test (testing "should create a temp file when not given a prefix" (let [f (temp-file)] (is (fs/file? f)))) (testing "should create a temp file when given a prefix and suffix" (let [f (temp-file "foo" ".bar")] (is (fs/file? f)) (is (.startsWith (.getName f) "foo")) (is (.endsWith (.getName f) ".bar")))) (testing "should create a temp dir when not given a prefix" (let [d (temp-dir)] (is (fs/directory? d)))) (testing "should create a temp dir when given a prefix and suffix" (let [d (temp-dir "foo" ".bar")] (is (fs/directory? d)) (is (.startsWith (.getName d) "foo")) (is (.endsWith (.getName d) ".bar"))))) (deftest ini-parsing (testing "Parsing ini files" (testing "should work for a single file" (let [tf (temp-file)] (spit tf "[foo]\nbar=baz") (testing "when specified as a file object" (is (= (inis-to-map tf) {:foo {:bar "baz"}}))) (testing "when specified as a string" (is (= (inis-to-map (absolute-path tf)) {:foo {:bar "baz"}}))))) (testing "should work for a directory" (let [td (temp-dir)] (testing "when no matching files exist" (is (= (inis-to-map td) {}))) (let [tf (fs/file td "a-test.ini")] (spit tf "[foo]\nbar=baz")) (testing "when only a single matching file exists" (is (= (inis-to-map td) {:foo {:bar "baz"}}))) (let [tf (fs/file td "b-test.ini")] ;; Now add a second file (spit tf "[bar]\nbar=baz")) (testing "when multiple matching files exist" (is (= (inis-to-map td) {:foo {:bar "baz"} :bar {:bar "baz"}}))))))) (deftest cli-parsing (testing "Should throw an error if a required option is missing" (let [got-expected-error (atom false)] (try+ (cli! [] [["-r" "--required" "A required field"]] [:required]) (catch map? m (is (contains? m :kind)) (is (= :puppetlabs.kitchensink.core/cli-error (:kind m))) (is (= :cli-error (without-ns (:kind m)))) (is (contains? m :msg)) (reset! got-expected-error true))) (is (true? @got-expected-error)))) (testing "Should throw a help message if --help is provided" (let [got-expected-help (atom false)] (try+ (cli! ["--help"] [] []) (catch map? m (is (contains? m :kind)) (is (= :puppetlabs.kitchensink.core/cli-help (:kind m))) (is (= :cli-help (without-ns (:kind m)))) (is (contains? m :msg)) (reset! got-expected-help true))) (is (true? @got-expected-help)))) (testing "Should return options map, remaining args, and summary after parsing CLI args" (let [[cli-data remaining-args summary] (cli! ["-a" "1234 Sunny ave." "--greeting" "Hey, what's up?" "--toggle" "extra-arg"] [["-g" "--greeting GREETING" "A string to greet somebody"] ["-a" "--address ADDRESS" "Somebody's address"] ["-t" "--toggle" "A flag/boolean option"]] [])] (is (map? cli-data)) (is (= "1234 Sunny ave." (cli-data :address))) (is (= "Hey, what's up?" (cli-data :greeting))) (is (= true (cli-data :toggle))) (is (vector? remaining-args)) (is (= ["extra-arg"] remaining-args)) (is (= (str " -g, --greeting GREETING A string to greet somebody\n" " -a, --address ADDRESS Somebody's address\n" " -t, --toggle A flag/boolean option\n" " -h, --help Show help") summary)))) (testing "Errors reported by tools.cli should be thrown out of cli! as slingshot exceptions" (let [got-expected-exception (atom false)] (try+ (let [specs [["-f" "--foo FOO" "Something that is foo"]] args ["--bar"]] (cli! args specs)) (catch map? m (is (= :puppetlabs.kitchensink.core/cli-error (:kind m))) (is (contains? m :msg)) (is (re-find #"Unknown option.*--bar" (m :msg))) (reset! got-expected-exception true))) (is (true? @got-expected-exception))))) (deftest cert-utils (testing "extracting cn from a dn" (is (thrown? AssertionError (cn-for-dn 123)) "should throw error when arg is a number") (is (thrown? AssertionError (cn-for-dn nil)) "should throw error when arg is nil") (is (= (cn-for-dn "") nil) "should return nil when passed an empty string") (is (= (cn-for-dn "MEH=bar") nil) "should return nil when no CN is present") (is (= (cn-for-dn "cn=foo.bar.com") nil) "should return nil when CN present but lower case") (is (= (cn-for-dn "cN=foo.bar.com") nil) "should return nil when CN present but with mixed case") (is (= (cn-for-dn "CN=foo.bar.com") "foo.bar.com") "should work when only CN is present") (is (= (cn-for-dn "CN=foo.bar.com,OU=something") "foo.bar.com") "should work when more than just the CN is present") (is (= (cn-for-dn "CN=foo.bar.com,OU=something") "foo.bar.com") "should work when more than just the CN is present") (is (= (cn-for-dn "OU=something,CN=foo.bar.com") "foo.bar.com") "should work when more than just the CN is present and CN is last") (is (= (cn-for-dn "OU=something,CN=foo.bar.com,D=foobar") "foo.bar.com") "should work when more than just the CN is present and CN is in the middle") (is (= (cn-for-dn "CN=foo.bar.com,CN=goo.bar.com,OU=something") "goo.bar.com") "should use the most specific CN if multiple CN's are present"))) (deftest cert-whitelist-auth (testing "cert whitelist authorizer" (testing "should fail when whitelist is not given" (is (thrown? AssertionError (cn-whitelist->authorizer nil)))) (testing "should fail when whitelist is given, but not readable" (is (thrown? java.io.FileNotFoundException (cn-whitelist->authorizer "/this/does/not/exist")))) (testing "when whitelist is present" (let [whitelist (temp-file)] (spit whitelist "foo\nbar\n") (let [authorized? (cn-whitelist->authorizer whitelist)] (testing "should allow plain-text, HTTP requests" (is (authorized? {:scheme :http :ssl-client-cn "foobar"}))) (testing "should fail HTTPS requests without a client cert" (is (not (authorized? {:scheme :https})))) (testing "should reject certs that don't appear in the whitelist" (is (not (authorized? {:scheme :https :ssl-client-cn "goo"})))) (testing "should accept certs that appear in the whitelist" (is (authorized? {:scheme :https :ssl-client-cn "foo"})))))))) (deftest memoization (testing "with an illegal bound" (is (thrown? AssertionError (bounded-memoize identity -1))) (is (thrown? AssertionError (bounded-memoize identity 0))) (is (thrown? AssertionError (bounded-memoize identity 1.5))) (is (thrown? AssertionError (bounded-memoize identity "five")))) (testing "with a legal bound" (let [f (testutils/call-counter) memoized (bounded-memoize f 2)] (testing "should only call the function once per argument" (is (= (testutils/times-called f) 0)) (memoized 0) (is (= (testutils/times-called f) 1)) (memoized 0) (is (= (testutils/times-called f) 1)) (memoized 1) (is (= (testutils/times-called f) 2))) ;; We call it here for a hit, which we expect not to clear the cache, ;; then call it again to verify the cache wasn't cleared and therefore f ;; wasn't called (testing "should not clear the cache at max size on a hit" (memoized 1) (is (= (testutils/times-called f) 2)) (memoized 1) (is (= (testutils/times-called f) 2))) ;; Now call it with a new argument to clear the cache, then with an old ;; one to show f is called (testing "should clear the cache at max size on a miss" (memoized 2) (is (= (testutils/times-called f) 3)) (memoized 3) (is (= (testutils/times-called f) 4)))))) (deftest uuid-handling (testing "a generated uuid is a valid uuid" (is (uuid? (uuid)))) (testing "a phrase is not a uuid" (is (not (uuid? "Hello World"))))) (deftest jvm-versions (testing "comparing same versions should return 0" (is (= 0 (compare-jvm-versions "1.7.0_3" "1.7.0_3")))) (testing "comparing same versions should return 0, even with trailing fields" (is (= 0 (compare-jvm-versions "1.7.0_3" "1.7.0_3-beta3")))) (testing "should detect older versions" (is (neg? (compare-jvm-versions "1.7.0_0" "1.7.0_3"))) (is (neg? (compare-jvm-versions "1.7.0_0" "1.7.0_3-beta3"))) (is (neg? (compare-jvm-versions "1.7.0_2" "1.7.0_03"))) (is (neg? (compare-jvm-versions "1.6.0_3" "1.7.0_3"))) (is (neg? (compare-jvm-versions "1.6.0_2" "1.7.0_3"))) (is (neg? (compare-jvm-versions "0.6.0_2" "1.7.0_3")))) (testing "should detect newer versions" (is (pos? (compare-jvm-versions "1.7.0_13" "1.7.0_3"))) (is (pos? (compare-jvm-versions "1.8.0_3" "1.7.0_3"))) (is (pos? (compare-jvm-versions "1.8.0_3" "1.7.0_3-beta3"))) (is (pos? (compare-jvm-versions "2.7.0_3" "1.7.0_3"))) (is (pos? (compare-jvm-versions "1.7.0_10" "1.7.0_3"))))) (deftest some-pred->>-macro (testing "should thread all the way through if the pred never matches" (is (= 10 (some-pred->> nil? 1 (* 2) (+ 9) (dec))))) (testing "should break and return the value if the pred matches" (is (= {:a 1} (some-pred->> map? 5 (/ 5) (assoc {} :a) (keys)))))) (deftest while-let-macro (let [counter (atom 0) list (ArrayList.)] (dotimes [_ 5] (.add list "foo")) (let [iter (.iterator list)] (while-let [item (and (.hasNext iter) (.next iter))] (swap! counter inc))) (is (= 5 @counter)))) (deftest test-spit-ini (let [tf (temp-file)] (spit tf "[foo]\nbar=baz\n[bar]\nfoo=baz") (let [ini-map (ini-to-map tf)] (is (= ini-map {:foo {:bar "baz"} :bar {:foo "baz"}})) (testing "changing existing keys" (let [result-file (temp-file)] (spit-ini result-file (-> ini-map (assoc-in [:foo :bar] "baz changed") (assoc-in [:bar :foo] "baz also changed"))) (is (= {:foo {:bar "baz changed"} :bar {:foo "baz also changed"}} (ini-to-map result-file))))) (testing "adding a new section to an existing ini" (let [result-file (temp-file)] (spit-ini result-file (assoc-in ini-map [:baz :foo] "bar")) (is (= {:foo {:bar "baz"} :bar {:foo "baz"} :baz {:foo "bar"}} (ini-to-map result-file)))))))) (deftest duplicate-ini-entries (testing "duplicate settings" (let [tempfile (temp-file)] (spit tempfile "[foo]\nbar=baz\nbar=bizzle\n") (is (thrown-with-msg? IllegalArgumentException #"Duplicate configuration entry: \[:foo :bar\]" (ini-to-map tempfile)))) (let [tempdir (temp-dir) tempfile1 (fs/file tempdir "initest1.ini") tempfile2 (fs/file tempdir "initest2.ini")] (spit tempfile1 "[foo]\nsetting1=hi\nbar=baz\n") (spit tempfile2 "[foo]\nsetting2=hi\nbar=bizzle\n") (is (thrown-with-msg? IllegalArgumentException #"Duplicate configuration entry: \[:foo :bar\]" (inis-to-map tempdir))))) (testing "duplicate sections but no duplicate settings" (let [tempdir (temp-dir) tempfile1 (fs/file tempdir "initest1.ini") tempfile2 (fs/file tempdir "initest.ini")] (spit tempfile1 "[foo]\nsetting1=hi\nbar=baz\n") (spit tempfile2 "[foo]\nsetting2=hi\nbunk=bizzle\n") (is (= {:foo {:setting1 "hi" :bar "baz" :setting2 "hi" :bunk "bizzle"}} (inis-to-map tempdir)))))) (deftest timeout-test (let [wait-return (fn [time val] (Thread/sleep time) val)] (testing "with-timeout" (testing "does nothing if the body returns within the limit" (is (= true (with-timeout 1 false (wait-return 500 true))))) (testing "returns the default value if the body times out" (is (= false (with-timeout 1 false (wait-return 1005 true)))))))) (deftest open-port-num-test (let [port-in-use (open-port-num)] (with-open [s (java.net.ServerSocket. port-in-use)] (let [open-ports (set (take 60000 (repeatedly open-port-num)))] (is (every? pos? open-ports)) (is (not (contains? open-ports port-in-use))))))) (deftest assoc-if-new-test (testing "assoc-if-new assocs appropriately" (is (= {:a "foo"} (assoc-if-new {:a "foo"} :a "bar"))) (is (= {:a "bar" :b "foo"} (assoc-if-new {:b "foo"} :a "bar"))) (is (= {:a "foo" :b "bar"} (assoc-if-new {} :a "foo" :b "bar"))) (is (= {:a "foo" :b nil} (assoc-if-new {:b nil} :a "foo" :b "bar"))) (is (= {:a "foo" :b "baz"} (assoc-if-new {:b "baz"} :a "foo" :b "bar"))))) (deftest deref-swap-test (testing "deref-swap behaves as advertised" (let [a (atom 10) b (deref-swap! a inc)] (is (= 11 @a)) (is (= 10 b))))) (deftest parse-interval-test (are [x y] (= x (parse-interval y)) (t/seconds 11) "11s" (t/minutes 12) "12m" (t/hours 13) "13h" (t/days 14) "14d" (t/years 15) "15y" (t/seconds 0) "0" (t/seconds 10) "10" nil "15a" nil "h" nil "12hhh" nil "12H" nil "1,300y" nil "" nil nil)) clj-kitchensink-2.3.0/test/puppetlabs/kitchensink/json_test.clj000066400000000000000000000054421307352521100247520ustar00rootroot00000000000000(ns puppetlabs.kitchensink.json-test (:require [cheshire.generate :refer [remove-encoder]] [clj-time.core :as clj-time] [clojure.tools.logging :as log] [me.raynes.fs :as fs] [puppetlabs.kitchensink.core :refer [temp-file]]) (:import (java.io StringWriter StringReader)) (:use clojure.test puppetlabs.kitchensink.json)) (defn add-common-encoders-fixture [f] (add-common-json-encoders!*) (f)) (use-fixtures :once add-common-encoders-fixture) (deftest test-with-custom-datetime-encoder (testing "should allow use of custom encoder" (is (= (with-datetime-encoder (fn [dt gn8r] (.writeString gn8r "Beer-o-clock")) (generate-string (clj-time/date-time 1989 11 17 5 6 24 654))) "\"Beer-o-clock\"")))) (deftest test-generate-string (testing "should generate a json string" (is (= (generate-string {:a 1 :b 2}) "{\"a\":1,\"b\":2}"))) (testing "should generate a json string that has a Joda DataTime object in it and not explode" (is (= (generate-string {:a 1 :b (clj-time/date-time 1986 10 14 4 3 27 456)}) "{\"a\":1,\"b\":\"1986-10-14T04:03:27.456Z\"}")))) (deftest test-generate-pretty-string (testing "should generate a json string" (is (= (generate-pretty-string {:a 1 :b 2}) "{\n \"a\" : 1,\n \"b\" : 2\n}"))) (testing "should generate a json string that has a Joda DataTime object in it and not explode" (is (= (generate-pretty-string {:a 1 :b (clj-time/date-time 1986 10 14 4 3 27 456)}) "{\n \"a\" : 1,\n \"b\" : \"1986-10-14T04:03:27.456Z\"\n}")))) (deftest test-generate-stream (testing "should generate a json string from a stream" (let [sw (StringWriter.)] (generate-stream {:a 1 :b 2} sw) (is (= (.toString sw) "{\"a\":1,\"b\":2}"))))) (deftest test-generate-pretty-stream (testing "should generate a pretty printed json string from a stream" (let [sw (StringWriter.)] (generate-pretty-stream {:a 1 :b 2} sw) (is (= (.toString sw) "{\n \"a\" : 1,\n \"b\" : 2\n}"))))) (deftest test-parse-string (testing "should return a map from parsing a json string" (is (= (parse-string "{\"a\":1,\"b\":2}") {"a" 1 "b" 2})))) (deftest test-parse-stream (testing "should return map from parsing a json stream" (is (= (parse-stream (StringReader. "{\"a\":1,\"b\":2}")) {"a" 1 "b" 2})))) (deftest test-spit-json (let [json-out (temp-file "spit-json")] (testing "json output with keywords" (spit-json json-out {:a 1 :b 2}) (is (= "{\n \"a\" : 1,\n \"b\" : 2\n}" (slurp json-out)))) (testing "json output with strings" (spit-json json-out {"a" 1 "b" 2}) (is (= "{\n \"a\" : 1,\n \"b\" : 2\n}" (slurp json-out)))))) clj-kitchensink-2.3.0/test/puppetlabs/kitchensink/testutils.clj000066400000000000000000000014031307352521100247730ustar00rootroot00000000000000(ns puppetlabs.kitchensink.testutils (:require [me.raynes.fs :as fs] [puppetlabs.kitchensink.core :as ks])) (defn call-counter "Returns a method that just tracks how many times it's called, and with what arguments. That information is stored in metadata for the method." [] (let [ncalls (ref 0) arguments (ref [])] (with-meta (fn [& args] (dosync (alter ncalls inc) (alter arguments conj args))) {:ncalls ncalls :args arguments}))) (defn times-called "Returns the number of times a `call-counter` function has been invoked." [f] (deref (:ncalls (meta f)))) (defmacro with-no-jvm-shutdown-hooks [& body] `(with-redefs [ks/add-shutdown-hook! (fn [_#] nil)] ~@body)) clj-kitchensink-2.3.0/test/puppetlabs/kitchensink/testutils/000077500000000000000000000000001307352521100243035ustar00rootroot00000000000000clj-kitchensink-2.3.0/test/puppetlabs/kitchensink/testutils/fixtures.clj000066400000000000000000000006411307352521100266470ustar00rootroot00000000000000(ns puppetlabs.kitchensink.testutils.fixtures (:require [puppetlabs.kitchensink.core :as kitchensink])) (defn with-no-jvm-shutdown-hooks "Test fixture to prevent JVM shutdown hooks from being added. Only works if the shutdown hook is being added by a call to the utility function `puppetlabs.kitchensink.core/add-shutdown-hook!`." [f] (with-redefs [kitchensink/add-shutdown-hook! (fn [_] nil)] (f)))