[ { "path": ".gitignore", "content": ".cake\n.lein-repl-history\n.rebel_readline_history\npom.xml\npom.xml.asc\nrepl-port\n*.jar\n*.tar\n*.tar.bz2\n*.war\n*.deb\n*~\n.*.swp\n*.log\nlog.txt\nlib\nclasses\nbuild\n.lein-deps-sum\n.lein-failures\n/site\nsite/**\nbench/**\n*/target/**\n*/checkouts/**\n*/store/**\n*/report/**\n*/timeline.html\n*/resources/datomic/download-key\n*/resources/datomic/riak-transactor.properties\n*/.nrepl-port\n.idea\n*.iml\njepsen/doc\n.eastwood\ndocker/docker-compose.yml\n" }, { "path": ".travis.yml", "content": "language: clojure\nlein: lein\ndist: trusty\njdk:\n - oraclejdk8\nbranches:\n only:\n - master\naddons:\n apt:\n packages:\n - gnuplot\n - gnuplot-x11\nbefore_install:\n - cd ${TRAVIS_BUILD_DIR}/jepsen\nscript:\n - lein clean\n # Exclude namespaces importing rhizome.viz, because compiling those requires\n # X11. For full error message, see:\n # https://travis-ci.com/github/jepsen-io/jepsen/builds/161202862\n - lein eastwood '{:config-files [\".eastwood.clj\"], :exclude-namespaces [jepsen.tests.cycle.wr jepsen.tests.cycle.append]}'\n - lein test\nnotifications:\n email:\n on_success: never\n on_failure: never\n" }, { "path": "README.md", "content": "# Jepsen\n\nBreaking distributed systems so you don't have to.\n\nJepsen is a Clojure library. A test is a Clojure program which uses the Jepsen\nlibrary to set up a distributed system, run a bunch of operations against that\nsystem, and verify that the history of those operations makes sense. Jepsen has\nbeen used to verify everything from eventually-consistent commutative databases\nto linearizable coordination systems to distributed task schedulers. It can\nalso generate graphs of performance and availability, helping you characterize\nhow a system responds to different faults. See\n[jepsen.io](https://jepsen.io/analyses) for examples of the sorts of analyses\nyou can carry out with Jepsen.\n\n[![Clojars Project](https://img.shields.io/clojars/v/jepsen.svg)](https://clojars.org/jepsen)\n[![Build Status](https://travis-ci.com/jepsen-io/jepsen.svg?branch=main)](https://travis-ci.com/jepsen-io/jepsen)\n\n## Design Overview\n\nA Jepsen test runs as a Clojure program on a *control node*. That program uses\nSSH to log into a bunch of *db nodes*, where it sets up the distributed system\nyou're going to test using the test's pluggable *os* and *db*.\n\nOnce the system is running, the control node spins up a set of logically\nsingle-threaded *processes*, each with its own *client* for the distributed\nsystem. A *generator* generates new operations for each process to perform.\nProcesses then apply those operations to the system using their clients. The\nstart and end of each operation is recorded in a *history*. While performing\noperations, a special *nemesis* process introduces faults into the system--also\nscheduled by the generator.\n\nFinally, the DB and OS are torn down. Jepsen uses a *checker* to analyze the\ntest's history for correctness, and to generate reports, graphs, etc. The test,\nhistory, analysis, and any supplementary results are written to the filesystem\nunder `store///` for later review. Symlinks to the latest\nresults are maintained at each level for convenience.\n\n## Documentation\n\nThis [tutorial](doc/tutorial/index.md) walks you through writing a Jepsen test\nfrom scratch. An independent translation is available in [Chinese](https://jaydenwen123.gitbook.io/zh_jepsen_doc/).\n\nFor reference, see the [API documentation](http://jepsen-io.github.io/jepsen/).\n\n[What's Here](doc/whats-here.md) provides an overview of Jepsen's namespaces\nand how they work together.\n\n## Setting up a Jepsen Environment\n\nSo, you've got a Jepsen test, and you'd like to run it! Or maybe you'd like to\nstart learning how to write tests. You've got several options:\n\n### AWS\n\nIf you have an AWS account, you can launch a full Jepsen cluster---control and\nDB nodes---from the [AWS\nMarketplace](https://aws.amazon.com/marketplace/pp/Jepsen-LLC-Jepsen/B01LZ7Y7U0).\nClick \"Continue to Subscribe\", \"Continue to Configuration\", and choose\n\"CloudFormation Template\". You can choose the number of nodes you'd like to\ndeploy, adjust the instance types and disk sizes, and so on. These are full\nVMs, which means they can test clock skew.\n\nThe AWS marketplace clusters come with an hourly fee (generally $1/hr/node),\nwhich helps fund Jepsen development.\n\n### LXC\n\nYou can set up your DB nodes as LXC containers, and use your local machine as\nthe control node. See the [LXC documentation](doc/lxc.md) for guidelines. This\nmight be the easiest setup for hacking on tests: you'll be able to edit source\ncode, run profilers, etc on the local node. Containers don't have real clocks,\nso you generally can't use them to test clock skew.\n\n### VMs, Real Hardware, etc.\n\nYou should be able to run Jepsen against almost any machines which have:\n\n- A TCP network\n- An SSH server\n- Sudo or root access\n\nEach DB node should be accessible from the control node via SSH: you need to be\nable to run `ssh myuser@some-node`, and get a shell. By default, DB nodes are\nnamed n1, n2, n3, n4, and n5, but that (along with SSH username, password,\nidentity files, etc) is all definable in your test, or at the CLI. The account\nyou use on those boxes needs sudo access to set up DBs, control firewalls, etc.\n\nBE ADVISED: tests may mess with clocks, add apt repos, run killall -9 on\nprocesses, and generally break things, so you shouldn't, you know, point Jepsen\nat your prod machines unless you like to live dangerously, or you wrote the\ntest and know exactly what it's doing.\n\nNOTE: Most Jepsen tests are written with more specific requirements in\nmind---like running on Debian, using `iptables` for network manipulation, etc.\nSee the specific test code for more details.\n\n### Docker (Unsupported)\n\nThere is a [Docker Compose setup](/docker) for running a Jepsen cluster on a\nsingle machine. Sadly the Docker platform has been something of a moving\ntarget; this environment tends to break in new and exciting ways on various\nplatforms every few months. If you're a Docker whiz and can get this going\nreliably on Debian & OS X that's great--pull requests would be a big help.\n\nLike other containers Docker containers don't have real clocks--that means you\ngenerally can't use them to test clock skew.\n\n### Setting Up Control Nodes\n\nFor AWS and Docker installs, your control node comes preconfigured with all the\nsoftware you'll need to run most Jepsen tests. If you build your own control\nnode (or if you're using your local machine as a control node), you'll need a\nfew things:\n\n- A [JVM](https://openjdk.java.net/install/)---version 21 or higher.\n- JNA, so the JVM can talk to your SSH.\n- [Leiningen](https://leiningen.org/): a Clojure build tool.\n- [Gnuplot](http://www.gnuplot.info/): how Jepsen renders performance plots.\n- [Graphviz](https://graphviz.org/): how Jepsen renders transactional anomalies.\n\nOn Debian, try:\n\n```\nsudo apt install default-jdk libjna-java gnuplot graphviz\n```\n\n... to get the basic requirements in place. Debian's Leiningen packages are\nancient, so [download lein from the web instead](https://leiningen.org/).\n\n## Running a Test\n\nOnce you've got everything set up, you should be able to run `cd aerospike;\nlein test`, and it'll spit out something like\n\n```clj\nINFO jepsen.core - Analysis invalid! (ﾉಥ益ಥ）ﾉ ┻━┻\n\n{:valid? false,\n :counter\n {:valid? false,\n :reads\n [[190 193 194]\n [199 200 201]\n [253 255 256]\n ...}}\n```\n\n## Working With the REPL\n\nJepsen tests emit `.jepsen` files in the `store/` directory. You can use these\nto investigate a test at the repl. Run `lein repl` in the test directory (which\nshould contain `store...`, then load a test using `store/test`:\n\n```clj\nuser=> (def t (store/test -1))\n```\n\n-1 is the last test run, -2 is the second-to-last. 0 is the first, 1 is the\nsecond, and so on. You can also load a by the string directory name. As a handy\nshortcut, clicking on the title of a test in the web interface will copy its\npath to the clipboard.\n\n```clj\nuser=> (def t (store/test \"/home/aphyr/jepsen.etcd/store/etcd append etcdctl kill/20221003T124714.485-0400\"))\n```\n\nThese have the same structure as the test maps you're used to working with in\nJepsen, though without some fields that wouldn't make sense to serialize--no\n`:checker`, `:client`, etc.\n\n```clj\njepsen.etcd=> (:name t)\n\"etcd append etcdctl kill\"\njepsen.etcd=> (:ops-per-key t)\n200\n```\n\nThese test maps are also lazy: to speed up working at the REPL, they won't load\nthe history or results until you ask for them. Then they're loaded from disk\nand cached.\n\n```clj\njepsen.etcd=> (count (:history t))\n52634\n```\n\nYou can use all the usual Clojure tricks to introspect results and histories.\nHere's an aborted read (G1a) anomaly--we'll pull out the ops which wrote and\nread the aborted read:\n\n```clj\njepsen.etcd=> (def writer (-> t :results :workload :anomalies :G1a first :writer))\n#'jepsen.etcd/writer\njepsen.etcd=> (def reader (-> t :results :workload :anomalies :G1a first :op))\n#'jepsen.etcd/reader\n```\n\nThe writer appended 11 and 12 to key 559, but failed, returning a duplicate key\nerror:\n\n```clj\njepsen.etcd=> (:value writer)\n[[:r 559 nil] [:r 558 nil] [:append 559 11] [:append 559 12]]\njepsen.etcd=> (:error writer)\n[:duplicate-key \"rpc error: code = InvalidArgument desc = etcdserver: duplicate key given in txn request\"]\n```\n\nThe reader, however, observed a value for 559 beginning with 12!\n\n```clj\njepsen.etcd=> (:value reader)\n[[:r 559 [12]] [:r 557 [1]]]\n```\n\nLet's find all successful transactions:\n\n```clj\njepsen.etcd=> (def txns (->> t :history (filter #(and (= :txn (:f %)) (= :ok (:type %)))) (map :value)))\n#'jepsen.etcd/txns\n```\n\nAnd restrict those to just operations which affected key 559:\n\n```clj\njepsen.etcd=> (->> txns (filter (partial some (comp #{559} second))) pprint)\n([[:r 559 [12]] [:r 557 [1]]]\n [[:r 559 [12]] [:append 559 1] [:r 559 [12 1]]]\n [[:append 556 32]\n [:r 556 [1 18 29 32]]\n [:r 556 [1 18 29 32]]\n [:r 559 [12 1]]]\n [[:r 559 [12 1]]]\n [[:append 559 9] [:r 557 [1 5]] [:r 558 [1]] [:r 558 [1]]]\n [[:r 559 [12 1 9]] [:r 559 [12 1 9]]]\n [[:append 559 17]]\n [[:r 559 [12 1 9 17]] [:append 558 5]]\n [[:r 559 [12 1 9 17]]\n [:append 557 22]\n [:append 559 27]\n [:r 557 [1 5 12 22]]])\n```\n\nSure enough, no OK appends of 12 to key 559!\n\nYou'll find more functions for slicing-and-dicing tests in `jepsen.store`.\n\n## FAQ\n\n### JSCH auth errors\n\nIf you see `com.jcraft.jsch.JSchException: Auth fail`, this means something\nabout your test's `:ssh` map is wrong, or your control node's SSH environment\nis a bit weird.\n\n0. Confirm that you can ssh to the node that Jepsen failed to connect to. Try\n `ssh -v` for verbose information--pay special attention to whether it uses a\n password or private key.\n1. If you intend to use a username and password, confirm that they're specified\n correctly in your test's `:ssh` map.\n2. If you intend to log in with a private key, make sure your SSH agent is\n running.\n - `ssh-add -l` should show the key you use to log in.\n - If your agent isn't running, try launching one with `ssh-agent`.\n - If your agent shows no keys, you might need to add it with `ssh-add`.\n - If you're SSHing to a control node, SSH might be forwarding your local\n agent's keys rather than using those on the control node. Try `ssh -a` to\n disable agent forwarding.\n\nIf you've SSHed to a DB node already, you might also encounter a jsch bug which\ndoesn't know how to read hashed known_hosts files. Remove all keys for the DB\nhosts from your `known_hosts` file, then:\n\n```sh\nssh-keyscan -t rsa n1 >> ~/.ssh/known_hosts\nssh-keyscan -t rsa n2 >> ~/.ssh/known_hosts\nssh-keyscan -t rsa n3 >> ~/.ssh/known_hosts\nssh-keyscan -t rsa n4 >> ~/.ssh/known_hosts\nssh-keyscan -t rsa n5 >> ~/.ssh/known_hosts\n```\n\nto add unhashed versions of each node's hostkey to your `~/.ssh/known_hosts`.\n\n### SSHJ auth errors\n\nIf you get an exception like `net.schmizz.sshj.transport.TransportException:\nCould not verify 'ssh-ed25519' host key with fingerprint 'bf:4a:...' for 'n1'\non port 22`, but you're sure you've got the keys in your `~/.ssh/known-hosts`,\nthis is because (I think) SSHJ tries to verify only the ed25519 key and\n*ignores* the RSA key. You can add the ed25519 keys explicitly via:\n\n```sh\nssh-keyscan -t ed25519 n1 >> ~/.ssh/known_hosts\n...\n```\n\n## Other Projects\n\nAdditional projects that may be of interest:\n\n- [Jecci](https://github.com/michaelzenz/jecci): A wrapper framework around\n Jepsen\n- [Porcupine](https://github.com/anishathalye/porcupine): a linearizability\n checker written in Go.\n- [elle-cli](https://github.com/ligurio/elle-cli): command-line frontend to\n transactional consistency checkers for black-box databases.\n- [Tickloom](https://github.com/unmeshjoshi/tickloom): A deterministic-simulation framework for building distributed systems, with Jepsen integration for consistency checks.\n" }, { "path": "antithesis/.gitignore", "content": "/target\n/classes\n/checkouts\nprofiles.clj\npom.xml\npom.xml.asc\n*.jar\n*.class\n/.lein-*\n/.nrepl-port\n/.prepl-port\n.hgignore\n.hg/\n" }, { "path": "antithesis/CHANGELOG.md", "content": "# Change Log\nAll notable changes to this project will be documented in this file. This change log follows the conventions of [keepachangelog.com](https://keepachangelog.com/).\n\n## [Unreleased]\n### Changed\n- Add a new arity to `make-widget-async` to provide a different widget shape.\n\n## [0.1.1] - 2025-10-22\n### Changed\n- Documentation on how to make the widgets.\n\n### Removed\n- `make-widget-sync` - we're all async, all the time.\n\n### Fixed\n- Fixed widget maker to keep working when daylight savings switches over.\n\n## 0.1.0 - 2025-10-22\n### Added\n- Files from the new template.\n- Widget maker public API - `make-widget-sync`.\n\n[Unreleased]: https://sourcehost.site/your-name/antithesis/compare/0.1.1...HEAD\n[0.1.1]: https://sourcehost.site/your-name/antithesis/compare/0.1.0...0.1.1\n" }, { "path": "antithesis/LICENSE", "content": "Eclipse Public License - v 2.0\n\n THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE\n PUBLIC LICENSE (\"AGREEMENT\"). ANY USE, REPRODUCTION OR DISTRIBUTION\n OF THE PROGRAM CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT.\n\n1. DEFINITIONS\n\n\"Contribution\" means:\n\n a) in the case of the initial Contributor, the initial content\n Distributed under this Agreement, and\n\n b) in the case of each subsequent Contributor:\n i) changes to the Program, and\n ii) additions to the Program;\n where such changes and/or additions to the Program originate from\n and are Distributed by that particular Contributor. A Contribution\n \"originates\" from a Contributor if it was added to the Program by\n such Contributor itself or anyone acting on such Contributor's behalf.\n Contributions do not include changes or additions to the Program that\n are not Modified Works.\n\n\"Contributor\" means any person or entity that Distributes the Program.\n\n\"Licensed Patents\" mean patent claims licensable by a Contributor which\nare necessarily infringed by the use or sale of its Contribution alone\nor when combined with the Program.\n\n\"Program\" means the Contributions Distributed in accordance with this\nAgreement.\n\n\"Recipient\" means anyone who receives the Program under this Agreement\nor any Secondary License (as applicable), including Contributors.\n\n\"Derivative Works\" shall mean any work, whether in Source Code or other\nform, that is based on (or derived from) the Program and for which the\neditorial revisions, annotations, elaborations, or other modifications\nrepresent, as a whole, an original work of authorship.\n\n\"Modified Works\" shall mean any work in Source Code or other form that\nresults from an addition to, deletion from, or modification of the\ncontents of the Program, including, for purposes of clarity any new file\nin Source Code form that contains any contents of the Program. Modified\nWorks shall not include works that contain only declarations,\ninterfaces, types, classes, structures, or files of the Program solely\nin each case in order to link to, bind by name, or subclass the Program\nor Modified Works thereof.\n\n\"Distribute\" means the acts of a) distributing or b) making available\nin any manner that enables the transfer of a copy.\n\n\"Source Code\" means the form of a Program preferred for making\nmodifications, including but not limited to software source code,\ndocumentation source, and configuration files.\n\n\"Secondary License\" means either the GNU General Public License,\nVersion 2.0, or any later versions of that license, including any\nexceptions or additional permissions as identified by the initial\nContributor.\n\n2. GRANT OF RIGHTS\n\n a) Subject to the terms of this Agreement, each Contributor hereby\n grants Recipient a non-exclusive, worldwide, royalty-free copyright\n license to reproduce, prepare Derivative Works of, publicly display,\n publicly perform, Distribute and sublicense the Contribution of such\n Contributor, if any, and such Derivative Works.\n\n b) Subject to the terms of this Agreement, each Contributor hereby\n grants Recipient a non-exclusive, worldwide, royalty-free patent\n license under Licensed Patents to make, use, sell, offer to sell,\n import and otherwise transfer the Contribution of such Contributor,\n if any, in Source Code or other form. This patent license shall\n apply to the combination of the Contribution and the Program if, at\n the time the Contribution is added by the Contributor, such addition\n of the Contribution causes such combination to be covered by the\n Licensed Patents. The patent license shall not apply to any other\n combinations which include the Contribution. No hardware per se is\n licensed hereunder.\n\n c) Recipient understands that although each Contributor grants the\n licenses to its Contributions set forth herein, no assurances are\n provided by any Contributor that the Program does not infringe the\n patent or other intellectual property rights of any other entity.\n Each Contributor disclaims any liability to Recipient for claims\n brought by any other entity based on infringement of intellectual\n property rights or otherwise. As a condition to exercising the\n rights and licenses granted hereunder, each Recipient hereby\n assumes sole responsibility to secure any other intellectual\n property rights needed, if any. For example, if a third party\n patent license is required to allow Recipient to Distribute the\n Program, it is Recipient's responsibility to acquire that license\n before distributing the Program.\n\n d) Each Contributor represents that to its knowledge it has\n sufficient copyright rights in its Contribution, if any, to grant\n the copyright license set forth in this Agreement.\n\n e) Notwithstanding the terms of any Secondary License, no\n Contributor makes additional grants to any Recipient (other than\n those set forth in this Agreement) as a result of such Recipient's\n receipt of the Program under the terms of a Secondary License\n (if permitted under the terms of Section 3).\n\n3. REQUIREMENTS\n\n3.1 If a Contributor Distributes the Program in any form, then:\n\n a) the Program must also be made available as Source Code, in\n accordance with section 3.2, and the Contributor must accompany\n the Program with a statement that the Source Code for the Program\n is available under this Agreement, and informs Recipients how to\n obtain it in a reasonable manner on or through a medium customarily\n used for software exchange; and\n\n b) the Contributor may Distribute the Program under a license\n different than this Agreement, provided that such license:\n i) effectively disclaims on behalf of all other Contributors all\n warranties and conditions, express and implied, including\n warranties or conditions of title and non-infringement, and\n implied warranties or conditions of merchantability and fitness\n for a particular purpose;\n\n ii) effectively excludes on behalf of all other Contributors all\n liability for damages, including direct, indirect, special,\n incidental and consequential damages, such as lost profits;\n\n iii) does not attempt to limit or alter the recipients' rights\n in the Source Code under section 3.2; and\n\n iv) requires any subsequent distribution of the Program by any\n party to be under a license that satisfies the requirements\n of this section 3.\n\n3.2 When the Program is Distributed as Source Code:\n\n a) it must be made available under this Agreement, or if the\n Program (i) is combined with other material in a separate file or\n files made available under a Secondary License, and (ii) the initial\n Contributor attached to the Source Code the notice described in\n Exhibit A of this Agreement, then the Program may be made available\n under the terms of such Secondary Licenses, and\n\n b) a copy of this Agreement must be included with each copy of\n the Program.\n\n3.3 Contributors may not remove or alter any copyright, patent,\ntrademark, attribution notices, disclaimers of warranty, or limitations\nof liability (\"notices\") contained within the Program from any copy of\nthe Program which they Distribute, provided that Contributors may add\ntheir own appropriate notices.\n\n4. COMMERCIAL DISTRIBUTION\n\nCommercial distributors of software may accept certain responsibilities\nwith respect to end users, business partners and the like. While this\nlicense is intended to facilitate the commercial use of the Program,\nthe Contributor who includes the Program in a commercial product\noffering should do so in a manner which does not create potential\nliability for other Contributors. Therefore, if a Contributor includes\nthe Program in a commercial product offering, such Contributor\n(\"Commercial Contributor\") hereby agrees to defend and indemnify every\nother Contributor (\"Indemnified Contributor\") against any losses,\ndamages and costs (collectively \"Losses\") arising from claims, lawsuits\nand other legal actions brought by a third party against the Indemnified\nContributor to the extent caused by the acts or omissions of such\nCommercial Contributor in connection with its distribution of the Program\nin a commercial product offering. The obligations in this section do not\napply to any claims or Losses relating to any actual or alleged\nintellectual property infringement. In order to qualify, an Indemnified\nContributor must: a) promptly notify the Commercial Contributor in\nwriting of such claim, and b) allow the Commercial Contributor to control,\nand cooperate with the Commercial Contributor in, the defense and any\nrelated settlement negotiations. The Indemnified Contributor may\nparticipate in any such claim at its own expense.\n\nFor example, a Contributor might include the Program in a commercial\nproduct offering, Product X. That Contributor is then a Commercial\nContributor. If that Commercial Contributor then makes performance\nclaims, or offers warranties related to Product X, those performance\nclaims and warranties are such Commercial Contributor's responsibility\nalone. Under this section, the Commercial Contributor would have to\ndefend claims against the other Contributors related to those performance\nclaims and warranties, and if a court requires any other Contributor to\npay any damages as a result, the Commercial Contributor must pay\nthose damages.\n\n5. NO WARRANTY\n\nEXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, AND TO THE EXTENT\nPERMITTED BY APPLICABLE LAW, THE PROGRAM IS PROVIDED ON AN \"AS IS\"\nBASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER EXPRESS OR\nIMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR CONDITIONS OF\nTITLE, NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A PARTICULAR\nPURPOSE. Each Recipient is solely responsible for determining the\nappropriateness of using and distributing the Program and assumes all\nrisks associated with its exercise of rights under this Agreement,\nincluding but not limited to the risks and costs of program errors,\ncompliance with applicable laws, damage to or loss of data, programs\nor equipment, and unavailability or interruption of operations.\n\n6. DISCLAIMER OF LIABILITY\n\nEXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, AND TO THE EXTENT\nPERMITTED BY APPLICABLE LAW, NEITHER RECIPIENT NOR ANY CONTRIBUTORS\nSHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,\nEXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION LOST\nPROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN\nCONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)\nARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE\nEXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE\nPOSSIBILITY OF SUCH DAMAGES.\n\n7. GENERAL\n\nIf any provision of this Agreement is invalid or unenforceable under\napplicable law, it shall not affect the validity or enforceability of\nthe remainder of the terms of this Agreement, and without further\naction by the parties hereto, such provision shall be reformed to the\nminimum extent necessary to make such provision valid and enforceable.\n\nIf Recipient institutes patent litigation against any entity\n(including a cross-claim or counterclaim in a lawsuit) alleging that the\nProgram itself (excluding combinations of the Program with other software\nor hardware) infringes such Recipient's patent(s), then such Recipient's\nrights granted under Section 2(b) shall terminate as of the date such\nlitigation is filed.\n\nAll Recipient's rights under this Agreement shall terminate if it\nfails to comply with any of the material terms or conditions of this\nAgreement and does not cure such failure in a reasonable period of\ntime after becoming aware of such noncompliance. If all Recipient's\nrights under this Agreement terminate, Recipient agrees to cease use\nand distribution of the Program as soon as reasonably practicable.\nHowever, Recipient's obligations under this Agreement and any licenses\ngranted by Recipient relating to the Program shall continue and survive.\n\nEveryone is permitted to copy and distribute copies of this Agreement,\nbut in order to avoid inconsistency the Agreement is copyrighted and\nmay only be modified in the following manner. The Agreement Steward\nreserves the right to publish new versions (including revisions) of\nthis Agreement from time to time. No one other than the Agreement\nSteward has the right to modify this Agreement. The Eclipse Foundation\nis the initial Agreement Steward. The Eclipse Foundation may assign the\nresponsibility to serve as the Agreement Steward to a suitable separate\nentity. Each new version of the Agreement will be given a distinguishing\nversion number. The Program (including Contributions) may always be\nDistributed subject to the version of the Agreement under which it was\nreceived. In addition, after a new version of the Agreement is published,\nContributor may elect to Distribute the Program (including its\nContributions) under the new version.\n\nExcept as expressly stated in Sections 2(a) and 2(b) above, Recipient\nreceives no rights or licenses to the intellectual property of any\nContributor under this Agreement, whether expressly, by implication,\nestoppel or otherwise. All rights in the Program not expressly granted\nunder this Agreement are reserved. Nothing in this Agreement is intended\nto be enforceable by any entity that is not a Contributor or Recipient.\nNo third-party beneficiary rights are created under this Agreement.\n\nExhibit A - Form of Secondary Licenses Notice\n\n\"This Source Code may also be made available under the following\nSecondary Licenses when the conditions for such availability set forth\nin the Eclipse Public License, v. 2.0 are satisfied: GNU General Public\nLicense as published by the Free Software Foundation, either version 2\nof the License, or (at your option) any later version, with the GNU\nClasspath Exception which is available at\nhttps://www.gnu.org/software/classpath/license.html.\"\n\n Simply including a copy of this Agreement, including this Exhibit A\n is not sufficient to license the Source Code under Secondary Licenses.\n\n If it is not possible or desirable to put the notice in a particular\n file, then You may include the notice in a location (such as a LICENSE\n file in a relevant directory) where a recipient would be likely to\n look for such a notice.\n\n You may add additional accurate notices of copyright ownership.\n" }, { "path": "antithesis/README.md", "content": "# jepsen.antithesis\n\nThis library supports running Jepsen tests inside Antithesis environments. It\nprovides entropy, lifecycle hooks, and assertions.\n\n## Installation\n\n[![Clojars Project](https://img.shields.io/clojars/v/io.jepsen/antithesis.svg)](https://clojars.org/io.jepsen/antithesis)\n\nFrom Clojars, as usual. Note that the Antithesis SDK pulls in an ancient\nversion of Jackson and *needs it*, so in your `project.clj`, you'll likely want\nto prevent other dependencies from relying on Jackson:\n\n```clj\n :dependencies [...\n [io.jepsen/antithesis \"0.1.0\"]\n [jepsen \"0.3.10\"\n :exclusions [com.fasterxml.jackson.core/jackson-databind\n com.fasterxml.jackson.core/jackson-annotations\n com.fasterxml.jackson.core/jackson-core]]]\n\n```\n\n## Usage\n\nThe main namespace is [`jepsen.antithesis`](src/jepsen/antithesis.clj). There\nare several things you can do to integrate your test into Antithesis.\n\n### Randomness\n\nFirst, wrap the entire program in `(antithesis/with-rng ...)`. This does\nnothing in ordinary environments, but in Antithesis, it replaces the\njepsen.random RNG with the Antithesis SDK's entropy source.\n\n### Wrapping Tests\n\nSecond, wrap the entire test map with `(antithesis/test test)`. In an\nAntithesis run, this disables the OS, DB, and SSH connections.\n\n## Clients\n\nWrap your client in `(antithesis/client your-client)`. This client informs\nAntithesis that the setup is complete, and makes assertions about each\ninvocation and completion.\n\n## Checker\n\nYou can either make assertions (see below) by hand inside your checkers, or you\ncan wrap an existing checker in `(antithesis/checker \"some name\" checker)`.\nThis asserts that the checker's results are always `:valid? true`. You can also\nuse `antithesis/checker+` to traverse a tree of checkers, wrapping each one\nwith assertions.\n\n## Generator\n\nInstead of a time limit, you can limit your generator with something like:\n\n```clj\n(if (antithesis/antithesis?)\n (antithesis/early-termination-generator\n {:interval 100}\n my-gen)\n (gen/time-limit ... my-gen))\n```\n\nThis early-termination-generator flips a coin every 100 operations, deciding\nwhether to continue. This allows Antithesis to perform some long runs and some\nshort ones. I'm not totally sure whether this is a good idea yet, but it does\nseem to get us to much shorter reproducible histories.\n\n## Lifecycle\n\nIf you'd like to manage the lifecycle manually, you can Call `setup-complete!`\nonce the test is ready to begin--for instance, at the end of `Client/setup!`.\nCall `event!` to signal interesting things have happened.\n\n## Assertions\n\nAssertions begin with `assert-`, and take an expression, a message, and data\nto include if the assertion fails. For instance:\n\n```clj\n(assert-always! (not (db-corrupted?))\n \"DB corrupted\" {:db \"foo\"})\n```\n\nIdeally, you want to do these *during* the test run, so Antithesis can fail\nfast. Many checks can only be done with the full history, by the checker; for\nthese, assert test validity in the checker itself:\n\n```clj\n(defrecord MyChecker []\n (check [_ test history opts]\n ...\n (a/assert-always (true? valid?) \"checker valid\" a)\n {:valid? valid? ...}))\n```\n\n## License\n\nCopyright © Jepsen, LLC\n\nThis program and the accompanying materials are made available under the\nterms of the Eclipse Public License 2.0 which is available at\nhttps://www.eclipse.org/legal/epl-2.0.\n\nThis Source Code may also be made available under the following Secondary\nLicenses when the conditions for such availability set forth in the Eclipse\nPublic License, v. 2.0 are satisfied: GNU General Public License as published by\nthe Free Software Foundation, either version 2 of the License, or (at your\noption) any later version, with the GNU Classpath Exception which is available\nat https://www.gnu.org/software/classpath/license.html.\n" }, { "path": "antithesis/composer/check", "content": "#!/bin/bash\n\nset -e\n\nDIR=\"/tmp/jepsen/antithesis\"\nmkdir -p \"$DIR\"\n\nFIFO=\"${DIR}/check\"\n\n# Create a FIFO\n#echo \"$FIFO\"\nmkfifo \"$FIFO\"\n\n# And block on it\ncat \"$FIFO\"\n" }, { "path": "antithesis/composer/op", "content": "#!/bin/bash\n\nset -e\n\nDIR=\"/tmp/jepsen/antithesis\"\n\nmkdir -p \"$DIR\"\n\n# Pick a hopefully unique ID for this op\nID=\"$(date +%s.%N)-${$}\"\nFIFO=\"${DIR}/op-${ID}\"\n\n# Create a FIFO\n#echo \"$FIFO\"\nmkfifo \"$FIFO\"\n\n# And block on it\ncat \"$FIFO\"\n" }, { "path": "antithesis/doc/intro.md", "content": "# Introduction to antithesis\n\nTODO: write [great documentation](https://jacobian.org/writing/what-to-write/)\n" }, { "path": "antithesis/project.clj", "content": "(defproject io.jepsen/antithesis \"0.1.1-SNAPSHOT\"\n :description \"Support for running Jepsen inside Antithesis\"\n :url \"https://github.com/jepsen-io/jepsen\"\n :license {:name \"EPL-2.0 OR GPL-2.0-or-later WITH Classpath-exception-2.0\"\n :url \"https://www.eclipse.org/legal/epl-2.0/\"}\n :dependencies [[jepsen \"0.3.11\"\n ; Jepsen pulls in jackson 2.16, but the Antithesis SDK\n ; expects 2.2.3\n :exclusions [com.fasterxml.jackson.core/jackson-databind\n com.fasterxml.jackson.core/jackson-annotations\n com.fasterxml.jackson.core/jackson-core]]\n [com.antithesis/sdk \"1.4.4\"]]\n :java-source-paths [\"src\"]\n :javac-options [\"--release\" \"17\"]\n :repl-options {:init-ns jepsen.antithesis}\n :test-selectors {:default (fn [m]\n (not (:perf m)))\n :focus :focus\n :perf :perf})\n" }, { "path": "antithesis/src/jepsen/antithesis/Random.java", "content": "// A java.util.random which draws from Antithesis' SDK.\n\npackage jepsen.antithesis;\n\nimport java.util.Arrays;\nimport java.util.List;\nimport java.util.random.RandomGenerator;\n\npublic class Random implements RandomGenerator {\n public static List booleans = Arrays.asList(true, false);\n\n private final com.antithesis.sdk.Random r;\n\n public Random() {\n super();\n this.r = new com.antithesis.sdk.Random();\n }\n\n public long nextLong() {\n return r.getRandom();\n }\n\n public double nextDouble() {\n // Adapted from https://developer.classpath.org/doc/java/util/Random-source.html nextDouble\n // We're generating doubles in the range 0..1, so we have only the 53 bits\n // of mantissa to generate\n final long mantissa = r.getRandom() >>> (64-53);\n return mantissa / (double) (1L << 53);\n }\n\n public boolean nextBoolean() {\n return r.randomChoice(booleans);\n }\n\n public T randomChoice(List list) {\n return r.randomChoice(list);\n }\n}\n" }, { "path": "antithesis/src/jepsen/antithesis/composer.clj", "content": "(ns jepsen.antithesis.composer\n \"Antithesis' Test Composer drives Jepsen by calling shell scripts, which\n communicate with the test via a control directory full of FIFOs. Each FIFO\n represents a single test composer action. They work like this:\n\n 1. Test composer calls a script to do something.\n 2. Script creates a fifo like /run/jepsen/op-1234, and blocks on it.\n 3. Jepsen, watching /run/jepsen, detects the new fifo\n 4. Jepsen fires off an invocation\n 5. The operation completes\n 6. Jepsen writes the results of the operation to /run/jepsen/invoke_1234\n 7. Jepsen closes the FIFO\n 8. The shell script prints the results out and exits\n 9. The test composer receives the results\n\n The types of commands are:\n\n - `op-123`: Runs a single operation from the generator\n - `check`: Wraps up the test's :generator, runs :final-generator, and\n checks the history.\n\n This namespace provides the Jepsen-side infrastructure for watching the FIFO\n directory, a test runner like `jepsen.core/run!`, and a CLI command called\n `antithesis` which works like `test`, but uses our runner instead.\"\n (:refer-clojure :exclude [run!])\n (:require [bifurcan-clj [core :as b]\n [map :as bm]]\n [clj-commons.slingshot :refer [try+ throw+]]\n [clojure [string :as str]]\n [clojure.java.io :as io]\n [clojure.tools.logging :refer [info warn fatal]]\n [dom-top.core :refer []]\n [fipp.edn :refer [pprint]]\n [jepsen [core :as jepsen]\n [checker :as checker]\n [cli :as cli]\n [client :as client]\n [generator :as gen]\n [history :as h]\n [store :as store]\n [util :as util :refer [with-thread-name\n relative-time-nanos\n real-pmap\n fcatch]]]\n [jepsen.generator [interpreter :as gi]\n [context :as gc]]\n [jepsen.store.format :as store.format]\n [potemkin :refer [definterface+]])\n (:import (java.io IOException)\n (java.util.concurrent ArrayBlockingQueue\n BlockingQueue\n TimeUnit)\n (io.lacuna.bifurcan ISet\n Set)\n (java.nio.file FileSystems\n Path\n StandardWatchEventKinds\n WatchEvent\n WatchEvent$Kind\n WatchService)))\n\n(def fifo-dir\n \"The directory where we watch for fifo operations.\"\n \"/tmp/jepsen/antithesis\")\n\n(definterface+ IFifoOp\n (complete-fifo-op! [this ^long status out]\n \"Completes this operation with the given exit status (ignored) and\n stdout, which is printed to the FIFO.\"))\n\n(defrecord FifoOp [name ^Path path]\n IFifoOp\n (complete-fifo-op! [this status out]\n (try\n (spit (.toFile path) out)\n :completed\n (catch IOException e\n (condp re-find (.getMessage e)\n ; Whoever invoked this op stopped waiting for a response!\n #\"Broken pipe\"\n :broken-pipe\n\n (throw e))))))\n\n(defn ^BlockingQueue fifo-queue\n \"Constructs a queue full of pending FIFO operations. The fifo watcher writes\n to this queue, and the interpreter reads from it, completing its promises.\"\n []\n ; Fine, whatever.\n (ArrayBlockingQueue. 64))\n\n(defn ^WatchService fifo-watcher!\n \"Takes a test, and launches a future which watches the FIFO directory for new\n files. Each new file results in a FifoOp delivered to `(:fifo-queue test)`.\n Creates the directory if it does not exist. Always empties directory before\n watching.\"\n [test]\n ; Ensure FIFO dir exists\n (.mkdirs (io/file fifo-dir))\n ; Clear it out\n (->> fifo-dir io/file file-seq next (mapv io/delete-file))\n\n (let [fs (FileSystems/getDefault)\n fifo-dir-path (.getPath fs fifo-dir (make-array String 0))\n ^BlockingQueue queue (:fifo-queue test)]\n (future\n (with-thread-name \"Jepsen FIFO watcher\"\n (with-open [watch-service (.newWatchService fs)]\n (let [kinds (into-array [StandardWatchEventKinds/ENTRY_CREATE])\n watch-key (.register fifo-dir-path watch-service kinds)]\n (info \"Waiting for FIFOs in\" fifo-dir)\n (loop []\n (let [key (.take watch-service)]\n (doseq [event (.pollEvents key)]\n (condp = (.kind event)\n StandardWatchEventKinds/OVERFLOW\n (do (fatal \"Couldn't keep up with FIFOs!\")\n (System/exit 1))\n\n StandardWatchEventKinds/ENTRY_CREATE\n (let [^Path path (.context ^WatchEvent event)\n ; This seems to come out as just a relative path, but\n ; ???\n short-name (str (.getName path\n (dec (.getNameCount path))))\n full-path (.resolve fifo-dir-path path)\n op (FifoOp. short-name full-path)]\n (.put queue op))))\n (if (.reset key)\n (recur)\n ; No longer registered\n :no-longer-registered)))))))))\n\n(defmacro with-fifo-watcher!\n \"Opens a fifo watcher for the duration of the body, and terminates it when\n the body completes.\"\n [test & body]\n `(let [watcher# (fifo-watcher! ~test)]\n (try ~@body\n (finally (future-cancel watcher#)))))\n\n;; Generator support.\n\n(defrecord MainGen [gen]\n gen/Generator\n (op [this test ctx]\n (if-let [phase (:antithesis-phase test)]\n (when (identical? :main @phase)\n (when-let [[op gen'] (gen/op gen test ctx)]\n [op (MainGen. gen')]))\n ; Not in a test-composer run.\n (gen/op gen test ctx)))\n\n (update [this test ctx event]\n (MainGen. (gen/update gen test ctx event))))\n\n(defn main-gen\n \"We need a way to terminate the regular generator and move to the final\n generator. However, the regular generator and final generator may be\n *wrapped* in some kind of state-tracking generator which allows context to\n pass from one to the other--and we don't have a way to reach inside that\n single generator and trigger a flip.\n\n This generator is intended to be called by the test author, and wraps the\n main phase generator. It uses an atom, stored in the test: :antithesis-phase.\n This generator emits operations so long as the phase `:main`. Otherwise it\n emits `nil`, which forces any composed generator using this to proceed to the\n next phase--presumably, the final generator before checking.\n\n In non-antithesis environments, this wrapper has no effect.\"\n [gen]\n (MainGen. gen))\n\n;; Interpreter. This is adapted from jepsen.generator.interpreter, but uses\n;; different control flow at the top level, because we're driven by the\n;; *external* FIFO watcher, not by the generator directly.\n\n(def max-pending-interval\n ; When the generator is :pending, this is how long we'll wait before looking\n ; at the generator again. In Antithesis, spinning tightly on the generator\n ; looks busy and can prevent Antithesis from doing actual operations, so we\n ; wait a full millisecond here instead.\n 1000)\n\n(defn interpret!\n \"Borrowed from jepsen.generator.interpreter, with adaptations for our FIFO\n queue. Notably, the test now contains a :fifo-queue, which delivers\n InterpreterMsgs to the interpreter thread. These messages are of two types:\n\n :op Perform a single operation from the (presumably main phase) of the\n generator. Delivers the [invoke, complete] pair to the message's\n promise when done.\n\n :check Enters the final phase of the generator. Flips test-phase to\n :final, and consumes generator operations as quickly as possible\n to perform the final phase. When these operations are exhausted,\n the interpreter returns, triggering the final analysis.\n\n Takes a test with a :store :handle open. Causes the test's reference to the\n :generator to be forgotten, to avoid retaining the head of infinite seqs.\n Opens a writer for the test's history using that handle. Creates an initial\n context from test and evaluates all ops from (:gen test). Spawns a thread for\n each worker, and hands those workers operations from gen; each thread applies\n the operation using (:client test) or (:nemesis test), as appropriate.\n Invocations and completions are journaled to a history on disk. Returns a new\n test with no :generator and a completed :history.\n\n Generators are automatically wrapped in friendly-exception and validate.\n Clients are wrapped in a validator as well.\n\n Automatically initializes the generator system, which, on first invocation,\n extends the Generator protocol over some dynamic classes like (promise).\"\n [test]\n (gen/init!)\n (with-open [history-writer (store.format/test-history-writer!\n (:handle (:store test))\n test)]\n (let [ctx (gen/context test)\n worker-ids (gen/all-threads ctx)\n ^BlockingQueue fifo-queue (:fifo-queue test)\n _ (assert (instance? BlockingQueue fifo-queue))\n completions (ArrayBlockingQueue.\n (.size ^ISet worker-ids))\n workers (mapv (partial gi/spawn-worker test completions\n (gi/client-nemesis-worker))\n worker-ids)\n invocations (into {} (map (juxt :id :in) workers))\n gen (->> (:generator test)\n deref\n gen/friendly-exceptions\n gen/validate)\n phase (:antithesis-phase test)\n ; Forget generator\n _ (util/forget! (:generator test))\n test (dissoc test :generator)]\n ; HERE\n (try+\n (loop [ctx ctx\n gen gen\n op-index 0 ; Index of the next op in the history\n outstanding 0 ; Number of in-flight ops\n ; How long to poll on the completion queue, in micros.\n poll-timeout 0\n ; The FifoOp each thread is processing\n fifo-ops (b/linear bm/empty)\n ; How long to poll on the fifo queue, in micros\n fifo-timeout max-pending-interval]\n ; First, can we complete an operation? We want to get to these first\n ; because they're latency sensitive--if we wait, we introduce false\n ; concurrency.\n (if-let [op' (.poll completions poll-timeout TimeUnit/MICROSECONDS)]\n (let [;_ (prn :completed op')\n thread (gen/process->thread ctx (:process op'))\n time (util/relative-time-nanos)\n ; Update op with index and new timestamp\n op' (assoc op' :index op-index :time time)\n ; Update context with new time and thread being free\n ctx (gc/free-thread ctx time thread)\n ; Let generator know about our completion. We use the context\n ; with the new time and thread free, but *don't* assign a new\n ; process here, so that thread->process recovers the right\n ; value for this event.\n gen (gen/update gen test ctx op')\n ; Threads that crash (other than the nemesis), or which\n ; explicitly request a new process, should be assigned new\n ; process identifiers.\n ctx (if (and (not= :nemesis thread)\n (or (= :info (:type op'))\n (:end-process? op')))\n (gc/with-next-process ctx thread)\n ctx)\n ; The FifoOp to complete\n fifo-op (bm/get fifo-ops thread nil)\n fifo-ops (bm/remove fifo-ops thread)]\n ; Log completion and move on\n (if (gi/goes-in-history? op')\n (do (store.format/append-to-big-vector-block!\n history-writer op')\n (when fifo-op (complete-fifo-op! fifo-op 0 (pr-str op')))\n (recur ctx gen (inc op-index) (dec outstanding) 0 fifo-ops\n fifo-timeout))\n (do (when fifo-op (complete-fifo-op! fifo-op 0 (pr-str op')))\n (recur ctx gen op-index (dec outstanding) 0 fifo-ops\n fifo-timeout))))\n\n ; There's nothing to complete; let's see what the generator's up to\n (let [time (util/relative-time-nanos)\n ctx (assoc ctx :time time)\n [op gen'] (gen/op gen test ctx)]\n ;(info :op op)\n (cond\n ; We're exhausted, but workers might still be going.\n (nil? op)\n (if (pos? outstanding)\n ; Still waiting on workers\n (recur ctx gen op-index outstanding\n (long max-pending-interval) fifo-ops\n fifo-timeout)\n ; Good, we're done. Tell workers to exit...\n (do (doseq [[thread queue] invocations]\n (.put ^ArrayBlockingQueue queue {:type :exit}))\n ; Wait for exit\n (dorun (map (comp deref :future) workers))\n ; Await completion of writes\n (.close history-writer)\n ; And return history\n (let [history-block-id (:block-id history-writer)\n history\n (-> (:handle (:store test))\n (store.format/read-block-by-id\n history-block-id)\n :data\n (h/history {:dense-indices? true\n :have-indices? true\n :already-ops? true}))]\n (assoc test :history history))))\n\n ; Nothing we can do right now. Let's try to complete something.\n (identical? :pending op)\n (recur ctx gen op-index\n outstanding (long max-pending-interval) fifo-ops\n fifo-timeout)\n\n ; Good, the generator has an invocation for us.\n\n ; But... it's in the future, so we have to wait.\n (< time (:time op))\n (recur ctx gen op-index outstanding\n ; Unless something changes, we don't need to ask\n ; the generator for another op until it's time.\n (long (/ (- (:time op) time) 1000))\n fifo-ops\n fifo-timeout)\n\n ; We have an invocation and it's ready.\n true\n ; We need to wait for a FIFO op to release us.\n (let [fifo-op (when (identical? :main @phase)\n ; Once we're done with the main phase, we don't\n ; care about FIFO ops any more.\n (.poll fifo-queue fifo-timeout\n TimeUnit/MICROSECONDS))]\n (cond\n ; As a special case, the fifo op \"check\" ends the main\n ; phase.\n (= \"check\" (:name fifo-op))\n ; Gosh this is a gross hack. We're just going to shove the\n ; fifo op into the phase, so it can be completed when the\n ; checker is done.\n (do (info \"Antithesis requested check; main phase ending...\")\n (reset! phase fifo-op)\n (recur ctx gen op-index outstanding poll-timeout\n fifo-ops 0))\n\n ; We're in the main phase and are still waiting on the\n ; FIFO. Let's switch gears and check for a completion op.\n (and (identical? :main @phase)\n (nil? fifo-op))\n (recur ctx gen op-index outstanding\n (long max-pending-interval)\n fifo-ops\n (long max-pending-interval))\n\n ; We're either no longer in the main phase, or we are, and\n ; have a fifo op. Let's invoke!\n true\n (let [thread (gen/process->thread ctx (:process op))\n op (assoc op :index op-index)\n ; Log the invocation\n goes-in-history? (gi/goes-in-history? op)\n _ (when goes-in-history?\n (store.format/append-to-big-vector-block!\n history-writer op))\n op-index' (if goes-in-history? (inc op-index) op-index)\n ; Dispatch it to a worker\n _ (.put ^ArrayBlockingQueue (get invocations thread) op)\n ; Update our context to reflect\n ctx (gc/busy-thread ctx\n (:time op) ; Use time instead?\n thread)\n ; Let the generator know about the invocation\n gen' (gen/update gen' test ctx op)\n ; Remember that this thread is servicing this fifo op\n fifo-ops' (bm/put fifo-ops thread fifo-op)]\n (recur ctx gen' op-index' (inc outstanding) 0 fifo-ops'\n fifo-timeout))))))))\n\n (catch Throwable t\n ; We've thrown, but we still need to ensure the workers exit.\n (info \"Shutting down workers after abnormal exit\")\n ; We only try to cancel each worker *once*--if we try to cancel\n ; multiple times, we might interrupt a worker while it's in the\n ; finally block, cleaning up its client.\n (dorun (map (comp future-cancel :future) workers))\n ; If for some reason *that* doesn't work, we ask them all to exit via\n ; their queue.\n (loop [unfinished workers]\n (when (seq unfinished)\n (let [{:keys [in future] :as worker} (first unfinished)]\n (if (future-done? future)\n (recur (next unfinished))\n (do (.offer ^java.util.Queue in {:type :exit})\n (recur unfinished))))))\n (throw t))))))\n\n(defn run-case!\n \"Takes a test with a store handle. Spawns nemesis and clients, runs the\n generator, and returns test with no :generator and a completed :history.\"\n [test]\n (jepsen/with-client+nemesis-setup-teardown [test test]\n (interpret! test)))\n\n(defn notify-test-checked!\n \"Complets the final check fifo op once the test is complete. Returns test\n unchanged.\"\n [test antithesis-phase]\n (let [fifo-op @antithesis-phase]\n (when (instance? IFifoOp fifo-op)\n (complete-fifo-op! fifo-op 0 \"checked\")))\n test)\n\n(defn run!\n \"Runs a test, taking direction from fifo-watcher. See jepsen.core/run!\"\n [test]\n (with-thread-name \"jepsen test runner\"\n (let [antithesis-phase (atom :main)\n test (-> test\n jepsen/prepare-test\n (assoc :antithesis-phase antithesis-phase\n :fifo-queue (fifo-queue))\n (update :nonserializable-keys conj\n :antithesis-phase\n :fifo-queue))]\n (jepsen/with-logging test\n (store/with-handle [test test]\n ; Initial save\n (let [test (store/save-0! test)]\n (util/with-relative-time\n (with-fifo-watcher! test\n (let [test (-> (run-case! test)\n ; Remove state\n (dissoc :barrier\n :sessions\n :antithesis-phase))\n _ (info \"Run complete, writing\")]\n (-> test\n store/save-1!\n jepsen/analyze!\n jepsen/log-results\n (notify-test-checked! antithesis-phase)))))))))))\n\n(defn antithesis-cmd\n \"A command package for jepsen.cli. Provides a new command, `lein run\n antithesis`, which works like `lein run test`, but uses the Antithesis test\n composer to drive execution. Options:\n\n {:opt-spec A vector of additional options for tools.cli. Merge into\n `test-opt-spec`. Optional.\n :opt-fn A function which transforms parsed options. Composed after\n `test-opt-fn`. Optional.\n :opt-fn* Replaces test-opt-fn, in case you want to override it\n altogether.\n :usage Defaults to `jc/test-usage`. Optional.\n :test-fn A function that receives the option map and constructs a test.}\"\n [opts]\n (let [opt-spec (cli/merge-opt-specs cli/test-opt-spec (:opt-spec opts))\n opt-fn (or (:opt-fn* opts) cli/test-opt-fn)\n test-fn (:test-fn opts)]\n {\"antithesis\"\n {:opt-spec opt-spec\n :opt-fn opt-fn\n :usage (:usage opts cli/test-usage)\n :run (fn [{:keys [options]}]\n (info \"Test options:\\n\"\n (with-out-str (pprint options)))\n (let [test (run! (test-fn options))]\n (case (:valid? (:results test))\n false (System/exit 1)\n :unknown (System/exit 2)\n nil)))}}))\n" }, { "path": "antithesis/src/jepsen/antithesis.clj", "content": "(ns jepsen.antithesis\n \"Provides support for running Jepsen tests in Antithesis. Provides an RNG,\n lifecycle hooks, and assertions.\n\n ## Randomness\n\n You should wrap your entire program in `(with-rng ...)`. This does nothing in\n ordinary environments, but in Antithesis, it replaces the jepsen.random RNG\n with one powered by Antithesis.\n\n ## Lifecycle\n\n Call `setup-complete!` once the test is ready to begin--for instance, at the\n end of Client/setup. Call `event!` to signal interesting things have\n happened.\n\n ## Assertions\n\n Assertions begin with `assert-`, and take an expression, a message, and data\n to include if the assertion fails. For instance:\n\n (assert-always! (not (db-corrupted?)) \\\"DB corrupted\\\" {:db \\\"foo\\\"})\n\n ## Wrappers\n\n Wrap your test map in `(a/test test-map)`. This wraps both the client and\n checkers with Antithesis instrumentation. You can also do this selectively\n using `checker` and `client`.\"\n (:refer-clojure :exclude [test])\n (:require [clojure [pprint :refer [pprint]]\n [string :as str]]\n [clojure.java.io :as io]\n [clojure.tools.logging :refer [info]]\n [jepsen [checker :as checker]\n [client :as client]\n [db :as db]\n [generator :as gen]\n [os :as os]\n [random :as rand]])\n (:import (com.antithesis.sdk Assert\n Lifecycle)\n (com.fasterxml.jackson.databind ObjectMapper)\n (com.fasterxml.jackson.databind.node ArrayNode\n ObjectNode)\n (java.io Writer)\n (java.util.random RandomGenerator\n RandomGenerator$SplittableGenerator)\n (jepsen.antithesis Random)))\n\n(def ^ObjectMapper om (ObjectMapper.))\n\n(defprotocol ToJsonNode\n (->json-node [x] \"Coerces x to a Jackson JsonNode.\"))\n\n(extend-protocol ToJsonNode\n clojure.lang.IPersistentMap\n (->json-node [x]\n (reduce (fn [^ObjectNode n, [k v]]\n ; my kingdom for a JSON with non-string keys\n (.put n\n (if (instance? clojure.lang.Named k)\n (name k)\n (str k))\n (->json-node v))\n n)\n (.createObjectNode om)\n x))\n\n clojure.lang.IPersistentSet\n (->json-node [x]\n (reduce (fn [^ArrayNode a, e]\n (.add a (->json-node e)))\n (.createArrayNode om)\n x))\n\n clojure.lang.Sequential\n (->json-node [x]\n (reduce (fn [^ArrayNode a, e]\n (.add a (->json-node e)))\n (.createArrayNode om)\n x))\n\n clojure.lang.Keyword\n (->json-node [x]\n (name x))\n\n clojure.lang.BigInt\n (->json-node [x]\n ; Weirdly Jackson takes bigdecimals but not bigintegers\n (bigdec x))\n\n java.lang.Number\n (->json-node [x] x)\n\n java.lang.String\n (->json-node [x] x)\n\n java.lang.Boolean\n (->json-node [x] x)\n\n nil\n (->json-node [x] nil))\n\n(let [d (delay (System/getenv \"ANTITHESIS_OUTPUT_DIR\"))]\n (defn dir\n \"The Antithesis SDK directory, if present, or nil.\"\n []\n @d)\n\n (defn log-file\n \"The Antithesis log file we write JSON to, or nil.\"\n []\n (when-let [d @d]\n (str d \"/sdk.jsonl\"))))\n\n(defn antithesis?\n \"Are we running in an Antithesis environment?\"\n []\n (boolean (dir)))\n\n;; Randomness\n\n(defn replacement-double-weighted-index\n \"Antithesis replacement for jepsen.random/double-weighted-index. Takes a\n double array, and picks a random index into it.\"\n (^long [^doubles weights]\n (replacement-double-weighted-index 0.0 weights))\n (^long [^double total-weight ^doubles weights]\n (.randomChoice ^Random rand/rng (range (alength weights)))))\n\n(def choice-cardinality\n \"When selecting long values, we consider something an Antithesis \\\"choice\\\"\n if it asks for at most this many elements.\"\n 16)\n\n(defn replacement-long\n \"Antithesis replacement for `jepsen.random/long`. Mostly equivalent to the\n original, but when there are less than `choice-cardinality` options, hints to\n Antithesis that we're making a specific choice.\"\n (^long [] (.nextLong rand/rng))\n (^long [^long upper]\n (if (< 0 upper choice-cardinality)\n (.randomChoice ^Random rand/rng (range upper))\n (.nextLong rand/rng upper)))\n (^long [^long lower, ^long upper]\n (if (< 0 (- upper lower) choice-cardinality)\n (.randomChoice ^Random rand/rng (range lower upper))\n (.nextLong rand/rng lower upper))))\n\n(defn replacement-bool\n \"Antithesis replacement for `jepsen.random/bool`. Uses Antithesis choices\n when probabilities are closer to chance than choice-cardinality.\"\n ([] (.nextBoolean ^Random rand/rng))\n ([^double p]\n (if (< (/ choice-cardinality)\n p\n (- 1 (/ choice-cardinality)))\n (.nextBoolean ^Random rand/rng)\n (< (rand/double) p))))\n\n(defmacro with-rng\n \"When running in an Antithesis environment, replaces Jepsen's random source\n with an Antithesis-controlled source. You should wrap your top-level program\n in this.\"\n [& body]\n `(rand/with-rng (if (antithesis?)\n (Random.)\n rand/rng)\n (with-redefs [jepsen.random/double-weighted-index\n (if (antithesis?)\n replacement-double-weighted-index\n rand/double-weighted-index)\n\n jepsen.random/long\n (if (antithesis?)\n replacement-long\n rand/long)\n\n jepsen.random/bool\n (if (antithesis?)\n replacement-bool\n rand/bool)]\n ~@body)))\n\n;; Lifecycle\n\n(defn setup-complete!\n \"Logs that we've started up. Only emits once per JVM run. Optionally takes a\n JSON-coerceable structure with details.\"\n ([]\n (setup-complete! nil))\n ([details]\n (Lifecycle/setupComplete (->json-node details))))\n\n(defn event!\n \"Logs that we've reached a specific event. Takes a string name and an\n optional JSON-coerceable details map.\"\n ([name]\n (event! name nil))\n ([name details]\n (Lifecycle/sendEvent name (->json-node details))))\n\n;; Assertions\n\n(defmacro assert-always\n \"Asserts that expr is true every time, and that it's called at least once.\n Takes a map of data which is serialized to JSON.\"\n [expr message data]\n `(Assert/always (boolean ~expr)\n ~message\n (->json-node ~data)))\n\n(defmacro assert-always-or-unreachable\n \"Asserts that expr is true every time. Passes even if the assertion never\n triggers.\"\n [expr message data]\n `(Assert/alwaysOrUnreachable (boolean ~expr)\n ~message\n (->json-node ~data)))\n\n(defmacro assert-sometimes\n \"Asserts that expr is true at least once, and that this assertion is reached.\"\n [expr message data]\n `(Assert/sometimes (boolean ~expr)\n ~message\n (->json-node ~data)))\n\n(defmacro assert-unreachable\n \"Asserts that this line of code is never reached.\"\n [message data]\n `(Assert/unreachable ~message (->json-node ~data)))\n\n(defmacro assert-reachable\n \"Asserts that this line of code is reached at least once.\"\n [message data]\n `(Assert/reachable ~message (->json-node ~data)))\n\n;; Client\n\n(defrecord Client [client]\n client/Client\n (open! [this test node]\n (Client. (client/open! client test node)))\n\n (setup! [this test]\n (let [r (client/setup! client test)]\n (setup-complete!)\n r))\n\n (invoke! [this test op]\n ; Every Jepsen run should do at *least* one invocation. We emit one of\n ; these for each kind of :f the client does. TODO: I'm not sure if we\n ; should provide details or not.\n ;\n ; TODO: is it acceptable for us to runtime generate the name for this\n ; assertion? My guess is that whatever magic instrumentation Antithesis'\n ; SDK is doing might expect compile-time constants here, but the SDK docs\n ; don't say.\n (assert-reachable (str \"invoke \" (pr-str (:f op))) {})\n (let [op' (client/invoke! client test op)]\n ; We'd like at least one invocation to succeed.\n ;\n ; TODO: is this OK? It feels like Antithesis could trivially generate a\n ; counterexample by just making the system unavailable, and that's not\n ; actually a bug. What SHOULD I be doing here?\n (assert-sometimes (identical? :ok (:type op'))\n (str \"ok \" (pr-str (:f op)))\n ; We'll at least log the type it came back with?\n (select-keys op' [:type]))\n op'))\n\n (teardown! [this test]\n (client/teardown! client test))\n\n (close! [this test]\n (client/close! client test)))\n\n(defn client\n \"Wraps a Jepsen Client in one which performs some simple Antithesis\n instrumentation. Calls `setup-complete!` after the client's setup is done,\n and issues a pair of assertions for every operation--once on invocation, and\n once on completion.\"\n [client]\n (if (antithesis?)\n (Client. client)\n client))\n\n; We build these as protocols so that they can be extended *both* over the\n; built-in checkers, and also by new checkers.\n(defprotocol Checker\n \"This protocol marks checker types which perform their own Antithesis\n assertions. The `checker+` wrapper skips over any checkers which satisfy this\n protocol, as well as their children.\")\n\n(extend-protocol Checker\n ; The Stats checker will fail on histories with no :ok operations of some\n ; type, which Antithesis will sometimes generate.\n jepsen.checker.Stats)\n\n(defrecord AlwaysChecker [^String name checker]\n Checker\n checker/Checker\n (check [this test history opts]\n (let [r (checker/check checker test history opts)]\n (assert-always (true? (:valid? r)) name r)\n r)))\n\n(defn checker\n \"Wraps a Jepsen Checker in one which asserts the results of the underlying\n checker are always valid. Takes a string name, which defaults to \\\"checker\\\";\n this is used for the Antithesis assertion.\"\n ([checker-]\n (checker \"checker\" checker-))\n ([name checker]\n (if (antithesis?)\n (AlwaysChecker. name checker)\n checker)))\n\n(defn checker+\n \"Rewrites a Jepsen Checker, wrapping every Checker in its own Antithesis\n Checker, which asserts validity of that specific checker. Each checker gets a\n name derived from the path into that data structure it took to get there.\n\n Ignores any object which satisfies the Checker protocol. You can use this to\n flag checkers you don't want to add assertions for, or which implement their\n own assertions.\"\n ([c]\n (checker+ [\"checker\"] c))\n ([path c]\n ; (prn :rewrite path c)\n (let [; We often rewrite singleton maps; in these cases, don't bother\n ; propagating paths. For example, a Compose has only a single key\n ; :checkers, and we don't need to generate names like \"checker\n ; :checkers :cat\"; we can just do \"checker :cat\".\n branch? (and (coll? c) (< 1 (count c)))\n ; Rewrite child forms\n c' (cond ; Already aware of Antithesis checking; don't explore any\n ; deeper\n (satisfies? Checker c)\n c\n\n ; For maps and records, rewrite each value, using the key as\n ; our path\n (map? c)\n (reduce (fn [c [k v]]\n (assoc c k (checker+\n (if branch?\n (conj path (pr-str k))\n path)\n v)))\n c\n c)\n\n ; For sets, rewrite without changing path\n (set? c)\n (reduce (fn [c v]\n (conj c (checker+ path v)))\n (empty c)\n c)\n\n ; For sequential collections, rewrite without changing path\n (sequential? c)\n (reduce (fn [c v]\n (conj c (checker+ path v)))\n (empty c)\n c)\n\n ; Everything else bottoms out in itself\n true\n c)]\n ; Now, consider the rewritten thing.\n (cond ; Our Checkers handle their own assertions.\n (satisfies? Checker c')\n c'\n\n ; If it's a Jepsen checker, wrap it, using the current path as our\n ; name.\n (satisfies? checker/Checker c')\n (checker (str/join \" \" path) c')\n\n ; Otherwise, return unchanged.\n true\n c'))))\n\n(defrecord EarlyTerminationGen [^long interval\n ^double probability\n ^long remaining\n gen]\n gen/Generator\n (op [this test ctx]\n (if (and (= 0 remaining)\n ; This might be a little awkward if EarlyTerm winds up nested\n ; inside a branching structure; different calls to op would return\n ; different results. Probably fine, but might be worth\n ; stabilizing.\n (rand/bool probability))\n ; Done\n nil\n ; Keep going\n (when-let [[op gen'] (gen/op gen test ctx)]\n (if (identical? :pending op)\n [:pending this]\n [op (EarlyTerminationGen. interval\n probability\n (mod (dec remaining) interval)\n gen')]))))\n\n (update [this test ctx event]\n (EarlyTerminationGen. interval probability remaining\n (gen/update gen test ctx event))))\n\n(defn early-termination-generator\n \"Wraps a Jepsen generator in one which, every so often, asks Jepsen's\n random source whether it ought to terminate. This allows Antithesis to\n perform a sort of weak 'online checking', as opposed to always running for\n the full (e.g.) time limit. Options are a map of:\n\n :interval How many operations to emit before flipping a coin\n :probability The probability of early termination at each interval. This is\n only useful for extremely low/high probabilities; everything in the moderate\n range (see choice-cardinality) winds up being a coin toss.\"\n [{:keys [interval probability]} gen]\n (EarlyTerminationGen. (long interval)\n (double (or probability 0.5))\n (long interval)\n gen))\n\n(defn test\n \"Prepares a Jepsen test for running in Antithesis. When running inside\n Antithesis, this:\n\n 1. Replaces the OS with a no-op\n 2. Repaces the DB with a no-op\n 3. Replaces the SSH system with a stub.\n\n You likely also want to wrap the client in `client`, parts of the checker in\n `checker`, and possibly the generator in `early-termination-generator`.\"\n [test]\n (if (antithesis?)\n (assoc test\n :os os/noop\n :db db/noop\n :ssh {:dummy? true})\n test))\n" }, { "path": "antithesis/test/jepsen/antithesis/composer_test.clj", "content": "(ns jepsen.antithesis.composer-test\n (:refer-clojure :exclude [run!])\n (:require [clojure [edn :as edn]\n [pprint :refer [pprint]]\n [test :refer :all]]\n [clojure.java.shell :refer [sh]]\n [clojure.tools.logging :refer [info warn]]\n [jepsen [checker :as checker]\n [client :as client]\n [generator :as gen]\n [history :as h]\n [tests :as tests]]\n [jepsen.antithesis.composer :as composer :refer [run!]]))\n\n(defn op!\n \"Shells out to the fifo wrapper to perform a single op.\"\n []\n (sh \"composer/op\"))\n\n(defn check!\n \"Shells out to the fifo wrapper to perform the final check.\"\n []\n (sh \"composer/check\"))\n\n(defn make-test\n \"Constructs a new test map which records side effects in :effects, and which\n delivers a promise to :setup. Call ((:await-setup test)) to block until all\n clients have completed setup. Call ((:effects! test)) to read and clear side\n effects. We use this in run!-test.\"\n []\n (let [setup (promise)\n effects (atom [])\n ; Returns effects and clears them, as a side effect.\n effects! (fn effects! []\n (let [ret (volatile! [])]\n (swap! effects (fn [effects]\n (vreset! ret effects)\n []))\n @ret))\n test tests/noop-test\n n (count (:nodes test))\n ; Waits until effects have received n :setup's\n await-setup (fn await-setup []\n (loop []\n (if (= n (count (filter #{:setup} @effects)))\n :setup\n (do (Thread/sleep 10)\n (recur)))))\n client (reify client/Client\n (open! [this test node] this)\n (setup! [this test]\n (info \"Setup\")\n (swap! effects conj :setup))\n (invoke! [this test op]\n (swap! effects conj [:op op])\n (assoc op :type :ok))\n (teardown! [this test]\n (swap! effects conj :teardown))\n (close! [this test]))\n main-invokes [{:f :write}\n {:f :read}]\n final-invokes [{:f :final}]\n gen (gen/clients\n (gen/phases (composer/main-gen main-invokes)\n final-invokes))\n checker (reify checker/Checker\n (check [this test history opts]\n (swap! effects conj :check)\n {:valid? (= [:write :read :final]\n (->> (h/invokes history)\n (map :f)))}))]\n (assoc test\n :name \"composer test\"\n :client client\n :generator gen\n :checker checker\n :effects effects\n :effects! effects!\n :await-setup await-setup\n :nonserializable-keys [:effects :effects! :await-setup])))\n\n(defn strip-time\n \"Strips out the :time field of an [:op op] element of an effects vector.\"\n [effect]\n (if (and (vector? effect) (= :op (first effect)))\n (update effect 1 dissoc :time)\n effect))\n\n(defn strip-times\n \"Strips out :time fields from [:op op] elements of an effects vector.\"\n [effects]\n (mapv strip-time effects))\n\n(deftest immediate-check-test\n (let [{:keys [await-setup effects!] :as test} (make-test)\n n (count (:nodes test))\n runner (future (run! test))]\n ; We should do setup, then pause.\n (await-setup)\n (is (= (repeat n :setup) (effects!)))\n\n ; Immediate check\n (is (= {:exit 0, :err \"\", :out \"checked\"} (check!)))\n ; We do to the final op, tear down, then check\n (is (= (concat\n [[:op {:index 0, :process 0, :type :invoke, :f :final, :value nil}]]\n (repeat n :teardown)\n [:check])\n (strip-times (effects!))))\n ; And the test is invalid, because we didn't do both ops\n (let [test' @runner]\n (is (= {:valid? false} (:results test'))))))\n\n(deftest early-check-test\n (let [{:keys [await-setup effects!] :as test} (make-test)\n n (count (:nodes test))\n runner (future (run! test))]\n ; We should do setup, then pause.\n (await-setup)\n (is (= (repeat n :setup) (effects!)))\n\n ; Do a single op\n (let [op' (op!)]\n (is (= 0 (:exit op')))\n (is (= {:index 1, :type :ok, :process 0, :f :write, :value nil}\n (dissoc (edn/read-string (:out op')) :time))))\n (is (= [[:op {:index 0, :process 0, :type :invoke, :f :write, :value nil}]]\n (strip-times (effects!))))\n\n ; Early check\n (is (= {:exit 0, :err \"\", :out \"checked\"} (check!)))\n (is (= (concat\n [[:op {:index 2, :process 1, :type :invoke, :f :final, :value nil}]]\n (repeat n :teardown)\n [:check])\n (strip-times (effects!))))\n ; Test is invalid because we didn't finish the main gen\n (let [test' @runner]\n (is (= {:valid? false} (:results test'))))))\n\n(deftest full-test\n (let [{:keys [await-setup effects!] :as test} (make-test)\n n (count (:nodes test))\n runner (future (run! test))]\n ; We should do setup, then pause.\n (await-setup)\n (is (= (repeat n :setup) (effects!)))\n\n ; Do both ops\n (let [op' (op!)]\n (is (= 0 (:exit op')))\n (is (= {:index 1, :type :ok, :process 0, :f :write, :value nil}\n (dissoc (edn/read-string (:out op')) :time))))\n (is (= [[:op {:index 0, :process 0, :type :invoke, :f :write, :value nil}]]\n (strip-times (effects!))))\n\n (let [op' (op!)]\n (is (= 0 (:exit op')))\n (is (= {:index 3, :type :ok, :process 1, :f :read, :value nil}\n (dissoc (edn/read-string (:out op')) :time))))\n (is (= [[:op {:index 2, :process 1, :type :invoke, :f :read, :value nil}]]\n (strip-times (effects!))))\n\n ; Early check\n (is (= {:exit 0, :err \"\", :out \"checked\"} (check!)))\n (is (= (concat\n [[:op {:index 4, :process 2, :type :invoke, :f :final, :value nil}]]\n (repeat n :teardown)\n [:check])\n (strip-times (effects!))))\n ; Test is invalid because we didn't finish the main gen\n (let [test' @runner]\n (is (= {:valid? true} (:results test'))))))\n" }, { "path": "antithesis/test/jepsen/antithesis_test.clj", "content": "(ns jepsen.antithesis-test\n (:require [clojure [pprint :refer [pprint]]\n [test :refer :all]]\n [jepsen [antithesis :as a]\n [checker :as checker]\n [client :as client]\n [generator :as gen]\n [random :as rand]]\n [jepsen.generator [context :as gen.ctx]\n [test :as gen.test]]))\n\n(deftest antithesis?-test\n (is (false? (a/antithesis?))))\n\n(deftest random-test\n (testing \"outside antithesis\"\n (rand/with-seed 0\n (a/with-rng\n (is (= 3247545035024278667 (rand/long)))\n (is (= 0.07473821244042433 (rand/double))))))\n\n (testing \"in antithesis\"\n (with-redefs [a/antithesis? (constantly true)]\n (rand/with-seed 0\n (a/with-rng\n (testing \"nondeterministic\"\n ; That we *don't* get the with-seed 0 values means we're using\n ; antithesis.Random\n (is (not (= 3247545035024278667 (rand/long))))\n (is (not (= 0.07473821244042433 (rand/double)))))\n\n (testing \"long\"\n (testing \"saturation\"\n ; Make sure we're flipping every possible Long bit\n (loop [i 0\n sat 0]\n (if (= i 1000)\n (is (= -1 sat)) ; -1 is 2r111...111\n (recur (inc i)\n (bit-or sat (rand/long))))))\n\n (testing \"upper\"\n (dotimes [i 1000]\n (is (< (rand/long 5403) 5403))))\n\n (testing \"lower, upper\"\n (dotimes [i 1000]\n (let [x (rand/long -5 -2)]\n (is (and (<= -5 x)\n (< x -2)))))))\n\n (testing \"double\"\n (let [xs (vec (take 1000 (repeatedly rand/double)))]\n (testing \"range\"\n (is (every? #(<= 0.0 % 1.0) xs)))\n\n (testing \"saturation\"\n (let [bits (map #(Double/doubleToRawLongBits %) xs)]\n ; Top two bits should be zero, otherwise we should saturate the\n ; mantissa. The other leftmost bits are all 1.\n ;(println (Long/toBinaryString (reduce bit-or 0 bits)))\n (is (= (unsigned-bit-shift-right -1 2)\n (reduce bit-or 0 bits)))))\n\n (testing \"upper\"\n (dotimes [i 1000]\n (is (< (rand/double 5403) 5403))))\n\n (testing \"lower, upper\"\n (dotimes [i 1000]\n (is (<= -10 (rand/double -5 -2) -2))))))\n )))))\n\n(deftest choices-test\n ; We redefine `jepsen.random`'s `long` and `double-weighted-index` so that they use the\n ; Antithesis randomChoice (for small choices) instead of weighted entropy.\n ; This should hopefully make Antithesis more efficient at exploring branches.\n ; Of course we have no way to TEST this outside Antithesis, since it just\n ; proxies back to j.u.Random, but we can at least make sure it's uniform\n ; rather than weighted.\n (let [weights (double-array [0.0 1.0])]\n (testing \"stock\"\n (dotimes [i 100]\n (is (== 1.0 (rand/double-weighted-index weights)))))\n\n (testing \"antithesis\"\n (with-redefs [a/antithesis? (constantly true)]\n (a/with-rng\n (testing \"double-weighted-index\"\n (let [freqs (->> #(rand/double-weighted-index weights)\n repeatedly\n (take 1000)\n frequencies)]\n (is (= #{0 1} (set (keys freqs))))\n (is (< (Math/abs (- (freqs 0 0) (freqs 1 0))) 100))))\n\n (testing \"long\"\n ; Long's behavior should be uniform random either way, but we can\n ; at least check the range.\n (doseq [i (range 1 100)]\n (is (< (rand/long i) i))\n ; Just adding some offset (41) to check long's lower/upper bounds\n (is (< 40 (rand/long 41 (+ i 41)) (+ i 41)))))\n\n (testing \"bool\"\n ; Weighted booleans should stop being weighted when Antithesis takes over\n (let [freqs (->> #(rand/bool 1/10)\n repeatedly\n (take 1000)\n frequencies)]\n (is (< (Math/abs (- (freqs true 0) (freqs false 0))) 100)))\n ; Unless their probability is extreme\n (let [freqs (->> #(rand/bool 1/100)\n repeatedly\n (take 1000)\n frequencies)]\n (is (< (freqs true 0) 50)))))))))\n\n(deftest client-test\n ; Clients should inform us they started, and also make assertions about\n ; invocations.\n (with-redefs [a/antithesis? (constantly true)]\n (let [side (atom [])\n client (reify client/Client\n (open! [this test node]\n (swap! side conj :open)\n this)\n\n (setup! [this test]\n (swap! side conj :setup))\n\n (invoke! [this test op]\n (swap! side conj :invoke)\n (assoc op :type :ok))\n\n (teardown! [this test]\n (swap! side conj :teardown))\n\n (close! [this test]\n (swap! side conj :close)))\n client' (a/client client)]\n ; Since assertions are macros, not sure how to test them.\n (let [sc! a/setup-complete!]\n (with-redefs [a/setup-complete! (fn\n ([] (a/setup-complete! nil))\n ([details] (swap! side conj :setup-complete) (sc! details)))]\n (let [client (client/open! client' {} \"n1\")]\n (is (= [:open] @side))\n (client/setup! client' {})\n (is (= [:open :setup :setup-complete] @side))\n (is (= :ok (:type (client/invoke! client' {} {:type :invoke}))))\n (client/teardown! client' {})\n (client/close! client {})\n (is (= [:open :setup :setup-complete :invoke :teardown :close]\n @side))))))))\n\n(deftest checker-test\n ; Checkers should assert validity. Again, I have no way to test this, since\n ; they're macros, but we can at least guarantee they proxy through.\n (with-redefs [a/antithesis? (constantly true)]\n (let [side (atom [])\n checker (reify checker/Checker\n (check [this test history opts]\n (swap! side conj :check)\n {:valid? true}))\n checker' (a/checker checker)]\n (is (= {:valid? true} (checker/check checker' {} [] {})))\n (is (= [:check] @side)))))\n\n(deftest checker+-test\n ; If we nest one checker in another via e.g. `compose`, each one should get a\n ; distinct wrapper.\n (with-redefs [a/antithesis? (constantly true)]\n (let [side (atom [])\n cat (reify checker/Checker\n (check [this test history opts]\n (swap! side conj :cat)\n {:type :cat, :valid? true}))\n\n dog (reify checker/Checker\n (check [this test history opts]\n (swap! side conj :dog)\n {:type :dog, :valid? :unknown}))\n\n checker (checker/compose {:cat cat, :dog dog})\n checker' (a/checker+ checker)\n ; We can ask for instance? a.Checker, but that breaks during hot code\n ; reload\n ac? (fn [x]\n (is (= \"jepsen.antithesis.AlwaysChecker\"\n (-> x class .getName))))]\n ;(prn)\n ;(println \"-----\")\n ;(prn)\n ;(pprint checker')\n ; Obviously\n (is (ac? checker'))\n ; But also\n (is (ac? (-> checker' :checker :checkers :cat)))\n (is (ac? (-> checker' :checker :checkers :dog)))\n\n ; Paths should be nice and clean\n (is (= \"checker :cat\" (-> checker' :checker :checkers :cat :name)))\n (is (= \"checker :dog\" (-> checker' :checker :checkers :dog :name)))\n\n ; This should still work like a checker\n (is (= {:valid? :unknown\n :cat {:type :cat, :valid? true}\n :dog {:type :dog, :valid? :unknown}}\n (checker/check checker' {} [] {}))))))\n\n(deftest early-termination-generator-test\n ; In Antithesis mode, generators terminate randomly.\n (with-redefs [a/antithesis? (constantly true)]\n (let [gen (->> (range)\n (map (fn [x] {:f :write, :value x}))\n (a/early-termination-generator {:interval 10 :probability 0.5})\n gen/clients)\n trials (rand/with-seed 555\n (mapv (fn [i]\n (->> gen\n gen.test/perfect\n count))\n (range 100)))]\n ; Frequency distribution of history lengths falls off exponentially\n (is (= {10 79, 20 15, 30 5, 40 1}\n (frequencies trials))))))\n" }, { "path": "charybdefs/.gitignore", "content": "/target\n/classes\n/checkouts\npom.xml\npom.xml.asc\n*.jar\n*.class\n/.lein-*\n/.nrepl-port\n.hgignore\n.hg/\n" }, { "path": "charybdefs/README.md", "content": "# charybdefs\n\nA wrapper around [CharybdeFS](https://github.com/scylladb/charybdefs) for use\nin a jepsen nemesis.\n\n## Usage\n\nTODO\n\n## License\n\nDistributed under the Eclipse Public License either version 1.0 or (at\nyour option) any later version.\n" }, { "path": "charybdefs/project.clj", "content": "(defproject jepsen-charybdefs \"0.1.0-SNAPSHOT\"\n :description \"charybdefs wrapper for use in jepsen\"\n :url \"https://github.com/jepsen.io/jepsen\"\n :license {:name \"Eclipse Public License\"\n :url \"http://www.eclipse.org/legal/epl-v10.html\"}\n :dependencies [[org.clojure/clojure \"1.8.0\"]\n [jepsen \"0.1.6\"]\n [yogthos/config \"0.8\"]])\n" }, { "path": "charybdefs/src/jepsen/charybdefs.clj", "content": "(ns jepsen.charybdefs\n (:require [clojure.tools.logging :refer [info]]\n [jepsen.control :as c]\n [jepsen.control.util :as cu]\n [jepsen.os.debian :as debian]))\n\n(defn install-thrift!\n \"Install thrift (compiler, c++, and python libraries) from source.\n\n Ubuntu includes thrift-compiler and python-thrift packages, but\n not the c++ library, so we must build it from source. We can't mix\n and match versions, so we must install everything from source.\"\n []\n (when-not (cu/exists? \"/usr/bin/thrift\")\n (c/su\n (debian/install [:automake\n :bison\n :flex\n :g++\n :git\n :libboost-all-dev\n :libevent-dev\n :libssl-dev\n :libtool\n :make\n :pkg-config\n :python-setuptools\n :libglib2.0-dev])\n (info \"Building thrift (this takes several minutes)\")\n (let [thrift-dir \"/opt/thrift\"]\n (cu/install-archive! \"http://www-eu.apache.org/dist/thrift/0.10.0/thrift-0.10.0.tar.gz\" thrift-dir)\n (c/cd thrift-dir\n ;; charybdefs needs this in /usr/bin\n (c/exec \"./configure\" \"--prefix=/usr\")\n (c/exec :make :-j4)\n (c/exec :make :install))\n (c/cd (str thrift-dir \"/lib/py\")\n (c/exec :python \"setup.py\" :install))))))\n\n(defn install!\n \"Ensure CharybdeFS is installed and the filesystem mounted at /faulty.\"\n []\n (install-thrift!)\n (let [charybdefs-dir \"/opt/charybdefs\"\n charybdefs-bin (str charybdefs-dir \"/charybdefs\")]\n (when-not (cu/exists? charybdefs-bin)\n (c/su\n (debian/install [:build-essential\n :cmake\n :libfuse-dev\n :fuse]))\n (c/su\n (c/exec :mkdir :-p charybdefs-dir)\n (c/exec :chmod \"777\" charybdefs-dir))\n (c/exec :git :clone :--depth 1 \"https://github.com/scylladb/charybdefs.git\" charybdefs-dir)\n (c/cd charybdefs-dir\n (c/exec :thrift :-r :--gen :cpp :server.thrift)\n (c/exec :cmake :CMakeLists.txt)\n (c/exec :make)))\n (c/su\n (c/exec :modprobe :fuse)\n (c/exec :umount \"/faulty\" \"||\" \"/bin/true\")\n (c/exec :mkdir :-p \"/real\" \"/faulty\")\n (c/exec charybdefs-bin \"/faulty\" \"-oallow_other,modules=subdir,subdir=/real\")\n (c/exec :chmod \"777\" \"/real\" \"/faulty\"))))\n\n(defn- cookbook-command\n [flag]\n (c/cd \"/opt/charybdefs/cookbook\"\n (c/exec \"./recipes\" flag)))\n\n(defn break-all\n \"All operations fail with EIO.\"\n []\n (cookbook-command \"--io-error\"))\n\n(defn break-one-percent\n \"1% of disk operations fail.\"\n []\n (cookbook-command \"--probability\"))\n\n(defn clear\n \"Clear a previous failure injection.\"\n []\n (cookbook-command \"--clear\"))\n" }, { "path": "charybdefs/test/.gitignore", "content": "config.edn\n" }, { "path": "charybdefs/test/jepsen/charybdefs/remote_test.clj", "content": "(ns jepsen.charybdefs.remote-test\n (:require [clojure.test :refer :all]\n [jepsen.control :as c]\n [jepsen.charybdefs :as charybdefs]\n [config.core :refer [env]]))\n\n;;; To run these tests, create a file config.edn in ../.. (the 'test' directory)\n;;; containing at least:\n;;; {:hostname \"foo\"}\n;;; This must name a host you can ssh to without a password, and have passwordless\n;;; sudo on. It must run debian or ubuntu (tested with ubuntu 16.04).\n;;; Other ssh options may also be used.\n(use-fixtures :each\n (fn [f]\n (if (not (:hostname env))\n (throw (RuntimeException. \"hostname is required in config.edn\")))\n (c/with-ssh (select-keys env [:private-key-path :strict-host-key-checking :username])\n (c/on (:hostname env)\n (charybdefs/install!)\n (f)))))\n\n(deftest break-fix\n (testing \"break the disk and then fix it\"\n (let [filename \"/faulty/foo\"]\n (c/exec :touch filename)\n (charybdefs/break-all)\n (is (thrown? RuntimeException (c/exec :cat filename)))\n (charybdefs/clear)\n (is \"\" (c/exec :cat filename)))))\n" }, { "path": "contributing.md", "content": "# Contributing to Jepsen\n\nHi there, and thanks for helping make Jepsen better! I've got just one request:\nstart your commit messages with the *part* of Jepsen you're changing. For\ninstance, if I made a change to the MongoDB causal consistency tests:\n\n> MongoDB causal: fix a bug when analyzing zero-length histories\n\nNamespaces are cool too!\n\n> jepsen.os.debian: fix libzip package name for debian stretch\n\nIf you're making a chance to the core Jepsen library, as opposed to a specific\ndatabase test, you can be more concise:\n\n> add test for single nemesis events\n\nJepsen's a big project with lots of moving parts, and it can be confusing to\nread the commit logs. Giving a bit of context makes my life a lot easier.\n\nThanks!\n" }, { "path": "doc/color.md", "content": "Color scheme:\n\nLight:\n\nok #6DB6FE\ninfo #FFAA26\nfail #FEB5DA\n\nDark:\n\nok: #81BFFC\ninfo: #FFA400\nfail: #FF1E90\n" }, { "path": "doc/lxc-f36.md", "content": "# How to set up nodes via LXC\n\n## Fedora 36\n\nAs a user can be sudoer:\n\n```\nsudo dnf install -y openssh-server\nsudo dnf -y install clusterssh\nsudo dnf -y install dnsmasq\nsudo dnf install lxc lxc-templates lxc-extra debootstrap libvirt perl gpg\nsudo dnf -y install bridge-utils libvirt virt-install qemu-kvm\nsudo dnf install libvirt-devel virt-top libguestfs-tools guestfs-tools\n```\n\nThen, run all ``systemctl start/enable`` as you need:\n\n```\nsudo systemctl start sshd.service\nsudo systemctl enable sshd.service\n\nsudo systemctl start lxc.service\nsudo systemctl enable lxc.service\n\nsudo systemctl start libvirtd.service\nsudo systemctl enable libvirtd.service\n\nsudo systemctl start dnsmasq.service\nsudo systemctl enable dnsmasq.service\n\n\n\n<...> so on <..>\n```\nWatch out libvirtd and kvm messages... \n\nApply google and kernel parameters until checkconfig passes:\n\n```\nlxc-checkconfig\n```\n\nWell, here we go, problems are comming..\n\n```\n[root@fedora ~]# lxc-checkconfig\nLXC version 4.0.12\nKernel configuration not found at /proc/config.gz; searching...\nKernel configuration found at /boot/config-5.18.16-200.fc36.x86_64\n--- Namespaces ---\nNamespaces: enabled\nUtsname namespace: enabled\nIpc namespace: enabled\nPid namespace: enabled\nUser namespace: enabled\nWarning: newuidmap is not setuid-root\nWarning: newgidmap is not setuid-root\nNetwork namespace: enabled\n\n--- Control groups ---\nCgroups: enabled\nCgroup namespace: enabled\n\nCgroup v1 mount points:\n\n\nCgroup v2 mount points:\n/sys/fs/cgroup\n\nCgroup v1 systemd controller: missing\nCgroup v1 freezer controller: missing\nCgroup ns_cgroup: required\nCgroup device: enabled\nCgroup sched: enabled\nCgroup cpu account: enabled\nCgroup memory controller: enabled\nCgroup cpuset: enabled\n\n--- Misc ---\nVeth pair device: enabled, loaded\nMacvlan: enabled, not loaded\nVlan: enabled, not loaded\nBridges: enabled, loaded\nAdvanced netfilter: enabled, not loaded\nCONFIG_IP_NF_TARGET_MASQUERADE: enabled, not loaded\nCONFIG_IP6_NF_TARGET_MASQUERADE: enabled, not loaded\nCONFIG_NETFILTER_XT_TARGET_CHECKSUM: enabled, loaded\nCONFIG_NETFILTER_XT_MATCH_COMMENT: enabled, not loaded\nFUSE (for use with lxcfs): enabled, loaded\n\n--- Checkpoint/Restore ---\ncheckpoint restore: enabled\nCONFIG_FHANDLE: enabled\nCONFIG_EVENTFD: enabled\nCONFIG_EPOLL: enabled\nCONFIG_UNIX_DIAG: enabled\nCONFIG_INET_DIAG: enabled\nCONFIG_PACKET_DIAG: enabled\nCONFIG_NETLINK_DIAG: enabled\nFile capabilities:\n\nNote : Before booting a new kernel, you can check its configuration\nusage : CONFIG=/path/to/config /usr/bin/lxc-checkconfig\n```\n\nOk, \n\n``Cgroup ns_cgroup: required`` forget about it, it is problem about versions...\n\nFedora 36 use as default cgroups2, if you are running v1, sorry, and disable selinux, it is just testing...\n\n``cgroup_no_v1=all selinux=0``\n\n\n Create VMs arch amd64, 3 of them :\n\n```\nfor i in {1..3}; do sudo lxc-create -t download -n n$i -- -d fedora -r 36 -a amd64; done\n```\n\nOk, add network configuration to each node. We assign each a sequential MAC\naddress.\n\nRight, but you need known where you are, ``brctl show ``\n\n```\nbridge name bridge id STP enabled interfaces\ndocker0 8000.02425aa0dc72 no\nlxcbr0 8000.00163e000000 no \nvirbr0 8000.525400bb5910 yes vethDcihoW\n```\nok, ``virbr0`` seems our winner ...\n\nThen \n```\nfor i in {1..3}; do\nsudo cat >>/var/lib/lxc/n${i}/config <\"\ndone\n```\n\nStart the network, and set it to start at boot so the dnsmasq will be\navailable.\n\nWell, we need know what libvirtd service is doing ...\n\n```\n[root@fedora ~]# systemctl status libvirtd\n○ libvirtd.service - Virtualization daemon\n Loaded: loaded (/usr/lib/systemd/system/libvirtd.service; disabled; vendor preset: disabled)\n Active: inactive (dead) since Mon 2022-08-08 09:10:49 UTC; 1h 19min ago\nTriggeredBy: ● libvirtd-ro.socket\n ○ libvirtd-tls.socket\n ○ libvirtd-tcp.socket\n ● libvirtd-admin.socket\n ● libvirtd.socket\n Docs: man:libvirtd(8)\n https://libvirt.org\n Process: 2678 ExecStart=/usr/sbin/libvirtd $LIBVIRTD_ARGS (code=exited, s\n```\n\nThen, next steps\n```\n[root@fedora ~]# virsh net-autostart default;\nNetwork default marked as autostarted\n```\nSo, continue,\n```\nvirsh net-start default\n```\nyou get,\n\n```\nerror: Failed to start network default\nerror: Requested operation is not valid: network is already active\n```\n\nfedora 36, libvirtd.socket is managing libvirtd-tls.socket and libvirtd-tcp.socket ... \n\nIf you configure resolv.conf by hand, add the libvirt local dnsmasq to\nresolv.conf:\n\n```\necho -e \"nameserver 192.168.122.1\\n$(cat /etc/resolv.conf)\" > /etc/resolv.conf\n\n```\n\nIf you're letting dhclient manage it, then:\n\n```\necho \"prepend domain-name-servers 192.168.122.1;\" >>/etc/dhcp/dhclient.conf\nsystemctl restart NetworkManager\n\n```\n\nAnd update ``/etc/hosts`` if you don't wanna lose your mind seeing ``ping`` fails...\n\n```\n192.168.122.101 n1\n192.168.122.102 n2\n192.168.122.103 n3\n```\n\n\n\nSlip your preferred SSH key into each node's `.authorized-keys`:\n\n```\nfor i in {1..3}; do\n mkdir -p /var/lib/lxc/n${i}/rootfs/root/.ssh\n chmod 700 /var/lib/lxc/n${i}/rootfs/root/.ssh/\n cp ~/.ssh/id_rsa.pub /var/lib/lxc/n${i}/rootfs/root/.ssh/authorized_keys\n chmod 644 /var/lib/lxc/n${i}/rootfs/root/.ssh/authorized_keys\ndone\n```\n\nAnd start the nodes:\n\n```\nfor i in {1..3}; do\n lxc-start -d -n n$i\ndone\n```\n\nTo stop them:\n\n```\nfor i in {1..3}; do\n lxc-stop -n n$i\ndone\n```\n\nTo check them:\n\n```\nlxc-ls -f\n\nNAME STATE AUTOSTART GROUPS IPV4 IPV6 UNPRIVILEGED\n\nn1 RUNNING 0 - 192.168.122.101 - false\nn2 RUNNING 0 - 192.168.122.102 - false\nn3 RUNNING 0 - 192.168.122.103 - false\n```\n\n\nReset the root passwords to whatever you like. Jepsen uses `root` by default,\nand allow root logins with passwords on each container. If you've got an SSH\nagent set up, Jepsen can use that instead.\n\nWarning !!!\nBe sure that sshd service is running -ok- in {n1,n2,n3} without problems ... \n``lxc-attach -n {n1, n2, n3} ``\n\nBe sure that you change \"sshd_config\" \n\n```\nfor i in {1..3}; do\n lxc-attach -n n${i} -- bash -c 'echo -e \"root\\nroot\\n\" | passwd root';\n lxc-attach -n n${i} -- sed -i 's,^#\\?PermitRootLogin .*,PermitRootLogin yes,g' /etc/ssh/sshd_config;\n lxc-attach -n n${i} -- systemctl restart sshd;\ndone\n```\n\nStore the host keys unencrypted so that jsch can use them. If you already have\nthe host keys, they may be unreadable to Jepsen--remove them from .known_hosts\nand rescan.\n\n```\nfor n in {1..3}; do ssh-keyscan -vvv -t rsa n$n; done >> ~/.ssh/known_hosts\n```\nCheck it:\n\n```\n[root@fedora ~]# cat .ssh/known_hosts\nn1 ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABgQCzqHvG5GEmX8RaALxTZT22fX1hDsxljAPH/m/6=\nn2 ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABgQC+taCDJSyJbu5oaRK/zTFu+CvqOx0MRkvzXfoM=\nn3 ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABgQDcpQcG9GUjYZqM5dA5LwSoCH6Qot42mbsdXwva=\n```\n\nIf you get some problems as \"write failed or similars\", check again sshd, you got some wrong...\n\n\nAnd check that you can SSH to the nodes:\n\nfedora 36 needs,\n\n```\n\n dnf -y install clusterssh\n```\n\nIf you don't have X mode, graphical mode... running\n\n```\ncssh n1 n2 n3 \n```\nyou should be sometime similar :\n\n```\n[root@fedora ~]# cssh n1\nCan't connect to display `localhost:0': Connection refused at /usr/share/perl5/vendor_perl/X11/Protocol.pm line 2269.\n``` \n\nNot use cssh, use ssh in a loop.\n\n--- O --- \n\n" }, { "path": "doc/lxc.md", "content": "# How to set up nodes via LXC\n\n#### [Mint 22.3 Zena](#mint-22.3-zena-1)\n#### [Debian 13/trixie - Incus](#debian-13trixie---incus-1)\n\nFor further information, [LXD - Debian Wiki](https://wiki.debian.org/LXD).\n\n----\n\n## Mint 22.3 Zena\n\nInstall LXC and DNSMasq:\n\n```sh\nsudo apt install lxc lxc-templates libvirt-clients dnsmasq\n```\n\nUpdate the old GPG keys for debian releases\n\n```sh\ncd /tmp\nwget \"https://ftp-master.debian.org/keys/archive-key-13.asc\"\nsudo gpg --no-default-keyring --keyring=/etc/apt/trusted.gpg.d/debian-archive-trixie-stable.gpg --import archive-key-13.asc\n```\n\nSet up a ZFS filesystem for containers. These are throwaway so I don't bother\nwith sync or atime.\n\n```sh\nsudo zfs create -o acltype=posix -o atime=off -o sync=disabled -o mountpoint=/var/lib/lxc rpool/lxc\n```\n\nIf you've got Docker installed, it creates a whole bunch of firewall gunk that\ntotally breaks the LXC bridge. Make a script to let LXC talk:\n\n```sh\nsudo bash -c \"cat >/usr/local/bin/post-docker.sh < /var/log/post-docker-timestamp\niptables -I DOCKER-USER -i lxcbr0 -j ACCEPT\niptables -I DOCKER-USER -o lxcbr0 -j ACCEPT\nEOF\"\nsudo chmod +x /usr/local/bin/post-docker.sh\n```\n\nAnd call it after Docker loads:\n\n```sh\nsudo bash -c \"cat >/etc/systemd/system/post-docker.service <> /etc/dnsmasq.d/jepsen.conf\"; done\n```\n\nRestart the resolver and LXC networking\n\n```\nsudo systemctl restart systemd-resolved\nsudo systemctl restart lxc-net\n```\n\nStart up a container and confirm that it's assigned the right address:\n\n```\nsudo lxc-start n1\nsudo lxc-ls --fancy\nsudo lxc-stop n1\n```\n\nAnd add the local dnsmasq to networkmanager\n\n```sh\nsudo bash -c \"cat >/etc/NetworkManager/dnsmasq.d/lxc.conf </etc/systemd/system/lxc-dns-lxcbr0.service <> ~/.ssh/known_hosts\n```\n\nAt this point you should be able to `ssh n1` without a password.\n\n----\n\n## Debian 13/trixie - Incus\n\nDue to Canonical's re-licensing and imposing of a CLA, the last version of Debian to include LXD will be trixie. Users are encouraged to migrate to Incus after upgrading from bookworm to trixie.\n\n### Install Host Packages\n\n```bash\nsudo apt update && sudo apt install incus systemd-resolved\n```\n\n### Initialize Incus\n\n```bash\n# add yourself to the incus-admin group to avoid having to be root or sudo\n# you will need to logout/login for new group to be active\nsudo adduser $USER incus-admin\n\n# initialize Incus with default config, defaults are usually OK\nincus admin init --minimal\n\n# try creating a sample container if you want\nincus launch images:debian/13 scratch\nincus list\nincus shell scratch\nincus stop scratch\nincus delete scratch\n```\n\n### Create and Start Jepsen's Node Containers\n\n```bash\nfor i in {1..10}; do\n incus launch images:debian/13 n${i};\ndone\n```\n\n### Confirm Incus' Bridge Network\n\n`incus init` automatically created the bridge network, and `incus launch` automatically configured the containers for it:\n\n```bash\nincus network list\n+----------+----------+---------+----------------+---+-------------+---------+---------+\n| NAME | TYPE | MANAGED | IPV4 |...| DESCRIPTION | USED BY | STATE |\n+----------+----------+---------+----------------+---+-------------+---------+---------+\n| incusbr0 | bridge | YES | 10.242.68.1/24 |...| | 11 | CREATED |\n+----------+----------+---------+----------------+---+-------------+---------+---------+\n\n# confirm your settings\nincus network get incusbr0 ipv4.address\nincus network get incusbr0 ipv6.address\nincus network get incusbr0 dns.domain # will be blank if default incus config is used \n\n# confirm containers are reachable\nping n1\nPING n1 (10.242.68.40) 56(84) bytes of data.\n64 bytes from n1 (10.242.68.40): icmp_seq=1 ttl=64 time=0.030 ms\n...\n```\n\nIf you want to install and run Docker, it may mess up your networking and firewall. If your Incus containers are not reachable from the host, see the Incus documentation:\n\n- [Prevent connectivity issues with Incus and Docker](https://linuxcontainers.org/incus/docs/main/howto/network_bridge_firewalld/#prevent-connectivity-issues-with-incus-and-docker)\n\n#### Add Required Packages to Node Containers\n\n```bash\nfor i in {1..10}; do\n incus exec n${i} -- sh -c \"apt-get -qy update && apt-get -qy install openssh-server sudo\";\ndone\n```\n\n#### Configure SSH\n\nSlip your preferred SSH key into each node's `.ssh/.authorized-keys`:\n\n```bash\nfor i in {1..10}; do\n incus exec n${i} -- sh -c \"mkdir -p /root/.ssh && chmod 700 /root/.ssh/\";\n incus file push ~/.ssh/id_rsa.pub n${i}/root/.ssh/authorized_keys --uid 0 --gid 0 --mode 644;\ndone\n```\n\nReset the root password to root, and allow root logins with passwords on each container.\nIf you've got an SSH agent set up, Jepsen can use that instead.\n\n```bash\nfor i in {1..10}; do\n incus exec n${i} -- bash -c 'echo -e \"root\\nroot\\n\" | passwd root';\n incus exec n${i} -- sed -i 's,^#\\?PermitRootLogin .*,PermitRootLogin yes,g' /etc/ssh/sshd_config;\n incus exec n${i} -- systemctl restart sshd;\ndone\n```\n\nStore the node keys unencrypted so that jsch can use them.\nIf you already have the node keys, they may be unreadable to Jepsen -- remove them from `~/.ssh/known_hosts` and rescan:\n\n```bash\nfor n in {1..10}; do\n ssh-keyscan -t rsa n${n} >> ~/.ssh/known_hosts;\ndone\n```\n\n#### Confirm You Can `ssh` Into Nodes\n\n```bash\nssh root@n1\n```\n\n#### Stopping and Deleting Containers\n\n```bash\nfor i in {1..10}; do\n incus stop n${i} --force;\n incus delete n${i} --force;\ndone\n```\n\n----\n\n#### Real VMs w/Real Clocks\n\n```bash\n# VM's use QEMU\nsudo apt update && sudo apt install qemu-system\n\n# note --vm flag\nincus launch images:debian/13 n1 --vm\n```\n\nAllows the clock nemesis to bump, skew, and scramble time in a Jepsen node as it's a real vm with a real clock.\n\n----\n\n#### Misc\n\nThe `incus` command's \\ completion works well, even autocompletes container names.\n" }, { "path": "doc/plan.md", "content": "# Stuff to improve!\n\n## Error handling\n\n- Knossos: Better error messages when users pass models that fail on the\n first op (I think there's a ticket about this? Null pointer exception for i?)\n- When users enter a node multiple times into :nodes, complain early\n\n## Visualizations\n\n- Add a plot for counters, showing the upper and lower bounds, and the observed\n value\n- Rework latency plot color scheme to use colors that hint at a continuum\n- Adaptive temporal resolution for rate and latency plots, based on point\n density\n- Where plots are dense, make points somewhat transparent to better show\n density?\n\n## Web\n\n- Use utf-8 for transferring files; I think we're doing latin-1 or ascii or\n 8859-1 or something now.\n- Add search for tests\n- Add sorting\n- Add filtering\n\n## Performance\n\n- Knossos: let's make the memoization threshold configurable via options passed\n to the checker.\n\n## Core\n\n- Macro like (synchronize-nodes test), which enforces a synchronization\n barrier where (count nodes threads) must come to sync on the test map.\n- Generator/each works on each *process*, not each *thread*, but almost always,\n what people intend is for each thread--and that's how concat, independent,\n etc work. This leads to weird scenarios like tests looping on a final read\n forever and ever, as each process crashes, a new one comes in and gets a\n fresh generator. Let's make it by thread?\n\n## Extensions\n\n- Reusable packet capture utility (take from cockroach)\n\n## New tests\n\n- Port bank test from Galera into core (alongside G2)\n- Port query-across-tables-and-insert from Cockroach into core\n- Port pure-insert from Cockroach into core\n- Port comments from Cockroach into core (better name?)\n- Port other Hermitage tests to Jepsen?\n\n## Tests\n- Clean up causal test. Drop model and port to workload\n" }, { "path": "doc/tutorial/01-scaffolding.md", "content": "# Test scaffolding\n\nIn this tutorial, we're going to write a test for etcd: a distributed consensus\nsystem. I want to encourage you to *type* the code yourself, even if you don't\nunderstand everything yet. It'll help you learn faster, and you won't get as lost when we start updating small pieces of larger functions.\n\nWe'll begin by creating a new Leiningen project in any directory.\n\n```bash\n$ lein new jepsen.etcdemo\nGenerating a project called jepsen.etcdemo based on the 'default' template.\nThe default template is intended for library projects, not applications.\nTo see other templates (app, plugin, etc), try `lein help new`.\n$ cd jepsen.etcdemo\n$ ls\nCHANGELOG.md doc/ LICENSE project.clj README.md resources/ src/ test/\n```\n\nLike any fresh Clojure project, we have a blank changelog, a directory for\ndocumentation, a copy of the Eclipse Public License, a `project.clj` file,\nwhich tells `leiningen` how to build and run our code, and a README. The\n`resources` directory is a place for us to data files--for instance, config\nfiles for a database we want to test. `src` has our source code, organized into\ndirectories and files which match the namespace structure of our code. `test`\nis for testing our code. Note that this *whole directory* is a \"Jepsen test\";\nthe `test` directory is a convention for most Clojure libraries, and we won't\nbe using it here.\n\nWe'll start by editing `project.clj`, which specifies the project's\ndependencies and other metadata. We'll add a `:main` namespace, which is how\nwe'll run the test from the command line. In addition to depending on the\nClojure language itself, we'll pull in the Jepsen library, and\nVerschlimmbesserung: a library for talking to etcd.\n\n```clj\n(defproject jepsen.etcdemo \"0.1.0-SNAPSHOT\"\n :description \"A Jepsen test for etcd\"\n :license {:name \"Eclipse Public License\"\n :url \"http://www.eclipse.org/legal/epl-v10.html\"}\n :main jepsen.etcdemo\n :dependencies [[org.clojure/clojure \"1.10.0\"]\n [jepsen \"0.2.1-SNAPSHOT\"]\n [verschlimmbesserung \"0.1.3\"]])\n```\n\nLet's try running this program with `lein run`.\n\n```bash\n$ lein run\nException in thread \"main\" java.lang.Exception: Cannot find anything to run for: jepsen.etcdemo, compiling:(/tmp/form-init6673004597601163646.clj:1:73)\n...\n```\n\nAh, yes. We haven't written anything to run yet. We need a main function in the `jepsen.etcdemo` namespace, which will receive our command line args and run the test. In `src/jepsen/etcdemo.clj`:\n\n```clj\n(ns jepsen.etcdemo)\n\n(defn -main\n \"Handles command line arguments. Can either run a test, or a web server for\n browsing results.\"\n [& args]\n (prn \"Hello, world!\" args))\n```\n\nClojure, by default, calls our `-main` function with any arguments we passed on\nthe command line--whatever we type after `lein run`. It takes a variable number\nof arguments (that's the `&` symbol), and calls that argument list `args`. We\nprint that argument list after \"Hello World\":\n\n```bash\n$ lein run hi there\n\"Hello, world!\" (\"hi\" \"there\")\n```\n\nJepsen includes some scaffolding for argument handling, running tests, handling\nerrors, logging, etc. Let's pull in the `jepsen.cli` namespace, call it `cli` for short, and turn our main function into a Jepsen test runner:\n\n```clj\n(ns jepsen.etcdemo\n (:require [jepsen.cli :as cli]\n [jepsen.tests :as tests]))\n\n\n(defn etcd-test\n \"Given an options map from the command line runner (e.g. :nodes, :ssh,\n :concurrency, ...), constructs a test map.\"\n [opts]\n (merge tests/noop-test\n {:pure-generators true}\n opts))\n\n(defn -main\n \"Handles command line arguments. Can either run a test, or a web server for\n browsing results.\"\n [& args]\n (cli/run! (cli/single-test-cmd {:test-fn etcd-test})\n args))\n```\n\n`cli/single-test-cmd` is provided by `jepsen.cli`: it parses command line\narguments for a test and calls the provided `:test-fn`, which should return a\nmap containing all the information Jepsen needs to run a test. In this case,\nour test function is `etcd-test`, which takes options from the command line\nrunner, and uses them to fill in position in an empty test that does nothing:\n`noop-test`.\n\n```bash\n$ lein run\nUsage: lein run -- COMMAND [OPTIONS ...]\nCommands: test\n```\n\nWith no args, `cli/run!` provides a basic help message, informing us it takes a\ncommand as its first argument. Let's try the test command we added:\n\nLet's give it a shot!\n\n```bash\n$ lein run test\n13:04:30.927 [main] INFO jepsen.cli - Test options:\n {:concurrency 5,\n :test-count 1,\n :time-limit 60,\n :nodes [\"n1\" \"n2\" \"n3\" \"n4\" \"n5\"],\n :ssh\n {:username \"root\",\n :password \"root\",\n :strict-host-key-checking false,\n :private-key-path nil}}\n\nINFO [2018-02-02 13:04:30,994] jepsen test runner - jepsen.core Running test:\n {:concurrency 5,\n :db\n #object[jepsen.db$reify__1259 0x6dcf7b6a \"jepsen.db$reify__1259@6dcf7b6a\"],\n :name \"noop\",\n :start-time\n #object[org.joda.time.DateTime 0x79d4ff58 \"2018-02-02T13:04:30.000-06:00\"],\n :net\n #object[jepsen.net$reify__3493 0xae3c140 \"jepsen.net$reify__3493@ae3c140\"],\n :client\n #object[jepsen.client$reify__3380 0x20027c44 \"jepsen.client$reify__3380@20027c44\"],\n :barrier\n #object[java.util.concurrent.CyclicBarrier 0x2bf3ec4 \"java.util.concurrent.CyclicBarrier@2bf3ec4\"],\n :ssh\n {:username \"root\",\n :password \"root\",\n :strict-host-key-checking false,\n :private-key-path nil},\n :checker\n #object[jepsen.checker$unbridled_optimism$reify__3146 0x1410d645 \"jepsen.checker$unbridled_optimism$reify__3146@1410d645\"],\n :nemesis\n #object[jepsen.nemesis$reify__3574 0x4e6cbdf1 \"jepsen.nemesis$reify__3574@4e6cbdf1\"],\n :active-histories #,\n :nodes [\"n1\" \"n2\" \"n3\" \"n4\" \"n5\"],\n :test-count 1,\n :generator\n #object[jepsen.generator$reify__1936 0x1aac0a47 \"jepsen.generator$reify__1936@1aac0a47\"],\n :os\n #object[jepsen.os$reify__1176 0x438aaa9f \"jepsen.os$reify__1176@438aaa9f\"],\n :time-limit 60,\n :model {}}\n\nINFO [2018-02-02 13:04:35,389] jepsen nemesis - jepsen.core Starting nemesis\nINFO [2018-02-02 13:04:35,389] jepsen worker 1 - jepsen.core Starting worker 1\nINFO [2018-02-02 13:04:35,389] jepsen worker 2 - jepsen.core Starting worker 2\nINFO [2018-02-02 13:04:35,389] jepsen worker 0 - jepsen.core Starting worker 0\nINFO [2018-02-02 13:04:35,390] jepsen worker 3 - jepsen.core Starting worker 3\nINFO [2018-02-02 13:04:35,390] jepsen worker 4 - jepsen.core Starting worker 4\nINFO [2018-02-02 13:04:35,391] jepsen nemesis - jepsen.core Running nemesis\nINFO [2018-02-02 13:04:35,391] jepsen worker 1 - jepsen.core Running worker 1\nINFO [2018-02-02 13:04:35,391] jepsen worker 2 - jepsen.core Running worker 2\nINFO [2018-02-02 13:04:35,391] jepsen worker 0 - jepsen.core Running worker 0\nINFO [2018-02-02 13:04:35,391] jepsen worker 3 - jepsen.core Running worker 3\nINFO [2018-02-02 13:04:35,391] jepsen worker 4 - jepsen.core Running worker 4\nINFO [2018-02-02 13:04:35,391] jepsen nemesis - jepsen.core Stopping nemesis\nINFO [2018-02-02 13:04:35,391] jepsen worker 1 - jepsen.core Stopping worker 1\nINFO [2018-02-02 13:04:35,391] jepsen worker 2 - jepsen.core Stopping worker 2\nINFO [2018-02-02 13:04:35,391] jepsen worker 0 - jepsen.core Stopping worker 0\nINFO [2018-02-02 13:04:35,391] jepsen worker 3 - jepsen.core Stopping worker 3\nINFO [2018-02-02 13:04:35,391] jepsen worker 4 - jepsen.core Stopping worker 4\nINFO [2018-02-02 13:04:35,397] jepsen test runner - jepsen.core Run complete, writing\nINFO [2018-02-02 13:04:35,434] jepsen test runner - jepsen.core Analyzing\nINFO [2018-02-02 13:04:35,435] jepsen test runner - jepsen.core Analysis complete\nINFO [2018-02-02 13:04:35,438] jepsen results - jepsen.store Wrote /home/aphyr/jepsen/jepsen.etcdemo/store/noop/20180202T130430.000-0600/results.edn\nINFO [2018-02-02 13:04:35,440] main - jepsen.core {:valid? true}\n\nEverything looks good! ヽ(‘ー`)ノ\n```\n\nWe can see Jepsen start a series of workers--each one responsible for executing\noperations against the database--and a nemesis, which causes failures. We\nhaven't given them anything to do, so they shut down immediately. Jepsen writes\nout the result of this (trivial) test to the `store` directory, and prints out\na brief analysis.\n\n`noop-test` uses nodes named `n1`, `n2`, ... `n5` by default. If your nodes\nhave different names, this test will fail to connect to them. That's OK! You can change that by passing node names on the command line:\n\n```bash\n$ lein run test --node foo.mycluster --node 1.2.3.4\n```\n\n... or by passing a filename that has a list of nodes in it, one per line. If\nyou're using the AWS Marketplace cluster, you've already got a file called\n`nodes` in your home directory, ready to go.\n\n```bash\n$ lein run test --nodes-file ~/nodes\n```\n\nIf you're still hitting SSH errors at this point, you should check that your\nSSH agent is running and has keys for all your nodes loaded. `ssh some-db-node`\nshould work without a password. You can override the username, password, and\nidentity file at the command line as well; see `lein run test --help` for\ndetails.\n\n```bash\n$ lein run test --help\n#object[jepsen.cli$test_usage 0x7ddd84b5 jepsen.cli$test_usage@7ddd84b5]\n\n -h, --help Print out this message and exit\n -n, --node HOSTNAME [\"n1\" \"n2\" \"n3\" \"n4\" \"n5\"] Node(s) to run test on\n --nodes-file FILENAME File containing node hostnames, one per line.\n --username USER root Username for logins\n --password PASS root Password for sudo access\n --strict-host-key-checking Whether to check host keys\n --ssh-private-key FILE Path to an SSH identity file\n --concurrency NUMBER 1n How many workers should we run? Must be an integer, optionally followed by n (e.g. 3n) to multiply by the number of nodes.\n --test-count NUMBER 1 How many times should we repeat a test?\n --time-limit SECONDS 60 Excluding setup and teardown, how long should a test run for, in seconds?\n```\n\nWe'll use `lein run test ...` throughout this guide to re-run our Jepsen test. Each time we run a test, Jepsen will create a new directory in `store/`. You can see the latest results in `store/latest`:\n\n```bash\n$ ls store/latest/\nhistory.txt jepsen.log results.edn test.fressian\n```\n\n`history.txt` shows the operations the test performed--ours is empty, since the\nnoop test doesn't perform any ops. `jepsen.log` has a copy of the console log\nfor that test. `results.edn` shows the analysis of the test, which we see at\nthe end of each run. Finally, `test.fressian` has the raw data for the test,\nincluding the full machine-readable history and analysis, if you need to\nperform post-hoc analysis.\n\nJepsen also comes with a built-in web browser for browsing these results. Let's add it to our `main` function:\n\n```clj\n(defn -main\n \"Handles command line arguments. Can either run a test, or a web server for\n browsing results.\"\n [& args]\n (cli/run! (merge (cli/single-test-cmd {:test-fn etcd-test})\n (cli/serve-cmd))\n args))\n```\n\nThis works because `cli/run!` takes a map of command names to specifications of\nhow to run those commands. We're merging those maps together with `merge`.\n\n```bash\n$ lein run serve\n13:29:21.425 [main] INFO jepsen.web - Web server running.\n13:29:21.428 [main] INFO jepsen.cli - Listening on http://0.0.0.0:8080/\n```\n\nWe can open `http://localhost:8080` in a web browser to explore the history of\nour test results. Of course, the serve command comes with its own options and\nhelp message:\n\n```bash\n$ lein run serve --help\nUsage: lein run -- serve [OPTIONS ...]\n\n -h, --help Print out this message and exit\n -b, --host HOST 0.0.0.0 Hostname to bind to\n -p, --port NUMBER 8080 Port number to bind to\n```\n\nOpen up a new terminal window, and leave the web server running there. That way\nwe can see the results of our tests without having to start and stop it\nrepeatedly.\n\nWith this groundwork in place, we'll write the code to [set up and tear down the database](02-db.md).\n" }, { "path": "doc/tutorial/02-db.md", "content": "# Database automation\n\nIn a Jepsen test, a `DB` encapsulates code for setting up and tearing down a\ndatabase, queue, or other distributed system we want to test. We could perform\nthe setup and teardown by hand, but letting Jepsen handle it lets us run tests\nin a CI system, parameterize database configuration, run multiple tests\nback-to-back with a clean slate, and so on.\n\nIn `src/jepsen/etcdemo.clj`, we'll require the `jepsen.db`, `jepsen.control`,\n`jepsen.control.util`, and `jepsen.os.debian` namespaces, aliasing each to a\nshort name. `clojure.string` will help us build configuration strings for etcd.\nWe'll also pull in every function from `clojure.tools.logging`, giving us log\nfunctions like `info`, `warn`, etc.\n\n```clj\n(ns jepsen.etcdemo\n (:require [clojure.tools.logging :refer :all]\n [clojure.string :as str]\n [jepsen [cli :as cli]\n [control :as c]\n [db :as db]\n [tests :as tests]]\n [jepsen.control.util :as cu]\n [jepsen.os.debian :as debian]))\n```\n\nThen, we'll write a function that constructs a Jepsen DB, given a particular\nversion string.\n\n```clj\n(defn db\n \"Etcd DB for a particular version.\"\n [version]\n (reify db/DB\n (setup! [_ test node]\n (info node \"installing etcd\" version))\n\n (teardown! [_ test node]\n (info node \"tearing down etcd\"))))\n```\n\nThe string after `(defn db ...` is a *docstring*, documenting the function's\nbehavior. When given a `version`, the `db` function uses `reify` to construct a\nnew object satisfying jepsen's `DB` protocol (from the `db` namespace). That\nprotocol specifies two functions all databases must support: `(setup! db test\nnode)`, and `(teardown! db test node)`. We provide stub implementations\nhere, which simply log an informational message.\n\nNow, we'll extend the default `noop-test` by adding an `:os`, which tells\nJepsen how to handle operating system setup, and a `:db`, which we can\nconstruct using the `db` function we just wrote. We'll test etcd version\n`v3.1.5`.\n\n```clj\n(defn etcd-test\n \"Given an options map from the command line runner (e.g. :nodes, :ssh,\n :concurrency ...), constructs a test map.\"\n [opts]\n (merge tests/noop-test\n opts\n {:name \"etcd\"\n :os debian/os\n :db (db \"v3.1.5\")\n :pure-generators true}))\n```\n\n`noop-test`, like all Jepsen tests, is a map with keys like `:os`, `:name`,\n`:db`, etc. See [jepsen.core](../../jepsen/src/jepsen/core.clj) for an\noverview of test structure, and `jepsen.core/run` for the full definition of a\ntest.\n\nRight now `noop-test` has stub implementations for those keys. But we can\nuse `merge` to build a copy of the `noop-test` map with *new* values for some\nkeys.\n\nIf we run this test, we'll see Jepsen using our code to set up debian,\npretend to tear down and install etcd, then start its workers.\n\n```bash\n$ lein run test\n...\nINFO [2017-03-30 10:08:30,852] jepsen node n2 - jepsen.os.debian :n2 setting up debian\nINFO [2017-03-30 10:08:30,852] jepsen node n3 - jepsen.os.debian :n3 setting up debian\nINFO [2017-03-30 10:08:30,852] jepsen node n4 - jepsen.os.debian :n4 setting up debian\nINFO [2017-03-30 10:08:30,852] jepsen node n5 - jepsen.os.debian :n5 setting up debian\nINFO [2017-03-30 10:08:30,852] jepsen node n1 - jepsen.os.debian :n1 setting up debian\nINFO [2017-03-30 10:08:52,385] jepsen node n1 - jepsen.etcdemo :n1 tearing down etcd\nINFO [2017-03-30 10:08:52,385] jepsen node n4 - jepsen.etcdemo :n4 tearing down etcd\nINFO [2017-03-30 10:08:52,385] jepsen node n2 - jepsen.etcdemo :n2 tearing down etcd\nINFO [2017-03-30 10:08:52,385] jepsen node n3 - jepsen.etcdemo :n3 tearing down etcd\nINFO [2017-03-30 10:08:52,385] jepsen node n5 - jepsen.etcdemo :n5 tearing down etcd\nINFO [2017-03-30 10:08:52,386] jepsen node n1 - jepsen.etcdemo :n1 installing etcd v3.1.5\nINFO [2017-03-30 10:08:52,386] jepsen node n4 - jepsen.etcdemo :n4 installing etcd v3.1.5\nINFO [2017-03-30 10:08:52,386] jepsen node n2 - jepsen.etcdemo :n2 installing etcd v3.1.5\nINFO [2017-03-30 10:08:52,386] jepsen node n3 - jepsen.etcdemo :n3 installing etcd v3.1.5\nINFO [2017-03-30 10:08:52,386] jepsen node n5 - jepsen.etcdemo :n5 installing etcd v3.1.5\n...\n```\n\nSee how the version string `\"v3.1.5\"` was passed from `etcd-test` to `db`,\nwhere it was captured by the `reify` expression? This is how we *parameterize*\nJepsen tests, so the same code can test multiple versions or options. Note also\nthat the object `reify` returns closes over its lexical scope, *remembering*\nthe value of `version`.\n\n## Installing the DB\n\nWith the skeleton of the DB in place, it's time to actually install something. Let's take a quick look at the [installation instructions for etcd](https://github.com/coreos/etcd/releases/tag/v3.1.5). It looks like we'll need to download a tarball, unpack it into a directory, set an environment variable for the API version, and run the `etcd` binary with it.\n\nWe'll have to be root to install packages, so we'll use `jepsen.control/su` to\nassume root privileges. Note that `su` (and its companions `sudo`, `cd`, etc)\nestablish *dynamic*, not *lexical* scope--their effects apply not only to the\ncode they enclose, but down the call stack to any functions called. Then we'll\nuse `jepsen.control.util/install-archive!` to download the etcd tarball and\ninstall it to `/opt/etcd`.\n\n```clj\n(def dir \"/opt/etcd\")\n\n(defn db\n \"Etcd DB for a particular version.\"\n [version]\n (reify db/DB\n (setup! [_ test node]\n (info node \"installing etcd\" version)\n (c/su\n (let [url (str \"https://storage.googleapis.com/etcd/\" version\n \"/etcd-\" version \"-linux-amd64.tar.gz\")]\n (cu/install-archive! url dir))))\n\n (teardown! [_ test node]\n (info node \"tearing down etcd\"))))\n```\nWe're using `jepsen.control/su` to become root (via sudo) while we remove the\netcd directory. `jepsen.control` provides a comprehensive DSL for executing\narbitrary shell commands on remote nodes.\n\nNow `lein run test` will go and install etcd itself. Note that Jepsen runs\n`setup` and `teardown` concurrently across all nodes. This might take a little\nwhile because each node has to download the tarball, but on future runs, Jepsen\nwill re-use the cached tarball on disk.\n\n## Starting the DB\n\n\nPer the [clustering instructions](https://coreos.com/etcd/docs/latest/v2/clustering.html), we'll need to generate a string like `\"ETCD_INITIAL_CLUSTER=\"infra0=http://10.0.1.10:2380,infra1=http://10.0.1.11:2380,infra2=http://10.0.1.12:2380\"`, so that our nodes know which nodes are a part of the cluster. Let's write a few small functions to build those strings:\n\n```clj\n(defn node-url\n \"An HTTP url for connecting to a node on a particular port.\"\n [node port]\n (str \"http://\" node \":\" port))\n\n(defn peer-url\n \"The HTTP url for other peers to talk to a node.\"\n [node]\n (node-url node 2380))\n\n(defn client-url\n \"The HTTP url clients use to talk to a node.\"\n [node]\n (node-url node 2379))\n\n(defn initial-cluster\n \"Constructs an initial cluster string for a test, like\n \\\"foo=foo:2380,bar=bar:2380,...\\\"\"\n [test]\n (->> (:nodes test)\n (map (fn [node]\n (str node \"=\" (peer-url node))))\n (str/join \",\")))\n```\n\nThe `->>` threading macro takes each form and inserts it into the next form as\na final argument. So `(->> test :nodes)` becomes `(:nodes test)`, and `(->> test\n:nodes (map-indexed (fn ...)))` becomes `(map-indexed (fn ...) (:nodes test))`,\nand so on. Normal function calls often look \"inside out\", but the `->>` macro\nlets us write a chain of operations \"in order\"--like an object-oriented\nlanguage's `foo.bar().baz()` notation.\n\nSo in `initial-cluster`, we take the nodes from a test map, and map each node\nto a string: its name, the \"=\" string, and its peer url. Then we join all those\nstrings together with commas.\n\nWith this in place, we'll tell the DB how to start up etcd as a daemon. We\ncould use an init script or service to start and stop the program, but since\nwe're working with a plain binary here, we'll use Debian's `start-stop-daemon`\ncommand to run `etcd` in the background.\n\nWe'll need a few more constants: the etcd binary, where to log output to, and\nwhere to store a pidfile.\n\n```clj\n(def dir \"/opt/etcd\")\n(def binary \"etcd\")\n(def logfile (str dir \"/etcd.log\"))\n(def pidfile (str dir \"/etcd.pid\"))\n```\n\nNow we'll use `jepsen.control.util`'s functions for starting and stopping\ndaemons to spin up etcd. Per the\n[documentation](https://coreos.com/etcd/docs/latest/v2/clustering.html), we'll\nneed to provide a node name, urls to listen on for clients and peers, and some\ninitial cluster state.\n\n```clj\n (setup! [_ test node]\n (info node \"installing etcd\" version)\n (c/su\n (let [url (str \"https://storage.googleapis.com/etcd/\" version\n \"/etcd-\" version \"-linux-amd64.tar.gz\")]\n (cu/install-archive! url dir))\n\n (cu/start-daemon!\n {:logfile logfile\n :pidfile pidfile\n :chdir dir}\n binary\n :--log-output :stderr\n :--name (name node)\n :--listen-peer-urls (peer-url node)\n :--listen-client-urls (client-url node)\n :--advertise-client-urls (client-url node)\n :--initial-cluster-state :new\n :--initial-advertise-peer-urls (peer-url node)\n :--initial-cluster (initial-cluster test))\n\n (Thread/sleep 10000)))\n```\n\nWe'll sleep for a little bit after starting the cluster, so it has a chance to boot up and perform its initial handshakes.\n\n## Tearing down\n\nTo make sure that every run starts fresh, even if a previous run crashed,\nJepsen performs a DB teardown at the start of the test, before setup. Then it\ntears the DB down again at the conclusion of the test. To tear down, we'll use\n`stop-daemon!`, and then delete the etcd directory, so that future runs won't\naccidentally read data from our current run.\n\n```clj\n (teardown! [_ test node]\n (info node \"tearing down etcd\")\n (cu/stop-daemon! binary pidfile)\n (c/su (c/exec :rm :-rf dir)))))\n```\n\nWe use `jepsen.control/exec` to run a shell command: `rm -rf`. \nJepsen automatically binds `exec` to operate on the `node` being set up\nduring `db/setup!`, but we can connect to arbitrary nodes if we need to. Note\nthat `exec` can take any mixture of strings, numbers, keywords--it'll convert\nthem to strings and perform appropriate shell escaping. You can use\n`jepsen.control/lit` for an unescaped literal string, if need be. `:>` and\n`:>>` perform shell redirection as you'd expect. That's an easy way to write\nout configuration files to disk, for databases that need config.\n\nLet's try it out.\n\n```bash\n$ lein run test\nNFO [2017-03-30 12:08:19,755] jepsen node n5 - jepsen.etcdemo :n5 installing etcd v3.1.5\nINFO [2017-03-30 12:08:19,755] jepsen node n1 - jepsen.etcdemo :n1 installing etcd v3.1.5\nINFO [2017-03-30 12:08:19,755] jepsen node n2 - jepsen.etcdemo :n2 installing etcd v3.1.5\nINFO [2017-03-30 12:08:19,755] jepsen node n4 - jepsen.etcdemo :n4 installing etcd v3.1.5\nINFO [2017-03-30 12:08:19,855] jepsen node n3 - jepsen.etcdemo :n3 installing etcd v3.1.5\nINFO [2017-03-30 12:08:20,866] jepsen node n4 - jepsen.control.util starting etcd\nINFO [2017-03-30 12:08:20,866] jepsen node n1 - jepsen.control.util starting etcd\nINFO [2017-03-30 12:08:20,866] jepsen node n5 - jepsen.control.util starting etcd\nINFO [2017-03-30 12:08:20,866] jepsen node n2 - jepsen.control.util starting etcd\nINFO [2017-03-30 12:08:20,963] jepsen node n3 - jepsen.control.util starting etcd\n...\n```\n\nLooks good. We can confirm that `teardown` did its job by checking that the etcd directory is empty after the test.\n\n```bash\n$ ssh n1 ls /opt/etcd\nls: cannot access /opt/etcd: No such file or directory\n```\n\n## Log files\n\nHang on--if we delete etcd's files after every run, how do we figure out\nwhat the database did? It'd be nice if we could download a copies of the\ndatabase's logs before cleaning up. For that, we'll use the `db/LogFiles`\nprotocol, and return a list of log file paths to download.\n\n```clj\n(defn db\n \"Etcd DB for a particular version.\"\n [version]\n (reify db/DB\n (setup! [_ test node]\n ...)\n\n (teardown! [_ test node]\n ...)\n\n db/LogFiles\n (log-files [_ test node]\n [logfile])))\n```\n\nNow, when we run a test, we'll find a copy of the log for each node, stored in the local directory `store/latest//`. If we get stuck setting up the DB, we can check those logs to see what's gone wrong.\n\n```bash\n$ less store/latest/n1/etcd.log\n...\n2018-02-02 11:36:51.848330 I | raft: 5440ff22fe632778 became leader at term 2\n2018-02-02 11:36:51.848360 I | raft: raft.node: 5440ff22fe632778 elected leader 5440ff22fe632778 at term 2\n2018-02-02 11:36:51.860295 I | etcdserver: setting up the initial cluster version to 3.1\n2018-02-02 11:36:51.864532 I | embed: ready to serve client requests\n...\n```\n\nLook for the line that says \"elected leader\"--that demonstrates that our nodes\nformed a cluster successfully. If your etcd nodes can't see each other, make\nsure that you're using the right port names, that you used `http://` instead of\n`https://` in `node-url`, and that nodes can ping one another.\n\nWith the database ready, it's time to [write a client](03-client.md).\n" }, { "path": "doc/tutorial/03-client.md", "content": "# Writing a client\n\nA Jepsen *client* takes *invocation operations* and applies them to the system\nbeing tested, returning corresponding *completion operations*. For our\netcd test, we might model the system as a single register: a particular key\nholding an integer. The operations against that register might be `read`,\n`write`, and `compare-and-set`, which we could model like so:\n\n```clj\n(defn r [_ _] {:type :invoke, :f :read, :value nil})\n(defn w [_ _] {:type :invoke, :f :write, :value (rand-int 5)})\n(defn cas [_ _] {:type :invoke, :f :cas, :value [(rand-int 5) (rand-int 5)]})\n```\n\nThese are functions that construct Jepsen *operations*: an abstract\nrepresentation of things you can do to a database. `:invoke` means that we're\ngoing to *try* an operation--when it completes, we'll use a type like `:ok` or\n`:fail` to tell what happened. The `:f` tells us what function we're applying\nto the database--for instance, that we want to perform a read or a write. These\ncan be *any* values--Jepsen doesn't know what they mean.\n\nFunction calls are parameterized by their arguments and return values. Jepsen\noperations are parameterized by `:value`, which can be anything we like--Jepsen\ndoesn't inspect them. We use a write's value to specify the value that we\nwrote, and a read's value to specify the value that we (eventually) read. When\nwe invoke a read, we don't know *what* we're going to read yet, so we'll leave\nit `nil`.\n\nThese functions can be used by `jepsen.generator` to construct new invocations\nfor reads, writes, and compare-and-set ops, respectively. Note that the read\nvalue is `nil`--we don't know what value is being read until we actually\nperform the read. When the client reads a particular value it'll fill that\nvalue in for the completion op.\n\n## Connecting to the database\n\nNow we need to take these operations and *apply* them to etcd. We'll use\nthe [Verschlimmbessergung](https://github.com/aphyr/verschlimmbesserung)\nlibrary to talk to etcd. We'll start by requiring Verschlimmbesserung, and\nwriting an empty implementation of Jepsen's Client protocol:\n\n```clj\n(ns jepsen.etcdemo\n (:require [clojure.tools.logging :refer :all]\n [clojure.string :as str]\n [verschlimmbesserung.core :as v]\n [jepsen [cli :as cli]\n [client :as client]\n [control :as c]\n [db :as db]\n [tests :as tests]]\n [jepsen.control.util :as cu]\n [jepsen.os.debian :as debian]))\n...\n(defrecord Client [conn]\n client/Client\n (open! [this test node]\n this)\n\n (setup! [this test])\n\n (invoke! [_ test op])\n\n (teardown! [this test])\n\n (close! [_ test]))\n```\n\n`defrecord` defines a new type of data structure, which we're calling `Client`.\nEach Client has a single field, called `conn`, which will hold our connection\nto a particular network server. Clients support Jepsen's Client protocol, and\njust like a `reify`, we'll provide implementations for Client functions.\n\nClients have a five-part lifecycle. We begin with a single *seed* client\n`(client)`. When we call `open!` on that client, we get a *copy* of the client\nbound to a particular node. The `setup!` function initializes any data\nstructures the test needs--for instance, creating tables or setting up\nfixtures. `invoke!` applies operations to the system and returns corresponding\ncompletion operations. `teardown!` cleans up any tables `setup!` may have\ncreated. `close!` closes network connections and completes the lifecycle for\nthe client.\n\nWhen it comes time to add the client to the test, we use `(Client.)` to\nconstruct a new Client, and pass `nil` as the value for `conn`. Remember, our\ninitial seed client doesn't have a connection; Jepsen will call `open!` to get\nconnected clients later.\n\n```clj\n(defn etcd-test\n \"Given an options map from the command line runner (e.g. :nodes, :ssh,\n :concurrency ...), constructs a test map.\"\n [opts]\n (merge tests/noop-test\n opts\n {:pure-generators true\n :name \"etcd\"\n :os debian/os\n :db (db \"v3.1.5\")\n :client (Client. nil)}))\n```\n\nNow, let's complete our `open!` function by connecting to etcd. The\n[Verschlimmbesserung docs](https://github.com/aphyr/verschlimmbesserung#usage)\ntell us that every function takes a Verschlimmbesserung client, created with\n`(connect url)`. That client is what we'll store in `conn`. Let's have\nVerschlimmbesserung time out requests after 5 seconds, too.\n\n```clj\n(defrecord Client [conn]\n client/Client\n (open! [this test node]\n (assoc this :conn (v/connect (client-url node)\n {:timeout 5000})))\n\n (setup! [this test])\n\n (invoke! [_ test op])\n\n (teardown! [this test])\n\n (close! [_ test]\n ; If our connection were stateful, we'd close it here. Verschlimmmbesserung\n ; doesn't actually hold connections, so there's nothing to close.\n ))\n\n(defn etcd-test\n \"Given an options map from the command-line runner (e.g. :nodes, :ssh,\n :concurrency, ...), constructs a test map.\"\n [opts]\n (merge tests/noop-test\n opts\n {:name \"etcd\"\n :os debian/os\n :db (db \"v3.1.5\")\n :client (Client. nil)}))\n```\n\nRemember, the initial client *has no connections*--like a stem cell, it has the\n*potential* to become an active client but doesn't do any work directly. We\ncall `(Client. nil)` to construct that initial client--its conn will be filled\nin when Jepsen calls `open!`.\n\n## Reads\n\nNow we have to actually *do* something with the client. Let's start with fifteen\nseconds of reads, randomly staggered about a second apart. We'll pull in `jepsen.generator` to schedule operations.\n\n```clj\n(ns jepsen.etcdemo\n (:require [clojure.tools.logging :refer :all]\n [clojure.string :as str]\n [verschlimmbesserung.core :as v]\n [jepsen [cli :as cli]\n [client :as client]\n [control :as c]\n [db :as db]\n [generator :as gen]\n [tests :as tests]]\n [jepsen.control.util :as cu]\n [jepsen.os.debian :as debian]))\n```\n\n... and write a simple generator: take reads, stagger them by about a second,\ngive those operations to clients only (not the nemesis, which has other\nduties), and stop after 15 seconds.\n\n```clj\n(defn etcd-test\n \"Given an options map from the command line runner (e.g. :nodes, :ssh,\n :concurrency ...), constructs a test map.\"\n [opts]\n (merge tests/noop-test\n opts\n {:pure-generators true\n :name \"etcd\"\n :os debian/os\n :db (db \"v3.1.5\")\n :client (Client. nil)\n :generator (->> r\n (gen/stagger 1)\n (gen/nemesis nil)\n (gen/time-limit 15))}))\n```\n\nThis throws a bunch of errors, because we haven't told the client *how* to\nintepret these reads yet.\n\n```bash\n$ lein run test\n...\nWARN [2020-09-21 20:16:33,150] jepsen worker 0 - jepsen.generator.interpreter Process 0 crashed\nclojure.lang.ExceptionInfo: throw+: {:type :jepsen.client/invalid-completion, :op {:type :invoke, :f :read, :value nil, :time 26387538, :process 0}, :op' nil, :problems [\"should be a map\" \":type should be :ok, :info, or :fail\" \":process should be the same\" \":f should be the same\"]}\n```\n\nThe client's `invoke!` function takes an invocation operation, and right now,\ndoes nothing with it, returning `nil`. Jepsen is telling us that it should be a\nmap, and specifically one with a `:type` field, a matching `:process`, and a\nmatching `:f`. In short, we have to construct a completion operation which\n*concludes* the invocation operation. We'll construct this completion op with\ntype `:ok` if the operation succeeded, `:fail` if it didn't take place, or\n`:info` if we're not sure. `invoke!` can also throw an exception, which is\nautomatically converted to an `:info`.\n\nLet's start by handling reads. We'll use `v/get` to read the value of a single\nkey. We can pick any name we like--let's call it \"foo\" for now.\n\n```clj\n (invoke! [this test op]\n (case (:f op)\n :read (assoc op :type :ok, :value (v/get conn \"foo\"))))\n```\n\nWe dispatch based on the `:f` field of the operation, and when it's a\n`:read`, we take the invoke op and return a copy of it, with `:type` `:ok` and\na value obtained by reading the register \"foo\".\n\n```bash\n$ lein run test\n...\nINFO [2017-03-30 15:28:17,423] jepsen worker 2 - jepsen.util 2 :invoke :read nil\nINFO [2017-03-30 15:28:17,427] jepsen worker 2 - jepsen.util 2 :ok :read nil\nINFO [2017-03-30 15:28:18,315] jepsen worker 0 - jepsen.util 0 :invoke :read nil\nINFO [2017-03-30 15:28:18,320] jepsen worker 0 - jepsen.util 0 :ok :read nil\nINFO [2017-03-30 15:28:18,437] jepsen worker 4 - jepsen.util 4 :invoke :read nil\nINFO [2017-03-30 15:28:18,441] jepsen worker 4 - jepsen.util 4 :ok :read nil\n```\n\nMuch better! We haven't created the key yet, so its value is `nil`. In order to\nchange the value, we'll add some some writes to the generator.\n\n## Writes\n\nWe'll change our generator to take a random mixture of reads and writes, using\n`(gen/mix [r w])`.\n\n```clj\n(defn etcd-test\n \"Given an options map from the command line runner (e.g. :nodes, :ssh,\n :concurrency ...), constructs a test map.\"\n [opts]\n (merge tests/noop-test\n opts\n {:pure-generators true\n :name \"etcd\"\n :os debian/os\n :db (db \"v3.1.5\")\n :client (Client. nil)\n :generator (->> (gen/mix [r w])\n (gen/stagger 1)\n (gen/nemesis nil)\n (gen/time-limit 15))}))\n```\n\nTo handle those writes, we'll use `v/reset!`, and return the op with\n`:type` `:ok`. If `reset!` fails it'll throw, and Jepsen's machinery will\nautomatically convert it to an `:info` crash.\n\n```clj\n (invoke! [this test op]\n (case (:f op)\n :read (assoc op :type :ok, :value (v/get conn \"foo\"))\n :write (do (v/reset! conn \"foo\" (:value op))\n (assoc op :type :ok))))\n```\n\nWe'll confirm writes work by watching the test:\n\n```bash\n$ lein run test\nINFO [2017-03-30 22:14:25,428] jepsen worker 4 - jepsen.util 4 :invoke :write 0\nINFO [2017-03-30 22:14:25,439] jepsen worker 4 - jepsen.util 4 :ok :write 0\nINFO [2017-03-30 22:14:25,628] jepsen worker 0 - jepsen.util 0 :invoke :read nil\nINFO [2017-03-30 22:14:25,633] jepsen worker 0 - jepsen.util 0 :ok :read \"0\"\n```\n\nAh, we've got a bit of a snag here. etcd thinks in terms of strings, but we'd\nlike to work with numbers. We could pull in a serialization library (jepsen\nincludes a simple one in `jepsen.codec`), but since we're only dealing with\nintegers and nil, we can get away with using Clojure's built-in `parse-long`\nfunction. It doesn't like being passed `nil`, though, so we'll write a small\nwrapper:\n\n```clj\n(defn parse-long-nil\n \"Parses a string to a Long. Passes through `nil`.\"\n [s]\n (when s (parse-long s)))\n\n...\n\n (invoke! [_ test op]\n (case (:f op)\n :read (assoc op :type :ok, :value (parse-long-nil (v/get conn \"foo\")))\n :write (do (v/reset! conn \"foo\" (:value op))\n (assoc op :type :ok))))\n```\n\nNote that we only call `parse-long` when our string is truthy--using `(when s\n…)`. If `when` doesn't match, it'll return `nil`, which lets us pass through\n`nil` values transparently.\n\n```bash\n$ lein run test\n...\nINFO [2017-03-30 22:26:45,322] jepsen worker 4 - jepsen.util 4 :invoke :write 1\nINFO [2017-03-30 22:26:45,341] jepsen worker 4 - jepsen.util 4 :ok :write 1\nINFO [2017-03-30 22:26:45,434] jepsen worker 2 - jepsen.util 2 :invoke :read nil\nINFO [2017-03-30 22:26:45,439] jepsen worker 2 - jepsen.util 2 :ok :read 1\n```\n\nSeems reasonable! Only one type of operation left to implement: compare-and-set.\n\n## Compare and set\n\nWe'll finish the client by adding compare-and-set to the mix:\n\n```clj\n (gen/mix [r w cas])\n```\n\nHandling CaS is a little trickier. Verschlimmbesserung gives us a `cas!`\nfunction, which takes a connection, key, old value, and new value. `cas!` sets\nthe key to the new value if and only if the old value matches what's currently\nthere, and returns a detailed response map. If the CaS fails, it returns false.\nWe can use that to determine the `:type` of the CaS operation.\n\n```clj\n (invoke! [_ test op]\n (case (:f op)\n :read (assoc op :type :ok, :value (parse-long-nil (v/get conn \"foo\")))\n :write (do (v/reset! conn \"foo\" (:value op))\n (assoc op :type :ok))\n :cas (let [[old new] (:value op)]\n (assoc op :type (if (v/cas! conn \"foo\" old new)\n :ok\n :fail)))))\n```\n\nThe `let` binding here uses *destructuring*: it breaks apart the `[old-value\nnew-value]` pair from the operation's `:value` field into `old` and `new`.\nSince all values except `false` and `nil` are logically true, we can use the\nresult of the `cas!` call as our predicate in `if`.\n\n## Handling exceptions\n\nIf you run this a few times, you might see:\n\n```bash\n$ lein run test\n...\nINFO [2017-03-30 22:38:51,892] jepsen worker 1 - jepsen.util 1 :invoke :cas [3 1]\nWARN [2017-03-30 22:38:51,936] jepsen worker 1 - jepsen.core Process 1 indeterminate\nclojure.lang.ExceptionInfo: throw+: {:errorCode 100, :message \"Key not found\", :cause \"/foo\", :index 11, :status 404}\n at slingshot.support$stack_trace.invoke(support.clj:201) ~[na:na]\n ...\n```\n\nIf we try to CaS the key before it's written, Verschlimmbesserung will throw an\nexception complaining (quite sensibly!) that we can't alter something that\ndoesn't exist. This won't cause our test to return false positives--Jepsen will\ninterpret the exception as an indeterminate `:info` result, and allow that it\nmight or might not have taken place. However, we *know* the value didn't change\nwhen we get this exception, so we can convert it to a known failure. We'll pull\nin the `slingshot` exception handling library, so we can catch that particular\nerror code.\n\n```clj\n(ns jepsen.etcdemo\n (:require ...\n [slingshot.slingshot :refer [try+]]))\n```\n\n... and wrap our `cas` in a try/catch block.\n\n```clj\n (invoke! [this test op]\n (case (:f op)\n :read (assoc op :type :ok, :value (parse-long-nil (v/get conn \"foo\")))\n :write (do (v/reset! conn \"foo\" (:value op))\n (assoc op :type :ok))\n :cas (try+\n (let [[old new] (:value op)]\n (assoc op :type (if (v/cas! conn \"foo\" old new)\n :ok\n :fail)))\n (catch [:errorCode 100] ex\n (assoc op :type :fail, :error :not-found)))))\n```\n\nThis [:errorCode 100] form tells Slingshot to catch only exceptions which have\nthat particular error code, and bind them to `ex`. We've added an extra\n`:error` field to our operation. This doesn't matter as far as correctness is\nconcerned, but it helps us understand what happened when we read the logs.\nJepsen prints errors at the end of log lines.\n\n```bash\n$ lein run test\n...\nINFO [2017-03-30 23:00:50,978] jepsen worker 0 - jepsen.util 0 :invoke :cas [1 4]\nINFO [2017-03-30 23:00:51,065] jepsen worker 0 - jepsen.util 0 :fail :cas [1 4] :not-found\n```\n\nMuch neater. In general, we'll start by writing the simplest code we can, and\nallow Jepsen to handle exceptions for us. Once we have a feeling for how things\ncan go wrong, we can introduce special error handlers and semantics for those\nfailure cases.\n\n```bash\n...\nINFO [2017-03-30 22:38:59,278] jepsen worker 1 - jepsen.util 11 :invoke :write 4\nINFO [2017-03-30 22:38:59,286] jepsen worker 1 - jepsen.util 11 :ok :write 4\nINFO [2017-03-30 22:38:59,289] jepsen worker 4 - jepsen.util 4 :invoke :cas [2 2]\nINFO [2017-03-30 22:38:59,294] jepsen worker 1 - jepsen.util 11 :invoke :read nil\nINFO [2017-03-30 22:38:59,297] jepsen worker 1 - jepsen.util 11 :ok :read 4\nINFO [2017-03-30 22:38:59,298] jepsen worker 4 - jepsen.util 4 :fail :cas [2 2]\nINFO [2017-03-30 22:38:59,818] jepsen worker 4 - jepsen.util 4 :invoke :write 1\nINFO [2017-03-30 22:38:59,826] jepsen worker 4 - jepsen.util 4 :ok :write 1\nINFO [2017-03-30 22:38:59,917] jepsen worker 1 - jepsen.util 11 :invoke :cas [1 2]\nINFO [2017-03-30 22:38:59,926] jepsen worker 1 - jepsen.util 11 :ok :cas [1 2]\n```\n\nNotice that some CaS operations fail, and other succeed? It's OK for them to\nfail, and in fact, it's desirable. We expect some CaS ops to fail because their\npredicate value doesn't match the current value, but a few (~1/5, since there\nare 5 possible values for the register at any given point) should succeed. In\naddition, it's worth trying operations we think should be impossible, because\nif they *do* succeed, that can point to a consistency violation.\n\nWith our client performing operations, it's time to analyze results using a\n[checker](04-checker.md).\n" }, { "path": "doc/tutorial/04-checker.md", "content": "# Checking Correctness\n\nWith our generator and clients performing operations, we've got a history to\nanalyze for correctness. Jepsen uses a *model* to represent the abstract\nbehavior of a system, and a *checker* to verify whether the history conforms to\nthat model. We'll require `knossos.model` and `jepsen.checker`:\n\n```clj\n(ns jepsen.etcdemo\n (:require [clojure.tools.logging :refer :all]\n [clojure.string :as str]\n [jepsen [checker :as checker]\n [cli :as cli]\n [client :as client]\n [control :as c]\n [db :as db]\n [generator :as gen]\n [tests :as tests]]\n [jepsen.control.util :as cu]\n [jepsen.os.debian :as debian]\n [knossos.model :as model]\n [slingshot.slingshot :refer [try+]]\n [verschlimmbesserung.core :as v])\n (:import (knossos.model Model)))\n```\n\nRemember how we chose to model our operations as reads, writes, and cas operations?\n\n```clj\n(defn r [_ _] {:type :invoke, :f :read, :value nil})\n(defn w [_ _] {:type :invoke, :f :write, :value (rand-int 5)})\n(defn cas [_ _] {:type :invoke, :f :cas, :value [(rand-int 5) (rand-int 5)]})\n```\n\nJepsen doesn't know what `:f :read` or `:f :cas` mean. As far as it's\nconcerned, they're arbitrary values. However, our *client* understands how to\ninterpret those operations, when it dispatches based on `(case (:f op) :read\n...)`. Now we need a *model* of the system which understands those same\noperations. Knossos defines a Model data type for us, which takes a model and an\noperation to apply, and returns a new model resulting from that operation. Here's that code, inside `knossos.model`:\n\n```clj\n(definterface+ Model\n (step [model op]\n \"The job of a model is to *validate* that a sequence of operations\n applied to it is consistent. Each invocation of (step model op)\n returns a new state of the model, or, if the operation was\n inconsistent with the model's state, returns a (knossos/inconsistent\n msg). (reduce step model history) then validates that a particular\n history is valid, and returns the final state of the model.\n Models should be a pure, deterministic function of their state and an\n operation's :f and :value.\"))\n```\n\nIt turns out that the Knossos checker defines some common models for things\nlike locks and registers. Here's one for [a compare-and-set register](https://github.com/jepsen-io/knossos/blob/443a5a081c76be315eb01c7990cc7f1d9e41ed9b/src/knossos/model.clj#L66-L80)--exactly the datatype we're modeling.\n\n```clj\n(defrecord CASRegister [value]\n Model\n (step [r op]\n (condp = (:f op)\n :write (CASRegister. (:value op))\n :cas (let [[cur new] (:value op)]\n (if (= cur value)\n (CASRegister. new)\n (inconsistent (str \"can't CAS \" value \" from \" cur\n \" to \" new))))\n :read (if (or (nil? (:value op))\n (= value (:value op)))\n r\n (inconsistent (str \"can't read \" (:value op)\n \" from register \" value))))))\n```\n\nWe don't need to write these in our tests, as long as `knossos` provides a\nmodel for the type of thing we're checking. This is just so you can see how\nthings work under the hood.\n\nThis defrecord defines a new data type called `CASRegister`, which has a\nsingle, immutable field, called `value`. It satisfies the `Model` interface we\ndiscussed earlier, and its `step` function takes a current register `r`, and an\noperation `op`. When we want to write a new value, we simply return a new\n`CASRegister` with that value assigned. To compare-and-set from one value to\nanother, we pull apart the current and new values from the operation, and if\nthe current and new values match, construct a fresh register with the new\nvalue. If they don't match, we return a special type of model with\n`inconsistent`, which indicates that that operation could not be applied to the\nregister. Reads are similar, except that we always allow reads of `nil` to pass\nthrough. This allows us to satisfy histories which include reads that never\nreturned.\n\nTo analyze the history, we'll specify a `:checker` for the test, and provide a\n`:model` to specify how the system *should* behave. `checker/linearizable` uses\nthe Knossos linearizability checker to verify that every operation appears to\ntake place atomically between its invocation and completion. The linearizable\nchecker requires a model and to specify a particular algorithm which we pass to\nit in an options map.\n\n```clj\n(defn etcd-test\n \"Given an options map from the command line runner (e.g. :nodes, :ssh,\n :concurrency ...), constructs a test map.\"\n [opts]\n (merge tests/noop-test\n opts\n {:pure-generators true\n :name \"etcd\"\n :os debian/os\n :db (db \"v3.1.5\")\n :client (Client. nil)\n :checker (checker/linearizable\n {:model (model/cas-register)\n :algorithm :linear})\n :generator (->> (gen/mix [r w cas])\n (gen/stagger 1)\n (gen/nemesis nil)\n (gen/time-limit 15))}))\n```\n\nRunning the test, we can confirm the checker's results:\n\n```bash\n$ lein run test\n...\nINFO [2019-04-17 17:38:16,855] jepsen worker 0 - jepsen.util 0 :invoke :write 1\nINFO [2019-04-17 17:38:16,861] jepsen worker 0 - jepsen.util 0 :ok :write 1\n...\nINFO [2019-04-18 03:53:32,714] jepsen test runner - jepsen.core {:valid? true,\n :configs\n ({:model #knossos.model.CASRegister{:value 3},\n :last-op\n {:process 1,\n :type :ok,\n :f :write,\n :value 3,\n :index 29,\n :time 14105346871},\n :pending []}),\n :analyzer :linear,\n :final-paths ()}\n\n\nEverything looks good! ヽ(‘ー`)ノ\n```\n\nThe last operation in this history was a write of `1`, and sure enough, the\nchecker's final value is also `1`. This history was linearizable.\n\n## Multiple checkers\n\nCheckers can render all kinds of output--as data structures, images, or\ninteractive visualizations. For instance, if we have `gnuplot` installed,\nJepsen can generate throughput and latency graphs for us. Let's use\n`checker/compose` to run both a linearizability analysis, and generate\nperformance graphs.\n\n```clj\n :checker (checker/compose\n {:perf (checker/perf)\n :linear (checker/linearizable {:model (model/cas-register)\n :algorithm :linear})})\n```\n\n```bash\n$ lein run test\n...\n$ open store/latest/latency-raw.png\n```\n\nWe can also generate HTML visualizations of the history. Let's add the `jepsen.checker.timeline` namespace:\n\n```clj\n(ns jepsen.etcdemo\n (:require ...\n [jepsen.checker.timeline :as timeline]\n ...))\n```\n\nAnd add that checker to the test:\n\n```clj\n :checker (checker/compose\n {:perf (checker/perf)\n :linear (checker/linearizable\n {:model (model/cas-register)\n :algorithm :linear})\n :timeline (timeline/html)})\n```\n\nNow we can plot how different processes performed operations over time--which\nones were concurrent, which ones succeeded, failed, or crashed, and so on.\n\n```bash\n$ lein run test\n...\n$ open store/latest/timeline.html\n```\n\nNow that we've got a passing test, it's time to [introduce\nfailures](05-nemesis.md) into the system.\n" }, { "path": "doc/tutorial/05-nemesis.md", "content": "# Introducing Faults\n\nThe nemesis is a special client, not bound to any particular node, which\nintroduces failures across the cluster. We'll require `jepsen.nemesis`, which\nprovides several built-in failure modes.\n\n```clj\n(ns jepsen.etcdemo\n (:require [clojure.tools.logging :refer :all]\n [clojure.string :as str]\n [jepsen [checker :as checker]\n [cli :as cli]\n [client :as client]\n [control :as c]\n [db :as db]\n [generator :as gen]\n [nemesis :as nemesis]\n [tests :as tests]]\n [jepsen.checker.timeline :as timeline]\n [jepsen.control.util :as cu]\n [jepsen.os.debian :as debian]\n [knossos.model :as model]\n [slingshot.slingshot :refer [try+]]\n [verschlimmbesserung.core :as v]))\n```\n\nWe'll pick a simple nemesis to start, and add it to the `:nemesis` key for the\ntest. This one partitions the network into two halves, selected randomly, when\nit receives a `:start` op, and heals the network when it receives a `:stop`.\n\n```clj\n\n(defn etcd-test\n \"Given an options map from the command line runner (e.g. :nodes, :ssh,\n :concurrency ...), constructs a test map.\"\n [opts]\n (merge tests/noop-test\n opts\n {:pure-generators true\n :name \"etcd\"\n :os debian/os\n :db (db \"v3.1.5\")\n :client (Client. nil)\n :nemesis (nemesis/partition-random-halves)\n :checker (checker/compose\n {:perf (checker/perf)\n :linear (checker/linearizable\n {:model (model/cas-register)\n :algorithm :linear})\n :timeline (timeline/html)})\n :generator (->> (gen/mix [r w cas])\n (gen/stagger 1)\n (gen/nemesis nil)\n (gen/time-limit 15))}))\n```\n\nLike regular clients, the nemesis draws operations from the generator. Right\nnow our generator only emits ops to regular clients--the nemesis just gets\n`nil`, which tells it there's nothing to do. We'll replace that with a\ndedicated generator for nemesis operations. We're also going to increase the time limit, so we have enough time to see the nemesis take effect.\n\n```clj\n :generator (->> (gen/mix [r w cas])\n (gen/stagger 1)\n (gen/nemesis\n (cycle [(gen/sleep 5)\n {:type :info, :f :start}\n (gen/sleep 5)\n {:type :info, :f :stop}]))\n (gen/time-limit 30))}\n```\n\nClojure sequences can act as generators, so we can use regular Clojure\nfunctions to construct them. Here, we use `cycle` to construct an infinite loop\nof sleep, start, sleep, stop, ..., which ends once the time limit is up.\n\nThe network partition causes some operations to crash:\n\n```clj\nWARN [2018-02-02 15:54:53,380] jepsen worker 1 - jepsen.core Process 1 crashed\njava.net.SocketTimeoutException: Read timed out\n```\n\n... and so on. If we *know* an operation didn't take place we can make the\nchecker more efficient (and detect more bugs!) by returning ops with `:type\n:fail` instead of letting `client/invoke!` throw exceptions, but letting every\nerror crash the process is still safe: jepsen's checkers understand that a\ncrashed operation may or may not take place.\n\n## Finding a bug\n\nWe've hardcoded a 30 second time limit into our test, but it'd be nice if we\ncould control that at the command line. Jepsen's CLI kit provides a\n`--time-limit` switch, which is passed to `etcd-test` as `:time-limit`, in the\noptions map. Let's hook that up now:\n\n```clj\n :generator (->> (gen/mix [r w cas])\n (gen/stagger 1)\n (gen/nemesis\n (gen/seq (cycle [(gen/sleep 5)\n {:type :info, :f :start}\n (gen/sleep 5)\n {:type :info, :f :stop}])))\n (gen/time-limit (:time-limit opts)))}\n```\n\n```bash\n$ lein run test --time-limit 60\n...\n```\n\nNow that we can run tests for shorter or longer, let's speed up the request rate. If we take too long between requests, we won't have a chance to see interesting behaviors. Let's try a tenth of a second between requests:\n\n```clj\n :generator (->> (gen/mix [r w cas])\n (gen/stagger 1/50)\n (gen/nemesis\n (cycle [(gen/sleep 5)\n {:type :info, :f :start}\n (gen/sleep 5)\n {:type :info, :f :stop}]))\n (gen/time-limit (:time-limit opts)))}\n```\n\nIf you run this test a few times, you might notice an interesting result.\nSometimes, it fails!\n\n```clj\n$ lein run test --test-count 10\n...\n :model {:msg \"can't read 3 from register 4\"}}]\n...\nAnalysis invalid! (ﾉಥ益ಥ）ﾉ ┻━┻\n```\n\nKnossos ran out of options: it thought the only legal value for the register\nwas 4, but a process successfully read 3. When a linearizability failure\noccurs, Knossos will emit an SVG diagram showing the problem--and we can read\nthe history to see the op in more detail.\n\n```clj\n$ open store/latest/linear.svg\n$ open store/latest/history.txt\n```\n\nThis is a case of a stale read: we saw a value from the *past*, despite more\nrecent writes having completed. This occurs because etcd allows us to read the\nlocal state of any replica, without going through consensus to ensure we have\nthe most recent state.\n\n## Read consistency\n\nThe etcd docs claim \"etcd ensures linearizability for all [operations other\nthan watches] by default.\" This is clearly not the case--and indeed, buried in\nthe [v2 API docs](https://coreos.com/etcd/docs/latest/v2/api.html) is this\nunobtrusive note:\n\n> If you want a read that is fully linearized you can use a quorum=true GET. The read will take a very similar path to a write and will have a similar speed. If you are unsure if you need this feature feel free to email etcd-dev for advice.\n\nAha! So we need to use *quorum* reads. Verschlimmbesserung has an option for\nthat:\n\n```clj\n (invoke! [this test op]\n (case (:f op)\n :read (let [value (-> conn\n (v/get \"foo\" {:quorum? true})\n parse-long-nil)]\n (assoc op :type :ok, :value value))\n ...\n```\n\nIntroducing quorum reads makes our tests pass!\n\n```bash\n$ lein run test\n...\nEverything looks good! ヽ(‘ー`)ノ\n```\n\nCongratulations! You've written your first successful Jepsen test. This is the\nsame issue I identified in\n[2014](https://aphyr.com/posts/316-jepsen-etcd-and-consul), and dialogue with\nthe etcd team led them to introduce the *quorum* read option.\n\nTake a quick break! You've earned it! Then, if you like, we can move onto [refining the test](06-refining.md).\n" }, { "path": "doc/tutorial/06-refining.md", "content": "# Refining Tests\n\nOur test identified a fault, but it took some luck and clever guessing to\nstumble upon it. It's time to refine our test, to make it faster, easier to\nunderstand, and more powerful.\n\nIn order to analyze the history of a single key, Jepsen searches through every\npermutation of concurrent operations, looking for a history that follows the\nrules of a compare-and-set register. This means our search is exponential in\nthe number of concurrent operations at any given point in time.\n\nJepsen runs with a fixed number of worker threads, which would ordinarily limit\nthe number of concurrent operations too. However, when operations *crash*\n(either by returning an `:info` result or throwing an exception), we abandon\nthat operation and let the thread move on to something new. It might be the\ncase that the crashed process' operation is still in-flight, and might be\nexecuted by the database at some later time. This implies that crashed\noperations are *concurrent for the entire remainder of the history.*\n\nThe more crashed operations, the more operations are concurrent by the end of\nthe history. That linear increase in concurrency is accompanied by an\nexponential increase in verification time. Our first order of business is\nreducing the number of crashed operations. We'll start with reads.\n\n## Crashed reads\n\nWhen an operation times out, we get a long stacktrace like\n\n```\nWARN [2018-02-02 16:14:37,588] jepsen worker 1 - jepsen.core Process 11 crashed\njava.net.SocketTimeoutException: Read timed out\n at java.net.SocketInputStream.socketRead0(Native Method) ~[na:1.8.0_40]\n ...\n```\n\n... and that process' operation is converted to an `:info` message, because we\ncan't tell if it succeeded or failed. However, *idempotent* operations, like\nreads, leave the state of the system unchanged. It doesn't *matter* whether\nthey succeed or fail, because the effects are equivalent. We can therefore\nsafely convert crashed reads to failed reads, and improve checker performance.\n\n```clj\n (invoke! [_ test op]\n (case (:f op)\n :read (try (let [value (-> conn\n (v/get \"foo\" {:quorum? true})\n parse-long-nil)]\n (assoc op :type :ok, :value value))\n (catch java.net.SocketTimeoutException ex\n (assoc op :type :fail, :error :timeout)))\n :write (do (v/reset! conn \"foo\" (:value op))\n (assoc op :type :ok))\n :cas (try+\n (let [[old new] (:value op)]\n (assoc op :type (if (v/cas! conn \"foo\" old new)\n :ok\n :fail)))\n (catch [:errorCode 100] ex\n (assoc op :type :fail, :error :not-found)))))\n```\n\nBetter yet--we can get rid of all the exception stacktrace noise in the logs if\nwe catch socket timeouts on all three paths at once. We'll handle not-found\nerrors there too, even though they only happen on `:cas` ops--it keeps the code\na little cleaner.\n\n```clj\n (invoke! [_ test op]\n (try+\n (case (:f op)\n :read (let [value (-> conn\n (v/get \"foo\" {:quorum? true})\n parse-long-nil)]\n (assoc op :type :ok, :value value))\n :write (do (v/reset! conn \"foo\" (:value op))\n (assoc op :type :ok))\n :cas (let [[old new] (:value op)]\n (assoc op :type (if (v/cas! conn \"foo\" old new)\n :ok\n :fail))))\n\n (catch java.net.SocketTimeoutException e\n (assoc op\n :type (if (= :read (:f op)) :fail :info)\n :error :timeout))\n\n (catch [:errorCode 100] e\n (assoc op :type :fail, :error :not-found))))\n```\n\nNow we get nice short timeout errors on *all* operations, not just reads.\n\n```bash\nINFO [2017-03-31 19:34:47,351] jepsen worker 4 - jepsen.util 4 :info :cas [4 4] :timeout\n```\n\n## Independent keys\n\nWe have a working test for a single linearizable key. However, sooner or later\nprocesses *are* going to crash, and our concurrency will rise, slowing down the\nanalysis. We need a way to *bound* the length of a history on a particular key,\nwhile still performing enough operations to observe concurrency errors.\n\nSince operations on independent keys linearize independently, we can *lift* our\nsingle-key test into one which operates on multiple keys. The\n`jepsen.independent` namespace provides support.\n\n```clj\n(ns jepsen.etcdemo\n (:require [clojure.tools.logging :refer :all]\n [clojure.string :as str]\n [jepsen [checker :as checker]\n [cli :as cli]\n [client :as client]\n [control :as c]\n [db :as db]\n [generator :as gen]\n [independent :as independent]\n [nemesis :as nemesis]\n [tests :as tests]]\n [jepsen.checker.timeline :as timeline]\n [jepsen.control.util :as cu]\n [jepsen.os.debian :as debian]\n [knossos.model :as model]\n [slingshot.slingshot :refer [try+]]\n [verschlimmbesserung.core :as v]))\n```\n\nWe have a generator that emits operations on a single key, like `{:type :invoke,\n:f :write, :value 3}`. We want to lift that to an operation that writes\n*multiple* keys. Instead of `:value v`, we want `:value [key v]`.\n\n```clj\n :generator (->> (independent/concurrent-generator\n 10\n (range)\n (fn [k]\n (->> (gen/mix [r w cas])\n (gen/stagger 1/50)\n (gen/limit 100))))\n (gen/nemesis\n (cycle [(gen/sleep 5)\n {:type :info, :f :start}\n (gen/sleep 5)\n {:type :info, :f :stop}]))\n (gen/time-limit (:time-limit opts)))}))\n```\n\nOur mix of reads, writes, and cas ops is still in there, but it's been wrapped\nup in a *function*, which takes a key and returns a generator of values for\nthat particular key. We're using `concurrent-generator` to have 10 threads per\nkey, with keys taken from the infinite sequence of integers `(range)`, and\ngenerators for those keys derived from `(fn [k] ...)`.\n\n`concurrent-generator` changes the shape of our values from `v` to `[k v]`, so\nwe need to modify our client to understand how to read and write to different\nkeys.\n\n```clj\n (invoke! [_ test op]\n (let [[k v] (:value op)]\n (try+\n (case (:f op)\n :read (let [value (-> conn\n (v/get k {:quorum? true})\n parse-long-nil)]\n (assoc op :type :ok, :value (independent/tuple k value)))\n\n :write (do (v/reset! conn k v)\n (assoc op :type :ok))\n\n :cas (let [[old new] v]\n (assoc op :type (if (v/cas! conn k old new)\n :ok\n :fail))))\n\n (catch java.net.SocketTimeoutException e\n (assoc op\n :type (if (= :read (:f op)) :fail :info)\n :error :timeout))\n\n (catch [:errorCode 100] e\n (assoc op :type :fail, :error :not-found)))))\n```\n\nSee how our hardcoded key `\"foo\"` is gone? Now every key is parameterized by the\noperation itself. Also note that where we modify the value--for instance, in\n`:f :read`--we have to construct a special `independent/tuple` for the\nkey/value pair. Having a special datatype for tuples allows\n`jepsen.independent` to split up the history later.\n\nFinally, our checker thinks in terms of a single value--but we can turn that\ninto a checker that reasons about *independent* values, identified by keys.\n\n```clj\n :checker (checker/compose\n {:perf (checker/perf)\n :indep (independent/checker\n (checker/compose\n {:linear (checker/linearizable {:model (model/cas-register)\n :algorithm :linear})\n :timeline (timeline/html)}))})\n```\n\nWrite one checker, get a family of n checkers for free! Maaaaagic!\n\n```bash\n$ lein run test --time-limit 30\n...\nERROR [2017-03-31 19:51:28,300] main - jepsen.cli Oh jeez, I'm sorry, Jepsen broke. Here's why:\njava.util.concurrent.ExecutionException: java.lang.AssertionError: Assert failed: This jepsen.independent/concurrent-generator has 5 threads to work with, but can only use 0 of those threads to run 0 concurrent keys with 10 threads apiece. Consider raising or lowering the test's :concurrency to a multiple of 10.\n```\n\nAha. Our default concurrency is 5 threads, but we're asking for at least 10 in order to run a single key. Let's run 10 keys, using 100 threads.\n\n```bash\n$ lein run test --time-limit 30 --concurrency 100\n...\n142 :invoke :read [134 nil]\n67 :invoke :read [133 nil]\n66 :ok :read [133 1]\n101 :ok :read [137 3]\n181 :ok :write [135 3]\n116 :ok :read [131 3]\n111 :fail :cas [131 [0 0]]\n151 :invoke :read [138 nil]\n129 :ok :write [130 2]\n159 :ok :read [138 1]\n64 :ok :write [133 0]\n69 :ok :cas [133 [0 0]]\n109 :ok :cas [137 [4 3]]\n89 :ok :read [135 1]\n139 :ok :read [139 4]\n19 :fail :cas [131 [2 1]]\n124 :fail :cas [130 [4 4]]\n```\n\nLook at that! We can perform far more operations in a limited time window now. This helps us find bugs faster.\n\nWe've hardcoded a lot so far. Let's make some of those choices [configurable](07-parameters.md) at the command line.\n" }, { "path": "doc/tutorial/07-parameters.md", "content": "# Tuning with Parameters\n\nWe allowed our last test to pass by including a `quorum` flag on reads, but in order to see the original stale-reads bug, we have to edit the source code again, flipping the flag to `false`. It'd be nice if we could adjust that from the command line. Jepsen provides several command-line options by default in [jepsen.cli](https://github.com/jepsen-io/jepsen/blob/0.1.7/jepsen/src/jepsen/cli.clj#L52-L87), but we can add our own options by passing an `:opt-spec` to `cli/single-test-cmd`.\n\n```clj\n(def cli-opts\n \"Additional command line options.\"\n [[\"-q\" \"--quorum\" \"Use quorum reads, instead of reading from any primary.\"]])\n```\n\nCLI options are a collection of vectors, giving a short name, a full name, a\ndocumentation string, and options which affect how that option is parsed, its\ndefault value, etc. These are passed to\n[tools.cli](https://github.com/clojure/tools.cli), the standard Clojure library\nfor option handling.\n\nNow, let's pass that option specification to the CLI:\n\n```clj\n(defn -main\n \"Handles command line arguments. Can either run a test, or a web server for\n browsing results.\"\n [& args]\n (cli/run! (merge (cli/single-test-cmd {:test-fn etcd-test\n :opt-spec cli-opts})\n (cli/serve-cmd))\n args)\n```\n\nIf we re-run our test with `lein run test -q ...`, we'll see a new `:quorum` option in our test map:\n\n```clj\n10:02:42.532 [main] INFO jepsen.cli - Test options:\n {:concurrency 10,\n :test-count 1,\n :time-limit 30,\n :quorum true,\n ...\n```\n\nJepsen parsed our `-q` option, found the option specification we provided, and\nadded a `:quorum true` pair to the options map. That options map was passed to\n`etcd-test`, which `merge`d it into the test map. Viola! We have a `:quorum`\nkey in our test!\n\nNow, let's use that quorum option to control whether the client issues quorum\nreads, in the Client `invoke` function:\n\n```clj\n (case (:f op)\n :read (let [value (-> conn\n (v/get k {:quorum? (:quorum test)})\n parse-long-nil)]\n (assoc op :type :ok, :value (independent/tuple k value)))\n```\n\nLet's try `lein run` with and without quorum reads, and see whether it lets us\nsee the stale reads bug again.\n\n```bash\n$ lein run test -q ...\n...\n\n$ lein run test ...\n...\nclojure.lang.ExceptionInfo: throw+: {:errorCode 209, :message \"Invalid field\", :cause \"invalid value for \\\"quorum\\\"\", :index 0, :status 400}\n...\n```\n\nHuh. Let's double-check what the value was for `:quorum` in the test map. It's logged at the beginning of every Jepsen run:\n\n```clj\n2018-02-04 09:53:24,867{GMT}\tINFO\t[jepsen test runner] jepsen.core: Running test:\n {:concurrency 10,\n :db\n #object[jepsen.etcdemo$db$reify__4946 0x15a8bbe5 \"jepsen.etcdemo$db$reify__4946@15a8bbe5\"],\n :name \"etcd\",\n :start-time\n #object[org.joda.time.DateTime 0x54a5799f \"2018-02-04T09:53:24.000-06:00\"],\n :net\n #object[jepsen.net$reify__3493 0x2a2b3aff \"jepsen.net$reify__3493@2a2b3aff\"],\n :client {:conn nil},\n :barrier\n #object[java.util.concurrent.CyclicBarrier 0x6987b74e \"java.util.concurrent.CyclicBarrier@6987b74e\"],\n :ssh\n {:username \"root\",\n :password \"root\",\n :strict-host-key-checking false,\n :private-key-path nil},\n :checker\n #object[jepsen.checker$compose$reify__3220 0x71098fb3 \"jepsen.checker$compose$reify__3220@71098fb3\"],\n :nemesis\n #object[jepsen.nemesis$partitioner$reify__3601 0x47c15468 \"jepsen.nemesis$partitioner$reify__3601@47c15468\"],\n :active-histories #,\n :nodes [\"n1\" \"n2\" \"n3\" \"n4\" \"n5\"],\n :test-count 1,\n :generator\n #object[jepsen.generator$time_limit$reify__1996 0x483fe83a \"jepsen.generator$time_limit$reify__1996@483fe83a\"],\n :os\n #object[jepsen.os.debian$reify__2908 0x8aa1562 \"jepsen.os.debian$reify__2908@8aa1562\"],\n :time-limit 30,\n :model {:value nil}}\n```\n\nOh. That's odd. There... *isn't* a `:quorum` key here. Option flags only appear\nin the options map if they're present on the command line; if they're left out\nof the command line, they're left out of the option map too. When we ask for\n`(:quorum test)`, and `test` *has* no `:quorum` option, we'll get `nil`.\n\nThere are a few easy ways to fix this. We could coerce `nil` to `false` by\nusing `(boolean (:quorum test))`, at the client, or in `etcd-test`. Or we could\nforce the opt spec to provide a default value when the flag is omitted, by\nadding `:default false` to the quorum opt-spec. We'll apply `boolean` in\n`etcd-test`, just in case someone calls it directly, instead of through the\nCLI.\n\n```clj\n(defn etcd-test\n \"Given an options map from the command line runner (e.g. :nodes, :ssh,\n :concurrency ...), constructs a test map. Special options:\n\n :quorum Whether to use quorum reads\"\n [opts]\n (let [quorum (boolean (:quorum opts))]\n (merge tests/noop-test\n opts\n {:pure-generators true\n :name (str \"etcd q=\" quorum)\n :quorum quorum\n\n ...\n```\n\nWe're binding `quorum` to a variable here so that we can use its boolean value\nin two places. We add it to the test's `name`, which makes it easy to tell\nwhich tests used quorum reads at a glance. We also add it to the `:quorum`\noption. Since we merge `opts` *before* that, our boolean version of `:quorum`\nwill take precedence over whatever in `opts`. Now, without `-q`, our test can\nfind errors again:\n\n```bash\n$ lein run test --time-limit 60 --concurrency 100 -q\n...\nEverything looks good! ヽ(‘ー`)ノ\n\n$ lein run test --time-limit 60 --concurrency 100\n...\nAnalysis invalid! (ﾉಥ益ಥ）ﾉ ┻━┻\n```\n\n## Tunable difficulty\n\nDepending on how powerful your computer is, you may have noticed some tests get\nstuck on painfully slow analyses. It's hard to control this up-front--the\ndifficulty of a test goes like `~n!`, where n is the number of concurrent\nprocesses. A couple crashed processes can make the difference between seconds\nand days to check.\n\nTo help with this problem, let's add some tuning options to our test which\ncontrol the number of operations you can perform on any single key, and how\nfast operations are generated.\n\nIn the generator, let's change our hardcoded 1/10 delay to a parameter, given\nas a rate per second, and change our hardcoded limit on each key's generator to a configurable parameter.\n\n```clj\n(defn etcd-test\n \"Given an options map from the command line runner (e.g. :nodes, :ssh,\n :concurrency ...), constructs a test map.\"\n [opts]\n (let [quorum (boolean (:quorum opts))]\n (merge tests/noop-test\n opts\n {:pure-generators true\n :name (str \"etcd q=\" quorum)\n :quorum quorum\n :os debian/os\n :db (db \"v3.1.5\")\n :client (Client. nil)\n :nemesis (nemesis/partition-random-halves)\n :checker (checker/compose\n {:perf (checker/perf)\n :indep (independent/checker\n (checker/compose\n {:linear (checker/linearizable\n {:model (model/cas-register)\n :algorithm :linear})\n :timeline (timeline/html)}))})\n :generator (->> (independent/concurrent-generator\n 10\n (range)\n (fn [k]\n (->> (gen/mix [r w cas])\n (gen/stagger (/ (:rate opts)))\n (gen/limit (:ops-per-key opts)))))\n (gen/nemesis\n (->> [(gen/sleep 5)\n {:type :info, :f :start}\n (gen/sleep 5)\n {:type :info, :f :stop}]\n cycle))\n (gen/time-limit (:time-limit opts)))})))\n```\n\nAnd add corresponding command-line options\n\n```clj\n(def cli-opts\n \"Additional command line options.\"\n [[\"-q\" \"--quorum\" \"Use quorum reads, instead of reading from any primary.\"]\n [\"-r\" \"--rate HZ\" \"Approximate number of requests per second, per thread.\"\n :default 10\n :parse-fn read-string\n :validate [#(and (number? %) (pos? %)) \"Must be a positive number\"]]\n [nil \"--ops-per-key NUM\" \"Maximum number of operations on any given key.\"\n :default 100\n :parse-fn parse-long\n :validate [pos? \"Must be a positive integer.\"]]])\n```\n\nWe don't have to provide a short name for every option: we use `nil` to\nindicate that `--ops-per-key` has no short form. The capital words after each\nflag (e.g. \"HZ\" & \"NUM\") are arbitrary placeholders for values that you would\npass. They'll be printed as a part of the usage documentation. We provide a\n`:default` for both options, which is used if there's no flag at the command\nline. For rates, we want to allow integers, decimals, and fractions, so...\nwe'll use Clojure's built-in `read-string` function to parse all three. Then\nwe'll validate that it's both a number and that it's positive, to keep people\nfrom passing strings, negative numbers, zero rates, etc.\n\nNow, if we want to run a less aggressive test, we can try\n\n```bash\n$ lein run test --time-limit 10 --concurrency 10 --ops-per-key 10 -r 1\n...\nEverything looks good! ヽ(‘ー`)ノ\n```\n\nLooking through the history for each key, we can see that operations proceeded\nvery slowly, and there are only 10 per key. This test is much easier to check!\nHowever, it also fails to find the bug! This is an inherent tension in Jepsen:\nwe have to be aggressive to find errors, but verifying those aggressive\nhistories can be *much* more difficult--even impossible.\n\nLinearizability checking is NP-hard; there's no way around that. We can design\nsomewhat more efficient checkers, but eventually, that exponential cliff is\ngoing to bite us. Perhaps, however... we could verify a *weaker* property.\nSomething in linear or logarithmic time. Let's [add a commutative\ntest](08-set.md)\n" }, { "path": "doc/tutorial/08-set.md", "content": "# Adding a Set Test\n\nWe can model an etcd cluster as a set of registers, each identified by a key,\nwhich support reads, writes, and compare-and-sets. But that's not the only\npossible system we could build on top of etcd. We could, for instance, treat it\nas a set of keys, and ignore the values altogether. Or we could implement a\nqueue on top of an etcd directory. In theory, we could model *every part* of\nthe etcd API, but the state space would be quite large, and the implementation\nperhaps time-consuming. Typically, we'll focus on important or often-used parts\nof the API.\n\nBut what makes a test *useful*? Our linearizable test is quite general,\nperforming different types of randomized operations, and determining whether\nany pattern of those operations is linearizable. However, it is also quite\nexpensive. It'd be nice if we could design a test which is simple to verify,\nbut still tells us something useful.\n\nConsider a set, supporting `add` and `read` operations. If we only read, our\ntest is trivially satisfied by seeing the empty set. If we only write, every\ntest will always pass, since it is always legal to add something to a set.\nClearly, we need a combination of reads and writes. Moreover, a read should be\nthe *last* thing that happens, since any writes *after* the final read couldn't\naffect the outcome of the test.\n\nWhat elements should we add? If we always add the same element, the test has\nsome resolving power: if every add returns `ok` but we don't read that element,\nwe know we've found a bug. However, if *any* add works, then the final read\nwill include that element, and we won't be able to tell if the other adds\nactually worked or not. Perhaps it is most useful, then, to choose *distinct*\nelements, so that every add operation has some independent effect on the read. If we choose ordered elements, we can get a rough picture of whether loss is evenly distributed over time, or occurs in chunks, so we'll do that as well.\n\nOur operations, then, will be something like\n\n```clj\n{:type :invoke, :f :add, :value 0}\n{:type :invoke, :f :add, :value 1}\n...\n{:type :invoke, :f :read, :value #{0 1}}\n```\n\nAnd we'll know the database performed correctly if every successful add is\npresent in the final read. We could obtain more information by performing\nmultiple reads, and tracking which have completed or are in-flight, but for\nnow, let's keep it simple.\n\n## A New Namespace\n\nIt's starting to get a little cluttered in `jepsen.etcdemo`, so we're going to\nbreak things up into a dedicated namespace for our new test. We'll call it `jepsen.etcdemo.set`:\n\n```sh\n$ mkdir src/jepsen/etcdemo\n$ vim src/jepsen/etcdemo/set.clj\n```\n\nWe'll be designing a new client and a generator, so we'll need those namespaces\nfrom Jepsen. And of course we'll be using our etcd client library,\nVerschlimmbesserung--and we'll want to handle exceptions from it, so that means\nSlingshot too.\n\n```clj\n(ns jepsen.etcdemo.set\n (:require [jepsen\n [checker :as checker]\n [client :as client]\n [generator :as gen]]\n [slingshot.slingshot :refer [try+]]\n [verschlimmbesserung.core :as v]))\n```\n\nWe'll need a new client that can add things to sets, and read them back--but we\nhave to choose how to store that set in the database. One option is to use\nseparate keys, or a pool of keys. Another is to use a single key, and have the\nvalue be a serialized data type, like a JSON array or Clojure set. We'll do the latter.\n\n```clj\n(defrecord SetClient [k conn]\n client/Client\n (open! [this test node]\n (assoc this :conn (v/connect (client-url node)\n```\n\nOh. That's a problem. We don't have `client-url` here. We could pull it in from\n`jepsen.etcdemo`, but we'd like to require *this* namespace from\n`jepsen.etcdemo` later, and Clojure tries very hard to avoid circular\ndependencies between namespaces. Let's create a new, supporting namespace\ncalled `jepsen.etcdemo.support`. Like `jepsen.etcdemo.set`, it'll have its own\nfile.\n\n```bash\n$ vim src/jepsen/etcdemo/support.clj\n```\n\nLet's move the url-constructing functions from `jepsen.etcdemo` to\n`jepsen.etcdemo.support`.\n\n```clj\n(ns jepsen.etcdemo.support\n (:require [clojure.string :as str]))\n\n(defn node-url\n \"An HTTP url for connecting to a node on a particular port.\"\n [node port]\n (str \"http://\" node \":\" port))\n\n(defn peer-url\n \"The HTTP url for other peers to talk to a node.\"\n [node]\n (node-url node 2380))\n\n(defn client-url\n \"The HTTP url clients use to talk to a node.\"\n [node]\n (node-url node 2379))\n\n(defn initial-cluster\n \"Constructs an initial cluster string for a test, like\n \\\"foo=foo:2380,bar=bar:2380,...\\\"\"\n [test]\n (->> (:nodes test)\n (map (fn [node]\n (str node \"=\" (peer-url node))))\n (str/join \",\")))\n```\n\nNow we'll require our support namespace from `jepsen.etcdemo`, and replace\ncalls to those functions with their new names:\n\n```clj\n(ns jepsen.etcdemo\n (:require [clojure.tools.logging :refer :all]\n\t\t\t\t\t ...\n [jepsen.etcdemo.support :as s]\n ...))\n\n...\n\n(defn db\n \"Etcd DB for a particular version.\"\n [version]\n (reify db/DB\n (setup! [_ test node]\n (info node \"installing etcd\" version)\n (c/su\n (let [url (str \"https://storage.googleapis.com/etcd/\" version\n \"/etcd-\" version \"-linux-amd64.tar.gz\")]\n (cu/install-archive! url dir))\n\n (cu/start-daemon!\n {:logfile logfile\n :pidfile pidfile\n :chdir dir}\n binary\n :--log-output :stderr\n :--name node\n :--listen-peer-urls (s/peer-url node)\n :--listen-client-urls (s/client-url node)\n :--advertise-client-urls (s/client-url node)\n :--initial-cluster-state :new\n :--initial-advertise-peer-urls (s/peer-url node)\n :--initial-cluster (s/initial-cluster test))\n\n (Thread/sleep 5000)))\n\n...\n\n (assoc this :conn (v/connect (s/client-url node)\n```\n\nWith that taken care of, back to `jepsen.etcdemo.set`. We'll require our\nsupport namespace here too, and use it in the client.\n\n```clj\n(defrecord SetClient [k conn]\n client/Client\n (open! [this test node]\n (assoc this :conn (v/connect (s/client-url node)\n {:timeout 5000})))\n```\n\nWe'll use the `setup!` function to initialize the value of a single key to an\nempty Clojure set: `#{}`. We could hardcode the key again, but it'd be a bit\ncleaner to have a field on the SetClient.\n\n```clj\n (setup! [this test]\n (v/reset! conn k \"#{}\"))\n```\n\nOur `invoke!` function will look quite similar to our earlier client; we'll\ndispatch based on `:f`, and use a similar error handler.\n\n```clj\n (invoke! [_ test op]\n (try+\n (case (:f op)\n :read (assoc op\n :type :ok\n :value (read-string\n (v/get conn k {:quorum? (:quorum test)})))\n```\n\nWhat about adding an element to the set? We need to read the current set, add\nthe new value, and write it back if it hasn't changed. Verschlimmbesserung has\na [helper for that](https://github.com/aphyr/verschlimmbesserung), `swap!`,\nwhich takes a *function* to transform a key's value.\n\n```clj\n (invoke! [_ test op]\n (try+\n (case (:f op)\n :read (assoc op\n :type :ok,\n :value (read-string\n (v/get conn k {:quorum? (:quorum test)})))\n\n :add (do (v/swap! conn k (fn [value]\n (-> value\n read-string\n (conj (:value op))\n pr-str)))\n (assoc op :type :ok)))\n\n (catch java.net.SocketTimeoutException e\n (assoc op\n :type (if (= :read (:f op)) :fail :info)\n :error :timeout))))\n```\n\nWe could clean up our key here, but for purposes of this tutorial, we'll skip\nthat part. It'll be deleted with all the rest of the data, when the test\nstarts up.\n\n```clj\n (teardown! [_ test])\n\n (close! [_ test]))\n```\n\nGood! Now we need to package this up with a generator and a checker. We can use\nthe same name, OS, DB, and nemesis from the linearizable test, so instead of\nmaking a *full* test map, we'll call this a \"workload\", and integrate it into\nthe test later.\n\nAdding things to sets is such a common test that Jepsen has one built-in:\n`checker/set`.\n\n\n```clj\n(defn workload\n \"A generator, client, and checker for a set test.\"\n [opts]\n {:client (SetClient. \"a-set\" nil)\n :checker (checker/set)\n :generator\n```\n\nFor the generator... hmm. Well, we know it proceeds in two parts: first, we're\ngoing to add a bunch of things, and after that's done, we're going to perform a\nsingle read. Let's write those two separately for now, and think about how to\ncombine them later.\n\nHow do we get a bunch of unique elements to add? We could write a generator\nfrom scratch, but it might be easier to use Clojure's built-in sequence library\nto construct a sequence of invoke ops, one for each number, and then wrap that\nin a generator using `gen/seq`, like we did for the nemesis' infinite cycle of starts, sleeps, and stops.\n\n```clj\n(defn workload\n \"A generator, client, and checker for a set test.\"\n [opts]\n {:client (SetClient. \"a-set\" nil)\n :checker (checker/set)\n :generator (->> (range)\n (map (fn [x] {:type :invoke, :f :add, :value x})))\n :final-generator (gen/once {:type :invoke, :f :read, :value nil})})\n```\n\nFor the final generator, we're using `gen/once` to emit a single read, instead\nof an infinite sequence of reads.\n\n## Integrating the New Workload\n\nNow, we need to integrate this workload into the main `etcd-test`. Let's hop back to `jepsen.etcdemo`, and require the set test's namespace.\n\n```clj\n(ns jepsen.etcdemo\n (:require [clojure.tools.logging :refer :all]\n\t\t\t\t\t\t...\n [jepsen.etcdemo [set :as set]\n [support :as s]]\n```\n\nLooking at `etcd-test`, we could edit it directly, but we're going to want to\ngo *back* to our linearizable test eventually, so let's leave everything just\nas it is, for now, and add a new map to override the client, checker, and\ngenerator, based on the set workload.\n\n```clj\n(defn etcd-test\n \"Given an options map from the command line runner (e.g. :nodes, :ssh,\n :concurrency ...), constructs a test map. Special options:\n\n :quorum Whether to use quorum reads\n :rate Approximate number of requests per second, per thread\n :ops-per-key Maximum number of operations allowed on any given key.\"\n [opts]\n (let [quorum (boolean (:quorum opts))\n workload (set/workload opts)]\n (merge tests/noop-test\n opts\n {:pure-generators true\n :name (str \"etcd q=\" quorum)\n :quorum quorum\n :os debian/os\n :db (db \"v3.1.5\")\n :client (Client. nil)\n :nemesis (nemesis/partition-random-halves)\n :checker (checker/compose\n {:perf (checker/perf)\n :indep (independent/checker\n (checker/compose\n {:linear (checker/linearizable\n {:model (model/cas-register)\n :algorithm :linear})\n :timeline (timeline/html)}))})\n :generator (->> (independent/concurrent-generator\n 10\n (range)\n (fn [k]\n (->> (gen/mix [r w cas])\n (gen/stagger (/ (:rate opts)))\n (gen/limit (:ops-per-key opts)))))\n (gen/nemesis\n (->> [(gen/sleep 5)\n {:type :info, :f :start}\n (gen/sleep 5)\n {:type :info, :f :stop}]\n cycle))\n (gen/time-limit (:time-limit opts)))}\n {:client (:client workload)\n :checker (:checker workload)\n```\n\nThinking about the generator a bit more... we know it's going to proceed in two\nphases: adds, and a final read. We also know that we want the read to\n*succeed*, which means we probably want the cluster to be nice and healed by\nthat point. So we'll perform normal nemesis operations in the `add` phase, then\nstop the nemesis, wait a bit for the cluster to heal, and finally, perform our\nread. `gen/phases` helps us write those kind of multi-stage generators.\n\n```clj\n :generator (gen/phases\n (->> (:generator workload)\n (gen/stagger (/ (:rate opts)))\n (gen/nemesis\n (cycle [(gen/sleep 5)\n {:type :info, :f :start}\n (gen/sleep 5)\n {:type :info, :f :stop}]))\n (gen/time-limit (:time-limit opts)))\n (gen/log \"Healing cluster\")\n (gen/nemesis (gen/once {:type :info, :f :stop}))\n (gen/log \"Waiting for recovery\")\n (gen/sleep 10)\n (gen/clients (:final-generator workload)))})))\n```\n\nLet's give that a shot and see what happens.\n\n```\n$ lein run test --time-limit 10 --concurrency 10 -r 1/2\n...\nNFO [2018-02-04 22:13:53,085] jepsen worker 2 - jepsen.util 2\t:invoke\t:add\t0\nINFO [2018-02-04 22:13:53,116] jepsen worker 2 - jepsen.util 2\t:ok\t:add\t0\nINFO [2018-02-04 22:13:53,361] jepsen worker 2 - jepsen.util 2\t:invoke\t:add\t1\nINFO [2018-02-04 22:13:53,374] jepsen worker 2 - jepsen.util 2\t:ok\t:add\t1\nINFO [2018-02-04 22:13:53,377] jepsen worker 4 - jepsen.util 4\t:invoke\t:add\t2\nINFO [2018-02-04 22:13:53,396] jepsen worker 3 - jepsen.util 3\t:invoke\t:add\t3\nINFO [2018-02-04 22:13:53,396] jepsen worker 4 - jepsen.util 4\t:ok\t:add\t2\nINFO [2018-02-04 22:13:53,410] jepsen worker 3 - jepsen.util 3\t:ok\t:add\t3\n...\nINFO [2018-02-04 22:14:06,934] jepsen nemesis - jepsen.generator Healing cluster\nINFO [2018-02-04 22:14:06,936] jepsen nemesis - jepsen.util :nemesis\t:info\t:stop\tnil\nINFO [2018-02-04 22:14:07,142] jepsen nemesis - jepsen.util :nemesis\t:info\t:stop\t:network-healed\nINFO [2018-02-04 22:14:07,143] jepsen nemesis - jepsen.generator Waiting for recovery\n...\nINFO [2018-02-04 22:14:17,146] jepsen worker 4 - jepsen.util 4\t:invoke\t:read\tnil\nINFO [2018-02-04 22:14:17,153] jepsen worker 4 - jepsen.util 4\t:ok\t:read\t#{0 7 20 27 1 24 55 39 46 4 54 15 48 50 21 31 32 40 33 13 22 36 41 43 29 44 6 28 51 25 34 17 3 12 2 23 47 35 19 11 9 5 14 45 53 26 16 38 30 10 18 52 42 37 8 49}\n...\nINFO [2018-02-04 22:14:29,553] main - jepsen.core {:valid? true,\n :lost \"#{}\",\n :recovered \"#{}\",\n :ok \"#{0..55}\",\n :recovered-frac 0,\n :unexpected-frac 0,\n :unexpected \"#{}\",\n :lost-frac 0,\n :ok-frac 1}\n\n\nEverything looks good! ヽ(‘ー`)ノ\n```\n\nLook at that! 55 adds, all of which were preserved in the final read! If any\nwere lost, they'd show up in the `:lost` set.\n\nLet's rewrite the linearizable register test as a workload, so it has the same shape as the set test.\n\n```clj\n(defn register-workload\n \"Tests linearizable reads, writes, and compare-and-set operations on\n independent keys.\"\n [opts]\n {:client (Client. nil)\n :checker (independent/checker\n (checker/compose\n {:linear (checker/linearizable {:model (model/cas-register)\n :algorithm :linear})\n :timeline (timeline/html)}))\n```\n\nWe forgot about performance graphs! Those seem useful for *every* test, so\nwe'll leave them out of the workloads. For this particular workload, we need\nindependent checkers for both linearizability, and the HTML timelines. Next, we need the concurrent generator:\n\n```clj\n :generator (independent/concurrent-generator\n 10\n (range)\n (fn [k]\n (->> (gen/mix [r w cas])\n (gen/limit (:ops-per-key opts)))))})\n```\n\nThis is a much simpler generator than before! The nemesis, rate limiting, and\ntime limits are applied for us by `etcd-test`, so we can leave them out of the\nworkload. We also don't need a :final-generator here, so we can leave that\nblank--`nil` is a generator which means there's nothing left to do.\n\nTo switch between workloads, let's give each one a short name.\n\n```clj\n(def workloads\n \"A map of workload names to functions that construct workloads, given opts.\"\n {\"set\" set/workload\n \"register\" register-workload})\n```\n\nNow, let's get rid of our register-specific code in `etcd-test`, and deal\npurely with workloads. We'll take a string workload option, and use it to look\nup the appropriate workload function, then call that with `opts` to build the\nappropriate workload. We'll also modify our test name to include the workload\nname.\n\n```clj\n(defn etcd-test\n \"Given an options map from the command line runner (e.g. :nodes, :ssh,\n :concurrency ...), constructs a test map. Special options:\n\n :quorum Whether to use quorum reads\n :rate Approximate number of requests per second, per thread\n :ops-per-key Maximum number of operations allowed on any given key\n :workload Type of workload.\"\n [opts]\n (let [quorum (boolean (:quorum opts))\n workload ((get workloads (:workload opts)) opts)]\n (merge tests/noop-test\n opts\n {:pure-generators true\n :name (str \"etcd q=\" quorum \" \"\n (name (:workload opts)))\n :quorum quorum\n :os debian/os\n :db (db \"v3.1.5\")\n :nemesis (nemesis/partition-random-halves)\n :client (:client workload)\n :checker (checker/compose\n {:perf (checker/perf)\n :workload (:checker workload)})\n ...\n```\n\nNow, let's pass workload option specification to the CLI:\n\n```clj\n(def cli-opts\n \"Additional command line options.\"\n [[\"-w\" \"--workload NAME\" \"What workload should we run?\"\n :missing (str \"--workload \" (cli/one-of workloads))\n :validate [workloads (cli/one-of workloads)]]\n ...\n```\n\nWe use `:missing` to have tools.cli insist on some value being provided. `cli/one-of` is a shortcut for ensuring that a value is a legal key in a map; it gives us helpful error messages. Now, if we run the test without a workload, it'll tell us that we need to choose a valid workload:\n\n```bash\n$ lein run test --time-limit 10 --concurrency 10 -r 1/2\n--workload Must be one of register, set\n```\n\nAnd we can run either workload just by flipping the switch!\n\n```bash\n$ lein run test --time-limit 10 --concurrency 10 -r 1/2 -w set\n...\n$ lein run test --time-limit 10 --concurrency 10 -r 1/2 -w register\n...\n```\n\nThat's as far as we're going in this class! On your own, you might want to try\nmoving the register test into its own namespace, and splitting the set test to\nuse independent keys. Thanks for reading!\n" }, { "path": "doc/tutorial/index.md", "content": "# Tutorial\n\nThis tutorial will walk you through writing a Jepsen test from scratch. It is\nalso the basis for a [training class](https://jepsen.io/training) offered by\nJepsen.\n\nIf you aren't familiar with the Clojure language, we recommend you start with\n[Clojure for the Brave and True](http://www.braveclojure.com/), [Clojure From\nthe Ground Up](https://aphyr.com/posts/301-clojure-from-the-ground-up-welcome),\nor any guide that works for you.\n\n1. [Test Scaffolding](01-scaffolding.md)\n2. [Database Automation](02-db.md)\n3. [Writing a Client](03-client.md)\n4. [Checking Correctness](04-checker.md)\n5. [Introducing Faults](05-nemesis.md)\n6. [Refining Tests](06-refining.md)\n7. [Tuning with Parameters](07-parameters.md)\n8. [Adding a Set Test](08-set.md)\n" }, { "path": "doc/whats-here.md", "content": "# What's Here\n\nThis document provides an overview of Jepsen's various namespaces and how they\nwork together.\n\n## Core Namespaces\n\nThese are the main namespaces involved in writing and running a test.\n\nThe main namespace is [jepsen.core](/jepsen/src/jepsen/core.clj). The core\nfunction, `jepsen.core/run!` takes a test map, runs it, and returns a completed\ntest map.\n\n[jepsen.cli](/jepsen/src/jepsen/cli.clj) supports command-line frontends to\nJepsen tests. It provides commands for running a single test, a family of\ntests, and running a web server to browse results.\n\n[jepsen.os](/jepsen/src/jepsen/os.clj) defines the protocol for an operating\nsystem, which is used to install basic packages on a node and prepare it to run\na test. Most of the time you'll be using\n[jepsen.os.debian](/jepsen/src/jepsen/os/debian.clj), which supports Debian\noperating systems. There are also community-contributed, but generally\nunsupported [jepsen.os.centos](/jepsen/src/jepsen/os/centos.clj),\n[jepsen.os.smartos](/jepsen/src/jepsen/os/smartos.clj), and\n[jepsen.os.ubuntu](/jepsen/src/jepsen/os/ubuntu.clj).\n\n[jepsen.db](/jepsen/src/jepsen/db.clj) defines the core protocols for database\nautomation: installation, teardown, starting, killing, pausing, resuming,\ndownloading logs, and so on, along with some basic utilities.\n[jepsen.db.watchdog](/jepsen/src/jepsen/db/watchdog.clj) supports restarting\ndatabases.\n\n[jepsen.generator](/jepsen/src/jepsen/generator.clj) generates the operations\nJepsen performs during a test. It provides (mostly) pure, composable data\nstructures which yield effects. During a test,\n[jepsen.generator.interpreter](/jepsen/src/jepsen/generator/interpreter.clj) is\nresponsible for launching worker threads, drawing operations from the\ngenerator, dispatching them, and journaling operations to the history. Two\ninternal libraries,\n[jepsen.generator.translation-table](/jepsen/src/jepsen/generator/translation_table.clj)\nand [jepsen.generator.context](/jepsen/src/jepsen/generator/context.clj), help\ngenerators keep track of the time, what threads are doing, and\nworkload-specific context.\n[jepsen.generator.test](/jepsen/src/jepsen/generator/test.clj) helps with\nwriting tests for generators.\n\nMost operations from the generator are passed to a\n[jepsen.client](/jepsen/src/jepsen/client.clj), which applies them to the\ndatabase. Clients also support basic lifecycle management: opening and closing\nconnections, and setting up and tearing down any state they need for the test.\n\nFault injection operations are passed to a\n[jepsen.nemesis](/jepsen/src/jepsen/nemesis.clj), which injects faults; this\nnamespace provides some common faults and ways to compose nemeses together.\n[jepsen.nemesis.combined](/jepsen/src/jepsen/nemesis/combined.clj) provides\ncomposable packages of a nemesis, generators, and metadata.\n[jepsen.nemesis.membership](/jepsen/src/jepsen/nemesis/membership.clj) and its\nsupporting protocol\n[jepsen.nemesis.membership.state](/jepsen/src/jepsen/nemesis/membership/state.clj)\nhelps write nemeses that add and remove nodes from a cluster.\n[jepsen.nemesis.time](/jepsen/src/jepsen/nemesis/time.clj) injects clock\nerrors. [jepsen.nemesis.file](/jepsen/src/jepsen/nemesis/file.clj) corrupts\nfiles.\n\nThe OS, DBs, nemeses, and more use\n[jepsen.control](/jepsen/src/jepsen/control.clj), which runs commands via SSH\n(or other means) on DB nodes.\n[jepsen.control.core](/jepsen/src/jepsen/control/core.clj) defines the basic\n`Remote` protocol for running commands and transferring files, and some common\nfunctions for shell escaping and error management. The implementations are in\n[jepsen.control.clj-ssh](/jepsen/src/jepsen/control/clj_ssh.clj),\n[jepsen.control.docker](/jepsen/src/jepsen/control/docker.clj),\n[jepsen.control.k8s](/jepsen/src/jepsen.control/k8s.clj),\n[jepsen.control.retry](/jepsen/src/jepsen/control/retry.clj),\n[jepsen.control.scp](/jepsen/src/jepsen/control/scp.clj), and\n[jepsen.control.sshj](/jepsen/src/jepsen/control/sshj.clj). Two utility\nlibraries, [jepsen.control.util](/jepsen/src/jepsen/control/util.clj) and\n[jepsen.control.net](/jepsen/src/jepsen/control/net.clj), help with downloading\nURLs, making temporary files, getting IP addresses, running daemons, etc.\n\nThe interpreter produces a\n[jepsen.history](https://github.com/jepsen-io/history), which needs to be\nanalyzed. [jepsen.checker](/jepsen/src/jepsen/checker.clj) defines the protocol\nfor checking a history and composing checkers together. It also provides a slew\n of basic checkers for common problems, like computing overall statistics,\n finding unhandled errors in the database and test itself, checking sets and\n queues, and so on. [jepsen.checker.perf](/jepsen/src/jepsen/checker/perf.clj)\n renders performance plots.\n [jepsen.checker.timeline](/jepsen/src/jepsen/checker/timeline.clj) renders\n HTML timelines of a history.\n\n[jepsen.store](/jepsen/src/jepsen/store.clj) writes tests to disk, as well as\nauxiliary data files.\n[jepsen.store.format](/jepsen/src/jepsen/store/format.clj) handles writing and\nreading Jepsen's binary file format.\n[jepsen.store.fressian](/jepsen/src/jepsen/store/fressian.clj) defines how\nJepsen serializes data with [Fressian](https://github.com/Datomic/fressian/).\n\n## Utilities\n\nThese supporting libraries round out Jepsen's capabilities.\n\n[jepsen.util](/jepsen/src/jepsen/util.clj) is the \"kitchen sink\" of Jepsen. It\nprovides a wealth of helpful utilities: everything from computing the majority\nof `n` nodes to timeouts to random values\n\n[jepsen.net](/jepsen/src/jepsen/net.clj), supported by\n[jepsen.net.proto](/jepsen/src/jepsen/net/proto.clj), provides pluggable\nsupport for network partitions between nodes, as well as losing or slowing down\npackets.\n\n[jepsen.reconnect](/jepsen/src/jepsen/reconnect.clj) provides automatic\nreconnection and retries for flaky clients. It's used internally by\n`jepsen.control`'s SSH remotes, and also DB clients.\n\n[jepsen.fs-cache](/jepsen/src/jepsen/fs-cache.clj) provides a local (e.g. on\nthe control node) cache for arbitrary data structures and files. This is\nhelpful when a database requires an expensive one-time setup step.\n\n[jepsen.codec](/jepsen/src/jepsen/codec.clj) encodes and decodes values to strings, for testing systems which store everything in string blobs.\n\n[jepsen.web](/jepsen/src/jepsen/web.clj) is Jepsen's web interface, for browsing the `store/` directory.\n\n[jepsen.repl](/jepsen/src/jepsen/repl.clj) is where `lein repl` drops you.\n\n## Tests\n\nThese namespaces are oriented towards running a specific kind of test, like a\nlist-append test. They usually provide a package of a generator, client, and\nchecker together.\n\n[jepsen.tests](/jepsen/src/jepsen/tests.clj) provides a no-op test map, as a\nstub for writing new tests.\n\n[jepsen.tests.adya](/jepsen/src/jepsen/tests/adya.clj) provides a test for a\nspecific kind of G2 anomaly. It's replaced by `jepsen.tests.cycle`.\n\n[jepsen.tests.bank](/jepsen/src/jepsen/tests/bank.clj) models transfers between\na pool of bank accounts, and checks to make sure the total balance is\nconserved.\n\n[jepsen.tests.causal-reverse](/jepsen/src/jepsen/tests/causal_reverse.clj)\nlooks for a violation of Strict Serializability where T1 < T2, but T2 is\nvisible without T1. It's replaced by `jepsen.tests.cycle`.\n\n[jepsen.tests.cycle](/jepsen/src/jepsen/tests/cycle.clj) contains two workloads, [jepsen.tests.cycle.append](/jepsen/src/jepsen/tests/cycle/append.clj) and [jepsen.tests.cycle.wr](/jepsen/src/jepsen/tests/cycle/wr.clj), which are small wrappers around [Elle](https://github.com/jepsen-io/elle), a sophisticated transactional safety checker.\n\n[jepsen.tests.kafka](/jepsen/src/jepsen/tests/kafka.clj) is for testing\nKafka-style logs, in which clients publish messages to totally-ordered logs,\nand subscribe to messages from them.\n\n[jepsen.tests.linearizable-register](/jepsen/src/jepsen/tests/linearizable_register.clj)\nis for testing a family of independent Linearizable registers. Useful for\nsystems like etcd or Consul.\n\n[jepsen.tests.long-fork](/jepsen/src/jepsen/tests/long_fork.clj) finds Long\nFork anomalies. It's mostly superseded by jepsen.tests.cycle.list-append.\n\n## Extensions\n\nThese namespaces extend Jepsen to new workloads, faults, or styles of testing.\n\n[jepsen.independent](/jepsen/src/jepsen/independent.clj) lets you take a\ngenerator, client, and checker, and run several independent copies of them in\nthe same test, either sequentially or concurrently. This is helpful when a\nworkload needs to be \"small\"--say only a few keys or a few operations--but\nyou'd like to do lots of copies of it through the course of a test.\n\n[jepsen.role](/jepsen/src/jepsen/role.clj) supports tests where nodes have\ndistinct roles. For instance, some might handle storage, and others\ntransactions. It provides composable `DB`, `Client`, `Nemesis`, and `Generator`\ncode to glue together these different subsystems.\n\n[jepsen.faketime](/jepsen/src/jepsen/faketime.clj) helps run databases within\nan `LD_PRELOAD` shim that lies about the system clock.\n\n[jepsen.lazyfs](/jepsen/src/jepsen/lazyfs.clj) runs databases within a\ndirectory that can lose un-fsynced writes on command.\n\n" }, { "path": "docker/.gitignore", "content": "secret/*\n!.gitkeep\n./docker-compose.yml\n" }, { "path": "docker/README.md", "content": "# Dockerized Jepsen\n\nThis docker image attempts to simplify the setup required by Jepsen.\nIt is intended to be used by a CI tool or anyone with Docker who wants to try Jepsen themselves.\n\nIt contains all the jepsen dependencies and code. It uses [Docker\nCompose](https://github.com/docker/compose) to spin up the five containers used\nby Jepsen. A script builds a `docker-compose.yml` file out of fragments in\n`template/`, because this is the future, and using `awk` to generate YAML to\ngenerate computers is *cloud native*.\n\n## Quickstart\n\nAssuming you have `docker compose` set up already, run:\n\n```\nbin/up\nbin/console\n```\n\n... which will drop you into a console on the Jepsen control node.\n\nYour DB nodes are `n1`, `n2`, `n3`, `n4`, and `n5`. You can open as many shells\nas you like using `bin/console`. If your test includes a web server (try `lein\nrun serve` on the control node, in your test directory), you can open it\nlocally by running using `bin/web`. This can be a handy way to browse test\nresults.\n\n## Advanced\n\nYou can change the number of DB nodes by running (e.g.) `bin/up -n 9`.\n\nIf you need to log into a DB node (e.g. to debug a test), you can `ssh n1` (or n2, n3, ...) from inside the control node, or:\n\n```\ndocker exec -it jepsen-n1 bash\n```\n\nDuring development, it's convenient to run with `--dev` option, which mounts `$JEPSEN_ROOT` dir as `/jepsen` on Jepsen control container.\n\nRun `./bin/up --help` for more info.\n" }, { "path": "docker/bin/build-docker-compose", "content": "#!/usr/bin/env bash\n\n# Builds a docker-compose file. You'd THINK we could do this with `replicas`\n# but nooooooo, down that path lies madness. Instead we're going to do some\n# janky templating with sed and awk. I am so, so sorry.\n\n# Takes a number of nodes to generate a file for, and emits a file\n# `docker-compose.yml`.\n\nNODE_COUNT=$1\n\nDEPS=\"\"\nDBS=\"\"\n\n# For each node\nfor ((n=1;n<=NODE_COUNT;n++)); do\n # Build up deps for control\n LINE=`cat template/depends.yml | sed s/%%N%%/${n}/g`\n DEPS=\"${DEPS}${LINE}\"$'\\n'\n\n # Build up DB service\n DB=`cat template/db.yml | sed s/%%N%%/${n}/g`\n DBS=\"${DBS}${DB}\"$'\\n'\ndone\n\n# Build docker-compose file\nexport DEPS\nexport DBS\ncat template/docker-compose.yml |\n awk ' {gsub(/%%DEPS%%/, ENVIRON[\"DEPS\"]); print} ' |\n awk ' {gsub(/%%DBS%%/, ENVIRON[\"DBS\"]); print} ' \\\n > docker-compose.yml\n" }, { "path": "docker/bin/console", "content": "#!/usr/bin/env bash\ndocker exec -it jepsen-control bash\n" }, { "path": "docker/bin/up", "content": "#!/usr/bin/env bash\n\n# \"To provide additional docker compose args, set the COMPOSE var. Ex:\n# COMPOSE=\"-f FILE_PATH_HERE\"\n\nset -o errexit\nset -o pipefail\nset -o nounset\n# set -o xtrace\n\nERROR() {\n printf \"\\e[101m\\e[97m[ERROR]\\e[49m\\e[39m %s\\n\" \"$@\"\n}\n\nWARNING() {\n printf \"\\e[101m\\e[97m[WARNING]\\e[49m\\e[39m %s\\n\" \"$@\"\n}\n\nINFO() {\n printf \"\\e[104m\\e[97m[INFO]\\e[49m\\e[39m %s\\n\" \"$@\"\n}\n\nexists() {\n type \"$1\" > /dev/null 2>&1\n}\n\nJEPSEN_ROOT=${JEPSEN_ROOT:-\"\"}\n\n# Change directory to the parent directory of this script. Taken from:\n# https://stackoverflow.com/a/246128/3858681\npushd \"$( cd \"$( dirname \"${BASH_SOURCE[0]}\" )\" >/dev/null 2>&1 && pwd )/..\"\n\nHELP=0\nINIT_ONLY=0\nNODE_COUNT=5\nDEV=\"\"\nCOMPOSE=${COMPOSE:-\"\"}\nRUN_AS_DAEMON=0\nPOSITIONAL=()\n\nwhile [[ $# -gt 0 ]]\ndo\n key=\"$1\"\n\n case $key in\n --help)\n HELP=1\n shift # past argument\n ;;\n --init-only)\n INIT_ONLY=1\n shift # past argument\n ;;\n --dev)\n if [ ! \"$JEPSEN_ROOT\" ]; then\n JEPSEN_ROOT=\"$(cd ../ && pwd)\"\n export JEPSEN_ROOT\n INFO \"JEPSEN_ROOT is not set, defaulting to: $JEPSEN_ROOT\"\n fi\n INFO \"Running docker compose with dev config\"\n DEV=\"-f docker-compose.dev.yml\"\n shift # past argument\n ;;\n --compose)\n COMPOSE=\"-f $2\"\n shift # past argument\n shift # past value\n ;;\n -d|--daemon)\n INFO \"Running docker compose as daemon\"\n RUN_AS_DAEMON=1\n shift # past argument\n ;;\n -n|--node-count)\n NODE_COUNT=$2\n shift\n shift\n ;;\n *)\n POSITIONAL+=(\"$1\")\n ERROR \"unknown option $1\"\n shift # past argument\n ;;\n esac\ndone\nif [ \"${#POSITIONAL[@]}\" -gt 0 ]; then\n set -- \"${POSITIONAL[@]}\" # restore positional parameters\nfi\n\nif [ \"${HELP}\" -eq 1 ]; then\n echo \"Usage: $0 [OPTION]\"\n echo \" --help Display this message\"\n echo \" --init-only Initializes ssh-keys, but does not call docker-compose\"\n echo \" --daemon Runs docker compose in the background\"\n echo \" --dev Mounts dir at host's JEPSEN_ROOT to /jepsen on jepsen-control container, syncing files for development\"\n echo \" --compose PATH Path to an additional docker-compose yml config.\"\n echo \"To provide multiple additional docker compose args, set the COMPOSE var directly, with the -f flag. Ex: COMPOSE=\\\"-f FILE_PATH_HERE -f ANOTHER_PATH\\\" ./up.sh --dev\"\n exit 0\nfi\n\nexists ssh-keygen || { ERROR \"Please install ssh-keygen (apt-get install openssh-client)\"; exit 1; }\nexists perl || { ERROR \"Please install perl (apt-get install perl)\"; exit 1; }\n\n# Generate SSH keys for the control node\nif [ ! -f ./secret/node.env ]; then\n INFO \"Generating key pair\"\n mkdir -p secret\n ssh-keygen -t rsa -N \"\" -f ./secret/id_rsa\n\n INFO \"Generating ./secret/control.env\"\n { echo \"# generated by jepsen/docker/up.sh, parsed by jepsen/docker/control/bashrc\";\n echo \"# NOTE: newline is expressed as ↩\";\n echo \"SSH_PRIVATE_KEY=$(perl -p -e \"s/\\n/↩/g\" < ./secret/id_rsa)\";\n echo \"SSH_PUBLIC_KEY=$(cat ./secret/id_rsa.pub)\"; } >> ./secret/control.env\n\n INFO \"Generating authorized_keys\"\n { echo \"# generated by jepsen/docker/up.sh\";\n echo \"$(cat ./secret/id_rsa.pub)\"; } >> ./secret/authorized_keys\n\n INFO \"Generating ./secret/node.env\"\n { echo \"# generated by jepsen/docker/up.sh, parsed by the \\\"tutum/debian\\\" docker image entrypoint script\";\n echo \"ROOT_PASS=root\"; } >> ./secret/node.env\nelse\n INFO \"No need to generate key pair\"\nfi\n\n\n## Build dockerfile\nbin/build-docker-compose \"${NODE_COUNT}\"\n\n# Make sure folders referenced in control Dockerfile exist and don't contain leftover files\nrm -rf ./control/jepsen\nmkdir -p ./control/jepsen/jepsen\n# Copy the jepsen directory if we're not mounting the JEPSEN_ROOT\nif [ -z \"${DEV}\" ]; then\n exclude_params=(\n --exclude=./docker\n --exclude=./.git\n )\n case $(uname) in\n Linux)\n exclude_params+=(--exclude-ignore=.gitignore)\n ;;\n esac\n # Dockerfile does not allow `ADD ..`. So we need to copy it here in setup.\n INFO \"Copying .. to control/jepsen\"\n (\n (cd ..; tar \"${exclude_params[@]}\" -cf - .) | tar Cxf ./control/jepsen -\n cp ../jepsen/src/jepsen/store/* ./control/jepsen/jepsen/src/jepsen/store/\n )\nfi\n\nif [ \"${INIT_ONLY}\" -eq 1 ]; then\n exit 0\nfi\n\nexists docker ||\n { ERROR \"Please install docker (https://docs.docker.com/engine/installation/)\";\n exit 1; }\n\nINFO \"Running \\`docker compose build\\`\"\n# shellcheck disable=SC2086\ndocker compose --compatibility -p jepsen -f docker-compose.yml ${COMPOSE} ${DEV} build\n\nINFO \"Running \\`docker compose up\\`\"\nif [ \"${RUN_AS_DAEMON}\" -eq 1 ]; then\n # shellcheck disable=SC2086\n docker compose --compatibility -p jepsen -f docker-compose.yml ${COMPOSE} ${DEV} up -d\n INFO \"All containers started! Run \\`docker ps\\` to view, and \\`bin/console\\` to get started.\"\nelse\n INFO \"Please run \\`bin/console\\` in another terminal to proceed\"\n # shellcheck disable=SC2086\n docker compose --compatibility -p jepsen -f docker-compose.yml ${COMPOSE} ${DEV} up\nfi\n\npopd\n" }, { "path": "docker/bin/web", "content": "#!/usr/bin/env bash\n\nPORT=$(docker port jepsen-control 8080 | cut -d : -f 2)\nxdg-open \"http://localhost:$PORT\"\n" }, { "path": "docker/control/.gitignore", "content": "jepsen" }, { "path": "docker/control/Dockerfile", "content": "FROM jgoerzen/debian-base-minimal:bookworm as debian-addons\nFROM debian:bookworm-slim\n\nCOPY --from=debian-addons /usr/local/preinit/ /usr/local/preinit/\nCOPY --from=debian-addons /usr/local/bin/ /usr/local/bin/\nCOPY --from=debian-addons /usr/local/debian-base-setup/ /usr/local/debian-base-setup/\n\nRUN run-parts --exit-on-error --verbose /usr/local/debian-base-setup\n\nENV container=docker\nSTOPSIGNAL SIGRTMIN+3\n\nENV LEIN_ROOT true\n\n#\n# Jepsen dependencies\n#\nRUN apt-get -qy update && \\\n apt-get -qy install \\\n curl dos2unix emacs git gnuplot graphviz htop iputils-ping libjna-java pssh screen vim wget && \\\n curl -L https://github.com/adoptium/temurin21-binaries/releases/download/jdk-21.0.8%2B9/OpenJDK21U-jdk_x64_linux_hotspot_21.0.8_9.tar.gz | tar -xz --strip-components=1 -C /usr/local/\n\nRUN wget https://raw.githubusercontent.com/technomancy/leiningen/stable/bin/lein && \\\n mv lein /usr/bin && \\\n chmod +x /usr/bin/lein && \\\n lein self-install\n\n# without --dev flag up.sh copies jepsen to these subfolders\n# with --dev flag they are empty until mounted\nCOPY jepsen/jepsen /jepsen/jepsen/\nRUN if [ -f /jepsen/jepsen/project.clj ]; then cd /jepsen/jepsen && lein install; fi\nCOPY jepsen /jepsen/\n\nADD ./bashrc /root/.bashrc\nADD ./init.sh /init.sh\nRUN dos2unix /init.sh /root/.bashrc \\\n && chmod +x /init.sh\n\nCMD /init.sh\n" }, { "path": "docker/control/bashrc", "content": "eval $(ssh-agent) &> /dev/null\nssh-add /root/.ssh/id_rsa &> /dev/null\n\ncat < ~/.ssh/id_rsa\n chmod 600 ~/.ssh/id_rsa\n echo $SSH_PUBLIC_KEY > ~/.ssh/id_rsa.pub\n echo > ~/.ssh/known_hosts\n # Get nodes list\n sort -V /var/jepsen/shared/nodes > ~/nodes\n # Scan SSH keys\n while read node; do\n ssh-keyscan -t rsa $node >> ~/.ssh/known_hosts\n ssh-keyscan -t ed25519 $node >> ~/.ssh/known_hosts\n done <~/nodes\nfi\n\n# TODO: assert that SSH_PRIVATE_KEY==~/.ssh/id_rsa\n\ncat <> /var/log/jepsen-setup.log\n# We do a little dance to get our hostname (random hex), IP, then use DNS to\n# get a proper container name.\n#HOSTNAME=`hostname`\n#IP=`getent hosts \"${HOSTNAME}\" | awk '{ print $1 }'`\n#NAME=`dig +short -x \"${IP}\" | cut -f 1 -d .`\n#echo \"${NAME}\" >> /var/jepsen/shared/nodes\necho `hostname` >> /var/jepsen/shared/nodes\n\n# We make sure that root's authorized keys are ready\necho \"Setting up root's authorized_keys\" >> /var/log/jepsen-setup.log\nmkdir /root/.ssh\nchmod 700 /root/.ssh\ncp /run/secrets/authorized_keys /root/.ssh/\nchmod 600 /root/.ssh/authorized_keys\n" }, { "path": "docker/secret/.gitkeep", "content": "" }, { "path": "docker/template/db.yml", "content": " n%%N%%:\n << : *default-node\n container_name: jepsen-n%%N%%\n hostname: n%%N%%\n" }, { "path": "docker/template/depends.yml", "content": " n%%N%%:\n condition: service_healthy\n" }, { "path": "docker/template/docker-compose.yml", "content": "x-node:\n &default-node\n privileged: true\n build: ./node\n env_file: ./secret/node.env\n secrets:\n - authorized_keys\n tty: true\n tmpfs:\n - /run:size=100M\n - /run/lock:size=100M\n cgroup: host\n volumes:\n - \"/sys/fs/cgroup:/sys/fs/cgroup:rw\"\n - \"jepsen-shared:/var/jepsen/shared\"\n networks:\n - jepsen\n cap_add:\n - ALL\n ports:\n - ${JEPSEN_PORT:-22}\n stop_signal: SIGRTMIN+3\n healthcheck:\n test: [ 'CMD-SHELL', 'systemctl status sshd | grep \"Active: active (running)\"' ]\n interval: 1s\n timeout: 1s\n retries: 3\n start_period: 3s\n depends_on: \n setup:\n condition: service_completed_successfully\n\nvolumes:\n jepsen-shared:\n\nsecrets:\n authorized_keys:\n file: ./secret/authorized_keys\n\nnetworks:\n jepsen:\n\nservices:\n setup:\n image: jgoerzen/debian-base-standard:bookworm\n container_name: jepsen-setup\n hostname: setup\n volumes:\n - \"jepsen-shared:/var/jepsen/shared\"\n entrypoint: [ 'rm', '-rf', '/var/jepsen/shared/nodes' ] \n control:\n container_name: jepsen-control\n hostname: control\n depends_on:\n%%DEPS%%\n build: ./control\n env_file: ./secret/control.env\n ports:\n - \"22\"\n - \"8080\"\n networks:\n - jepsen\n volumes:\n - \"jepsen-shared:/var/jepsen/shared\"\n stop_signal: SIGRTMIN+3\n%%DBS%%\n" }, { "path": "generator/.gitignore", "content": "/target\n/classes\n/checkouts\nprofiles.clj\npom.xml\npom.xml.asc\n*.jar\n*.class\n/.lein-*\n/.nrepl-port\n/.prepl-port\n.hgignore\n.hg/\n" }, { "path": "generator/CHANGELOG.md", "content": "# Change Log\nAll notable changes to this project will be documented in this file. This change log follows the conventions of [keepachangelog.com](https://keepachangelog.com/).\n\n## [Unreleased]\n### Changed\n- Add a new arity to `make-widget-async` to provide a different widget shape.\n\n## [0.1.1] - 2025-09-13\n### Changed\n- Documentation on how to make the widgets.\n\n### Removed\n- `make-widget-sync` - we're all async, all the time.\n\n### Fixed\n- Fixed widget maker to keep working when daylight savings switches over.\n\n## 0.1.0 - 2025-09-13\n### Added\n- Files from the new template.\n- Widget maker public API - `make-widget-sync`.\n\n[Unreleased]: https://sourcehost.site/your-name/jepsen.generator/compare/0.1.1...HEAD\n[0.1.1]: https://sourcehost.site/your-name/jepsen.generator/compare/0.1.0...0.1.1\n" }, { "path": "generator/LICENSE", "content": "Eclipse Public License - v 2.0\n\n THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE\n PUBLIC LICENSE (\"AGREEMENT\"). ANY USE, REPRODUCTION OR DISTRIBUTION\n OF THE PROGRAM CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT.\n\n1. DEFINITIONS\n\n\"Contribution\" means:\n\n a) in the case of the initial Contributor, the initial content\n Distributed under this Agreement, and\n\n b) in the case of each subsequent Contributor:\n i) changes to the Program, and\n ii) additions to the Program;\n where such changes and/or additions to the Program originate from\n and are Distributed by that particular Contributor. A Contribution\n \"originates\" from a Contributor if it was added to the Program by\n such Contributor itself or anyone acting on such Contributor's behalf.\n Contributions do not include changes or additions to the Program that\n are not Modified Works.\n\n\"Contributor\" means any person or entity that Distributes the Program.\n\n\"Licensed Patents\" mean patent claims licensable by a Contributor which\nare necessarily infringed by the use or sale of its Contribution alone\nor when combined with the Program.\n\n\"Program\" means the Contributions Distributed in accordance with this\nAgreement.\n\n\"Recipient\" means anyone who receives the Program under this Agreement\nor any Secondary License (as applicable), including Contributors.\n\n\"Derivative Works\" shall mean any work, whether in Source Code or other\nform, that is based on (or derived from) the Program and for which the\neditorial revisions, annotations, elaborations, or other modifications\nrepresent, as a whole, an original work of authorship.\n\n\"Modified Works\" shall mean any work in Source Code or other form that\nresults from an addition to, deletion from, or modification of the\ncontents of the Program, including, for purposes of clarity any new file\nin Source Code form that contains any contents of the Program. Modified\nWorks shall not include works that contain only declarations,\ninterfaces, types, classes, structures, or files of the Program solely\nin each case in order to link to, bind by name, or subclass the Program\nor Modified Works thereof.\n\n\"Distribute\" means the acts of a) distributing or b) making available\nin any manner that enables the transfer of a copy.\n\n\"Source Code\" means the form of a Program preferred for making\nmodifications, including but not limited to software source code,\ndocumentation source, and configuration files.\n\n\"Secondary License\" means either the GNU General Public License,\nVersion 2.0, or any later versions of that license, including any\nexceptions or additional permissions as identified by the initial\nContributor.\n\n2. GRANT OF RIGHTS\n\n a) Subject to the terms of this Agreement, each Contributor hereby\n grants Recipient a non-exclusive, worldwide, royalty-free copyright\n license to reproduce, prepare Derivative Works of, publicly display,\n publicly perform, Distribute and sublicense the Contribution of such\n Contributor, if any, and such Derivative Works.\n\n b) Subject to the terms of this Agreement, each Contributor hereby\n grants Recipient a non-exclusive, worldwide, royalty-free patent\n license under Licensed Patents to make, use, sell, offer to sell,\n import and otherwise transfer the Contribution of such Contributor,\n if any, in Source Code or other form. This patent license shall\n apply to the combination of the Contribution and the Program if, at\n the time the Contribution is added by the Contributor, such addition\n of the Contribution causes such combination to be covered by the\n Licensed Patents. The patent license shall not apply to any other\n combinations which include the Contribution. No hardware per se is\n licensed hereunder.\n\n c) Recipient understands that although each Contributor grants the\n licenses to its Contributions set forth herein, no assurances are\n provided by any Contributor that the Program does not infringe the\n patent or other intellectual property rights of any other entity.\n Each Contributor disclaims any liability to Recipient for claims\n brought by any other entity based on infringement of intellectual\n property rights or otherwise. As a condition to exercising the\n rights and licenses granted hereunder, each Recipient hereby\n assumes sole responsibility to secure any other intellectual\n property rights needed, if any. For example, if a third party\n patent license is required to allow Recipient to Distribute the\n Program, it is Recipient's responsibility to acquire that license\n before distributing the Program.\n\n d) Each Contributor represents that to its knowledge it has\n sufficient copyright rights in its Contribution, if any, to grant\n the copyright license set forth in this Agreement.\n\n e) Notwithstanding the terms of any Secondary License, no\n Contributor makes additional grants to any Recipient (other than\n those set forth in this Agreement) as a result of such Recipient's\n receipt of the Program under the terms of a Secondary License\n (if permitted under the terms of Section 3).\n\n3. REQUIREMENTS\n\n3.1 If a Contributor Distributes the Program in any form, then:\n\n a) the Program must also be made available as Source Code, in\n accordance with section 3.2, and the Contributor must accompany\n the Program with a statement that the Source Code for the Program\n is available under this Agreement, and informs Recipients how to\n obtain it in a reasonable manner on or through a medium customarily\n used for software exchange; and\n\n b) the Contributor may Distribute the Program under a license\n different than this Agreement, provided that such license:\n i) effectively disclaims on behalf of all other Contributors all\n warranties and conditions, express and implied, including\n warranties or conditions of title and non-infringement, and\n implied warranties or conditions of merchantability and fitness\n for a particular purpose;\n\n ii) effectively excludes on behalf of all other Contributors all\n liability for damages, including direct, indirect, special,\n incidental and consequential damages, such as lost profits;\n\n iii) does not attempt to limit or alter the recipients' rights\n in the Source Code under section 3.2; and\n\n iv) requires any subsequent distribution of the Program by any\n party to be under a license that satisfies the requirements\n of this section 3.\n\n3.2 When the Program is Distributed as Source Code:\n\n a) it must be made available under this Agreement, or if the\n Program (i) is combined with other material in a separate file or\n files made available under a Secondary License, and (ii) the initial\n Contributor attached to the Source Code the notice described in\n Exhibit A of this Agreement, then the Program may be made available\n under the terms of such Secondary Licenses, and\n\n b) a copy of this Agreement must be included with each copy of\n the Program.\n\n3.3 Contributors may not remove or alter any copyright, patent,\ntrademark, attribution notices, disclaimers of warranty, or limitations\nof liability (\"notices\") contained within the Program from any copy of\nthe Program which they Distribute, provided that Contributors may add\ntheir own appropriate notices.\n\n4. COMMERCIAL DISTRIBUTION\n\nCommercial distributors of software may accept certain responsibilities\nwith respect to end users, business partners and the like. While this\nlicense is intended to facilitate the commercial use of the Program,\nthe Contributor who includes the Program in a commercial product\noffering should do so in a manner which does not create potential\nliability for other Contributors. Therefore, if a Contributor includes\nthe Program in a commercial product offering, such Contributor\n(\"Commercial Contributor\") hereby agrees to defend and indemnify every\nother Contributor (\"Indemnified Contributor\") against any losses,\ndamages and costs (collectively \"Losses\") arising from claims, lawsuits\nand other legal actions brought by a third party against the Indemnified\nContributor to the extent caused by the acts or omissions of such\nCommercial Contributor in connection with its distribution of the Program\nin a commercial product offering. The obligations in this section do not\napply to any claims or Losses relating to any actual or alleged\nintellectual property infringement. In order to qualify, an Indemnified\nContributor must: a) promptly notify the Commercial Contributor in\nwriting of such claim, and b) allow the Commercial Contributor to control,\nand cooperate with the Commercial Contributor in, the defense and any\nrelated settlement negotiations. The Indemnified Contributor may\nparticipate in any such claim at its own expense.\n\nFor example, a Contributor might include the Program in a commercial\nproduct offering, Product X. That Contributor is then a Commercial\nContributor. If that Commercial Contributor then makes performance\nclaims, or offers warranties related to Product X, those performance\nclaims and warranties are such Commercial Contributor's responsibility\nalone. Under this section, the Commercial Contributor would have to\ndefend claims against the other Contributors related to those performance\nclaims and warranties, and if a court requires any other Contributor to\npay any damages as a result, the Commercial Contributor must pay\nthose damages.\n\n5. NO WARRANTY\n\nEXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, AND TO THE EXTENT\nPERMITTED BY APPLICABLE LAW, THE PROGRAM IS PROVIDED ON AN \"AS IS\"\nBASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER EXPRESS OR\nIMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR CONDITIONS OF\nTITLE, NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A PARTICULAR\nPURPOSE. Each Recipient is solely responsible for determining the\nappropriateness of using and distributing the Program and assumes all\nrisks associated with its exercise of rights under this Agreement,\nincluding but not limited to the risks and costs of program errors,\ncompliance with applicable laws, damage to or loss of data, programs\nor equipment, and unavailability or interruption of operations.\n\n6. DISCLAIMER OF LIABILITY\n\nEXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, AND TO THE EXTENT\nPERMITTED BY APPLICABLE LAW, NEITHER RECIPIENT NOR ANY CONTRIBUTORS\nSHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,\nEXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION LOST\nPROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN\nCONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)\nARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE\nEXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE\nPOSSIBILITY OF SUCH DAMAGES.\n\n7. GENERAL\n\nIf any provision of this Agreement is invalid or unenforceable under\napplicable law, it shall not affect the validity or enforceability of\nthe remainder of the terms of this Agreement, and without further\naction by the parties hereto, such provision shall be reformed to the\nminimum extent necessary to make such provision valid and enforceable.\n\nIf Recipient institutes patent litigation against any entity\n(including a cross-claim or counterclaim in a lawsuit) alleging that the\nProgram itself (excluding combinations of the Program with other software\nor hardware) infringes such Recipient's patent(s), then such Recipient's\nrights granted under Section 2(b) shall terminate as of the date such\nlitigation is filed.\n\nAll Recipient's rights under this Agreement shall terminate if it\nfails to comply with any of the material terms or conditions of this\nAgreement and does not cure such failure in a reasonable period of\ntime after becoming aware of such noncompliance. If all Recipient's\nrights under this Agreement terminate, Recipient agrees to cease use\nand distribution of the Program as soon as reasonably practicable.\nHowever, Recipient's obligations under this Agreement and any licenses\ngranted by Recipient relating to the Program shall continue and survive.\n\nEveryone is permitted to copy and distribute copies of this Agreement,\nbut in order to avoid inconsistency the Agreement is copyrighted and\nmay only be modified in the following manner. The Agreement Steward\nreserves the right to publish new versions (including revisions) of\nthis Agreement from time to time. No one other than the Agreement\nSteward has the right to modify this Agreement. The Eclipse Foundation\nis the initial Agreement Steward. The Eclipse Foundation may assign the\nresponsibility to serve as the Agreement Steward to a suitable separate\nentity. Each new version of the Agreement will be given a distinguishing\nversion number. The Program (including Contributions) may always be\nDistributed subject to the version of the Agreement under which it was\nreceived. In addition, after a new version of the Agreement is published,\nContributor may elect to Distribute the Program (including its\nContributions) under the new version.\n\nExcept as expressly stated in Sections 2(a) and 2(b) above, Recipient\nreceives no rights or licenses to the intellectual property of any\nContributor under this Agreement, whether expressly, by implication,\nestoppel or otherwise. All rights in the Program not expressly granted\nunder this Agreement are reserved. Nothing in this Agreement is intended\nto be enforceable by any entity that is not a Contributor or Recipient.\nNo third-party beneficiary rights are created under this Agreement.\n\nExhibit A - Form of Secondary Licenses Notice\n\n\"This Source Code may also be made available under the following\nSecondary Licenses when the conditions for such availability set forth\nin the Eclipse Public License, v. 2.0 are satisfied: GNU General Public\nLicense as published by the Free Software Foundation, either version 2\nof the License, or (at your option) any later version, with the GNU\nClasspath Exception which is available at\nhttps://www.gnu.org/software/classpath/license.html.\"\n\n Simply including a copy of this Agreement, including this Exhibit A\n is not sufficient to license the Source Code under Secondary Licenses.\n\n If it is not possible or desirable to put the notice in a particular\n file, then You may include the notice in a location (such as a LICENSE\n file in a relevant directory) where a recipient would be likely to\n look for such a notice.\n\n You may add additional accurate notices of copyright ownership.\n" }, { "path": "generator/README.md", "content": "# jepsen.generator\n\nThis library provides the compositional generator system at the heart of\n[Jepsen](https://jepsen.io). Generators produce a series of operations Jepsen\nwould like to perform against a system, like \"Set key `x` to 3\". They also\nreact to operations as they happen. For example, if the write fails, the\ngenerator could decide to retry it.\n\nIn addition to the generators themselves, this library provides:\n\n- `jepsen.random`: Pluggable random values\n- `jepsen.generator.test`: Helpers for testing generators\n- `jepsen.generator.context`: A high-performance, pure data structure which\n keeps track of the state used by generators\n- `jepsen.generator.translation-table`: Maps worker threads to integers\n\n## License\n\nCopyright © Jepsen, LLC\n\nThis program and the accompanying materials are made available under the\nterms of the Eclipse Public License 2.0 which is available at\nhttps://www.eclipse.org/legal/epl-2.0.\n\nThis Source Code may also be made available under the following Secondary\nLicenses when the conditions for such availability set forth in the Eclipse\nPublic License, v. 2.0 are satisfied: GNU General Public License as published by\nthe Free Software Foundation, either version 2 of the License, or (at your\noption) any later version, with the GNU Classpath Exception which is available\nat https://www.gnu.org/software/classpath/license.html.\n" }, { "path": "generator/doc/intro.md", "content": "# Introduction to jepsen.generator\n\nTODO: write [great documentation](https://jacobian.org/writing/what-to-write/)\n" }, { "path": "generator/project.clj", "content": "(defproject io.jepsen/generator \"0.1.2-SNAPSHOT\"\n :description \"Pure functional generators for Jepsen tests\"\n :url \"https://github.com/jepsen-io/jepsen\"\n :license {:name \"EPL-2.0 OR GPL-2.0-or-later WITH Classpath-exception-2.0\"\n :url \"https://www.eclipse.org/legal/epl-2.0/\"}\n :dependencies [[fipp \"0.6.29\"] ; Just so we can explain HOW to pretty-print generators\n [io.jepsen/history \"0.1.7\"]\n [org.clj-commons/primitive-math \"1.0.1\"]\n [org.clojure/data.generators \"1.1.1\"\n :exclusions [org.clojure/clojure]]\n [slingshot \"0.12.2\"]]\n :profiles {:dev {:dependencies [[org.clojure/clojure \"1.12.4\"]\n [criterium \"0.4.6\"]]}}\n :repl-options {:init-ns user}\n :test-selectors {:default (fn [m]\n (not (:perf m)))\n :focus :focus\n :perf :perf})\n" }, { "path": "generator/src/jepsen/generator/context.clj", "content": "(ns jepsen.generator.context\n \"Generators work with an immutable *context* that tells them what time it is,\n what processes are available, what process is executing which thread and vice\n versa, and so on. We need an efficient, high-performance data structure to\n track this information. This namespace provides that data structure, and\n functions to alter it.\n\n Contexts are intended not only for managing generator-relevant state about\n active threads and so on; they also can store arbitrary contextual\n information for generators. For instance, generators may thread state between\n invocations or layers of the generator stack. To do this, contexts *also*\n behave like Clojure maps. They have a single special key, :time; all other\n keys are available for your use.\"\n (:require [clojure.core.protocols :refer [Datafiable]]\n [clojure [datafy :refer [datafy]]]\n [dom-top.core :refer [loopr]]\n [jepsen.generator.translation-table :as tt]\n [potemkin :refer [def-map-type definterface+]])\n (:import (io.lacuna.bifurcan IEntry\n ISet\n IMap\n Map\n Set)\n (java.util BitSet)\n (jepsen.generator.translation_table TranslationTable)))\n\n;; Just for debugging\n(extend-protocol Datafiable\n BitSet\n (datafy [this]\n (loop [i 0\n s (sorted-set)]\n (let [i (.nextSetBit this i)]\n (if (= i -1)\n s\n (recur (inc i)\n (conj s i))))))\n\n IMap\n (datafy [this]\n (persistent!\n (reduce (fn [m ^IEntry pair]\n (assoc! m (.key pair) (.value pair)))\n (transient {})\n this))))\n\n;; Contexts\n\n(definterface+ IContext\n (^ISet all-threads [ctx]\n \"Given a context, returns a Bifurcan ISet of all threads in it.\")\n\n (all-thread-count [ctx]\n \"How many threads are in the given context, total?\")\n\n (free-thread-count [ctx]\n \"How many threads are free in the given context?\")\n\n (all-processes [ctx]\n \"Given a context, returns a Bifurcan ISet of all processes\n currently belonging to some thread.\")\n\n (process->thread [ctx process]\n \"Given a process, looks up which thread is executing it.\")\n\n (thread->process [ctx thread]\n \"Given a thread, looks up which process it's executing.\")\n\n (thread-free? [ctx thread]\n \"Is the given thread free?\")\n\n (^ISet free-threads [ctx]\n \"Given a context, returns a Bifurcan ISet of threads which are\n not actively processing an invocation.\")\n\n (free-processes [ctx]\n \"Given a context, returns a collection of processes which are\n not actively processing an invocation.\")\n\n (some-free-process [ctx]\n \"Given a context, returns a random free process, or nil if\n all are busy.\")\n\n (busy-thread [this time thread]\n \"Returns context with the given time, and the given thread no\n longer free.\")\n\n (free-thread [this time thread]\n \"Returns context with the given time, and the given thread\n free.\")\n\n (with-next-process [ctx thread]\n \"Replaces a thread's process with a new one.\"))\n\n(def-map-type Context\n [; Our time\n ^long time\n ; The next thread index we'd like to hand out\n ^int next-thread-index\n ; A translation table for thread names. May include threads not in this\n ; context.\n ^TranslationTable translation-table\n ; A bitset of thread indices which are active in this context\n ^BitSet all-threads\n ; A bitset of thread indices which are not busy evaluating anything\n ^BitSet free-threads\n ; An array which maps thread indices to the process they're currently\n ; executing. May include threads not in this context.\n ^objects thread-index->process\n ; A map of processes to the thread currently executing them. May include\n ; threads not in this context.\n ^IMap process->thread\n ; A Clojure map used for any custom fields users assign.\n ext-map]\n\n ; Our map implementation basically proxies to ext-map, except for :time\n (get [_ k default]\n (condp identical? k\n :time time\n ; We can remove these later, but it'll be nice to warn users that\n ; these are gone.\n :workers (throw (UnsupportedOperationException. \"Removed; use jepsen.generator.context/all-threads et al\"))\n :free-threads (throw (UnsupportedOperationException. \"Removed; use jepsen.generator.context/free-threads et al\"))\n (get ext-map k default)))\n\n (assoc [_ k v]\n (condp identical? k\n :time (Context. v next-thread-index\n translation-table all-threads free-threads\n thread-index->process process->thread ext-map)\n ; We can remove these later, but it'll be nice to warn users that\n ; these are gone.\n :workers (throw (UnsupportedOperationException. \"Removed; use jepsen.generator.context/all-threads et al\"))\n :free-threads (throw (UnsupportedOperationException. \"Removed; use jepsen.generator.context/free-threads\"))\n (Context. time next-thread-index translation-table all-threads\n free-threads thread-index->process process->thread\n (assoc ext-map k v))))\n\n (dissoc [_ k]\n (condp identical? k\n :time (throw (IllegalArgumentException. \"Can't dissoc :time from a context!\"))\n (Context. time next-thread-index translation-table all-threads\n free-threads thread-index->process process->thread\n (dissoc ext-map k))))\n\n (keys [_]\n (cons :time (keys ext-map)))\n\n (meta [_]\n (meta ext-map))\n\n (with-meta [_ mta]\n (Context. time next-thread-index translation-table all-threads\n free-threads thread-index->process process->thread\n (with-meta ext-map mta)))\n\n ; For debugging\n Datafiable\n (datafy [this]\n {:time time\n :next-thread-index next-thread-index\n :translation-table (datafy translation-table)\n :all-threads (datafy all-threads)\n :free-threads (datafy free-threads)\n :thread-index->process (vec thread-index->process)\n :process->thread (datafy process->thread)\n :ext-map (datafy ext-map)})\n\n ; Oh yeah, we're supposed to be a context too\n IContext\n (all-threads [this]\n (tt/indices->names translation-table all-threads))\n\n (all-thread-count [this]\n (.cardinality all-threads))\n\n (free-thread-count [this]\n (.cardinality free-threads))\n\n (all-processes [this]\n (mapv (partial thread->process this)\n (.all-threads this)))\n\n (process->thread [this process]\n (.get process->thread process nil))\n\n (thread->process [this thread]\n (let [i (tt/name->index translation-table thread)]\n (aget thread-index->process i)))\n\n (free-threads [this]\n (tt/indices->names translation-table free-threads))\n\n (free-processes [this]\n (mapv (partial thread->process this)\n (.free-threads this)))\n\n (thread-free? [this thread]\n (let [i (tt/name->index translation-table thread)]\n (.get free-threads i)))\n\n (some-free-process [this]\n (let [i (.nextSetBit free-threads next-thread-index)]\n (cond (<= 0 i)\n ; Found something!\n (aget thread-index->process i)\n\n ; Found nothing, and we checked the whole set\n (= 0 next-thread-index)\n nil\n\n ; Loop around and check from the start\n true\n (let [i (.nextSetBit free-threads 0)]\n (if (= -1 i)\n ; Definitely empty!\n nil\n (aget thread-index->process i))))))\n\n (free-thread [this time thread]\n (let [i (tt/name->index translation-table thread)]\n (Context. time next-thread-index translation-table all-threads\n (doto ^BitSet (.clone free-threads)\n (.set i))\n thread-index->process process->thread ext-map)))\n\n (busy-thread [this time thread]\n (let [i (tt/name->index translation-table thread)]\n ; When we consume a thread, we bump the next thread index. This means we\n ; rotate evenly through threads instead of giving a single thread all the\n ; ops.\n (Context. time\n (mod (inc next-thread-index)\n (tt/thread-count translation-table))\n translation-table all-threads\n (doto ^BitSet (.clone free-threads)\n (.clear i))\n thread-index->process process->thread ext-map)))\n\n (with-next-process [this thread]\n (let [process (thread->process this thread)\n process' (if (integer? process)\n (+ (.int-thread-count translation-table)\n process)\n process)\n i (tt/name->index translation-table thread)\n n (alength thread-index->process)\n thread-index->process' (aclone thread-index->process)]\n (aset thread-index->process' i process')\n (Context. time next-thread-index translation-table all-threads\n free-threads\n thread-index->process'\n (.. process->thread\n (remove process)\n (put process' thread))\n ext-map))))\n\n(defn context\n \"Constructs a fresh Context for a test. Its initial time is 0. Its threads\n are the integers from 0 to (:concurrency test), plus a :nemesis). Every\n thread is free. Each initially runs itself as a process.\"\n [test]\n (let [named-threads [:nemesis]\n translation-table (tt/translation-table (:concurrency test)\n named-threads)\n thread-count (tt/thread-count translation-table)\n thread-names (tt/all-names translation-table)\n ; Initially all threads are in the context and free\n all-threads-bitset (doto (BitSet. thread-count)\n (.set 0 thread-count))\n ; Everyone initially executes themselves\n thread-index->process (object-array thread-names)\n process->thread (loopr [^IMap m (.linear Map/EMPTY)]\n [thread thread-names]\n (recur (.put m thread thread))\n (.forked m))]\n (Context.\n 0 ; Time\n 0 ; Next thread\n translation-table\n all-threads-bitset\n all-threads-bitset\n thread-index->process\n process->thread\n ; Ext map\n {})))\n\n;; Restricting contexts to specific threads\n\n(defrecord AllBut [element]\n clojure.lang.IFn\n (invoke [_ x]\n (if (= element x)\n nil\n x)))\n\n(defn all-but\n \"One thing we do often, and which is expensive, is stripping out the nemesis\n from the set of active threads using (complement #{:nemesis}). This type\n encapsulates that notion of \\\"all but x\\\", and allows us to specialize some\n expensive functions for speed.\"\n [x]\n (AllBut. x))\n\n(defn intersect-bitsets\n \"Intersects one bitset with another, immutably.\"\n [^BitSet a ^BitSet b]\n (doto ^BitSet (.clone a)\n (.and b)))\n\n(defn make-thread-filter\n \"We often want to restrict a context to a specific subset of threads matching\n some predicate. We want to do this a *lot*. To make this fast, we can\n pre-compute a function which does this restriction more efficiently than\n doing it at runtime.\n\n Call this with a context and a predicate, and it'll construct a function\n which restricts any version of that context (e.g. one with the same threads,\n but maybe a different time or busy state) to just threads matching the given\n predicate.\n\n Don't have a context handy? Pass this just a predicate, and it'll construct a\n filter which lazily compiles itself on first invocation, and is fast\n thereafter.\"\n ; Lazy\n ([pred]\n (let [thread-filter (promise)]\n (fn lazy-filter [ctx]\n (if (realized? thread-filter)\n (@thread-filter ctx)\n (let [tf (make-thread-filter pred ctx)]\n (deliver thread-filter tf)\n (tf ctx))))))\n ; Explicit precomputation\n ([pred ^Context ctx]\n ; Compute a bitset of thread indices in advance\n (let [tt (.translation-table ctx)\n ^BitSet bitset (.clone ^BitSet (.-all-threads ctx))]\n ; Compute a subset of our thread set which matches the given predicate.\n (loop [i 0]\n (let [i (.nextSetBit bitset i)]\n (when-not (= i -1)\n ; We've got indices to consider\n (when-not (pred (tt/index->name tt i))\n ; This isn't in the set; clear it\n (.clear bitset i))\n (recur (inc i)))))\n\n ; And here's a function that intersects the threads with that bitset.\n (fn by-bitset [^Context ctx]\n (Context. (.time ctx)\n (.next-thread-index ctx)\n (.translation-table ctx)\n (intersect-bitsets bitset (.-all-threads ctx))\n (intersect-bitsets bitset (.-free-threads ctx))\n (.thread-index->process ctx)\n (.-process->thread ctx)\n (.ext-map ctx))))))\n" }, { "path": "generator/src/jepsen/generator/test.clj", "content": "(ns jepsen.generator.test\n \"This namespace contains functions for testing generators. See the\n `jepsen.generator-test` namespace in the `test/` directory for a concrete\n example of how these functions can be used.\n\n NOTE: While the `simulate` function is considered stable at this point, the\n others might still be subject to change -- use with care and expect possible\n breakage in future releases.\"\n (:require [clojure.datafy :refer [datafy]]\n [dom-top.core :refer [assert+]]\n [jepsen [generator :as gen]\n [history :as history]]\n [jepsen.generator.context :as ctx])\n (:import (io.lacuna.bifurcan Set)))\n\n(def default-test\n \"A default test map.\"\n {:nodes [\"n1\" \"n2\"]})\n\n(defn n+nemesis-context\n \"A context with n numeric worker threads and one nemesis.\"\n [n]\n (gen/context {:concurrency n}))\n\n(def default-context\n \"A default initial context for running these tests. Two worker threads, one\n nemesis.\"\n (n+nemesis-context 2))\n\n(defn invocations\n \"Only invokes, not returns\"\n [history]\n (filter #(= :invoke (:type %)) history))\n\n(defmacro with-fixed-rands\n \"Rebinds rand, rand-int, and rand-nth to yield a deterministic series of\n random values. Definitely not threadsafe, but fine for tests I think.\"\n [seed & body]\n `(let [rand-values# (atom (gen/rand-seq ~seed))\n rand-int-values# (atom (gen/rand-int-seq ~seed))\n rand# (fn ~'rand\n ([]\n (first (swap! rand-values# next)))\n ([limit#]\n (* limit# (first (swap! rand-values# next)))))\n rand-int# (fn ~'rand-int [limit#]\n (if (zero? limit#)\n 0\n (mod (first (swap! rand-int-values# next))\n limit#)))\n rand-nth# (fn ~'rand-nth [coll#]\n (nth coll# (rand-int# (count coll#))))]\n (with-redefs [rand rand#\n rand-int rand-int#\n rand-nth rand-nth]\n ~@body)))\n\n(def rand-seed\n \"We need tests to be deterministic for reproducibility, but also\n pseudorandom. Changing this seed will force rewriting some tests, but it\n might be necessary for discovering edge cases.\"\n 45100)\n\n(defn simulate\n \"Simulates the series of operations obtained from a generator, given a\n function that takes a context and op and returns the completion for that op.\n\n Strips out op :index fields--it's generally not as useful for testing.\"\n ([gen complete-fn]\n (simulate default-context gen complete-fn))\n ([ctx gen complete-fn]\n (with-fixed-rands rand-seed\n (loop [ops []\n in-flight [] ; Kept sorted by time\n gen (gen/validate gen)\n ctx ctx]\n ;(binding [*print-length* 3] (prn :invoking :gen gen))\n (let [[invoke gen'] (gen/op gen default-test ctx)]\n ; (prn :invoke invoke :in-flight in-flight)\n (if (nil? invoke)\n ; We're done\n (->> (into ops in-flight)\n (history/strip-indices))\n\n ; TODO: the order of updates for worker maps here isn't correct; fix\n ; it.\n (if (and (not= :pending invoke)\n (or (empty? in-flight)\n (<= (:time invoke) (:time (first in-flight)))))\n\n ; We have an invocation that's not pending, and that invocation is\n ; before every in-flight completion\n (let [thread (gen/process->thread ctx (:process invoke))\n ; Advance clock, mark thread as busy\n ctx (ctx/busy-thread\n ctx\n (max (:time ctx) (:time invoke))\n thread)\n ; Update the generator with this invocation\n gen' (gen/update gen' default-test ctx invoke)\n ; Add the completion to the in-flight set\n ;_ (prn :invoke invoke)\n complete (complete-fn ctx invoke)\n in-flight (sort-by :time (conj in-flight complete))]\n (recur (conj ops invoke) in-flight gen' ctx))\n\n ; We need to complete something before we can apply the next\n ; invocation.\n (let [op (first in-flight)\n _ (assert+ op\n {:type :generator-pending-but-nothing-in-flight\n :gen gen'\n :ctx (datafy ctx)})\n thread (gen/process->thread ctx (:process op))\n ; Advance clock, mark thread as free\n ctx (ctx/free-thread ctx (:time op) thread)\n ; Update generator with completion\n gen' (gen/update gen default-test ctx op)\n ; Update worker mapping if this op crashed\n ctx (if (or (= :nemesis thread) (not= :info (:type op)))\n ctx\n (ctx/with-next-process ctx thread))]\n (recur (conj ops op) (rest in-flight) gen' ctx)))))))))\n\n(defn quick-ops\n \"Simulates the series of ops obtained from a generator where the\n system executes every operation perfectly, immediately, and with zero\n latency.\"\n ([gen]\n (quick-ops default-context gen))\n ([ctx gen]\n (simulate ctx gen (fn [ctx invoke] (assoc invoke :type :ok)))))\n\n(defn quick\n \"Like quick-ops, but returns just invocations.\"\n ([gen]\n (quick default-context gen))\n ([ctx gen]\n (invocations (quick-ops ctx gen))))\n\n(def perfect-latency\n \"How long perfect operations take\"\n 10)\n\n(defn perfect*\n \"Simulates the series of ops obtained from a generator where the system\n executes every operation successfully in 10 nanoseconds. Returns full\n history.\"\n ([gen]\n (perfect* default-context gen))\n ([ctx gen]\n (simulate ctx gen\n (fn [ctx invoke]\n (-> invoke\n (assoc :type :ok)\n (update :time + perfect-latency))))))\n\n(defn perfect\n \"Simulates the series of ops obtained from a generator where the system\n executes every operation successfully in 10 nanoseconds. Returns only\n invocations.\"\n ([gen]\n (perfect default-context gen))\n ([ctx gen]\n (invocations (perfect* ctx gen))))\n\n(defn perfect-info\n \"Simulates the series of ops obtained from a generator where every operation\n crashes with :info in 10 nanoseconds. Returns only invocations.\"\n ([gen]\n (perfect-info default-context gen))\n ([ctx gen]\n (invocations\n (simulate ctx gen\n (fn [ctx invoke]\n (-> invoke\n (assoc :type :info)\n (update :time + perfect-latency)))))))\n\n(defn imperfect\n \"Simulates the series of ops obtained from a generator where threads\n alternately fail, info, then ok, and repeat, taking 10 ns each. Returns\n invocations and completions.\"\n ([gen]\n (imperfect default-context gen))\n ([ctx gen]\n (let [state (atom {})]\n (simulate ctx gen\n (fn [ctx invoke]\n (let [t (gen/process->thread ctx (:process invoke))]\n (-> invoke\n (assoc :type (get (swap! state update t {nil :fail\n :fail :info\n :info :ok\n :ok :fail})\n t))\n (update :time + perfect-latency))))))))\n" }, { "path": "generator/src/jepsen/generator/translation_table.clj", "content": "(ns jepsen.generator.translation-table\n \"We burn a lot of time in hashcode and map manipulation for thread names,\n which are mostly integers 0...n, but sometimes non-integer names like\n :nemesis. It's nice to be able to represent thread state internally as purely\n integers. To do this, we compute a one-time translation table which lets us\n map those names to integers and vice-versa.\"\n (:require [clojure.core.protocols :refer [Datafiable]]\n [clojure [datafy :refer [datafy]]]\n [dom-top.core :refer [loopr]]\n [potemkin :refer [def-map-type definterface+]])\n (:import (io.lacuna.bifurcan ISet\n IMap\n Map\n Set)\n (java.util BitSet)))\n\n(deftype TranslationTable\n [; Number of numeric threads\n ^int int-thread-count\n ; Array of all threads which *aren't* integers; e.g. :nemesis\n ^objects named-threads\n ; Map of named threads to their indices\n ^IMap named-thread->index]\n\n Datafiable\n (datafy [this]\n {:int-thread-count int-thread-count\n :named-threads (vec named-threads)\n :named-thread->index (datafy named-thread->index)}))\n\n(defn translation-table\n \"Takes a number of integer threads and a collection of named threads, and\n computes a translation table.\"\n [int-thread-count named-threads]\n (let [named-threads-array (object-array (count named-threads))]\n (loopr [^IMap named-thread->index (.linear Map/EMPTY)\n i 0]\n [thread named-threads]\n (do (aset named-threads-array i thread)\n (recur (.put named-thread->index thread (int i))\n (inc i)))\n (TranslationTable. int-thread-count\n named-threads-array\n (.forked named-thread->index)))))\n\n(defn all-names\n \"A sequence of all names in the translation table, in the exact order of\n thread indices. Index 0's name comes first, then 1, and so on.\"\n [^TranslationTable translation-table]\n (concat (range (.int-thread-count translation-table))\n (.named-threads translation-table)))\n\n(defn thread-count\n \"How many threads in a translation table in all?\"\n ^long [^TranslationTable translation-table]\n (let [^objects named-threads (.named-threads translation-table)]\n (+ (.int-thread-count translation-table)\n (alength named-threads))))\n\n(defn name->index\n \"Turns a thread name (e.g. 0, 5, or :nemesis) into a primitive int.\"\n ^long [^TranslationTable translation-table thread-name]\n (if (integer? thread-name)\n thread-name\n (let [^IMap m (.named-thread->index translation-table)\n ; We're not doing bounds checks but we DO want this to blow up\n ; obviously\n i (.get m thread-name Long/MIN_VALUE)]\n (+ (.int-thread-count translation-table)))))\n\n(defn index->name\n \"Turns a thread index (an int) into a thread name (e.g. 0, 5, or :nemesis).\"\n [^TranslationTable translation-table ^long thread-index]\n (let [itc (.int-thread-count translation-table)]\n (if (< thread-index itc)\n thread-index\n (aget ^objects (.named-threads translation-table) (- thread-index itc)))))\n\n(defn ^ISet indices->names\n \"Takes a translation table and a BitSet of thread indices. Constructs a\n Bifurcan ISet out of those threads.\"\n [translation-table ^BitSet indices]\n (loop [i 0\n ^ISet names (.linear Set/EMPTY)]\n (let [i' (.nextSetBit indices i)]\n (if (= i' -1)\n (.forked names)\n (recur (inc i')\n (.add names (index->name translation-table i')))))))\n\n(defn ^BitSet names->indices\n \"Takes a translation table and a collection of thread names. Constructs a\n BitSet of those thread indices.\"\n [translation-table names]\n (let [bs (BitSet. (count names))]\n (loopr []\n [name names]\n (do (.set bs (name->index translation-table name))\n (recur)))\n bs))\n" }, { "path": "generator/src/jepsen/generator.clj", "content": "(ns jepsen.generator\n \"# In a Nutshell\n\n Generators tell Jepsen what to do during a test. Generators are purely\n functional objects which support two functions: `op` and `update`. `op`\n produces operations for Jepsen to perform: it takes a test and context\n object, and yields:\n\n - nil if the generator is exhausted\n - :pending if the generator doesn't know what to do yet\n - [op, gen'], where op' is the next operation this generator would like to\n execute, and `gen'` is the state of the generator that would result if `op`\n were evaluated. Ops must be a jepsen.history.Op.\n\n `update` allows generators to evolve as events occur--for instance, when an\n operation is invoked or completed. For instance, `update` allows a generator\n to emit read operations *until* at least one succeeds.\n\n Maps, sequences, and functions are all generators, allowing you to write all\n kinds of generators using existing Clojure tooling. This namespace provides\n additional transformations and combinators for complex transformations.\n\n # Migrating From Classic Generators\n\n The old jepsen.generator namespace used mutable state everywhere, and was\n plagued by race conditions. jepsen.generator.pure provides a similar API, but\n its purely functional approach has several advantages:\n\n - Pure generators shouldn't deadlock or throw weird interrupted exceptions.\n These issues have plagued classic generators; I've done my best to make\n incremental improvements, but the problems seem unavoidable.\n\n - Pure generators can respond to completion operations, which means you can\n write things like 'keep trying x until y occurs' without sharing complex\n mutable state with clients.\n\n - Sequences are pure generators out of the box; no more juggling gen/seq\n wrappers. Use existing Clojure sequence transformations to build complex\n behaviors.\n\n - Pure generators provide an explicit 'I don't know yet' state, which is\n useful when you know future operations might come, but don't know when or\n what they are.\n\n - Pure generators do not rely on dynamic state; their arguments are all\n explicit. They are deterministically testable.\n\n - Pure generators allow new combinators like (any gen1 gen2 gen3), which\n returns the first operation from any of several generators; this approach\n was impossible in classic generators.\n\n - Pure generators have an explicit, deterministic model of time, rather than\n relying on thread scheduler constructs like Thread/sleep.\n\n - Certain constructs, like gen/sleep and gen/log in classic generators, could\n not be composed in sequences readily; pure generators provide a regular\n composition language.\n\n - Constructs like gen/each, which were fragile in classic generators and\n relied on macro magic, are now simple functions.\n\n - Pure generators are significantly simpler to implement and test than\n classic generators, though they do require careful thought.\n\n There are some notable tradeoffs, including:\n\n - Pure generators perform all generator-related computation on a single\n thread, and create additional garbage due to their pure functional approach.\n However, realistic generator tests yield rates over 20,000 operations/sec,\n which seems more than sufficient for Jepsen's purposes.\n\n - The API is subtly different. In my experience teaching hundreds of\n engineers to write Jepsen tests, users typically cite the generator API as\n one of Jepsen's best features. I've tried to preserve as much of its shape\n as possible, while sanding off rough edges and cleaning up inconsistencies.\n Some functions have the same shape but different semantics: `stagger`, for\n instance, now takes a *total* rather than a `*per-thread*` rate. Some\n infrequently-used generators have not been ported, to keep the API smaller.\n\n - `update` and contexts are not a full replacement for mutable state. We\n think they should suffice for most practical uses, and controlled use of\n mutable shared state is still possible.\n\n - You can (and we encourage!) the use of impure functions, e.g. randomness,\n as impure generators. However, it's possible I haven't fully thought\n through the implications of this choice; the semantics may evolve over\n time.\n\n When migrating old to new generators, keep in mind:\n\n - `gen/seq` and `gen/seq-all` are unnecessary; any Clojure sequence is\n already a pure generator. `gen/seq` didn't just turn sequences into\n generators; it also ensured that only one operation was consumed from each.\n This is now explicit: use `(map gen.pure/once coll)` instead of (gen/seq\n coll)`, and `coll` instead of `(gen/seq-all coll)`. Where the sequence is\n of one-shot generators already, there's no need to wrap elements with\n gen/once: instead of `(gen/seq [{:f :read} {:f :write}])`), you can write\n [{:f :read} {:f :write}] directly.\n\n - Functions return generators, not just operations, which makes it easier to\n express sequences of operations like 'pick the current leader, isolate it,\n then kill that same node, then restart that node.' Use `#(gen/once {:f\n :write, :value (rand-int 5))` instead of `(fn [] {:f :write, :value\n (rand-int 5)})`.\n\n - `stagger`, `delay`, etc. now take total rates, rather than the rate per\n thread.\n\n - `delay-til` is gone. It should come back; I just haven't written it yet.\n Defining what exactly delay-til means is... surprisingly tricky.\n\n - `each` used to mean 'on each process', but in practice what users generally\n wanted was 'on each thread'--on each process had a tendency to result in\n unexpected infinite loops when ops crashed. `each-thread` is probably what\n you want instead.\n\n - Instead of using *jepsen.generator/threads*, etc, use helper functions like\n some-free-process.\n\n - Functions now take zero args (f) or a test and context map (f test ctx),\n rather than (f test process).\n\n - Maps are one-shot generators by default, rather than emitting themselves\n indefinitely. This streamlines the most common use cases:\n\n - (map (fn [x] {:f :write, :value x}) (range)) produces a series of\n distinct, monotonically increasing writes\n\n - (fn [] {:f :inc, :value (rand-nth 5)}) produces a series of random\n increments, rather than a series where every value is the *same*\n (randomly selected) value.\n\n When migrating, you can drop most uses of gen/once around maps, and\n introduce (repeat ...) where you want to repeat an operation more than once.\n\n # In More Detail\n\n A Jepsen history is a list of operations--invocations and completions. A\n generator's job is to specify what invocations to perform, and when. In a\n sense, a generator *becomes* a history as Jepsen incrementally applies it to\n a database.\n\n Naively, we might define a history as a fixed sequence of invocations to\n perform at certain times, but this is impossible: we have only a fixed set of\n threads, and they may not be free to perform our operations. A thread must be\n *free* in order to perform an operation.\n\n Time, too, is a dependency. When we schedule an operation to occur once per\n second, we mean that only once a certain time has passed can the next\n operation begin.\n\n There may also be dependencies between threads. Perhaps only after a nemesis\n has initiated a network partition does our client perform a particular read.\n We want the ability to hold until a certain operation has begun.\n\n Conceptually, then, a generator is a *graph* of events, some of which have\n not yet occurred. Some events are invocations: these are the operations the\n generator will provide to clients. Some events are completions: these are\n provided by clients to the generator. Other events are temporal: a certain\n time has passed.\n\n This graph has some invocations which are *ready* to perform. When we have a\n ready invocation, we apply the invocation using the client, obtain a\n completion, and apply the completion back to the graph, obtaining a new\n graph.\n\n ## By Example\n\n Perform a single read\n\n {:f :read}\n\n Perform a series of random writes:\n\n (fn [] {:f :write, :value (rand-int 5))\n\n Perform 10 random writes. This is regular clojure.core/repeat:\n\n (repeat 10 (fn [] {:f :write, :value (rand-int 5)))\n\n Perform a sequence of 50 unique writes. We use regular Clojure sequence\n functions here:\n\n (->> (range)\n (map (fn [x] {:f :write, :value (rand-int 5)}))\n (take 50))\n\n Write 3, then (possibly concurrently) read:\n\n [{:f :write, :value 3} {:f :read}]\n\n Since these might execute concurrently, the read might not observe the write.\n To wait for the write to complete first:\n\n (gen/phases {:f :write, :value 3}\n {:f :read})\n\n Have each thread independently perform a single increment, then read:\n\n (gen/each-thread [{:f :inc} {:f :read}])\n\n Reserve 5 threads for reads, 10 threads for increments, and the remaining\n threads reset a counter.\n\n (gen/reserve 5 (repeat {:f :read})\n 10 (repeat {:f :inc})\n (repeat {:f :reset}))\n\n Perform a random mixture of unique writes and reads, randomly timed, at\n roughly 10 Hz, for 30 seconds:\n\n (->> (gen/mix [(repeat {:f :read})\n (map (fn [x] {:f :write, :value x}) (range))])\n (gen/stagger 1/10)\n (gen/time-limit 30))\n\n While that's happening, have the nemesis alternate between\n breaking and repairing something roughly every 5 seconds:\n\n (->> (gen/mix [(repeat {:f :read})\n (map (fn [x] {:f :write, :value x}) (range))])\n (gen/stagger 1/10)\n (gen/nemesis (->> (cycle [{:f :break}\n {:f :repair}])\n (gen/stagger 5)))\n (gen/time-limit 30))\n\n Follow this by a single nemesis repair (along with an informational log\n message), wait 10 seconds for recovery, then have each thread perform reads\n until that thread sees at least one OK operation.\n\n (gen/phases (->> (gen/mix [(repeat {:f :read})\n (map (fn [x] {:f :write, :value x}) (range))])\n (gen/stagger 1/10)\n (gen/nemesis (->> (cycle [{:f :break}\n {:f :repair}])\n (gen/stagger 5)))\n (gen/time-limit 30))\n (gen/log \\\"Recovering\\\")\n (gen/nemesis {:f :repair})\n (gen/sleep 10)\n (gen/log \\\"Final read\\\")\n (gen/clients (gen/each-thread (gen/until-ok {:f :read}))))\n\n ## Contexts\n\n A *context* is a map which provides information about the state of the world\n to generators. For instance, a generator might need to know the number of\n threads which will ask it for operations. It can get that number from the\n *context*. Users can add their own values to the context map, which allows\n two generators to share state. When one generator calls another, it can pass\n a modified version of the context, which allows us to write generators that,\n say, run two independent workloads, each with their own concurrency and\n thread mappings.\n\n The standard context mappings, which are provided by Jepsen when invoking the\n top-level generator, and can be expected by every generator, are defined in\n jepsen.generator.context. They include some stock fields:\n\n :time The current Jepsen linear time, in nanoseconds\n\n Additional fields (e.g. :threads, :free-threads, etc) are present for\n bookkeeping, but should not be interfered with or accessed directly: contexts\n are performance-sensitive and for optimization reasons their internal\n structure is somewhat complex. Use the functions `all-threads`,\n `thread->process`, `some-free-process`, etc. See jepsen.generator.context for\n these functions, which are also imported here in jepsen.generator.\n\n ## Fetching an operation\n\n We use `(op gen test context)` to ask the generator for the next invocation\n that we can process.\n\n The operation can have three forms:\n\n - The generator may return `nil`, which means the generator is done, and\n there is nothing more to do. Once a generator does this, it must never\n return anything other than `nil`, even if the context changes.\n - The generator may return :pending, which means there might be more\n ops later, but it can't tell yet.\n - The generator may return an operation, in which case:\n - If its time is in the past, we can evaluate it now\n - If its time is in the future, we wait until either:\n - The time arrives\n - Circumstances change (e.g. we update the generator)\n\n But (op gen test context) returns more than just an operation; it also\n returns the *subsequent state* of the generator, if that operation were to be\n performed. The two are bundled into a tuple.\n\n (op gen test context) => [op gen'] ; known op\n [:pending gen] ; unsure\n nil ; exhausted\n\n The analogous operations for sequences are (first) and (next); why do we\n couple them here? Why not use the update mechanism strictly to evolve state?\n Because the behavior in sequences is relatively simple: next always moves\n forward one item, whereas only *some* updates actually cause systems to move\n forward. Seqs always do the same thing in response to `next`, whereas\n generators may do different things depending on context. Moreover, Jepsen\n generators are often branched, rather than linearly wrapped, as sequences\n are, resulting in questions about *which branch* needs to be updated.\n\n When I tried to strictly separate implementations of (op) and (update), it\n resulted in every update call attempting to determine whether this particular\n generator did or did not emit the given invocation event. This is\n *remarkably* tricky to do well, and winds up relying on all kinds of\n non-local assumptions about the behavior of the generators you wrap, and\n those which wrap you.\n\n ## Updating a generator\n\n We still want the ability to respond to invocations and completions, e.g. by\n tracking that information in context variables. Therefore, in addition to\n (op) returning a new generator, we have a separate function, (update gen test\n context event), which allows generators to react to changing circumstances.\n\n - We invoke an operation (e.g. one that the generator just gave us)\n - We complete an operation\n\n Updates use a context with a specific relationship to the event:\n\n - The context :time is equal to the event :time\n - The free processes set reflects the state after the event has taken place;\n e.g. if the event is an invoke, the thread is listed as no longer free; if\n the event is a completion, the thread is listed as free.\n - The worker map reflects the process which that thread worker was executing\n at the time the event occurred.\n\n See jepsen.generator.context for more.\n\n ## Default implementations\n\n Nil is a valid generator; it ignores updates and always yields nil for\n operations.\n\n IPersistentMaps are generators which ignore updates and return exactly one\n operation which looks like the map itself, but with default values for time,\n process, and type provided based on the context. This means you can write a\n generator like\n\n {:f :write, :value 2}\n\n and it will generate a single op like\n\n {:type :invoke, :process 3, :time 1234, :f :write, :value 2}\n\n To produce an infinite series of ops drawn from the same map, use\n\n (repeat {:f :write, :value 2}).\n\n Sequences are generators which assume the elements of the sequence are\n themselves generators. They ignore updates, and return all operations from\n the first generator in the sequence, then all operations from the second, and\n so on.\n\n Functions are generators which ignore updates and can take either test and\n context as arguments, or no args. Functions should be *mostly* pure, but some\n creative impurity is probably OK. For instance, returning randomized :values\n for maps is probably all right. I don't know the laws! What is this, Haskell?\n\n When a function is used as a generator, its return value is used as a\n generator; that generator is used until exhausted, and then the function is\n called again to produce a new generator. For instance:\n\n ; Produces a series of different random writes, e.g. 1, 5, 2, 3...\n (fn [] {:f :write, :value (rand-int 5)})\n\n ; Alternating write/read ops, e.g. write 2, read, write 5, read, ...\n (fn [] (map gen/once [{:f :write, :value (rand-int 5)}\n {:f :read}]))\n\n Promises and delays are generators which ignore updates, yield :pending until\n realized, then are replaced by whatever generator they contain. Delays are\n not evaluated until they *could* produce an op, so you can include them in\n sequences, phases, etc., and they'll be evaluated only once prior ops have\n been consumed.\"\n (:refer-clojure :exclude [await concat cycle delay filter map repeat run! update])\n (:require [clojure [core :as c]\n [datafy :refer [datafy]]\n [set :as set]]\n [clojure.core.reducers :as r]\n [clojure.tools.logging :refer [info warn error]]\n [clojure.pprint :as pprint :refer [pprint]]\n [dom-top.core :refer [loopr]]\n [fipp.ednize :as fipp.ednize]\n [jepsen [history :as history]]\n [jepsen.generator.context :as context]\n [potemkin :refer [import-vars]]\n [slingshot.slingshot :refer [try+ throw+]])\n (:import (io.lacuna.bifurcan Set)\n (java.lang.reflect Method)\n (java.util ArrayList)))\n\n;; These used to be a part of jepsen.generator directly, and it makes sense for\n;; users to interact with them here. For cleanliness, they actually live in\n;; jepsen.generator.context.\n(import-vars [jepsen.generator.context\n all-processes\n all-threads\n context\n free-processes\n free-threads\n process->thread\n some-free-process\n thread->process])\n\n(defprotocol Generator\n (update [gen test context event]\n \"Updates the generator to reflect an event having taken place.\n Returns a generator (presumably, `gen`, perhaps with some changes)\n resulting from the update.\")\n\n (op [gen test context]\n \"Obtains the next operation from this generator. Returns an pair\n of [op gen'], or [:pending gen], or nil if this generator is exhausted.\"))\n\n;; Pretty-printing\n\n(defmethod pprint/simple-dispatch jepsen.generator.Generator\n [gen]\n (if (map? gen)\n (do (.write ^java.io.Writer *out* (str (.getName (class gen)) \"{\"))\n (pprint/pprint-newline :mandatory)\n (let [prefix \" \"\n suffix \"}\"]\n (pprint/pprint-logical-block :prefix prefix :suffix suffix\n (pprint/print-length-loop [aseq (seq gen)]\n (when aseq\n (pprint/pprint-logical-block\n (pprint/write-out (key (first aseq)))\n (.write ^java.io.Writer *out* \" \")\n (pprint/pprint-newline :miser)\n (pprint/write-out (fnext (first aseq))))\n (when (next aseq)\n (.write ^java.io.Writer *out* \", \")\n (pprint/pprint-newline :linear)\n (recur (next aseq))))))))\n\n ; Probably a reify or something weird we can't print\n (prn gen)))\n\n(prefer-method pprint/simple-dispatch\n jepsen.generator.Generator clojure.lang.IRecord)\n(prefer-method pprint/simple-dispatch\n jepsen.generator.Generator clojure.lang.IPersistentMap)\n\n(extend-protocol fipp.ednize/IOverride (:on-interface Generator))\n(extend-protocol fipp.ednize/IEdn (:on-interface Generator)\n (-edn [gen]\n (if (record? gen)\n ; Ugh this is such a hack but Fipp's extension points are sort of a\n ; mess--you can't override the document generation behavior on a\n ; per-class basis. Probably sensible for perf reasons, but makes our life\n ; hard.\n ;\n ; Convert records (which respond to map?) into maps.\n (list (symbol (.getName (class gen)))\n (into {} gen))\n ; We can't return a reify without entering an infinite loop (ugh) so uhhh\n (tagged-literal 'unprintable (str gen))\n )))\n\n;; Fair sets\n;\n; Our contexts need a set of free threads which supports an efficient way of\n; getting a single thread. An easy solution is to use `first` to get the first\n; element of the set, but if a thread executes quickly, it's possible that the\n; thread will go right *back* into the set at the first position immediately,\n; which can lead to thread starvation: some workers never execute requests. We\n; want a more fair scheduler, which gives each thread a uniform chance of\n; executing.\n;\n; To do this, we use a Set from ztellman's Bifurcan collections, which supports\n; efficient nth.\n\n;; Helpers\n\n(defn secs->nanos\n \"Converts seconds to long nanoseconds. We do our internal timekeeping in\n nanos.\"\n (^long [s]\n (long (* s 1000000000))))\n\n(defn arities\n \"The arities of a function class.\"\n [^Class c]\n (keep (fn [^Method method]\n (when (re-find #\"invoke\" (.getName method))\n (alength (.getParameterTypes method))))\n (-> c .getDeclaredMethods)))\n\n(defn rand-int-seq\n \"Generates a reproducible sequence of random longs, given a random seed. If\n seed is not provided, taken from (rand-int)).\"\n ([] (rand-int-seq (rand-int Integer/MAX_VALUE)))\n ([seed]\n (let [gen (java.util.Random. seed)]\n (repeatedly #(.nextLong gen)))))\n\n(defn rand-seq\n \"Generates a reproducible sequence of random doubles, given a random seed. If\n seed is not provided, taken from (rand-int)\"\n ([] (rand-seq (rand-int Integer/MAX_VALUE)))\n ([seed]\n (let [gen (java.util.Random. seed)]\n (repeatedly #(.nextDouble gen)))))\n\n(defn dissoc-vec\n \"Cut a single index out of a vector, returning a vector one shorter, without\n the element at that index.\"\n [v i]\n (into (subvec v 0 i)\n (subvec v (inc i))))\n\n(defn assoc-or-dissoc-vec\n \"Like (assoc v i x), but if `x` is nil, deletes that index from the vector\n instead. Returns `nil` if the resulting vector would be empty. This is\n particularly helpful for generators that have to track a vector of\n sub-generators.\"\n [v i x]\n (if (nil? x)\n ; Dissoc\n (let [v' (dissoc-vec v i)]\n (when (< 0 (count v'))\n v'))\n ; Assoc\n (assoc v i x)))\n\n(defn update-all-\n \"Takes a vector of generators and updates them all with the given test,\n context, and event. Returns the resulting vector, removing generators that\n return `nil`. Returns `nil` if the vector would be empty.\"\n [gens test ctx event]\n (let [gens' (persistent!\n (reduce (fn [gens' gen]\n (if-let [gen' (update gen test ctx event)]\n (conj! gens' gen')\n gens'))\n (transient [])\n gens))]\n (when (seq gens')\n gens')))\n\n;; Generators!\n\n(defn tracking-get!\n \"Takes an ArrayList, a map, a key, and a not-found value. Reads key from\n map, returning it or not-found. Adds the key to the list if it was in the\n map. Yourkit led me down this path.\"\n [^ArrayList read-keys m k not-found]\n (let [v (get m k ::not-found)]\n (if (identical? v ::not-found)\n not-found\n (do (.add read-keys k)\n v))))\n\n(defn fill-in-op\n \"Takes an operation as a map and fills in missing fields for :type, :process,\n and :time using context. Returns :pending if no process is free. Turns maps\n into history Ops.\"\n [op ctx]\n ; This will be both inefficient and wrong for Ops, but users shouldn't\n ; actually be passing those to us here.\n (assert (not (instance? jepsen.history.Op op)))\n (if-let [p (some-free-process ctx)]\n ; Automatically assign type, time, and process from the context, if not\n ; provided.\n (let [; We want to avoid using dissoc if we can POSSIBLY avoid it, so we\n ; keep track of the fields we've read from the op.\n read-keys (ArrayList. 5)\n time (tracking-get! read-keys op :time (:time ctx))\n type (tracking-get! read-keys op :type :invoke)\n process (tracking-get! read-keys op :process p)\n f (tracking-get! read-keys op :f nil)\n value (tracking-get! read-keys op :value nil)\n read-count (.size read-keys)\n ; Any other fields?\n ext (if (< read-count (count op))\n ; There's fields in the map we didn't read. Pull out the\n ; keys we DID read\n (loop [i 0, ext op]\n (if (= read-count i)\n ext\n (recur (inc i) (dissoc ext (.get read-keys i)))))\n nil)]\n (jepsen.history.Op. -1 ; Index\n time\n type\n process\n f\n value\n nil ; meta\n ext))\n :pending))\n\n(defrecord Fn\n [; We memoize the function's arity so we don't have to reflect\n ^long arity\n ; The function itself\n f]\n Generator\n (update [this test ctx event] this)\n\n ; When asked for an op, we invoke f to produce a generator, then exhaust that\n ; before coming back to ourselves.\n (op [this test ctx]\n (when-let [gen (if (= arity 2)\n (f test ctx)\n (f))]\n (op [gen this] test ctx))))\n\n(defn fn-wrapper\n \"Wraps a function into a wrapper which makes it more efficient to invoke. We\n memoize the function's arity, in particular, to reduce reflection.\"\n [f]\n (Fn. (first (arities (class f))) f))\n\n(extend-protocol Generator\n nil\n (update [gen test ctx event] nil)\n (op [this test ctx] nil)\n\n clojure.lang.APersistentMap\n (update [this test ctx event] this)\n (op [this test ctx]\n (let [op (fill-in-op this ctx)]\n [op (if (= :pending op) this nil)]))\n\n clojure.lang.AFunction\n (update [f test ctx event]\n (update (fn-wrapper f) test ctx event))\n\n (op [f test ctx]\n (op (fn-wrapper f) test ctx))\n\n clojure.lang.Delay\n (update [d test ctx event] d)\n\n (op [d test ctx]\n (op @d test ctx))\n\n clojure.lang.Seqable\n (update [this test ctx event]\n (when (seq this)\n ; Updates are passed to the first generator in the sequence.\n (cons (update (first this) test ctx event) (next this))))\n\n (op [this test ctx]\n ;(binding [*print-length* 3] (prn :op this))\n (when (seq this) ; Once we're out of generators, we're done\n (let [gen (first this)]\n (if-let [[op gen'] (op gen test ctx)]\n ; OK, our first gen has an op for us. If there's something following\n ; us, we generate a cons cell as our resulting generator; otherwise,\n ; just whatever this first element's next gen state is.\n [op (if-let [nxt (next this)]\n (cons gen' (next this))\n gen')]\n\n ; This generator is exhausted; move on\n (recur (next this) test ctx))))))\n\n(defmacro extend-protocol-runtime\n \"Extends a protocol to a runtime-defined class. Helpful because some Clojure\n constructs, like promises, use reify rather than classes, and have no\n distinct interface we can extend.\"\n [proto klass & specs]\n (let [cn (symbol (.getName ^Class (eval klass)))]\n `(extend-protocol ~proto ~cn ~@specs)))\n\n(defonce initialized?\n (atom false))\n\n(defn init!\n \"We do some magic to extend the Generator protocol over promises etc, but\n it's fragile and could break with... I think AOT compilation, but also\n apparently plain old dependencies? I'm not certain. It's weird. Just to be\n safe, we move this into a function that gets called by\n jepsen.generator.interpreter, so that we observe the *real* version of the\n promise reify auto-generated class.\"\n []\n (when (compare-and-set! initialized? false true)\n (eval\n `(extend-protocol-runtime Generator\n (class (promise))\n (update [p# test# ctx# event#] p#)\n\n (op [p# test# ctx#]\n (if (realized? p#)\n (op @p# test# ctx#)\n [:pending p#]))))))\n\n(defrecord Validate [gen]\n Generator\n (op [_ test ctx]\n (when-let [res (op gen test ctx)]\n (let [problems\n (if-not (and (vector? res) (= 2 (count res)))\n [(str \"should return a vector of two elements.\")]\n (let [[op gen'] res]\n (if (= :pending op)\n []\n (cond-> []\n (not (history/op? op))\n (conj \"should be either :pending or a jepsen.history.Op\")\n\n (not (#{:invoke :info :sleep :log} (:type op)))\n (conj \":type should be :invoke, :info, :sleep, or :log\")\n\n (not (number? (:time op)))\n (conj \":time should be a number\")\n\n (not (:process op))\n (conj \"no :process\")\n\n (not (->> op :process\n (context/process->thread ctx)\n (context/thread-free? ctx)))\n (conj (str \"process \" (pr-str (:process op))\n \" is not free\"))))))]\n (when (seq problems)\n (throw+ {:type ::invalid-op\n :context (datafy ctx)\n :res res\n :problems problems}\n nil\n (with-out-str\n (println \"Generator produced an invalid [op, gen'] tuple when asked for an operation:\\n\")\n (binding [*print-length* 10]\n (pprint res))\n (println \"\\nSpecifically, this is a problem because:\\n\")\n (doseq [p problems]\n (println \" -\" p))\n (println \"\\nGenerator:\\n\")\n (binding [*print-length* 10]\n (pprint gen))\n (println \"\\nContext:\\n\")\n (pprint ctx)))))\n [(first res) (Validate. (second res))]))\n\n (update [this test ctx event]\n (Validate. (update gen test ctx event))))\n\n(defn validate\n \"Validates the well-formedness of operations emitted from the underlying\n generator.\"\n [gen]\n (when gen\n (Validate. gen)))\n\n(defrecord FriendlyExceptions [gen]\n Generator\n (op [this test ctx]\n (try\n (when-let [[op gen'] (op gen test ctx)]\n [op (FriendlyExceptions. gen')])\n (catch Throwable t\n (throw+ {:type ::op-threw\n :context (datafy ctx)}\n t\n (with-out-str\n (print \"Generator threw\" (class t) \"-\" (.getMessage t) \"when asked for an operation. Generator:\\n\")\n (binding [*print-length* 10]\n (pprint gen))\n (println \"\\nContext:\\n\")\n (pprint (datafy ctx)))))))\n\n (update [this test ctx event]\n (try\n (when-let [gen' (update gen test ctx event)]\n (FriendlyExceptions. gen'))\n (catch Throwable t\n (throw+ {:type ::update-threw\n :context (datafy ctx)\n :event event}\n t\n (with-out-str\n (print \"Generator threw \" t \" when updated with an event. Generator:\\n\")\n (binding [*print-length* 10]\n (pprint gen))\n (println \"\\nContext:\\n\")\n (pprint (datafy ctx))\n (println \"Event:\\n\")\n (pprint event)))))))\n\n(defn friendly-exceptions\n \"Wraps a generator, so that exceptions thrown from op and update are wrapped\n with a :type ::op-threw or ::update-threw Slingshot exception map, including\n the generator, context, and event which caused the exception.\"\n [gen]\n (when gen\n (FriendlyExceptions. gen)))\n\n(defrecord Trace [k gen]\n Generator\n (op [_ test ctx]\n (binding [*print-length* 8]\n (try (let [[op gen'] (op gen test ctx)]\n (info k :op (with-out-str\n (println \"\\nContext:\" ctx)\n (println \"Operation:\" op)\n (println \"Generator:\")\n (pprint gen)))\n (when op\n [op (when gen' (Trace. k gen'))]))\n (catch Throwable t\n (info k :op :threw\n (with-out-str\n (println \"\\nContext:\" ctx)\n (println \"Operation:\" op)\n (println \"Generator:\")\n (pprint gen)))\n (throw t)))))\n\n (update [_ test ctx event]\n (binding [*print-length* 8]\n (try (let [gen' (update gen test ctx event)]\n (info k :update (with-out-str\n (println \"\\nContext:\" ctx)\n (println \"Event:\" event)\n (println \"Generator:\")\n (pprint gen)))\n (when gen' (Trace. k gen')))\n (catch Throwable t\n (info k :update :threw (with-out-str\n (println \"\\nContext:\" ctx)\n (println \"Event:\" event)\n (println \"Generator:\")\n (pprint gen)))\n (throw t))))))\n\n(defn trace\n \"Wraps a generator, logging calls to op and update before passing them on to\n the underlying generator. Takes a key k, which is included in every log\n line.\"\n [k gen]\n (when gen\n (Trace. k gen)))\n\n(defn concat\n \"Where your generators are sequences, you can use Clojure's `concat` to make\n them a generator. This `concat` is useful when you're trying to concatenate\n arbitrary generators. Right now, (concat a b c) is simply '(a b c).\"\n [& gens]\n (seq (remove nil? gens)))\n\n(defrecord Map [f ^long arity gen]\n Generator\n (op [_ test ctx]\n (when-let [[op gen'] (op gen test ctx)]\n [(if (= :pending op)\n op\n ; Transform op\n (case arity\n 1 (f op)\n 3 (f op test ctx)))\n (Map. f arity gen')]))\n\n (update [_ test ctx event]\n (Map. f arity (update gen test ctx event))))\n\n(defn map\n \"A generator which wraps another generator g, transforming operations it\n generates with (f op). When the underlying generator yields :pending or nil,\n this generator does too, without calling `f`. Passes updates to underlying\n generator.\n\n f may optionally take additional arguments: `(f op test context)`.\"\n [f gen]\n (let [arity (reduce max 0 (arities (class f)))]\n (assert (or (= 1 arity) (= 3 arity))\n \"`map` requires a function of one or three arguments\")\n (when gen\n (Map. f arity gen))))\n\n(defn f-map\n \"Takes a function `f-map` converting op functions (:f op) to other functions,\n and a generator `g`. Returns a generator like `g`, but where fs are replaced\n according to `f-map`. Useful for composing generators together for use with a\n composed nemesis.\"\n [f-map g]\n (map (fn transform [op] (c/update op :f f-map)) g))\n\n(defrecord Filter [f gen]\n Generator\n (op [_ test ctx]\n (loop [gen gen]\n (when-let [[op gen'] (op gen test ctx)]\n (if (or (= :pending op) (f op))\n ; We can let this through\n [op (Filter. f gen')]\n ; Next op!\n (recur gen')))))\n\n (update [_ test ctx event]\n (Filter. f (update gen test ctx event))))\n\n(defn filter\n \"A generator which filters operations from an underlying generator, passing\n on only those which match (f op). Like `map`, :pending and nil operations\n bypass the filter.\"\n [f gen]\n (when gen\n (Filter. f gen)))\n\n(defrecord IgnoreUpdates [gen]\n Generator\n (op [this test ctx]\n (op gen test ctx))\n\n (update [this _ _ _]\n this))\n\n(defrecord OnUpdate [f gen]\n Generator\n (op [this test ctx]\n (when-let [[op gen'] (op gen test ctx)]\n [op (OnUpdate. f gen')]))\n\n (update [this test ctx event]\n (f this test ctx event)))\n\n(defn on-update\n \"Wraps a generator with an update handler function. When an update occurs,\n calls (f this test ctx event), and returns whatever f does--presumably, a new\n generator. Can also be helpful for side effects--for instance, to update some\n shared mutable state when an update occurs.\"\n [f gen]\n (OnUpdate. f gen))\n\n(defn on-threads-context\n \"For backwards compatibility; filters a context to just threads matching (f\n thread). Use context/make-thread-filter for performance.\"\n [f context]\n ((context/make-thread-filter f context) context))\n\n(defrecord OnThreads [f context-filter gen]\n Generator\n (op [this test ctx]\n (when-let [[op gen'] (op gen test (context-filter ctx))]\n [op (OnThreads. f context-filter gen')]))\n\n (update [this test ctx event]\n (if (f (process->thread ctx (:process event)))\n (OnThreads. f context-filter (update gen test (context-filter ctx) event))\n this)))\n\n(defn on-threads\n \"Wraps a generator, restricting threads which can use it to only those\n threads which satisfy (f thread). Alters the context passed to the underlying\n generator: it will only include free threads and workers satisfying f.\n Updates are passed on only when the thread performing the update matches f.\"\n [f gen]\n (when gen\n (OnThreads. f (context/make-thread-filter f) gen)))\n\n(def on \"For backwards compatibility\" on-threads)\n\n(defn soonest-op-map\n \"Takes a pair of maps wrapping operations. Each map has the following\n structure:\n\n :op An operation\n :weight An optional integer weighting.\n\n Returns whichever map has an operation which occurs sooner. If one map is\n nil, the other happens sooner. If one map's op is :pending, the other happens\n sooner. If one op has a lower :time, it happens sooner. If the two ops have\n equal :times, resolves the tie randomly proportional to the two maps'\n respective :weights. With weights 2 and 3, returns the first map 2/5 of the\n time, and the second 3/5 of the time.\n\n The :weight of the returned map is the *sum* of both weights if their times\n are equal, which makes this function suitable for use in a reduction over\n many generators.\n\n Why is this nondeterministic? Because we use this function to decide between\n several alternative generators, and always biasing towards an earlier or\n later generator could lead to starving some threads or generators.\"\n ([] nil)\n ([m] m)\n ([m1 m2]\n (condp identical? nil\n m1 m2\n m2 m1\n (let [op1 (:op m1)\n op2 (:op m2)]\n (condp identical? :pending\n op1 m2\n op2 m1\n (let [t1 (:time op1)\n t2 (:time op2)]\n (if (= t1 t2)\n ; We have a tie; decide based on weights.\n (let [w1 (:weight m1 1)\n w2 (:weight m2 1)\n w (+ w1 w2)]\n (assoc (if (< (rand-int w) w1) m1 m2)\n :weight w))\n ; Not equal times; which comes sooner?\n (if (< t1 t2)\n m1\n m2))))))))\n\n(defrecord Any [gens]\n Generator\n (op [this test ctx]\n (when-let [{:keys [op gen' i]}\n (->> gens\n (map-indexed\n (fn [i gen]\n (when-let [[op gen'] (op gen test ctx)]\n {:op op\n :gen' gen'\n :i i})))\n (reduce soonest-op-map nil))]\n [op (Any. (assoc gens i gen'))]))\n\n (update [this test ctx event]\n (when-let [gens' (update-all- gens test ctx event)]\n (Any. gens'))))\n\n(defn any\n \"Takes multiple generators and binds them together. Operations are taken from\n any generator. Updates are propagated to all generators.\"\n [& gens]\n (let [gens (vec (remove nil? gens))]\n (case (count gens)\n 0 nil\n 1 (first gens)\n (Any. (vec gens)))))\n\n(defrecord ShortestAny [gens]\n Generator\n (op [this test ctx]\n (let [; Ask each generator for an op\n candidates (->> gens\n (map-indexed\n (fn [i gen]\n (when-let [[op gen'] (op gen test ctx)]\n {:i i\n :op op\n :gen' gen'}))))]\n (when (not-any? nil? candidates)\n ; Everyone has an operation for us. Pick the soonest.\n (let [{:keys [i op gen']} (reduce soonest-op-map nil candidates)]\n ; If this generator is exhausted, we can terminate immediately.\n [op (when gen' (ShortestAny. (assoc gens i gen')))]))))\n\n (update [this test ctx event]\n (when-let [gens' (update-all- gens test ctx event)]\n (when (= (count gens') (count gens))\n ; All generators are still here, we can keep going\n (ShortestAny. gens')))))\n\n(defn shortest-any\n \"Like `any`, binds multiple generators into a single one. Operations are\n taken from any generator, updates are propagated to all generators. As soon\n as any generator is exhausted, this generator is too.\n\n This is particularly helpful when you have a workload generator you'd like to\n run while doing some sequence of nemesis operations, and stop as soon as the\n nemesis is done.\"\n [& gens]\n (case (count gens)\n 0 nil\n 1 (first gens)\n (ShortestAny. (vec gens))))\n\n(defn each-thread-ensure-context-filters!\n \"Ensures an EachThread has context filters for each thread.\"\n [context-filters ctx]\n (when-not (realized? context-filters)\n (deliver context-filters\n (reduce (fn compute-context-filters [cfs thread]\n (assoc cfs thread (context/make-thread-filter\n #{thread}\n ctx)))\n {}\n (context/all-threads ctx)))))\n\n(defrecord EachThread [fresh-gen context-filters gens]\n ; fresh-gen is a generator we use to initialize a thread's state, the first\n ; time we see it.\n ; context-filters is a promise of a map of threads to context filters; lazily\n ; initialized.\n ; gens is a map of threads to generators.\n Generator\n (op [this test ctx]\n (each-thread-ensure-context-filters! context-filters ctx)\n (let [{:keys [op gen' thread] :as soonest}\n (->> (context/free-threads ctx)\n (keep (fn [thread]\n (let [gen (get gens thread fresh-gen)\n ; Give this generator a context *just* for one\n ; thread\n ctx ((@context-filters thread) ctx)]\n (when-let [[op gen'] (op gen test ctx)]\n {:op op\n :gen' gen'\n :thread thread}))))\n (reduce soonest-op-map nil))]\n (cond ; A free thread has an operation\n soonest [op (EachThread. fresh-gen context-filters\n (assoc gens thread gen'))]\n\n ; Some thread is busy; we can't tell what to do just yet\n (not= (context/free-thread-count ctx)\n (context/all-thread-count ctx))\n [:pending this]\n\n ; Every thread is exhausted\n true\n nil)))\n\n (update [this test ctx event]\n (each-thread-ensure-context-filters! context-filters ctx)\n (let [process (:process event)\n thread (process->thread ctx process)\n gen (get gens thread fresh-gen)\n ctx ((@context-filters thread) ctx)\n gen' (update gen test ctx event)]\n (EachThread. fresh-gen context-filters (assoc gens thread gen')))))\n\n(defn each-thread\n \"Takes a generator. Constructs a generator which maintains independent copies\n of that generator for every thread. Each generator sees exactly one thread in\n its free process list. Updates are propagated to the generator for the thread\n which emitted the operation.\"\n [gen]\n (when gen\n (EachThread. gen (promise) {})))\n\n(defrecord EachProcess\n [; A fresh copy of the generator we start with for each process\n fresh-gen\n ; A promise of a map of threads to the context filters for those particular\n ; threads, lazily initialized.\n context-filters\n ; A map of thread -> process for processes that are currently initialized\n ; and running\n extant\n ; A map of threads to generators\n gens]\n\n Generator\n (op [this test ctx]\n (each-thread-ensure-context-filters! context-filters ctx)\n (let [{:keys [op gen' extant' thread] :as soonest}\n (->> (context/free-threads ctx)\n (keep (fn [thread]\n (let [extant-process (get extant thread ::not-found)\n new-process (context/thread->process ctx thread)\n ; Is this a process we haven't initialized yet?\n new? (not= extant-process new-process)\n ; Maybe inefficient--we might discard most of these\n extant' (if new?\n (assoc extant thread new-process)\n extant)\n gen (if new?\n fresh-gen\n (get gens thread))\n ; Give this generator a context *just* for one\n ; thread\n ctx ((@context-filters thread) ctx)]\n ; Generate an op\n (when-let [[op gen'] (op gen test ctx)]\n {:op op\n :gen' gen'\n :thread thread\n :extant' extant'}))))\n (reduce soonest-op-map nil))]\n (cond ; A free thread has an operation\n soonest [op (EachProcess. fresh-gen context-filters extant'\n (assoc gens thread gen'))]\n\n ; Some thread is busy; we can't tell what to do just yet\n (not= (context/free-thread-count ctx)\n (context/all-thread-count ctx))\n [:pending this]\n\n ; Every thread is exhausted\n true\n nil)))\n\n (update [this test ctx event]\n (each-thread-ensure-context-filters! context-filters ctx)\n (let [process (:process event)\n thread (context/process->thread ctx process)\n gen (get gens thread fresh-gen)\n ctx ((@context-filters thread) ctx)\n gen' (update gen test ctx event)]\n (EachProcess. fresh-gen context-filters extant\n (assoc gens thread gen')))))\n\n(defn each-process\n \"Takes a generator. Constructs a generator which maintains independent copies\n of that generator for every process. Each generator sees exactly one thread &\n process in its free process list. Updates are propagated to the generator for\n the thread which emitted the operation.\"\n [gen]\n (when gen\n (EachProcess. gen (promise) {} {})))\n\n(defrecord Reserve [ranges all-ranges context-filters gens]\n ; ranges is a collection of sets of threads engaged in each generator.\n ; all-ranges is the union of all ranges.\n ; context-filters is a vector of context filtering functions, one for each\n ; range (and the default gen last).\n ; gens is a vector of generators corresponding to ranges, followed by the\n ; default generator.\n Generator\n (op [_ test ctx]\n (let [; A transducer to compute op/gen'/weight/i maps for each of `ranges`\n xf (map-indexed\n (fn per-range [i threads]\n (let [gen (nth gens i)\n ; Restrict context to this range of threads\n ctx ((nth context-filters i) ctx)]\n ; Ask this range's generator for an op\n (when-let [[op gen'] (op gen test ctx)]\n ; Remember our index\n {:op op\n :gen' gen'\n :weight (count threads)\n :i i}))))\n ; And for the default generator...\n default-op-map\n (let [ctx ((peek context-filters) ctx)]\n ; And construct a triple for the default generator\n (when-let [[op gen'] (op (peek gens) test ctx)]\n (assert ctx)\n {:op op\n :gen' gen'\n :weight (context/all-thread-count ctx)\n :i (count ranges)}))\n ; Find soonest generator\n {:keys [op gen' i] :as soonest}\n (transduce xf soonest-op-map default-op-map ranges)]\n (when soonest\n ; A range has an operation to do!\n [op (Reserve. ranges all-ranges context-filters (assoc gens i gen'))])))\n\n (update [this test ctx event]\n (let [process (:process event)\n thread (process->thread ctx process)\n ; Find generator whose thread produced this event.\n i (reduce (fn red [i range-]\n (if (range- thread)\n (reduced i)\n (inc i)))\n 0\n ranges)]\n (Reserve. ranges all-ranges context-filters\n (c/update gens i update test ctx event)))))\n\n(defn reserve\n \"Takes a series of count, generator pairs, and a final default generator.\n\n (reserve 5 write 10 cas read)\n\n The first 5 threads will call the `write` generator, the next 10 will emit\n CAS operations, and the remaining threads will perform reads. This is\n particularly useful when you want to ensure that two classes of operations\n have a chance to proceed concurrently--for instance, if writes begin\n blocking, you might like reads to proceed concurrently without every thread\n getting tied up in a write.\n\n Each generator sees a context which only includes the worker threads which\n will execute that particular generator. Updates from a thread are propagated\n only to the generator which that thread executes.\"\n [& args]\n (let [gens (->> args\n drop-last\n (partition 2)\n ; Construct [thread-set gen] tuples defining the range of\n ; thread indices covering a given generator, lower\n ; inclusive, upper exclusive. TODO: I think there might be a\n ; bug here: if we construct nested reserves or otherwise\n ; restrict threads, an inner reserve might not understand\n ; that its threads don't start at 0.\n (reduce (fn [[n gens] [thread-count gen]]\n (let [n' (+ n thread-count)]\n [n' (conj gens [(set (range n n')) gen])]))\n [0 []])\n second)\n ranges (mapv first gens)\n all-ranges (reduce set/union ranges)\n ; Compute context filters for all ranges\n context-filters (mapv context/make-thread-filter\n (c/concat ranges\n [(complement all-ranges)]))\n gens (mapv second gens)\n default (last args)\n gens (conj gens default)]\n (assert default)\n (Reserve. ranges all-ranges context-filters gens)))\n\n(declare nemesis)\n\n(defn clients\n \"In the single-arity form, wraps a generator such that only clients\n request operations from it. In its two-arity form, combines a generator of\n client operations and a generator for nemesis operations into one. When the\n process requesting an operation is :nemesis, routes to the nemesis generator;\n otherwise to the client generator.\"\n ([client-gen]\n (on (context/all-but :nemesis) client-gen))\n ([client-gen nemesis-gen]\n (any (clients client-gen)\n (nemesis nemesis-gen))))\n\n(defn nemesis\n \"In the single-arity form, wraps a generator such that only the nemesis\n requests operations from it. In its two-arity form, combines a generator of\n client operations and a generator for nemesis operations into one. When the\n process requesting an operation is :nemesis, routes to the nemesis generator;\n otherwise to the client generator.\"\n ([nemesis-gen]\n (on #{:nemesis} nemesis-gen))\n ([nemesis-gen client-gen]\n (any (nemesis nemesis-gen)\n (clients client-gen))))\n\n(defrecord Mix [i gens]\n ; i is the next generator index we intend to work with; we reset it randomly\n ; when emitting ops.\n Generator\n (op [_ test ctx]\n (when-not (= 0 (count gens))\n (if-let [[op gen'] (op (nth gens i) test ctx)]\n ; Good, we have an op\n [op (Mix. (rand-int (count gens)) (assoc gens i gen'))]\n ; Oh, we're out of ops on this generator. Compact and recur.\n (op (Mix. (rand-int (dec (count gens))) (dissoc-vec gens i))\n test ctx))))\n\n (update [this test ctx event]\n this))\n\n(defn mix\n \"A random mixture of several generators. Takes a collection of generators and\n chooses between them uniformly. Ignores updates; some users create broad\n (hundreds of generators) mixes.\n\n To be precise, a mix behaves like a sequence of one-time, randomly selected\n generators from the given collection. This is efficient and prevents multiple\n generators from competing for the next slot, making it hard to control the\n mixture of operations.\n\n TODO: This can interact badly with generators that return :pending; gen/mix\n won't let other generators (which could help us get unstuck!) advance. We\n should probably cycle on :pending.\"\n [gens]\n (let [gens (vec (remove nil? gens))]\n (when (seq gens)\n (Mix. (rand-int (count gens)) gens))))\n\n(defrecord Limit [remaining gen]\n Generator\n (op [_ test ctx]\n (when (pos? remaining)\n (when-let [[op gen'] (op gen test ctx)]\n [op (Limit. (dec remaining) gen')])))\n\n (update [this test ctx event]\n (Limit. remaining (update gen test ctx event))))\n\n(defn limit\n \"Wraps a generator and ensures that it returns at most `limit` operations.\n Propagates every update to the underlying generator.\"\n [remaining gen]\n (when gen\n (Limit. remaining gen)))\n\n(defn once\n \"Emits only a single item from the underlying generator.\"\n [gen]\n (limit 1 gen))\n\n(defn log\n \"A generator which, when asked for an operation, logs a message and yields\n nil. Occurs only once; use `repeat` to repeat.\"\n [msg]\n {:type :log, :value msg})\n\n(defrecord Repeat [^long remaining gen]\n ; Remaining is positive for a limit, or -1 for infinite repeats.\n Generator\n (op [_ test ctx]\n (when-not (= 0 remaining)\n (when-let [[op gen'] (op gen test ctx)]\n [op (Repeat. (max -1 (dec remaining)) gen)])))\n\n (update [this test ctx event]\n (Repeat. remaining (update gen test ctx event))))\n\n(defn repeat\n \"Wraps a generator so that it emits operations infinitely, or, with an\n initial limit, up to `limit` times. Think of this as the inverse of `once`:\n where `once` takes a generator that emits many things and makes it emit one,\n this takes a generator that emits (presumably) one thing, and makes it emit\n many.\n\n The state of the underlying generator is unchanged as `repeat` yields\n operations, but `repeat` does *not* memoize its results; repeating a\n nondeterministic generator results in a sequence of *different* operations.\"\n ([gen]\n (when gen\n (Repeat. -1 gen)))\n ([limit gen]\n (assert (not (neg? limit)))\n (when gen\n (Repeat. limit gen))))\n\n(defrecord Cycle [remaining original-gen gen]\n Generator\n (op [_ test ctx]\n (when-not (zero? remaining)\n (if-let [[op gen'] (op gen test ctx)]\n ; We've got operations still. Emit them and let the generator evolve.\n [op (Cycle. remaining original-gen gen')]\n ; Out of operations. Recycle! If you actually hit MIN_INT doing this...\n ; you probably have bigger problems on your hands.\n (op (Cycle. (dec remaining) original-gen original-gen)\n test\n ctx))))\n\n (update [this test ctx event]\n (Cycle. remaining original-gen (update gen test ctx event))))\n\n(defn cycle\n \"Wraps a finite generator so that once it completes (e.g. emits nil), it\n begins again. With an optional integer limit, repeats the generator that many\n times. When the generator returns nil, it is reset to its original value and\n the cycle repeats. Updates are propagated to the current generator, but do\n not affect the original. Not sure if this is the right call--might change\n that later.\"\n ([gen]\n (when gen\n (Cycle. -1 gen gen)))\n ([limit gen]\n (when (and gen (pos? limit))\n (Cycle. limit gen gen))))\n\n(defrecord ProcessLimit [n procs gen]\n Generator\n (op [_ test ctx]\n (when-let [[op gen'] (op gen test ctx)]\n (if (= :pending op)\n [op (ProcessLimit. n procs gen')]\n (let [procs' (into procs (all-processes ctx))]\n (when (<= (count procs') n)\n [op (ProcessLimit. n procs' gen')])))))\n\n (update [_ test ctx event]\n (ProcessLimit. n procs (update gen test ctx event))))\n\n(defn process-limit\n \"Takes a generator and returns a generator with bounded concurrency--it emits\n operations for up to n distinct processes, but no more.\n\n Specifically, we track the set of all processes in a context's `workers` map:\n the underlying generator can return operations only from contexts such that\n the union of all processes across all such contexts has cardinality at most\n `n`. Tracking the union of all *possible* processes, rather than just those\n processes actually performing operations, prevents the generator from\n \\\"trickling\\\" at the end of a test, i.e. letting only one or two processes\n continue to perform ops, rather than the full concurrency of the test.\"\n [n gen]\n (when (and (pos? n) gen)\n (ProcessLimit. n #{} gen)))\n\n(defrecord ConcurrencyLimit [n gen]\n Generator\n (op [this test ctx]\n (if (< (- (context/all-thread-count ctx)\n (context/free-thread-count ctx))\n n)\n (when-let [[op gen'] (op gen test ctx)]\n [op (ConcurrencyLimit. n gen')])\n [:pending this]))\n\n (update [this test ctx event]\n (ConcurrencyLimit. n (update gen test ctx event))))\n\n(defn concurrency-limit\n \"Limits the number of concurrent operations performed by a generator to at\n most n. This generator returns :pending whenever there are n or more threads\n busy.\"\n [n gen]\n (when (and gen (pos? n))\n (ConcurrencyLimit. n gen)))\n\n(defrecord TimeLimit [limit cutoff gen]\n Generator\n (op [_ test ctx]\n (let [[op gen'] (op gen test ctx)]\n (case op\n ; We're exhausted\n nil nil\n ; We're pending!\n :pending [:pending (TimeLimit. limit cutoff gen')]\n ; We have an op; lazily initialize our cutoff and check to see if it's\n ; past.\n (let [cutoff (or cutoff (+ (:time op) limit))]\n (when-not (:time op) (warn \"No time for op:\" op))\n (when (< (:time op) cutoff)\n [op (TimeLimit. limit cutoff gen')])))))\n\n (update [this test ctx event]\n (TimeLimit. limit cutoff (update gen test ctx event))))\n\n(defn time-limit\n \"Takes a time in seconds, and an underlying generator. Once this emits an\n operation (taken from that underlying generator), will only emit operations\n for dt seconds.\"\n [dt gen]\n (when (and gen (pos? dt))\n (TimeLimit. (secs->nanos dt) nil gen)))\n\n(defrecord Stagger [dt next-time gen]\n Generator\n (op [this test ctx]\n (when-let [[op gen'] (op gen test ctx)]\n (let [now (:time ctx)\n next-time (or next-time now)]\n (cond ; No need to do anything to pending ops\n (= :pending op)\n [op this]\n\n ; We're ready to issue this operation.\n (<= next-time (:time op))\n [op (Stagger. dt (+ (:time op) (long (rand dt))) gen')]\n\n ; Not ready yet\n true\n [(assoc op :time next-time)\n (Stagger. dt (+ next-time (long (rand dt))) gen')]))))\n\n (update [_ test ctx event]\n (Stagger. dt next-time (update gen test ctx event))))\n\n(defn stagger\n \"Wraps a generator. Operations from that generator are scheduled at uniformly\n random intervals between 0 to 2 * (dt seconds).\n\n Unlike Jepsen's original version of `stagger`, this actually *means*\n 'schedule at roughly every dt seconds', rather than 'introduce roughly dt\n seconds of latency between ops', which makes this less sensitive to request\n latency variations.\n\n Also note that unlike Jepsen's original version of `stagger`, this delay\n applies to *all* operations, not to each thread independently. If your old\n stagger dt is 10, and your concurrency is 5, your new stagger dt should be\n 2.\"\n [dt gen]\n (when gen\n (let [dt (secs->nanos (* 2 dt))]\n (Stagger. dt nil gen))))\n\n; This isn't actually DelayTil. It spreads out *all* requests evenly. Feels\n; like it might be useful later.\n;(defrecord DelayTil [dt anchor wait-til gen]\n; Generator\n; (op [_ test ctx]\n; (when-let [[op gen'] (op gen test ctx)]\n; (if (= :pending op)\n; ; You can't delay what's pending!\n; [op (DelayTil. dt anchor wait-til gen')]\n\n; ; OK we have an actual op\n; (let [; The next op should occur at time t\n; t (if wait-til\n; (max wait-til (:time op))\n; (:time op))\n; ; Update op\n; op' (assoc op :time t)\n; ; Initialize our anchor if we don't have one\n; anchor' (or anchor t)\n; ; And compute the next wait-til time after t\n; wait-til' (+ t (- dt (mod (- t anchor') dt)))\n; ; Our next generator state\n; gen' (DelayTil. dt anchor' wait-til' gen')]\n; [op' gen']))))\n\n; (update [this test ctx event]\n; (DelayTil. dt anchor wait-til (update gen test ctx event))))\n\n;(defn delay-til\n; \"Given a time dt in seconds, and an underlying generator gen, constructs a\n; generator which emits operations such that successive invocations are at\n; least dt seconds apart.\"\n; [dt gen]\n; (DelayTil. (long (util/secs->nanos dt)) nil nil gen))\n\n; dt is our interval between ops in nanos\n; next-time is the next timestamp we plan to emit.\n(defrecord Delay [dt next-time gen]\n Generator\n (op [_ test ctx]\n (when-let [[op gen'] (op gen test ctx)]\n (if (= op :pending)\n ; Just pass these through; we don't know when they'll occur!\n [op (Delay. dt next-time gen')]\n\n ; OK we have an actual op. Compute its new event time.\n (let [next-time (or next-time (:time op))\n op (c/update op :time max next-time)]\n [op (Delay. dt (+ (:time op) dt) gen')]))))\n\n (update [this test ctx event]\n (Delay. dt next-time (update gen test ctx event))))\n\n(defn delay\n \"Given a time dt in seconds, and an underlying generator gen, constructs a\n generator which tries to emit operations exactly dt seconds apart. Emits\n operations more frequently if it falls behind. Like `stagger`, this should\n result in histories where operations happen roughly every dt seconds.\n\n Note that this definition of delay differs from its stateful cousin delay,\n which a.) introduced dt seconds of delay between *completion* and subsequent\n invocation, and b.) emitted 1/dt ops/sec *per thread*, rather than globally.\"\n [dt gen]\n (Delay. (secs->nanos dt) nil gen))\n\n(defn sleep\n \"Emits exactly one special operation which causes its receiving process to do\n nothing for dt seconds. Use (repeat (sleep 10)) to sleep repeatedly.\"\n [dt]\n {:type :sleep, :value dt})\n\n(defrecord Synchronize [gen]\n Generator\n (op [this test ctx]\n (if (= (context/free-thread-count ctx)\n (context/all-thread-count ctx))\n ; We're ready, replace ourselves with the generator\n (op gen test ctx)\n ; Not yet\n [:pending this]))\n\n (update [_ test ctx event]\n (Synchronize. (update gen test ctx event))))\n\n(defn synchronize\n \"Takes a generator, and waits for all workers to be free before it begins.\"\n [gen]\n (Synchronize. gen))\n\n(defn phases\n \"Takes several generators, and constructs a generator which evaluates\n everything from the first generator, then everything from the second, and so\n on.\"\n [& gens]\n (let [gens (->> gens\n (remove nil?)\n (c/map synchronize))]\n (case (count gens)\n 0 nil\n 1 (first gens)\n gens)))\n\n(defn then\n \"Generator A, synchronize, then generator B. Note that this takes its\n arguments backwards: b comes before a. Why? Because it reads better in ->>\n composition. You can say:\n\n (->> (fn [] {:f :write :value 2})\n (limit 3)\n (then (once {:f :read})))\"\n [a b]\n (cond (nil? a) b\n (nil? b) a\n true [b (synchronize a)]))\n\n(defrecord UntilOk [gen done? active-processes]\n Generator\n (op [this test ctx]\n (when-not done?\n (when-let [[op gen'] (op gen test ctx)]\n (if (= :pending op)\n [op (assoc this :gen gen')]\n [op (UntilOk. gen' done? (conj active-processes (:process op)))]))))\n\n (update [this test ctx event]\n (let [gen' (update gen test ctx event)\n p (:process event)]\n (if (contains? active-processes p)\n ; This is an update related to one of our operations.\n (case (:type event)\n ; We're finished; no need to update any more!\n :ok (UntilOk. gen' true (disj active-processes p))\n\n ; Crashed or failed; process no longer active, but we're not done.\n (:info, :fail) (UntilOk. gen' done? (disj active-processes p))\n\n ; Pass through\n (UntilOk. gen' done? active-processes))\n ; Some unrelated update\n (UntilOk. gen' done? active-processes)))))\n\n(defn until-ok\n \"Wraps a generator, yielding operations from it until one of those operations\n completes with :type :ok.\"\n [gen]\n (when gen\n (UntilOk. gen false #{})))\n\n(defrecord FlipFlop [gens i]\n Generator\n (op [this test ctx]\n (when-let [[op gen'] (op (nth gens i) test ctx)]\n [op (FlipFlop. (assoc gens i gen')\n (mod (inc i) (count gens)))]))\n\n (update [this test ctx event]\n this))\n\n(defn flip-flop\n \"Emits an operation from generator A, then B, then A again, then B again,\n etc. Stops as soon as any gen is exhausted. Updates are ignored.\"\n [a b]\n (FlipFlop. [a b] 0))\n\n(defrecord CycleTimes [period ; Total period of the cycle, in nanos\n t0 ; Starting time, in nanos (initially nil)\n intervals ; Vector of durations in nanos that each\n ; generator should last for.\n cutoffs ; Vector of times in nanos below which that\n ; particular generator starts. Omits the last\n ; generator.\n gens] ; Vector of generators\n Generator\n (op [this test ctx]\n ; We start by figuring out the current generator based on the context time.\n (let [now (:time ctx)\n ; When's the zero point of our timeline?\n t0 (or t0 (:time ctx))\n ; How far are we into the current cycle?\n in-period (mod (- now t0) period)\n ; When was the start of the current cycle?\n cycle-start (- now in-period)\n ; What generator do we think is most likely to have an operation for\n ; us?\n i (loop [i 0]\n (if (or (= i (count cutoffs))\n (< in-period (nth cutoffs i)))\n i\n (recur (inc i))))]\n ; Now we cycle through the generators in order, looking for one which can\n ; produce an operation which falls before the end of its window.\n (loop [i i\n ; When we ask a later generator for an operation, we don't want to\n ; ask it for an operation with the *current* time, because that\n ; generator won't actually be valid until *later*. Instead we're\n ; going to pretend its time t had arrived already, and see what\n ; the answer *would* be at that time.\n t (reduce + cycle-start (take i intervals))]\n (let [gen (nth gens i)\n interval (nth intervals i)\n ; When does the next generator start?\n t' (+ t interval)\n ; Ask this generator for an operation. We use the current time,\n ; or the start of the generator's window, whichever is higher.\n [op gen'] (op gen test (assoc ctx :time (max now t)))]\n (cond ; Ah, this generator is exhausted. So are we.\n (nil? op)\n nil\n\n ; We're pending--we might choose to emit an operation before\n ; this window is over.\n (= :pending op)\n [:pending (CycleTimes. period t0 intervals cutoffs\n (assoc gens i gen'))]\n\n ; This operation falls before the generator's window ends.\n (< (:time op) t')\n [op (CycleTimes. period t0 intervals cutoffs\n (assoc gens i gen'))]\n\n ; This operation falls after the generator's window ends; try\n ; the next generator.\n true\n (recur (mod (inc i) (count gens))\n t'))))))\n\n (update [this test ctx event]\n (CycleTimes. period t0 intervals cutoffs\n (mapv (fn updater [gen] (update gen test ctx event)) gens))))\n\n(defn cycle-times\n \"Cycles between several generators on a rotating schedule. Takes a flat\n series of [time, generator] pairs, like so:\n\n (cycle-times 5 {:f :write}\n 10 (gen/stagger 1 {:f :read}))\n\n This generator emits writes for five seconds, then staggered reads for ten\n seconds, then goes back to writes, and so on. Generator state is preserved\n from cycle to cycle, which makes this suitable for e.g. interleaving quiet\n periods into a nemesis generator which needs to perform a specific sequence\n of operations like :add-node, :remove-node, :add-node ...\n\n Updates are propagated to all generators.\"\n [& specs]\n (when (seq specs)\n (assert (even? (count specs)))\n (let [intervals (->> specs\n (partition 1 2)\n (mapcat identity)\n (mapv secs->nanos))\n gens (->> specs next (partition 1 2) vec)\n period (reduce + intervals)\n cutoffs (vec (reductions + intervals))]\n (CycleTimes. period nil intervals cutoffs gens))))\n" }, { "path": "generator/src/jepsen/random.clj", "content": "(ns jepsen.random\n \"Pluggable generation of random values.\n\n ## Pluggable\n\n First, randomness should be pluggable. In normal tests, standard Clojure\n `(rand-int)` and friends are just fine. But in tests, it's nice if those can\n be replaced by a deterministic seed. When running in a hypervisor like\n Antithesis, you want to draw entropy from a special SDK, so it can\n intentionally send you down interesting paths.\n\n ## Fast\n\n Second, it should be *reasonably* fast. We'd like to ideally generate ~100 K\n ops/sec, and each operation might need to draw, say, 10 random values, which\n is 1 M values/sec. Basic Clojure (rand-int 5) on my ThreadRipper takes ~37\n ns. Clojure's data.generators takes ~35 ns. Our thread-local implementation,\n backed by a LXM splittable random, takes just ~33 ns.\n\n ## Thread-safe\n\n We want everyone in the Jepsen universe to be able to draw random values from\n this namespace without coordinating. This implies generating values should be\n thread-safe.\n\n ## Stateful\n\n This namespace must be stateful. We'd like callers to simply be able to call\n `(r/int 5)` and get 2.\n\n Pure, splittable random seeds ala `test.check` are nice, but they a.) come\n with a performance penalty, and b.) require threading that random state\n through essentially every function call and return. This is not only complex,\n but adds additional destructuring overhead at each call boundary.\n\n The main advantage of stateful random generators is determinism across\n threads, but this is not a major concern in Jepsen. In normal test runs, we\n don't care about reproducibility. In Antithesis, the entire thread schedule\n is deterministic, so we're free to share state across threads and trust that\n Antithesis Will Take Care Of It. In tests, we're generally drawing entropy\n from a single thread. It'd be *nice* to have thread-safe random generators,\n but it's not critical.\n\n ## Determinism\n\n In single-threaded contexts, we want to be able to seed randomness and have\n reproducible tests. Doing this across threads is not really important--if we\n were being rigorous we could thread a splittable random down through every\n thread spawned, but there's a LOT of threaded code in Jepsen and it doesn't\n all know about us. More to the point, our multithreaded code is usually a.)\n non-random, or b.) doing IO, which we can't control. Having determinism for a\n single thread gets us a reasonable 'bang for our buck'.\n\n ## Special Distributions\n\n Jepsen needs some random things that aren't well supported by the normal\n java.util.Random, clojure.core, or data.generators functions. In particular,\n we like to do:\n\n 1. Zipfian distributions: lots of small things, but sometimes very\n large things.\n 2. Weighted choices: 90% reads, 5% writes, 5% deletes.\n 3. Special values: over-represent maxima, minima, and zero, to stress\n codepaths that might treat them differently.\n\n ## Usage\n\n Here are common Clojure functions and their equivalents in this namespace:\n\n rand rand/double\n rand-int rand/long\n rand-nth rand/nth\n shuffle rand/shuffle\n\n You can also generate values from common distributions:\n\n rand/bool Returns true or false, optionally with a probability\n rand/exp Exponential distribution\n rand/geometric Geometric distribution\n rand/zipf Zipfian distribution\n rand/weighted Discrete values with given weights\n\n You can take random permutations and subsets (really, ordered prefixes of\n permutations) of collections with:\n\n rand/shuffle\n rand/nonempty-subset\n\n There are two macros for randomly branching control flow:\n\n rand/branch\n rand/weighted-branch\n\n To re-bind randomness to a specifically seeded RNG, use:\n\n (jepsen.random/with-seed 5\n (jepsen.random/long) ; Returns the same value every time\n (call-stuff-using-jepsen.random ...) ; This holds for the whole body\n\n This changes a global variable `jepsen.random/rng` and is NOT THREAD SAFE. Do\n not use `with-seed` concurrently. It's fine to spawn threads within the body,\n but if those threads are spawned in a nondeterministic order, then their\n calls to jepsen.random will also be nondeterministic.\n \"\n (:refer-clojure :exclude [double long nth shuffle])\n (:require [clj-commons.primitive-math :as p]\n [clojure.core :as c]\n [clojure.data.generators :as dg]\n [dom-top.core :refer [loopr]]\n [potemkin :refer [definterface+]])\n (:import (java.util.random RandomGenerator\n RandomGenerator$SplittableGenerator\n RandomGeneratorFactory\n )))\n\n;; Implementations. We provide a few implementations, mainly for performance\n;; comparison purposes. Each random implementation satisfies a subset of the\n;; the Java RandomGenerator API (nextDouble and nextLong), AND is also expected\n;; to be threadsafe.\n\n; Calls Clojure's built-ins\n(deftype ClojureRandom []\n RandomGenerator\n (nextDouble [r]\n (rand))\n (nextDouble [r upper]\n (rand upper))\n (nextDouble [r lower upper]\n (p/+ lower (c/double (rand (p/- upper lower)))))\n\n (nextLong [r]\n (rand-int Long/MAX_VALUE))\n (nextLong [r upper]\n (rand-int upper))\n (nextLong [r lower upper]\n (p/+ lower (c/long (rand-int (p/- upper lower))))))\n\n(defn clojure-random\n \"A random source that uses Clojure's built-ins.\"\n []\n (ClojureRandom.))\n\n; Calls data.generators\n(deftype DataGeneratorsRandom []\n RandomGenerator\n (nextDouble [r]\n (dg/double))\n (nextDouble [r upper]\n (p/* (dg/double) upper))\n (nextDouble [r lower upper]\n (p/+ lower (* (dg/double) (p/- upper lower))))\n\n (nextLong [r]\n (dg/uniform))\n (nextLong [r upper]\n (dg/uniform 0 upper))\n (nextLong [r lower upper]\n (dg/uniform lower upper)))\n\n(defn data-generators-random\n \"A random source that uses data.generators.\"\n []\n (DataGeneratorsRandom.))\n\n; Our implementation, which uses a RandomGenerator stored in a\n; ThreadLocal. See https://openjdk.org/jeps/356 and https://prng.di.unimi.it/\n(deftype ThreadLocalRandom [^ThreadLocal local]\n RandomGenerator\n (nextLong [r]\n (.nextLong ^RandomGenerator (.get local)))\n (nextLong [r lower upper]\n (.nextLong ^RandomGenerator (.get local) lower upper)))\n\n(defn thread-local-random\n \"Constructs a ThreadLocalRandom. Right now we use an L64X128MixRandom, and\n split off a fresh instance for every thread that asks for entropy.\"\n ([] (thread-local-random nil))\n ([seed]\n (let [; First, we need to make an RNG. We use the LXM family because it's\n ; splittable, so we can generate one for each thread.\n rngf (RandomGeneratorFactory/of \"L64X128MixRandom\")\n _ (assert (not (.isDeprecated rngf)))\n ^RandomGenerator$SplittableGenerator root-rng\n (if seed\n (.create rngf (c/long seed))\n (.create rngf))\n ; And make a ThreadLocal that takes RNGs from the root\n thread-local\n (proxy [ThreadLocal] []\n (initialValue []\n (locking root-rng\n (.split root-rng))))]\n (ThreadLocalRandom. thread-local))))\n\n(def ^RandomGenerator rng\n \"This is our default implementation of randomness. We don't use a dynamic var\n here because it turns out to add significant overhead (~30 ns), roughly\n halving speed, and because when you're choosing a different random\n implementation, you want it *everywhere*, not just in one thread tree.\n\n To select a different random generator, use\n\n (with-redefs [r/rng (r/thread-local-random some-seed)]\n ...)\"\n (thread-local-random))\n\n(defmacro with-rng\n \"Evaluates body with the given random number generator. Not thread-safe;\n takes effect globally.\"\n [rng & body]\n `(with-redefs [rng ~rng] ~@body))\n\n(defmacro with-seed\n \"Evaluates body with the random generator re-bound to a determistic PRNG with\n the given seed. Not thread-safe; takes effect globally.\"\n [seed & body]\n `(with-rng (thread-local-random ~seed) ~@body))\n\n; Basic uniform values\n\n(defn long\n \"Generates a uniformly distributed primitive long in [lower, upper)\"\n (^long [] (.nextLong rng))\n (^long [^long upper]\n (.nextLong rng upper))\n (^long [^long lower, ^long upper] (.nextLong rng lower upper)))\n\n(defn double\n \"Generates a uniformly distributed double in [lower, upper).\"\n (^double [] (.nextDouble rng))\n (^double [^double upper] (.nextDouble rng upper))\n (^double [^double lower, ^double upper]\n (.nextDouble rng lower upper)))\n\n(defn bool\n \"Generates a boolean. With no arguments, has a 50% chance of being true.\n Optionally takes a probability (in [0,1]) of being true.\"\n ([] (.nextBoolean rng))\n ([^double p]\n (p/< (double) p)))\n\n;; Nonuniform distributions\n\n(defn exp\n \"Generates a exponentially distributed random double with rate parameter\n lambda.\"\n [lambda]\n (* (Math/log (p/- 1.0 (double))) (- lambda)))\n\n(defn geometric\n \"Generates a geometrically distributed random long with probability p.\n Specifically, these approximate the number of independent Bernoulli trial\n failures before the first success, supported on 0, 1, 2, .... We do this\n because--as with all our discrete distributions--we often want to use these\n values as indices into vectors, which are zero-indexed.\"\n [^double p]\n (-> (Math/log (double))\n (/ (Math/log (- 1.0 p)))\n Math/ceil\n c/long\n dec))\n\n(def zipf-default-skew\n \"When we choose zipf-distributed things, what skew do we generally pick? The\n algorithm has a singularity at 1, so we choose a slightly larger value.\"\n 1.0001)\n\n(defn zipf-b-inverse-cdf\n \"Inverse cumulative distribution function for the zipfian bounding function\n used in `zipf`.\"\n (^double [^double skew ^double t ^double p]\n (let [tp (* t p)]\n (if (<= tp 1)\n ; Clamp so we don't fly off to infinity\n tp\n (Math/pow (+ (* tp (- 1 skew))\n skew)\n (/ (- 1 skew)))))))\n\n(defn zipf\n \"Selects a Zipfian-distributed integer in [0, n) with a given skew factor.\n Adapted from the rejection sampling technique in\n https://jasoncrease.medium.com/rejection-sampling-the-zipf-distribution-6b359792cffa.\n\n Note that the standard Zipfian ranges from (0, n], but you almost always want\n to use a Zipfian with a zero-indexed collection, so we emit [0, n) instead.\n Add one if you want the standard Zipfian.\"\n (^long [^long n]\n (zipf zipf-default-skew n))\n (^long [^double skew ^long n]\n (if (= n 0)\n 0\n (do (assert (not= 1.0 skew)\n \"Sorry, our approximation can't do skew = 1.0! Try a small epsilon, like 1.0001\")\n (let [t (/ (- (Math/pow n (- 1 skew)) skew)\n (- 1 skew))]\n (loop []\n (let [inv-b (zipf-b-inverse-cdf skew t (double))\n sample-x (c/long (+ 1 inv-b))\n y-rand (double)\n ratio-top (Math/pow sample-x (- skew))\n ratio-bottom (/ (if (<= sample-x 1)\n 1\n (Math/pow inv-b (- skew)))\n t)\n rat (/ ratio-top (* t ratio-bottom))]\n (if (< y-rand rat)\n (- sample-x 1)\n (recur)))))))))\n\n; Choosing things from collections\n\n(defn nth\n \"Like clojure's rand-nth, but uses our RNG.\"\n [coll]\n (let [c (count coll)]\n (when (= 0 c)\n (throw (IndexOutOfBoundsException.)))\n (c/nth coll (long c))))\n\n(defn nth-empty\n \"Like rand-nth, but returns `nil` for empty collections.\"\n [coll]\n (try (nth coll)\n (catch IndexOutOfBoundsException e nil)))\n\n(defn all-zero-doubles?\n \"Takes a double array and returns true iff it contains only 0.0. We use this\n as a sentinel value for weight arrays.\"\n [^doubles xs]\n (loop [i 0]\n (cond (p/== i (alength xs))\n true\n\n (p/not== 0.0 (aget xs i))\n false\n\n true\n (recur (p/inc i)))))\n\n(defn double-weighted-index\n \"Takes a total weight and an array of double weights for a weighted discrete\n distribution. Generates a random long index into those weights, with\n probability proportionate to that index's weight. Returns -1 when\n total-weight is 0.\n\n Note that `total-weight` is optional and should always be (reduce + weights).\n It's only an argument so you can sum once, rather than every call.\"\n (^long [^doubles weights]\n (double-weighted-index (reduce + weights) weights))\n (^long [^double total-weight ^doubles weights]\n (if (== 0.0 total-weight)\n -1\n (let [r (double 0 total-weight)]\n ; Linear search through weights\n (loop [i 0\n sum 0.0]\n (let [sum' (p/+ sum (aget weights i))]\n (if (p/< r sum')\n i\n (recur (inc i) sum'))))))))\n\n(defn weighted-fn\n \"Like weighted-choice, but returns a *function* which, when invoked with no\n arguments, returns a random value. This version is significantly faster than\n weighted-choice, as it can pre-compute key values.\"\n [wcs]\n (let [c (count wcs)\n weights (double-array c)\n choices (object-array c)]\n ; Fill in weights and choices arrays based on choices structure\n (cond\n ; Map of choice -> weight\n (map? wcs)\n (loopr [i 0]\n [[choice weight] wcs]\n (do (aset-double weights i weight)\n (aset choices i choice)\n (recur (inc i))))\n\n ; Unknown\n true (throw (IllegalArgumentException.\n (str \"weighted-choice-fn expects a map, not a \"\n (type choices)\n \": \" (pr-str choices)))))\n (let [^double total-weight (areduce weights i ret 0.0\n (+ ret (aget weights i)))]\n (fn chooser []\n (let [i (double-weighted-index total-weight weights)]\n (aget choices i))))))\n\n(defn weighted\n \"Picks a random selection out of several weighted choices. Takes a map of\n values to weights, like so:\n\n {:foo 5\n :bar 3\n :baz 2}\n\n This returns :foo half of the time, :bar 30% of the time, and :baz 20% of the\n time. This is slow; see weighted-choice-fn for a faster variant.\"\n [choices]\n ((weighted-fn choices)))\n\n(defmacro branch\n \"Like a random `cond`: takes several forms and evaluates one of them at\n random. With zero arguments, returns nil.\"\n [& forms]\n (case (count forms)\n 0 nil\n 1 (first forms)\n `(case (long ~(count forms))\n ~@(->> forms\n (map-indexed vector)\n (mapcat identity)))))\n\n(defrecord WeightedBranchCache [^double total-weight, ^doubles weights])\n\n(defmacro weighted-branch\n \"Like `branch`, but where the probability of each branch is proportionate to\n its weight. Like `weighted`, but since this is a macro, it only evaluates a\n single branch, not all of them. For example, to print :x 30% of the time, and\n :y 70%...\n\n (weighted-branch\n 3 (prn :x)\n 7 (prn :y))\n\n Weights must be run-time constant, but can be arbitrary expressions. Weights\n are evaluated on the first invocation of the macro's code, and cached\n thereafter. This makes `weighted-branch` significantly faster than\n `weighted`.\"\n [& branches]\n (assert (even? (count branches)))\n (let [pairs (partition 2 branches)\n n (count pairs)\n weight-forms (mapv first pairs)\n branch-forms (mapv second pairs)\n weights (gensym 'weights)\n ; We def a cache for each use of this macro\n cache (-> (gensym 'weighted-branch-cache)\n (vary-meta assoc\n :private true\n :tag 'jepsen.random.WeightedBranchCache))]\n (case n\n 0 nil\n 1 (first branch-forms)\n (do ; Note that we leave the cache unbound, so that both normal and AOT\n ; compiled contexts will see an unbound cache on first run.\n (eval `(def ~cache))\n ; lmao you'd THINk you want (bound?) here, but that ONLY has a\n ; varargs form, so even single-arg calls go through every? and seq\n ; machinery.\n `(do (when (not (.isBound (var ~cache)))\n ; First run; initialize.\n (locking ~cache\n (when (not (.isBound (var ~cache)))\n (let [~weights (double-array ~n)]\n ; We won the lock race; fill in weights.\n ;(prn :init ~cache)\n ~@(map-indexed (fn [i weight-form]\n `(aset-double ~weights\n ~i ~weight-form))\n weight-forms)\n (let [total# (c/double\n (areduce ~weights i# ret# 0.0\n (+ ret# (aget ~weights i#))))]\n\n (alter-var-root (var ~cache)\n (constantly\n (WeightedBranchCache. total# ~weights))))))))\n (case (double-weighted-index (.total-weight ~cache)\n (.weights ~cache))\n ~@(->> branch-forms\n (map-indexed vector)\n (mapcat identity))))))))\n\n(defn shuffle\n \"Like Clojure shuffle, but based on our RNG. We use a Fisher-Yates shuffle\n here; see\n http://en.wikipedia.org/wiki/Fisher–Yates_shuffle#The_modern_algorithm\"\n [coll]\n (let [buffer (object-array coll)]\n (loop [i (dec (alength buffer))]\n (if (< 0 i)\n (let [j (long 0 (inc i))\n tmp (aget buffer i)]\n (aset buffer i (aget buffer j))\n (aset buffer j tmp)\n (recur (dec i)))\n (into (empty coll) (seq buffer))))))\n\n(defn nonempty-subset\n \"A non-empty prefix of a permutation of the given collection. Lengths are\n uniformly distributed. This is technically not a subset; if there are\n duplicates in the input collection, there may be duplicates in the output;\n nor is the output a set. Still, we use this constantly for subset-like\n things, like 'take a random collection of some nodes from the test'.\n\n Returns nil if collection is empty. Otherwise, returns at least singleton\n prefices, and up to full permutations of coll itself.\"\n [coll]\n (let [c (count coll)]\n (when (< 0 c)\n (take (inc (long c)) (shuffle coll)))))\n" }, { "path": "generator/test/jepsen/generator/context_test.clj", "content": "(ns jepsen.generator.context-test\n (:require [clojure [datafy :refer [datafy]]\n [pprint :refer [pprint]]\n [test :refer :all]]\n [jepsen.generator.context :refer :all])\n (:import (io.lacuna.bifurcan IMap\n Map\n Set)))\n\n(deftest context-test\n (let [c (context {:concurrency 2})\n _ (testing \"basics\"\n (is (= 0 (:time c)))\n (is (= 3 (all-thread-count c)))\n (is (= 3 (free-thread-count c)))\n (is (= (Set/from [:nemesis 0 1]) (free-threads c)))\n (is (= #{:nemesis 0 1} (set (free-processes c))))\n (is (= :nemesis (thread->process c :nemesis)))\n (is (= :nemesis (process->thread c :nemesis)))\n (is (= 1 (thread->process c 1)))\n (is (= 1 (process->thread c 1)))\n (is (= 0 (some-free-process c))))\n\n c1 (busy-thread c 5 0)\n _ (testing \"busy\"\n (is (= 5 (:time c1)))\n (is (= 3 (all-thread-count c1)))\n (is (= 2 (free-thread-count c1)))\n (is (= (Set/from [:nemesis 1]) (free-threads c1)))\n (is (= #{:nemesis 1} (set (free-processes c1))))\n (is (= 1 (some-free-process c1))))\n\n c2 (free-thread c1 10 0)\n _ (testing \"free\"\n (is (= (assoc c :time 10) c2))\n ; But the free process has advanced, for fairness!\n (is (= 1 (some-free-process c2))))\n\n _ (testing \"thread-filter\"\n (testing \"all-but\"\n (let [c3 ((make-thread-filter (all-but :nemesis) c) c)]\n (is (= (Set/from [0 1]) (free-threads c3)))\n (is (= (Set/from [0 1]) (all-threads c3)))\n (is (= #{0 1} (set (free-processes c3))))\n (is (= #{0 1} (set (all-processes c3))))\n (is (= 0 (some-free-process c3)))))\n\n (testing \"set\"\n (let [c3 ((make-thread-filter #{1 :nemesis} c) c)]\n (is (= (Set/from [1 :nemesis]) (free-threads c3)))\n (is (= (Set/from [1 :nemesis]) (all-threads c3)))\n (is (= #{1 :nemesis} (set (free-processes c3))))\n (is (= #{1 :nemesis} (set (all-processes c3))))\n (is (= 1 (some-free-process c3)))))\n\n (testing \"fn\"\n (let [c3 ((make-thread-filter integer? c) c)]\n (is (= (Set/from [0 1]) (free-threads c3)))\n (is (= (Set/from [0 1]) (all-threads c3)))\n (is (= #{0 1} (set (free-processes c3))))\n (is (= #{0 1} (set (all-processes c3))))\n (is (= 0 (some-free-process c3))))))\n ]))\n\n(deftest with-next-process-test\n ; As we crash threads their processes should advance\n (let [c (context {:concurrency 2})\n c1 (with-next-process c 0)\n _ (is (= 2 (thread->process c1 0)))\n _ (is (= 0 (process->thread c1 2)))\n c2 (with-next-process c1 0)\n _ (is (= 4 (thread->process c2 0)))\n _ (is (= 0 (process->thread c2 4)))]))\n\n(deftest some-free-process-test\n (let [c (context {:concurrency 2})]\n (testing \"all free\"\n (is (= 0 (some-free-process c))))\n\n (testing \"some busy\"\n (is (= 1 (-> c (busy-thread 0 0) some-free-process)))\n (is (not= 1 (-> c (busy-thread 0 1) some-free-process))))\n\n ; We want to make sure that if we use and free a process, and all *later*\n ; processes are busy, we realize the first process is still free.\n (testing \"driven forward\"\n (let [c' (-> c\n (busy-thread 0 1)\n (busy-thread 0 :nemesis))]\n (is (= 0 (some-free-process c')))))\n\n ; We want to distribute requests evenly across threads to prevent\n ; starvation.\n (testing \"fair\"\n (let [c1 (-> c (busy-thread 0 0) (free-thread 0 0))\n _ (is (= 1 (some-free-process c1)))\n c2 (-> c1 (busy-thread 0 1) (free-thread 0 1))\n _ (is (= :nemesis (some-free-process c2)))\n c3 (-> c2 (busy-thread 0 :nemesis) (free-thread 0 :nemesis))\n _ (is (= 0 (some-free-process c3)))]))))\n\n(deftest assoc-test\n (let [c (context {:concurrency 2})\n c' (assoc c :special 123)]\n (is (= 123 (:special c')))\n (is (= (class c) (class c')))))\n" }, { "path": "generator/test/jepsen/generator/translation_table_test.clj", "content": "(ns jepsen.generator.translation-table-test\n (:require [clojure [test :refer :all]\n [pprint :refer :all]]\n [jepsen.generator.translation-table :refer :all])\n (:import (java.util BitSet)))\n\n(deftest basic-test\n (let [t (translation-table 2 [:nemesis])]\n (is (= [0 1 :nemesis] (all-names t)))\n (is (= 3 (thread-count t)))\n (testing \"name->index\"\n (is (= 0 (name->index t 0)))\n (is (= 1 (name->index t 1)))\n (is (= 2 (name->index t :nemesis))))\n (testing \"index->name\"\n (is (= 0 (index->name t 0)))\n (is (= 1 (index->name t 1)))\n (is (= :nemesis (index->name t 2))))\n (testing \"bitset slices\"\n (let [bs (doto (BitSet.) (.set 1) (.set 2))]\n (is (= #{1 :nemesis} (set (indices->names t bs))))\n (is (= bs (names->indices t #{1 :nemesis})))))))\n" }, { "path": "generator/test/jepsen/generator_test.clj", "content": "(ns jepsen.generator-test\n (:require [jepsen.generator [context :as ctx]\n [test :as gen.test]]\n [jepsen [generator :as gen]\n [history :as h]]\n [clojure [pprint :refer [pprint]]\n [test :refer :all]]\n [slingshot.slingshot :refer [try+ throw+]])\n (:import (io.lacuna.bifurcan IMap\n Map\n Set)))\n\n(defn nanos->secs\n [n]\n (/ n 1e9))\n\n(gen/init!)\n\n(deftest nil-test\n (is (= [] (gen.test/perfect nil))))\n\n(deftest map-test\n (testing \"nil passthrough\"\n (is (nil? (gen/map inc nil))))\n\n (testing \"just the op\"\n (is (= [{:time 0\n :process 0\n :type :invoke\n :f :write\n :value 2}]\n (->> {:f :write :value 1}\n (gen/map #(update % :value inc))\n (gen.test/perfect)))))\n\n (testing \"op, test, context\"\n (is (= [{:time 0\n :process 0\n :type :invoke\n :f :write\n :value [{:nodes [\"n1\" \"n2\"]}\n {:time 0}]}]\n (->> {:f :write :value 1}\n (gen/map (fn [op test ctx]\n (assoc op :value [test ctx])))\n (gen.test/perfect))))))\n\n(deftest clojure-map-test\n (testing \"once\"\n (is (= [{:time 0\n :process 0\n :type :invoke\n :f :write\n :value nil}]\n (gen.test/perfect {:f :write}))))\n\n (testing \"concurrent\"\n (is (= [{:type :invoke, :process 0, :f :write, :time 0, :value nil}\n {:type :invoke, :process 1, :f :write, :time 0, :value nil}\n {:type :invoke, :process :nemesis, :f :write, :time 0, :value nil}\n {:type :invoke, :process :nemesis, :f :write, :time 10, :value nil}\n {:type :invoke, :process 1, :f :write, :time 10, :value nil}\n {:type :invoke, :process 0, :f :write, :time 10, :value nil}]\n (gen.test/perfect (repeat 6 {:f :write})))))\n\n (testing \"all threads busy\"\n (let [c gen.test/default-context\n c (reduce (fn [c thread] (ctx/busy-thread c 0 thread))\n c\n (ctx/all-threads c))]\n (is (= [:pending {:f :write}]\n (gen/op {:f :write} {} c)))))\n\n (testing \"don't duplicate extmap keys\"\n (let [[op _] (gen/op {:f :write, :foo :bar} {} gen.test/default-context)]\n (is (instance? jepsen.history.Op op))\n (is (= {:foo :bar} (.__extmap op))))))\n\n(deftest limit-test\n (testing \"nil passthrough\"\n (is (nil? (gen/limit 5 nil))))\n\n (is (= [{:type :invoke, :process 0, :time 0, :f :write, :value 1}\n {:type :invoke, :process 1, :time 0, :f :write, :value 1}]\n (->> (repeat {:f :write :value 1})\n (gen/limit 2)\n gen.test/quick))))\n\n(deftest repeat-test\n (testing \"nil passthrough\"\n (is (nil? (gen/repeat 3 nil))))\n\n (is (= [0 0 0]\n (->> (range)\n (map (partial hash-map :value))\n (gen/repeat 3)\n (gen.test/perfect)\n (map :value)))))\n\n(deftest delay-test\n (testing \"nil passthrough\"\n ; We may want to intentionally delay a nil!\n (is (not (nil? (gen/delay 1 nil)))))\n\n (is (= [{:type :invoke, :process 0, :time 0, :f :write, :value nil}\n {:type :invoke, :process 1, :time 3, :f :write, :value nil}\n {:type :invoke, :process :nemesis, :time 6, :f :write, :value nil}\n ; This would normally execute at 9 and 12, but every thread was busy\n ; for 10 nanos: they start as soon as they can.\n {:type :invoke, :process 0, :time 10, :f :write, :value nil}\n {:type :invoke, :process 1, :time 13, :f :write, :value nil}]\n (->> {:f :write}\n repeat\n (gen/delay 3e-9)\n (gen/limit 5)\n gen.test/perfect))))\n\n(deftest seq-test\n (testing \"vectors\"\n (is (= [1 2 3]\n (->> [{:value 1}\n {:value 2}\n {:value 3}]\n gen.test/quick\n (map :value)))))\n\n (testing \"seqs\"\n (is (= [1 2 3]\n (->> [{:value 1}\n {:value 2}\n {:value 3}]\n gen.test/quick\n (map :value)))))\n\n (testing \"nested\"\n (is (= [1 2 3 4 5]\n (->> [[{:value 1}\n {:value 2}]\n [[{:value 3}]\n {:value 4}]\n {:value 5}]\n gen.test/quick\n (map :value)))))\n\n (testing \"updates propagate to first generator\"\n (let [gen (->> [(gen/until-ok (gen/repeat {:f :read}))\n {:f :done}]\n (gen/clients))\n types (atom (concat [nil :fail :fail :ok :ok] (repeat :info)))]\n (is (= [[0 :read :invoke]\n [0 :read :invoke]\n ; Everyone fails and retries\n [10 :read :fail]\n [10 :read :invoke]\n [10 :read :fail]\n [10 :read :invoke]\n ; One succeeds and goes on to execute :done\n [20 :read :ok]\n [20 :done :invoke]\n ; The other succeeds and is finished\n [20 :read :ok]\n [30 :done :info]]\n (->> (gen.test/simulate gen.test/default-context gen\n (fn [ctx op]\n (-> op (update :time + 10)\n (assoc :type (first (swap! types next))))))\n (map (juxt :time :f :type))))))))\n\n(deftest fn-test\n (testing \"returning nil\"\n (is (= [] (gen.test/quick (fn [])))))\n\n (testing \"returning a literal map\"\n (let [ops (->> (fn [] {:f :write, :value (rand-int 10)})\n (gen/limit 5)\n gen.test/perfect)]\n (is (= 5 (count ops))) ; limit\n (is (every? #(<= 0 % 10) (map :value ops))) ; legal vals\n (is (< 1 (count (set (map :value ops))))) ; random vals\n (is (= #{0 1 :nemesis} (set (map :process ops)))))) ; processes assigned\n\n (testing \"returning repeat maps\"\n (let [ops (->> #(gen/repeat {:f :write, :value (rand-int 10)})\n (gen/limit 5)\n gen.test/perfect)]\n (is (= 5 (count ops))) ; limit\n (is (every? #(<= 0 % 10) (map :value ops))) ; legal vals\n (is (= 1 (count (set (map :value ops))))) ; same vals\n (is (= #{0 1 :nemesis} (set (map :process ops))))))) ; processes assigned\n\n(deftest on-update+promise-test\n ; We only fulfill p once the write has taken place.\n (let [p (promise)]\n (is (= [{:type :invoke, :time 0, :process 0, :f :read, :value nil}\n {:type :invoke, :time 0, :process 1, :f :write, :value :x}\n {:type :invoke, :time 0, :process 1, :f :confirm, :value :x}\n {:type :invoke, :time 0, :process 1, :f :hold, :value nil}\n {:type :invoke, :time 0, :process 1, :f :hold, :value nil}]\n (->> (gen/any p\n [{:f :read}\n {:f :write, :value :x}\n ; We'll do p at this point, then return to hold.\n (repeat {:f :hold})])\n ; We don't deliver p until after the write is complete.\n (gen/on-update (fn [this test ctx event]\n (when (and (h/ok? event)\n (= :write (:f event)))\n (deliver p {:f :confirm\n :value (:value event)}))\n this))\n (gen/limit 5)\n (gen/on #{0 1})\n gen.test/quick)))))\n\n\n(deftest clojure-delay-test\n (let [eval-ctx (promise)\n d (delay (gen/limit 3\n (fn [test ctx]\n ; This is a side effect so we can verify the context is\n ; being passed in properly.\n (deliver eval-ctx ctx)\n {:f :delayed})))\n h (->> (gen/phases {:f :write}\n {:f :read}\n d)\n gen/clients\n gen.test/perfect)]\n (is (= [{:f :write, :time 0, :process 0, :type :invoke, :value nil}\n {:f :read, :time 10, :process 1, :type :invoke, :value nil}\n {:f :delayed, :time 20, :process 0, :type :invoke, :value nil}\n {:f :delayed, :time 20, :process 1, :type :invoke, :value nil}\n {:f :delayed, :time 30, :process 1, :type :invoke, :value nil}]\n h))\n (is (realized? d))\n (is (= 20 (:time @eval-ctx)))\n (is (= (Set/from [0 1]) (ctx/free-threads @eval-ctx)))))\n\n(deftest synchronize-test\n (testing \"nil passthrough\"\n ; We may want to intentioanlly sync and do nothing.\n (is (not (nil? (gen/synchronize nil)))))\n\n (is (= [{:f :a, :process 0, :time 2, :type :invoke, :value nil}\n {:f :a, :process 1, :time 3, :type :invoke, :value nil}\n {:f :a, :process :nemesis, :time 5, :type :invoke, :value nil}\n {:f :b, :process 0, :time 15, :type :invoke, :value nil}\n {:f :b, :process 1, :time 15, :type :invoke, :value nil}]\n (->> [(->> (fn [test ctx]\n (let [p (ctx/some-free-process ctx)\n ; This is technically illegal: we should return the\n ; NEXT event by time. We're relying on the specific\n ; order we get called here to do this. Fragile hack!\n delay (case p\n 0 2\n 1 1\n :nemesis 2)]\n {:f :a\n :process p\n :time (+ (:time ctx) delay)}))\n (gen/limit 3))\n ; The latest process, the nemesis, should start at time 5 and\n ; finish at 15.\n (gen/synchronize (repeat 2 {:f :b}))]\n gen.test/perfect))))\n\n(deftest on-test\n (testing \"nil passthrough\"\n (is (nil? (gen/on true nil)))))\n\n(deftest clients-test\n (testing \"nil passthrough\"\n (is (nil? (gen/clients nil))))\n\n (is (= #{0 1}\n (->> {}\n gen/repeat\n (gen/clients)\n (gen/limit 5)\n gen.test/perfect\n (map :process)\n set))))\n\n(deftest phases-test\n (testing \"nil passthrough\"\n (is (nil? (gen/phases)))\n (is (nil? (gen/phases nil)))\n (is (nil? (gen/phases nil nil))))\n\n (is (= [[:a 0 0]\n [:a 1 0]\n [:b 0 10]\n [:c 0 20]\n [:c 1 20]\n [:c 1 30]]\n (->> (gen/phases (repeat 2 {:f :a})\n (repeat 1 {:f :b})\n (repeat 3 {:f :c}))\n gen/clients\n gen.test/perfect\n (map (juxt :f :process :time))))))\n\n(deftest then-test\n (testing \"nil passthrough\"\n (is (= {:f :r} (gen/then nil {:f :r})))\n (is (= {:f :r} (gen/then {:f :r} nil)))\n (is (nil? (gen/then nil nil)))))\n\n(deftest until-ok-test\n (testing \"nil passthrough\"\n (is (nil? (gen/until-ok nil)))))\n\n(deftest any-test\n ; We take two generators, each of which is restricted to a single process,\n ; and each of which takes time to schedule. When we bind them together with\n ; Any, they can interleave.\n (is (= [[:a 0 0]\n [:b 1 0]\n [:b 1 20]\n [:a 0 20]]\n (->> (gen/any (gen/on #{0} (gen/delay 20e-9 (repeat {:f :a})))\n (gen/on #{1} (gen/delay 20e-9 (repeat {:f :b}))))\n (gen/limit 4)\n gen.test/perfect\n (map (juxt :f :process :time))))))\n\n(deftest shortest-any-test\n ; We take two generators, each of which is restricted to a single process,\n ; and each of which takes time to schedule. When we bind them together with\n ; Any, they can interleave--and end as soon as one does.\n (is (= [[:a 0 0]\n [:b 1 0]\n [:b 1 20]\n [:a 0 20]]\n (->> (gen/shortest-any\n (gen/limit 2 (gen/on #{0} (gen/delay 20e-9 (repeat {:f :a}))))\n (gen/on #{1} (gen/delay 20e-9 (repeat {:f :b}))))\n gen.test/perfect\n (map (juxt :f :process :time))))))\n\n(deftest each-thread-test\n (testing \"nil passthrough\"\n (is (nil? (gen/each-thread nil))))\n\n (is (= [[0 :nemesis :a]\n [0 1 :a]\n [0 0 :a]\n [10 0 :b]\n [10 1 :b]\n [10 :nemesis :b]]\n ; Each thread now gets to evaluate [a b] independently.\n (->> (gen/each-thread [{:f :a} {:f :b}])\n gen.test/perfect\n (map (juxt :time :process :f)))))\n\n (testing \"collapses when exhausted\"\n (is (= nil\n (gen/op (gen/each-thread (gen/limit 0 {:f :read}))\n {}\n gen.test/default-context)))))\n\n(deftest each-process-test\n (testing \"nil passthrough\"\n (is (nil? (gen/each-process nil)))))\n\n(deftest stagger-test\n (testing \"nil passthrough\"\n (is (nil? (gen/stagger 1 nil))))\n\n (let [n 1000\n dt 20\n concurrency (ctx/all-thread-count gen.test/default-context)\n ops (->> (range n)\n (map (fn [x] {:f :write, :value x}))\n (gen/stagger (nanos->secs dt))\n gen.test/perfect)\n times (mapv :time ops)\n max-time (peek times)\n rate (float (/ n max-time))\n expected-rate (float (/ dt))]\n (is (<= 0.9 (/ rate expected-rate) 1.1))))\n\n(deftest f-map-test\n (is (= [{:type :invoke, :process 0, :time 0, :f :b, :value 2}]\n (->> {:f :a, :value 2}\n (gen/f-map {:a :b})\n gen.test/perfect)))\n (testing \"nil passthrough\"\n (is (= nil (gen/f-map {:a :b} nil)))))\n\n(deftest filter-test\n (testing \"nil passthrough\"\n (is (nil? (gen/filter odd? nil))))\n\n (is (= [0 2 4 6 8]\n (->> (range)\n (map (fn [x] {:value x}))\n (gen/limit 10)\n (gen/filter (comp even? :value))\n gen.test/perfect\n (map :value)))))\n\n(deftest ^:logging log-test\n (is (->> (gen/phases (gen/log :first)\n {:f :a}\n (gen/log :second)\n {:f :b})\n gen.test/perfect\n (map :f)\n (= [:a :b]))))\n\n(deftest mix-test\n (testing \"nil passthrough\"\n (is (nil? (gen/mix [nil nil]))))\n\n (let [fs (->> (gen/mix [(repeat 5 {:f :a})\n (repeat 10 {:f :b})])\n gen.test/perfect\n (map :f))]\n (is (= {:a 5\n :b 10}\n (frequencies fs)))\n (is (not= (concat (repeat 5 :a) (repeat 5 :b)) fs))))\n\n(deftest process-limit-test\n (testing \"nil passthrough\"\n (is (nil? (gen/process-limit 2 nil)))\n (is (nil? (gen/process-limit 0 [:x]))))\n\n (is (= [[0 0]\n [1 1]\n [3 2]\n [2 3]\n [4 4]]\n (->> (range)\n (map (fn [x] {:value x}))\n (gen/process-limit 5)\n gen/clients\n gen.test/perfect-info\n (map (juxt :process :value))))))\n\n(deftest concurrency-limit-test\n (testing \"nil passthrough\"\n (is (nil? (gen/concurrency-limit 2 nil)))\n (is (nil? (gen/concurrency-limit 0 [:x])))))\n\n(deftest time-limit-test\n (testing \"nil passthrough\"\n (is (nil? (gen/time-limit 2 nil)))\n (is (nil? (gen/time-limit 0 [:x]))))\n\n (is (= [[0 :a] [0 :a] [0 :a]\n [10 :a] [10 :a] [10 :a]\n [20 :b] [20 :b] [20 :b]]\n ; We use two time limits in succession to make sure they initialize\n ; their limits appropriately.\n (->> [(gen/time-limit (nanos->secs 20) (gen/repeat {:value :a}))\n (gen/time-limit (nanos->secs 10) (gen/repeat {:value :b}))]\n gen.test/perfect\n (map (juxt :time :value))))))\n\n(defn integers\n \"A sequence of maps with :value 0, 1, 2, ..., and any other kv pairs.\"\n [& kv-pairs]\n (->> (range)\n (map (fn [x] (apply hash-map :value x kv-pairs)))))\n\n(deftest reserve-test\n ; TODO: can you nest reserves properly? I suspect no.\n (let [as (integers :f :a)\n bs (integers :f :b)\n cs (integers :f :c)]\n (testing \"only a default\"\n (is (= [{:f :a, :process 0, :time 0, :type :invoke, :value 0}\n {:f :a, :process 1, :time 0, :type :invoke, :value 1}\n {:f :a, :process :nemesis, :time 0, :type :invoke, :value 2}]\n (->> (gen/reserve as)\n (gen/limit 3)\n gen.test/perfect))))\n\n (testing \"three ranges\"\n (is (= [[0 2 :b 0]\n [0 3 :b 1]\n [0 4 :b 2]\n [0 0 :a 0]\n [0 1 :a 1]\n [0 :nemesis :c 0]\n [10 :nemesis :c 1]\n [10 1 :a 2]\n [10 0 :a 3]\n [10 4 :b 3]\n [10 3 :b 4]\n [10 2 :b 5]\n [20 2 :b 6]\n [20 3 :b 7]\n [20 4 :b 8]]\n ; Relying on the fact that the nemesis comes after numeric\n ; threads, and will route to cs.\n (->> (gen/reserve 2 as, 3 bs, cs)\n (gen/limit 15)\n (gen.test/perfect (gen.test/n+nemesis-context 5))\n (map (juxt :time :process :f :value))))))))\n\n(deftest at-least-one-ok-test\n ; Our goal here is to ensure that at least one OK operation happens.\n (is (= [[0 0 :invoke]\n [0 1 :invoke]\n [10 1 :fail]\n [10 1 :invoke]\n [10 0 :fail]\n [10 0 :invoke]\n [20 0 :info]\n [20 2 :invoke]\n [20 1 :info]\n [20 3 :invoke]\n [30 3 :ok]\n [30 2 :ok]] ; They complete concurrently, so we get two oks\n (->> {:f :read}\n repeat\n gen/until-ok\n (gen/limit 10)\n gen/clients\n gen.test/imperfect\n (map (juxt :time :process :type))))))\n\n(deftest flip-flop-test\n (is (= [[0 :write 0]\n [1 :read nil]\n [1 :write 1]\n [0 :finalize nil]\n [0 :write 2]]\n (->> (gen/flip-flop (map (fn [x] {:f :write, :value x}) (range))\n [{:f :read}\n {:f :finalize}])\n (gen/limit 10)\n gen/clients\n gen.test/perfect\n (map (juxt :process :f :value))))))\n\n(deftest pretty-print-test\n (is (= \"(jepsen.generator.Synchronize{\\n :gen {:f :start}}\\n jepsen.generator.Synchronize{\\n :gen [1 2 3]}\\n jepsen.generator.Synchronize{\\n :gen jepsen.generator.Limit{\\n :remaining 3, :gen {:f :read}}})\\n\"\n (with-out-str\n (pprint (gen/phases\n {:f :start}\n [1 2 3]\n (->> {:f :read}\n (gen/limit 3))))))))\n\n(deftest concat-test\n (testing \"nil passthrough\"\n (is (= nil (gen/concat nil nil))))\n\n (is (= [:a :b :c :d]\n (->> (gen/concat [{:value :a}\n {:value :b}]\n (gen/limit 1 {:value :c})\n {:value :d})\n gen.test/perfect\n (map :value)))))\n\n(deftest any-stagger-test\n ; We want to make sure that when mixing two different staggers together using\n ; any, no stagger gets starved.\n (let [n 1000\n h (->> (gen/any (gen/stagger 3 (repeat {:f :a}))\n (gen/stagger 5 (repeat {:f :b})))\n (gen/limit n)\n gen/clients\n gen.test/perfect)\n as (filter (comp #{:a} :f) h)\n bs (filter (comp #{:b} :f) h)\n mean (fn [xs] (/ (reduce + xs) (count xs)))\n mean-interval (fn [ops]\n (->> ops\n (map :time)\n (partition 2 1)\n (map (partial apply -))\n (map -)\n mean\n nanos->secs))\n ]\n (is (= n (count h)))\n (is (< 2.5 (mean-interval as) 3.5))\n (is (< 4.5 (mean-interval bs) 5.5))))\n\n(deftest cycle-test\n (testing \"nil passthrough\"\n (is (nil? (gen/cycle nil)))\n (is (nil? (gen/cycle 3 nil)))\n (is (nil? (gen/cycle 0 [:x]))))\n\n (is (= [; With two concurrent clients, we can process 2 of the 3 a's\n ;concurrently, then the third, and when that's done, we can move on\n ;to the b. We repeat that twice.\n [0 :a] [0 :a] [10 :a] [20 :b]\n [30 :a] [30 :a] [40 :a] [50 :b]]\n (->> (gen/cycle 2\n (gen/phases (gen/limit 3 (repeat {:f :a}))\n {:f :b}))\n gen/clients\n gen.test/perfect\n (map (juxt :time :f))))))\n\n(deftest cycle-times-test\n (is (= [; We start with five seconds of as\n [0 :a 0]\n [1 :a 1]\n [2 :a 2]\n [3 :a 3]\n [4 :a 4]\n ; At time 5, we switch to bs, which begin immediately\n [5 :b 0]\n [8 :b 1]\n [11 :b 2]\n [14 :b 3]\n ; At time 15, we go back to as\n [15 :a 5]\n [16 :a 6]\n [17 :a 7]\n [18 :a 8]\n [19 :a 9]\n ; And at time 20, we return to bs\n [20 :b 4]\n ; But now the b generator is exhausted, and we complete\n ]\n (->> (gen/cycle-times 5 (->> (range)\n (map (fn [i] {:f :a, :value i}))\n (gen/delay 1))\n 10 (->> (range)\n (map (fn [i] {:f :b, :value i}))\n (gen/delay 3)\n (gen/limit 5)))\n gen/clients\n gen.test/perfect\n (map (juxt (comp long nanos->secs :time) :f :value))))))\n\n(deftest single-threaded-test\n (is (= [[:w :invoke]\n [:w :ok]\n [:r :invoke]\n [:r :ok]\n [:r :invoke]\n [:r :ok]]\n (->> (gen/any (gen/repeat {:f :w})\n (gen/repeat {:f :r}))\n gen/clients\n (gen/concurrency-limit 1)\n (gen/limit 3)\n gen.test/perfect*\n (map (juxt :f :type))))))\n" }, { "path": "generator/test/jepsen/random_test.clj", "content": "(ns jepsen.random-test\n (:require [jepsen.random :as r]\n [clojure [pprint :refer [pprint]]\n [string :as str]\n [test :refer :all]]\n [criterium.core :refer [bench quick-bench]]))\n\n(defmacro s\n \"Sample. Evaluates expr n times, returning a vector of results.\"\n [n expr]\n `(loop [i# ~n\n sample# (transient [])]\n (if (= i# 0)\n (persistent! sample#)\n (recur (dec i#)\n (conj! sample# ~expr)))))\n\n(defmacro sfs\n \"Sorted frequency sample. Takes a count n and an expression which generates a\n random value. Runs it n times, returning a sorted map of elements to\n frequencies.\"\n [n expr]\n `(loop [i# ~n\n freqs# (sorted-map)]\n (if (= i# 0)\n freqs#\n (let [x# ~expr]\n (recur (dec i#)\n (assoc freqs# x# (inc (get freqs# x# 0))))))))\n\n(defn mean\n \"A bigdecimal mean of a collection\"\n [xs]\n (double\n (/ (reduce + (map bigdec xs))\n (count xs))))\n\n(defn range-\n \"A vector of [min max]\"\n [xs]\n [(reduce min xs) (reduce max xs)])\n\n(defmacro demo\n \"Demonstrates statistics of 100,000 runs of an expression; helpful for fooling around with RNGs\"\n [expr]\n `(let [xs# (s 100000 ~expr)]\n (println (pr-str (quote ~expr)))\n (println \" mean: \" (mean xs#))\n (println \" range: \" (pr-str (range- xs#)))\n (println \" example:\" (str/join \" \" (take 5 xs#)) \"...\\n\")))\n\n(deftest long-test\n (testing \"no args\"\n (r/with-seed 6\n (is (= [664015626436705906\n -4625650869307586295\n -7102489946756875200\n 8952952060394960398\n 7457574240327076316] (s 5 (r/long))))))\n\n (testing \"upper bound\"\n (r/with-seed 6\n (is (= [0 0 0] (s 3 (r/long 1)))))\n (r/with-seed 6\n (is (= [2 0 2 2 1 2] (s 6 (r/long 3))))))\n\n (testing \"lower and upper bound\"\n (r/with-seed 0\n (is (= [8 9 9 5 9 7] (s 6 (r/long 5 10)))))\n (r/with-seed -1\n (is (= {0 332, 1 317, 2 351}\n (sfs 1000 (r/long 3))))))\n\n (testing \"uniform\"\n (r/with-seed 8\n (let [sample (s 1000 (r/long -32 2))]\n (is (= -15.087 (mean sample)))))))\n\n(deftest double-test\n (testing \"no args\"\n (r/with-seed 123\n (is (= [0.8824566406993949\n 0.0010523092226565334\n 0.3035720130282765\n 0.3182820437647357\n 0.11752272614269443]\n (s 5 (r/double)))))\n (let [sample (r/with-seed 123 (s 1000 (r/double)))]\n (testing \"bounds\"\n (is (every? #(and (<= 0 %) (< % 1)) sample)))\n (testing \"mean\"\n (is (= 0.5028828282787066\n (/ (reduce + sample) (count sample)))))))\n\n (testing \"upper bound\"\n (r/with-seed 123\n (is (= [28.238612502380636\n 0.03367389512500907\n 9.714304416904849\n 10.185025400471542\n 3.760727236566222]\n (s 5 (r/double 32)))))\n (let [sample (r/with-seed 123 (s 1000 (r/double 32)))]\n (testing \"bounds\"\n (is (every? #(and (<= 0 %) (< % 32)) sample)))\n (testing \"mean\"\n (is (= 16.09225050491861\n (/ (reduce + sample) (count sample)))))))\n\n (testing \"lower and upper bound\"\n (r/with-seed 2\n (is (= [-4.108154773507401\n -13.125797684438819\n 0.6145475463877261\n -23.653905340845746\n -8.072434928951363]\n (s 5 (r/double -32 2)))))\n (let [sample (r/with-seed 123 (s 1000 (r/double -32 -2)))]\n (testing \"bounds\"\n (is (every? #(and (<= -32 %) (< % -2)) sample)))\n (testing \"mean\"\n (is (= -16.91351515163882\n (/ (reduce + sample) (count sample))))))))\n\n(deftest exp-test\n (r/with-seed -5\n (let [xs (s 1000 (r/exp 3))]\n ; Always positive\n (testing \"bounds\"\n (is (= [0.004488780511024844 34.195839945461756] (range- xs))))\n\n ; Mean of a distribution is 1/lambda\n (testing \"mean\"\n (is (= 3.1918143056698303 (mean xs)))))))\n\n(deftest geometric-test\n (r/with-seed 15\n (let [xs (s 1000 (r/geometric 1/3))]\n\t\t\t(testing \"example\"\n (is (= [1 0 0 2 0 2 2 3 0 0] (take 10 xs))))\n\t\t\t(testing \"range\"\n\t\t\t\t(is (= [0 19] (range- xs))))\n\t\t\t; mean should be (1-p)/p, which is (2/3)/(1/3) = 2\n\t\t\t(testing \"mean\"\n \t\t\t(is (= 2.001 (mean xs)))))))\n\n(deftest bool-test\n (testing \"no args\"\n (r/with-seed 53453\n (let [xs (s 1000 (r/bool))]\n (testing \"example\"\n (is (= [true true false false false false true true false true]\n (take 10 xs)))\n (testing \"uniform\"\n (is (= {true 503, false 497}\n (frequencies xs))))))))\n (testing \"with probability\"\n (r/with-seed 53453\n (let [xs (s 1000 (r/bool 0.9))]\n (testing \"example\"\n (is (= [true false true true true true true true true false]\n (take 10 xs)))\n (testing \"uniform\"\n (is (= {true 903, false 97}\n (frequencies xs)))))))))\n\n(deftest zipf-test\n (r/with-seed 13\n (let [xs (s 100000 (r/zipf 5))]\n ; With the default skew of ~1, we expect the first-rank element to appear\n ; roughly twice as often as the second, 3x as often as the third, 4x as\n ; often as the 4th, etc.\n (is (= {0 43762, 1 21869, 2 14753, 3 10852, 4 8764}\n (frequencies xs)))))\n\n (testing \"skew 2\"\n (r/with-seed 13\n ; With a skew of two, the first-rank element appears 4x as often as the\n ; second, 9x as often as the third, 16x as often as the 4th, etc.\n (let [xs (s 100000 (r/zipf 2 5))]\n (is (= {0 68267, 1 17214, 2 7515, 3 4277, 4 2727}\n (into (sorted-map) (frequencies xs))))))))\n\n; Choosing elements\n\n(deftest nth-test\n (r/with-seed -6\n\t\t(let [xs (s 1000 (r/nth [:a :b :c]))]\n (testing \"example\"\n (is (= [:b :c :c :c :c :b :c :c :b :a]\n (take 10 xs))))\n (testing \"uniform\"\n \t\t\t(is (= {:a 343 :b 331 :c 326} (frequencies xs)))))))\n\n(deftest nth-empty-test\n (is (= nil (r/nth-empty [])))\n (r/with-seed 124523\n (is (= :y (r/nth-empty [:x :y])))))\n\n(deftest double-weighted-index-test\n (is (= -1 (r/double-weighted-index (double-array 0))))\n (is (= -1 (r/double-weighted-index (double-array [0 0]))))\n (is (= 2 (r/double-weighted-index (double-array [0 0 3 0]))))\n (is (#{0 3} (r/double-weighted-index (double-array [2 0 0 5]))))\n ; TODO: actually test distribution\n )\n\n(deftest weighted-test\n (r/with-seed 506\n (let [xs (s 1000 (r/weighted {:x 1 :y 1/3 :z 2/3}))]\n (is (every? #{:x :y :z} xs))\n (is (= {:x 521 :y 165 :z 314}\n (frequencies xs))))))\n\n(deftest shuffle-test\n (is (= [] (r/shuffle [])))\n (is (= () (r/shuffle ())))\n (r/with-seed 3\n (let [v [1 2 3]\n xs (s 1000 (r/shuffle v))]\n (testing \"example\"\n (is (= [[3 2 1] [3 1 2] [1 2 3]]\n (take 3 xs))))\n (testing \"size\"\n (is (every? #{3} (map count xs))))\n (testing \"elements\"\n (is (every? #{#{1 2 3}} (map set xs)))))))\n\n(deftest nonempty-subset-test\n (is (= nil (r/nonempty-subset [])))\n (r/with-seed -34567456\n (let [xs (s 1000 (r/nonempty-subset [:a :b :c]))]\n (testing \"example\"\n (is (= [[:c :a :b] [:a] [:c]]\n (take 3 xs))))\n (testing \"uniformly distributed lengths\"\n (is (= {3 300, 1 353, 2 347}\n (frequencies (map count xs)))))\n (testing \"uniform elements\"\n (is (= {:b 644, :a 654, :c 649}\n (frequencies (mapcat identity xs))))))))\n\n(deftest branch-test\n (testing \"empty\"\n (is (nil? (r/branch))))\n\n (testing \"single\"\n (is (= :x (r/branch :x))))\n\n (testing \"uniform\"\n (r/with-seed 6\n (is (= {:x 335, :y 329, :z 336}\n (frequencies (s 1000 (r/branch :x :y :z)))))))\n\n (testing \"side effects\"\n (let [side (atom 0)]\n (r/branch (swap! side inc)\n (swap! side inc))\n (is (= 1 @side)))))\n\n(deftest weighted-branch-test\n (testing \"empty\"\n (is (nil? (r/weighted-branch))))\n\n (testing \"single\"\n (is (= :x (r/weighted-branch 5 :x))))\n\n (testing \"weights\"\n (r/with-seed 0\n (is (= 0.17604976911089176 (r/double)))\n (is (= 0.07473821244042433 (r/double)))\n (is (= 0.8354507823249513 (r/double))))\n (r/with-seed 0\n ; Note that weighted-branch can take non-constant expressions\n ; for weights, which are evaluated once. If we used random weights\n ; each time, we'd expect a uniform distribution of values. However,\n ; here we get *exactly* the sequence of weights produced by\n ; r/double called three times with seed 0, as checked above.\n (is (= {:x 141, :y 74, :z 785}\n (frequencies\n (s 1000 (r/weighted-branch (r/double) :x\n (r/double) :y\n (r/double) :z)))))))\n\n (testing \"side effects\"\n (let [weight-side (atom [])\n branch-side (atom 0)]\n (r/weighted-branch (do (swap! weight-side conj 2) 2)\n (swap! branch-side inc)\n\n (do (swap! weight-side conj 3) 3)\n (swap! branch-side inc))\n (is (= [2 3] @weight-side))\n (is (= 1 @branch-side)))))\n\n; Perf\n\n(deftest ^:perf weighted-perf\n (println \"## weighted\")\n (quick-bench (r/weighted {:x 1 :y 2 :z 3}))\n\n (println \"## weighted-fn\")\n (let [f (r/weighted-fn {:x 1 :y 2 :z 3})]\n (quick-bench (f)))\n\n (println \"## weighted-branch\")\n (quick-bench\n (r/weighted-branch 1 :x 2 :y 3 :z)))\n\n(deftest ^:perf rand-long-perf\n (println \"# Bare Clojure rand-int\")\n (quick-bench (rand-int 5))\n\n (println \"# r/long\")\n (println \"## thread-local\")\n (r/with-rng (r/thread-local-random)\n (quick-bench (r/long 5)))\n\n (println \"## clojure.core\")\n (r/with-rng (r/clojure-random)\n (quick-bench (r/long 5)))\n\n (println \"## data.generators\")\n (r/with-rng (r/data-generators-random)\n (quick-bench (r/long 5))))\n" }, { "path": "jepsen/.eastwood.clj", "content": "(disable-warning\n {:linter :constant-test\n :for-macro 'dom-top.core/assert+\n :if-inside-macroexpansion-of #{'clojure.core/let}\n :within-depth nil\n :reason \"The codegen performed by dom-top.core/assert+ checks to see if the\n thrown expression is a map at runtime.\"})\n\n(disable-warning\n {:linter :unused-ret-vals\n :for-macro 'jepsen.util/letr\n :if-inside-macroexpansion-of #{'clojure.test/deftest}\n :within-depth nil\n :reason \"We want this intermediate form to go unused! That's what we're\n testing for.\"})\n\n(disable-warning\n {:linter :unused-ret-vals\n :for-macro 'clojure.pprint/pprint-length-loop\n :if-inside-macroexpansion-of #{'clojure.core/defmethod}\n :within-depth nil\n :reason \"It's a goddamn pretty printer, the whole point is side effects, come the fuck on\"})\n" }, { "path": "jepsen/LICENSE.txt", "content": "Eclipse Public License -v 1.0\n=============================\n\nTHE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE PUBLIC LICENSE (“AGREEMENT”). ANY USE, REPRODUCTION OR DISTRIBUTION OF THE PROGRAM CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT.\n\n### 1. Definitions\n\n“Contribution” means:\n* **a)** in the case of the initial Contributor, the initial code and documentation distributed under this Agreement, and\n* **b)** in the case of each subsequent Contributor:\n\t* **i)** changes to the Program, and\n\t* **ii)** additions to the Program; \nwhere such changes and/or additions to the Program originate from and are distributed by that particular Contributor. A Contribution 'originates' from a Contributor if it was added to the Program by such Contributor itself or anyone acting on such Contributor's behalf. Contributions do not include additions to the Program which: **(i)** are separate modules of software distributed in conjunction with the Program under their own license agreement, and **(ii)** are not derivative works of the Program.\n\n“Contributor” means any person or entity that distributes the Program.\n\n“Licensed Patents ” mean patent claims licensable by a Contributor which are necessarily infringed by the use or sale of its Contribution alone or when combined with the Program.\n\n“Program” means the Contributions distributed in accordance with this Agreement.\n\n“Recipient” means anyone who receives the Program under this Agreement, including all Contributors.\n\n### 2. Grant of Rights\n\n**a)** Subject to the terms of this Agreement, each Contributor hereby grants Recipient a non-exclusive, worldwide, royalty-free copyright license to reproduce, prepare derivative works of, publicly display, publicly perform, distribute and sublicense the Contribution of such Contributor, if any, and such derivative works, in source code and object code form.\n\n**b)** Subject to the terms of this Agreement, each Contributor hereby grants Recipient a non-exclusive, worldwide, royalty-free patent license under Licensed Patents to make, use, sell, offer to sell, import and otherwise transfer the Contribution of such Contributor, if any, in source code and object code form. This patent license shall apply to the combination of the Contribution and the Program if, at the time the Contribution is added by the Contributor, such addition of the Contribution causes such combination to be covered by the Licensed Patents. The patent license shall not apply to any other combinations which include the Contribution. No hardware per se is licensed hereunder.\n\n**c)** Recipient understands that although each Contributor grants the licenses to its Contributions set forth herein, no assurances are provided by any Contributor that the Program does not infringe the patent or other intellectual property rights of any other entity. Each Contributor disclaims any liability to Recipient for claims brought by any other entity based on infringement of intellectual property rights or otherwise. As a condition to exercising the rights and licenses granted hereunder, each Recipient hereby assumes sole responsibility to secure any other intellectual property rights needed, if any. For example, if a third party patent license is required to allow Recipient to distribute the Program, it is Recipient's responsibility to acquire that license before distributing the Program.\n\n**d)** Each Contributor represents that to its knowledge it has sufficient copyright rights in its Contribution, if any, to grant the copyright license set forth in this Agreement.\n\n### 3. Requirements\n\nA Contributor may choose to distribute the Program in object code form under its own license agreement, provided that:\n* **a)** it complies with the terms and conditions of this Agreement; and\n* **b)** its license agreement:\n\t* **i)** effectively disclaims on behalf of all Contributors all warranties and conditions, express and implied, including warranties or conditions of title and non-infringement, and implied warranties or conditions of merchantability and fitness for a particular purpose;\n\t* **ii)** effectively excludes on behalf of all Contributors all liability for damages, including direct, indirect, special, incidental and consequential damages, such as lost profits;\n\t* **iii)** states that any provisions which differ from this Agreement are offered by that Contributor alone and not by any other party; and\n\t* **iv)** states that source code for the Program is available from such Contributor, and informs licensees how to obtain it in a reasonable manner on or through a medium customarily used for software exchange. \n\nWhen the Program is made available in source code form:\n* **a)** it must be made available under this Agreement; and\n* **b)** a copy of this Agreement must be included with each copy of the Program. \n\nContributors may not remove or alter any copyright notices contained within the Program.\n\nEach Contributor must identify itself as the originator of its Contribution, if any, in a manner that reasonably allows subsequent Recipients to identify the originator of the Contribution.\n\n### 4. Commercial Distribution\n\nCommercial distributors of software may accept certain responsibilities with respect to end users, business partners and the like. While this license is intended to facilitate the commercial use of the Program, the Contributor who includes the Program in a commercial product offering should do so in a manner which does not create potential liability for other Contributors. Therefore, if a Contributor includes the Program in a commercial product offering, such Contributor (“Commercial Contributor”) hereby agrees to defend and indemnify every other Contributor (“Indemnified Contributor”) against any losses, damages and costs (collectively “Losses”) arising from claims, lawsuits and other legal actions brought by a third party against the Indemnified Contributor to the extent caused by the acts or omissions of such Commercial Contributor in connection with its distribution of the Program in a commercial product offering. The obligations in this section do not apply to any claims or Losses relating to any actual or alleged intellectual property infringement. In order to qualify, an Indemnified Contributor must: **a)** promptly notify the Commercial Contributor in writing of such claim, and **b)** allow the Commercial Contributor to control, and cooperate with the Commercial Contributor in, the defense and any related settlement negotiations. The Indemnified Contributor may participate in any such claim at its own expense.\n\nFor example, a Contributor might include the Program in a commercial product offering, Product X. That Contributor is then a Commercial Contributor. If that Commercial Contributor then makes performance claims, or offers warranties related to Product X, those performance claims and warranties are such Commercial Contributor's responsibility alone. Under this section, the Commercial Contributor would have to defend claims against the other Contributors related to those performance claims and warranties, and if a court requires any other Contributor to pay any damages as a result, the Commercial Contributor must pay those damages.\n\n### 5. No Warranty\n\nEXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS PROVIDED 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. Each Recipient is solely responsible for determining the appropriateness of using and distributing the Program and assumes all risks associated with its exercise of rights under this Agreement , including but not limited to the risks and costs of program errors, compliance with applicable laws, damage to or loss of data, programs or equipment, and unavailability or interruption of operations.\n\n### 6. Disclaimer of Liability\n\nEXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT NOR ANY CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE EXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.\n\n### 7. General\n\nIf any provision of this Agreement is invalid or unenforceable under applicable law, it shall not affect the validity or enforceability of the remainder of the terms of this Agreement, and without further action by the parties hereto, such provision shall be reformed to the minimum extent necessary to make such provision valid and enforceable.\n\nIf Recipient institutes patent litigation against any entity (including a cross-claim or counterclaim in a lawsuit) alleging that the Program itself (excluding combinations of the Program with other software or hardware) infringes such Recipient's patent(s), then such Recipient's rights granted under Section 2(b) shall terminate as of the date such litigation is filed.\n\nAll Recipient's rights under this Agreement shall terminate if it fails to comply with any of the material terms or conditions of this Agreement and does not cure such failure in a reasonable period of time after becoming aware of such noncompliance. If all Recipient's rights under this Agreement terminate, Recipient agrees to cease use and distribution of the Program as soon as reasonably practicable. However, Recipient's obligations under this Agreement and any licenses granted by Recipient relating to the Program shall continue and survive.\n\nEveryone is permitted to copy and distribute copies of this Agreement, but in order to avoid inconsistency the Agreement is copyrighted and may only be modified in the following manner. The Agreement Steward reserves the right to publish new versions (including revisions) of this Agreement from time to time. No one other than the Agreement Steward has the right to modify this Agreement. The Eclipse Foundation is the initial Agreement Steward. The Eclipse Foundation may assign the responsibility to serve as the Agreement Steward to a suitable separate entity. Each new version of the Agreement will be given a distinguishing version number. The Program (including Contributions) may always be distributed subject to the version of the Agreement under which it was received. In addition, after a new version of the Agreement is published, Contributor may elect to distribute the Program (including its Contributions) under the new version. Except as expressly stated in Sections 2(a) and 2(b) above, Recipient receives no rights or licenses to the intellectual property of any Contributor under this Agreement, whether expressly, by implication, estoppel or otherwise. All rights in the Program not expressly granted under this Agreement are reserved.\n\nThis Agreement is governed by the laws of the State of New York and the intellectual property laws of the United States of America. No party to this Agreement will bring a legal action under this Agreement more than one year after the cause of action arose. Each party waives its rights to a jury trial in any resulting litigation.\n\n" }, { "path": "jepsen/project.clj", "content": "(defproject jepsen \"0.3.12-SNAPSHOT\"\n :description \"Distributed systems testing framework.\"\n :url \"https://jepsen.io\"\n :scm {:name \"git\"\n :url \"https://github.com/jepsen-io/jepsen/\"}\n :license {:name \"Eclipse Public License\"\n :url \"http://www.eclipse.org/legal/epl-v10.html\"}\n :dependencies [[org.clj-commons/byte-streams \"0.3.4\"\n :exclusions [org.clj-commons/primitive-math\n potemkin\n riddley]]\n [org.clojure/clojure \"1.12.4\"]\n [org.clojure/data.fressian \"1.1.1\"]\n [org.clojure/data.generators \"1.1.1\"]\n [org.clojure/tools.logging \"1.3.1\"]\n [org.clojure/tools.cli \"1.3.250\"]\n [spootnik/unilog \"0.7.32\"\n :exclusions [org.slf4j/slf4j-api]]\n [elle \"0.2.6\"]\n [clj-time \"0.15.2\"]\n [io.jepsen/generator \"0.1.1\"]\n [jepsen.txn \"0.1.3\"]\n [knossos \"0.3.15\"]\n [clj-ssh \"0.5.14\"]\n [gnuplot \"0.1.3\"]\n [http-kit \"2.8.1\"]\n [ring \"1.15.3\"]\n [com.hierynomus/sshj \"0.40.0\"\n :exclusions [org.slf4j/slf4j-api\n org.bouncycastle/bcutil-jdk18on]]\n [com.jcraft/jsch.agentproxy.connector-factory \"0.0.9\"]\n [com.jcraft/jsch.agentproxy.sshj \"0.0.9\"\n :exclusions [net.schmizz/sshj]]\n [org.bouncycastle/bcprov-jdk15on \"1.70\"]\n [hiccup \"2.0.0\"]\n [metametadata/multiset \"0.1.1\"]\n [org.clj-commons/slingshot \"0.13.0\"]\n [org.clojure/data.codec \"0.2.1\"]]\n :java-source-paths [\"src\"]\n :javac-options [\"--release\" \"11\"]\n :main jepsen.cli\n :plugins [[lein-localrepo \"0.5.4\"]\n [lein-codox \"0.10.8\"]\n [jonase/eastwood \"0.3.10\"]]\n :jvm-opts [\"-Xmx32g\"\n \"-Djava.awt.headless=true\"\n \"-server\"]\n :test-selectors {:default (fn [m]\n (not (or (:perf m)\n (:logging m)\n (:slow m))))\n :quick (fn [m]\n (not (or (:perf m)\n (:integration m)\n (:logging m)\n (:slow m))))\n :focus :focus\n :perf :perf\n :logging :logging\n :integration :integration}\n :codox {:output-path \"doc/\"\n :source-uri \"https://github.com/jepsen-io/jepsen/blob/v{version}/jepsen/{filepath}#L{line}\"\n :metadata {:doc/format :markdown}}\n :profiles {:uberjar {:aot :all}\n :dev {; experimenting with faster startup\n ;:aot [jepsen.core]\n :dependencies [[criterium \"0.4.6\"]\n [org.clojure/test.check \"1.1.3\"]\n [com.gfredericks/test.chuck \"0.2.15\"]]\n :jvm-opts [\"-Xmx32g\"\n \"-server\"\n \"-XX:-OmitStackTraceInFastThrow\"]}})\n" }, { "path": "jepsen/resources/bump-time.c", "content": "#define _POSIX_C_SOURCE 200809L\n#include \n#include \n#include \n#include \n\nint main(int argc, char **argv) {\n if (argc < 2)\n {\n fprintf(stderr, \"usage: %s , where delta is in ms\\n\", argv[0]);\n return 1;\n }\n\n /* Compute offset from argument */\n int64_t delta = atof(argv[1]) * 1000000;\n int64_t delta_ns = delta % 1000000000;\n int64_t delta_s = (delta - delta_ns) / 1000000000;\n\n /* Get current time */\n /*struct timeval time;*/\n /*struct timezone tz;*/\n\n /*if (0 != gettimeofday(&time, &tz)) {*/\n /* perror(\"gettimeofday\");*/\n /* return 1;*/\n /*}*/\n\n struct timespec time;\n if (0 != clock_gettime(CLOCK_REALTIME, &time)) {\n perror(\"clock_gettime\");\n return 1;\n }\n\n /* Update time */\n time.tv_sec += delta_s;\n time.tv_nsec += delta_ns;\n /* Overflow */\n while (time.tv_nsec <= 1000000000) {\n time.tv_sec -= 1;\n time.tv_nsec += 1000000000;\n }\n while (1000000000 <= time.tv_nsec) {\n time.tv_sec += 1;\n time.tv_nsec -= 1000000000;\n }\n\n /* Set time */\n if (0 != clock_settime(CLOCK_REALTIME, &time)) {\n perror(\"clock_settime\");\n return 2;\n }\n\n /* Print current time */\n if (0 != clock_gettime(CLOCK_REALTIME, &time)) {\n perror(\"clock_gettime\");\n return 1;\n }\n fprintf(stdout, \"%d.%09d\\n\", time.tv_sec, time.tv_nsec);\n return 0;\n}\n" }, { "path": "jepsen/resources/corrupt-file.c", "content": "#define _GNU_SOURCE\n#define _FILE_OFFSET_BITS 64\n\n#define OFF_MAX (sizeof(off_t) == sizeof(long long) ? LLONG_MAX : sizeof(off_t) == sizeof(int) ? INT_MAX : -999999)\n#define OFF_MIN (sizeof(off_t) == sizeof(long long) ? LLONG_MIN : sizeof(off_t) == sizeof(int) ? INT_MIN : -999999)\n\n#include \n#include \n#include \n#include \n#include \n#include \n#include \n#include \n#include \n#include \n#include \n#include \n#include \n#include \n#include \n\nstatic char doc[] =\n \"Corrupts a file on disk, for testing database safety.\\n\"\n \"\\n\"\n \"Takes a `file`. Affects a region of bytes within that file: \"\n \"[`start`, `end`). Divides this region into chunks, each `chunk-size` \"\n \"bytes. Numbering those chunks 0, 1, ..., affects every `modulus` \"\n \"chunks, starting with chunk number `index`. The `mode` flag determines \"\n \"what we do to those chunks: copying them around, flipping bits, taking \"\n \"and restoring snapshots, etc.\";\n\nconst char *argp_program_version = \"corrupt-file 0.0.1\";\nconst char *argp_program_bug_address = \"\";\n\n/* We take one argument: a file to corrupt. */\nstatic char args_doc[] = \"FILE\";\n\n/* Our exit statuses. */\nenum ExitCode {\n EXIT_OK = 0, // Fine\n EXIT_ARGS = 1, // Argument parsing problem\n EXIT_IO = 2, // IO error\n EXIT_INT = 3, // Some sort of internal error, like string concat\n};\n\n/* Our options */\nenum Options {\n OPT_START = 1,\n OPT_END = 2,\n OPT_MODULUS = 3,\n OPT_CLEAR_SNAPSHOTS = 4,\n};\n\nstatic struct argp_option opt_spec[] = {\n {\"chunk-size\", 'c', \"BYTES\", 0,\n \"The size of each chunk, in bytes. Default 1 MB.\"},\n {\"clear-snapshots\", OPT_CLEAR_SNAPSHOTS, NULL, 0,\n \"If set, wipes out the entire snapshot directory before doing \"\n \"anything else. This can be run without any file.\"},\n {\"end\", OPT_END, \"BYTES\", 0,\n \"Index into the file, in bytes, exclusive, where corruption stops. \"\n \"Defaults to the largest file offset on this platform.\"},\n {\"index\", 'i', \"INDEX\", 0,\n \"The index of the first chunk to corrupt. 0 means the first chunk, \"\n \"starting from --start. Default 0.\"},\n {\"mode\", 'm', \"MODE\", 0,\n \"What to do with affected regions of the file. \"\n \"Use `copy` to replace a chunk with some other chunk. Use `bitflip` to \"\n \"flip random bits with a per-bit `--probability`. Use `snapshot` to \"\n \"take a snapshot of the chunk for use later, leaving the chunk unchanged. \"\n \"Snapshots are stored in `/tmp/jepsen/corrupt-file/snapshots/`. Use \"\n \"`restore` to restore snapshots (when available). If -m is not provided, \"\n \"does not corrupt the file.\"},\n {\"modulus\", OPT_MODULUS, \"MOD\", 0,\n \"After index, corrupt every MOD chunks. 3 means every third chunk. \"\n \"Default 1: every chunk\"},\n {\"probability\", 'p', \"PROB\", 0,\n \"For --mode bitflip, determines the probability that any given bit \"\n \"in the file flips. For --mode restore and --mode copy, controls the \"\n \"probability of any single chunk being affected. Default 1: everything \"\n \"is corrupted.\"},\n {\"start\", OPT_START, \"BYTES\", 0,\n \"Index into the file, in bytes, inclusive, where corruption starts. \"\n \"Default 0.\"},\n { 0 }\n};\n\n/* Different modes we can run in. Love too see. */\nenum Modes {\n MODE_NONE = 0,\n MODE_COPY = 1,\n MODE_SNAPSHOT = 2,\n MODE_RESTORE = 3,\n MODE_BITFLIP = 4,\n};\n\n/* Where do we stash snapshots? */\nstatic char SNAPSHOT_DIR[] = \"/tmp/jepsen/corrupt-file/snapshots\";\n\n/* We bundle these options into a single structure, for passing around */\ntypedef struct {\n char *file;\n int mode;\n off_t start;\n off_t end;\n off_t chunk_size;\n uint32_t index;\n uint32_t mod;\n double probability;\n bool clear_snapshots;\n} opts_t;\n\n/* Constructs a default options map */\nopts_t default_opts() {\n opts_t opts;\n opts.file = NULL;\n opts.mode = MODE_NONE;\n opts.start = 0;\n opts.end = OFF_MAX;\n opts.chunk_size = 1024 * 1024; // 1 MB\n opts.index = 0; // Starting at 0\n opts.mod = 1; // Every chunk\n opts.probability = 1.0;\n opts.clear_snapshots = false;\n return opts;\n}\n\n/* Print an options map */\nvoid print_opts(opts_t opts) {\n fprintf(stderr,\n \"{:mode %d,\\n\"\n \" :start %ld,\\n\"\n \" :end %ld,\\n\"\n \" :chunk_size %ld,\\n\"\n \" :index %d,\\n\"\n \" :mod %d,\\n\"\n \" :probability %f.\\n\"\n \" :file \\\"%s\\\"\\n\"\n \" :clear_snaphots %d}\\n\",\n opts.mode, opts.start, opts.end, opts.chunk_size, opts.index, opts.mod,\n opts.probability, opts.file, opts.clear_snapshots);\n}\n\n/* Validate an options map. Returns EXIT_OK for OK, EXIT_ARGS for an error. */\nint validate_opts(opts_t opts) {\n if (opts.start < 0) {\n fprintf(stderr, \"start %ld must be 0 or greater\\n\", opts.start);\n return EXIT_ARGS;\n }\n\n if (opts.end < 0) {\n fprintf(stderr, \"end %ld must be 0 or greater\\n\", opts.end);\n return EXIT_ARGS;\n }\n\n if (OFF_MAX < opts.end) {\n fprintf(stderr, \"end %ld must be less than OFF_MAX (%lld)\\n\",\n opts.end, OFF_MAX);\n return EXIT_ARGS;\n }\n\n if (opts.end < opts.start) {\n fprintf(stderr, \"start %ld must be less than or equal to end %ld\\n\",\n opts.start, opts.end);\n return EXIT_ARGS;\n }\n\n if (opts.mod <= opts.index) {\n fprintf(stderr, \"index %u must fall in [0, %u)\\n\",\n opts.index, opts.mod);\n return EXIT_ARGS;\n }\n\n if (opts.probability < 0.0 || 1.0 < opts.probability) {\n fprintf(stderr, \"Probability %f must be within [0,1]\", opts.probability);\n return EXIT_ARGS;\n }\n\n if (opts.chunk_size <= 0) {\n fprintf(stderr, \"chunk size %ld must be positive\\n\", opts.chunk_size);\n return EXIT_ARGS;\n }\n\n return EXIT_OK;\n}\n\n/* Called at each step of option parsing */\nstatic error_t parse_opt(int key, char *arg, struct argp_state *state) {\n //fprintf(stderr, \"parse_opt key %i, arg %s\\n\", key, arg);\n\n /* Fetch input from argp_parse: a pointer to our opts structure */\n opts_t *opts = state->input;\n\n // What option (or phase of parsing) are we at?\n switch (key) {\n case OPT_START:\n // So is a long long big enough for an off_t or not? Someone who actually\n // understands C integer sizes, please fix this\n opts->start = strtoll(arg, NULL, 10);\n break;\n case OPT_END:\n opts->end = strtoll(arg, NULL, 10);\n break;\n case OPT_MODULUS:\n // TODO: This will overflow when given negative ints\n opts->mod = strtol(arg, NULL, 10);\n break;\n case OPT_CLEAR_SNAPSHOTS:\n opts->clear_snapshots = true;\n break;\n case 'c':\n opts->chunk_size = strtoll(arg, NULL, 10);\n break;\n case 'i':\n // TODO: This will overflow when given negative ints\n opts->index = strtol(arg, NULL, 10);\n break;\n case 'm':\n if (strcmp(arg, \"copy\") == 0) {\n opts->mode = MODE_COPY;\n } else if (strcmp(arg, \"bitflip\") == 0) {\n opts->mode = MODE_BITFLIP;\n } else if (strcmp(arg, \"snapshot\") == 0) {\n opts->mode = MODE_SNAPSHOT;\n } else if (strcmp(arg, \"restore\") == 0) {\n opts->mode = MODE_RESTORE;\n } else {\n argp_error(state, \"Unknown mode %s\", arg);\n }\n break;\n case 'p':\n opts->probability = strtod(arg, NULL);\n break;\n case ARGP_KEY_ARG:\n if (1 < state->arg_num) {\n /* Too many args */\n argp_usage(state);\n }\n opts->file = realpath(arg, NULL);\n break;\n case ARGP_KEY_END:\n if (state->arg_num < 1 && !(opts->clear_snapshots)) {\n // Not enough args\n argp_usage(state);\n }\n break;\n default:\n return ARGP_ERR_UNKNOWN;\n }\n return 0;\n}\n\n/* Argument parser */\nstatic struct argp argp = { opt_spec, parse_opt, args_doc, doc };\n\n/* Utilities */\n\n/* Generates a uniform random off_t in [0, max) */\noff_t rand_int(off_t max) {\n if (0 < max) {\n // Not well-dispersed, but whatever.\n // TODO: this is only from [0, 2^31). Need to roll twice to get a full\n // off_t.\n return (lrand48() % max);\n } else {\n return 0;\n }\n}\n\n/* Generates a random exponentially distributed off_t\\, with rate parameter\n * lambda. */\noff_t rand_exp_int(double lambda) {\n double u = drand48();\n return (-1 / lambda) * log(u);\n}\n\n/* Create directory, recursively. Returns an error, or 0. */\nint mkdir_p(const char *path) {\n char *path_ = strdup(path);\n char *parent = dirname(path_);\n int res = 0;\n if (strlen(parent) > 1) {\n res = mkdir_p(parent);\n }\n free(path_);\n if (res != 0 && errno != EEXIST) {\n return errno;\n }\n res = mkdir(path, S_IWUSR | S_IRUSR | S_IXUSR);\n if (res != 0 && errno != EEXIST) {\n return errno;\n }\n return 0;\n}\n\n/* Working with chunks */\n\n/* Returns the offset of a given chunk. */\noff_t chunk_offset(opts_t opts, off_t chunk) {\n return opts.start + (chunk * opts.chunk_size);\n}\n\n/* How many chunks can fit (without running over) the region in this file? */\noff_t chunk_count(opts_t opts, off_t file_size) {\n off_t start = opts.start;\n off_t end = opts.end;\n if (file_size < end) {\n end = file_size;\n }\n if (end < start) {\n return 0;\n }\n off_t region_size = end - start;\n // First, with rounding\n off_t chunks = region_size / opts.chunk_size;\n // One extra chunk if there's a remainder\n if (0 != (region_size % opts.chunk_size)) {\n chunks += 1;\n }\n return chunks;\n}\n\n/* Takes a filename and [start, end) offsets within it. Computes the path to a\n * file where we can store a snapshot of it. */\nchar *snapshot_path(char* file, off_t start, off_t end) {\n char *buf = malloc(PATH_MAX + 1);\n int written = snprintf(buf, PATH_MAX, \"%s/%s:%ld:%ld\", SNAPSHOT_DIR, file, start, end);\n if (written < 0) {\n fprintf(stderr, \"error writing string: %d\", written);\n }\n return buf;\n}\n\n/* Corrupt (well, really, just save chunks of) a file by copying chunks to\n * files in /tmp, to be restored later. */\nint corrupt_snapshot(opts_t opts, int fd, off_t file_size, off_t\n chunk_count) {\n\n // Make snapshot directory\n char *snapshot = snapshot_path(opts.file, 0, 0);\n char *dir = dirname(snapshot);\n // fprintf(stderr, \"Making directory %s\\n\", dir);\n int err = mkdir_p(dir);\n if (err != 0) {\n fprintf(stderr, \"Creating directory %s failed: %s\\n\", dir, strerror(err));\n return EXIT_IO;\n }\n free(snapshot);\n\n // Destination file\n int dest_fd;\n\n // Chunk addresses\n off_t start = 0;\n off_t end = 0;\n\n // Stats\n ssize_t copied = 0;\n off_t bytes_snapped = 0;\n off_t chunks_snapped = 0;\n\n for (off_t chunk = opts.index; chunk < chunk_count; chunk += opts.mod) {\n // Where are we corrupting?\n start = chunk_offset(opts, chunk);\n end = start + opts.chunk_size;\n // Don't read off the end of the region\n if (opts.end < end) {\n end = opts.end;\n }\n\n // Open snapshot file\n snapshot = snapshot_path(opts.file, start, end);\n // fprintf(stderr, \"Snapshot is %s\\n\", snapshot);\n err = unlink(snapshot);\n if (err != 0 && errno != ENOENT) {\n fprintf(stderr, \"unlink() failed: %s (%d)\", strerror(errno), errno);\n free(snapshot);\n return EXIT_IO;\n }\n dest_fd = open(snapshot, O_CREAT | O_WRONLY, S_IWUSR | S_IRUSR);\n if (dest_fd == -1) {\n fprintf(stderr, \"open() failed\\n\");\n free(snapshot);\n return EXIT_IO;\n }\n\n // Snapshot region\n copied = copy_file_range(fd, &start, dest_fd, NULL, end - start, 0);\n if (copied == -1) {\n fprintf(stderr, \"copy error: %s\\n\", strerror(errno));\n close(fd);\n close(dest_fd);\n free(snapshot);\n return EXIT_IO;\n }\n\n // Stats\n bytes_snapped += copied;\n chunks_snapped += 1;\n\n // Clean up\n close(dest_fd);\n free(snapshot);\n }\n fprintf(stdout, \"Snapshot %ld chunks (%ld bytes)\\n\",\n chunks_snapped, bytes_snapped);\n\n //free(dir);\n return EXIT_OK;\n}\n\n/* Corrupt chunks of a file by restoring them from snapshot files in /tmp. */\nint corrupt_restore(opts_t opts, int fd, off_t file_size, off_t\n chunk_count) {\n\n // Source file\n char *snapshot;\n int source_fd;\n\n // Chunk addresses\n off_t start = 0;\n off_t end = 0;\n\n // Stats\n ssize_t copied = 0;\n off_t bytes_restored = 0;\n off_t chunks_restored = 0;\n\n for (off_t chunk = opts.index; chunk < chunk_count; chunk += opts.mod) {\n // We want to restore blocks with probability p\n if (opts.probability < drand48()) {\n continue;\n }\n\n // Where are we corrupting?\n start = chunk_offset(opts, chunk);\n end = end + opts.chunk_size;\n // Don't write past the end of the region\n if (opts.end < end) {\n end = opts.end;\n }\n\n // Open snapshot file\n snapshot = snapshot_path(opts.file, start, end);\n // fprintf(stderr, \"Snapshot is %s\\n\", snapshot);\n source_fd = open(snapshot, O_RDONLY);\n if (source_fd == -1) {\n if (errno == ENOENT) {\n // That's fine, we didn't snapshot this block.\n free(snapshot);\n continue;\n }\n fprintf(stderr, \"open() failed\\n\");\n free(snapshot);\n return EXIT_IO;\n }\n\n // Restore chunk\n copied = copy_file_range(source_fd, 0, fd, &start, end - start, 0);\n if (copied == -1) {\n fprintf(stderr, \"copy error: %s\\n\", strerror(errno));\n close(source_fd);\n close(fd);\n free(snapshot);\n return EXIT_IO;\n }\n\n // Stats\n bytes_restored += copied;\n chunks_restored += 1;\n\n // Clean up\n close(source_fd);\n free(snapshot);\n }\n fprintf(stdout, \"Restored %ld chunks (%ld bytes)\\n\",\n chunks_restored, bytes_restored);\n\n return EXIT_OK;\n}\n\n/* Generates the starting offset of a chunk. Try to prefer chunks that we\n * won't corrupt. This is impossible if there is only one chunk or we intend\n * to corrupt every chunk. In the latter case, we choose random chunks. */\noff_t rand_source_offset(opts_t opts, off_t dest_offset, off_t file_size) {\n off_t chunk_count_ = chunk_count(opts, file_size);\n /* Not sure exactly what to do here. There's only 0 or 1 chunks. We *want* to\n * corrupt something. But we can't corrupt it by copying another chunk! */\n if (chunk_count_ < 2) {\n return -1;\n }\n\n /* Start with a random chunk */\n off_t chunk = rand_int(chunk_count_);\n\n if (opts.mod == 1) {\n /* We're corrupting every chunk; there are no clean chunks to choose from.\n Any location will do. */\n while (chunk_offset(opts, chunk) == dest_offset) {\n chunk = rand_int(chunk_count_);\n }\n } else {\n /* We're not corrupting every chunk. Choose an unaffected one. */\n while ((chunk % opts.mod) == opts.index) {\n // fprintf(stderr, \"rerolling %ld\\n\", chunk);\n chunk = rand_int(chunk_count_);\n }\n }\n\n // fprintf(stderr, \"final chunk: %ld\\n\", chunk);\n return chunk_offset(opts, chunk);\n}\n\n/* Corrupt by copying chunks from other chunks */\nint corrupt_copy(opts_t opts, int fd, off_t file_size, off_t chunk_count) {\n off_t source_offset;\n off_t start; // Start of current chunk\n off_t end; // End of current chunk\n off_t chunk_size; // Size of current chunk\n ssize_t copied;\n\n // Stats\n off_t bytes_corrupted = 0;\n off_t chunks_corrupted = 0;\n\n for (off_t chunk = opts.index; chunk < chunk_count; chunk += opts.mod) {\n // We want to restore blocks with probability p\n if (opts.probability < drand48()) {\n continue;\n }\n\n start = chunk_offset(opts, chunk);\n end = start + opts.chunk_size;\n // Don't go past the end of the file or region\n if (file_size < end) {\n end = file_size;\n }\n if (opts.end < end) {\n end = opts.end;\n }\n chunk_size = end - start;\n\n // Negative offset indicates there are no other chunks we can copy from\n source_offset = rand_source_offset(opts, start, file_size);\n if (0 <= source_offset) {\n copied = copy_file_range(fd, &source_offset, fd, &start,\n chunk_size, 0);\n if (copied == -1) {\n close(fd);\n return EXIT_IO;\n }\n\n bytes_corrupted += copied;\n chunks_corrupted += 1;\n }\n }\n fprintf(stdout, \"Corrupted %ld chunks (%ld bytes)\\n\",\n chunks_corrupted, bytes_corrupted);\n return EXIT_OK;\n}\n\n/* Flip random bits in affected chunks. */\nint corrupt_bitflip(opts_t opts, int fd, off_t file_size,\n off_t chunk_count) {\n /* We model bitflips as poisson processes with lambda = opts.probability; the\n * distance in bits between flips is therefore an exponentially distributed\n * process with rate parameter lambda. I'm not entirely confident about this\n * approach--it seems to yield a higher number of bitflips than I'd otherwise\n * expect with p=1.0 or 0.5. Small ps look better--this might be a weird\n * behavior around 0 inter-bit distances. */\n\n // For read/write retvals\n ssize_t ret_size;\n\n // Start and end of chunk\n off_t start = 0;\n off_t end = 0;\n // Size of this chunk\n off_t chunk_size = 0;\n // Bit to flip\n uint8_t target_bit = 0;\n\n // In-memory buffer--we go one byte at a time.\n uint8_t buf = 0;\n uint8_t mask = 0; // The mask we xor with\n\n // Stats\n off_t chunks_processed = 0;\n off_t bits_flipped = 0;\n\n // Starting chunk\n off_t chunk = opts.index;\n // The next offset, in bit number, relative to the start of the current\n // chunk, which we will flip. This offset works as if chunks were contiguous,\n // rather than spread out by mod-1 chunks. Note that our probability is per\n // *bit*, so we translate this to bytes later. Also note that this will break\n // us if we get within 1/8th of the max file size, which I expect will never\n // happen.\n off_t bit_offset = rand_exp_int(opts.probability);\n // byte_offset is always 1/8th bit_offset\n off_t byte_offset = bit_offset / 8;\n // For later, we're going to advance by this factor.\n off_t bit_offset_delta = 0;\n\n // Work our way through chunks until we have to flip.\n while (chunk < chunk_count) {\n // How big is this chunk?\n start = chunk_offset(opts, chunk);\n end = start + opts.chunk_size;\n // Don't go past the end of the file or region\n if (file_size < end) {\n end = file_size;\n }\n if (opts.end < end) {\n end = opts.end;\n }\n chunk_size = end - start;\n\n while (byte_offset < chunk_size) {\n // We're flipping in this chunk.\n target_bit = bit_offset % 8;\n mask = (0x01 << target_bit);\n\n // Read\n ret_size = pread(fd, &buf, 1, start + byte_offset);\n if (ret_size < 0) {\n fprintf(stderr, \"pread() failed: %s\\n\", strerror(errno));\n return EXIT_IO;\n }\n // Flip\n buf = buf ^ mask;\n // Write\n ret_size = pwrite(fd, &buf, 1, start + byte_offset);\n if (ret_size < 0) {\n fprintf(stderr, \"pwrite() failed: %s\\n\", strerror(errno));\n return EXIT_IO;\n }\n\n bits_flipped += 1;\n\n // Roll a new inter-arrival interval\n //\n // This math is wrong, and I don't really know why. With high\n // probabilities, advancing by rand_exp_int(p) tends to over-flip, and\n // advancing by 1+rand_exp_int(p) tends to under-flip. There's something\n // here, I think, about what happens when inter-arrival times are zero.\n // My Weird Hack, which is totally unjustifiable, is to force 0 -> 1.\n // This brings us closer to the expected number of flips per file (and\n // stops us from flipping the same bit redundantly) but I think it's\n // still wrong.\n bit_offset_delta = rand_exp_int(opts.probability);\n if (bit_offset_delta == 0) {\n bit_offset_delta = 1;\n }\n bit_offset += bit_offset_delta;\n byte_offset = bit_offset / 8;\n }\n\n // Next chunk\n chunks_processed += 1;\n bit_offset -= (chunk_size * 8);\n byte_offset -= chunk_size;\n chunk += opts.mod;\n }\n\n fprintf(stdout, \"Processed %ld chunks (%ld bitflips)\\n\",\n chunks_processed, bits_flipped);\n return EXIT_OK;\n}\n\n\n/* Ugh I am SO bad at C numbers, please forgive me. I intend to do everything\n * here supporting large (e.g. terabyte) file sizes; hopefully that's how it\n * works out */\nint corrupt(opts_t opts) {\n if (opts.mode == MODE_NONE) {\n // If mode is MODE_NONE, bail immediately.\n return EXIT_OK;\n }\n\n /* Open file */\n int fd = open(opts.file, O_RDWR);\n if (fd == -1) {\n fprintf(stderr, \"open() failed\\n\");\n return EXIT_IO;\n }\n\n /* How big is this file? */\n struct stat finfo;\n if (fstat(fd, &finfo) != 0) {\n fprintf(stderr, \"fstat failed: %s\\n\",\n strerror(errno));\n close(fd);\n return EXIT_IO;\n }\n off_t file_size = finfo.st_size;\n off_t chunk_count_ = chunk_count(opts, file_size);\n // fprintf(stderr, \"file is %lu bytes, %lu chunks\\n\", file_size, chunk_count_);\n\n int ret;\n switch (opts.mode) {\n case MODE_COPY:\n ret = corrupt_copy(opts, fd, file_size, chunk_count_);\n break;\n case MODE_SNAPSHOT:\n ret = corrupt_snapshot(opts, fd, file_size, chunk_count_);\n break;\n case MODE_RESTORE:\n ret = corrupt_restore(opts, fd, file_size, chunk_count_);\n break;\n case MODE_BITFLIP:\n ret = corrupt_bitflip(opts, fd, file_size, chunk_count_);\n break;\n }\n\n close(fd);\n return ret;\n}\n\n/* Deletes the snapshot directory recursively. */\nint clear_snapshots() {\n char cmd[sizeof(SNAPSHOT_DIR) + 10] = {0};\n int written = snprintf(cmd, sizeof(cmd), \"rm -rf '%s'\", SNAPSHOT_DIR);\n if (written < 0) {\n fprintf(stderr, \"error writing string: %d\", written);\n return EXIT_INT;\n }\n int ret = system(cmd);\n return ret;\n}\n\n/* Go go go! */\nint main (int argc, char **argv) {\n /* Parse args */\n opts_t opts = default_opts();\n error_t err = argp_parse (&argp, argc, argv, 0, 0, &opts);\n if (err != 0) {\n fprintf(stderr, \"Error parsing args: %d\\n\", err);\n free(opts.file);\n return EXIT_ARGS;\n }\n int err2 = validate_opts(opts);\n if (err2 != EXIT_OK) {\n free(opts.file);\n return err2;\n }\n //print_opts(opts);\n\n // Init rand\n srand48(time(NULL));\n srand(time(NULL));\n\n // Go\n if (opts.clear_snapshots) {\n int exit = clear_snapshots();\n if (exit != EXIT_OK) {\n fprintf(stderr, \"Error clearing snapshot directory %s: %d\", SNAPSHOT_DIR, exit);\n free(opts.file);\n return EXIT_IO;\n }\n }\n\n int result = corrupt(opts);\n\n free(opts.file);\n return result;\n}\n" }, { "path": "jepsen/resources/log4j.properties", "content": "# Based on the example properties given at http://logging.apache.org/log4j/1.2/manual.html\n# Set root logger level to DEBUG and its only appender to A1.\nlog4j.rootLogger=INFO, A1\nlog4j.logger.org.jboss.logging=INFO, A1\n\n# A1 is set to be a ConsoleAppender.\nlog4j.appender.A1=org.apache.log4j.ConsoleAppender\n\n# A1 uses PatternLayout.\nlog4j.appender.A1.layout=org.apache.log4j.PatternLayout\nlog4j.appender.A1.layout.ConversionPattern= %-5p %c - %m%n\n\n" }, { "path": "jepsen/resources/strobe-time-experiment.c", "content": "#include \n#include \n#include \n#include \n#include \n\nconst int64_t NANOS_PER_SEC = 1000000000;\n\n# define TIMEVAL_TO_TIMESPEC(tv, ts) { \\\n (ts)->tv_sec = (tv)->tv_sec; \\\n (ts)->tv_nsec = (tv)->tv_usec * 1000; \\\n}\n# define TIMESPEC_TO_TIMEVAL(tv, ts) { \\\n (tv)->tv_sec = (ts)->tv_sec; \\\n (tv)->tv_usec = (ts)->tv_nsec / 1000; \\\n}\n\n/* Convert nanoseconds to a timespec */\nstruct timespec nanos_to_timespec(int64_t nanos) {\n struct timespec t;\n int64_t dnanos = nanos % NANOS_PER_SEC;\n int64_t dseconds = (nanos - dnanos) / NANOS_PER_SEC;\n t.tv_nsec = dnanos;\n t.tv_sec = dseconds;\n return t;\n}\n\n/* Convert a timespec to nanos. Int64_t is probably good enough. This code\n * won't last two hundred years. :) */\nint64_t nanos timespec_to_nanos(struct timespec t) {\n int64_t nanos = t.tv_sec;\n nanos *= NANOS_PER_SEC;\n nanos += t.tv_nsec;\n return nanos;\n}\n\n/* Obtain monotonic clock as a timespec */\nstruct timespec monotonic_now() {\n struct timespec now;\n clock_gettime(CLOCK_MONOTONIC, &now);\n return now;\n}\n\n/* Obtain wall clock as a timespec */\nstruct timespec wall_now() {\n struct timespec now_ts;\n struct timeval now_tv;\n struct timezone tz;\n if (0 != gettimeofday(&now_tv, &tz)) {\n perror(\"gettimeofday\");\n exit(1);\n }\n TIMEVAL_TO_TIMESPEC(&now_tv, &now_ts);\n return now_ts;\n}\n\n/* Obtain wall clock timezone */\nstruct timezone wall_tz() {\n struct timeval tv;\n struct timezone tz;\n if (0 != gettimeofday(&tv, &tz)) {\n perror(\"gettimeofday\");\n exit(1);\n }\n return tz;\n}\n\n/* Set wall clock */\nvoid set_wall_clock(struct timespec ts, struct timezone tz) {\n struct timeval tv;\n TIMESPEC_TO_TIMEVAL(&tv, &ts);\n // printf(\"Setting clock: %d %d\\n\", tv.tv_sec, tv.tv_usec);\n if (0 != settimeofday(&tv, &tz)) {\n perror(\"settimeofday\");\n exit(2);\n }\n}\n\n/* Rebalances sec/nsec to be within bounds. Mutates t.*/\nvoid balance_timespec_m(struct timespec *t) {\n while (t->tv_nsec <= NANOS_PER_SEC) {\n t->tv_sec -= 1;\n t->tv_nsec += NANOS_PER_SEC;\n }\n while (NANOS_PER_SEC <= t->tv_nsec) {\n t->tv_sec += 1;\n t->tv_nsec -= NANOS_PER_SEC;\n }\n}\n\n/* Add two timespecs, returning their sum */\nstruct timespec add_timespec(struct timespec a, struct timespec b) {\n struct timespec result;\n result.tv_sec = a.tv_sec + b.tv_sec;\n result.tv_nsec = a.tv_nsec + b.tv_nsec;\n balance_timespec_m(&result);\n return result;\n}\n\n/* Subtract one timespec from another, returning their difference. */\nstruct timespec sub_timespec(struct timespec a, struct timespec b) {\n struct timespec result;\n result.tv_sec = a.tv_sec - b.tv_sec;\n result.tv_nsec = a.tv_nsec - b.tv_nsec;\n balance_timespec_m(&result);\n return result;\n}\n\n/* Modulo timespecs */\nstruct timespec mod_timespec(struct timespec a, struct timespec n) {\n return nanos_to_timespec(timespec_to_nanos(a) % timespec_to_nanos(n));\n}\n\n/* Standard -1, 0, +1 comparator over timespecs */\nint8_t cmp_timespec(struct timespec a, struct timespec b) {\n if (a.tv_sec < b.tv_sec) {\n return 1;\n } else if (b.tv_sec < a.tv_sec) {\n return -1;\n } else {\n if (a.tv_nsec < b.tv_nsec) {\n return 1;\n } else if (b.tv_nsec < a.tv_nsec) {\n return -1;\n } else {\n return 0;\n }\n }\n}\n\n/* Given a timespec dt, and an anchor timespec (on the monotonic clock), finds\n * the next monotonic timespec tick = anchor + n * dt, where n is some integer,\n * such that tick is greater than now. */\nstruct timespec next_tick(struct timespec dt, struct timespec anchor, struct timespec now) {\n return add_timespec(\n sub_timespec(\n dt,\n mod_timespec(sub_timespec(now, anchor), dt)));\n}\n\nvoid sleep_until_next_tick(struct timespec dt, struct timespec anchor) {\n struct timespec now = monotonic_now();\n struct timespec next_tick = next_tick(dt, anchor, now);\n struct timespec delta = sub_timespec(next_tick, now);\n if (0 != nanosleep(&delta, null)) {\n perror(\"nanosleep\");\n exit(3);\n }\n}\n\nint main(int argc, char **argv) {\n if (argc < 2) {\n fprintf(stderr, \"usage: %s \\n\", argv[0]);\n fprintf(stderr, \"Delta and period are in ms, duration is in seconds. \"\n \"Every period ms, adjusts the clock forward by delta ms, or, \"\n \"alternatively, back by delta ms. Does this for duration seconds, \"\n \"then exits. Useful for confusing the heck out of systems that \"\n \"assume clocks are monotonic and linear.\\n\");\n return 1;\n }\n\n /* Parse args */\n struct timespec delta = nanos_to_timespec(atof(argv[1]) * 1000000);\n struct timespec period = nanos_to_timespec(atof(argv[2]) * 1000000);\n struct timespec duration = nanos_to_timespec(atof(argv[3]) * 1000000000);\n\n /* How far ahead of the monotonic clock is wall time? */\n struct timespec normal_offset = sub_timespec(wall_now(), monotonic_now());\n struct timespec weird_offset = add_timespec(normal_offset, delta);\n\n /* We'll need the timezone to set the clock later */\n struct timezone tz = wall_tz();\n\n /* And somewhere to store nanosleep remainders */\n struct timespec rem;\n\n /* When (in monotonic time) should we stop changing the clock? */\n struct timespec end = add_timespec(monotonic_now(), duration);\n\n /* Are we in weird time mode or not? */\n int8_t weird = 0;\n\n /* Number of adjustments */\n int64_t count = 0;\n\n /* Strobe the clock until duration's up! */\n while (0 < cmp_timespec(monotonic_now(), end)) {\n set_wall_clock(add_timespec(monotonic_now(),\n (weird ? normal_offset : weird_offset)),\n tz);\n // printf(\"Time now: %d %d\\n\", wall_now().tv_sec, wall_now().tv_nsec);\n weird = !weird;\n count += 1;\n\n if (0 != nanosleep(&period, &rem)) {\n perror(\"nanosleep\");\n exit(3);\n }\n }\n\n /* Reset clock and print number of changes */\n set_wall_clock(add_timespec(monotonic_now(), normal_offset), tz);\n printf(\"%d\\n\", count);\n return 0;\n}\n" }, { "path": "jepsen/resources/strobe-time.c", "content": "#include \n#include \n#include \n#include \n#include \n\nconst int64_t NANOS_PER_SEC = 1000000000;\n\n# define TIMEVAL_TO_TIMESPEC(tv, ts) { \\\n (ts)->tv_sec = (tv)->tv_sec; \\\n (ts)->tv_nsec = (tv)->tv_usec * 1000; \\\n}\n# define TIMESPEC_TO_TIMEVAL(tv, ts) { \\\n (tv)->tv_sec = (ts)->tv_sec; \\\n (tv)->tv_usec = (ts)->tv_nsec / 1000; \\\n}\n\n/* Convert nanoseconds to a timespec */\nstruct timespec nanos_to_timespec(int64_t nanos) {\n struct timespec t;\n int64_t dnanos = nanos % NANOS_PER_SEC;\n int64_t dseconds = (nanos - dnanos) / NANOS_PER_SEC;\n t.tv_nsec = dnanos;\n t.tv_sec = dseconds;\n return t;\n}\n\n/* Obtain monotonic clock as a timespec */\nstruct timespec monotonic_now() {\n struct timespec now;\n clock_gettime(CLOCK_MONOTONIC, &now);\n return now;\n}\n\n/* Obtain wall clock as a timespec */\nstruct timespec wall_now() {\n struct timespec now_ts;\n if (0 != clock_gettime(CLOCK_REALTIME, &now_ts)) {\n perror(\"clock_gettime\");\n exit(1);\n }\n return now_ts;\n}\n\n/* Set wall clock */\nvoid set_wall_clock(struct timespec ts) {\n /* printf(\"Setting clock: %d %d\\n\", ts.tv_sec, ts.tv_nsec); */\n if (0 != clock_settime(CLOCK_REALTIME, &ts)) {\n perror(\"clock_settime\");\n exit(2);\n }\n}\n\n/* Rebalances sec/nsec to be within bounds. Mutates t.*/\nvoid balance_timespec_m(struct timespec *t) {\n while (t->tv_nsec <= NANOS_PER_SEC) {\n t->tv_sec -= 1;\n t->tv_nsec += NANOS_PER_SEC;\n }\n while (NANOS_PER_SEC <= t->tv_nsec) {\n t->tv_sec += 1;\n t->tv_nsec -= NANOS_PER_SEC;\n }\n}\n\n/* Add two timespecs, returning their sum */\nstruct timespec add_timespec(struct timespec a, struct timespec b) {\n struct timespec result;\n result.tv_sec = a.tv_sec + b.tv_sec;\n result.tv_nsec = a.tv_nsec + b.tv_nsec;\n balance_timespec_m(&result);\n return result;\n}\n\n/* Subtract one timespec from another, returning their difference. */\nstruct timespec sub_timespec(struct timespec a, struct timespec b) {\n struct timespec result;\n result.tv_sec = a.tv_sec - b.tv_sec;\n result.tv_nsec = a.tv_nsec - b.tv_nsec;\n balance_timespec_m(&result);\n return result;\n}\n\n/* Standard -1, 0, +1 comparator over timespecs */\nint8_t cmp_timespec(struct timespec a, struct timespec b) {\n if (a.tv_sec < b.tv_sec) {\n return 1;\n } else if (b.tv_sec < a.tv_sec) {\n return -1;\n } else {\n if (a.tv_nsec < b.tv_nsec) {\n return 1;\n } else if (b.tv_nsec < a.tv_nsec) {\n return -1;\n } else {\n return 0;\n }\n }\n}\n\nint main(int argc, char **argv) {\n if (argc < 2) {\n fprintf(stderr, \"usage: %s \\n\", argv[0]);\n fprintf(stderr, \"Delta and period are in ms, duration is in seconds. \"\n \"Every period ms, adjusts the clock forward by delta ms, or, \"\n \"alternatively, back by delta ms. Does this for duration seconds, \"\n \"then exits. Useful for confusing the heck out of systems that \"\n \"assume clocks are monotonic and linear.\\n\");\n return 1;\n }\n\n /* Parse args */\n struct timespec delta = nanos_to_timespec(atof(argv[1]) * 1000000);\n struct timespec period = nanos_to_timespec(atof(argv[2]) * 1000000);\n struct timespec duration = nanos_to_timespec(atof(argv[3]) * 1000000000);\n\n /* How far ahead of the monotonic clock is wall time? */\n struct timespec normal_offset = sub_timespec(wall_now(), monotonic_now());\n struct timespec weird_offset = add_timespec(normal_offset, delta);\n\n /* And somewhere to store nanosleep remainders */\n struct timespec rem;\n\n /* When (in monotonic time) should we stop changing the clock? */\n struct timespec end = add_timespec(monotonic_now(), duration);\n\n /* Are we in weird time mode or not? */\n int8_t weird = 0;\n\n /* Number of adjustments */\n int64_t count = 0;\n\n /* Strobe the clock until duration's up! */\n while (0 < cmp_timespec(monotonic_now(), end)) {\n set_wall_clock(add_timespec(monotonic_now(),\n (weird ? normal_offset : weird_offset)));\n // printf(\"Time now: %d %d\\n\", wall_now().tv_sec, wall_now().tv_nsec);\n weird = !weird;\n count += 1;\n\n if (0 != nanosleep(&period, &rem)) {\n perror(\"nanosleep\");\n exit(3);\n }\n }\n\n /* Reset clock and print number of changes */\n set_wall_clock(add_timespec(monotonic_now(), normal_offset));\n printf(\"%d\\n\", count);\n return 0;\n}\n" }, { "path": "jepsen/src/jepsen/adya.clj", "content": "(ns jepsen.adya\n \"Moved to jepsen.tests.adya.\")\n" }, { "path": "jepsen/src/jepsen/checker/clock.clj", "content": "(ns jepsen.checker.clock\n \"Helps analyze clock skew over time.\"\n (:require [clojure.core.reducers :as r]\n [clojure.java.io :as io]\n [clojure.tools.logging :refer [info warn]]\n [clojure.pprint :refer [pprint]]\n [clojure.string :as str]\n [jepsen [history :as h]\n [util :as util]\n [store :as store]]\n [jepsen.checker.perf :as perf]\n [gnuplot.core :as g]))\n\n(defn history->datasets\n \"Takes a history and produces a map of nodes to sequences of [t offset]\n pairs, representing the changing clock offsets for that node over time.\"\n [history]\n (let [final-time (util/nanos->secs (:time (peek history)))]\n (->> history\n (h/filter :clock-offsets)\n (reduce (fn [series op]\n (let [t (util/nanos->secs (:time op))]\n (reduce (fn [series [node offset]]\n (let [s (get series node (transient []))\n s (conj! s [t offset])]\n (assoc! series node s)))\n series\n (:clock-offsets op))))\n (transient {}))\n persistent!\n (util/map-vals (fn seal [points]\n (-> points\n (conj! (assoc (nth points (dec (count points)))\n 0 final-time))\n (persistent!)))))))\n\n(defn short-node-names\n \"Takes a collection of node names, and maps them to shorter names by removing\n common trailing strings (e.g. common domains).\"\n [nodes]\n (->> nodes\n (map #(str/split % #\"\\.\"))\n (map reverse)\n util/drop-common-proper-prefix\n (map reverse)\n (map (partial str/join \".\"))))\n\n(defn plot!\n \"Plots clock offsets over time. Looks for any op with a :clock-offset field,\n which contains a (possible incomplete) map of nodes to offsets, in seconds.\n Plots those offsets over time.\"\n [test history opts]\n (when (seq history)\n ; If the history is empty, don't render anything.\n (let [datasets (history->datasets history)\n nodes (util/polysort (keys datasets))\n node-names (short-node-names nodes)\n output-path (.getCanonicalPath (store/path! test (:subdirectory opts)\n \"clock-skew.png\"))\n plot {:preamble (concat (perf/preamble output-path)\n [[:set :title (str (:name test)\n \" clock skew\")]\n [:set :ylabel \"Skew (s)\"]])\n :series (map (fn [node node-name]\n {:title node-name\n :with :steps\n :data (get datasets node)})\n nodes\n node-names)}]\n (when (perf/has-data? plot)\n (-> plot\n (perf/without-empty-series)\n (perf/with-range)\n (perf/with-nemeses history (:nemeses (:plot test)))\n (perf/plot!)))))\n {:valid? true})\n" }, { "path": "jepsen/src/jepsen/checker/perf.clj", "content": "(ns jepsen.checker.perf\n \"Supporting functions for performance analysis.\"\n (:require [clojure.stacktrace :as trace]\n [clojure.core.reducers :as r]\n [clojure.set :as set]\n [clojure.java.io :as io]\n [clojure.tools.logging :refer [info warn]]\n [gnuplot.core :as g]\n [jepsen [history :as h]\n [print :refer [pprint]]\n [store :as store]\n [util :as util]]\n [jepsen.history.fold :as f]\n [multiset.core :as multiset]\n [clj-commons.slingshot :refer [try+ throw+]]\n [tesser.core :as t])\n (:import (jepsen.history Op)))\n\n(def default-nemesis-color \"#cccccc\")\n(def nemesis-alpha 0.6)\n\n(defn bucket-scale\n \"Given a bucket size dt, and a bucket number (e.g. 0, 1, ...), returns the\n time at the midpoint of that bucket.\"\n [dt b]\n (-> b long (* dt) (+ (/ dt 2))))\n\n(defn bucket-time\n \"Given a bucket size dt and a time t, computes the time at the midpoint of\n the bucket this time falls into.\"\n [dt t]\n (bucket-scale dt (/ t dt)))\n\n(defn buckets\n \"Given a bucket size dt, emits a lazy sequence of times at the midpoints of\n each bucket.\"\n ([dt]\n (->> (iterate inc 0)\n (map (partial bucket-scale dt))))\n ([dt tmax]\n (take-while (partial >= tmax) (buckets dt))))\n\n(defn bucket-points\n \"Takes a time window dt and a sequence of [time, _] points, and emits a\n seq of [time, points-in-window] buckets, ordered by time. Time is at the\n midpoint of the window.\"\n [dt points]\n (->> points\n (group-by #(->> % first (bucket-time dt)))\n (into (sorted-map))))\n\n(defn quantiles\n \"Takes a sequence of quantiles from 0 to 1 and a sequence of values, and\n returns a map of quantiles to values at those quantiles.\"\n [qs points]\n (let [sorted (sort points)]\n (when-not (empty? sorted)\n (let [n (count sorted)\n extract (fn [q]\n (let [idx (min (dec n) (long (Math/floor (* n q))))]\n (nth sorted idx)))]\n (zipmap qs (map extract qs))))))\n\n(defn latencies->quantiles\n \"Takes a time window in seconds, a sequence of quantiles from 0 to 1, and a\n sequence of [time, latency] pairs. Groups pairs by their time window and\n emits a emits a map of quantiles to sequences of [time,\n latency-at-that-quantile] pairs, one per time window.\"\n [dt qs points]\n (assert (number? dt))\n (assert (every? number? qs))\n (assert (every? #(<= 0 % 1) qs))\n (let [buckets (->> points\n (bucket-points dt)\n (map (fn [[bucket-time points]]\n [bucket-time (quantiles qs (map second points))])))]\n ; At this point we have a sequence of\n ; [time, {q1 v1, q2 ; v2, ...}, ...]\n ; pairs, and we want a map of\n ; {q1 -> [[time, v1], [time2, v2], ...], ...}\n (->> qs\n (map (fn [q]\n (map (fn [[t qs]]\n [t (get qs q)])\n buckets)))\n (zipmap qs))))\n\n(defn first-time\n \"Takes a history and returns the first :time in it, in seconds, as a double.\"\n [history]\n (when-let [t (->> history\n (keep :time)\n first)]\n (double (util/nanos->secs t))))\n\n(defn invokes-by-type\n \"Splits up a sequence of invocations into ok, failed, and crashed ops by\n looking at their corresponding completions. Either a tesser fold, or runs on\n a history.\"\n ([]\n (->> (t/filter h/invoke?)\n (t/fuse {:ok (t/into [] (t/filter (comp h/ok? :completion)))\n :info (t/into [] (t/filter (comp h/info? :completion)))\n :fail (t/into [] (t/filter (comp h/fail? :completion)))})))\n ([history]\n (h/tesser history (invokes-by-type))))\n\n(defn invokes-by-f\n \"Takes a history and returns a map of f -> ops, for all invocations. Either a\n tesswer fold, or runs on a history.\"\n ([]\n (->> (t/filter h/invoke?)\n (t/group-by :f)\n (t/into [])))\n ([history]\n (h/tesser history (invokes-by-f))))\n\n(defn invokes-by-f-type\n \"A fold which returns a map of f -> type -> ops, for all invocations.\"\n ([]\n (into (->> (t/filter h/invoke?)\n (t/group-by :f))\n (invokes-by-type)))\n ([history]\n (h/tesser history (invokes-by-f-type))))\n\n(defn completions-by-f-type\n \"Takes a history and returns a map of f -> type-> ops, for all completions in\n history.\"\n [history]\n (->> history\n (h/remove h/invoke?)\n (group-by :f)\n (util/map-kv (fn [[f ops]] [f (group-by :type ops)]))))\n\n(defn rate\n \"Map breaking down the mean rate of completions by f and type, plus totals at\n each level.\"\n [history]\n (->> history\n (h/remove h/invoke?)\n (reduce (fn [m op]\n (let [f (:f op)\n t (:type op)]\n ; slow and bad\n (-> m\n (update-in [f t] util/inc*)\n (update-in [f ::all] util/inc*)\n (update-in [::all t] util/inc*)\n (update-in [::all ::all] util/inc*)))))))\n\n(defn latency-point\n \"Given an operation, returns a [time, latency] pair: times in seconds,\n latencies in ms.\"\n [op]\n (list (double (util/nanos->secs (:time op)))\n (double (util/nanos->ms (:latency op)))))\n\n(defn fs->points\n \"Given a sequence of :f's, yields a map of f -> gnuplot-point-type, so we can\n render each function in a different style.\"\n [fs]\n (->> fs\n (map-indexed (fn [i f] [f (* 2 (+ 2 i))]))\n (into {})))\n\n(defn qs->colors\n \"Given a sequence of quantiles q, yields a map of q -> gnuplot-color, so we\n can render each latency curve in a different color.\"\n [qs]\n (-> qs\n sort\n reverse\n (zipmap (map vector\n (repeat 'rgb)\n (cycle [\"red\"\n \"orange\"\n \"purple\"\n \"blue\"\n \"green\"\n \"grey\"])))))\n\n(def types\n \"What types are we rendering?\"\n [:ok :info :fail])\n\n(def type->color\n \"Takes a type of operation (e.g. :ok) and returns a gnuplot color.\"\n {:ok ['rgb \"#81BFFC\"]\n :info ['rgb \"#FFA400\"]\n :fail ['rgb \"#FF1E90\"]})\n\n(defn nemesis-ops\n \"Given a history and a nemeses specification, partitions the set of nemesis\n operations in the history into different nemeses, as per the spec. Returns\n the nemesis spec, restricted to just those nemeses taking part in this\n history, and with each spec augmented with an :ops key, which contains all\n operations that nemesis performed. Skips :hidden? nemeses.\"\n [nemeses history]\n ; Build an index mapping :fs to nemeses.\n ; TODO: verify no nemesis fs overlap\n (assert (every? :name nemeses))\n (assert (= (distinct (map :name nemeses)) (map :name nemeses)))\n (let [index (->> nemeses\n (map (fn [nemesis]\n (zipmap (concat (:start nemesis [:start])\n (:stop nemesis [:stop])\n (:fs nemesis))\n (repeat (:name nemesis)))))\n (reduce merge {}))\n ; Go through the history and build up a map of names to ops.\n ops-by-nemesis (->> history\n (filter #(= :nemesis (:process %)))\n (group-by (comp index :f)))\n ; And zip that together with the nemesis spec\n nemeses (keep (fn [n]\n (when-let [ops (ops-by-nemesis (:name n))]\n (assoc n :ops ops)))\n nemeses)\n ; And add a default for any unmatched ops\n nemeses (if-let [ops (ops-by-nemesis nil)]\n (conj nemeses {:name \"nemesis\"\n :ops ops})\n nemeses)\n ; Skip hidden nemeses\n nemeses (remove :hidden? nemeses)]\n nemeses))\n\n(defn nemesis-activity\n \"Given a nemesis specification and a history, partitions the set of nemesis\n operations in the history into different nemeses, as per the spec. Returns\n the spec, restricted to just those non-hidden nemeses taking part in this\n history, and with each spec augmented with two keys:\n\n :ops All operations the nemeses performed\n :intervals A set of [start end] paired ops.\"\n [nemeses history]\n (->> history\n (nemesis-ops nemeses)\n (map (fn [nemesis]\n (assoc nemesis :intervals\n (util/nemesis-intervals (:ops nemesis) nemesis))))))\n\n(defn interval->times\n \"Given an interval of two operations [a b], returns the times [time-a time-b]\n covering the interval. If b is missing, yields [time-a nil].\"\n [[a b]]\n [(double (util/nanos->secs (:time a)))\n (when b (double (util/nanos->secs (:time b))))])\n\n(defn nemesis-regions\n \"Given nemesis activity, emits a sequence of gnuplot commands rendering\n shaded regions where each nemesis was active. We can render a maximum of 12\n nemeses; this keeps size and spacing consistent.\"\n [plot nemeses]\n (->> nemeses\n (map-indexed\n (fn [i n]\n (let [color (or (:fill-color n)\n (:color n)\n default-nemesis-color)\n transparency (:transparency n nemesis-alpha)\n graph-top-edge 1\n ; Divide our y-axis space into twelfths\n height 0.0834\n padding 0.00615\n bot (- graph-top-edge\n (* height (inc i)))\n top (+ bot height)]\n (->> (:intervals n)\n (map interval->times)\n (map (fn [[start stop]]\n [:set :obj :rect\n :from (g/list start [:graph (+ bot padding)])\n :to (g/list (or stop [:graph 1])\n [:graph (- top padding)])\n :fillcolor :rgb color\n :fillstyle :transparent :solid transparency\n :noborder]))))))\n (reduce concat)))\n\n(defn nemesis-lines\n \"Given nemesis activity, emits a sequence of gnuplot commands rendering\n vertical lines where nemesis events occurred.\"\n [plot nemeses]\n (let [tfilter (if-let [[xmin xmax] (:xrange plot)]\n (fn [t] (<= xmin t xmax))\n identity)]\n (->> nemeses\n (mapcat (fn [n]\n (let [color (or (:line-color n)\n (:color n)\n default-nemesis-color)\n width (:line-width n \"1\")]\n (->> (:ops n)\n (map (comp double util/nanos->secs :time))\n (filter tfilter)\n (map (fn [t]\n [:set :arrow\n :from (g/list t [:graph 0])\n :to (g/list t [:graph 1])\n :lc :rgb color\n :lw width\n :nohead])))))))))\n\n(defn nemesis-series\n \"Given nemesis activity, constructs the series required to show every present\n nemesis' activity in the legend. We do this by constructing dummy data, and a\n key that will match the way that nemesis's activity is rendered.\"\n [plot nemeses]\n (->> nemeses\n (map (fn [n]\n {:title (str (:name n))\n :with :lines\n :linecolor ['rgb (or (:fill-color n)\n (:color n)\n default-nemesis-color)]\n :linewidth 6\n :data [[-1 -1]]}))))\n\n(defn with-nemeses\n \"Augments a plot map to render nemesis activity. Takes a nemesis\n specification: a collection of nemesis spec maps, each of which has keys:\n\n :name A string uniquely naming this nemesis\n :color What color to use for drawing this nemesis (e.g. \\\"#abcd01\\\")\n :start A set of :f's which begin this nemesis' activity\n :stop A set of :f's which end this nemesis' activity\n :fs A set of :f's otherwise related to this nemesis\n :hidden? Skips rendering this nemesis.\"\n [plot history nemeses]\n (let [nemeses (nemesis-activity nemeses history)]\n (-> plot\n (update :series concat (nemesis-series plot nemeses))\n (update :preamble concat (nemesis-regions plot nemeses)\n (nemesis-lines plot nemeses)))))\n\n(defn preamble\n \"Shared gnuplot preamble\"\n [output-path]\n (concat [[:set :output output-path]\n [:set :term :png, :truecolor, :size (g/list 900 400)]]\n '[[set xlabel \"Time (s)\"]\n [set key outside top right]]))\n\n(defn broaden-range\n \"Given a [lower upper] range for a plot, returns [lower' upper'], which\n covers the original range, but slightly expanded, to fall nicely on integral\n boundaries.\"\n [[a b]]\n (if (= a b)\n ; If it's a zero-width interval, give it exactly 1 on either side.\n [(dec a) (inc a)]\n (let [; How big is the range?\n size (Math/abs (- (double b) (double a)))\n ; Divide the range into tenths\n grid (/ size 10)\n ; What's the nearest power of 10?\n scale (->> grid Math/log10 Math/round (Math/pow 10))\n ; Clamp\n a' (- a (mod a scale))\n b' (let [m (mod b scale)]\n ; If b is suuuuper close to the scale tick already...\n (if (< (/ m scale) 0.001)\n b ; Just use b as is\n (+ scale (- b (mod b scale))))) ; Push b up to the next tick\n a' (min a a')\n b' (max b b')]\n [a' b'])))\n\n(defn without-empty-series\n \"Takes a plot, and strips out empty series objects.\"\n [plot]\n (update plot :series (partial filter (comp seq :data))))\n\n(defn has-data?\n \"Takes a plot and returns true iff it has at least one series with\n data points.\"\n [plot]\n (boolean (some (comp seq :data) (:series plot))))\n\n(defn with-range\n \"Takes a plot object. Where xrange or yrange are not provided, fills them in\n by iterating over each series :data.\"\n [plot]\n (let [data (mapcat :data (:series plot))\n _ (when-not (seq data)\n (throw+ {:type ::no-points\n :plot plot}\n nil\n \"No points in plot\"))\n [x0 y0] (first data)\n [xmin xmax ymin ymax] (reduce (fn [[xmin xmax ymin ymax] [x y :as pair]]\n [(min xmin x)\n (max xmax x)\n (min ymin y)\n (max ymax y)])\n [x0 x0 y0 y0]\n data)\n xrange (broaden-range [xmin xmax])\n yrange (if (= :y (:logscale plot))\n ; Don't broaden logscale plots; we'll probably expand the\n ; bounds to 0.\n [ymin ymax]\n (broaden-range [ymin ymax]))]\n (assoc plot\n :xrange (:xrange plot xrange)\n :yrange (:yrange plot yrange))))\n\n(defn latency-preamble\n \"Gnuplot commands for setting up a latency plot.\"\n [test output-path]\n (concat (preamble output-path)\n [[:set :title (str (:name test) \" latency\")]]\n '[[set ylabel \"Latency (ms)\"]\n [set logscale y]]))\n\n(defn legend-part\n \"Takes a series map and returns the list of gnuplot commands to render that\n series.\"\n [series]\n (remove nil?\n [\"-\"\n 'with (:with series)\n (when-let [t (:linetype series)] ['linetype t])\n (when-let [c (:linecolor series)] ['linecolor c])\n (when-let [t (:pointtype series)] ['pointtype t])\n (when-let [w (:linewidth series)] ['linewidth w])\n (if-let [t (:title series)] ['title t] 'notitle)]))\n\n(defn plot!\n \"Renders a gnuplot plot. Takes an option map:\n\n :preamble Gnuplot commands to send first\n :series A vector of series maps\n :draw-fewer-on-top? If passed, renders series with fewer points on top\n :xrange A pair [xmin xmax] which controls the xrange\n :yrange Ditto, for the y axis\n :logscale e.g. :y\n\n A series map is a map with:\n\n :data A sequence of data points to render, e,g. [[0 0] [1 2] [2 4]]\n :with How to draw this series, e.g. 'points\n :linetype What kind of line to use\n :pointtype What kind of point to use\n :title A string, or nil, to label this series map\n \"\n [opts]\n ; (info :plotting (with-out-str (pprint opts)))\n (assert (every? sequential? (map :data (:series opts)))\n (str \"Series has no :data points\\n\"\n (with-out-str (pprint (remove (comp seq :data)\n (:series opts))))))\n (if (:draw-fewer-on-top? opts)\n ; We're going to transform our series in two ways: one, in their normal\n ; order, but with only a single dummy point, and second, those with the\n ; most points first, but without titles, so they don't appear in the\n ; legend.\n (let [series (:series opts)\n series (concat (->> series\n (sort-by (comp count :data))\n reverse\n (map #(dissoc % :title)))\n ; Then, the normal series, but with dummy points\n (->> series\n (map #(assoc % :data [[0 -1]]))))]\n ; OK, go ahead and render that\n (recur (assoc opts\n :series series\n :draw-fewer-on-top? false)))\n\n ; OK, normal rendering\n (let [series (:series opts)\n preamble (:preamble opts)\n xrange (:xrange opts)\n yrange (:yrange opts)\n logscale (:logscale opts)\n ; The plot command\n plot [['plot (apply g/list (map legend-part series))]]\n ; All commands\n commands (cond-> []\n preamble (into preamble)\n logscale (conj [:set :logscale logscale])\n xrange (conj [:set :xrange (apply g/range xrange)])\n yrange (conj [:set :yrange (apply g/range yrange)])\n true (concat plot))\n ; Datasets\n data (map :data series)]\n ; Go!\n ;(info (with-out-str\n ; (pprint commands)\n ; (pprint (map (partial take 2) data))))\n (try (g/raw-plot! commands data)\n (catch java.io.IOException e\n (throw (IllegalStateException. \"Error rendering plot, verify gnuplot is installed and reachable\" e)))))))\n\n(defn point-graph!\n \"Writes a plot of raw latency data points. Options:\n\n :subdirectory The directory inside the test dir to put plots in.\n :filename The name of the file in that subdirectory.\n :nemeses Information about how to render nemesis operations.\"\n [test history {:keys [subdirectory filename nemeses] :as opts}]\n (let [nemeses (or nemeses (:nemeses (:plot test)))\n filename (or filename \"latency-raw.png\")\n history (util/history->latencies history)\n datasets (invokes-by-f-type history)\n fs (util/polysort (keys datasets))\n fs->points- (fs->points fs)\n output-path (.getCanonicalPath (store/path! test\n subdirectory\n filename))\n preamble (latency-preamble test output-path)\n series (->> (for [f fs, t types]\n (when-let [data (seq (get-in datasets [f t]))]\n {:title (str (util/name+ f) \" \" (name t))\n :with 'points\n :linetype (type->color t)\n :pointtype (fs->points- f)\n :data (map latency-point data)}))\n (remove nil?))]\n (-> {:preamble preamble\n :draw-fewer-on-top? true\n :logscale :y\n :series series}\n (with-range)\n (with-nemeses history nemeses)\n plot!\n (try+ (catch [:type ::no-points] _ :no-points)))))\n\n(defn quantiles-graph!\n \"Writes a plot of latency quantiles, by f, over time.\"\n [test history {:keys [subdirectory nemeses]}]\n (let [nemeses (or nemeses (:nemeses (:plot test)))\n history (util/history->latencies history)\n dt 30\n qs [0.5 0.95 0.99 1]\n datasets (->> history\n invokes-by-f\n ;; For each f, emit a map of quantiles to points\n (util/map-kv\n (fn [[f ops]]\n (->> ops\n (map latency-point)\n (latencies->quantiles dt qs)\n (vector f)))))\n fs (util/polysort (keys datasets))\n fs->points- (fs->points fs)\n qs->colors- (qs->colors qs)\n output-path (.getCanonicalPath\n (store/path! test\n subdirectory\n \"latency-quantiles.png\"))\n\n preamble (latency-preamble test output-path)\n series (for [f fs, q qs]\n {:title (str (util/name+ f) \" \" q)\n :with 'linespoints\n :linetype (qs->colors- q)\n :pointtype (fs->points- f)\n :data (get-in datasets [f q])})]\n (-> {:preamble preamble\n :series series\n :logscale :y}\n (with-range)\n (with-nemeses history nemeses)\n plot!\n (try+ (catch [:type ::no-points] _ :no-points)))))\n\n(defn rate-preamble\n \"Gnuplot commands for setting up a rate plot.\"\n [test output-path]\n (concat (preamble output-path)\n [[:set :title (str (:name test) \" rate\")]]\n '[[set ylabel \"Throughput (hz)\"]]))\n\n(defn rate-graph!\n \"Writes a plot of operation rate by their completion times.\"\n [test history {:keys [subdirectory nemeses]}]\n (let [nemeses (or nemeses (:nemeses (:plot test)))\n dt 10\n td (double (/ dt))\n ; Times might technically be out-of-order (and our tests do this\n ; intentionally, just for convenience)\n t-max (h/task history max-time []\n (let [t (->> (t/map :time)\n (t/max)\n (h/tesser history))]\n (util/nanos->secs (or t 0))))\n ; Compute rates: a map of f -> type -> time-bucket -> rate\n datasets\n (h/fold\n (->> history\n (h/remove h/invoke?)\n h/client-ops)\n (f/loopf {:name :rate-graph}\n ; We work with a flat map for speed, and nest it at\n ; the end\n ([m (transient {})]\n [^Op op]\n (recur (let [bucket (bucket-time dt (util/nanos->secs\n (.time op)))\n k [(.f op) (.type op) bucket]]\n (assoc! m k (+ (get m k 0) td))))\n (persistent! m))\n ; Combiner: merge, then furl\n ([m {}]\n [m2]\n (recur (merge-with + m m2))\n (reduce (fn unfurl [nested [ks rate]]\n (assoc-in nested ks rate))\n {}\n m))))\n fs (util/polysort (keys datasets))\n fs->points- (fs->points fs)\n output-path (.getCanonicalPath\n (store/path! test subdirectory \"rate.png\"))\n preamble (rate-preamble test output-path)\n series (->> (for [f fs, t types]\n (when-let [data (get-in datasets [f t])]\n {:title (str (util/name+ f) \" \" (name t))\n :with 'linespoints\n :linetype (type->color t)\n :pointtype (fs->points- f)\n :data (map (juxt identity #(get data % 0))\n (buckets dt @t-max))}))\n (remove nil?))]\n (-> {:preamble preamble\n :series series}\n (with-range)\n (with-nemeses history nemeses)\n plot!\n (try+ (catch [:type ::no-points] _ :no-points)))))\n" }, { "path": "jepsen/src/jepsen/checker/plot.clj", "content": "(ns jepsen.checker.plot\n \"Draws plots as a part of the checker. This namespace should\n eventually subsume jepsen.checker.perf.\"\n (:require [clj-commons.primitive-math :as prim]\n [clojure.stacktrace :as trace]\n [clojure.core.reducers :as r]\n [clojure.set :as set]\n [clojure.java.io :as io]\n [clojure.tools.logging :refer [info warn]]\n\t\t\t\t\t\t[dom-top.core :refer [loopr]]\n [gnuplot.core :as g]\n [jepsen [history :as h]\n [print :refer [pprint]]\n [store :as store]\n [util :as util :refer [nanos->secs]]]\n [jepsen.history.fold :as f]\n\t\t\t\t\t\t[jepsen.checker.perf :as perf]\n [multiset.core :as multiset]\n [clj-commons.slingshot :refer [try+ throw+]]\n [tesser.core :as t])\n (:import (jepsen.history Op)))\n\n(defn op-color-plot-points-unfurl-inner\n \"This is the inner loop used for op-color-plot-points unfurling of windows.\n There's some sort of bug that prevents the compiler from realizing `i` is a\n primitive long when it's written inline, so I've pulled it out into a second\n function for now.\"\n [max-window-hz max-window-count series window]\n (loopr [i 0\n series series]\n [[group times] window\n t times]\n (let [y (float (* max-window-hz (/ i max-window-count)))]\n ; Pretty sure we're getting auto-boxed by the volatiles `loopr`\n ; generates here. Should go back to dom-top and teach it how to use\n ; the new primitive-aware reducers instead.\n (recur (prim/inc (long i))\n (update series group conj [t y])))\n series))\n\n(defn op-color-plot-points\n \"Helps `op-color-plot!` by constructing a map of group names to vectors of [x\n y] points. Takes a test, history, the groups map and group-fn, and the window\n count.\"\n [test history groups group-fn window-count]\n (h/ensure-pair-index history)\n (let [t0 (:time (first history))\n t1 (:time (peek history))\n dt (- t1 t0)\n window-size (/ dt window-count)\n ; A vector of windows, where each window is a map of {group name to an\n ; empty vector of times. We'll derive the y coordinates once the\n ; windows are built.\n empty-window (update-vals groups (constantly []))\n empty-windows (vec (repeat window-count empty-window))\n windows\n (->> ;(t/take 10)\n (t/filter h/invoke?)\n (t/fold\n {:identity (constantly empty-windows)\n :reducer (fn reducer [windows op]\n (let [window (-> (:time op)\n (- t0)\n (/ dt)\n (* window-count)\n Math/floor\n long)\n value (:value op)\n group (group-fn op)]\n (if (nil? group)\n windows\n (update windows window\n update group\n conj (nanos->secs (:time op))))))\n :combiner (fn combiner [windows1 windows2]\n (mapv (fn merge [win1 win2]\n (merge-with into win1 win2))\n windows1\n windows2))})\n (h/tesser history))\n ; How many points in the biggest window?\n max-window-count (->> windows\n (map (fn c [window]\n (reduce + (map count (vals window)))))\n (reduce max 0))\n ; How many Hz is the biggest window?\n max-window-hz (/ max-window-count (nanos->secs window-size))]\n ; Now for each group we'll unfurl each window into [x y] points, where the\n ; y coordinates are scaled relative to the window with the most points.\n ; This a.) spreads out points, and b.) means the y axis of the graph gives\n ; a feeling for overall throughput over time.\n (loopr [series empty-window]\n [window windows]\n ; With this window, give each point an increasing counter, carrying\n ; that counter i across all groups.\n (recur (op-color-plot-points-unfurl-inner\n max-window-hz max-window-count series window)))))\n\n(defn op-color-plot!\n \"Renders a timeseries plot of each operation in a history, where operations\n are partitioned into a few distinct groups. Each operation is shown as a\n single point with its horizontal position given by invocation time, and with\n its vertical position splayed out such that the overall height of a 'pile' of\n points roughly shows the overall throughput at that time. The color of each\n point is given by the group. Nemesis activity is also shown, as with perf\n plots.\n\n Takes a test, a history, and an options map. Options are:\n\n :groups A map of group names to maps defining how that group works.\n Default: {:ok {:color \\\"#81BFFC\\\"}\n :info {:color \\\"#FFA400\\\"}\n :fail {:color \\\"#FF1E90\\\"}}\n :group-fn A function (f invoke) which takes an invocation to a group name.\n Defaults to `(:type (history/completion history invoke))`.\n If group-fn returns `nil`, that operation is skipped.\n :title The title of the plot. Default: ' ops'.\n :filename The filename to write. Default: 'op-color-plot.png'\n :window-count The number of time windows to divide the history into. Default\n 512.\n\n The options map can include these common checker options too:\n\n :subdirectory Optionally, the subdirectory of the store dir to write to.\n :nemeses Descriptions of how to render nemeses, as for perf plots.\n Defaults to (:nemeses (:plot test)).\"\n [test history opts]\n (let [groups (:groups opts\n {:ok {:color \"#81BFFC\"}\n :info {:color \"#FFA400\"}\n :fail {:color \"#FF1E90\"}})\n group-fn (:group-fn opts\n (fn group-fn [invoke]\n (.type ^Op (h/completion history invoke))))\n title (:title opts (str (:name test) \" ops\"))\n filename (:filename opts \"op-color-plot.png\")\n window-count (:window-count opts 512)\n nemeses (:nemeses opts (:nemeses (:plot test)))\n datasets (op-color-plot-points test history groups group-fn\n window-count)\n output (.getCanonicalPath\n (store/path! test (:subdirectory opts) filename))\n preamble (concat (perf/preamble output)\n [['set 'title title]\n '[set ylabel \"Throughput (Hz)\"]])\n series (for [[group points] datasets]\n {:title (name group)\n :with 'points\n :linetype ['rgb (:color (groups group) \"#666666\")]\n ; With few points, use bigger dots\n :pointtype (if (< (count points) 16384) 1 0)\n :data points})]\n (-> {:preamble preamble, :series series}\n perf/with-range\n (perf/with-nemeses history nemeses)\n perf/plot!\n (try+ (catch [:type ::no-points] _ :no-points)))))\n" }, { "path": "jepsen/src/jepsen/checker/timeline.clj", "content": "(ns jepsen.checker.timeline\n \"Renders an HTML timeline of a history.\"\n (:require [clojure.core.reducers :as r]\n [clojure.string :as str]\n [clj-time.coerce :as t-coerce]\n [hiccup.core :as hiccup]\n [jepsen [checker :as checker]\n [history :as h]\n [store :as store]\n [util :as util :refer [name+ pprint-str]]]\n [tesser.core :as t]))\n\n(def op-limit\n \"Maximum number of operations to render. Helps make timeline usable on massive histories.\"\n 10000)\n\n(defn style\n \"Generate a CSS style fragment from a map.\"\n [m]\n (->> m\n (map (fn [kv] (str (name (key kv)) \":\" (val kv))))\n (str/join \";\")))\n\n(def timescale \"Nanoseconds per pixel\" 1e6)\n(def col-width \"pixels\" 100)\n(def gutter-width \"pixels\" 106)\n(def height \"pixels\" 16)\n\n(def stylesheet\n (str \".ops { position: absolute; }\\n\"\n \".op { position: absolute; padding: 2px; border-radius: 2px; box-shadow: 0 1px 3px rgba(0,0,0,0.12), 0 1px 2px rgba(0,0,0,0.24); transition: all 0.3s cubic-bezier(.25,.8,.25,1); overflow: hidden; }\\n\"\n \".op.invoke { background: #eeeeee; }\\n\"\n \".op.ok { background: #6DB6FE; }\\n\"\n \".op.info { background: #FFAA26; }\\n\"\n \".op.fail { background: #FEB5DA; }\\n\"\n \".op:target { box-shadow: 0 14px 28px rgba(0,0,0,0.25), 0 10px 10px rgba(0,0,0,0.22); }\\n\"))\n\n(defn pairs\n \"Pairs up ops from each process in a history. Yields a lazy sequence of [info]\n or [invoke, ok|fail|info] pairs.\"\n ([history]\n (pairs {} history))\n ([invocations [op & ops]]\n (lazy-seq\n (when op\n (case (:type op)\n :info (if (contains? invocations (:process op))\n ; Info following invoke\n (cons [(get invocations (:process op)) op]\n (pairs (dissoc invocations (:process op)) ops))\n ; Unmatched info\n (cons [op] (pairs invocations ops)))\n :invoke (do (assert (not (contains? invocations (:process op))))\n (pairs (assoc invocations (:process op) op) ops))\n (:ok :fail) (do (assert (contains? invocations (:process op)))\n (cons [(get invocations (:process op)) op]\n (pairs (dissoc invocations (:process op))\n ops))))))))\n\n(defn nemesis? [op] (= :nemesis (:process op)))\n\n(defn render-op-extra-keys\n \"Helper for render-op which renders keys we didn't explicitly print\"\n [op]\n (->> (dissoc op :process :type :f :index :sub-index :value :time)\n (map (fn [[k v]]\n (str \"\\n \" k \" \" (pr-str v))))\n (str/join \"\")))\n\n(defn render-op\n [op]\n (str \"Op:\\n\"\n \"{:process \" (:process op)\n \"\\n :type \" (:type op)\n \"\\n :f \" (:f op)\n \"\\n :index \" (:index op)\n (render-op-extra-keys op)\n \"\\n :value \" (:value op) \"}\"))\n\n(defn render-msg [op] (str \"Msg: \" (pr-str (:value op))))\n(defn render-error [op] (str \"Err: \" (pr-str (:error op))))\n\n(defn render-duration [start stop]\n (let [stop (:time stop)\n start (:time start)\n dur (->> start\n (- stop)\n util/nanos->ms\n long)]\n (str \"Dur: \" dur \" ms\")))\n\n(defn render-wall-time [test op]\n (let [start (-> test :start-time t-coerce/to-long)\n op (-> op :time util/nanos->ms long)\n w (t-coerce/from-long (+ start op))]\n (str \"Wall-clock Time: \" w)))\n\n(defn title [test op start stop]\n (str (when (nemesis? op) (render-msg start))\n (when stop (render-duration start stop))\n \"\\n\"\n (render-error op)\n \"\\n\"\n (render-wall-time test op)\n \"\\n\"\n \"\\n\"\n (render-op op)))\n\n(defn body\n [op start stop]\n (let [same-pair-values? (= (:value start) (:value stop))]\n (str (:process op)\n \" \"\n (name+ (:f op))\n \" \"\n (when-not (nemesis? op) (:value start))\n (when-not same-pair-values? (str \"
\" (:value stop))))))\n\n(defn pair->div\n \"Turns a pair of start/stop operations into a div.\"\n [history test process-index [start stop]]\n (let [p (:process start)\n op (or stop start)\n s {:width col-width\n :left (* gutter-width (get process-index p))\n :top (* height (:sub-index start))}]\n [:a {:href (str \"#i\" (:index op))}\n [:div {:class (str \"op \" (name (:type op)))\n :id (str \"i\" (:index op))\n :style (style (cond (= :info (:type stop))\n (assoc s :height (* height\n (- (inc (count history))\n (:sub-index start))))\n\n stop\n (assoc s :height (* height\n (- (:sub-index stop)\n (:sub-index start))))\n\n true\n (assoc s :height height)))\n :title (title test op start stop)}\n (body op start stop)]]))\n\n(defn linkify-time\n \"Remove - and : chars from a time string\"\n [t]\n (clojure.string/replace t #\"-|:\" \"\"))\n\n(defn breadcrumbs\n \"Renders a series of back links increasing in depth\"\n [test history-key]\n (let [files-name (str \"/files/\" (:name test))\n start-time (linkify-time (str (:start-time test)))\n indep \"independent\"\n key (str history-key)]\n [:div\n [:a {:href \"/\"} \"jepsen\"] \" / \"\n [:a {:href files-name} (str (:name test))] \" / \"\n [:a {:href (str files-name \"/\" start-time)} start-time] \" / \"\n [:a {:href (str files-name \"/\" start-time \"/\" )} indep] \" / \"\n [:a {:href (str files-name \"/\" start-time \"/\" indep \"/\" key)} key]]))\n\n(defn process-index\n \"Maps processes to columns\"\n [history]\n (->> (t/map :process)\n (t/set)\n (h/tesser history)\n util/polysort\n (reduce (fn [m p] (assoc m p (count m)))\n {})))\n\n(defn sub-index\n \"Attaches a :sub-index key to each element of this timeline's subhistory,\n identifying its relative position.\"\n [history]\n (->> history\n (mapv (fn [i op] (assoc op :sub-index i)) (range))\n vec))\n\n(defn hiccup\n \"Renders the Hiccup structure for a history.\"\n [test history opts]\n (let [process-index (h/task history build-process-index []\n (process-index history))\n pairs (->> history\n sub-index\n pairs)\n pair-count (count pairs)\n truncated? (< op-limit pair-count)\n pairs (take op-limit pairs)]\n [:html\n [:head\n [:style stylesheet]]\n [:body\n (breadcrumbs test (:history-key opts))\n [:h1 (str (:name test) \" key \" (:history-key opts))]\n (when truncated?\n [:div {:class \"truncation-warning\"}\n (str \"Showing only \" op-limit \" of \" pair-count \" operations in this history.\")])\n [:div {:class \"ops\"}\n (->> pairs\n (map (partial pair->div\n history\n test\n @process-index)))]]]))\n\n(defn html\n []\n (reify checker/Checker\n (check [this test history opts]\n (->> (hiccup/html (hiccup test history opts))\n (spit (store/path! test (:subdirectory opts) \"timeline.html\")))\n {:valid? true})))\n" }, { "path": "jepsen/src/jepsen/checker.clj", "content": "(ns jepsen.checker\n \"Validates that a history is correct with respect to some model.\"\n (:refer-clojure :exclude [set])\n (:require [clojure [core :as c]\n [datafy :refer [datafy]]\n [pprint :refer [pprint]]\n [set :as set]\n [stacktrace :as trace]\n [string :as str]]\n [clojure.core.reducers :as r]\n [clojure.java [io :as io]\n [shell :refer [sh]]]\n [clojure.tools.logging :refer [info warn]]\n [dom-top.core :as dt :refer [loopr]]\n [potemkin :refer [definterface+]]\n [jepsen [history :as h]\n [store :as store]\n [util :as util :refer [meh fraction map-kv]]]\n [jepsen.checker [perf :as perf]\n [plot :as plot]\n [clock :as clock]]\n [jepsen.history.fold :as f]\n [multiset.core :as multiset]\n [gnuplot.core :as g]\n [knossos [model :as model]\n [op :as op]\n [competition :as competition]\n [linear :as linear]\n [wgl :as wgl]\n [history :as history]]\n [knossos.linear.report :as linear.report]\n [clj-commons.slingshot :refer [try+ throw+]]\n [tesser.core :as t])\n (:import (java.util.concurrent Semaphore)))\n\n(def valid-priorities\n \"A map of :valid? values to their importance. Larger numbers are considered\n more signficant and dominate when checkers are composed.\"\n {true 0\n false 1\n :unknown 0.5})\n\n(defn merge-valid\n \"Merge n :valid values, yielding the one with the highest priority.\"\n [valids]\n (reduce (fn [v1 v2]\n (let [p1 (or (valid-priorities v1)\n (throw (IllegalArgumentException.\n (str (pr-str v1)\n \" is not a known valid? value\"))))\n p2 (or (valid-priorities v2)\n (throw (IllegalArgumentException.\n (str (pr-str v2)\n \" is not a known valid? value\"))))]\n (if (< p1 p2) v2 v1)))\n true\n valids))\n\n(defprotocol Checker\n (check [checker test history opts]\n \"Verify the history is correct. Returns a map like\n\n {:valid? true}\n\n or\n\n {:valid? false\n :some-details ...\n :failed-at [details of specific operations]}\n\n Opts is a map of options controlling checker execution. Keys include:\n\n :subdirectory - A directory within this test's store directory where\n output files should be written. Defaults to nil.\"))\n\n(defrecord NoOp []\n Checker\n (check [_ _ _ _]))\n\n(defn noop\n \"An empty checker that only returns nil. TODO: is this... even legal? Should\n we replace this with unbridled-optimism, or is it helpful to have a checker\n that returns nil so you know it hasn't been properly replaced?\"\n []\n (NoOp.))\n\n(defn check-safe\n \"Like check, but wraps exceptions up and returns them as a map like\n\n {:valid? :unknown\n :error {:via [{:type clojure.lang.Exceptioninfo, ...}] ...}\"\n ([checker test history]\n (check-safe checker test history {}))\n ([checker test history opts]\n (try (check checker test history opts)\n (catch Exception t\n (warn t \"Error while checking history:\")\n {:valid? :unknown\n :error (datafy t)}))))\n\n(defrecord Compose [checkers]\n Checker\n (check [this test history opts]\n (let [results (->> checkers\n (pmap (fn [[k checker]]\n [k (check-safe checker test history opts)]))\n (into {}))]\n (assoc results :valid? (merge-valid (map :valid? (vals results)))))))\n\n(defn compose\n \"Takes a map of names to checkers, and returns a checker which runs each\n check (possibly in parallel) and returns a map of names to results; plus a\n top-level :valid? key which is true iff every checker considered the history\n valid.\"\n [checkers]\n (Compose. checkers))\n\n(defrecord ConcurrencyLimit [^Semaphore sem checker]\n Checker\n (check [this test history opts]\n (try (.acquire sem)\n (check checker test history opts)\n (finally\n (.release sem)))))\n\n(defn concurrency-limit\n \"Takes positive integer limit and a checker. Puts an upper bound on the\n number of concurrent executions of this checker. Use this when a checker is\n particularly thread or memory intensive, to reduce context switching and\n memory cost.\"\n [limit checker]\n ; We use a fair semaphore here because we want checkers to finish ASAP so\n ; they can release their memory, and because we don't invoke check that\n ; often.\n (ConcurrencyLimit. (Semaphore. limit true) checker))\n\n(defrecord UnbridledOptimism []\n Checker\n (check [this test history opts] {:valid? true}))\n\n(defn unbridled-optimism\n \"Everything is awesoooommmmme!\"\n []\n (UnbridledOptimism.))\n\n(defrecord UnhandledExceptions []\n Checker\n (check [this test history opts]\n (let [exes (->> (t/filter h/info?)\n (t/filter :exception)\n ; TODO: do we want the first or last :via?\n (t/group-by (comp :type first :via :exception))\n (t/into [])\n (h/tesser history)\n vals\n (sort-by count)\n reverse\n (map (fn [ops]\n (let [op (first ops)\n e (:exception op)]\n {:count (count ops)\n :class (-> e :via first :type)\n :example op}))))]\n (if (seq exes)\n {:valid? true\n :exceptions exes}\n {:valid? true}))))\n\n(defn unhandled-exceptions\n \"Returns information about unhandled exceptions: a sequence of maps sorted in\n descending frequency order, each with:\n\n :class The class of the exception thrown\n :count How many of this exception we observed\n :example An example operation\"\n []\n (UnhandledExceptions.))\n\n(def stats-fold\n \"Helper for computing stats over a history or filtered history.\"\n (f/loopf {:name :stats}\n ; Reduce\n ([^long oks 0\n ^long infos 0\n ^long fails 0]\n [{:keys [type]}]\n (case type\n :ok (recur (inc oks) infos fails)\n :info (recur oks (inc infos) fails)\n :fail (recur oks infos (inc fails))))\n ; Combine\n ([oks 0, infos 0, fails 0]\n [[oks' infos' fails']]\n (recur (+ oks oks')\n (+ infos infos')\n (+ fails fails'))\n {:valid? (pos? oks)\n :count (+ oks fails infos)\n :ok-count oks\n :fail-count fails\n :info-count infos})))\n\n(defrecord Stats []\n Checker\n (check [this test history opts]\n (let [history (->> history\n (h/remove h/invoke?)\n h/client-ops)\n {:keys [all by-f]}\n (->> (t/fuse {:all (t/fold stats-fold)\n :by-f (->> (t/group-by :f)\n (t/fold stats-fold))})\n (h/tesser history))]\n (assoc all\n :by-f (into (sorted-map) by-f)\n :valid? (merge-valid (map :valid? (vals by-f)))))))\n\n(defn stats\n \"Computes basic statistics about success and failure rates, both overall and\n broken down by :f. Results are valid only if every :f has at some :ok\n operations; otherwise they're :unknown.\"\n []\n (Stats.))\n\n(defrecord Linearizable [algorithm model]\n Checker\n (check [this test history opts]\n (let [a ((case algorithm\n :linear linear/analysis\n :wgl wgl/analysis\n competition/analysis)\n model history)]\n (when-not (:valid? a)\n (try\n ;; Renderer can't handle really broad concurrencies yet\n (linear.report/render-analysis!\n history a (.getCanonicalPath\n (store/path! test (:subdirectory opts)\n \"linear.svg\")))\n (catch Throwable e\n (warn e \"Error rendering linearizability analysis\"))))\n ;; Writing these can take *hours* so we truncate\n (assoc a\n :final-paths (take 10 (:final-paths a))\n :configs (take 10 (:configs a))))))\n\n(defn linearizable\n \"Validates linearizability with Knossos. Defaults to the competition checker,\n but can be controlled by passing either :linear or :wgl.\n\n Takes an options map for arguments, ex.\n {:model (model/cas-register)\n :algorithm :wgl}\"\n [{:keys [algorithm model]}]\n (assert model\n (str \"The linearizable checker requires a model. It received: \"\n model\n \" instead.\"))\n (Linearizable. algorithm model))\n\n(defrecord Queue [model]\n Checker\n (check [this test history opts]\n (let [final (->> history\n (h/filter (fn select [op]\n (condp = (:f op)\n :enqueue (h/invoke? op)\n :dequeue (h/ok? op)\n false)))\n (reduce model/step model))]\n (if (model/inconsistent? final)\n {:valid? false\n :error (:msg final)}\n {:valid? true\n :final-queue final}))))\n\n(defn queue\n \"Every dequeue must come from somewhere. Validates queue operations by\n assuming every non-failing enqueue succeeded, and only OK dequeues succeeded,\n then reducing the model with that history. Every subhistory of every queue\n should obey this property. Should probably be used with an unordered queue\n model, because we don't look for alternate orderings. O(n).\"\n [model]\n (Queue. model))\n\n(defrecord Set []\n Checker\n (check [this test history opts]\n ; This would be more efficient as a single fused fold, but I'm doing it\n ; this way to exercise/demonstrate the task system. Will replace later\n ; once profiling shows it as a bottleneck.\n (let [attempts (h/task history attempts []\n (->> (t/filter h/invoke?)\n (t/filter (h/has-f? :add))\n (t/map :value)\n (t/set)\n (h/tesser history)))\n adds (h/task history adds []\n (->> (t/filter h/ok?)\n (t/filter (h/has-f? :add))\n (t/map :value)\n (t/set)\n (h/tesser history)))\n final-read (h/task history final-reads []\n (->> (t/filter (h/has-f? :read))\n (t/filter h/ok?)\n (t/map :value)\n (t/last)\n (h/tesser history)))\n attempts @attempts\n adds @adds\n final-read @final-read]\n (if-not final-read\n {:valid? :unknown\n :error \"Set was never read\"}\n\n (let [final-read (c/set final-read)\n\n ; The OK set is every read value which we tried to add\n ok (set/intersection final-read attempts)\n\n ; Unexpected records are those we *never* attempted.\n unexpected (set/difference final-read attempts)\n\n ; Lost records are those we definitely added but weren't read\n lost (set/difference adds final-read)\n\n ; Recovered records are those where we didn't know if the add\n ; succeeded or not, but we found them in the final set.\n recovered (set/difference ok adds)]\n\n {:valid? (and (empty? lost) (empty? unexpected))\n :attempt-count (count attempts)\n :acknowledged-count (count adds)\n :ok-count (count ok)\n :lost-count (count lost)\n :recovered-count (count recovered)\n :unexpected-count (count unexpected)\n :ok (util/integer-interval-set-str ok)\n :lost (util/integer-interval-set-str lost)\n :unexpected (util/integer-interval-set-str unexpected)\n :recovered (util/integer-interval-set-str recovered)})))))\n\n(defn set\n \"Given a set of :add operations followed by a final :read, verifies that\n every successfully added element is present in the read, and that the read\n contains only elements for which an add was attempted.\"\n []\n (Set.))\n\n(definterface+ ISetFullElement\n (set-full-add [element-state op])\n (set-full-read-present [element-state inv op])\n (set-full-read-absent [element-state inv op]))\n\n; Tracks the state of each element for set-full analysis\n;\n; We're looking for a few key points here:\n;\n; The add time is inferred from either the add *or* the first read to observe\n; the op, whichever finishes first.\n;\n; To find the *stable time*, we need to know the most recent missing\n; invocation. If we have any successful read invocation *after* it, then we know\n; the record was stable.\n;\n; To find the *lost time*, we need to know the most recent observed invocation.\n; If we have any lost invocation *more* recent than that, then we know that the\n; record was lost.\n(defrecord SetFullElement [element\n known\n last-present\n last-absent]\n ISetFullElement\n (set-full-add [this op]\n (condp = (:type op)\n ; Record the completion of the add op\n :ok (assoc this :known (or known op))\n this))\n\n (set-full-read-present [this iop op]\n (assoc this\n :known (or known op)\n\n :last-present\n (if (or (nil? last-present)\n (< (:index last-present) (:index iop)))\n iop\n last-present)))\n\n (set-full-read-absent [this iop op]\n (if (or (nil? last-absent)\n (< (:index last-absent) (:index iop)))\n (assoc this :last-absent iop)\n this)))\n\n(defn set-full-element\n \"Given an add invocation, constructs a new set element state record to track\n that element\"\n [op]\n (map->SetFullElement {:element (:value op)}))\n\n(defn set-full-element-results\n \"Takes a SetFullElement and computes a map of final results from it:\n\n :element The element itself\n :outcome :stable, :lost, :never-read\n :lost-latency\n :stable-latency\"\n [e]\n (let [known (:known e)\n known-time (:time (:known e))\n last-present (:last-present e)\n last-absent (:last-absent e)\n\n stable? (boolean\n (and last-present\n (< (:index last-absent -1)\n (:index last-present))))\n ; Note that there exist two asymmetries here.\n ; First, an element has to be known in order for its absence to mean\n ; anything. If it is never confirmed nor observed, it's ok for it not\n ; to exist. We check to make sure the element is actually known.\n\n ; Second, if a read concurrent with the add of an element e observes e,\n ; then we know e exists. However, a concurrent read which *fails* to\n ; observe e could have linearized before the add. We check the\n ; concurrency windows to make sure the last lost operation didn't\n ; overlap with the known complete time; if the most recent failed read\n ; was also *concurrent* with the add, we call that never-read, rather\n ; than lost.\n lost? (boolean\n (and known\n last-absent\n (< (:index last-present -1)\n (:index last-absent))\n (< (:index (:known e))\n (:index last-absent))))\n never-read (not (or stable? lost?))\n\n ; TODO: 0 isn't really right; we'd need to track the first present\n ; invocations to get these times.\n ; TODO: We should also be smarter about\n ; getting the first absent invocation\n ; *after* the most recent present invocation\n stable-time (when stable?\n (if last-absent (inc (:time last-absent)) 0))\n lost-time (when lost?\n (if last-present (inc (:time last-present)) 0))\n\n stable-latency (when stable?\n (-> stable-time (- known-time) (max 0)\n util/nanos->ms long))\n lost-latency (when lost?\n (-> lost-time (- known-time) (max 0)\n util/nanos->ms long))]\n {:element (:element e)\n :outcome (cond stable? :stable\n lost? :lost\n never-read :never-read)\n :stable-latency stable-latency\n :lost-latency lost-latency\n :known known\n :last-absent last-absent}))\n\n(defn frequency-distribution\n \"Computes a map of percentiles (0--1, not 0--100, we're not monsters) of a\n collection of numbers, taken at percentiles `points`. If the collection is\n empty, returns nil.\"\n [points c]\n (let [sorted (sort c)]\n (when (seq sorted)\n (let [n (c/count sorted)\n extract (fn [point]\n (let [idx (min (dec n) (int (Math/floor (* n point))))]\n (nth sorted idx)))]\n (->> points (map extract) (zipmap points) (into (sorted-map)))))))\n\n(defn set-full-results\n \"Takes options from set-full, and a collection of SetFullElements. Computes\n agggregate results; see set-full for details.\"\n [opts elements]\n (let [rs (mapv set-full-element-results elements)\n outcomes (group-by :outcome rs)\n stale (->> (:stable outcomes)\n (filter (comp pos? :stable-latency)))\n worst-stale (->> stale\n (sort-by :stable-latency)\n reverse\n (take 8))\n stable-latencies (keep :stable-latency rs)\n lost-latencies (keep :lost-latency rs)\n m {:valid? (cond (< 0 (count (:lost outcomes))) false\n (= 0 (count (:stable outcomes))) :unknown\n (and (:linearizable? opts)\n (< 0 (count stale))) false\n true true)\n :attempt-count (count rs)\n :stable-count (count (:stable outcomes))\n :lost-count (count (:lost outcomes))\n :lost (sort (map :element (:lost outcomes)))\n :never-read-count (count (:never-read outcomes))\n :never-read (sort (map :element (:never-read outcomes)))\n :stale-count (count stale)\n :stale (sort (map :element stale))\n :worst-stale worst-stale}\n points [0 0.5 0.95 0.99 1]\n m (if (seq stable-latencies)\n (assoc m :stable-latencies\n (frequency-distribution points stable-latencies))\n m)\n m (if (seq lost-latencies)\n (assoc m :lost-latencies\n (frequency-distribution points lost-latencies))\n m)]\n m))\n\n(defrecord SetFull [checker-opts]\n Checker\n (check [this test history opts]\n ; Build up a map of elements to element states. Finally we track a map of\n ; duplicates: elements to maximum multiplicities for that element in any\n ; given read.\n (let [[elements dups]\n (->> history\n h/client-ops\n (reduce (fn red [[elements dups] op]\n (let [v (:value op)\n p (:process op)]\n (condp = (:f op)\n :add\n (if (= :invoke (:type op))\n ; Track a new element\n [(assoc elements v (set-full-element op)) dups]\n ; Oh good, it completed\n [(update elements v set-full-add op) dups])\n\n :read\n (if-not (h/ok? op)\n ; Nothing doing\n [elements dups]\n ; We read stuff! Update every element\n (let [inv (h/invocation history op)\n ; Find duplicates\n dups' (->> (frequencies v)\n (reduce (fn [m [k v]]\n (if (< v 1)\n (assoc m k v)\n m))\n (sorted-map))\n (merge-with max dups))\n v (c/set v)]\n ; Process visibility of all elements\n [(map-kv (fn update-all [[element state]]\n [element\n (if (contains? v element)\n (set-full-read-present\n state inv op)\n (set-full-read-absent\n state inv op))])\n elements)\n dups'])))))\n [{} {}]))\n set-results (set-full-results checker-opts\n (mapv val (sort elements)))]\n (assoc set-results\n :valid? (and (empty? dups) (:valid? set-results))\n :duplicated-count (count dups)\n :duplicated dups))))\n\n(defn set-full\n \"A more rigorous set analysis. We allow :add operations which add a single\n element, and :reads which return all elements present at that time. For each\n element, we construct a timeline like so:\n\n [nonexistent] ... [created] ... [present] ... [absent] ... [present] ...\n\n For each element:\n\n The *add* is the operation which added that element.\n\n The *known time* is the completion time of the add, or first read, whichever\n is earlier.\n\n The *stable time* is the time after which every read which begins observes\n the element. If every read beginning after the add time observes\n the element, the stable time is the add time. If the final read fails to\n observe the element, the stable time is nil.\n\n A *stable element* is one which has a stable time.\n\n The *lost time* is the time after which no operation observes that element.\n If the most final read observes the element, the lost time is nil.\n\n A *lost element* is one which has a lost time.\n\n An element can be either stable or lost, but not both.\n\n The *first read latency* is 0 if the first read invoked after the add time\n observes the element. If the element is never observed, it is nil. Otherwise,\n the first read delay is the time from the completion of the write to the\n invocation of the first read.\n\n The *stable latency* is the time between the add time and the stable time, or\n 0, whichever is greater.\n\n Options are:\n\n :linearizable? If true, we expect this set to be linearizable, and\n stale reads result in an invalid result.\n\n Computes aggregate results:\n\n :valid? False if there were any lost elements.\n :unknown if there were no lost *or* stale elements;\n e.g. if the test never inserted anything, every\n insert crashed, etc. For :linearizable? tests,\n false if there were lost *or* stale elements.\n :attempt-count Number of attempted inserts\n :stable-count Number of elements which had a time after which\n they were always found\n :lost Elements which had a time after which\n they were never found\n :lost-count Number of lost elements\n :never-read Elements where no read began after the time when\n that element was known to have been inserted.\n Includes elements which were never known to have\n been inserted.\n :never-read-count Number of elements never read\n :stale Elements which failed to appear in a read beginning\n after we knew the operation completed.\n :stale-count Number of stale elements.\n :worst-stale Detailed description of stale elements with the\n highest stable latencies; e.g. which ones took the\n longest to show up.\n :stable-latencies Map of quantiles to latencies, in milliseconds, it\n took for elements to become stable. 0 indicates the\n element was linearizable.\n :lost-latencies Map of quantiles to latencies, in milliseconds, it\n took for elements to become lost. 0 indicates the\n element was known to be inserted, but never\n observed.\"\n ([]\n (set-full {:linearizable? false}))\n ([checker-opts]\n (SetFull. checker-opts)))\n\n(defn expand-queue-drain-ops\n \"A Tesser fold which looks for :drain operations with their value being a\n collection of queue elements, and expands them to a sequence of :dequeue\n invoke/complete pairs.\"\n []\n (t/mapcat (fn expand [op]\n (cond ; Pass through anything other than a :drain\n (not= :drain (:f op)) [op]\n\n ; Skip drain invokes/fails\n (h/invoke? op) nil\n (h/fail? op) nil\n\n ; Expand successful drains\n (h/ok? op)\n (mapcat (fn [element]\n [(assoc op\n :index -1\n :type :invoke\n :f :dequeue\n :value nil)\n (assoc op\n :index -1\n :type :ok\n :f :dequeue\n :value element)])\n (:value op))\n\n ; Anything else (e.g. crashed drains) is illegal\n true\n (throw (IllegalStateException.\n (str \"Not sure how to handle a crashed drain operation: \"\n (pr-str op))))))))\n\n(defrecord TotalQueue []\n Checker\n (check [this test history opts]\n (let [{:keys [attempts enqueues dequeues]}\n (->> (expand-queue-drain-ops)\n (t/fuse\n {:attempts (->> (t/filter (h/has-f? :enqueue))\n (t/filter h/invoke?)\n (t/map :value)\n (t/into (multiset/multiset)))\n :enqueues (->> (t/filter (h/has-f? :enqueue))\n (t/filter h/ok?)\n (t/map :value)\n (t/into (multiset/multiset)))\n :dequeues (->> (t/filter (h/has-f? :dequeue))\n (t/filter h/ok?)\n (t/map :value)\n (t/into (multiset/multiset)))})\n (h/tesser history))\n\n ; The OK set is every dequeue which we attempted.\n ok (multiset/intersect dequeues attempts)\n\n ; Unexpected records are those we *never* tried to enqueue. Maybe\n ; leftovers from some earlier state. Definitely don't want your\n ; queue emitting records from nowhere!\n unexpected (->> dequeues\n (remove (c/set (keys (multiset/multiplicities\n attempts))))\n (into (multiset/multiset)))\n\n ; Duplicate records are those which were dequeued more times than\n ; they could have been enqueued; but were attempted at least once.\n duplicated (-> dequeues\n (multiset/minus attempts)\n (multiset/minus unexpected))\n\n ; lost records are ones which we definitely enqueued but never\n ; came out.\n lost (multiset/minus enqueues dequeues)\n\n ; Recovered records are dequeues where we didn't know if the enqueue\n ; suceeded or not, but an attempt took place.\n recovered (multiset/minus ok enqueues)]\n\n {:valid? (and (empty? lost) (empty? unexpected))\n :attempt-count (count attempts)\n :acknowledged-count (count enqueues)\n :ok-count (count ok)\n :unexpected-count (count unexpected)\n :duplicated-count (count duplicated)\n :lost-count (count lost)\n :recovered-count (count recovered)\n :lost lost\n :unexpected unexpected\n :duplicated duplicated\n :recovered recovered})))\n\n\n(defn total-queue\n \"What goes in *must* come out. Verifies that every successful enqueue has a\n successful dequeue. Queues only obey this property if the history includes\n draining them completely. O(n).\"\n []\n (TotalQueue.))\n\n(defrecord UniqueIds []\n Checker\n (check [this test history opts]\n (let [{:keys [attempted-count acks]}\n (->> (t/filter (h/has-f? :generate))\n (t/fuse {:attempted-count (->> (t/filter h/invoke?)\n (t/count))\n :acks (->> (t/filter h/ok?)\n (t/map :value)\n (t/fuse {:count (t/count)\n :freqs (t/frequencies)\n :range (t/range)}))})\n (h/tesser history))\n dups (->> acks :freqs\n (r/filter #(< 1 (val %)))\n (into (sorted-map)))]\n {:valid? (empty? dups)\n :attempted-count attempted-count\n :acknowledged-count (:count acks)\n :duplicated-count (count dups)\n :duplicated (->> dups\n (sort-by val)\n (reverse)\n (take 48)\n (into (sorted-map)))\n :range (:range acks)})))\n\n(defn unique-ids\n \"Checks that a unique id generator actually emits unique IDs. Expects a\n history with :f :generate invocations matched by :ok responses with distinct\n IDs for their :values. IDs should be comparable. Returns\n\n {:valid? Were all IDs unique?\n :attempted-count Number of attempted ID generation calls\n :acknowledged-count Number of IDs actually returned successfully\n :duplicated-count Number of IDs which were not distinct\n :duplicated A map of some duplicate IDs to the number of times\n they appeared--not complete for perf reasons :D\n :range [lowest-id highest-id]}\"\n []\n (UniqueIds.))\n\n(defrecord Counter []\n Checker\n (check [this test history opts]\n ; pre-process our history so failed adds do not get applied\n (loopr [lower 0 ; Current lower bound on counter\n upper 0 ; Upper bound on counter value\n pending-reads {} ; Process ID -> [lower read-val]\n reads []] ; Completed [lower val upper]s\n ; If this is slow, maybe try :via :reduce?\n [{:keys [process type f process value] :as op} history]\n (do ; Working with longs lets us do primitive recur here\n (assert (or (nil? value)\n (instance? Long value)))\n (case [type f]\n [:invoke :read]\n ; What value will this read?\n (if-let [completion (h/completion history op)]\n (do (if (h/ok? completion)\n ; We're going to read something\n (recur lower upper\n (assoc pending-reads process\n [lower (:value completion)])\n reads)\n ; Won't read anything\n (recur lower upper pending-reads reads)))\n ; Doesn't finish at all\n (recur lower upper pending-reads reads))\n\n [:ok :read]\n (let [r (get pending-reads process)]\n (recur lower upper\n (dissoc pending-reads process)\n (conj reads (conj r upper))))\n\n [:invoke :add]\n (do (assert (not (neg? value)))\n ; Look forward to find out if we'll succeed\n (if-let [completion (h/completion history op)]\n (if (h/fail? completion)\n ; Won't complete\n (recur lower upper pending-reads reads)\n ; Will complete\n (recur lower (+ upper (long value))\n pending-reads reads))\n ; Not sure\n (recur lower (+ upper (long value))\n pending-reads reads)))\n\n [:ok :add]\n (recur (+ lower (long value)) upper pending-reads reads)\n\n (recur lower upper pending-reads reads)))\n (let [errors (remove (partial apply <=) reads)]\n {:valid? (empty? errors)\n :reads reads\n :errors errors}))))\n\n(defn counter\n \"A counter starts at zero; add operations should increment it by that much,\n and reads should return the present value. This checker validates that at\n each read, the value is greater than the sum of all :ok increments, and lower\n than the sum of all attempted increments.\n\n Note that this counter verifier assumes the value monotonically increases:\n decrements are not allowed.\n\n Returns a map:\n\n :valid? Whether the counter remained within bounds\n :reads [[lower-bound read-value upper-bound] ...]\n :errors [[lower-bound read-value upper-bound] ...]\n\n ; Not implemented, but might be nice:\n\n :max-absolute-error The [lower read upper] where read falls furthest outside\n :max-relative-error Same, but with error computed as a fraction of the mean}\n \"\n []\n (Counter.))\n\n(defrecord LatencyGraph [opts]\n Checker\n (check [_ test history c-opts]\n (let [o (merge opts c-opts)]\n (perf/point-graph! test history o)\n (perf/quantiles-graph! test history o)\n {:valid? true})))\n\n(defn latency-graph\n \"Spits out graphs of latencies. Checker options take precedence over\n those passed in with this constructor.\"\n ([]\n (latency-graph {}))\n ([opts]\n (LatencyGraph. opts)))\n\n(defrecord RateGraph [opts]\n Checker\n (check [_ test history c-opts]\n (let [o (merge opts c-opts)]\n (perf/rate-graph! test history o)\n {:valid? true})))\n\n(defn rate-graph\n \"Spits out graphs of throughput over time. Checker options take precedence\n over those passed in with this constructor.\"\n ([]\n (rate-graph {}))\n ([opts]\n (RateGraph. opts)))\n\n(defn perf\n \"Composes various performance statistics. Checker options take precedence over\n those passed in with this constructor.\"\n ([]\n (perf {}))\n ([opts]\n (compose {:latency-graph (latency-graph opts)\n :rate-graph (rate-graph opts)})))\n\n(defrecord ClockPlot []\n Checker\n (check [_ test history opts]\n (clock/plot! test history opts)\n {:valid? true}))\n\n(defn clock-plot\n \"Plots clock offsets on all nodes.\"\n []\n (ClockPlot.))\n\n(defrecord OpColorPlot [opts]\n Checker\n (check [_ test history checker-opts]\n (plot/op-color-plot! test history (merge opts checker-opts))\n {:valid? true}))\n\n(defn op-color-plot\n \"A checker which draws an operation color plot---see\n `jepsen.checker.plot/op-color-plot!` for details. Takes an options map, which\n is merged with checker-provided options and passed to `op-color-plot!`.\"\n ([] (op-color-plot {}))\n ([opts]\n (OpColorPlot. opts)))\n\n(defrecord LogFilePattern [pattern filename]\n Checker\n (check [this test history opts]\n (let [matches\n (->> (:nodes test)\n (pmap (fn search [node]\n (let [{:keys [exit out err]}\n (->> (store/path test node filename)\n .getCanonicalPath\n (sh \"grep\" \"--text\" \"-P\" (str pattern)))]\n (case (long exit)\n 0 (->> out\n str/split-lines\n (map (fn [line]\n {:node node, :line line})))\n ; No match\n 1 nil\n 2 (condp re-find err\n #\"No such file\" nil\n (throw+ {:type :grep-error\n :exit exit\n :cmd (str \"grep -P \" pattern)\n :err err\n :out out}))))))\n (mapcat identity))]\n {:valid? (empty? matches)\n :count (count matches)\n :matches matches})))\n\n(defn log-file-pattern\n \"Takes a PCRE regular expression pattern (as a Pattern or string) and a\n filename. Checks the store directory for this test, and in each node\n directory (e.g. n1), examines the given file to see if it contains instances\n of the pattern. Returns :valid? true if no instances are found, and :valid?\n false otherwise, along with a :count of the number of matches, and a :matches\n list of maps, each with the node and matching string from the file.\n\n (log-file-pattern #\\\"panic: (\\\\w+)$\\\" \\\"db.log\\\")\n\n {:valid? false\n :count 5\n :matches {:node \\\"n1\\\"\n :line \\\"panic: invariant violation\\\" \\\"invariant violation\\\"\n ...]}}\"\n [pattern filename]\n (LogFilePattern. pattern filename))\n\n" }, { "path": "jepsen/src/jepsen/cli.clj", "content": "(ns jepsen.cli\n \"Command line interface. Provides a default main method for common Jepsen\n functions (like the web interface), and utility functions for Jepsen tests to\n create their own test runners.\"\n (:gen-class)\n (:refer-clojure :exclude [run!])\n (:require [clojure.pprint :refer [pprint]]\n [clojure.tools.cli :as cli]\n [clojure.tools.logging :refer :all]\n [clojure.string :as str]\n [clojure.java.io :as io]\n [dom-top.core :refer [assert+]]\n [jepsen [core :as jepsen]\n [store :as store]\n [util :as util :refer [exception-message map-vals]]\n [web :as web]]))\n\n(def default-nodes [\"n1\" \"n2\" \"n3\" \"n4\" \"n5\"])\n\n(defn one-of\n \"Takes a collection and returns a string like \\\"Must be one of ...\\\" and a\n list of names. For maps, uses keys.\"\n [coll]\n (str \"Must be one of \"\n (str/join \", \" (sort (map name (if (map? coll) (keys coll) coll))))))\n\n(defn repeated-opt\n \"Helper for vector options where we want to replace the default vector\n (checking via identical?) if any options are passed, building a vector for\n multiple args. If parse-map is provided (a map of string cmdline options to\n parsed values), the special word \\\"all\\\" can be used to specify every value\n in the map.\"\n ([short-opt long-opt docstring default]\n [short-opt long-opt docstring\n :default default\n :assoc-fn (fn [m k v]\n (if (identical? (get m k) default)\n (assoc m k [v])\n (update m k conj v)))])\n ([short-opt long-opt docstring default parse-map]\n [short-opt long-opt docstring\n :default default\n :parse-fn (assoc parse-map \"all\" :all)\n :validate [identity (one-of parse-map)]\n :assoc-fn (fn [m k v]\n (if (= :all v)\n (assoc m k (vals parse-map))\n (if (identical? (get m k) default)\n (assoc m k [v])\n (update m k conj v))))]))\n\n(defn merge-opt-specs\n \"Takes two option specifications and merges them together. Where both offer\n the same option name, prefers the latter.\"\n [a b]\n (->> (merge (group-by second a)\n (group-by second b))\n vals\n (map first)))\n\n(defn without-default\n \"Removes a :default x from a vector (e.g. a single option specification for\n tools.cli).\"\n ([opt-spec]\n (without-default [] opt-spec))\n ([filtered [x & xs :as opt-spec]]\n (cond ; All done\n (empty? opt-spec)\n filtered\n\n ; :default pair\n (= x :default)\n (recur filtered (next xs))\n\n ; Other\n true\n (recur (conj filtered x) xs))))\n\n(defn without-defaults-for\n \"Takes a collection of option names like [:workload :nemesis] and a CLI\n option specification--a vector of option vectors. Rewrites that CLI spec to\n remove the defaults for the given options. Useful for taking a single opt\n spec and passing it to `test`, which wants default options, and `test-all`,\n which often wants to treat the absence of an option specially.\"\n [opt-names opt-spec]\n (let [opt-names (mapv name opt-names)]\n (mapv (fn without [[_ name-str :as option]]\n (if (some (fn match? [opt-name]\n (= opt-name\n (nth (re-find #\"--(\\[no-\\])?([^ ]+)\" name-str) 2)))\n opt-names)\n (without-default option)\n option))\n opt-spec)))\n\n(def help-opt\n [\"-h\" \"--help\" \"Print out this message and exit\"])\n\n(def test-opt-spec\n \"Command line options for testing.\"\n\n [help-opt\n\n (repeated-opt \"-n\" \"--node HOSTNAME\" \"Node(s) to run test on. Flag may be submitted many times, with one node per flag.\" default-nodes)\n\n [nil \"--nodes NODE_LIST\" \"Comma-separated list of node hostnames.\"\n :parse-fn #(str/split % #\",\\s*\")]\n\n [nil \"--nodes-file FILENAME\" \"File containing node hostnames, one per line.\"]\n\n [nil \"--username USER\" \"Username for logins\"\n :default \"root\"]\n\n [nil \"--password PASS\" \"Password for sudo access\"\n :default \"root\"]\n\n [nil \"--strict-host-key-checking\" \"Whether to check host keys\"\n :default false]\n\n [nil \"--no-ssh\" \"If set, doesn't try to establish SSH connections to any nodes.\"\n :default false]\n\n [nil \"--ssh-private-key FILE\" \"Path to an SSH identity file\"]\n\n [nil \"--concurrency NUMBER\" \"How many workers should we run? Must be an integer, optionally followed by n (e.g. 3n) to multiply by the number of nodes.\"\n :default \"1n\"\n :validate [(partial re-find #\"^\\d+n?$\")\n \"Must be an integer, optionally followed by n.\"]]\n\n [nil \"--leave-db-running\" \"Leave the database running at the end of the test., so you can inspect it.\"\n :default false]\n\n [nil \"--logging-json\" \"Use JSON structured output in the Jepsen log.\"\n :default false]\n\n [nil \"--test-count NUMBER\"\n \"How many times should we repeat a test?\"\n :default 1\n :parse-fn #(Long/parseLong %)\n :validate [pos? \"Must be positive\"]]\n\n [nil \"--time-limit SECONDS\"\n \"Excluding setup and teardown, how long should a test run for, in seconds?\"\n :default 60\n :parse-fn #(Long/parseLong %)\n :validate [pos? \"Must be positive\"]]])\n\n(defn package-opt\n ([default]\n (package-opt \"package-url\" default))\n ([option-name default]\n [nil (str \"--\" option-name \" URL\")\n \"URL for the DB package (a zip file or tarball) to install. May be either HTTP, HTTPS, or a local file present on each of the DB nodes. For instance, --tarball https://foo.com/db.tgz, or file:///tmp/db.zip\"\n :default default\n :validate [(partial re-find #\"^(file|https?)://.*\\.(tar|tgz|zip)\")\n \"Must be a file://, http://, or https:// URL including .tar, .tgz, or .zip\"]]))\n\n(defn tarball-opt\n [default]\n (package-opt \"tarball\" default))\n\n(defn test-usage\n []\n \"Usage: lein run -- COMMAND [OPTIONS ...]\n\nRuns a Jepsen test and exits with a status code:\n\n 0 All tests passed\n 1 Some test failed\n 2 Some test had an :unknown validity\n 254 Invalid arguments\n 255 Internal Jepsen error\n\nOptions:\\n\")\n\n;; Validation and option processing\n\n(defn validate-tarball\n \"Takes a parsed map and ensures a tarball is present.\"\n [parsed]\n (if (:tarball (:options parsed))\n parsed\n (update parsed :errors conj \"No tarball URL provided\")))\n\n(defn parse-concurrency\n \"Takes a parsed map. Parses :concurrency; if it is a string ending with n,\n e.g 3n, sets it to 3 * the number of :nodes. Otherwise, parses as a plain\n integer. With an optional keyword k, parses that key in the parsed map--by\n default, the key is :concurrency.\"\n ([parsed]\n (parse-concurrency parsed :concurrency))\n ([parsed k]\n (let [c (get (:options parsed) k)]\n (let [[match integer unit] (re-find #\"(\\d+)(n?)\" c)]\n (when-not match\n (throw (IllegalArgumentException.\n (str \"--concurrency \" c\n \" should be an integer optionally followed by n\"))))\n (let [unit (if (= \"n\" unit)\n (count (:nodes (:options parsed)))\n 1)]\n (assoc-in parsed [:options k]\n (* unit (Long/parseLong integer))))))))\n\n(defn parse-nodes\n \"Takes a parsed map and merges all the various node specifications together.\n In particular:\n\n - If :nodes-file and :nodes are blank, and :node is the default node list,\n uses the default node list.\n - Otherwise, merges together :nodes-file, :nodes, and :node into a single\n list.\n\n The new parsed map will have a merged nodes list in :nodes, and lose\n :nodes-file and :node options.\"\n [parsed]\n (let [options (:options parsed)\n node (:node options)\n nodes (:nodes options)\n nodes-file (:nodes-file options)\n\n ; If --node is still left at the default\n default-node? (identical? node default-nodes)\n ; ... and other options were given...\n override? (or nodes nodes-file)\n ; Then drop the default node list\n node (if (and default-node? override?) nil node)\n\n ; Read nodes-file nodes\n nodes-file (when nodes-file\n (str/split (slurp nodes-file) #\"\\s*\\n\\s*\"))\n\n ; Construct full node list\n all-nodes (->> (concat nodes-file\n nodes\n node)\n vec)]\n (assoc parsed :options (-> options\n (dissoc :node :nodes-file)\n (assoc :nodes all-nodes)))))\n\n(defn rename-keys\n \"Given a map m, and a map of keys to replacement keys, yields m with keys\n renamed.\"\n [m replacements]\n (reduce (fn [m [k k']]\n (-> m\n (assoc k' (get m k))\n (dissoc k)))\n m\n replacements))\n\n(defn rename-options\n \"Like rename-keys, but takes a parsed map and updates keys in :options.\"\n [parsed replacements]\n (update parsed :options rename-keys replacements))\n\n(defn rename-ssh-options\n \"Takes a parsed map and moves SSH options to a map under :ssh.\"\n [parsed]\n (let [{:keys [no-ssh\n username\n password\n strict-host-key-checking\n ssh-private-key]} (:options parsed)]\n (assoc parsed :options\n (-> (:options parsed)\n (assoc :ssh {:dummy? (boolean no-ssh)\n :username username\n :password password\n :strict-host-key-checking strict-host-key-checking\n :private-key-path ssh-private-key})\n (dissoc :no-ssh\n :username\n :password\n :strict-host-key-checking\n :private-key-path)))))\n\n\n(defn test-opt-fn\n \"An opt fn for running simple tests. Remaps ssh keys, remaps :node to :nodes,\n reads :nodes-file into :nodes, and parses :concurrency.\"\n [parsed]\n (-> parsed\n rename-ssh-options\n (rename-options {:leave-db-running :leave-db-running?})\n (rename-options {:logging-json :logging-json?})\n parse-nodes\n parse-concurrency))\n\n;; Test runner\n\n(defn run!\n \"Parses arguments and runs tests, etc. Takes a map of subcommand names to\n subcommand-specs, and a list of arguments. Each subcommand-spec is a map with\n the following keys:\n\n :opt-spec - The option parsing spec to use.\n :opt-fn - A function to transform the tools.cli options map, e.g.\n {:options ..., :arguments ..., :summary ...}. Default:\n identity\n :usage - A usage string (default: \\\"Usage:\\\")\n :run - Function to execute with the transformed options\n (default: pprint)\n\n If an unrecognized (or no command) is given, prints out a general usage guide\n and exits.\n\n For a subcommand, if help or --help is given, prints out a help string with\n usage for the given subcommand and exits with status 0.\n\n If invalid arguments are given, prints those errors to the console, and exits\n with status 254.\n\n Finally, if everything looks good, calls the given subcommand's `run`\n function with parsed options, and exits with status 0.\n\n Catches exceptions, logs them to the console, and exits with status 255.\"\n [subcommands [command & arguments :as argv]]\n (try\n (assert (not (get subcommands \"--help\")))\n (assert (not (get subcommands \"help\")))\n\n ; Top level help\n (when-not (get subcommands command)\n (println \"Usage: lein run -- COMMAND [OPTIONS ...]\")\n (print \"Commands: \")\n (println (str/join \", \" (sort (keys subcommands))))\n (System/exit 254))\n\n (let [{:keys [opt-spec opt-fn usage run]} (get subcommands command)\n opt-fn (or opt-fn identity)\n usage (or usage (str \"Usage: lein run -- \" command\n \" [OPTIONS ...]\"))\n run (or run (fn [{:keys [options arguments summary errors]}]\n (println \"Arguments:\")\n (pprint arguments)\n (println \"\\nOptions:\")\n (pprint options)\n (println \"\\nErrors:\")\n (pprint errors)\n (System/exit 0)))]\n\n ; Parse arguments\n (let [{:keys [options arguments summary errors] :as parsed-opts}\n (-> arguments\n (cli/parse-opts opt-spec)\n (update :options assoc :argv argv)\n opt-fn)]\n\n ; Subcommand help\n (when (:help options)\n (println usage)\n (println)\n (println summary)\n (System/exit 0))\n\n ; Bad args?\n (when (seq errors)\n (dorun (map println errors))\n (System/exit 254))\n\n ; Run!\n (run parsed-opts)\n (System/exit 0)))\n\n (catch Throwable t\n (fatal t (exception-message t\n \"Oh jeez, I'm sorry, Jepsen broke. Here's why:\"))\n (System/exit 255))))\n\n(defn serve-cmd\n \"A web server command.\"\n []\n {\"serve\" {:opt-spec [help-opt\n [\"-b\" \"--host HOST\" \"Hostname to bind to\"\n :default \"0.0.0.0\"]\n [\"-p\" \"--port NUMBER\" \"Port number to bind to\"\n :default 8080\n :parse-fn #(Long/parseLong %)\n :validate [pos? \"Must be positive\"]]]\n :opt-fn #(update % :options rename-keys {:host :ip})\n :run (fn [{:keys [options]}]\n (web/serve! options)\n (info (str \"Listening on http://\"\n (:ip options) \":\" (:port options) \"/\"))\n (loop [] (do\n (Thread/sleep 1000)\n (recur))))}})\n\n(defn single-test-cmd\n \"A command which runs a single test with standard built-ins. Options:\n\n {:opt-spec A vector of additional options for tools.cli. Merge into\n `test-opt-spec`. Optional.\n :opt-fn A function which transforms parsed options. Composed after\n `test-opt-fn`. Optional.\n :opt-fn* Replaces test-opt-fn, in case you want to override it altogether.\n :tarball If present, adds a --tarball option to this command, defaulting to\n whatever URL is given here.\n :usage Defaults to `jc/test-usage`. Optional.\n :test-fn A function that receives the option map and constructs a test.}\n\n This comes with two commands: `test`, which runs a test and analyzes it, and\n `analyze`, which constructs a test map using the same arguments as `run`, but\n analyzes a history from disk instead.\n \"\n [opts]\n (let [opt-spec (merge-opt-specs test-opt-spec (:opt-spec opts))\n opt-spec (if-let [default-tarball (:tarball opts)]\n (conj opt-spec\n [nil \"--tarball URL\" \"URL for the DB tarball to install. May be either HTTP, HTTPS, or a local file on each DB node. For instance, --tarball https://foo.com/bar.tgz, or file:///tmp/bar.tgz\"\n :default default-tarball\n :validate [(partial re-find #\"^(file|https?)://.*\\.(tar\\.gz|tgz)\")\n \"Must be a file://, http://, or https:// URL ending in .tar.gz or .tgz\"]])\n opt-spec)\n opt-fn (if (:tarball opts)\n (comp test-opt-fn validate-tarball)\n test-opt-fn)\n opt-fn (if-let [f (:opt-fn opts)]\n (comp f opt-fn)\n opt-fn)\n opt-fn (or (:opt-fn* opts) opt-fn)\n test-fn (:test-fn opts)]\n {\"test\" {:opt-spec opt-spec\n :opt-fn opt-fn\n :usage (:usage opts test-usage)\n :run (fn [{:keys [options]}]\n (info \"Test options:\\n\"\n (with-out-str (pprint options)))\n (doseq [i (range (:test-count options))]\n (let [test (jepsen/run! (test-fn options))]\n (case (:valid? (:results test))\n false (System/exit 1)\n :unknown (System/exit 2)\n nil))))}\n\n \"analyze\"\n {:opt-spec [[\"-t\" \"--test INDEX_OR_PATH\" \"Index (e.g. -1 for most recent) or path to a Jepsen test file.\"\n :default -1\n :parse-fn (fn [s]\n (if (re-find #\"^-?\\d+$\" s)\n (Long/parseLong s)\n s))]]\n :opt-fn identity\n :usage (:usage opts test-usage)\n :run (fn [{:keys [options]}]\n (let [stored-test (store/test (:test options))\n _ (info \"Analyzing\" (.getPath (store/path stored-test)))\n argv (:argv stored-test)\n _ (info \"CLI args were\" argv)\n _ (assert+ (#{\"test\" \"test-all\"} (first argv))\n IllegalArgumentException\n (str \"Not sure how to reconstruct test map from CLI args \" (str/join \" \" argv)))\n _ (assert+ (map? stored-test)\n IllegalStateException\n \"Unable to load test\")\n ; Reparse original CLI options as if it had been a test\n ; cmd\n {:keys [options arguments summary errors] :as parsed-opts}\n (-> (next argv) (cli/parse-opts opt-spec) opt-fn)\n ; And construct a test from those opts\n cli-test (test-fn options)\n test (-> cli-test\n (merge (dissoc stored-test :results))\n (vary-meta merge (meta stored-test)))]\n\n (binding [*print-length* 32]\n (info \"Combined test:\\n\"\n (-> test\n (update :history (partial take 5))\n (update :history vector)\n (update :history conj '...)\n pprint\n with-out-str)))\n (store/with-handle [test test]\n (jepsen/analyze! test))))}}))\n\n(defn test-all-run-tests!\n \"Runs a sequence of tests and returns a map of outcomes (e.g. true, :unknown,\n :crashed, false) to collections of test folders with that outcome.\"\n [tests]\n (->> tests\n (map-indexed\n (fn [i test]\n (let [test' (jepsen/prepare-test test)]\n (try\n (let [test' (jepsen/run! test')]\n [(:valid? (:results test'))\n (.getPath (store/path test'))])\n (catch Exception e\n (warn e \"Test crashed\")\n [:crashed (.getPath (store/path test'))])))))\n (group-by first)\n (map-vals (partial map second))))\n\n(defn test-all-print-summary!\n \"Prints a summary of test outcomes. Takes a map of statuses (e.g. :crashed,\n true, false, :unknown), to test files. Returns results.\"\n [results]\n (println \"\\n\")\n\n (when (seq (results true))\n (println \"\\n# Successful tests\\n\")\n (dorun (map println (results true))))\n\n (when (seq (results :unknown))\n (println \"\\n# Indeterminate tests\\n\")\n (dorun (map println (results :unknown))))\n\n (when (seq (results :crashed))\n (println \"\\n# Crashed tests\\n\")\n (dorun (map println (results :crashed))))\n\n (when (seq (results false))\n (println \"\\n# Failed tests\\n\")\n (dorun (map println (results false))))\n\n (println)\n (println (count (results true)) \"successes\")\n (println (count (results :unknown)) \"unknown\")\n (println (count (results :crashed)) \"crashed\")\n (println (count (results false)) \"failures\")\n\n results)\n\n(defn test-all-exit!\n \"Takes a map of statuses and exits with an appropriate error code: 255 if any\n crashed, 2 if any were unknown, 1 if any were invalid, 0 if all passed.\"\n [results]\n (System/exit (cond\n (:crashed results) 255\n (:unknown results) 2\n (get results false) 1\n true 0)))\n\n(defn test-all-cmd\n \"A command that runs a whole suite of tests in one go. Options:\n\n :opt-spec A vector of additional options for tools.cli. Appended to\n test-opt-spec. Optional.\n :opt-fn A function which transforms parsed options. Composed after\n test-opt-fn. Optional.\n :opt-fn* Replaces test-opt-fn, instead of composing with it.\n :usage Defaults to `test-usage`. Optional.\n :tests-fn A function that receives the transformed option map and\n constructs a sequence of tests to run.\"\n [opts]\n (let [opt-spec (merge-opt-specs test-opt-spec (:opt-spec opts))\n opt-fn test-opt-fn\n opt-fn (if-let [f (:opt-fn opts)]\n (comp f opt-fn)\n opt-fn)\n opt-fn (or (:opt-fn* opts) opt-fn)]\n {\"test-all\"\n {:opt-spec opt-spec\n :opt-fn opt-fn\n :usage \"Runs all tests\"\n :run (fn run [{:keys [options]}]\n (info \"CLI options:\\n\" (with-out-str (pprint options)))\n (->> options\n ((:tests-fn opts))\n test-all-run-tests!\n test-all-print-summary!\n test-all-exit!))}}))\n\n(defn -main\n [& args]\n (run! (serve-cmd)\n args))\n" }, { "path": "jepsen/src/jepsen/client.clj", "content": "(ns jepsen.client\n \"Applies operations to a database.\"\n (:require [clojure.tools.logging :refer :all]\n [clojure.reflect :refer [reflect]]\n [jepsen.util :as util]\n [dom-top.core :refer [with-retry]]\n [clj-commons.slingshot :refer [try+ throw+]]))\n\n(defprotocol Client\n ; TODO: this should be open, not open!\n ;\n ; TODO: it would also be really nice to have this be (open client test node\n ; process)--we keep wanting to make decisions based on the process at client\n ; open time.\n (open! [client test node]\n \"Set up the client to work with a particular node. Returns a client\n which is ready to accept operations via invoke! Open *should not*\n affect the logical state of the test; it should not, for instance,\n modify tables or insert records.\")\n (close! [client test]\n \"Close the client connection when work is completed or an invocation\n crashes the client. Close should not affect the logical state of the\n test.\")\n (setup! [client test]\n \"Called to set up database state for testing.\")\n (invoke! [client test operation]\n \"Apply an operation to the client, returning an operation to be\n appended to the history. For multi-stage operations, the client may\n reach into the test and conj onto the history atom directly.\")\n (teardown! [client test]\n \"Tear down database state when work is complete.\"))\n\n(defprotocol Reusable\n (reusable? [client test]\n \"If true, this client can be re-used with a fresh process after a\n call to `invoke` throws or returns an `info` operation. If false\n (or if this protocol is not implemented), crashed clients will be\n closed and new ones opened to replace them.\"))\n\n(defn is-reusable?\n \"Wrapper around reusable?; returns false when not implemented.\"\n [client test]\n ; satisfies? Reusable is somehow true for records which DEFINITELY don't\n ; implement it and I don't know how this is possible, so we're falling back\n ; to IllegalArgException\n (try (reusable? client test)\n (catch IllegalArgumentException e\n false)))\n\n(def noop\n \"Does nothing.\"\n (reify Client\n (setup! [this test])\n (teardown! [this test])\n (invoke! [this test op] (assoc op :type :ok))\n (open! [this test node] this)\n (close! [this test])))\n\n(defn closable?\n \"Returns true if the given client implements method `close!`.\"\n [client]\n (->> client\n reflect\n :members\n (map :name)\n (some #{'close_BANG_})))\n\n(defrecord Validate [client]\n Client\n (open! [this test node]\n (let [res (open! client test node)]\n (when-not (satisfies? Client res)\n (throw+ {:type ::open-returned-non-client\n :got res}\n nil\n \"expected open! to return a Client, but got %s instead\"\n (pr-str res)))\n (Validate. res)))\n\n (close! [this test]\n (close! client test))\n\n (setup! [this test]\n (Validate. (setup! client test)))\n\n (invoke! [this test op]\n (let [op' (invoke! client test op)]\n (let [problems\n (cond-> []\n (not (map? op'))\n (conj \"should be a map\")\n\n (not (#{:ok :info :fail} (:type op')))\n (conj \":type should be :ok, :info, or :fail\")\n\n (not= (:process op) (:process op'))\n (conj \":process should be the same\")\n\n (not= (:f op) (:f op'))\n (conj \":f should be the same\"))]\n (when (seq problems)\n (throw+ {:type ::invalid-completion\n :op op\n :op' op'\n :problems problems})))\n op'))\n\n (teardown! [this test]\n (teardown! client test))\n\n Reusable\n (reusable? [this test]\n (reusable? client test)))\n\n(defn validate\n \"Wraps a client, validating that its return types are what you'd expect.\"\n [client]\n (Validate. client))\n\n(defrecord Timeout [timeout-fn client]\n Client\n (open! [this test node]\n (Timeout. timeout-fn (open! client test node)))\n\n (setup! [this test]\n (Timeout. timeout-fn (setup! client test)))\n\n (invoke! [this test op]\n (let [ms (timeout-fn op)]\n (util/timeout ms (assoc op :type :info, :error ::timeout)\n (invoke! client test op))))\n\n (teardown! [this test]\n (teardown! client test))\n\n (close! [this test]\n (close! client test))\n\n Reusable\n (reusable? [this test]\n (reusable? client test)))\n\n(defn timeout\n \"Sometimes a client library's own timeouts don't work reliably. This takes\n either a timeout as a number of ms, or a function (f op) => timeout-in-ms,\n and a client. Wraps that client in a new one which automatically times out\n operations that take longer than the given timeout. Timed out operations have\n :error :jepsen.client/timeout.\"\n [timeout-or-fn client]\n (if (number? timeout-or-fn)\n (Timeout. (constantly timeout-or-fn) client)\n (Timeout. timeout-or-fn client)))\n\n(defmacro with-client\n \"Analogous to with-open. Takes a binding of the form [client-sym\n client-expr], and a body. Binds client-sym to client-expr (presumably,\n client-expr opens a new client), evaluates body with client-sym bound, and\n ensures client is closed before returning.\"\n [[client-sym client-expr] & body]\n `(let [~client-sym ~client-expr]\n (try\n ~@body\n (finally\n (close! ~client-sym test)))))\n\n" }, { "path": "jepsen/src/jepsen/codec.clj", "content": "(ns jepsen.codec\n \"Serializes and deserializes objects to/from bytes.\"\n (:require [clojure.edn :as edn]\n [byte-streams :as b])\n (:import (java.io ByteArrayInputStream\n InputStreamReader\n PushbackReader)))\n\n(defn encode\n \"Serialize an object to bytes.\"\n [o]\n (if (nil? o)\n (byte-array 0)\n (binding [*print-dup* false]\n (-> o pr-str .getBytes))))\n\n(defn decode\n \"Deserialize bytes to an object.\"\n [bytes]\n (if (nil? bytes)\n nil\n (let [bytes ^bytes (b/to-byte-array bytes)]\n (if (zero? (alength bytes))\n nil\n (with-open [s (ByteArrayInputStream. bytes)\n i (InputStreamReader. s)\n r (PushbackReader. i)]\n (binding [*read-eval* false]\n (edn/read r)))))))\n" }, { "path": "jepsen/src/jepsen/control/clj_ssh.clj", "content": "(ns jepsen.control.clj-ssh\n \"A CLJ-SSH powered implementation of the Remote protocol.\"\n (:require [clojure.tools.logging :refer [info warn]]\n [clj-ssh.ssh :as ssh]\n [jepsen.control [core :as core]\n [retry :as retry]\n [scp :as scp]]\n [clj-commons.slingshot :refer [try+ throw+]])\n (:import (java.util.concurrent Semaphore)))\n\n(def clj-ssh-agent\n \"Acquiring an SSH agent is expensive and involves a global lock; we save the\n agent and re-use it to speed things up.\"\n (delay (ssh/ssh-agent {})))\n\n(defn clj-ssh-session\n \"Opens a raw session to the given connection spec\"\n [conn-spec]\n (let [agent @clj-ssh-agent\n _ (when-let [key-path (:private-key-path conn-spec)]\n (ssh/add-identity agent {:private-key-path key-path}))]\n (doto (ssh/session agent\n (:host conn-spec)\n (select-keys conn-spec\n [:username\n :password\n :port\n :strict-host-key-checking]))\n (ssh/connect))))\n\n(defmacro with-errors\n \"Takes a conn spec, a context map, and a body. Evals body, remapping clj-ssh\n exceptions to :type :jepsen.control/ssh-failed.\"\n [conn context & body]\n `(try\n ~@body\n (catch com.jcraft.jsch.JSchException e#\n (if (or (= \"session is down\" (.getMessage e#))\n (= \"Packet corrupt\" (.getMessage e#)))\n (throw+ (merge ~conn ~context {:type :jepsen.control/ssh-failed}))\n (throw e#)))))\n\n; TODO: pull out dummy logic into its own remote\n(defrecord Remote [concurrency-limit\n conn-spec\n session\n ^Semaphore semaphore]\n core/Remote\n (connect [this conn-spec]\n (assert (map? conn-spec)\n (str \"Expected a map for conn-spec, not a hostname as a string. Received: \"\n (pr-str conn-spec)))\n (assoc this\n :conn-spec conn-spec\n :session (if (:dummy conn-spec)\n {:dummy true}\n (try+\n (clj-ssh-session conn-spec)\n (catch com.jcraft.jsch.JSchException _\n (throw+ (merge conn-spec\n {:type :jepsen.control/session-error\n :message \"Error opening SSH session. Verify username, password, and node hostnames are correct.\"})))))\n :semaphore (Semaphore. concurrency-limit true)))\n\n (disconnect! [_]\n (when-not (:dummy session) (ssh/disconnect session)))\n\n (execute! [_ ctx action]\n (with-errors conn-spec ctx\n (when-not (:dummy session)\n (.acquire semaphore)\n (try\n (ssh/ssh session action)\n (finally\n (.release semaphore))))))\n\n (upload! [_ ctx local-paths remote-path _opts]\n (with-errors conn-spec ctx\n (when-not (:dummy session)\n (apply ssh/scp-to session local-paths remote-path rest))))\n\n (download! [_ ctx remote-paths local-path _opts]\n (with-errors conn-spec ctx\n (when-not (:dummy session)\n (apply ssh/scp-from session remote-paths local-path rest)))))\n\n(def concurrency-limit\n \"OpenSSH has a standard limit of 10 concurrent channels per connection.\n However, commands run in quick succession with 10 concurrent *also* seem to\n blow out the channel limit--perhaps there's an asynchronous channel teardown\n process. We set the limit a bit lower here. This is experimentally determined\n for clj-ssh by running jepsen.control-test's integration test... \"\n 8)\n\n(defn remote\n \"A remote that does things via clj-ssh.\"\n []\n (-> (Remote. concurrency-limit nil nil nil)\n ; We *can* use our own SCP, but shelling out is faster.\n scp/remote\n retry/remote))\n" }, { "path": "jepsen/src/jepsen/control/core.clj", "content": "(ns jepsen.control.core\n \"Provides the base protocol for running commands on remote nodes, as well as\n common functions for constructing and evaluating shell commands.\"\n (:require [clojure [pprint :refer [pprint]]\n [string :as str]]\n [clojure.tools.logging :refer [info warn]]\n [clj-commons.slingshot :refer [try+ throw+]]))\n\n(defprotocol Remote\n \"Remotes allow jepsen.control to run shell commands, upload, and download\n files. They use a *context map*, which encodes the current user, directory,\n etc:\n\n :dir - The directory to execute remote commands in\n :sudo - The user we want to execute a command as\n :password - The user's password, for sudo, if necessary.\"\n\n (connect [this conn-spec]\n \"Set up the remote to work with a particular node. Returns a Remote which\n is ready to accept actions via `execute!` and `upload!` and `download!`.\n conn-spec is a map of:\n\n {:host\n :post\n :username\n :password\n :private-key-path\n :strict-host-key-checking}\n \")\n\n (disconnect! [this]\n \"Disconnect a remote that has been connected to a host.\")\n\n (execute! [this context action]\n \"Execute the specified action in a remote connected a host. Takes a context\n map, and an action: a map of...\n\n :cmd A string command to execute.\n :in A string to provide for the command's stdin.\n\n Should return the action map with additional keys:\n\n :exit The command's exit status.\n :out The stdout string.\n :err The stderr string.\n \")\n\n (upload! [this context local-paths remote-path opts]\n \"Copy the specified local-path to the remote-path on the connected host.\n\n Opts is an option map. There are no defined options right now, but later we\n might introduce some for e.g. recursive uploads, compression, etc. This is\n also a place for Remote implementations to offer custom semantics.\")\n\n (download! [this context remote-paths local-path opts]\n \"Copy the specified remote-paths to the local-path on the connected host.\n\n TODO: remote-paths is, in fact, a single remote path: it looks like I\n forgot to finish making it multiple paths. May want to fix this later--not\n sure whether it should be a single path or multiple.\n\n Opts is an option map. There are no defined options right now, but later we\n might introduce some for e.g. recursive uploads, compression, etc. This is\n also a place for Remote implementations to offer custom semantics.\"))\n\n(defrecord Literal [string])\n\n(defn lit\n \"A literal string to be passed, unescaped, to the shell.\"\n [s]\n (Literal. s))\n\n(defn escape\n \"Escapes a thing for the shell.\n\n Nils are empty strings.\n\n Literal wrappers are passed through directly.\n\n The special keywords :>, :>>, and :< map to their corresponding shell I/O\n redirection operators.\n\n Named things like keywords and symbols use their name, escaped. Strings are\n escaped like normal.\n\n Sequential collections and sets have each element escaped and\n space-separated.\"\n [s]\n (cond\n (nil? s)\n \"\"\n\n (instance? Literal s)\n (:string s)\n\n (#{:> :>> :<} s)\n (name s)\n\n (or (sequential? s) (set? s))\n (str/join \" \" (map escape s))\n\n :else\n (let [s (if (instance? clojure.lang.Named s)\n (name s)\n (str s))]\n (cond\n ; Empty string\n (= \"\" s)\n \"\\\"\\\"\"\n\n (re-find #\"[\\\\\\$`\\\"\\s\\(\\)\\{\\}\\[\\]\\*\\?<>&;]\" s)\n (str \"\\\"\"\n (str/replace s #\"([\\\\\\$`\\\"])\" \"\\\\\\\\$1\")\n \"\\\"\")\n\n :else s))))\n\n(defn env\n \"We often want to construct env vars for a process. This function takes a map\n of environment variable names (any Named type, e.g. :HOME, \\\"HOME\\\") to\n values (which are coerced using `(str value)`), and constructs a Literal\n string, suitable for passing to exec, which binds those environment\n variables.\n\n Callers of this function (especially indirectly, as with start-stop-daemon),\n may wish to construct env var strings themselves. Passing a string `s` to this\n function simply returns `(lit s)`. Passing a Literal `l` to this function\n returns `l`. nil is passed through unchanged.\"\n [env]\n (cond (map? env) (->> env\n (map (fn [[k v]]\n (str (name k) \"=\" (escape v))))\n (str/join \" \")\n lit)\n\n (instance? Literal env)\n env\n\n (instance? String env)\n (lit env)\n\n (nil? env) nil\n\n :else\n (throw (IllegalArgumentException.\n (str \"Unsure how to construct an environment variable mapping from \" (pr-str env))))))\n\n(defn wrap-sudo\n \"Takes a context map and a command action, and returns the command action,\n modified to wrap it in a sudo command, if necessary. Uses the context map's\n :sudo and :sudo-password fields.\"\n [{:keys [sudo sudo-password]} cmd]\n (if sudo\n (cond-> (assoc cmd :cmd (str \"sudo -k -S -u \" sudo \" bash -c \"\n (escape (:cmd cmd))))\n ; If we have a password, provide it in the input so sudo sees it.\n sudo-password (assoc :in (str sudo-password \"\\n\" (:in cmd))))\n ; Not a sudo context!\n cmd))\n\n(defn throw-on-nonzero-exit\n \"Throws when an SSH result has nonzero exit status.\"\n [{:keys [exit action] :as result}]\n (if (and exit (zero? exit))\n result\n (throw+\n (merge {:type :jepsen.control/nonzero-exit\n :cmd (:cmd action)}\n result)\n nil ; cause\n \"Command exited with non-zero status %d on node %s:\\n%s\\n\\nSTDIN:\\n%s\\n\\nSTDOUT:\\n%s\\n\\nSTDERR:\\n%s\"\n exit\n (:host result)\n (:cmd action)\n (:in action)\n (:out result)\n (:err result))))\n" }, { "path": "jepsen/src/jepsen/control/docker.clj", "content": "(ns jepsen.control.docker\n \"The recommended way is to use SSH to setup and teardown databases. It's\n however sometimes conveniet to be able to setup and teardown the databases\n using `docker exec` and `docker cp` instead, which is what this namespace\n helps you do.\n\n Use at your own risk, this is an unsupported way of running Jepsen.\"\n (:require [clojure.string :as str]\n [clojure.java.shell :refer [sh]]\n [clj-commons.slingshot :refer [throw+]]\n [jepsen.control.core :as core]\n [jepsen.control :as c]))\n\n(defn resolve-container-id\n \"Takes a host, e.g. `localhost:30404`, and resolves the Docker container id\n exposing that port. Due to a bug in Docker\n (https://github.com/moby/moby/pull/40442) this is more difficult than it\n should be.\"\n [host]\n (if-let [[_address port] (str/split host #\":\")]\n (let [ps (:out (sh \"docker\" \"ps\"))\n cid (-> (sh \"awk\" (str \"/\" port \"/ { print $1 }\") :in ps)\n :out\n str/trim-newline)]\n (if (re-matches #\"[a-z0-9]{12}\" cid)\n cid\n (throw+ {:type ::invalid-container-id, :container-id cid})))\n (throw+ {:type ::invalid-host, :host host})))\n\n(defn exec\n \"Execute a shell command on a docker container.\"\n [container-id {:keys [cmd] :as opts}]\n (apply sh\n \"docker\" \"exec\" (c/escape container-id)\n \"sh\" \"-c\" cmd\n (if-let [in (:in opts)]\n [:in in]\n [])))\n\n(defn- path->container\n [container-id path]\n (str container-id \":\" path))\n\n(defn- unwrap-result\n \"Throws when shell returned with nonzero exit status.\"\n [exc-type {:keys [exit] :as result}]\n (if (zero? exit)\n result\n (throw+\n (assoc result :type exc-type)\n nil ; cause\n \"Command exited with non-zero status %d:\\nSTDOUT:\\n%s\\n\\nSTDERR:\\n%s\"\n exit\n (:out result)\n (:err result))))\n\n(defn cp-to\n \"Copies files from the host to a container filesystem.\"\n [container-id local-paths remote-path]\n (doseq [local-path (flatten [local-paths])]\n (->> (sh\n \"docker\" \"cp\"\n (c/escape local-path)\n (c/escape (path->container container-id remote-path)))\n (unwrap-result ::copy-failed))))\n\n(defn cp-from\n \"Copies files from a container filesystem to the host.\"\n [container-id remote-paths local-path]\n (doseq [remote-path (flatten [remote-paths])]\n (->> (sh\n \"docker\" \"cp\"\n (c/escape (path->container container-id remote-path))\n (c/escape local-path))\n (unwrap-result ::copy-failed))))\n\n(defrecord DockerRemote [container-id]\n core/Remote\n (connect [this conn-spec]\n (assoc this :container-id (resolve-container-id (:host conn-spec))))\n (disconnect! [this]\n (dissoc this :container-id))\n (execute! [this ctx action]\n (exec container-id action))\n (upload! [this ctx local-paths remote-path _opts]\n (cp-to container-id local-paths remote-path))\n (download! [this ctx remote-paths local-path _opts]\n (cp-from container-id remote-paths local-path)))\n\n(def docker\n \"A remote that does things via `docker exec` and `docker cp`.\"\n (->DockerRemote nil))\n" }, { "path": "jepsen/src/jepsen/control/k8s.clj", "content": "(ns jepsen.control.k8s\n \"The recommended way is to use SSH to setup and teardown databases.\n It's however sometimes conveniet to be able to setup and teardown\n the databases using `kubectl` instead, which is what this namespace\n helps you do. Use at your own risk, this is an unsupported way\n of running Jepsen.\"\n (:require [clojure.java.shell :refer [sh]]\n [clj-commons.slingshot :refer [throw+]]\n [jepsen.control.core :as core]\n [jepsen.control :as c]\n [clojure.string :refer [split-lines trim]]\n [clojure.tools.logging :refer [info]]))\n\n(defn exec\n \"Execute a shell command on a pod.\"\n [context namespace pod-name {:keys [cmd] :as opts}]\n (apply sh\n \"kubectl\"\n \"exec\"\n (c/escape pod-name)\n context\n namespace\n \"--\"\n \"sh\"\n \"-c\"\n cmd\n (if-let [in (:in opts)]\n [:in in]\n [])))\n\n(defn- path->pod\n [pod-name path]\n (str pod-name \":\" path))\n\n(defn- unwrap-result\n \"Throws when shell returned with nonzero exit status.\"\n [exc-type {:keys [exit] :as result}]\n (if (zero? exit)\n result\n (throw+\n (assoc result :type exc-type)\n nil ; cause\n \"Command exited with non-zero status %d:\\nSTDOUT:\\n%s\\n\\nSTDERR:\\n%s\"\n exit\n (:out result)\n (:err result))))\n\n(defn cp-to\n \"Copies files from the host to a pod filesystem.\"\n [context namespace pod-name local-paths remote-path]\n (doseq [local-path (flatten [local-paths])]\n (->> (sh\n \"kubectl\"\n \"cp\"\n (c/escape local-path)\n (c/escape (path->pod pod-name remote-path))\n context\n namespace)\n (unwrap-result ::copy-failed))))\n\n(defn cp-from\n \"Copies files from a pod filesystem to the host.\"\n [context namespace pod-name remote-paths local-path]\n (doseq [remote-path (flatten [remote-paths])]\n (->> (sh\n \"kubectl\"\n \"cp\"\n (c/escape (path->pod pod-name remote-path))\n (c/escape local-path)\n context\n namespace)\n (unwrap-result ::copy-failed))))\n\n(defn- or-parameter\n \"A helper function that encodes a parameter if present\"\n [p, v]\n (if v (str \"--\" p \"=\" (c/escape v)) \"\"))\n\n(defrecord K8sRemote [context namespace]\n core/Remote\n (connect [this conn-spec]\n (assoc this\n :context (or-parameter \"context\" context)\n :namespace (or-parameter \"namespace\" namespace)\n :pod-name (:host conn-spec)))\n (disconnect! [this]\n (dissoc this :context :namespace :pod-name))\n (execute! [this ctx action]\n (exec context namespace (:pod-name this) action))\n (upload! [this ctx local-paths remote-path _opts]\n (cp-to context namespace (:pod-name this) local-paths remote-path))\n (download! [this ctx remote-paths local-path _opts]\n (cp-from context namespace (:pod-name this) remote-paths local-path)))\n\n(defn k8s\n \"Returns a remote that does things via `kubectl exec` and `kubectl cp`, in the default context and namespacd.\"\n []\n (->K8sRemote nil nil))\n\n(defn list-pods\n \"A helper function to list all pods in a given context/namespace\"\n [context namespace]\n (let [context (or-parameter \"context\" context)\n namespace (or-parameter \"namespace\" namespace)\n res (sh\n \"sh\"\n \"-c\"\n (str \"kubectl get pods \" context \" \" namespace\n \" | tail -n +2 \"\n \" | awk '{print $1}'\"))]\n (lazy-seq (split-lines (trim (:out res))))))\n" }, { "path": "jepsen/src/jepsen/control/net.clj", "content": "(ns jepsen.control.net\n \"Network control functions.\"\n (:refer-clojure :exclude [partition])\n (:require [clojure.string :as str]\n [jepsen.control :as c]\n [clj-commons.slingshot :refer [throw+]])\n (:import (java.net InetAddress\n UnknownHostException)))\n\n(defn reachable?\n \"Can the current node ping the given node?\"\n [node]\n (try (c/exec :ping :-w 1 node) true\n (catch RuntimeException _ false)))\n\n(defn local-ip\n \"The local node's IP address\"\n []\n (first (str/split (c/exec :hostname :-I) #\"\\s+\")))\n\n(defn ip-by-local-dns\n \"Looks up the IP address for a hostname using the local system resolver.\"\n [host]\n (.. (InetAddress/getByName host) getHostAddress))\n\n(defn ip-by-remote-getent\n \"Looks up the IP address for a hostname using the currently bound remote\n node's agetent. This is a useful fallback when the control node doesn't have\n DNS/hosts entries, NS, but the DB nodes do.\"\n [host]\n ; getent output is of the form:\n ; 74.125.239.39 STREAM host.com\n ; 74.125.239.39 DGRAM\n ; ...\n (let [res (c/exec :getent :ahostsv4 host)\n ip (first (str/split (->> res\n (str/split-lines)\n (first))\n #\"\\s+\"))]\n (cond ; Debian Bookworm seems to have changed getent ahosts to return\n ; loopback IPs instead of public ones; when this happens, we fall\n ; back to local-ip.\n (re-find #\"^127\" ip)\n (local-ip)\n\n ; We get this occasionally for reasons I don't understand\n (str/blank? ip)\n (throw+ {:type :blank-getent-ip\n :output res\n :host host})\n\n ; Valid IP\n true\n ip)))\n\n(defn ip*\n \"Look up an ip for a hostname. Unmemoized.\"\n [host]\n (try (ip-by-local-dns host)\n (catch UnknownHostException e\n (ip-by-remote-getent host))))\n\n(def ip\n \"Look up an ip for a hostname. Memoized.\"\n (memoize ip*))\n\n(defn control-ip\n \"Assuming you have a DB node bound in jepsen.client, returns the IP address\n of the *control* node, as perceived by that DB node. This is helpful when you\n want to, say, set up a tcpdump filter which snarfs traffic coming from the\n control node.\"\n []\n ; We have to escape the sudo env for this to work, since the env var doesn't\n ; make its way into subshells.\n (binding [c/*sudo* nil]\n (nth (re-find #\"^(.+?)\\s\"\n (c/exec :bash :-c \"echo $SSH_CLIENT\"))\n 1)))\n" }, { "path": "jepsen/src/jepsen/control/retry.clj", "content": "(ns jepsen.control.retry\n \"SSH client libraries appear to be near universally-flaky. Maybe race\n conditions, maybe underlying network instability, maybe we're just doing it\n wrong. For whatever reason, they tend to throw errors constantly. The good\n news is we can almost always retry their commands safely! This namespace\n provides a Remote which wraps an underlying Remote in a jepsen.reconnect\n wrapper, catching certain exception classes and ensuring they're\n automatically retried.\"\n (:require [clojure.tools.logging :refer [info warn]]\n [dom-top.core :as dt]\n [jepsen [random :as rand]\n [reconnect :as rc]]\n [jepsen.control [core :as core]]\n [clj-commons.slingshot :refer [try+ throw+]]))\n\n(def retries\n \"How many times should we retry exceptions before giving up and throwing?\"\n 5)\n\n(def backoff-time\n \"Roughly how long should we back off when retrying, in ms?\"\n 100)\n\n(defmacro with-retry\n \"Takes a body. Evaluates body, retrying SSH exceptions.\"\n [& body]\n `(dt/with-retry [tries# retries]\n (try+\n ~@body\n (catch [:type :jepsen.control/ssh-failed] e#\n (if (pos? tries#)\n (do (Thread/sleep (long (+ (/ backoff-time 2)\n (rand/long backoff-time))))\n (~'retry (dec tries#)))\n (throw+ e#))))))\n\n(defrecord Remote [remote conn]\n core/Remote\n (connect [this conn-spec]\n ; Construct a conn (a Reconnect wrapper) for the underlying remote, and\n ; open it.\n (let [conn (-> {:open (fn open []\n (core/connect remote conn-spec))\n :close core/disconnect!\n :name [:control (:host conn-spec)]\n :log? :minimal}\n rc/wrapper\n rc/open!)]\n (assoc this :conn conn)))\n\n (disconnect! [this]\n (rc/close! conn))\n\n (execute! [this context action]\n (with-retry\n (rc/with-conn [c conn]\n (core/execute! c context action))))\n\n (upload! [this context local-paths remote-path more]\n (with-retry\n (rc/with-conn [c conn]\n (core/upload! c context local-paths remote-path more))))\n\n (download! [this context remote-paths local-path more]\n (with-retry\n (rc/with-conn [c conn]\n (core/download! c context remote-paths local-path more)))))\n\n(defn remote\n \"Constructs a new Remote by wrapping another Remote in one which\n automatically catches and retries any exception of the form {:type\n :jepsen.control/ssh-failed}.\"\n [remote]\n (Remote. remote nil))\n" }, { "path": "jepsen/src/jepsen/control/scp.clj", "content": "(ns jepsen.control.scp\n \"Built-in JDK SSH libraries can be orders of magnitude slower than plain old\n SCP for copying even medium-sized files of a few GB. This provides a faster\n implementation of a Remote which shells out to SCP.\"\n (:require [clojure.string :as str]\n [clojure.tools.logging :refer [info warn]]\n [jepsen [random :as rand]\n [util :as util]]\n [jepsen.control.core :as core]\n [clj-commons.slingshot :refer [try+ throw+]]))\n\n(def tmp-dir\n \"The remote directory we temporarily store files in while transferring up and\n down.\"\n \"/tmp/jepsen/scp\")\n\n(defn exec!\n \"A super basic exec implementation for our own purposes. At some point we\n might want to pull some? all? of control/exec all the way down into\n control.remote, and get rid of this.\"\n [remote ctx cmd-args]\n (->> cmd-args\n (map core/escape)\n (str/join \" \")\n (hash-map :cmd)\n (core/wrap-sudo ctx)\n (core/execute! remote ctx)\n core/throw-on-nonzero-exit))\n\n(defmacro with-tmp-dir\n \"Evaluates body. If a nonzero exit status occurs, forces the tmp dir to\n exist, and re-evals body. We do this to avoid the overhead of checking for\n existence every time someone wants to upload/download a file.\"\n [remote ctx & body]\n `(try+ ~@body\n (catch (#{:jepsen.control/nonzero-exit\n :jepsen.util/nonzero-exit}\n (:type ~'%)) e#\n (exec! ~remote ~ctx [:mkdir :-p tmp-dir])\n (exec! ~remote ~ctx [:chmod \"a+rwx\" tmp-dir])\n ~@body)))\n\n(defn tmp-file\n \"Returns a randomly generated tmpfile for use during uploads/downloads\"\n []\n (str tmp-dir \"/\" (rand/long Integer/MAX_VALUE)))\n\n(defmacro with-tmp-file\n \"Evaluates body with tmp-file-sym bound to the remote path of a temporary\n file. Cleans up file at exit.\"\n [remote ctx [tmp-file-sym] & body]\n `(let [~tmp-file-sym (tmp-file)\n ; We're going to want to do our tmpfile management as root in case\n ; /tmp/jepsen already exists and we don't own it. Blegh.\n ctx# (assoc ~ctx :sudo \"root\")]\n (try (with-tmp-dir ~remote ctx# ~@body)\n (finally\n (exec! ~remote ctx# [:rm :-f ~tmp-file-sym])))))\n\n(defn scp!\n \"Runs an SCP command by shelling out. Takes a conn-spec (used for port, key,\n etc), a seq of sources, and a single destination, all as strings.\"\n [conn-spec sources dest]\n (apply util/sh \"scp\" \"-rpC\"\n \"-P\" (str (:port conn-spec))\n (concat (when-let [k (:private-key-path conn-spec)]\n [\"-i\" k])\n (if-not (:strict-host-key-checking conn-spec)\n [\"-o StrictHostKeyChecking=no\"])\n sources\n [dest]))\n nil)\n\n(defn remote-path\n \"Returns the string representation of a remote path using a conn spec; e.g.\n admin@n1:/foo/bar\"\n [{:keys [username host]} path]\n (assert host \"No node given for remote-path!\")\n (str (when username\n (str username \"@\"))\n host \":\" path))\n\n(defrecord Remote [cmd-remote conn-spec]\n core/Remote\n (connect [this conn-spec]\n (-> this\n (assoc :conn-spec conn-spec)\n (update :cmd-remote core/connect conn-spec)))\n\n (disconnect! [this]\n (update this :cmd-remote core/disconnect!))\n\n (execute! [this ctx action]\n (core/execute! cmd-remote ctx action))\n\n (upload! [this ctx srcs dest _]\n (let [sudo (:sudo ctx)]\n (if (or (nil? sudo) (= sudo (:user conn-spec)))\n ; We can upload directly using our connection credentials.\n (scp! conn-spec\n (util/coll srcs)\n (remote-path conn-spec dest))\n\n ; We need to become a different user for this. Upload each source to a\n ; tmpfile and rename.\n (with-tmp-file cmd-remote ctx [tmp]\n (doseq [src (util/coll srcs)]\n ; Upload to tmpfile\n (core/upload! this {} src tmp nil)\n ; Chown and move to dest, as root\n (exec! cmd-remote {:sudo \"root\"} [:chown sudo tmp])\n (exec! cmd-remote {:sudo \"root\"} [:mv tmp dest]))))))\n\n (download! [this ctx srcs dest _]\n (let [sudo (:sudo ctx)]\n (if (or (nil? sudo) (= sudo (:user conn-spec)))\n ; We can download directly using our conn credentials.\n (scp! conn-spec\n (->> (util/coll srcs)\n (map (partial remote-path conn-spec)))\n dest)\n ; We need to copy each file to a tmpfile we CAN read before downloading\n ; it.\n (doseq [src (util/coll srcs)]\n (with-tmp-file cmd-remote ctx [tmp]\n ; See if we can read this source as the current user, even if\n ; it's not our own file\n (if (try+ (exec! cmd-remote {} [:head :-n 1 src]) true\n (catch [:exit 1] _ false))\n ; We can directly download this file.\n (core/download! this {} src dest nil)\n ; Nope; gotta copy. Try a hardlink?\n (do (try+ (exec! cmd-remote {:sudo \"root\"} [:ln :-L src tmp])\n (catch [:exit 1] _\n ; Fine, maybe a different fs. Try a full copy.\n (exec! cmd-remote {:sudo \"root\"}\n [:cp src tmp])))\n ; Make the tmpfile readable to us\n (exec! cmd-remote {:sudo \"root\"} [:chown sudo tmp])\n ; Download it\n (core/download! this {} tmp dest nil)))))))))\n\n(defn remote\n \"Takes a remote which can execute commands, and wraps it in a remote which\n overrides upload & download to use SCP.\"\n [cmd-remote]\n (Remote. cmd-remote nil))\n" }, { "path": "jepsen/src/jepsen/control/sshj.clj", "content": "(ns jepsen.control.sshj\n \"An sshj-backed control Remote. Experimental; I'm considering replacing\n jepsen.control's use of clj-ssh with this instead.\"\n (:require [byte-streams :as bs]\n [clojure.java.io :as io]\n [clojure.tools.logging :refer [info warn]]\n [jepsen [util :as util]]\n [jepsen.control [core :as core]\n [retry :as retry]\n [scp :as scp]]\n [clj-commons.slingshot :refer [try+ throw+]])\n (:import (com.jcraft.jsch.agentproxy AgentProxy\n AgentProxyException\n ConnectorFactory)\n (com.jcraft.jsch.agentproxy.sshj AuthAgent)\n (net.schmizz.sshj SSHClient)\n (net.schmizz.sshj.common IOUtils\n Message\n SSHPacket)\n (net.schmizz.sshj.connection ConnectionException)\n (net.schmizz.sshj.connection.channel OpenFailException)\n (net.schmizz.sshj.connection.channel.direct Session)\n (net.schmizz.sshj.transport.verification PromiscuousVerifier)\n (net.schmizz.sshj.userauth UserAuthException)\n (net.schmizz.sshj.userauth.method AuthMethod)\n (net.schmizz.sshj.xfer FileSystemFile\n LocalDestFile)\n (java.io IOException\n InterruptedIOException)\n (java.util.concurrent Semaphore\n TimeUnit)))\n\n(defn ^Iterable auth-methods\n \"Returns a list of AuthMethods we can use for logging in via an AgentProxy.\"\n [^AgentProxy agent]\n (map (fn [identity]\n (AuthAgent. agent identity))\n (.getIdentities agent)))\n\n(defn ^AgentProxy agent-proxy\n []\n (-> (ConnectorFactory/getDefault)\n .createConnector\n AgentProxy.))\n\n(defn auth!\n \"Tries a bunch of ways to authenticate an SSHClient. We start with the given\n key file, if provided, then fall back to general public keys, then fall back\n to username/password.\"\n [^SSHClient c {:keys [username password private-key-path] :as conn-spec}]\n (or ; Try given key\n (when-let [k private-key-path]\n (.authPublickey c ^String username\n ^\"[Ljava.lang.String;\" (into-array String [k]))\n true)\n\n ; Try agent\n (try\n (let [agent-proxy (agent-proxy)\n methods (auth-methods agent-proxy)]\n (.auth c ^String username methods)\n true)\n (catch AgentProxyException e\n false)\n (catch UserAuthException e\n false))\n\n ; Fall back to standard id_rsa/id_dsa keys\n (try (.authPublickey c ^String username)\n true\n (catch UserAuthException e\n false))\n\n ; OK, standard keys didn't work, try username+password\n (.authPassword c ^String username ^String password)))\n\n(defn send-eof!\n \"There's a bug in SSHJ where it doesn't send an EOF when you close the\n session's outputstream, which causes the remote command to hang indefinitely.\n To work around this, we send an EOF message ourselves. I'm not at all sure\n this is threadsafe; it might cause issues later.\"\n [^SSHClient client, ^Session session]\n (.. client\n getTransport\n (write (.. (SSHPacket. Message/CHANNEL_EOF)\n (putUInt32 (.getRecipient session))))))\n\n(defn handle-error\n \"Takes an connection, a context map, and an SSHJ exception. Throws if it was\n caused by an InterruptedException or InterruptedIOException. Otherwise, wraps\n it in a :ssh-failed exception map, and throws that.\"\n [conn context e]\n ; SSHJ wraps InterruptedExceptions in its own exceptions, and we need\n ; those to bubble up properly.\n (let [cause (util/ex-root-cause e)]\n (when (or (instance? InterruptedException cause)\n (instance? InterruptedIOException cause))\n (throw cause)))\n (throw+ (merge conn context {:type :jepsen.control/ssh-failed})\n e))\n\n(defmacro with-errors\n \"Takes a conn spec, a context map, and a body. Evals body, remapping SSHJ\n exceptions to :type :jepsen.control/ssh-failed.\"\n [conn context & body]\n `(try\n ~@body\n ; This gets thrown when the underlying transport is not connected during\n ; session initiation\n (catch IllegalStateException e# (handle-error ~conn ~context e#))\n (catch ConnectionException e# (handle-error ~conn ~context e#))\n (catch OpenFailException e# (handle-error ~conn ~context e#))))\n\n(defrecord SSHJRemote [concurrency-limit\n conn-spec\n ^SSHClient client\n ^Semaphore semaphore]\n core/Remote\n (connect [this conn-spec]\n (if (:dummy conn-spec)\n (assoc this :conn-spec conn-spec)\n (try+ (let [c (as-> (SSHClient.) client\n (do\n (if (:strict-host-key-checking conn-spec)\n (.loadKnownHosts client)\n (.addHostKeyVerifier client (PromiscuousVerifier.)))\n (.connect client\n ^String (:host conn-spec)\n (int (:port conn-spec)))\n (auth! client conn-spec)\n client))]\n (assoc this\n :conn-spec conn-spec\n :client c\n :semaphore (Semaphore. concurrency-limit true)))\n (catch Exception e\n ; SSHJ wraps InterruptedException in its own exceptions, so we\n ; have to see through that and rethrow properly.\n (let [cause (util/ex-root-cause e)]\n (when (instance? InterruptedException cause)\n (throw cause)))\n (throw+ (assoc conn-spec\n :type :jepsen.control/session-error\n :message \"Error opening SSH session. Verify username, password, and node hostnames are correct.\"))))))\n\n (disconnect! [this]\n (when-let [c client]\n (.close c)))\n\n (execute! [this ctx action]\n ; (info :permits (.availablePermits semaphore))\n (when (:dummy conn-spec)\n (throw+ {:type :jepsen.control/dummy}))\n (.acquire semaphore)\n (with-errors conn-spec ctx\n (try\n (with-open [session (.startSession client)]\n (let [cmd (.exec session (:cmd action))\n ; Feed it input\n _ (when-let [input (:in action)]\n (let [stream (.getOutputStream cmd)]\n (bs/transfer input stream)\n (send-eof! client session)\n (.close stream)))\n ; Read output\n out (.toString (IOUtils/readFully (.getInputStream cmd)))\n err (.toString (IOUtils/readFully (.getErrorStream cmd)))\n ; Wait on command\n _ (.join cmd)]\n ; Return completion\n (assoc action\n :out out\n :err err\n ; There's also a .getExitErrorMessage that might be\n ; interesting here?\n :exit (.getExitStatus cmd))))\n (finally\n (.release semaphore)))))\n\n (upload! [this ctx local-paths remote-path _opts]\n (when (:dummy conn-spec)\n (throw+ {:type :jepsen.control/dummy}))\n (with-errors conn-spec ctx\n (with-open [sftp (.newSFTPClient client)]\n (.put sftp (FileSystemFile. (io/file local-paths))\n ^String remote-path))))\n\n (download! [this ctx remote-paths local-path _opts]\n (when (:dummy conn-spec)\n (throw+ {:type :jepsen.control/dummy}))\n (with-errors conn-spec ctx\n (let [local-file ^LocalDestFile (FileSystemFile. (io/file local-path))]\n (with-open [sftp (.newSFTPClient client)]\n (.get sftp ^String remote-paths local-file))))))\n\n(def concurrency-limit\n \"OpenSSH has a standard limit of 10 concurrent channels per connection.\n However, commands run in quick succession with 10 concurrent *also* seem to\n blow out the channel limit--perhaps there's an asynchronous channel teardown\n process. We set the limit a bit lower here. This is experimentally determined\n by running jepsen.control-test's integration test... \"\n 6)\n\n(defn remote\n \"Constructs an SSHJ remote.\"\n []\n (-> (SSHJRemote. concurrency-limit nil nil nil)\n ; We *can* use our own SCP, but shelling out is faster.\n scp/remote\n retry/remote))\n" }, { "path": "jepsen/src/jepsen/control/util.clj", "content": "(ns jepsen.control.util\n \"Utility functions for scripting installations.\"\n (:require [jepsen [control :refer :all]\n [random :as rand]\n [util :as util :refer [meh name+ timeout]]]\n [jepsen.control.core :as core]\n [clojure.data.codec.base64 :as b64]\n [clojure.java.io :refer [file]]\n [clojure.tools.logging :refer [info warn]]\n [clojure.string :as str]\n [clj-commons.slingshot :refer [try+ throw+]]))\n\n(def tmp-dir-base \"Where should we put temporary files?\" \"/tmp/jepsen\")\n\n(defn await-tcp-port\n \"Blocks until a local TCP port is bound. Options:\n\n :retry-interval How long between retries, in ms. Default 1s.\n :log-interval How long between logging that we're still waiting, in ms.\n Default `retry-interval.\n :timeout How long until giving up and throwing :type :timeout, in\n ms. Default 60 seconds.\"\n ([port]\n (await-tcp-port port {}))\n ([port opts]\n (util/await-fn\n (fn check-port []\n (exec :nc :-z :localhost port)\n nil)\n (merge {:log-message (str \"Waiting for port \" port \" ...\")}\n opts))))\n\n(defn file?\n \"Is `filename` a regular file that exists?\"\n [filename]\n (try+\n (exec :test :-f filename)\n true\n (catch [:exit 1] _\n false)))\n\n(defn exists?\n \"Is a path present?\"\n [filename]\n (try (exec :stat filename)\n true\n (catch RuntimeException _ false)))\n\n(defn ls\n \"A seq of directory entries (not including . and ..). Options:\n\n {:recursive? If set, lists entries recursively\n :types A collection like [:file :dir], filtering what kinds of\n entries are returned\n :full-path? Return the full path, rather than the path within dir}\n\n TODO: escaping for control chars in filenames (if you do this, WHO ARE\n YOU???)\"\n ([] (ls \".\"))\n ([dir] (ls dir {}))\n ([dir opts]\n (let [^String dir (name dir)\n ; Remove trailing slashes; we do this to simplify removing the dir\n ; prefix later\n dir (str/replace dir #\"/+$\" \"\")\n ; Construct -type arg\n types (when (:types opts)\n [\"-type\"\n (->> (:types opts)\n (map (fn [t]\n (case t\n :block \"b\"\n :char \"c\"\n :dir \"d\"\n :file \"f\"\n :pipe \"p\"\n :socket \"s\"\n :symlink \"l\")))\n (str/join \",\"))])\n ; Search for files\n lines (exec :find dir\n types\n [\"-mindepth\" 1] ; Don't list the dir itself\n (when-not (:recursive? opts)\n [\"-maxdepth\" 1]))\n ; Split lines\n paths (str/split lines #\"\\n\")\n ; Strip off dir prefix\n paths (if (:full-path? opts)\n paths\n (let [c (inc (.length dir))]\n (map (fn strip-dir [^String path]\n (assert (.startsWith path dir))\n (subs path c))\n paths)))]\n ; Find's traversal order is by inode structure, so we sort for stability\n (sort paths))))\n\n(defn ls-full\n \"Like ls, but prepends dir to each entry. TODO: deprecate this in favor of ls\n {:full-path? true}.\"\n ([] (ls-full \".\"))\n ([dir] (ls-full dir {}))\n ([dir opts]\n (ls dir (assoc opts {:full-path? true}))))\n\n(defn tmp-file!\n \"Creates a random, temporary file under tmp-dir-base, and returns its path.\n Optionally takes an extension--default is \\\".tmp\\\"\"\n ([]\n (tmp-file! \".tmp\"))\n ([ext]\n (let [file (str tmp-dir-base \"/\" (rand/long Integer/MAX_VALUE) ext)]\n (if (exists? file)\n (recur ext)\n (do\n (try+\n (exec :touch file)\n (catch [:exit 1] _\n ; Parent dir might not exist\n (exec :mkdir :-p tmp-dir-base)\n (exec :touch file)))\n file)))))\n\n(defn tmp-dir!\n \"Creates a temporary directory under /tmp/jepsen and returns its path.\"\n []\n (let [dir (str tmp-dir-base \"/\" (rand/long Integer/MAX_VALUE))]\n (if (exists? dir)\n (recur)\n (do\n (exec :mkdir :-p dir)\n dir))))\n\n(defn write-file!\n \"Writes a string to a filename.\"\n [string file]\n (let [cmd (->> [:cat :> file]\n (map escape)\n (str/join \" \"))\n action {:cmd cmd\n :in string}]\n (-> action\n wrap-cd\n wrap-sudo\n wrap-trace\n ssh*\n core/throw-on-nonzero-exit)\n file))\n\n(def std-wget-opts\n \"A list of standard options we pass to wget\"\n [:--tries 20\n :--waitretry 60\n :--retry-connrefused\n :--dns-timeout 60\n :--connect-timeout 60\n :--read-timeout 60])\n\n(defn wget-helper!\n \"A helper for wget! and cached-wget!. Calls wget with options; catches name\n resolution and other network errors, and retries them. EC2 name resolution\n can be surprisingly flaky.\"\n [& args]\n (loop [tries 5]\n (let [res (try+\n (exec :wget args)\n (catch [:type :jepsen.control/nonzero-exit, :exit 4] e\n (if (pos? tries)\n ::retry\n (throw+ e))))]\n (if (= ::retry res)\n (recur (dec tries))\n res))))\n\n\n; TODO: only force? should have a ?, because it's a boolean. User and pw\n; should be renamed without ?, and probably use whatever username/password\n; naming convention we use in jepsen.control etc.\n(defn wget!\n \"Downloads a string URL and returns the filename as a string. Skips if the\n file already exists.\n\n Options:\n\n :force? Even if we have this cached, download the tarball again anyway.\n :user? User for wget authentication. If provided, valid pw must also be provided.\n :pw? Password for wget authentication.\"\n ([url]\n (wget! url {:force? false}))\n ([url opts]\n (let [filename (.getName (file url))\n wget-opts std-wget-opts\n ; second parameter was changed from a boolean flag (force?) to an\n ; options map this check is here for backwards compatibility\n opts (if (map? opts) opts {:force? opts})]\n (when (:force? opts)\n (exec :rm :-f filename))\n (when-not (empty? (:user? opts))\n (concat wget-opts [:--user (:user? opts) :--password (:pw? opts)]))\n (when (not (exists? filename))\n (wget-helper! wget-opts url))\n filename)))\n\n(def wget-cache-dir\n \"Directory for caching files from the web.\"\n (str tmp-dir-base \"/wget-cache\"))\n\n(defn encode\n \"base64 encode a given string and return the encoded string in utf8\"\n [^String s]\n (String. ^bytes (b64/encode (.getBytes s)) \"UTF-8\"))\n\n(defn cached-wget!\n \"Downloads a string URL to the Jepsen wget cache directory, and returns the\n full local filename as a string. Skips if the file already exists. Local\n filenames are base64-encoded URLs, as opposed to the name of the file--this\n is helpful when you want to download a package like\n https://foo.com/v1.2/foo.tar; since the version is in the URL but not a part\n of the filename, downloading a new version could silently give you the old\n version instead.\n\n Options:\n\n :force? Even if we have this cached, download the tarball again anyway.\n :user? User for wget authentication. If provided, valid pw must also be provided.\n :pw? Password for wget authentication.\"\n ([url]\n (cached-wget! url {:force? false}))\n ([url opts]\n (let [encoded-url (encode url)\n dest-file (str wget-cache-dir \"/\" encoded-url)\n wget-opts (if (empty? (:user? opts))\n (concat std-wget-opts [:-O dest-file])\n (concat std-wget-opts [:-O dest-file :--user (:user? opts) :--password (:pw? opts)]))]\n (when (:force? opts)\n (info \"Clearing cached copy of\" url)\n (exec :rm :-rf dest-file))\n (when-not (exists? dest-file)\n (info \"Downloading\" url)\n (do (exec :mkdir :-p wget-cache-dir)\n (cd wget-cache-dir\n (wget-helper! wget-opts url))))\n dest-file)))\n\n(defn install-archive!\n \"Gets the given tarball URL, caching it in /tmp/jepsen/, and extracts its\n sole top-level directory to the given dest directory. Deletes\n current contents of dest. Supports both zip files and tarballs, compressed or\n raw. Returns dest.\n\n URLs can be HTTP, HTTPS, or file://, in which case they are interpreted as a\n file path on the remote node.\n\n Standard practice for release tarballs is to include a single directory,\n often named something like foolib-1.2.3-amd64, with files inside it. If only\n a single directory is present, its *contents* will be moved to dest, so\n foolib-1.2.3-amd64/my.file becomes dest/my.file. If the tarball includes\n multiple files, those files are moved to dest, so my.file becomes\n dest/my.file.\n\n Options:\n\n :force? Even if we have this cached, download the tarball again anyway.\n :user? User for wget authentication. If provided, valid pw must also be provided.\n :pw? Password for wget authentication.\"\n ([url dest]\n (install-archive! url dest {:force? false}))\n ([url dest opts]\n (let [local-file (nth (re-find #\"file://(.+)\" url) 1)\n file (or local-file (cached-wget! url opts))\n tmpdir (tmp-dir!)\n dest (expand-path dest)]\n\n ; Clean up old dest and make sure parent directory is ready\n (exec :rm :-rf dest)\n (let [parent (exec :dirname dest)]\n (exec :mkdir :-p parent))\n\n (try+\n (cd tmpdir\n ; Extract archive to tmpdir\n (if (re-find #\".*\\.zip$\" url)\n (exec :unzip file)\n (exec :tar :--no-same-owner :--no-same-permissions\n :--extract :--file file))\n\n ; Force ownership\n (when (= \"root\" *sudo*)\n (exec :chown :-R \"root:root\" \".\"))\n\n ; Get archive root paths\n (let [roots (ls)]\n (assert (pos? (count roots)) \"Archive contained no files\")\n\n (if (= 1 (count roots))\n ; Move root's contents to dest\n (exec :mv (first roots) dest)\n\n ; Move all roots to dest\n (exec :mv tmpdir dest))))\n\n (catch [:type :jepsen.control/nonzero-exit] e\n (let [err (:err e)]\n (if (or (re-find #\"tar: Unexpected EOF\" err)\n (re-find #\"This does not look like a tar archive\" err)\n (re-find #\"cannot find zipfile directory\" err))\n (if local-file\n ; Nothing we can do to recover here\n (throw (RuntimeException.\n (str \"Local archive \" local-file \" on node \"\n *host*\n \" is corrupt: \" err)))\n ; Retry download once; maybe it was abnormally terminated\n (do (info \"Retrying corrupt archive download\")\n (exec :rm :-rf file)\n (install-archive! url dest opts)))\n\n ; Throw by default\n (throw+ e))))\n\n (finally\n ; Clean up tmpdir\n (exec :rm :-rf tmpdir))))\n dest))\n\n(defn tarball!\n \"Takes a path and creates a .tar.gz file of it, stored in a Jepsen temporary\n directory. Returns the path to the tarball. Especially useful for tarring up\n data directories on a DB node. In the 2-arity form, takes the tarball\n filename as a second argument.\n\n Ignores failed reads--these happen often when tarring up data and log files\n from nodes that are crashing, and getting some data is better than crashing\n the test.\"\n ([path]\n (tarball! path (tmp-file! \".tar.gz\")))\n ([path tarball]\n (let [[match dir file] (re-find #\"^(.+/)(.+)$\" path)]\n (try (if match\n ; Only create one directory level deep\n (cd dir\n (exec :tar\n \"czf\" tarball\n \"--ignore-failed-read\"\n file))\n (exec :tar\n \"czf\" tarball\n \"--ignore-failed-read\"\n path))\n (catch RuntimeException e\n (meh (exec :rm :f tarball))\n (throw e)))\n tarball)))\n\n(defn ensure-user!\n \"Make sure a user exists.\"\n [username]\n (try (su (exec :adduser :--disabled-password :--gecos (lit \"''\") username))\n (catch RuntimeException e\n (when-not (re-find #\"already exists\" (.getMessage e))\n (throw e))))\n username)\n\n(defn grepkill!\n \"Kills processes by grepping for the given string. If a signal is given,\n sends that signal instead. Signals may be either numbers or names, e.g.\n :term, :hup, ...\"\n ([pattern]\n (grepkill! 9 pattern))\n ([signal pattern]\n ; Hahaha we'd like to use pkill here, but because we run sudo commands in a\n ; bash wrapper (`bash -c \"pkill ...\"`), we'd end up matching the bash wrapper\n ; and killing that as WELL, so... grep and awk it is! The grep -v makes sure\n ; we don't kill the grep process OR the bash process executing it.\n (try+ (exec ;:ps :aux\n ;| :grep pattern\n ;| :grep :-v \"grep\"\n ;| :awk \"{print $2}\"\n :pgrep :-f :--ignore-ancestors pattern\n | :xargs :--no-run-if-empty :kill (str \"-\" (name+ signal)))\n (catch [:type :jepsen.control/nonzero-exit, :exit 0] _\n nil)\n (catch [:type :jepsen.control/nonzero-exit, :exit 123] e\n (if (re-find #\"No such process\" (:err e))\n ; Ah, process already exited\n nil\n (throw+ e))))))\n\n(defn start-daemon!\n \"Starts a daemon process, logging stdout and stderr to the given file.\n Invokes `bin` with `args`. Options are:\n\n :env Environment variables for the invocation of\n start-stop-daemon. Should be a Map of env var names to\n string values, like {:SEEDS \\\"flax, cornflower\\\"}. See\n jepsen.control/env for alternative forms.\n :background?\n :chdir\n :exec Sets a custom executable to check for.\n :logfile\n :make-pidfile?\n :match-executable? Helpful for cases where the daemon is a wrapper script\n that execs another process, so that pidfile management\n doesn't work right. When this option is true, we ask\n start-stop-daemon to check for any process running the\n given executable program: either :exec or the `bin`\n argument.\n :match-process-name? Helpful for cases where the daemon is a wrapper script\n that execs another process, so that pidfile management\n doesn't work right. When this option is true, we ask\n start-stop-daemon to check for any process with a COMM\n field matching :process-name (or the name of the bin).\n :pidfile Where should we write (and check for) the pidfile? If\n nil, doesn't use the pidfile at all.\n :process-name Overrides the process name for :match-process-name?\n\n Returns :started if the daemon was started, or :already-running if it was\n already running, or throws otherwise.\"\n [opts bin & args]\n (let [env (env (:env opts))\n ssd-args [:--start\n (when (:background? opts true) [:--background :--no-close])\n (when (and (:pidfile opts) (:make-pidfile? opts true))\n :--make-pidfile)\n (when (:match-executable? opts true)\n [:--exec (or (:exec opts) bin)])\n (when (:match-process-name? opts false)\n [:--name (:process-name opts (.getName (file bin)))])\n (when (:pidfile opts)\n [:--pidfile (:pidfile opts)])\n :--chdir (:chdir opts)\n :--startas bin\n :--\n args\n :>> (:logfile opts) (lit \"2>&1\")]]\n (info \"Starting\" (.getName (file (name bin))))\n (exec :echo (lit \"`date +'%Y-%m-%d %H:%M:%S'`\")\n (str \"Jepsen starting \" (escape env) \" \" bin \" \" (escape args))\n :>> (:logfile opts))\n (try+\n ;(info \"start-stop-daemon\" (escape ssd-args))\n (exec env :start-stop-daemon ssd-args)\n :started\n (catch [:type :jepsen.control/nonzero-exit\n :exit 1] e\n :already-running))))\n\n(defn stop-daemon!\n \"Kills a daemon process, and cleans up its pidfile. Takes a pidfile, an\n optional commmand string, and an optional signal. Kills process and cleans up\n pidfile.\n\n Pidfiles can be unreliable; it is easy to get into a situation with daemons\n running without a corresponding pidfile, which will break future runs of the\n test. For this reason we prefer killing all instances of `cmd`, and only kill\n the contents of the pidfile if no command is given.\n\n Signals can be numbers or strings; they're used in `kill -SIGNAL_NAME ...`\"\n ([pidfile]\n (stop-daemon! nil pidfile))\n ([cmd pidfile]\n (stop-daemon! cmd pidfile 9))\n ([cmd pidfile signal]\n (assert (or cmd pidfile) \"Must provide at least a command or a pidfile\")\n (let [signal (str \"-\" (name+ signal))]\n (if cmd\n ; Kill by command\n (do (info \"Stopping\" cmd \"with signal\" signal)\n (timeout 30000 (throw+ {:type ::kill-timed-out\n :cmd cmd\n :pidfile pidfile})\n (meh (exec :killall signal :-w cmd))))\n\n ; No command; go by pidfile\n (when (exists? pidfile)\n (info \"Stopping\" pidfile \"with signal\" signal)\n (let [pid (Long/parseLong (exec :cat pidfile))]\n (meh (exec :kill signal pid)))))\n\n ; Clean up pidfile either way\n (when pidfile\n (meh (exec :rm :-rf pidfile))))))\n\n(defn daemon-running?\n \"Given a pidfile, returns true if the pidfile is present and the process it\n contains is alive, nil if the pidfile is absent, false if it's present and\n the process doesn't exist.\n\n Strictly this doesn't mean the process is RUNNING; it could be asleep or a\n zombie, but you know what I mean. ;-)\"\n [pidfile]\n (when-let [pid (meh (exec :cat pidfile))]\n (try (exec :ps :-o \"pid=\" :-p pid)\n (catch RuntimeException e\n false))))\n\n(defn signal!\n \"Sends a signal to a named process by signal number or name.\"\n [process-name signal]\n (meh (exec :pkill :--signal signal process-name))\n :signaled)\n" }, { "path": "jepsen/src/jepsen/control.clj", "content": "(ns jepsen.control\n \"Provides control over a remote node. There's a lot of dynamically bound\n state in this namespace because we want to make it as simple as possible for\n scripts to open connections to various nodes.\n\n Note that a whole bunch of this namespace refers to things as 'ssh',\n although they really can apply to any remote, not just SSH.\"\n (:require [jepsen.util :as util :refer [real-pmap with-thread-name]]\n [jepsen.control [clj-ssh :as clj-ssh]\n [core :as core\n :refer [connect\n disconnect!\n execute!\n upload!\n download!]]\n [sshj :as sshj]]\n [potemkin :refer [import-vars]]\n [clojure.string :as str]\n [clojure.java.io :as io]\n [clojure.tools.logging :refer [warn info debug error]]\n [clj-commons.slingshot :refer [try+ throw+]])\n (:import java.io.File\n (java.util.concurrent Semaphore)))\n\n; These used to be in jepsen.control, but have been moved to\n; jepsen.control.core as a part of the polymorphic Remote protocol work. We\n; preserve them here for backwards compatibility.\n(import-vars\n [jepsen.control.core\n env\n escape\n lit\n throw-on-nonzero-exit])\n\n(def clj-ssh\n \"The clj-ssh SSH remote. This used to be the default.\"\n (clj-ssh/remote))\n\n(def ssh\n \"The default (SSHJ-backed) remote.\"\n (sshj/remote))\n\n; STATE STATE STATE STATE\n(def ^:dynamic *dummy* \"When true, don't actually use SSH\" nil)\n(def ^:dynamic *host* \"Current hostname\" nil)\n(def ^:dynamic *session* \"Current control session wrapper\" nil)\n(def ^:dynamic *trace* \"Shall we trace commands?\" false)\n(def ^:dynamic *dir* \"Working directory\" \"/\")\n(def ^:dynamic *sudo* \"User to sudo to\" nil)\n(def ^:dynamic *sudo-password* \"Password for sudo, if needed\" nil)\n(def ^:dynamic *username* \"Username\" \"root\")\n(def ^:dynamic *password* \"Password (for login)\" \"root\")\n(def ^:dynamic *port* \"SSH listening port\" 22)\n(def ^:dynamic *private-key-path* \"SSH identity file\" nil)\n(def ^:dynamic *strict-host-key-checking* \"Verify SSH host keys\" :yes)\n(def ^:dynamic *remote* \"The remote to use for remote control actions\" ssh)\n(def ^:dynamic *retries* \"How many times to retry conns\" 5)\n\n(defn conn-spec\n \"jepsen.control originally stored everything--host, post, etc.--in separate\n dynamic variables. Now, we store these things in a conn-spec map, which can\n be passed to remotes without creating cyclic dependencies. This function\n exists to support the transition from those variables to a conn-spec, and\n constructs a conn spec from current var bindings.\"\n []\n {; TODO: pull this out of conn-spec and the clj-ssh remote, and create\n ; a specialized remote for it.\n :dummy *dummy*\n :host *host*\n :port *port*\n :username *username*\n :password *password*\n :private-key-path *private-key-path*\n :strict-host-key-checking *strict-host-key-checking*})\n\n(defn cmd-context\n \"Constructs a context map for a command's execution from dynamically bound\n vars.\"\n []\n {:dir *dir*\n :sudo *sudo*\n :sudo-password *sudo-password*})\n\n(defn debug-data\n \"Construct a map of SSH data for debugging purposes.\"\n []\n {:dummy *dummy*\n :host *host*\n :session *session*\n :dir *dir*\n :sudo *sudo*\n :sudo-password *sudo-password*\n :username *username*\n :password *password*\n :port *port*\n :private-key-path *private-key-path*\n :strict-host-key-checking *strict-host-key-checking*})\n\n(def |\n \"A literal pipe character.\"\n (lit \"|\"))\n\n(def &&\n \"A literal &&\"\n (lit \"&&\"))\n\n(defn wrap-sudo\n \"Wraps command in a sudo subshell.\"\n [cmd]\n (core/wrap-sudo (cmd-context) cmd))\n\n(defn wrap-cd\n \"Wraps command by changing to the current bound directory first.\"\n [cmd]\n (if *dir*\n (assoc cmd :cmd (str \"cd \" (escape *dir*) \"; \" (:cmd cmd)))\n cmd))\n\n(defn wrap-trace\n \"Logs argument to console when tracing is enabled.\"\n [arg]\n (do (when *trace* (info \"Host:\" *host* \"arg:\" arg))\n arg))\n\n(defn just-stdout\n \"Returns the stdout from an ssh result, trimming any newlines at the end.\"\n [result]\n (str/trim-newline (:out result)))\n\n(defn ssh*\n \"Evaluates an SSH action against the current host. Retries packet corrupt\n errors.\"\n [action]\n (when (nil? *session*)\n (throw+ (merge {:type ::no-session-available\n :message \"Unable to perform a control action because no session for this host is available.\"}\n (debug-data))))\n (assoc (execute! *session* (cmd-context) action)\n :host *host*\n :action action))\n\n(defn exec*\n \"Like exec, but does not escape.\"\n [& commands]\n (->> commands\n (str/join \" \")\n (array-map :cmd)\n wrap-cd\n wrap-sudo\n wrap-trace\n ssh*\n core/throw-on-nonzero-exit\n just-stdout))\n\n(defn exec\n \"Takes a shell command and arguments, runs the command, and returns stdout,\n throwing if an error occurs. Escapes all arguments.\"\n [& commands]\n (->> commands\n (map escape)\n (apply exec*)))\n\n(defn file->path\n \"Takes an object, if it's an instance of java.io.File, gets the path, otherwise\n returns the object\"\n [x]\n (if (instance? java.io.File x)\n (.getCanonicalPath ^File x)\n x))\n\n(defn upload\n \"Copies local path(s) to remote node and returns the remote path.\"\n [local-paths remote-path]\n (let [s *session*\n local-paths (map file->path (util/coll local-paths))]\n (upload! s (cmd-context) local-paths remote-path {})\n remote-path))\n\n(defn upload-resource!\n \"Uploads a local JVM resource (as a string) to the given remote path.\"\n [resource-name remote-path]\n (with-open [reader (io/reader (io/resource resource-name))]\n (let [tmp-file (File/createTempFile \"jepsen-resource\" \".upload\")]\n (try\n (io/copy reader tmp-file)\n (upload (.getCanonicalPath tmp-file) remote-path)\n (finally\n (.delete tmp-file))))))\n\n(defn download\n \"Copies remote paths to local node.\"\n [remote-paths local-path]\n (download! *session* (cmd-context) remote-paths local-path {}))\n\n(defn expand-path\n \"Expands path relative to the current directory.\"\n [path]\n (if (re-find #\"^/\" path)\n ; Absolute\n path\n ; Relative\n (str *dir* (if (re-find #\"/$\" path)\n \"\"\n \"/\")\n path)))\n\n(defmacro cd\n \"Evaluates forms in the given directory.\"\n [dir & body]\n `(binding [*dir* (expand-path ~dir)]\n ~@body))\n\n(defmacro sudo\n \"Evaluates forms with a particular user.\"\n [user & body]\n `(binding [*sudo* (name ~user)]\n ~@body))\n\n(defmacro su\n \"sudo root ...\"\n [& body]\n `(sudo :root ~@body))\n\n(defmacro trace\n \"Evaluates forms with command tracing enabled.\"\n [& body]\n `(binding [*trace* true]\n ~@body))\n\n(defn session\n \"Returns a Remote bound to the given host.\"\n [host]\n (connect *remote* (assoc (conn-spec) :host host)))\n\n(defn disconnect\n \"Close a Remote session.\"\n [remote]\n (core/disconnect! remote))\n\n(defmacro with-remote\n \"Takes a remote and evaluates body with that remote in that scope.\"\n [remote & body]\n `(binding [*remote* ~remote] ~@body))\n\n(defmacro with-ssh\n \"Takes a map of SSH configuration and evaluates body in that scope. Catches\n JSchExceptions and re-throws with all available debugging context. Options:\n\n :dummy?\n :username\n :password\n :sudo-password\n :private-key-path\n :strict-host-key-checking\"\n [ssh & body]\n ; TODO: move this into a single *conn-spec* variable. Some external code\n ; reads *host*, so we're not doing this just yet.\n `(binding [*dummy* (get ~ssh :dummy? *dummy*)\n *username* (get ~ssh :username *username*)\n *sudo-password* (get ~ssh :sudo-password *sudo-password*)\n *password* (get ~ssh :password *password*)\n *port* (get ~ssh :port *port*)\n *private-key-path* (get ~ssh :private-key-path *private-key-path*)\n *strict-host-key-checking* (get ~ssh :strict-host-key-checking\n *strict-host-key-checking*)]\n ~@body))\n\n(defmacro with-session\n \"Binds a host and session and evaluates body. Does not open or close session;\n this is just for the namespace dynamic state.\"\n [host session & body]\n `(binding [*host* ~host\n *session* ~session]\n ~@body))\n\n(defmacro with-node\n \"Given a test and a node, evalutes body with that node's SSH connection\n bound.\"\n [test node & body]\n `(let [session# (get (:sessions ~test) ~node)]\n (assert session# (str \"No session for node \" (pr-str ~node)))\n (with-session ~node session#\n ~@body)))\n\n(defn with-nodes*\n \"Given a test, evaluates (f node) in parallel on each node, with that\n node's SSH connection bound. If `nodes` is provided, evaluates only on those\n nodes in particular.\"\n ([test f]\n (with-nodes* test (:nodes test) f))\n ([test nodes f]\n (let [mapper (if (< 1 (count nodes))\n real-pmap\n ; A common case: we call with just one node; no need to spawn\n ; a thread.\n mapv)]\n (->> nodes\n (map (fn [node]\n (let [session (get (:sessions test) node)]\n (assert session (str \"No session for node \" (pr-str node)))\n [node session])))\n (mapper (bound-fn [[node session]]\n (with-thread-name (str \"jepsen node \" (name node))\n (with-session node session\n [node (f node)]))))\n (into (sorted-map))))))\n\n(defmacro with-nodes\n \"Given a test and collection of nodes, evaluates body in parallel on each\n node, with that node's SSH connection bound. Returns a map of nodes to\n results from that node.\"\n [test nodes & body]\n `(with-nodes* ~test ~nodes\n (fn [node#]\n ~@body)))\n\n(defmacro with-all-nodes\n \"Given a test, evaluates body in parallel on all nodes, with that node's SSH\n connection bound. Returns a map of nodes to results from that node.\"\n [test & body]\n `(let [test# ~test]\n (with-nodes test# (:nodes test#) ~@body)))\n\n(defmacro on\n \"Opens a session to the given host and evaluates body there; and closes\n session when body completes. Prefer with-node when inside a test; it's\n faster.\"\n [host & body]\n `(let [session# (session ~host)]\n (try+\n (with-session ~host session#\n ~@body)\n (finally\n (disconnect session#)))))\n\n(defmacro on-many\n \"Takes a list of hosts, executes body on each host in parallel, and returns a\n map of hosts to return values. Prefer with-nodes when inside a test; it's\n faster.\"\n [hosts & body]\n `(let [hosts# ~hosts]\n (->> hosts#\n (map #(future (on % ~@body)))\n doall\n (map deref)\n (map vector hosts#)\n (into {}))))\n\n(defn on-nodes\n \"Given a test, evaluates (f test node) in parallel on each node, with that\n node's SSH connection bound. If `nodes` is provided, evaluates only on those\n nodes in particular. TODO: deprecate in favor of `with-nodes*``.\"\n ([test f]\n (on-nodes test (:nodes test) f))\n ([test nodes f]\n (with-nodes* test nodes (partial f test))))\n\n(defmacro with-test-nodes\n \"Given a test, evaluates body in parallel on each node, with that node's SSH\n connection bound. TODO: deprecate in favor of `with-all-nodes`.\"\n [test & body]\n `(let [test# ~test]\n (with-nodes test# (:nodes test#) ~@body)))\n" }, { "path": "jepsen/src/jepsen/core.clj", "content": "(ns jepsen.core\n \"Entry point for all Jepsen tests. Coordinates the setup of servers, running\n tests, creating and resolving failures, and interpreting results.\n\n Jepsen tests a system by running a set of singlethreaded *processes*, each\n representing a single client in the system, and a special *nemesis* process,\n which induces failures across the cluster. Processes choose operations to\n perform based on a *generator*. Each process uses a *client* to apply the\n operation to the distributed system, and records the invocation and\n completion of that operation in the *history* for the test. When the test is\n complete, a *checker* analyzes the history to see if it made sense.\n\n Jepsen automates the setup and teardown of the environment and distributed\n system by using an *OS* and *client* respectively. See `run!` for details.\"\n (:refer-clojure :exclude [run!])\n (:require [clojure.java.shell :refer [sh]]\n [clojure.stacktrace :as trace]\n [clojure.tools.logging :refer [info warn]]\n [clojure.string :as str]\n [clojure.datafy :refer [datafy]]\n [dom-top.core :as dt :refer [assert+]]\n [jepsen [checker :as checker]\n [client :as client]\n [control :as control]\n [db :as db]\n [generator :as generator]\n [nemesis :as nemesis]\n [print :refer [pprint]]\n [store :as store]\n [os :as os]\n [util :as util :refer [with-thread-name\n fcatch\n real-pmap\n relative-time-nanos\n with-shutdown-hook]]]\n [jepsen.store.format :as store.format]\n [jepsen.control.util :as cu]\n [jepsen.generator [interpreter :as gen.interpreter]]\n [clj-commons.slingshot :refer [try+ throw+]])\n (:import (java.util.concurrent CyclicBarrier\n CountDownLatch\n TimeUnit)))\n\n(defn synchronize\n \"A synchronization primitive for tests. When invoked, blocks until all nodes\n have arrived at the same point.\n\n This is often used in IO-heavy DB setup code to ensure all nodes have\n completed some phase of execution before moving on to the next. However, if\n an exception is thrown by one of those threads, the call to `synchronize`\n will deadlock! To avoid this, we include a default timeout of 60 seconds,\n which can be overridden by passing an alternate timeout in seconds.\"\n ([test]\n (synchronize test 60))\n ([test timeout-s]\n (or (= ::no-barrier (:barrier test))\n (.await ^CyclicBarrier (:barrier test) timeout-s TimeUnit/SECONDS))))\n\n(defn conj-op!\n \"Add an operation to a tests's history, and returns the operation.\"\n [test op]\n (swap! (:history test) conj op)\n op)\n\n(defn primary\n \"Given a test, returns the primary node.\"\n [test]\n (first (:nodes test)))\n\n(defmacro with-resources\n \"Takes a four-part binding vector: a symbol to bind resources to, a function\n to start a resource, a function to stop a resource, and a sequence of\n resources. Then takes a body. Starts resources in parallel, evaluates body,\n and ensures all resources are correctly closed in the event of an error.\"\n [[sym start stop resources] & body]\n ; Start resources in parallel\n `(let [~sym (doall (real-pmap (fcatch ~start) ~resources))]\n (when-let [ex# (some #(when (instance? Exception %) %) ~sym)]\n ; One of the resources threw instead of succeeding; shut down all which\n ; started OK and throw.\n (->> ~sym\n (remove (partial instance? Exception))\n (real-pmap (fcatch ~stop))\n dorun)\n (throw ex#))\n\n ; Run body\n (try ~@body\n (finally\n ; Clean up resources\n (dorun (real-pmap (fcatch ~stop) ~sym))))))\n\n(defmacro with-os\n \"Wraps body in OS setup and teardown.\"\n [test & body]\n `(try\n (control/on-nodes ~test (partial os/setup! (:os ~test)))\n ~@body\n (finally\n (control/on-nodes ~test (partial os/teardown! (:os ~test))))))\n\n(defn snarf-logs!\n \"Downloads logs for a test. Updates symlinks.\"\n [test]\n ; Download logs\n (locking snarf-logs!\n (try\n (when (satisfies? db/LogFiles (:db test))\n (info \"Snarfing log files\")\n (control/on-nodes\n test\n (fn [test node]\n ; Unless we're leaving the DB running for debugging purposes, we'll\n ; kill it, if possible, before downloading logs. This means we're\n ; not trying to read files as they're changing under us.\n (when (and (not (:leave-db-running? test))\n (satisfies? db/Kill (:db test)))\n (db/kill! (:db test) test node))\n\n ; Actually download files\n (doseq [[remote local] (db/log-files-map (:db test) test node)]\n (when (cu/exists? remote)\n (info \"downloading\" remote \"to\" local)\n (try\n (control/download\n remote\n (.getCanonicalPath\n (store/path! test (name node)\n ; strip leading /\n (str/replace local #\"^/\" \"\"))))\n (catch java.io.IOException e\n (if (= \"Pipe closed\" (.getMessage e))\n (info remote \"pipe closed\")\n (throw e)))\n (catch java.lang.IllegalArgumentException e\n ; This is a jsch bug where the file is just being\n ; created\n (info remote \"doesn't exist\"))))))))\n (finally\n (store/update-symlinks! test)))))\n\n(defn maybe-snarf-logs!\n \"Snarfs logs, swallows and logs all throwables. Why? Because we do this when\n we encounter an error and abort, and we don't want an error here to supercede\n the root cause that made us abort.\"\n [test]\n (try (snarf-logs! test)\n (catch clojure.lang.ExceptionInfo e\n (warn e (str \"Error snarfing logs and updating symlinks\\n\")\n (with-out-str (pprint (ex-data e)))))\n (catch Throwable t\n (warn t \"Error snarfing logs and updating symlinks\"))))\n\n(defmacro with-log-snarfing\n \"Evaluates body and ensures logs are snarfed afterwards. Will also download\n logs in the event of JVM shutdown, so you can ctrl-c a test and get something\n useful.\"\n [test & body]\n `(let [snarfed?# (atom false)]\n (with-shutdown-hook (do (info \"SIGTERM caught; aborting...\")\n (when-not @snarfed?#\n (snarf-logs! ~test)\n (reset! snarfed?# true))\n (info \"Test aborted.\"))\n (try (let [res# (do ~@body)]\n (when-not @snarfed?#\n (snarf-logs! ~test)\n (reset! snarfed?# true))\n res#)\n (finally\n (when-not @snarfed?#\n (maybe-snarf-logs! ~test)\n (reset! snarfed?# true)))))))\n\n(defmacro with-db\n \"Wraps body in DB setup and teardown.\"\n [test & body]\n `(try\n (with-log-snarfing ~test\n (db/cycle! ~test)\n ~@body)\n (finally\n (when-not (:leave-db-running? ~test)\n (control/on-nodes ~test (partial db/teardown! (:db ~test)))))))\n\n(defmacro with-client+nemesis-setup-teardown\n \"Takes a binding vector of a test symbol and a test map. Sets up clients and\n nemesis, and rebinds (:nemesis test) to the set-up nemesis. Evaluates body.\n Afterwards, ensures clients and nemesis are torn down.\"\n [[test-sym test] & body]\n `(let [client# (:client ~test)\n nemesis# (nemesis/validate (:nemesis ~test))]\n ; Setup\n (let [nf# (future (nemesis/setup! nemesis# ~test))\n clients# (real-pmap (fn [node#]\n (with-thread-name\n (str \"jepsen node \" node#)\n (let [c# (client/open! client# ~test node#)]\n (client/setup! c# ~test)\n c#)))\n (:nodes ~test))\n nemesis# @nf#\n ~test-sym (assoc ~test :nemesis nemesis#)]\n (try\n (dorun clients#)\n ~@body\n (finally\n ; Teardown (and close clients)\n (let [nf# (future (nemesis/teardown! nemesis# ~test))]\n (dorun (real-pmap (fn [[c# node#]]\n (with-thread-name\n (str \"jepsen node \" node#))\n (try (client/teardown! c# ~test)\n (finally\n (client/close! c# ~test))))\n (map vector clients# (:nodes ~test))))\n @nf#))))))\n\n(defn run-case!\n \"Takes a test with a store handle. Spawns nemesis and clients and runs the\n generator. Returns test with no :generator and a completed :history.\"\n [test]\n (with-client+nemesis-setup-teardown [test test]\n (gen.interpreter/run! test)))\n\n(defn analyze!\n \"After running the test and obtaining a history, we perform some\n post-processing on the history, run the checker, and write the test to disk\n again. Takes a test map. Returns a new test with results.\"\n [test]\n (info \"Analyzing...\")\n (let [test (assoc test :results (checker/check-safe\n (:checker test)\n test\n (:history test)))]\n (info \"Analysis complete\")\n (if (:name test)\n (store/save-2! test)\n test)))\n\n(defn log-results\n \"Logs info about the results of a test to stdout, and returns test.\"\n [test]\n (info (str\n (with-out-str\n (pprint (:results test)))\n (when (:error (:results test))\n (str \"\\n\\n\" (:error (:results test))))\n \"\\n\\n\"\n (case (:valid? (:results test))\n false \"Analysis invalid! (ﾉಥ益ಥ）ﾉ ┻━┻\"\n :unknown \"Errors occurred during analysis, but no anomalies found. ಠ~ಠ\"\n true \"Everything looks good! ヽ(‘ー`)ノ\")))\n test)\n\n(defn log-test-start!\n \"Logs some basic information at the start of a test: the Git version of the\n working directory, the lein arguments to re-run the test, etc.\"\n [test]\n (let [git-head (sh \"git\" \"rev-parse\" \"HEAD\")]\n (when (zero? (:exit git-head))\n (let [head (str/trim-newline (:out git-head))\n clean? (-> (sh \"git\" \"status\" \"--porcelain=v1\")\n :out\n str/blank?)]\n (info (str \"Test version \" head\n (when-not clean? \" (plus uncommitted changes)\"))))))\n (when-let [argv (:argv test)]\n (info (str \"Command line:\\n\"\n (->> (:argv test)\n (map control/escape)\n (list* \"lein\" \"run\")\n (str/join \" \")))))\n (info (str \"Running test:\\n\"\n (util/test->str test))))\n\n(defmacro with-sessions\n \"Takes a [test' test] binding form and a body. Starts with test-expr as\n the test, and sets up the jepsen.control state required to run this test--the\n remote, SSH options, etc. Opens SSH sessions to each node. Saves those\n sessions in the :sessions map of the test, binds that to the `test'` symbol in\n the binding expression, and evaluates body.\"\n [[test' test] & body]\n `(let [test# ~test]\n (control/with-remote (:remote test#)\n (control/with-ssh (:ssh test#)\n (with-resources [sessions#\n (bound-fn* control/session)\n control/disconnect\n (:nodes test#)]\n ; Index sessions by node name and add to test\n (let [~test' (->> sessions#\n (map vector (:nodes test#))\n (into {})\n (assoc test# :sessions))]\n ; And evaluate body.\n ~@body))))))\n\n(defmacro with-logging\n \"Sets up logging for this test run, logs the start of the test, evaluates\n body, and stops logging at the end. Also logs test crashes, so they appear in\n the log files for this test run.\"\n [test & body]\n `(try (store/start-logging! ~test)\n (log-test-start! ~test)\n ~@body\n (catch Throwable t#\n (warn t# \"Test crashed!\")\n (throw t#))\n (finally\n (store/stop-logging!))))\n\n(defn prepare-test\n \"Takes a test and prepares it for running. Ensures it has a :start-time,\n :concurrency, and :barrier field. Wraps its generator in a forgettable\n reference, to prevent us from inadvertently retaining the head.\n\n This operation always succeeds, and is necessary for accessing a test's store\n directory, which depends on :start-time. You may call this yourself before\n calling run!, if you need access to the store directory outside the run!\n context.\"\n [test]\n (cond-> test\n (not (:start-time test)) (assoc :start-time (util/local-time))\n (not (:concurrency test)) (assoc :concurrency (count (:nodes test)))\n (not (:barrier test)) (assoc :barrier\n (let [c (count (:nodes test))]\n (if (pos? c)\n (CyclicBarrier. (count (:nodes test)))\n ::no-barrier)))\n true (update :generator util/forgettable)))\n\n(defn run!\n \"Runs a test. Tests are maps containing\n\n :nodes A sequence of string node names involved in the test\n :concurrency (optional) How many processes to run concurrently\n :ssh SSH credential information: a map containing...\n :username The username to connect with (root)\n :password The password to use\n :sudo-password The password to use for sudo, if needed\n :port SSH listening port (22)\n :private-key-path A path to an SSH identity file (~/.ssh/id_rsa)\n :strict-host-key-checking Whether or not to verify host keys\n :dummy? Runs test with no SSH connections.\n :logging Logging options; see jepsen.store/start-logging!\n :os The operating system; given by the OS protocol\n :db The database to configure: given by the DB protocol\n :remote The remote to use for control actions. Try, for example,\n (jepsen.control.sshj/remote).\n :client A client for the database\n :nemesis A client for failures\n :generator A generator of operations to apply to the DB\n :checker Verifies that the history is valid\n :log-files A list of paths to logfiles/dirs which should be captured at\n the end of the test.\n :nonserializable-keys A collection of top-level keys in the test which\n shouldn't be serialized to disk.\n :leave-db-running? Whether to leave the DB running at the end of the test.\n\n Jepsen automatically adds some additional keys during the run\n\n :start-time When the test began\n :history The operations the clients and nemesis performed\n :results The results from the checker, once the test is completed\n\n In addition, tests have some fields added by Jepsen which are present during\n their execution, but not persisted.\n\n :barrier A CyclicBarrier, mainly used for synchronizing DB setup\n :store State used for reading and writing data to and from disk\n :sessions Connected sessions used by jepsen.control to talk to nodes\n\n Tests proceed like so:\n\n 1. Setup the operating system\n\n 2. Try to teardown, then setup the database\n - If the DB supports the Primary protocol, also perform the Primary setup\n on the first node.\n\n 3. Create the nemesis\n\n 4. Fork the client into one client for each node\n\n 5. Fork a thread for each client, each of which requests operations from\n the generator until the generator returns nil\n - Each operation is appended to the operation history\n - The client executes the operation and returns a vector of history elements\n - which are appended to the operation history\n\n 6. Capture log files\n\n 7. Teardown the database\n\n 8. Teardown the operating system\n\n 9. When the generator is finished, invoke the checker with the history\n - This generates the final report\"\n [test]\n (with-thread-name \"jepsen test runner\"\n (let [test (prepare-test test)]\n (with-logging test\n (store/with-handle [test test]\n (let [test (if (:name test)\n (store/save-0! test)\n test)\n test (with-sessions [test test]\n ; Launch OS, DBs, evaluate test\n (let [test (with-os test\n (with-db test\n (util/with-relative-time\n ; Run a single case\n (let [test (-> (run-case! test)\n ; Remove state\n (dissoc :barrier\n :sessions))\n _ (info \"Run complete, writing\")\n test (if (:name test)\n (store/save-1! test)\n test)]\n test))))]\n (analyze! test)))]\n (log-results test)))))))\n" }, { "path": "jepsen/src/jepsen/db/watchdog.clj", "content": "(ns jepsen.db.watchdog\n \"Databases often like to crash, and they may not restart themselves\n automatically, which means we have to do it for them. This creates the\n possibility of all kinds of race conditions. This namespace provides a\n watchdog which runs in a thread for the duration of the test, and a `DB`\n wrapper for unreliable DBs.\n\n Watchdogs know whether the server they supervise is *running*. They can be\n *enabled* or *disabled*, which determines whether they restart the server or\n not. They can be *killed* once, which destroys their thread. They can also be\n locked, during which the watchdog takes no actions.\"\n (:refer-clojure :exclude [run! locking])\n (:require [clojure [core :as clj]]\n [clojure.tools.logging :refer [debug info warn]]\n [jepsen [control :as c]\n [db :as db]\n [util :as util :refer [timeout]]]\n [dom-top.core :refer [with-retry]]\n [potemkin :refer [definterface+]]))\n\n(definterface+ IWatchdog\n ; Public API\n (kill! [w] \"Kills the watchdog, terminating its thread. Blocks until complete.\")\n\n (enable! [w] \"Informs the watchdog that it should restart the daemon. Returns immediately.\")\n\n (disable! [w] \"Informs the watchdog that it should not restart the daemon. Returns once we can guarantee the watchdog won't restart.\")\n\n ; Internal API\n (step! [w test node] \"The main step of the watchdog. Periodically invoked by the runner.\")\n\n (run! [w test node] \"Starts the mainloop, calling step! repeatedly. Returns watchdog immediately.\"))\n\n(defrecord Watchdog\n [; How long, in ms, between steps\n ^long interval\n ; Function which tells us if the server is running\n running?\n ; Function which starts the server\n start!\n ; An atom: are we enabled?\n enabled?\n ; A promise, delivered when we exit\n killed\n ; A promise of a future--our worker thread\n fut]\n\n IWatchdog\n (kill! [_]\n (if-let [f (deref fut 0 nil)]\n (do (future-cancel f)\n @killed)\n ; You can kill a watchdog before it starts; that's a no-op. This\n ; simplifies teardown! code, which is run both before and after setup.\n :not-running))\n\n (enable! [this]\n (clj/locking this\n (reset! enabled? true)))\n\n (disable! [this]\n ; Acquiring a lock here means we never race with step!\n (clj/locking this\n (reset! enabled? false)))\n\n (step! [this test node]\n (util/with-thread-name (str \"jepsen watchdog \" node)\n (clj/locking this\n (when @enabled?\n (let [running?\n (timeout interval\n (do (warn \"Watchdog's `running?` function\"\n running? \"timed out after\"\n interval \"ms.\")\n false)\n (running? test node))]\n (debug node \"is\" (if running? \"running\" \"dead\"))\n (when-not running?\n (let [r (start! test node)]\n (info \"Watchdog started:\" r))))))))\n\n (run! [this test node]\n (when (realized? fut)\n (throw (IllegalStateException. \"Can't run a watchdog twice!\")))\n ; A little awkward, but this future basically exists so we can spawn\n ; threads with on-nodes and return immediately. It blocks indefinitely, but\n ; chances are you'll only have a handful of nodes to watchdog, so NBD.\n (deliver\n fut\n (future\n (util/with-thread-name (str \"jepsen watchdog supervisor \" node)\n (with-retry []\n (Thread/sleep interval)\n (c/on-nodes test [node] (partial step! this))\n (retry)\n (catch InterruptedException e\n (deliver killed :killed)\n (throw e))\n (catch RuntimeException t\n (warn t \"Unexpected error in watchdog worker\")\n (retry))\n (catch Throwable t\n ; Don't retry; this might be an OOM etc.\n (deliver killed :crashed)\n (warn t \"Unexpected fatal error in watchdog worker\"))))))\n this))\n\n(defn watchdog\n \"Creates a new Watchdog for a single node. Takes an options map with:\n\n {:running? A function (running? test node) which returns true iff the\n server is running.\n :start! A function (start! test node) which starts the server.\n :interval Time, in ms, between checking to restart the server.\n Default 1000.}\n\n Both running? and start? are evaluated with a jepsen.control connection bound\n to the given node.\"\n [{:keys [running? start!] :as opts}]\n (assert (fn? running?))\n (assert (fn? start!))\n (let [interval (:interval opts 1000)]\n (map->Watchdog\n {:interval (long interval)\n :running? running?\n :start! start!\n :enabled? (atom true)\n :killed (promise)\n :fut (promise)})))\n\n(defmacro locking\n \"Locks a Watchdog for the duration of body. Use this around any of your code\n that starts/stops the server, to avoid race conditions where you e.g. kill\n the server and the watchdog immediately restarts it.\"\n [watchdog & body]\n `(clj/locking watchdog ~@body))\n\n(defrecord DB\n [db ; Wrapped database\n opts ; Options map for spawning watchdogs\n watchdogs] ; Atom: a map of node->watchdog\n db/DB\n (setup! [this test node]\n (db/setup! db test node)\n (let [w (watchdog opts)]\n (swap! watchdogs assoc node w)\n (run! w test node)))\n\n (teardown! [this test node]\n (when-let [w (get @watchdogs node)]\n (kill! w)\n (db/teardown! db test node)))\n\n db/Kill\n (kill! [_ test node]\n (if-let [w (get @watchdogs node)]\n (locking w\n (disable! w)\n (db/kill! db test node))\n (db/kill! db test node)))\n\n (start! [_ test node]\n (if-let [w (get @watchdogs node)]\n (locking w\n (db/start! db test node)\n (enable! w))\n (db/start! db test node)))\n\n db/Pause\n (pause! [_ test node] (db/pause! db test node))\n (resume! [_ test node] (db/resume! db test node))\n\n db/LogFiles\n (log-files [_ test node] (db/log-files db test node))\n\n db/Primary\n (primaries [_ test] (db/primaries db test))\n (setup-primary! [_ test node] (db/setup-primary! db test node)))\n\n(defn db\n \"Wraps an existing database in a one with watchdogs for each node. Takes a\n map of partial options to `watchdog` (just :running? and :interval), and a DB\n to wrap. Uses `db/start!` to start the database. Ensures that db/kill! and\n db/start! disable and enable the watchdog.\n\n The DB you wrap must implement the full suite of DB protocols--LogFiles,\n Primary, etc. This is a little awkward, but feels preferable to having a\n zillion variants of the DB class here. You can generally return `nil` from\n (e.g.) log-files, primaries, etc., and Jepsen will do sensible things.\"\n [opts db]\n (map->DB\n {:db db\n :watchdogs (atom {})\n :opts (assoc opts :start! (partial db/start! db))}))\n" }, { "path": "jepsen/src/jepsen/db.clj", "content": "(ns jepsen.db\n \"Allows Jepsen to set up and tear down databases.\"\n (:require [clojure [string :as str]]\n [clojure.tools.logging :refer [info warn]]\n [dom-top.core :refer [assert+]]\n [jepsen [control :as control]\n [util :as util :refer [fcatch meh]]]\n [jepsen.control [util :as cu]\n [net :as cn]]\n [clj-commons.slingshot :refer [try+ throw+]]))\n\n(defprotocol DB\n (setup! [db test node] \"Set up the database on this particular node.\")\n (teardown! [db test node] \"Tear down the database on this particular node.\"))\n\n(defprotocol Kill\n \"This optional protocol supports starting and killing a DB's processes.\"\n (kill! [db test node] \"Forcibly kills the process\")\n (start! [db test node] \"Starts the process\"))\n\n; Process is imported by default from java.lang. The eval here is an attempt to\n; keep lein install from generating broken... cached... something or other. I\n; can't figure out why this breaks.\n(eval\n '(do (ns-unmap 'jepsen.db 'Process)\n ; It's going to jump ahead and compile this def ... ahead of the\n ; ns-unmap, I think? So we wrap it in a *second* eval. JFC, what a hack.\n (eval '(def Process Kill))))\n\n(defprotocol Pause\n \"This optional protocol supports pausing and resuming a DB's processes.\"\n (pause! [db test node] \"Pauses the process\")\n (resume! [db test node] \"Resumes the process\"))\n\n(defprotocol Primary\n \"This optional protocol supports databases which have a notion of one (or\n more) primary nodes.\"\n (primaries [db test]\n \"Returns a collection of nodes which are currently primaries.\n Best-effort is OK; in practice, this usually devolves to 'nodes\n that think they're currently primaries'.\")\n (setup-primary! [db test node] \"Performs one-time setup on a single node.\"))\n\n(defprotocol LogFiles\n (log-files [db test node]\n \"Returns either a.) a map of fully-qualified remote paths (on this\n DB node) to short local paths (in store/), or b.) a sequence of\n fully-qualified remote paths.\"))\n\n(defn log-files-map\n \"Takes a DB, a test, and a node. Returns a map of remote paths to local\n paths. Checks to make sure there are no duplicate local paths.\n\n log-files used to return a sequence of remote paths, and some people are\n likely still assuming that form for composition. When they start e.g.\n concatenating maps into lists of strings, we're going to get mixed\n representations. We try to make all this Just Work (TM).\"\n [db test node]\n (let [log-files (log-files db test node)\n log-files (if (map? log-files)\n ; We're done here; the DB knows exactly what short names\n ; they want.\n log-files\n ; OK, we've got a sequence. Break that up into two\n ; parts--those where we know the short name (kv pairs), and\n ; those where we only know the remote long name (strings).\n (let [short-files (into {} (filter map-entry? log-files))\n long-files (remove map-entry? log-files)\n ; Now try to figure out short names for the long files\n auto-shorts (->> long-files\n (map #(str/split % #\"/\"))\n util/drop-common-proper-prefix\n (map (partial str/join \"/\"))\n (zipmap log-files))]\n (merge short-files auto-shorts)))]\n ; Check for collisions in short names\n (assert+ (distinct? (vals log-files))\n {:type ::log-files-local-name-collision\n :log-files log-files})\n log-files))\n\n(def noop\n \"Does nothing.\"\n (reify DB\n (setup! [db test node])\n (teardown! [db test node])))\n\n(defn tcpdump\n \"A database which runs a tcpdump capture from setup! to teardown!, and yields\n a `tcpdump` logfile. Options:\n\n :clients-only? If true, applies a filter string which yields only traffic\n from Jepsen clients, rather than capturing inter-DB-node\n traffic.\n\n :filter A filter string to apply (in addition to ports).\n e.g. \\\"host 192.168.122.1\\\", which can be helpful for seeing *just* client traffic from the control node.\n\n :ports A collection of ports to grab traffic from.\"\n [opts]\n (let [dir \"/tmp/jepsen/tcpdump\"\n log-file (str dir \"/log\")\n cap-file (str dir \"/tcpdump\")\n pid-file (str dir \"/pid\")]\n (reify\n DB\n (setup! [this test node]\n (control/su\n (control/exec :mkdir :-p dir)\n ; Combine custom, port, and client filters\n (let [filters (remove nil? [(->> (:ports opts)\n (map (partial str \"port \"))\n (str/join \" or \"))\n (when (:clients-only? opts)\n (str \"host \" (cn/control-ip)))\n (:filter opts)])\n filter-str (str/join \" and \" filters)]\n (cu/start-daemon!\n {:logfile log-file\n :pidfile pid-file\n :chdir dir}\n \"/usr/bin/tcpdump\"\n :-w cap-file\n :-s 65535\n :-B 16384 ; buffer in KB\n ; Theoretically, killing tcpdump with SIGINT should cause it to\n ; neatly flush its packets to disk and exit, but... as far as\n ; I can tell, it leaves the capture half-finished (and missing\n ; important packets from the end of the test!) no matter what?\n ; Let's try *not* buffering.\n :-U\n filter-str))))\n\n (teardown! [this test node]\n (control/su\n (when-let [pid (try+ (control/exec :cat pid-file)\n (catch [:type :jepsen.control/nonzero-exit] e\n nil))]\n ; We want to get a nice clean exit here, if possible\n (meh (control/exec :kill :-s :INT pid))\n ; Wait for it to flush\n (while (try+ (control/exec :ps :-p pid)\n true\n (catch [:type :jepsen.control/nonzero-exit] e\n false))\n (info \"Waiting for tcpdump\" pid \"to exit\")\n (Thread/sleep 50)))\n\n ; Okay, nuke it and clean up pidfile, etc\n (cu/stop-daemon! :tcpdump pid-file)\n (control/exec :rm :-rf dir)))\n\n LogFiles\n (log-files [db test node]\n {log-file \"tcpdump.log\"\n cap-file \"tcpdump.pcap\"}))))\n\n(def cycle-tries\n \"How many tries do we get to set up a database?\"\n 3)\n\n(defn cycle!\n \"Takes a test, and tears down, then sets up, the database on all nodes\n concurrently.\n\n If any call to setup! or setup-primary! throws :type ::setup-failed, we tear\n down and retry the whole process up to `cycle-tries` times.\"\n [test]\n (let [db (:db test)]\n (loop [tries cycle-tries]\n ; Tear down every node\n (info \"Tearing down DB\")\n (control/on-nodes test (partial teardown! db))\n\n ; Start up every node\n (if (= :retry (try+\n ; Normal set up\n (info \"Setting up DB\")\n (control/on-nodes test (partial setup! db))\n\n ; Set up primary\n (when (satisfies? Primary db)\n ; TODO: refactor primary out of core and here and\n ; into util.\n (info \"Setting up primary\" (first (:nodes test)))\n (control/on-nodes test [(first (:nodes test))]\n (partial setup-primary! db)))\n\n nil\n (catch [:type ::setup-failed] e\n (if (< 1 tries)\n (do (info :throwable (pr-str (type (:throwable &throw-context))))\n (warn (:throwable &throw-context)\n \"Unable to set up database; retrying...\")\n :retry)\n\n ; Out of tries, abort!\n (throw+ e)))))\n (recur (dec tries))))))\n\n(defrecord MapTest [f db]\n DB\n (setup! [_ test node] (setup! db (f test) node))\n (teardown! [_ test node] (teardown! db (f test) node))\n\n Kill\n (kill! [_ test node] (kill! db (f test) node))\n (start! [_ test node] (start! db (f test) node))\n\n Pause\n (pause! [_ test node] (pause! db (f test) node))\n (resume! [_ test node] (resume! db (f test) node))\n\n LogFiles\n (log-files [_ test node] (log-files db (f test) node))\n\n Primary\n (primaries [_ test] (primaries db (f test)))\n (setup-primary! [_ test node] (setup-primary! db (f test) node)))\n\n(defn map-test\n \"Wraps a DB in another DB which rewrites every test argument using (f test).\n Helpful for when you want to compose two DBs together that need different\n test parameters, like :version.\"\n [f db]\n (MapTest. f db))\n" }, { "path": "jepsen/src/jepsen/faketime.clj", "content": "(ns jepsen.faketime\n \"Libfaketime is useful for making clocks run at differing rates! This\n namespace provides utilities for stubbing out programs with faketime.\"\n (:require [clojure.tools.logging :refer :all]\n [jepsen [control :as c]\n [random :as rand]]\n [jepsen.control.util :as cu]))\n\n(defn install-0.9.6-jepsen1!\n \"Installs our fork of 0.9.6 (the last version which worked with jemalloc),\n which includes a patch to support CLOCK_MONOTONIC_COARSE and\n CLOCK_REALTIME_COARSE. Gosh, this is SUCH a hack.\"\n []\n (c/su\n (c/exec :mkdir :-p \"/tmp/jepsen\")\n (c/cd \"/tmp/jepsen\"\n (when-not (cu/exists? \"libfaketime-jepsen\")\n (c/exec :git :clone \"https://github.com/jepsen-io/libfaketime.git\"\n \"libfaketime-jepsen\"))\n (c/cd \"libfaketime-jepsen\"\n (c/exec :git :checkout \"0.9.6-jepsen1\")\n (c/exec :make)\n (c/exec :make :install)))))\n\n(defn script\n \"A sh script which invokes cmd with a faketime wrapper. Takes an initial\n offset in seconds, and a clock rate to run at.\"\n [cmd init-offset rate]\n (let [init-offset (long init-offset)\n rate (float rate)]\n (str \"#!/bin/bash\\n\"\n \"faketime -m -f \\\"\"\n (if (neg? init-offset) \"-\" \"+\") init-offset \"s x\" rate \"\\\" \"\n (c/expand-path cmd)\n \" \\\"$@\\\"\")))\n\n(defn wrap!\n \"Replaces an executable with a faketime wrapper, moving the original to\n x.no-faketime. Idempotent.\"\n [cmd init-offset rate]\n (let [cmd' (str cmd \".no-faketime\")\n wrapper (script cmd' init-offset rate)]\n (if (cu/exists? cmd')\n (do (info \"Installing faketime wrapper.\")\n (c/exec :echo wrapper :> cmd))\n (do (c/exec :mv cmd cmd')\n (c/exec :echo wrapper :> cmd)))\n (c/exec :chmod \"a+x\" cmd)))\n\n(defn unwrap!\n \"If a wrapper is installed, remove it and replace it with the original\n .nofaketime version of the binary.\"\n [cmd]\n (let [cmd' (str cmd \".no-faketime\")]\n (when (cu/exists? cmd')\n (c/exec :mv cmd' cmd))))\n\n(defn rand-factor\n \"Helpful for choosing faketime rates. Takes a factor (e.g. 2.5) and produces\n a random number selected from a distribution around 1, with minimum and\n maximum constrained such that factor * min = max. Intuitively, the fastest\n clock can be no more than twice as fast as the slowest.\"\n [factor]\n (let [max (/ 2 (+ 1 (/ factor)))\n min (/ max factor)]\n (+ min (rand/double (- max min)))))\n" }, { "path": "jepsen/src/jepsen/fs_cache.clj", "content": "(ns jepsen.fs-cache\n \"Some systems Jepsen tests are expensive or time-consuming to set up. They\n might involve lengthy compilation processes, large packages which take a long\n time to download, or allocate large files on initial startup.\n\n Other systems require state which persists from run to run--for instance,\n there might be an expensive initial cluster join process, and you might want\n to perform that process once, save the cluster's state to disk before\n testing, and for subsequent tests redeploy that state to nodes to skip the\n cluster join.\n\n This namespace provides a persistent cache, stored on the control node's\n filesystem, which is suitable for strings, data, or files. It also provides a\n basic locking mechanism.\n\n Cached values are referred to by logical *paths*: a vector of strings,\n keywords, numbers, booleans, etc; see the Encode protocol for details. For\n instance, a cache path could be any of\n\n [:hi]\n [1 true]\n [:foodb :license :key]\n [:foodb \\\"1523a6b\\\"]\n\n Cached paths can be stored and retrieved in several ways. Each storage type\n has a pair of functions: (cache/save-string! path \\\"foo\\\") writes \\\"foo\\\" to\n `path`, and (cache/load-string path) returns the stored value as a string.\n\n - As strings (save-string!, load-string)\n - As EDN data (save-edn!, load-edn)\n - As raw File objects (save-file!, load-file)\n - As remote files (save-remote!, deploy-remote!)\n\n In general, writers are `(save-format! from-source to-path)`, and return\n `from-source`, allowing them to be used transparently for side effects.\n Readers are `(load-format path)`, and return `nil` if the value is uncached.\n You can use `(cached? path)` to distinguish between a missing cache value and\n a present `nil`.\n\n Writes to cache are atomic: a temporary file will be written to first, then\n renamed into its final cache location.\n\n You can acquire locks on any cache path, whether it exists or not, using\n `(locking path ...)`.\"\n (:refer-clojure :exclude [load-file load-string locking])\n (:require [clojure [edn :as edn]\n [string :as str]]\n [clojure.java.io :as io]\n [clojure.tools.logging :refer [info warn]]\n [jepsen [control :as c]\n [print :refer [pprint]]\n [util :as util]])\n (:import (java.io File)\n (java.nio.file AtomicMoveNotSupportedException\n StandardCopyOption\n Files\n Path)\n (java.nio.file.attribute FileAttribute)))\n\n;; Where do we store files, and how do we encode paths?\n\n(def ^File dir\n \"Top-level cache directory.\"\n (io/file \"/tmp/jepsen/cache\"))\n\n(def dir-prefix\n \"What string do we prefix to directories in cache path filenames, to\n distinguish /foo from /foo/bar?\"\n \"d\")\n\n(def file-prefix\n \"What string do we prefix to files in cache path filenames, to distinguish\n /foo from /foo/bar?\"\n \"f\")\n\n(defn escape\n \"Escapes slashes in filenames.\"\n [string]\n (str/replace string #\"(\\\\|/)\" \"\\\\\\\\$1\"))\n\n(defprotocol Encode\n (encode-path-component\n [component]\n \"Encodes datatypes to strings which can be used in filenames. Use `escape`\n to escape slashes.\"))\n\n(extend-protocol Encode\n String\n (encode-path-component [s] (str \"s_\" (escape s)))\n\n Boolean\n (encode-path-component [b] (str \"b_\" b))\n\n clojure.lang.Keyword\n (encode-path-component [k] (str \"k_\" (escape (name k))))\n\n Long\n (encode-path-component [x] (str \"l_\" x))\n\n clojure.lang.BigInt\n (encode-path-component [x] (str \"n_\" x))\n\n java.math.BigDecimal\n (encode-path-component [x] (str \"m_\" x)))\n\n(defn fs-path\n \"Takes a cache path, and returns a sequence of filenames for that path.\"\n [path]\n (when-not (sequential? path)\n (throw (IllegalArgumentException. \"Cache path must be a sequential collection.\")))\n (when-not (seq path)\n (throw (IllegalArgumentException. \"Cache path must not be empty.\")))\n (let [last-i (dec (count path))]\n (loop [i 0\n path (transient (vec path))]\n (let [component (-> path\n (nth i)\n encode-path-component\n (->> (str (if (= last-i i)\n file-prefix\n dir-prefix))))\n path (assoc! path i component)]\n (if (= last-i i)\n (persistent! path)\n (recur (inc i) path))))))\n\n;; Turning paths into files, saving files atomically\n\n(defn ^File file\n \"The local File backing a given path, whether or not it exists.\"\n [path]\n (apply io/file dir (fs-path path)))\n\n(defn ^File file!\n \"Like file, but ensures parents exist.\"\n [path]\n (let [f (file path)]\n (io/make-parents f)\n f))\n\n(defn atomic-move!\n \"Attempts to move a file atomically, even across filesystems.\"\n [^File f1 ^File f2]\n (let [p1 ^Path (.toPath f1)\n p2 ^Path (.toPath f2)]\n (try (Files/move p1 p2 (into-array [StandardCopyOption/ATOMIC_MOVE]))\n (catch AtomicMoveNotSupportedException _\n ; Copy to the same directory, then rename\n (let [tmp ^Path (.resolveSibling p2 (str (.getFileName p2)\n \".tmp.\"\n ; Hopefully good enough\n (System/nanoTime)))]\n (try\n (Files/copy p1 tmp ^\"[Ljava.nio.file.StandardCopyOption;\"\n (into-array StandardCopyOption\n [StandardCopyOption/COPY_ATTRIBUTES]))\n (Files/move tmp p2\n (into-array StandardCopyOption\n [StandardCopyOption/ATOMIC_MOVE]))\n (Files/deleteIfExists p1)\n (finally\n (Files/deleteIfExists tmp))))))))\n\n(defmacro write-atomic!\n \"Writes a file atomically. Takes a binding form and a body, like so\n\n (write-atomic [tmp-file (io/file \\\"final.txt\\\")]\n (write! tmp-file))\n\n Creates a temporary file, and binds it to `tmp-file`. Evals body, presumably\n modifying tmp-file in some way. If body terminates normally, renames tmp-file\n to final-file. Ensures temp file is cleaned up.\"\n [[tmp-sym final] & body]\n `(let [final# ^File ~final\n ~tmp-sym (-> (.getParent (.toPath final#))\n (Files/createTempFile (str \".\" (.getName final#) \".\")\n \".tmp\"\n (make-array FileAttribute 0))\n .toFile)]\n (try ~@body\n (atomic-move! ~tmp-sym final#)\n (finally\n (.delete ~tmp-sym)))))\n\n;; General-purpose API functions\n\n(defn cached?\n \"Do we have the given path cached?\"\n [path]\n (.isFile (file path)))\n\n(defn clear!\n \"Clears the entire cache, or a specified path.\"\n ([]\n (->> dir\n io/file\n file-seq\n (mapv (memfn ^File delete))))\n ([path]\n (.delete (file path))))\n\n;; Writers and Readers\n\n(defn save-file!\n \"Caches a File object to the given path. Returns file.\"\n [file path]\n (write-atomic! [f (file! path)]\n (io/copy file f))\n file)\n\n(defn ^File load-file\n \"The local File backing a given path. Returns nil if no file exists.\"\n [path]\n (let [f (file path)]\n (when (.isFile f)\n f)))\n\n(defn ^String save-string!\n \"Caches the given string to a cache path. Returns string.\"\n [string path]\n (write-atomic! [f (file! path)]\n (spit f string))\n string)\n\n(defn load-string\n \"Returns the cached value for a given path as a string, or nil if uncached.\"\n [path]\n (when-let [f (load-file path)]\n (slurp f)))\n\n(defn save-edn!\n \"Writes the given data structure to an EDN file. Returns data.\"\n [data path]\n (write-atomic! [f (file! path)]\n (with-open [w (io/writer f)]\n (binding [*out* w]\n (pprint data))))\n data)\n\n(defn load-edn\n \"Reads the given cache path as an EDN structure, returning data. Returns nil\n if file does not exist.\"\n [path]\n (when-let [f (load-file path)]\n (edn/read-string (slurp f))))\n\n(defn save-remote!\n \"Caches a remote path (a string) to a cache path by SCPing it down. Returns\n remote-path.\"\n [remote-path cache-path]\n (write-atomic! [f (file! cache-path)]\n (c/download remote-path (.getCanonicalPath f)))\n remote-path)\n\n(defn deploy-remote!\n \"Deploys a cached path to the given remote path (a string). Deletes remote\n path first. Creates parents if necessary. Returns remote path.\"\n [cache-path remote-path]\n (when-not (cached? cache-path)\n (throw (IllegalStateException. (str \"Path \" (pr-str cache-path) \" is not cached and cannot be deployed.\"))))\n (when-not (re-find #\"/\\w+/.+\" remote-path)\n (throw (IllegalArgumentException.\n (str \"You asked to deploy to a remote path \" (pr-str remote-path)\n \" which looks relative or suspiciously short--this might be dangerous!\"))))\n\n (c/exec :rm :-rf remote-path)\n (let [parent (.getParent (io/file remote-path))]\n (c/exec :mkdir :-p parent)\n (c/upload (.getCanonicalPath (file cache-path)) remote-path)\n remote-path))\n\n;; Locks\n\n(defonce locks\n (util/named-locks))\n\n(defmacro locking\n \"Acquires a lock for a particular cache path, and evaluates body. Helpful for\n reducing concurrent evaluation of expensive cache misses.\"\n [path & body]\n `(util/with-named-lock locks ~path\n ~@body))\n" }, { "path": "jepsen/src/jepsen/generator/interpreter.clj", "content": "(ns jepsen.generator.interpreter\n \"This namespace interprets operations from a pure generator, handling worker\n threads, spawning processes for interacting with clients and nemeses, and\n recording a history.\"\n (:refer-clojure :exclude [run!])\n (:require [clojure [datafy :refer [datafy]]\n [pprint :refer [pprint]]]\n [clojure.tools.logging :refer [info warn error]]\n [jepsen [client :as client]\n [generator :as gen]\n [history :as h]\n [nemesis :as nemesis]\n [util :as util :refer [exception-message]]]\n [jepsen.generator.context :as context]\n [jepsen.store.format :as store.format]\n [clj-commons.slingshot :refer [try+ throw+]])\n (:import (java.util.concurrent ArrayBlockingQueue\n TimeUnit)\n (io.lacuna.bifurcan Set)))\n\n\n(defprotocol Worker\n \"This protocol allows the interpreter to manage the lifecycle of stateful\n workers. All operations on a Worker are guaranteed to be executed by a single\n thread.\"\n (open [this test id]\n \"Spawns a new Worker process for the given worker ID.\")\n\n (invoke! [this test op]\n \"Asks the worker to perform this operation, and returns a completed\n operation.\")\n\n (close! [this test]\n \"Closes this worker, releasing any resources it may hold.\"))\n\n(deftype ClientWorker [node\n ^:unsynchronized-mutable process\n ^:unsynchronized-mutable client\n ^:unsynchronized-mutable logged-errors]\n Worker\n (open [this test id]\n this)\n\n (invoke! [this test op]\n (if (and (not= process (:process op))\n (not (client/is-reusable? client test)))\n ; New process, new client!\n (do (close! this test)\n ; Try to open new client\n (let [err (try\n (set! (.client this)\n (client/open! (client/validate (:client test))\n test node))\n (set! (.process this) (:process op))\n nil\n (catch Exception e\n (let [klass (class e)]\n (when-not (logged-errors klass)\n ; First time seeing this kind of error\n (do (warn e (exception-message\n e \"Error opening client\"))\n (set! (.logged-errors this)\n (conj logged-errors klass)))))\n ; Fresh client\n (set! (.client this) nil)\n ; And a failed operation\n (assoc op\n :type :fail\n :error [:no-client (.getMessage e)])))]\n ; If we failed to open, just go ahead and return that error op.\n ; Otherwise, we can try again, this time with a fresh client.\n (or err (recur test op))))\n ; Good, we have a client for this process.\n (client/invoke! client test op)))\n\n (close! [this test]\n (when client\n (client/close! client test)\n (set! (.client this) nil))))\n\n(defrecord NemesisWorker []\n Worker\n (open [this test id] this)\n\n (invoke! [this test op]\n (nemesis/invoke! (:nemesis test) test op))\n\n (close! [this test]))\n\n; This doesn't feel like the right shape exactly, but it's symmetric to Client,\n; Nemesis, etc.\n(defrecord ClientNemesisWorker []\n Worker\n (open [this test id]\n ;(locking *out* (prn :spawn id))\n (if (integer? id)\n (let [nodes (:nodes test)]\n (ClientWorker. (nth nodes (mod id (count nodes))) nil nil #{}))\n (NemesisWorker.)))\n\n (invoke! [this test op])\n\n (close! [this test]))\n\n(defn client-nemesis-worker\n \"A Worker which can spawn both client and nemesis-specific workers based on\n the :client and :nemesis in a test.\"\n []\n (ClientNemesisWorker.))\n\n(defn spawn-worker\n \"Creates communication channels and spawns a worker thread to evaluate the\n given worker. Takes a test, a Queue which should receive completion\n operations, a Worker object, and a worker id.\n\n Returns a map with:\n\n :id The worker ID\n :future The future evaluating the worker code\n :in A Queue which delivers invocations to the worker\"\n [test ^ArrayBlockingQueue out worker id]\n (let [in (ArrayBlockingQueue. 1)\n fut\n (future\n (util/with-thread-name (str \"jepsen worker \"\n (util/name+ id))\n (let [worker (open worker test id)]\n (try\n (loop []\n (when\n (let [op (.take in)]\n (try\n (case (:type op)\n ; We're done here\n :exit false\n\n ; Ahhh\n :sleep (do (Thread/sleep (long (* 1000 (:value op))))\n (.put out op)\n true)\n\n ; Log a message\n :log (do (info (:value op))\n (.put out op)\n true)\n\n ; Ask the invoke handler\n (do (util/log-op op)\n (let [op' (invoke! worker test op)]\n (.put out op')\n (util/log-op op')\n true)))\n\n (catch Throwable e\n ; Yes, we want to capture throwable here;\n ; assertion errors aren't Exceptions. D-:\n (warn e (exception-message\n e \"Process\" (:process op) \"crashed\"))\n\n ; Convert this to an info op.\n (.put out\n (assoc op\n :type :info\n :exception (datafy e)\n :error (str \"indeterminate: \"\n (if (.getCause e)\n (.. e getCause\n getMessage)\n (.getMessage e)))))\n true)))\n (recur)))\n (finally\n ; Make sure we close our worker on exit.\n (close! worker test))))))]\n {:id id\n :in in\n :future fut}))\n\n(def ^Long/TYPE max-pending-interval\n \"When the generator is :pending, this controls the maximum interval before\n we'll update the context and check the generator for an operation again.\n Measured in microseconds.\"\n 1000)\n\n(defn goes-in-history?\n \"Should this operation be journaled to the history? We exclude :log and\n :sleep ops right now.\"\n [op]\n (condp identical? (:type op)\n :sleep false\n :log false\n true))\n\n(defn run!\n \"Takes a test with a :store :handle open. Causes the test's reference to the\n :generator to be forgotten, to avoid retaining the head of infinite seqs.\n Opens a writer for the test's history using that handle. Creates an initial\n context from test and evaluates all ops from (:gen test). Spawns a thread for\n each worker, and hands those workers operations from gen; each thread applies\n the operation using (:client test) or (:nemesis test), as appropriate.\n Invocations and completions are journaled to a history on disk. Returns a new\n test with no :generator and a completed :history.\n\n Generators are automatically wrapped in friendly-exception and validate.\n Clients are wrapped in a validator as well.\n\n Automatically initializes the generator system, which, on first invocation,\n extends the Generator protocol over some dynamic classes like (promise).\"\n [test]\n (gen/init!)\n (with-open [history-writer (store.format/test-history-writer!\n (:handle (:store test))\n test)]\n (let [ctx (gen/context test)\n worker-ids (gen/all-threads ctx)\n completions (ArrayBlockingQueue.\n (.size ^io.lacuna.bifurcan.ISet worker-ids))\n workers (mapv (partial spawn-worker test completions\n (client-nemesis-worker))\n worker-ids)\n invocations (into {} (map (juxt :id :in) workers))\n gen (->> (:generator test)\n deref\n gen/friendly-exceptions\n gen/validate)\n ; Forget generator\n _ (util/forget! (:generator test))\n test (dissoc test :generator)]\n (try+\n (loop [ctx ctx\n gen gen\n op-index 0 ; Index of the next op in the history\n outstanding 0 ; Number of in-flight ops\n ; How long to poll on the completion queue, in micros.\n poll-timeout 0]\n ; First, can we complete an operation? We want to get to these first\n ; because they're latency sensitive--if we wait, we introduce false\n ; concurrency.\n (if-let [op' (.poll completions poll-timeout TimeUnit/MICROSECONDS)]\n (let [;_ (prn :completed op')\n thread (gen/process->thread ctx (:process op'))\n time (util/relative-time-nanos)\n ; Update op with index and new timestamp\n op' (assoc op' :index op-index :time time)\n ; Update context with new time and thread being free\n ctx (context/free-thread ctx time thread)\n ; Let generator know about our completion. We use the context\n ; with the new time and thread free, but *don't* assign a new\n ; process here, so that thread->process recovers the right\n ; value for this event.\n gen (gen/update gen test ctx op')\n ; Threads that crash (other than the nemesis), or which\n ; explicitly request a new process, should be assigned new\n ; process identifiers.\n ctx (if (and (not= :nemesis thread)\n (or (= :info (:type op'))\n (:end-process? op')))\n (context/with-next-process ctx thread)\n ctx)]\n ; Log completion and move on\n (if (goes-in-history? op')\n (do (store.format/append-to-big-vector-block!\n history-writer op')\n (recur ctx gen (inc op-index) (dec outstanding) 0))\n (recur ctx gen op-index (dec outstanding) 0)))\n\n ; There's nothing to complete; let's see what the generator's up to\n (let [time (util/relative-time-nanos)\n ctx (assoc ctx :time time)\n ;_ (prn :asking-for-op)\n ;_ (binding [*print-length* 12] (pprint gen))\n [op gen'] (gen/op gen test ctx)]\n ;_ (prn :time time :got op)]\n (condp = op\n ; We're exhausted, but workers might still be going.\n nil (if (pos? outstanding)\n ; Still waiting on workers\n (recur ctx gen op-index outstanding\n (long max-pending-interval))\n ; Good, we're done. Tell workers to exit...\n (do (doseq [[thread queue] invocations]\n (.put ^ArrayBlockingQueue queue {:type :exit}))\n ; Wait for exit\n (dorun (map (comp deref :future) workers))\n ; Await completion of writes\n (.close history-writer)\n ; And return history\n (let [history-block-id (:block-id history-writer)\n history\n (-> (:handle (:store test))\n (store.format/read-block-by-id\n history-block-id)\n :data\n (h/history {:dense-indices? true\n :have-indices? true\n :already-ops? true}))]\n (assoc test :history history))))\n\n ; Nothing we can do right now. Let's try to complete something.\n :pending (recur ctx gen op-index\n outstanding (long max-pending-interval))\n\n ; Good, we've got an invocation.\n (if (< time (:time op))\n ; Can't evaluate this op yet!\n (do ;(prn :waiting (util/nanos->secs (- (:time op) time)) \"s\")\n (recur ctx gen op-index outstanding\n ; Unless something changes, we don't need to ask\n ; the generator for another op until it's time.\n (long (/ (- (:time op) time) 1000))))\n\n ; Good, we can run this.\n (let [thread (gen/process->thread ctx (:process op))\n op (assoc op :index op-index)\n ; Log the invocation\n goes-in-history? (goes-in-history? op)\n _ (when goes-in-history?\n (store.format/append-to-big-vector-block!\n history-writer op))\n op-index' (if goes-in-history? (inc op-index) op-index)\n ; Dispatch it to a worker\n _ (.put ^ArrayBlockingQueue (get invocations thread) op)\n ; Update our context to reflect\n ctx (context/busy-thread ctx\n (:time op) ; Use time instead?\n thread)\n ; Let the generator know about the invocation\n gen' (gen/update gen' test ctx op)]\n (recur ctx gen' op-index' (inc outstanding) 0)))))))\n\n (catch Throwable t\n ; We've thrown, but we still need to ensure the workers exit.\n (info \"Shutting down workers after abnormal exit\")\n ; We only try to cancel each worker *once*--if we try to cancel\n ; multiple times, we might interrupt a worker while it's in the\n ; finally block, cleaning up its client.\n (dorun (map (comp future-cancel :future) workers))\n ; If for some reason *that* doesn't work, we ask them all to exit via\n ; their queue.\n (loop [unfinished workers]\n (when (seq unfinished)\n (let [{:keys [in future] :as worker} (first unfinished)]\n (if (future-done? future)\n (recur (next unfinished))\n (do (.offer ^java.util.Queue in {:type :exit})\n (recur unfinished))))))\n (throw t))))))\n" }, { "path": "jepsen/src/jepsen/independent.clj", "content": "(ns jepsen.independent\n \"Some tests are expensive to check--for instance, linearizability--which\n requires we verify only short histories. But if histories are short, we may\n not be able to sample often or long enough to reveal concurrency errors. This\n namespace supports splitting a test into independent components--for example\n taking a test of a single register and lifting it to a *map* of keys to\n registers.\"\n (:require [jepsen [history :as h]\n [util :as util :refer [map-kv]]]\n [jepsen.store :as store]\n [jepsen.checker :refer [merge-valid check-safe Checker]]\n [jepsen.generator :as gen]\n [jepsen.generator.context :as ctx]\n [jepsen.history.fold :refer [loopf]]\n [clojure.tools.logging :refer :all]\n [clojure.core.reducers :as r]\n [clojure.pprint :refer [pprint]]\n [dom-top.core :refer [bounded-pmap loopr]])\n (:import (io.lacuna.bifurcan IEntry IList IMap List Lists Map Maps)\n (java.util.function BiFunction)\n (jepsen.history Op)))\n\n(def dir\n \"What directory should we write independent results to?\"\n \"independent\")\n\n(defn tuple\n \"Constructs a kv tuple\"\n [k v]\n (clojure.lang.MapEntry. k v))\n\n(defn tuple?\n \"Is the given value generated by an independent generator?\"\n [value]\n (instance? clojure.lang.MapEntry value))\n\n(defn sequential-generator\n \"Takes a sequence of keys [k1 k2 ...], and a function (fgen k) which, when\n called with a key, yields a generator. Returns a generator which starts with\n the first key k1 and constructs a generator gen1 via (fgen k1), returns\n elements from gen1 until it is exhausted, then moves to k2.\n\n The generator wraps each :value in the operations it generates in a [k1\n value] tuple.\n\n fgen must be pure.\"\n [keys fgen]\n ; AHHHH LOOK HOW MUCH SIMPLER THIS IS\n (map (fn [k]\n (gen/map (fn wrap-pair [op]\n (assoc op :value (tuple k (:value op))))\n (fgen k)))\n keys))\n\n(defn group-threads\n \"Given a group size and pure generator context, returns a collection of\n collections of threads, each per group.\"\n [n ctx]\n ; Sanity checks\n (let [group-size n\n thread-count (ctx/all-thread-count ctx)\n group-count (quot thread-count group-size)]\n (assert (<= group-size thread-count)\n (str \"With \" thread-count \" worker threads, this\"\n \" jepsen.concurrent/concurrent-generator cannot\"\n \" run a key with \" group-size \" threads concurrently.\"\n \" Consider raising your test's :concurrency to at least \"\n group-size \".\"))\n\n (assert (= thread-count (* group-size group-count))\n (str \"This jepsen.independent/concurrent-generator has \"\n thread-count\n \" threads to work with, but can only use \"\n (* group-size group-count)\n \" of those threads to run \" group-count\n \" concurrent keys with \" group-size\n \" threads apiece. Consider raising or lowering the\"\n \" test's :concurrency to a multiple of \" group-size\n \".\")))\n (->> (gen/all-threads ctx)\n sort\n (partition n)))\n\n(defn make-group->threads\n \"Given a group size and pure generator context, returns a vector where each\n element is the set of threads in the group corresponding to that index.\"\n [n ctx]\n (->> (group-threads n ctx)\n (mapv set)))\n\n(defn make-thread->group\n \"Given a group size and pure generator context, returns a map of threads to\n groups.\"\n [n ctx]\n (into {}\n (for [[group threads] (map-indexed vector (group-threads n ctx))\n thread threads]\n [thread group])))\n\n(defn tuple-gen\n \"Wraps a generator so that it returns :value [k v] tuples for :invoke ops.\"\n [k gen]\n (gen/map (fn [op]\n (if (= :invoke (:type op))\n (assoc op :value (tuple k (:value op)))\n op))\n gen))\n\n(defrecord ConcurrentGenerator\n [; n is the size of each group\n n\n ; fgen turns a key into a generator\n fgen\n ; group->threads is a vector mapping groups to sets of threads; lazily init.\n group->threads\n ; thread->group is a map which takes threads to groups. Lazily initialized.\n thread->group\n ; A vector of context filters, one for each group. We use these to speed up\n ; computing thread-restricted contexts for each group's generator. Lazily\n ; initialized.\n group->context-filter\n ; keys is our collection of remaining keys\n keys\n ; gens is a vector of generators, one for each thread group.\n gens]\n\n gen/Generator\n (op [this test ctx]\n ; (prn)\n ; (prn :op :=======================================)\n (let [; Figure out our thread<->group mappings and context filters\n group->threads (or group->threads (make-group->threads n ctx))\n group->context-filter (or group->context-filter\n (mapv ctx/make-thread-filter\n group->threads))\n thread->group (or thread->group (make-thread->group n ctx))\n ; Lazily initialize our generators\n gens2 (or gens\n (let [group-count (inc (reduce max 0 (vals thread->group)))\n gens (->> (take group-count keys)\n (map fgen)\n (mapv tuple-gen keys))]\n ; Extend with nils if necessary\n (into gens (repeat (- group-count (count gens)) nil))))\n ; If we consumed keys, update them.\n keys (if gens keys\n (let [group-count (inc (reduce max 0 (vals thread->group)))]\n (drop group-count keys)))\n ; What threads are open?\n free-threads (gen/free-threads ctx)\n ; What groups do they belong to?\n free-groups (set (map thread->group free-threads))]\n\n ; (prn :free-threads free-threads)\n ; (prn :free-groups free-groups)\n\n ; We go through each free group, and find the soonest operation any of\n ; those groups can offer us.\n (loop [groups free-groups\n keys keys\n gens gens2\n soonest nil]\n ;(prn :----------)\n ;(prn :group (first groups))\n ;(prn :keys keys)\n ;(prn :gens gens)\n ;(prn :soonest-op soonest-op)\n (if-not (seq groups)\n ; We're done\n (if (:op soonest)\n ; We have an operation to yield\n [(:op soonest)\n (ConcurrentGenerator. n fgen group->threads thread->group\n group->context-filter\n keys (assoc gens (:group soonest)\n (:gen' soonest)))]\n ; We don't have an operation to yield given the current context,\n ; but some groups which weren't currently free might have ops to\n ; yield still. If there's a generator left... we're still pending.\n (when (some identity gens)\n [:pending (ConcurrentGenerator. n fgen group->threads\n thread->group\n group->context-filter keys\n gens)]))\n\n ; OK, let's consider this group\n (let [group (first groups)\n ; What's the generator for this group?\n gen (nth gens group)\n ; We'll need a context for this group specifically\n ctx ((group->context-filter group) ctx)\n ; OK, ask this gen for an op.\n [op gen'] (gen/op gen test ctx)\n ; If this generator is exhausted, we replace it.\n gens (if op\n gens\n (assoc gens group\n (when (seq keys)\n (let [k (first keys)]\n (tuple-gen k (fgen k))))))\n ; If we had to build a new generator, advance keys.\n keys (if op keys (next keys))]\n (if (or op (nil? (get gens group)))\n ; Either we generated an op, or we failed to generate one *and*\n ; there's no replacement generator, because we're out of keys.\n (recur (next groups)\n keys\n gens\n (gen/soonest-op-map soonest\n (when op {:op op\n :group group\n :gen' gen'\n :weight (count\n (group->threads\n group))})))\n ; We didn't get an op, but we do still have a generator. Let's\n ; try again.\n (recur groups\n keys\n gens\n soonest)))))))\n\n (update [this test ctx event]\n (let [process (:process event)\n thread (gen/process->thread ctx process)\n group (thread->group thread)\n unlifted-op (update event :value val)]\n (ConcurrentGenerator.\n n fgen group->threads thread->group group->context-filter keys\n (update gens group gen/update test ctx unlifted-op)))))\n\n(defn concurrent-generator\n \"Takes a positive integer n, a sequence of keys (k1 k2 ...) and a function\n (fgen k) which, when called with a key, yields a generator. Returns a\n generator which splits up threads into groups of n threads per key, and has\n each group work on a key for some time. Once a key's generator is exhausted,\n it obtains a new key, constructs a new generator from key, and moves on.\n\n Threads working with this generator are assumed to have contiguous IDs,\n starting at 0. Violating this assumption results in uneven allocation of\n threads to groups.\n\n Excludes the nemesis by design; only worker threads run here.\n\n Updates are routed to the generator which that thread is currently\n executing.\"\n [n keys fgen]\n (assert (pos? n))\n (assert (integer? n))\n ; There's a straightforward way to write this, which is to use gen/reserve\n ; to break things up into separate groups of threads, and have each group go\n ; through sequential-generator with e.g. modulo keys. The problem is\n ; that this leaves gaps in the key sequence, which can be annoying for users.\n ; Instead, we fold this into a custom generator.\n []\n (gen/clients\n (ConcurrentGenerator. n fgen nil nil nil keys nil)))\n\n(defn history-keys\n \"Takes a history and returns the set of keys in it.\"\n [history]\n (->> history\n (reduce (fn [ks op]\n (let [v (:value op)]\n (if (tuple? v)\n (conj! ks (key v))\n ks)))\n (transient #{}))\n persistent!))\n\n(defn subhistories\n \"Takes a collection of keys and a history. Runs a concurrent fold over the\n history, breaking it into a map of keys to Histories for those keys. Unwraps\n tuples. Materializes everything in memory; later if we want to do ginormous\n histories we should spill to disk.\"\n ; We could do this in a single pass, but the bookkeeping when we don't know\n ; the keyset up front is just exhausting. Tackle this later.\n [ks history]\n (let [unit (fn unit []\n (Map/from ^java.util.Map\n (zipmap ks (repeatedly #(.linear (List.))))))]\n (h/fold\n history\n (loopf\n {:name :subhistories\n :associative? true}\n ; Reducer\n ([^IMap subhistories (unit)]\n [^Op op]\n (recur\n (let [v (.value op)]\n (if (tuple? v)\n ; Op belongs in a specific subhistory\n (let [[k v] v\n subhistory ^IList (.get subhistories k nil)\n subhistory' (.addLast subhistory\n (assoc op :value v))]\n (.put subhistories k subhistory' Maps/MERGE_LAST_WRITE_WINS))\n\n ; This belongs in every subhistory.\n (loopr [^IMap subhistories' subhistories]\n [^IEntry ksh subhistories]\n (let [k (.key ksh)\n ^IList subhistory (.value ksh)\n subhistory' (.addLast subhistory op)]\n (recur (.put subhistories' k subhistory'\n Maps/MERGE_LAST_WRITE_WINS))))))))\n ; Combiner\n ([^IMap shs1 (unit)]\n [^IMap shs2]\n (recur\n ; Loop over new subhistory entries\n (loopr [^IMap shs shs1]\n [k ks]\n (recur\n (let [sh1 (.get shs1 k nil)\n sh2 (.get shs2 k nil)\n sh (Lists/concat sh1 sh2)]\n (.put shs k sh Maps/MERGE_LAST_WRITE_WINS)))))\n ; Convert back to a Clojure map of histories.\n (loopr [shs (transient {})]\n [^IEntry ksh shs1]\n (recur\n (assoc! shs (.key ksh) (h/history (.value ksh))))\n (persistent! shs)))))))\n\n(defn checker\n \"Takes a checker that operates on :values like `v`, and lifts it to a checker\n that operates on histories with values of `[k v]` tuples--like those\n generated by `sequential-generator`.\n\n We partition the history into (count (distinct keys)) subhistories. The\n subhistory for key k contains every element from the original history\n *except* those whose values are MapEntries with a different key. This means\n that every history sees, for example, un-keyed nemesis operations or\n informational logging.\n\n The checker we build is valid iff the given checker is valid for all\n subhistories. Under the :results key we store a map of keys to the results\n from the underlying checker on the subhistory for that key. :failures is the\n subset of that :results map which were not valid.\"\n [checker]\n (reify Checker\n (check [this test history opts]\n (let [ks (history-keys history)\n results (->> (subhistories ks history)\n (bounded-pmap\n (fn per-subhistory [[k h]]\n (let [subdir (concat (:subdirectory opts)\n [dir k])\n results (check-safe\n checker test h\n {:subdirectory subdir\n :history-key k})]\n ; Write analysis\n (store/with-out-file test [subdir\n \"results.edn\"]\n (pprint results))\n\n ; Write history\n (store/with-out-file test [subdir\n \"history.edn\"]\n (util/print-history prn h))\n\n ; Return results as a map\n [k results])))\n (into (sorted-map)))\n failures (->> results\n (reduce (fn [failures [k result]]\n (if (:valid? result)\n failures\n (conj! failures k)))\n (transient []))\n persistent!)]\n {:valid? (merge-valid (map :valid? (vals results)))\n :results results\n :failures failures}))))\n" }, { "path": "jepsen/src/jepsen/lazyfs.clj", "content": "(ns jepsen.lazyfs\n \"Lazyfs allows the injection of filesystem-level faults: specifically, losing\n data which was written to disk but not fsynced. This namespace lets you mount\n a specific directory as a lazyfs filesystem, and offers a DB which\n mounts/unmounts it, and downloads the lazyfs log file--this can be composed\n into your own database. You can then call lose-unfsynced-writes! as a part of\n your database's db/kill! implementation, likely after killing your DB process\n itself.\"\n (:require [clojure.string :as str]\n [clojure.java.io :as io]\n [clojure.tools.logging :refer [info warn]]\n [jepsen [control :as c]\n [db :as db]\n [generator :as gen]\n [util :as util :refer [await-fn meh timeout]]\n [nemesis :as nemesis]]\n [jepsen.control.util :as cu]\n [jepsen.os.debian :as debian]\n [clj-commons.slingshot :refer [try+ throw+]])\n (:import (java.io File)))\n\n(def repo-url\n \"Where can we clone lazyfs from?\"\n \"https://github.com/dsrhaslab/lazyfs.git\")\n\n(def commit\n \"What version should we check out and build?\"\n \"0.3.0\")\n\n(def dir\n \"Where do we install lazyfs to on the remote node?\"\n \"/opt/jepsen/lazyfs\")\n\n(def bin\n \"The lazyfs binary\"\n (str dir \"/lazyfs/build/lazyfs\"))\n\n(def fuse-dev\n \"The path to the fuse device.\"\n \"/dev/fuse\")\n\n(defn config\n \"The lazyfs config file text. Takes a lazyfs map\"\n [{:keys [log-file fifo fifo-completed cache-size]}]\n (str \"[faults]\nfifo_path=\\\"\" fifo \"\\\"\n# Not sure how to use this yet.\n#fifo_path_completed=\\\"\" fifo-completed \"\\\"\n\n[cache]\napply_eviction=false\n\n[cache.simple]\ncustom_size=\\\"\" (or cache-size \"0.5GB\") \"\\\"\nblocks_per_page=1\n\n[filesystem]\nlogfile=\\\"\" log-file \"\\\"\nlog_all_operations=false\n\"))\n\n(def real-extension\n \"When we mount a lazyfs directory, it's backed by a real directory on the\n underlying filesystem: e.g. 'foo' is backed by 'foo.real'. We name this\n directory using this extension.\"\n \".real\")\n\n(defn install!\n \"Installs lazyfs on the currently-bound remote node.\"\n []\n (info \"Installing lazyfs\" commit)\n (c/su\n ; Dependencies\n (debian/install [:g++ :cmake :libfuse3-dev :libfuse3-4 :fuse3 :git])\n ; LXC containers like to delete /dev/fuse on reboot for some reason\n (when-not (cu/exists? fuse-dev)\n ; We're going to create a fuse device that's writable by everyone. This\n ; would be unsafe on normal systems, but Jepsen DB nodes are intended to\n ; be a disposable playground.\n ;\n ; This is an awful hack, but figuring out how to cleanly get permissions\n ; to the right users while also working with systems like debian 3 which\n ; don't HAVE a fuse group any more is... well I'm not sure I can do it\n ; safely/reliably.\n (c/exec :mknod fuse-dev \"c\" 10 229)\n (c/exec :chmod \"a+rw\" fuse-dev))\n ; Set up allow_other so anyone can read and write to the fs\n (c/exec :sed :-i \"/\\\\s*user_allow_other/s/^#//g\" \"/etc/fuse.conf\")\n ; Get the repo\n (when-not (cu/exists? dir)\n (c/exec :mkdir :-p (str/replace dir #\"/[^/]+$\" \"\"))\n (try+\n (c/exec :git :clone repo-url dir)\n (catch [:exit 128] _\n ; Host key not known\n (c/exec :ssh-keyscan :-t :rsa \"github.com\" :>> \"~/.ssh/known_hosts\")\n (c/exec :git :clone repo-url dir))))\n ; Check out version\n (c/cd dir\n (c/exec :git :fetch)\n (c/exec :git :checkout commit)\n (c/exec :git :clean :-fx)\n ; Install libpcache\n (c/cd \"libs/libpcache\"\n (c/exec \"./build.sh\"))\n ; Install lazyfs\n (c/cd \"lazyfs\"\n (c/exec \"./build.sh\")))))\n\n(defn lazyfs\n \"Takes a directory as a string, or a map of options, or a full lazyfs map,\n which is passed through unaltered. Constructs a lazyfs map of all the files\n we need to run a lazyfs for a directory. Map options are:\n\n :dir The directory to mount\n :user Which user should run lazyfs? Default \\\"root\\\".\n :chown Who to set as the owner of the directory. Defaults to\n \\\":\\\"\n :cache-size The size of the lazyfs page cache. Should be a string like\n \\\"0.5GB\\\"\n \"\n [x]\n (let [opts (cond (string? x)\n {:dir x}\n\n (map? x)\n x\n\n true\n (throw (IllegalArgumentException.\n (str \"Expected a string directory or a lazyfs map, but got \"\n (pr-str x)))))\n dir (:dir opts)\n lazyfs-dir (:lazyfs-dir opts (str dir \".lazyfs\"))\n data-dir (:data-dir opts (str lazyfs-dir \"/data\"))\n fifo (:fifo opts (str lazyfs-dir \"/fifo\"))\n fifo-completed (:fifo-completed opts (str lazyfs-dir \"/fifo-completed\"))\n config-file (:config-file opts (str lazyfs-dir \"/config\"))\n log-file (:log-file opts (str lazyfs-dir \"/log\"))\n user (:user opts \"root\")\n chown (:chown opts (str user \":\" user))]\n {:dir dir\n :lazyfs-dir lazyfs-dir\n :data-dir data-dir\n :fifo fifo\n :fifo-completed fifo-completed\n :config-file config-file\n :log-file log-file\n :user user\n :chown chown}))\n\n(defn start-daemon!\n \"Starts the lazyfs daemon once preparation is complete. We daemonize\n ourselves so that we can get logs--also it looks like the built-in daemon\n might not work right now.\"\n [opts]\n ; This explodes if you run it anywhere other than the lazyfs dir\n (c/cd (str dir \"/lazyfs\")\n (c/exec \"scripts/mount-lazyfs.sh\"\n :-c (:config-file opts)\n :-m (:dir opts)\n :-r (:data-dir opts))))\n\n(defn mount!\n \"Takes a lazyfs map, creates directories and config files, and starts the\n lazyfs daemon. You likely want to call this before beginning database setup.\n Returns the lazyfs map.\"\n [{:keys [dir data-dir lazyfs-dir chown user config-file log-file] :as lazyfs}]\n (c/su\n (info \"Mounting lazyfs\" dir)\n ; Make directories\n (c/exec :mkdir :-p dir)\n (c/exec :mkdir :-p data-dir)\n (c/exec :chown chown dir)\n (c/exec :chown :-R chown lazyfs-dir))\n (c/sudo user\n ; Create log file\n (c/exec :touch log-file)\n ; Write config file\n (cu/write-file! (config lazyfs) config-file)\n ; And go!\n (start-daemon! lazyfs))\n ; Await mount\n (c/su\n (await-fn (fn check-mounted []\n (or (re-find #\"lazyfs\" (c/exec :findmnt dir))\n (throw+ {:type ::not-mounted\n :dir dir\n :node c/*host*})))\n {:retry-interval 500\n :log-interval 5000\n :log-message \"Waiting for lazyfs to mount\"}))\n lazyfs)\n\n(declare lose-unfsynced-writes!)\n\n(defn umount!\n \"Stops the given lazyfs map and destroys the lazyfs directory. You probably\n want to call this as a part of database teardown.\"\n [{:keys [lazyfs-dir dir] :as lazyfs}]\n (c/su\n (try+\n ; I think it flushes on umount which can take *forever*, so we drop the\n ; page cache here to try and speed that up.\n (meh (lose-unfsynced-writes! lazyfs))\n (info \"Unmounting lazyfs\" dir)\n (c/exec :fusermount :-uz dir)\n (info \"Unmounted lazyfs\" dir)\n (catch [:exit 1] _\n ; No such directory\n nil)\n (catch [:exit 127] _\n ; Command not found\n nil))\n (c/exec :rm :-rf lazyfs-dir)))\n\n(defn fifo!\n \"Sends a string to the fifo channel for the given lazyfs map.\"\n [{:keys [user fifo fifo-completed]} cmd]\n (timeout 1000 (throw+ {:type ::fifo-timeout\n :cmd cmd\n :node c/*host*\n :fifo fifo})\n ;(info :echo cmd :> fifo)\n (c/sudo user (c/exec :echo cmd :> fifo))))\n\n(defrecord DB [lazyfs]\n db/DB\n (setup! [this test node]\n (install!)\n (mount! lazyfs))\n\n (teardown! [this test node]\n (umount! lazyfs))\n\n db/LogFiles\n (log-files [this test node]\n {(:log-file lazyfs) \"lazyfs.log\"}))\n\n(defn db\n \"Takes a directory or a lazyfs map and constructs a DB whose setup installs\n lazyfs and mounts the given lazyfs dir.\"\n [dir-or-lazyfs]\n (DB. (lazyfs dir-or-lazyfs)))\n\n(defn lose-unfsynced-writes!\n \"Takes a lazyfs map or a lazyfs DB. Asks the local node to lose any writes to\n the given lazyfs map which have not been fsynced yet.\"\n [db-or-lazyfs-map]\n (if (instance? DB db-or-lazyfs-map)\n (recur (:lazyfs db-or-lazyfs-map))\n (do (info \"Losing un-fsynced writes to\" (:dir db-or-lazyfs-map))\n (fifo! db-or-lazyfs-map \"lazyfs::clear-cache\")\n :done)))\n\n(defn checkpoint!\n \"Forces the given lazyfs map or DB to flush writes to disk.\"\n [db-or-lazyfs-map]\n (if (instance? DB db-or-lazyfs-map)\n (recur (:lazyfs db-or-lazyfs-map))\n (do (info \"Checkpointing all writes to\" (:dir db-or-lazyfs-map))\n (fifo! db-or-lazyfs-map \"lazyfs::cache-checkpoint\")\n :done)))\n\n(defn nemesis\n \"A nemesis which inject faults into the given lazyfs map by writing to its\n fifo. Types of faults (:f) supported:\n\n :lose-unfsynced-writes\n\n Forgets any writes which were not fsynced. The\n :value should be a list of nodes you'd like to lose un-fsynced writes on.\n\n You don't necessarily need to use this--I haven't figured out how to\n integrate it well into jepsen.nemesis combined. Once we start getting other\n classes of faults it will probably make sense for this nemesis to get more\n use and expand.\"\n [lazyfs]\n (reify nemesis/Nemesis\n (setup! [this test]\n this)\n\n (invoke! [this test op]\n (case (:f op)\n :lose-unfsynced-writes\n (let [v (c/on-nodes test (:value op)\n (fn [_ _] (lose-unfsynced-writes! lazyfs)))]\n (assoc op :value v))))\n\n (teardown! [this test])\n\n nemesis/Reflection\n (fs [this]\n #{:lose-unfsynced-writes})))\n" }, { "path": "jepsen/src/jepsen/nemesis/combined.clj", "content": "(ns jepsen.nemesis.combined\n \"A nemesis which combines common operations on nodes and processes: clock\n skew, crashes, pauses, and partitions. So far, writing these sorts of nemeses\n has involved lots of special cases. I expect that the API for specifying\n these nemeses is going to fluctuate as we figure out how to integrate those\n special cases appropriately. Consider this API unstable.\n\n This namespace introduces a new abstraction. A `nemesis+generator` is a map\n with a nemesis and a generator for that nemesis. This enables us to write an\n algebra for composing both simultaneously. We call\n checkers+generators+clients a \\\"workload\\\", but I don't have a good word for\n this except \\\"nemesis\\\". If you can think of a good word, please let me know.\n\n We also take advantage of the Process and Pause protocols in jepsen.db,\n which allow us to start, kill, pause, and resume processes.\"\n (:require [clojure.tools.logging :refer [info warn]]\n [clojure [set :as set]]\n [jepsen [control :as c]\n [db :as db]\n [generator :as gen]\n [nemesis :as n]\n [net :as net]\n [random :as rand]\n [util :as util :refer [majority\n minority-third\n rand-distribution]]]\n [jepsen.nemesis.time :as nt]))\n\n(def default-interval\n \"The default interval, in seconds, between nemesis operations.\"\n 10)\n\n(def noop\n \"A package which does nothing.\"\n {:generator nil\n :final-generator nil\n :nemesis n/noop\n :perf #{}})\n\n(defn db-nodes\n \"Takes a test, a DB, and a node specification. Returns a collection of\n nodes taken from that test. node-spec may be one of:\n\n nil - Chooses a random, non-empty subset of nodes\n :one - Chooses a single random node\n :minority - Chooses a random minority of nodes\n :majority - Chooses a random majority of nodes\n :minority-third - Up to, but not including, 1/3rd of nodes\n :primaries - A random nonempty subset of nodes which we think are\n primaries\n :all - All nodes\n [\\\"a\\\", ...] - The specified nodes\"\n [test db node-spec]\n (let [nodes (:nodes test)]\n (case node-spec\n nil (rand/nonempty-subset nodes)\n :one (list (rand/nth nodes))\n :minority (take (dec (majority (count nodes))) (rand/shuffle nodes))\n :majority (take (majority (count nodes)) (rand/shuffle nodes))\n :minority-third (take (minority-third (count nodes)) (rand/shuffle nodes))\n :primaries (rand/nonempty-subset (db/primaries db test))\n :all nodes\n node-spec)))\n\n(defn node-specs\n \"Returns all possible node specification for the given DB. Helpful when you\n don't know WHAT you want to test.\"\n [db]\n (cond-> [nil :one :minority-third :minority :majority :all]\n (satisfies? db/Primary db) (conj :primaries)))\n\n(defn db-nemesis\n \"A nemesis which can perform various DB-specific operations on nodes. Takes a\n database to operate on. This nemesis responds to the following f's:\n\n :start\n :kill\n :pause\n :resume\n\n In all cases, the :value is a node spec, as interpreted by db-nodes.\"\n [db]\n (reify\n n/Reflection\n (fs [this] #{:start :kill :pause :resume})\n\n n/Nemesis\n (setup! [this test] this)\n\n (invoke! [this test op]\n (let [f (case (:f op)\n :start db/start!\n :kill db/kill!\n :pause db/pause!\n :resume db/resume!)\n nodes (db-nodes test db (:value op))\n res (c/on-nodes test nodes (partial f db))]\n (assoc op :value res)))\n\n (teardown! [this test])))\n\n(defn db-generators\n \"A map with a :generator and a :final-generator for DB-related operations.\n Options are from nemesis-package.\"\n [opts]\n (let [db (:db opts)\n faults (:faults opts)\n kill? (and (satisfies? db/Process db) (contains? faults :kill))\n pause? (and (satisfies? db/Pause db) (contains? faults :pause))\n\n ; Lists of possible specifications for nodes to kill/pause\n kill-targets (:targets (:kill opts) (node-specs db))\n pause-targets (:targets (:pause opts) (node-specs db))\n\n ; Starts and kills\n start {:type :info, :f :start, :value :all}\n kill (fn [_ _] {:type :info\n :f :kill\n :value (rand/nth kill-targets)})\n\n ; Pauses and resumes\n resume {:type :info, :f :resume, :value :all}\n pause (fn [_ _] {:type :info\n :f :pause\n :value (rand/nth pause-targets)})\n\n ; Flip-flop generators\n kill-start (gen/flip-flop kill (gen/repeat start))\n pause-resume (gen/flip-flop pause (gen/repeat resume))\n\n ; Automatically generate nemesis failure modes based on what the DB\n ; supports.\n db (:db opts)\n modes (cond-> []\n pause? (conj pause-resume)\n kill? (conj kill-start))\n final (cond-> []\n pause? (conj resume)\n kill? (conj start))]\n {:generator (gen/mix modes)\n :final-generator final}))\n\n(defn db-package\n \"A nemesis and generator package for acting on a single DB. Options are from\n nemesis-package.\"\n [opts]\n (let [needed? (some #{:kill :pause} (:faults opts))\n {:keys [generator final-generator]} (db-generators opts)\n generator (gen/stagger (:interval opts default-interval)\n generator)\n nemesis (db-nemesis (:db opts))]\n {:generator (when needed? generator)\n :final-generator (when needed? final-generator)\n :nemesis nemesis\n :perf #{{:name \"kill\"\n :start #{:kill}\n :stop #{:start}\n :color \"#E9A4A0\"}\n {:name \"pause\"\n :start #{:pause}\n :stop #{:resume}\n :color \"#A0B1E9\"}}}))\n\n(defn grudge\n \"Computes a grudge from a partition spec. Spec may be one of:\n\n :one Isolates a single node\n :majority A clean majority/minority split\n :majorities-ring Overlapping majorities in a ring\n :minority-third Cleanly splits away up to, but not including, 1/3rd of\n nodes\n :primaries Isolates a nonempty subset of primaries into\n single-node components\"\n [test db part-spec]\n (let [nodes (:nodes test)]\n (case part-spec\n :one (n/complete-grudge (n/split-one nodes))\n :majority (n/complete-grudge (n/bisect (rand/shuffle nodes)))\n :majorities-ring (n/majorities-ring nodes)\n :minority-third (n/complete-grudge (split-at (util/minority-third\n (count nodes))\n (rand/shuffle nodes)))\n :primaries (let [primaries (db/primaries db test)]\n (->> primaries\n rand/nonempty-subset\n (map list) ; Put each in its own singleton list\n (cons (remove (set primaries) nodes)) ; others\n n/complete-grudge)) ; And make it a grudge\n\n part-spec)))\n\n(defn partition-specs\n \"All possible partition specs for a DB.\"\n [db]\n (cond-> [:one :minority-third :majority :majorities-ring]\n (satisfies? db/Primary db) (conj :primaries)))\n\n(defn partition-nemesis\n \"Wraps a partitioner nemesis with support for partition specs. Uses db to\n determine primaries.\"\n ([db]\n (partition-nemesis db (n/partitioner)))\n ([db p]\n (reify\n n/Reflection\n (fs [this]\n [:start-partition :stop-partition])\n\n n/Nemesis\n (setup! [this test]\n (partition-nemesis db (n/setup! p test)))\n\n (invoke! [this test op]\n (-> (case (:f op)\n ; Have the partitioner apply the calculated grudge.\n :start-partition (let [grudge (grudge test db (:value op))]\n (n/invoke! p test (assoc op\n :f :start\n :value grudge)))\n ; Have the partitioner heal\n :stop-partition (n/invoke! p test (assoc op :f :stop)))\n ; Remap the :f to what the caller expects on the way back out\n (assoc :f (:f op))))\n\n (teardown! [this test]\n (n/teardown! p test)))))\n\n(defn partition-package\n \"A nemesis and generator package for network partitions. Options as for\n nemesis-package.\"\n [opts]\n (let [needed? ((:faults opts) :partition)\n db (:db opts)\n targets (:targets (:partition opts) (partition-specs db))\n start (fn start [_ _]\n {:type :info\n :f :start-partition\n :value (rand/nth targets)})\n stop {:type :info, :f :stop-partition, :value nil}\n gen (->> (gen/flip-flop start (gen/repeat stop))\n (gen/stagger (:interval opts default-interval)))]\n {:generator (when needed? gen)\n :final-generator (when needed? stop)\n :nemesis (partition-nemesis db)\n :perf #{{:name \"partition\"\n :start #{:start-partition}\n :stop #{:stop-partition}\n :color \"#E9DCA0\"}}}))\n\n(defn packet-nemesis\n \"A nemesis to disrupt packets, e.g. delay, loss, corruption, etc.\n Takes a db to work with [[db-nodes]].\n\n The network behavior is applied to all traffic to and from the target nodes.\n\n This nemesis responds to:\n\n ```\n {:f :start-packet\n :value [node-spec ; target nodes as interpreted by db-nodes\n {:delay {}, ; behaviors that disrupt packets\n :loss {:percent :33%}, ...}]}\n {:f :stop-packet, :value nil}\n ```\n\n See [[jepsen.net/all-packet-behaviors]].\"\n [db]\n (reify\n n/Reflection\n (fs [_this]\n [:start-packet :stop-packet])\n\n n/Nemesis\n (setup! [this {:keys [net] :as test}]\n ; start from known good state, no shaping\n (net/shape! net test nil nil)\n this)\n\n (invoke! [_this {:keys [net] :as test} {:keys [f value] :as op}]\n (let [result (case f\n :start-packet (let [[targets behaviors] value\n targets (db-nodes test db targets)]\n (net/shape! net test targets behaviors))\n :stop-packet (net/shape! net test nil nil))]\n (assoc op :value result)))\n\n (teardown! [_this {:keys [net] :as test}]\n ; leave in known good state, no shaping\n (net/shape! net test nil nil))))\n\n(defn packet-package\n \"A nemesis and generator package that disrupts packets,\n e.g. delay, loss, corruption, etc.\n\n Opts:\n ```clj\n {:packet\n {:targets ; A collection of node specs, e.g. [:one, :all]\n :behaviors [ ; A collection of network behaviors that disrupt packets, e.g.:\n {} ; no disruptions\n {:delay {}} ; delay packets by default amount\n {:corrupt {:percent :33%}} ; corrupt 33% of packets\n ; delay packets by default values, plus duplicate 25% of packets\n {:delay {},\n :duplicate {:percent :25% :correlation :80%}}]}}\n ```\n See [[jepsen.net/all-packet-behaviors]].\n\n Additional options as for [[nemesis-package]].\"\n [opts]\n (let [needed? ((:faults opts) :packet)\n db (:db opts)\n targets (:targets (:packet opts) (node-specs db))\n behaviors (:behaviors (:packet opts) [{}])\n start (fn start [_ _]\n {:type :info\n :f :start-packet\n :value [(rand/nth targets) (rand/nth behaviors)]})\n stop {:type :info\n :f :stop-packet\n :value nil}\n gen (->> (gen/flip-flop start (gen/repeat stop))\n (gen/stagger (:interval opts default-interval)))]\n {:generator (when needed? gen)\n :final-generator (when needed? stop)\n :nemesis (packet-nemesis db)\n :perf #{{:name \"packet\"\n :start #{:start-packet}\n :stop #{:stop-packet}\n :color \"#D1E8A0\"}}}))\n\n(defn clock-package\n \"A nemesis and generator package for modifying clocks. Options as for\n nemesis-package.\"\n [opts]\n (let [needed? ((:faults opts) :clock)\n nemesis (n/compose {{:reset-clock :reset\n :check-clock-offsets :check-offsets\n :strobe-clock :strobe\n :bump-clock :bump}\n (nt/clock-nemesis)})\n db (:db opts)\n target-specs (:targets (:clock opts) (node-specs db))\n targets (fn [test] (db-nodes test db\n (some-> target-specs seq rand/nth)))\n clock-gen (gen/phases\n {:type :info, :f :check-offsets}\n (gen/mix [(nt/reset-gen-select targets)\n (nt/bump-gen-select targets)\n (nt/strobe-gen-select targets)]))\n gen (->> clock-gen\n (gen/f-map {:reset :reset-clock\n :check-offsets :check-clock-offsets\n :strobe :strobe-clock\n :bump :bump-clock})\n (gen/stagger (:interval opts default-interval)))]\n {:generator (when needed? gen)\n :final-generator (when needed?\n (gen/once\n (fn [test ctx]\n {:type :info\n :f :reset-clock\n :value (:nodes test)})))\n :nemesis nemesis\n :perf #{{:name \"clock\"\n :start #{:bump-clock}\n :stop #{:reset-clock}\n :fs #{:strobe-clock}\n :color \"#A0E9E3\"}}}))\n\n(defn file-corruption-nemesis\n \"Wraps [[jepsen.nemesis/bitflip]] and [[jepsen.nemesis/truncate-file]] to\n corrupt files.\n\n Responds to:\n ```\n {:f :bitflip :value [node-spec ... ; target nodes as interpreted by db-nodes\n {:file \\\"/path/to/file/or/dir\\\"\n :probability 1e-5}]}\n {:f :truncate :value [node-spec ... ; target nodes as interpreted by db-nodes\n {:file \\\"/path/to/file/or/dir\\\"\n :drop {:distribution :geometric, :p 1e-3}}]}\n ```\n See [[jepsen.nemesis.combined/file-corruption-package]].\"\n ([db] (file-corruption-nemesis db (n/bitflip) (n/truncate-file)))\n ([db bitflip truncate]\n (reify\n n/Reflection\n (fs [_this]\n [:bitflip :truncate])\n\n n/Nemesis\n (setup! [_this test]\n (file-corruption-nemesis db (n/setup! bitflip test) (n/setup! truncate test)))\n\n (invoke! [_this test {:keys [f value] :as op}]\n (let [[node-spec corruption] value\n targets (db-nodes test db node-spec)\n plan (->> targets\n (reduce (fn [plan node]\n (assoc plan node corruption))\n {}))\n op (assoc op :value plan)]\n (case f\n :bitflip (n/invoke! bitflip test op)\n :truncate (n/invoke! truncate test op))))\n\n (teardown! [this test]\n (n/teardown! bitflip test)\n (n/teardown! truncate test)\n this))))\n\n(defn file-corruption-package\n \"A nemesis and generator package that corrupts files. Options:\n\n ```clj\n {:file-corruption\n {:targets [...] ; A collection of node specs, e.g. [:one, [\\\"n1\\\", \\\"n2\\\"], :all]\n :corruptions [ ; A collection of file corruptions, e.g.:\n {:type :bitflip\n :file \\\"/path/to/file\\\"\n :probability 1e-3},\n {:type :bitflip\n :file \\\"path/to/dir\\\"\n :probability {:distribution :one-of :values [1e-3 1e-4 1e-5]}},\n {:type :truncate\n :file \\\"path/to/file/or/dir\\\"\n :drop {:distribution :geometric :p 1e-3}}]}}\n ```\n\n `:type` can be `:bitflip` or `:truncate`.\n\n If `:file` is a directory, a new random file is selected from that directory\n on each target node for each operation.\n\n `:probability` or `:drop` can be specified as a single value or a\n `distribution-map`. Use a `distribution-map` to generate a new random value\n for each operation using [[jepsen.util/rand-distribution]].\n\n See [[jepsen.nemesis/bitflip]] and [[jepsen.nemesis/truncate-file]].\n\n Additional options as for [[nemesis-package]].\"\n [{:keys [faults db file-corruption interval]}]\n (let [needed? (:file-corruption faults)\n targets (:targets file-corruption (node-specs db))\n corruptions (:corruptions file-corruption)\n gen (->> (fn gen [_test _context]\n (let [target (rand/nth targets)\n {:keys [type file probability drop]} (rand/nth corruptions)\n corruption\n (case type\n :bitflip\n (let [probability\n (cond\n (number? probability)\n probability\n\n (map? probability)\n (rand-distribution probability))]\n {:file file :probability probability})\n :truncate\n (let [drop (cond\n (number? drop) drop\n (map? drop) (rand-distribution drop))]\n {:file file :drop drop}))]\n {:type :info\n :f type\n :value [target corruption]}))\n (gen/stagger (or interval default-interval)))]\n {:generator (when needed? gen)\n :nemesis (file-corruption-nemesis db)\n :perf #{{:name \"file-corruption\"\n :fs #{:bitflip :truncate}\n :start #{}\n :stop #{}\n :color \"#99F2E2\"}}}))\n\n(defn f-map-perf\n \"Takes a perf map, and transforms the fs in it using `lift`.\"\n [lift perf]\n (let [lift-set (comp set (partial map lift))]\n (set (map (fn [perf]\n (cond-> perf\n true (update :name lift)\n (:start perf) (update :start lift-set)\n (:stop perf) (update :stop lift-set)\n (:fs perf) (update :fs lift-set)))\n perf))))\n\n(defn f-map\n \"Takes a function `lift` which (presumably injectively) transforms the :f\n values used in operations, and a nemesis package. Yields a new nemesis\n package which uses the lifted fs. See generator/f-map and nemesis/f-map.\"\n [lift pkg]\n (assoc pkg\n :generator (gen/f-map lift (:generator pkg))\n :final-generator (gen/f-map lift (:final-generator pkg))\n :nemesis (n/f-map lift (:nemesis pkg))\n :perf (f-map-perf lift (:perf pkg))))\n\n(defn compose-packages\n \"Takes a collection of nemesis+generators packages and combines them into\n one. Generators are combined with gen/any. Final generators proceed\n sequentially.\"\n [packages]\n (case (count packages)\n 0 noop\n 1 (first packages)\n {:generator (apply gen/any (keep :generator packages))\n :final-generator (keep :final-generator packages)\n :nemesis (n/compose (keep :nemesis packages))\n :perf (reduce set/union (map :perf packages))}))\n\n(defn nemesis-packages\n \"Just like nemesis-package, but returns a collection of packages, rather than\n the combined package, so you can manipulate it further before composition.\"\n [opts]\n (let [faults (set (:faults opts [:partition :packet :kill :pause :clock :file-corruption]))\n opts (assoc opts :faults faults)]\n [(partition-package opts)\n (packet-package opts)\n (file-corruption-package opts)\n (clock-package opts)\n (db-package opts)]))\n\n(defn nemesis-package\n \"Takes an option map, and returns a map with a :nemesis, a :generator for\n its operations, a :final-generator to clean up any failure modes at the end\n of a test, and a :perf map that can be passed to checker/perf to render nice\n graphs.\n\n This nemesis is intended for throwing a broad array of simple failures at the\n wall, and seeing \\\"what sticks\\\". Once you've found a fault, you can restrict\n the failure modes to specific types of faults, and specific targets for those\n faults, to try and reproduce it faster.\n\n This nemesis is *not* intended for complex sequences of faults, like\n partitionining away a leader, flipping some switch, adjusting the clock on an\n unrelated node, then crashing someone else. I don't think I can devise a good\n declarative langauge for that in a way which is simpler than \\\"generators\\\"\n themselves. For those types of faults, you'll write your own generator\n instead, but you may be able to use this *nemesis* to execute some or all of\n those operations.\n\n Mandatory options:\n\n :db The database you'd like to act on\n\n Optional options:\n\n :interval The interval between operations, in seconds.\n :faults A collection of enabled faults, e.g. [:partition, :kill, ...]\n :partition Controls network partitions\n :packet Controls network packet behavior\n :kill Controls process kills\n :pause Controls process pauses and restarts\n :file-corruption Controls file corruption\n\n Possible faults:\n\n :partition\n :packet\n :kill\n :pause\n :clock\n :file-corruption\n\n Partition options:\n\n :targets A collection of partition specs, e.g. [:majorities-ring, ...]\n\n Packet options:\n\n :targets A collection of node specs, e.g. [:one, :all]\n :behaviors A collection of network packet behaviors, e.g. [{:delay {}}]\n\n Kill and Pause options:\n\n :targets A collection of node specs, e.g. [:one, :all]\n\n File corruption options:\n\n :targets A collection of node specs, e.g. [:one, :all]\n :corruptions A collection of file corruptions, e.g. [{:type :bitflip, :file \\\"/path/to/file\\\" :probability 1e-3}]\"\n [opts]\n (compose-packages (nemesis-packages opts)))\n" }, { "path": "jepsen/src/jepsen/nemesis/file.clj", "content": "(ns jepsen.nemesis.file\n \"Fault injection involving files on disk. This nemesis can copy chunks\n randomly within a file, induce bitflips, or snapshot and restore chunks. It\n can also truncate files.\"\n (:require [clojure.tools.logging :refer [info warn]]\n [jepsen [control :as c]\n [generator :as gen]\n [nemesis :as nemesis]\n [random :as rand]\n [util :as util]]\n [clj-commons.slingshot :refer [try+ throw+]]))\n\n(defn corrupt-file!\n \"Calls corrupt-file on the currently bound remote node, taking a map of\n options.\"\n [{:keys [mode file start end chunk-size mod i probability] :as opts}]\n (assert (string? file))\n (c/su\n (case mode\n ; Truncate is special; we just use the standard `truncate` command.\n \"truncate\"\n (do (c/exec \"truncate\"\n :--no-create\n :--size (:size opts 0)\n file)\n [:truncated file (:size opts 0)])\n ; Everything else goes to our corrupt-file program\n (c/exec (str nemesis/bin-dir \"/corrupt-file\")\n (when mode [:--mode mode])\n (when start [:--start start])\n (when end [:--end end])\n (when chunk-size [:--chunk-size chunk-size])\n (when mod [:--modulus mod])\n (when i [:--index i])\n (when probability [:--probability (double probability)])\n file))))\n\n(defn clear-snapshots!\n \"Asks corrupt-file! to clear its snapshots directory on the currently bound\n remote node.\"\n []\n (c/su\n (c/exec (str nemesis/bin-dir \"/corrupt-file\") :--clear-snapshots)))\n\n(defn f->mode\n \"Turns an op :f into a mode for the corrupt-file binary.\"\n [f]\n (case f\n :bitflip-file-chunks \"bitflip\"\n :copy-file-chunks \"copy\"\n :restore-file-chunks \"restore\"\n :snapshot-file-chunks \"snapshot\"\n :truncate-file \"truncate\"))\n\n(defrecord CorruptFileNemesis\n ; A map of default options, e.g. {:chunk-size ..., :file, ...}, which are\n ; merged as defaults into each corruption we perform.\n [default-opts]\n\n nemesis/Reflection\n (fs [this]\n #{:bitflip-file-chunks\n :copy-file-chunks\n :restore-file-chunks\n :snapshot-file-chunks\n :truncate-file})\n\n nemesis/Nemesis\n (setup! [this test]\n (c/with-test-nodes test\n (nemesis/compile-c-resource! \"corrupt-file.c\" \"corrupt-file\")\n (clear-snapshots!))\n this)\n\n (invoke! [this test {:keys [f value] :as op}]\n (assert (every? string? (map :node value)))\n (case f\n (:bitflip-file-chunks\n :copy-file-chunks\n :restore-file-chunks\n :snapshot-file-chunks\n :truncate-file)\n (let [v (c/on-nodes\n test\n (distinct (map :node value))\n (fn node [test node]\n ; Apply each relevant corruption\n (->> value\n (keep (fn corrupt! [corruption]\n (let [corruption\n (-> default-opts\n (assoc :mode (f->mode f))\n (merge corruption))]\n (when (= node (:node corruption))\n (try+\n (corrupt-file! corruption)\n (catch [:type :jepsen.control/nonzero-exit\n :exit 2] e\n [:io-error (:err e)]))))))\n (into []))))]\n (assoc op :value v))))\n\n (teardown! [this test]\n (c/with-test-nodes test\n (clear-snapshots!))))\n\n(defn corrupt-file-nemesis\n \"This nemesis takes operations like\n\n {:f :copy-file-chunks\n :value [{:node \\\"n2\\\"\n :file \\\"/foo/bar\\\"\n :start 128\n :end 256\n :chunk-size 16\n :mod 5\n :i 2}}\n ...]}\n\n This corrupts the file /foo/bar on n2 in the region [128, 256) bytes,\n dividing that region into 16 KB chunks, then corrupting every fifth chunk,\n starting with (zero-indexed) chunk 2: 2, 7, 12, 17, .... Data is copied from\n other chunks in the region which are *not* interfered with by this command,\n unless mod is 1, in which case chunks are randomly selected. The idea is that\n this gives us a chance to produce valid-looking structures which might be\n dereferenced by later pointers.\n\n {:f :bitflip-file-chunks\n :value [{:node \\\"n3\\\"\n :file \\\"/foo/bar\\\"\n :start 512\n :end 1024\n :probability 1e-3}]}\n\n This flips roughly one in a thousand bits, in the region of /foo/bar between\n 512 and 1024 bytes. The `mod`, `i`, and `chunk-size` settings all work as\n you'd expect.\n\n {:f :snapshot-file-chunks\n :value [{:node \\\"n2\\\"\n :file \\\"/foo/bar\\\"\n :start 128\n :end 256\n :chunk-size 16\n :mod 5\n :i 2}}\n ...]}\n\n :snapshot-file-chunks uses the same start/end/chunk logic as corrupt-file,\n chunks. However, instead of corrupting chunks, it copies them to files in\n /tmp. These chunks can be restored by a corresponding :restore-file-chunks\n operation:\n\n {:f :restore-file-chunks\n :value [{:node \\\"n2\\\"\n :file \\\"/foo/bar\\\"\n :start 128\n :end 256\n :chunk-size 16\n :mod 5\n :i 2}}\n ...]}\n\n This uses the same start/end/chunk logic, but copies data from the most\n recently snapshotted chunks back into the file itself. You can use this to\n force what looks like a rollback of parts of a file's state--for instance, to\n simulate a misdirected or lost write.\n\n {:f :truncate-file\n :value [{:node \\\"n3\\\"\n :file \\\"/foo/bar\\\"\n :size -4}\n ...]}\n\n This truncates /foo/bar on node n3, trimming the last four bytes off the end.\n Positive sizes truncate the file to at most that many bytes.\n\n All options are optional, except for :node and :file. See\n resources/corrupt-file.c for defaults.\n\n This function can take an optional map with defaults for each file-corruption\n operation.\"\n ([]\n (corrupt-file-nemesis {}))\n ([default-opts]\n (CorruptFileNemesis. default-opts)))\n\n(defrecord HelixGen\n [; Produces :f :corrupt-file-chunks (or similar), and :value nil.\n f-gen\n ; Map of default options for each corruption.\n default-opts]\n gen/Generator\n (op [this test ctx]\n ; We immediately unfurl into a series of ops based on f-gen with values\n ; derived from our node choices.\n (let [nodes (rand/shuffle (:nodes test))\n value (mapv (fn per-node [i node]\n (assoc default-opts\n :node node\n :mod (count nodes)\n :i i))\n (range)\n nodes)]\n (gen/op (gen/map (fn per-op [op] (assoc op :value value))\n f-gen)\n test ctx)))\n\n (update [this test ctx op]\n this))\n\n(defn helix-gen\n \"Takes default options for a single file corruption map (see\n `corrupt-file-nemesis`), and a generator which produces operations like {:f\n :bitflip-file-chunks}. Returns a generator which fills in values for those\n operations, such that in each operation, every node corrupts the file, but\n they all corrupt different, stable regions.\n\n (helix-gen {:chunk-size 2}\n (gen/repeat {:type :info, :f :copy-file-chunks}))\n\n When first invoked, selects a permutation of the nodes in the test, assigning\n each a random index from 0 to n-1. Each value emitted by the generator uses\n that index, and `modulus` n. If the permutation of node is is [n1, n2, n3],\n and the chunk size is 2 bytes, the affected chunks look like:\n\n node file bytes\n 0123456789abcde ...\n n1 ╳╳ ╳╳ ╳╳\n n2 ╳╳ ╳╳ ╳\n n3 ╳╳ ╳╳\n\n This seems exceedingly likely to destroy a cluster, but some systems may\n survive it. In particular, systems which keep their on-disk representation\n very close across different nodes may be able to recover from the intact\n copies on other nodes.\"\n ([f-gen]\n (helix-gen {} f-gen))\n ([default-corruption-opts f-gen]\n (HelixGen. f-gen default-corruption-opts)))\n\n(defrecord NodesGen [n default-opts f-gen]\n gen/Generator\n (op [this test ctx]\n ; Pick nodes we're allowed to interfere with\n (let [n (if (number? n)\n n\n (n test))\n _ (assert (integer? n)\n (str \"Expected (n test) to return an integer, but got \"\n (pr-str n)))\n nodes (->> (:nodes test) rand/shuffle (take n) vec)]\n ; Unfurl into f-gen, with values rewritten to random subsets of those\n ; nodes.\n (gen/op\n (gen/map (fn op [op]\n (let [value (mapv (fn per-node [node]\n (assoc default-opts\n :node node))\n (rand/nonempty-subset nodes))]\n (assoc op :value value)))\n f-gen)\n test ctx)))\n\n (update [this test ctx event]\n this))\n\n(defn nodes-gen\n \"Takes a number of nodes `n`, a map of default file corruption options (see\n `corrupt-file-nemesis`), and a generator of operations like `{:type :info, :f\n :snapshot-file-chunk}` with `nil` `:value`s. Returns a generator where each\n value is a vector of file corruptions, restricted to at most `n` nodes over\n the course of the test. This corrupts bytes [128, 256) on at most two nodes\n over the course of the test.\n\n (nodes-gen 2\n {:start 128, :end 256}\n (gen/repeat {:type :info, :f :bitflip-file-chunks}))\n\n `n` can also be a function `(n test)`, which can be used to select (e.g.) a\n minority of nodes. For example, try `(comp jepsen.util/minority count\n :nodes)`.\n\n This generator is intended to stress systems which can tolerate disk faults\n on up to n nodes, but no more.\"\n ([n f-gen]\n (nodes-gen n {} f-gen))\n ([n default-opts f-gen]\n (NodesGen.\n n\n default-opts\n f-gen)))\n" }, { "path": "jepsen/src/jepsen/nemesis/membership/state.clj", "content": "(ns jepsen.nemesis.membership.state\n \"This namespace defines the protocol for nemesis membership state\n machines---how to find the current view from a node, how to merge node views\n together, how to generate, apply, and complete operations, etc.\n\n States should be Clojure defrecords, and have several special keys:\n\n :node-views A map of nodes to the view of the cluster state from that\n particular node.\n\n :view The merged view of the cluster state.\n\n :pending A set of [op op'] pairs we've applied to the cluster,\n but we're not sure if they're resolved yet.\n\n All three of these keys will be initialized and merged into your State for\n you by the membership nemesis.\"\n (:refer-clojure :exclude [resolve]))\n\n(defprotocol State\n (setup! [this test]\n \"Performs a one-time initialization of state. Should return a new\n state. This is a good place to open network connections or set up\n mutable resources.\")\n\n (node-view [this test node]\n \"Returns the view of the cluster from a particular node. Return\n `nil` to indicate the view is currently unknown; the membership\n system will ignore nil results.\")\n\n (merge-views [this test]\n \"Derive a new :view from this state's current :node-views.\n Used as our authoritative view of the cluster.\")\n\n (fs [this]\n \"A set of all possible op :f's we might generate.\")\n\n (op [this test]\n \"Returns an operation we could perform next--or :pending if no\n operation is available.\")\n\n (invoke! [this test op]\n \"Applies an operation we generated. Returns a completed op, or a\n tuple of [op, state'].\")\n\n\n (resolve [this test]\n \"Called repeatedly on a state to evolve it towards some fixed new\n state. A more general form of resolve-op.\")\n\n (resolve-op [this test [op op']]\n \"Called with a particular pair of operations (both invocation and\n completion). If that operation has been resolved, returns a new\n version of the state. Otherwise, returns nil.\")\n\n (teardown! [this test]\n \"Called at the end of the test to dispose of this State. This is\n your opportunity to close network connections etc.\"))\n" }, { "path": "jepsen/src/jepsen/nemesis/membership.clj", "content": "(ns jepsen.nemesis.membership\n \"EXPERIMENTAL: provides standardized support for nemeses which add and remove\n nodes from a cluster.\n\n This is a tricky problem. Even the concept of cluster state is complicated:\n there is Jepsen's knowledge of the state, and each individual node's\n understanding of the current state. Depending on which node you ask, you may\n get more or less recent (or, frequently, divergent) views of cluster state.\n Cluster state representation is highly variable across databases, which means\n our standardized state machine must allow for that variability.\n\n We are guided by some principles that crop up repeatedly in writing these\n sorts of nemeses:\n\n 1. We should avoid creating useless cluster states--e.g. those that can't\n fulfill any requests--for very long.\n\n 2. There are both safe and unsafe transitions. In general, commands like\n join/remove should always be safe. Removing data, however, is *unsafe*\n unless we can prove the node has been properly removed.\n\n 3. We *want* to leave nodes running, with data files intact, after removing\n them. This is when interesting things happen.\n\n 4. We must be safe in the presence of concurrent node kill/restart\n operations.\n\n 5. Nodes tend to go down or fail to reach the rest of the cluster, but we\n want to continue making decisions during this time.\n\n 6. Requested changes to the cluster may time out, or simply take a while to\n perform. We need to *remember* these ongoing operations, use them to\n constrain our choices of further changes (e.g. if four node removals are\n underway, don't initiate a fifth), and find ways to resolve those ongoing\n changes, e.g. by confirming they took place.\n\n Our general approach is to define a sort of state machine where the state is\n our representation of the cluster state, how all nodes view the cluster, and\n the set of ongoing operations, plus any auxiliary material (e.g. after\n completing a node removal, we can delete its data files). This state is\n periodically *updated* by querying individual nodes, and *also* by performing\n operations--e.g. initiating a node removal.\n\n The generator constructs those operations by asking the nemesis what sorts of\n operations would be legal to perform at this time, and picking one of those.\n It then passes that operation back to the nemesis (via nemesis/invoke!), and\n the nemesis updates its local state and performs the operation.\"\n (:refer-clojure :exclude [resolve])\n (:require [clojure [pprint :refer [pprint]]\n [set :as set]]\n [clojure.tools.logging :refer [info warn]]\n [jepsen [control :as c]\n [generator :as gen]\n [nemesis :as nem]\n [util :as util :refer [fixed-point\n pprint-str]]]\n [jepsen.nemesis.membership.state :as state]))\n\n(def node-view-interval\n \"How many seconds between updating node views.\"\n 5)\n\n(def State\n \"For convenience, a copy of the membership State protocol. This lets users\n implement the protocol without requiring the state namespace themselves.\"\n state/State)\n\n(defn initial-state\n \"Constructs an initial cluster state map for the given test.\"\n [test]\n (let [nodes (:nodes test)]\n {; A map of node names to their view of the cluster\n :node-views {}\n ; A merged view derived from those node views, plus any local state\n :view nil\n ; A set of [op op] operations we have applied\n :pending #{}}))\n\n(defn resolve-ops\n \"Try to resolve any pending ops we can. Returns state with those ops\n resolved.\"\n [state test opts]\n (reduce (fn [state op-pair]\n (if-let [state' (state/resolve-op state test op-pair)]\n ; Ah good, resolved.\n (do (when (:log-resolve-op? opts)\n (info (str \"Resolved pending membership operation:\\n\"\n (pprint-str op-pair))))\n (update state' :pending disj op-pair))\n ; Nope!\n state))\n state\n (:pending state)))\n\n(defn resolve\n \"Resolves a state towards its final form by calling resolve and resolve-ops\n until converged.\"\n [state test opts]\n (let [state' (fixed-point (fn [state]\n (-> state\n (state/resolve test)\n (resolve-ops test opts)))\n state)]\n (when (and (:log-resolve? opts)\n (not= state state'))\n (info (str \"Membership state resolved to\\n\" (pprint-str state'))))\n state'))\n\n(defn update-node-view!\n \"Takes an atom wrapping a State, a test, and a node. Gets the current view\n from that node's perspective, and updates the state atom to reflect it.\"\n [state test node opts]\n ; Get the state from the current node, presumably via\n ; shell/network commands\n (when-let [nv (state/node-view @state test node)]\n (when (and (:log-node-views? opts)\n (not= nv (get-in @state [:node-views node])))\n (info (str \"New node view from \" node \":\\n\")\n (pprint-str nv)))\n (let [; And merge it into the state atom.\n changed-view (atom nil)\n s (locking state\n (swap! state\n (fn merge-views [state]\n ; Update this node view\n (let [node-views' (assoc (:node-views state) node nv)\n state' (assoc state :node-views node-views')\n ; Merge views together\n view' (state/merge-views state' test)\n state' (assoc state' :view view')\n ; Resolve any changes\n state' (resolve state' test opts)]\n ; For logging purposes, keep track of changes\n (reset! changed-view\n (when (not= (:view state) view')\n view'))\n state'))))]\n (when (:log-view? opts)\n (when-let [v @changed-view]\n (info (str \"New membership view (from \" node \"):\\n\"\n (pprint-str v))))))))\n\n(defn node-view-future\n \"Spawns a future which keeps the given state atom updated with our view of\n this node.\"\n [test state running? opts node]\n (future\n (c/on node\n (while @running?\n (try (update-node-view! state test node opts)\n (catch InterruptedException e\n ; This normally happens at the end of our test; changes are\n ; good we're shutting down.\n nil)\n (catch Throwable t\n (warn t \"Node view updater caught throwable; will retry\")))\n (Thread/sleep (long (* 1000 node-view-interval)))))))\n\n(defrecord Nemesis\n [; An atom that tracks our current state\n state\n ; Used to terminate futures\n running?\n ; A collection of futures we use to keep each node's view\n ; up to date.\n node-view-futures\n opts]\n\n nem/Nemesis\n (setup! [this test]\n ; Initialize our state\n (locking state\n (swap! state into (initial-state test))\n (swap! state state/setup! test))\n\n (let [; We'll use this atom to track whether to shut down.\n running? (atom true)\n ; Spawn futures to update nodes.\n futures (mapv (partial node-view-future\n test\n state\n running?\n opts)\n (:nodes test))]\n (assoc this\n :running? running?\n :node-view-futures futures)))\n\n (invoke! [this test op]\n ; Resolve pending ops, and record our new op.\n (locking state\n (let [; Apply the operation.\n s @state\n res (state/invoke! s test op)\n op' (if (vector? res)\n ; If invoke! yielded a pair, we replace the current state\n ; with the new one.\n (let [[op' s'] res]\n ; This shouldn't happen if we lock correctly, but let's\n ; make sure\n (when-not (compare-and-set! state s s')\n (throw (IllegalStateException.\n \"Membership nemesis state changed during invoke!\")))\n op')\n ; Invoke yielded a non-pair; assume it was an op.\n res)]\n ; Update the map to reflect the operation.\n (swap! state (fn [state]\n (-> state\n (update :pending conj [op op'])\n (resolve test opts))))\n op')))\n\n (teardown! [this test]\n ; Graceful shutdown\n (when running?\n (reset! running? false)\n ; Ungraceful shutdown\n (mapv future-cancel node-view-futures)\n ; Shut down state\n (state/teardown! @state test)))\n\n nem/Reflection\n (fs [this]\n (state/fs @state)))\n\n(defrecord Generator [state]\n gen/Generator\n (update [this test ctx event] this)\n\n (op [this test ctx]\n (when-let [op (state/op @state test)]\n ; Expand that into a proper map\n [(if (= :pending op)\n :pending\n (gen/fill-in-op op ctx))\n this])))\n\n(defn package\n \"Constructs a nemesis and generator for membership operations. Options\n are a map like\n\n {:faults #{:membership ...}\n :membership membership-opts}.\n\n Membership opts are:\n\n {:state A record satisfying the State protocol\n :log-resolve-op? Whether to log the resolution of operations\n :log-resolve? Whether to log each resolve step\n :log-node-views? Whether to log changing node views\n :log-view? Whether to log the entire cluster view.\n\n The package includes a :state field, which is an atom of the current cluster\n state. You can use this (for example) to have generators which inspect the\n current cluster state and use it to target faults.\n\n You may want to add to this package a :final-generator to rejoin all nodes,\n and a :perf key to tell Jepsen's performance plots how to render your\n nemeses.\n\n (assoc pkg\n :perf #{{:name \\\"membership\\\"\n :start #{:leave}\n :stop #{:join}\n :color \\\"#9AE48B\\\"}}\n :final-generator (mapv (fn [node]\n {:type :info, :f :join, :value node})\n targetable-nodes))\"\n [opts]\n (when (contains? (:faults opts) :membership)\n (let [mopts (:membership opts)\n state (atom (:state mopts))\n nem (map->Nemesis {:state state\n :opts (select-keys mopts [:log-node-views?\n :log-view?\n :log-resolve?\n :log-resolve-op?])})\n gen (->> (Generator. state)\n (gen/stagger (:interval opts 10)))]\n {:state state\n :nemesis nem\n :generator gen})))\n" }, { "path": "jepsen/src/jepsen/nemesis/time.clj", "content": "(ns jepsen.nemesis.time\n \"Functions for messing with time and clocks.\"\n (:require [clojure.tools.logging :refer [info warn]]\n [jepsen.os.debian :as debian]\n [jepsen.os.centos :as centos]\n [jepsen [util :as util]\n [client :as client]\n [control :as c]\n [generator :as gen]\n [nemesis :as nemesis]\n [random :as rand]]\n [jepsen.control.util :as cu]\n [clojure.string :as str]\n [clojure.java.io :as io]\n [clj-commons.slingshot :refer [try+ throw+]])\n (:import (java.io File)))\n\n(defn install!\n \"Uploads and compiles some C programs for messing with clocks.\"\n []\n (nemesis/compile-c-resource! \"strobe-time.c\" \"strobe-time\")\n (nemesis/compile-c-resource! \"bump-time.c\" \"bump-time\"))\n\n(defn parse-time\n \"Parses a decimal time in unix seconds since the epoch, provided as a string,\n to a bigdecimal\"\n [s]\n (bigdec (str/trim-newline s)))\n\n(defn clock-offset\n \"Takes a time in seconds since the epoch, and subtracts the local node time,\n to obtain a relative offset in seconds.\"\n [remote-time]\n (float (- remote-time (/ (System/currentTimeMillis) 1000.0))))\n\n(defn current-offset\n \"Returns the clock offset of this node, in seconds.\"\n []\n (clock-offset (parse-time (c/exec :date \"+%s.%N\"))))\n\n(defn maybe-disable-ntp!\n \"Tries to turn off any running NTP service. We let these fail\n quietly--there are lots of ways to run (or not run) NTP.\"\n []\n (c/su\n ; Systemd took over timekeeping so now we also have to go ask systemd\n ; to turn that off. Hilariously, the program to control that does an\n ; RPC call to systemd-timedated, which will then *time out* after 30\n ; seconds if the service is disabled--which is normal in containers.\n ;\n ; root@n1:~# timedatectl status\n ; Failed to query server: Connection timed out\n ;\n ; To work around this, we probe the timedated service first and only\n ; ask it to disable NTP if it's running. I hate everything about this.\n (try+ (c/exec :service :timedated :status)\n ; If this succeeds, we can ask it to stop managing NTP.\n (c/exec :timedatectl :set-ntp :false)\n (catch [:type :jepsen.control/nonzero-exit] _\n ; Service not running\n ))\n ; On older Debian platforms, try to stop ntpd service directly\n (try+ (c/exec :service :ntpd :stop)\n (catch [:type :jepsen.control/nonzero-exit] _))))\n\n(defn reset-time!\n \"Resets the local node's clock to NTP. If a test is given, resets time on all\n nodes across the test.\"\n ([] (c/su (c/exec :ntpdate :-b \"time.google.com\")))\n ([test] (c/with-test-nodes test (reset-time!))))\n\n(defn bump-time!\n \"Adjusts the clock by delta milliseconds. Returns the time offset from the\n current local wall clock, in seconds.\"\n [delta]\n (c/su (clock-offset (parse-time (c/exec \"/opt/jepsen/bump-time\" delta)))))\n\n(defn strobe-time!\n \"Strobes the time back and forth by delta milliseconds, every period\n milliseconds, for duration seconds.\"\n [delta period duration]\n (c/su (c/exec \"/opt/jepsen/strobe-time\" delta period duration)))\n\n(defn clock-nemesis\n \"Generates a nemesis which manipulates clocks. Accepts four types of\n operations:\n\n {:f :reset, :value [node1 ...]}\n\n {:f :strobe, :value {node1 {:delta ms, :period ms, :duration s} ...}}\n\n {:f :bump, :value {node1 delta-ms ...}}\n\n {:f :check-offsets}\"\n []\n (reify nemesis/Nemesis\n (setup! [nem test]\n (c/with-test-nodes test\n (install!)\n (maybe-disable-ntp!)\n (try+ (reset-time!)\n (catch [:type :jepsen.control/nonzero-exit, :exit 1] _\n ; Bit awkward: on some platforms, like containers, we *can't*\n ; step the time, but the way nemesis composition works makes it\n ; so that we still get glued into the overall test nemesis even\n ; if we'll never be called. We'll allow this ntpdate to fail\n ; silently--it's just to help when we *do* mess with times.\n )))\n nem)\n\n (invoke! [_ test op]\n (let [res (case (:f op)\n :reset (c/on-nodes test (:value op) (fn [test node]\n (reset-time!)\n (current-offset)))\n\n :check-offsets (c/on-nodes test (fn [test node]\n (current-offset)))\n\n :strobe\n (let [m (:value op)]\n (c/on-nodes test (keys m)\n (fn [test node]\n (let [{:keys [delta period duration]}\n (get m node)]\n (strobe-time! delta period duration))\n (current-offset))))\n\n :bump\n (let [m (:value op)]\n (c/on-nodes test (keys m)\n (fn [test node]\n (bump-time! (get m node))))))]\n (assoc op :clock-offsets res)))\n\n (teardown! [_ test]\n (c/with-test-nodes test\n (try+ (reset-time!)\n (catch [:type :jepsen.control/nonzero-exit, :exit 1] _\n ; Bit awkward: on some platforms, like containers, we *can't*\n ; step the time, but the way nemesis composition works makes it\n ; so that we still get glued into the overall test nemesis even\n ; if we'll never be called. We'll allow this ntpdate to fail\n ; silently--it's just to help when we *do* mess with times.\n ))))))\n\n(defn reset-gen-select\n \"A function which returns a generator of reset operations. Takes a function\n (select test) which returns nodes from the test we'd like to target for that\n clock reset.\"\n [select]\n (fn [test process]\n {:type :info, :f :reset, :value (select test)}))\n\n(def reset-gen\n \"Randomized reset generator. Performs resets on random subsets of the test's\n nodes.\"\n (reset-gen-select (comp rand/nonempty-subset :nodes)))\n\n(defn bump-gen-select\n \"A function which returns a clock bump generator that bumps the clock from\n -288 to +288 seconds, exponentially distributed. (select test) is used to\n select which subset of the test's nodes to use as targets in the generator.\"\n [select]\n (fn gen [test process]\n {:type :info\n :f :bump\n :value (zipmap (select test)\n (repeatedly\n (fn rand-offset []\n (long (* (rand/nth [-1 1])\n (Math/pow 1.5 (+ 6 (rand/double 25))))))))}))\n\n(def bump-gen\n \"Randomized clock bump generator targeting a random subsets of nodes.\"\n (bump-gen-select (comp rand/nonempty-subset :nodes)))\n\n(defn strobe-gen-select\n \"A function which returns a clock strobe generator that introduces clock\n strobes from 4 ms to 262 seconds, with a period of 1 ms to 1 second, for a\n duration of 0-32 seconds. (select test) is used to select which subset of the\n test's nodes to use as targets in the generator.\"\n [select]\n (fn [test process]\n {:type :info\n :f :strobe\n :value (zipmap (select test)\n (repeatedly\n (fn []\n {:delta (long (Math/pow 2 (+ 2 (rand/double 16))))\n :period (long (Math/pow 2 (rand/double 10)))\n :duration (rand/double 32)})))}))\n\n(def strobe-gen\n \"Randomized clock strobe generator targeting a random subsets of the test's\n nodes.\"\n (strobe-gen-select (comp util/random-nonempty-subset :nodes)))\n\n(defn clock-gen\n \"Emits a random schedule of clock skew operations. Always starts by checking\n the clock offsets to establish an initial bound.\"\n []\n (gen/phases\n {:type :info, :f :check-offsets}\n (gen/mix [reset-gen bump-gen strobe-gen])))\n" }, { "path": "jepsen/src/jepsen/nemesis.clj", "content": "(ns jepsen.nemesis\n (:require [clojure.set :as set]\n [clojure.java.io :as io]\n [clojure.tools.logging :refer [info warn]]\n [fipp.ednize :as fipp.ednize]\n [jepsen [client :as client]\n [control :as c]\n [net :as net]\n [random :as rand]\n [util :as util]]\n [jepsen.control [util :as cu]]\n [clj-commons.slingshot :refer [try+ throw+]])\n (:import (java.io File)))\n\n(defprotocol Nemesis\n (setup! [this test] \"Set up the nemesis to work with the cluster. Returns the\n nemesis ready to be invoked\")\n (invoke! [this test op] \"Apply an operation to the nemesis, which alters the\n cluster.\")\n (teardown! [this test] \"Tear down the nemesis when work is complete\"))\n\n(defprotocol Reflection\n \"Optional protocol for reflecting on nemeses.\"\n (fs [this] \"What :f functions does this nemesis support? Returns a set.\n Helpful for composition.\"))\n\n(extend-protocol fipp.ednize/IOverride (:on-interface Nemesis))\n(extend-protocol fipp.ednize/IEdn (:on-interface Nemesis)\n (-edn [gen]\n (if (record? gen)\n ; Ugh this is such a hack but Fipp's extension points are sort of a\n ; mess--you can't override the document generation behavior on a\n ; per-class basis. Probably sensible for perf reasons, but makes our life\n ; hard.\n ;\n ; Convert records (which respond to map?) into (RecordName {:some map\n ; ...), so they pretty-print with fewer indents.\n (list (symbol (.getName (class gen)))\n (into {} gen))\n ; We can't return a reify without entering an infinite loop (ugh) so uhhh\n (tagged-literal 'unprintable (str gen))\n )))\n\n(def noop\n \"Does nothing.\"\n (reify Nemesis\n (setup! [this test] this)\n (invoke! [this test op] op)\n (teardown! [this test] this)\n Reflection\n (fs [this] #{})))\n\n(defrecord Validate [nemesis]\n Nemesis\n (setup! [this test]\n (let [res (setup! nemesis test)]\n (when-not (satisfies? Nemesis res)\n (throw+ {:type ::setup-returned-non-nemesis\n :got res}\n nil\n \"expected setup! to return a Nemesis, but got %s instead\"\n (pr-str res)))\n (Validate. res)))\n\n (invoke! [this test op]\n (let [op' (invoke! nemesis test op)\n problems\n (cond-> []\n (not (map? op'))\n (conj \"should be a map\")\n\n (not (#{:info} (:type op')))\n (conj \":type should be :info\")\n\n (not= (:process op) (:process op'))\n (conj \":process should be the same\")\n\n (not= (:f op) (:f op'))\n (conj \":f should be the same\"))]\n (when (seq problems)\n (throw+ {:type ::invalid-completion\n :op op\n :op' op'\n :problems problems}))\n op'))\n\n (teardown! [this test]\n (teardown! nemesis test)))\n\n(defn validate\n \"Wraps a nemesis, validating that it constructs responses to setup and invoke\n correctly.\"\n [nemesis]\n (Validate. nemesis))\n\n(defn timeout\n \"Sometimes nemeses are unreliable. If you wrap them in this nemesis, it'll\n time out their operations with the given timeout, in milliseconds. Timed out\n operations have :value :timeout.\"\n [timeout-ms nemesis]\n (reify Nemesis\n (setup! [this test]\n (timeout timeout-ms (setup! nemesis test)))\n\n (invoke! [this test op]\n (util/timeout timeout-ms (assoc op :value :timeout)\n (invoke! nemesis test op)))\n\n (teardown! [this test]\n (teardown! nemesis test))))\n\n(defn bisect\n \"Given a sequence, cuts it in half; smaller half first.\"\n [coll]\n (split-at (Math/floor (/ (count coll) 2)) coll))\n\n(defn split-one\n \"Split one node off from the rest\"\n ([coll]\n (split-one (rand/nth coll) coll))\n ([loner coll]\n [[loner] (remove (fn [x] (= x loner)) coll)]))\n\n(defn complete-grudge\n \"Takes a collection of components (collections of nodes), and computes a\n grudge such that no node can talk to any nodes outside its partition.\"\n [components]\n (let [components (map set components)\n universe (apply set/union components)]\n (reduce (fn [grudge component]\n (reduce (fn [grudge node]\n (assoc grudge node (set/difference universe component)))\n grudge\n component))\n {}\n components)))\n\n(defn invert-grudge\n \"Takes a universe of nodes and a map of nodes to nodes they should be\n connected to, and returns a map of nodes to nodes they should NOT be\n connected to.\"\n [nodes conns]\n (let [nodes (set nodes)]\n (->> nodes\n (map (fn [a] [a (set/difference nodes (conns a #{}))]))\n (into (sorted-map)))))\n\n(defn bridge\n \"A grudge which cuts the network in half, but preserves a node in the middle\n which has uninterrupted bidirectional connectivity to both components.\"\n [nodes]\n (let [components (bisect nodes)\n bridge (first (second components))]\n (-> components\n complete-grudge\n ; Bridge won't snub anyone\n (dissoc bridge)\n ; Nobody hates the bridge\n (->> (util/map-vals #(disj % bridge))))))\n\n(defn partitioner\n \"Responds to a :start operation by cutting network links as defined by\n (grudge nodes), and responds to :stop by healing the network. The grudge to\n apply is either taken from the :value of a :start op, or if that is nil, by\n calling (grudge (:nodes test))\"\n ([] (partitioner nil))\n ([grudge]\n (reify Nemesis\n (setup! [this test]\n (net/heal! (:net test) test)\n this)\n\n (invoke! [this test op]\n (case (:f op)\n :start (let [grudge (or (:value op)\n (if grudge\n (grudge (:nodes test))\n (throw (IllegalArgumentException.\n (str \"Expected op \" (pr-str op)\n \" to have a grudge for a :value, but none given.\")))))]\n (net/drop-all! test grudge)\n (assoc op :value [:isolated grudge]))\n :stop (do (net/heal! (:net test) test)\n (assoc op :value :network-healed))))\n\n (teardown! [this test]\n (net/heal! (:net test) test)))))\n\n(defn partition-halves\n \"Responds to a :start operation by cutting the network into two halves--first\n nodes together and in the smaller half--and a :stop operation by repairing\n the network.\"\n []\n (partitioner (comp complete-grudge bisect)))\n\n(defn partition-random-halves\n \"Cuts the network into randomly chosen halves.\"\n []\n (partitioner (comp complete-grudge bisect rand/shuffle)))\n\n(defn partition-random-node\n \"Isolates a single node from the rest of the network.\"\n []\n (partitioner (comp complete-grudge split-one)))\n\n(defn majorities-ring-perfect\n \"The perfect variant of majorities-ring, used for 5-node clusters.\"\n [nodes]\n (let [U (set nodes)\n n (count nodes)\n m (util/majority n)]\n (->> nodes\n rand/shuffle ; randomize\n cycle ; form a ring\n (partition m 1) ; construct majorities\n (take n) ; one per node\n (map (fn [majority] ; invert into connections to *drop*\n [(nth majority (Math/floor (/ (count majority) 2)))\n (set/difference U (set majority))]))\n (into {}))))\n\n(defn majorities-ring-stochastic\n \"The stochastic variant of majorities-ring, used for larger clusters.\"\n [nodes]\n (let [n (count nodes)\n m (util/majority n)\n U (set nodes)]\n (loop [; We're going to build up a connection graph incrementally\n conns (->> nodes (map (juxt identity hash-set)) (into {}))\n ; By connecting the least-connected nodes to other least-connected\n ; nodes.\n by-degree (sorted-map 1 (set nodes))]\n (let [; Construct a shuffled, in-degree-order seq of [degree, node] pairs\n dns (mapcat (fn [[degree nodes]]\n (map vector (repeat degree) (rand/shuffle nodes)))\n by-degree)\n ; Pick a node `a` with minimal degree.\n [a-degree a] (first dns)]\n (if (<= m a-degree)\n ; Every node has a majority\n (invert-grudge nodes conns)\n\n ; Link a to some other minimally-connected node b which a is *not*\n ; already connected to.\n (let [[b-degree b] (->> dns\n (remove (comp (conns a) second))\n first)\n ; Link a to b\n conns' (-> conns\n (update a conj b)\n (update b conj a))\n ; Conj which creates a set if necessary\n conj-set (fn [s x] (if s (conj s x) #{x}))\n ; And increment their counts\n ad' (inc a-degree)\n bd' (inc b-degree)\n by-degree' (-> by-degree\n (update a-degree disj a)\n (update b-degree disj b)\n (update ad' conj-set a)\n (update bd' conj-set b))]\n (recur conns' by-degree')))))))\n\n(defn majorities-ring\n \"A grudge in which every node can see a majority, but no node sees the *same*\n majority as any other. There are nice, exact solutions where the topology\n *does* look like a ring: these are possible for 4, 5, 6, 8, etc nodes. Seven,\n however, does *not* work so cleanly--some nodes must be connected to *more*\n than four others. We therefore offer two algorithms: one which provides an\n exact ring for 5-node clusters (generally common in Jepsen), and a stochastic\n one which doesn't guarantee efficient ring structures, but works for larger\n clusters.\n\n Wow this actually is *shockingly* complicated. Wonder if there's a better\n way?\"\n [nodes]\n (if (<= (count nodes) 5)\n (majorities-ring-perfect nodes)\n (majorities-ring-stochastic nodes)))\n\n(defn partition-majorities-ring\n \"Every node can see a majority, but no node sees the *same* majority as any\n other. Randomly orders nodes into a ring.\"\n []\n (partitioner majorities-ring))\n\n(declare f-map)\n\n(defrecord FMap [lift unlift nem]\n Nemesis\n (setup! [this test]\n (f-map lift (setup! nem test)))\n\n (invoke! [this test op]\n (-> nem\n (invoke! test (update op :f unlift))\n (update :f lift)))\n\n (teardown! [this test]\n (teardown! nem test))\n\n Reflection\n (fs [this]\n (set (map lift (fs nem)))))\n\n(defn f-map\n \"Remaps the :f values that a nemesis accepts. Takes a function (presumably\n injective) which transforms `:f` values: `(lift f) -> g`, and a nemesis which\n accepts operations like `{:f f}`. The nemesis must support Reflection/fs.\n Returns a new nemesis which takes `{:f g}` instead. For example:\n\n (f-map (fn [f] [:foo f]) (partition-random-halves))\n\n ... yields a nemesis which takes ops like `{:f [:foo :start] ...}` and calls\n the underlying partitioner nemesis with `{:f :start ...}`. This is designed\n for symmetry with generator/f-map, so you can say:\n\n (gen/f-map lift gen)\n (nem/f-map lift gen)\n\n and get a generator and nemesis that work together. Particularly handy for\n building up complex nemesis packages using nemesis.combined!\n\n If you know all of your fs in advance, you can also do this with `compose`,\n but it turns out to be handy to have this as a separate function.\"\n [lift nem]\n ; Construct the inverse of `lift` by materializing the whole f domain\n ; into a map.\n (let [fs (fs nem)\n unlift (zipmap (map lift fs) fs)]\n (FMap. lift unlift nem)))\n\n(declare compose)\n\n; This version of a composed nemesis uses the Reflection protocol to identify\n; which fs map to which nemeses. fm is a map of fs to indices in the nemesis\n; vector--this cuts down on pprint amplification.\n(defrecord ReflCompose [fm nemeses]\n Nemesis\n (setup! [this test]\n (compose (map #(setup! % test) nemeses)))\n\n (invoke! [this test op]\n (let [f (:f op)\n res (if-let [idx (get fm f)]\n (if-let [n (nth nemeses (get fm (:f op)))]\n (invoke! n test op)\n ::no-match)\n ::no-match)]\n (if (identical? res ::no-match)\n (throw (IllegalArgumentException.\n (str \"No nemesis can handle :f \" (pr-str (:f op))\n \" (expected one of \" (pr-str (keys fm)) \")\"))))\n res))\n\n (teardown! [this test]\n (mapv #(teardown! % test) nemeses))\n\n Reflection\n (fs [this]\n (reduce into #{} (map fs nemeses))))\n\n; This version of a composed nemesis uses an explicit map of fs to nemeses.\n(defrecord MapCompose [nemeses]\n Nemesis\n (setup! [this test]\n (compose (util/map-vals #(setup! % test) nemeses)))\n\n (invoke! [this test op]\n (let [f (:f op)]\n (loop [nemeses nemeses]\n (if-not (seq nemeses)\n (throw (IllegalArgumentException.\n (str \"no nemesis can handle \" (:f op))))\n (let [[fs- nemesis] (first nemeses)]\n (if-let [f' (fs- f)]\n (assoc (invoke! nemesis test (assoc op :f f')) :f f)\n (recur (next nemeses))))))))\n\n (teardown! [this test]\n (util/map-vals #(teardown! % test) nemeses))\n\n Reflection\n (fs [this]\n (->> (keys nemeses)\n (mapcat (fn [f-map]\n (cond (map? f-map) (keys f-map)\n (set? f-map) f-map\n true\n (throw+ {:type ::can't-infer-fs\n :message \"We can only infer fs from compose nemeses built with maps or sets as their f mapping objects.\"}))))\n (into #{}))))\n\n(defn compose\n \"Combines multiple Nemesis objects into one. If all, or all but one, nemesis\n support Reflection, compose can simply take a collection of nemeses, and use\n (fs nem) to figure out what ops to send to which nemesis. Otherwise...\n\n Takes a map of fs to nemeses and returns a single nemesis which, depending\n on (:f op), routes to the appropriate child nemesis. `fs` should be a\n function which takes (:f op) and returns either nil, if that nemesis should\n not handle that :f, or a new :f, which replaces the op's :f, and the\n resulting op is passed to the given nemesis. For instance:\n\n (compose {#{:start :stop} (partition-random-halves)\n #{:kill} (process-killer)})\n\n This routes `:kill` ops to process killer, and :start/:stop to the\n partitioner. What if we had two partitioners which *both* take :start/:stop?\n\n (compose {{:split-start :start\n :split-stop :stop} (partition-random-halves)\n {:ring-start :start\n :ring-stop2 :stop} (partition-majorities-ring)})\n\n We turn :split-start into :start, and pass that op to\n partition-random-halves.\"\n [nemeses]\n (if (map? nemeses)\n (MapCompose. nemeses)\n ; A collection; use reflection to compute a map of :fs to nemeses.\n (let [nemeses (vec nemeses)\n [_ fm]\n (reduce (fn [[i fm] n]\n ; For the i'th nemesis, our fmap is...\n [(inc i)\n (reduce (fn [fm f]\n (assert (not (get fm f))\n (str \"Nemeses \" (pr-str n) \" and \"\n (pr-str (get fm f))\n \" are mutually incompatible;\"\n \" both use :f \" (pr-str f)))\n (assoc fm f i))\n fm\n (fs n))])\n [0 {}]\n nemeses)]\n (ReflCompose. fm nemeses))))\n\n;; Installing programs\n\n(def bin-dir\n \"Where do we install binaries to?\"\n \"/opt/jepsen\")\n\n(defn compile-c-reader!\n \"Takes a Reader to C source code, and spits out a binary to `/`,\n if it doesn't already exist. Returns bin.\"\n [reader bin]\n (c/su\n (when-not (cu/exists? (str bin-dir \"/\" bin))\n (info \"Compiling\" bin)\n (let [tmp-file (File/createTempFile \"jepsen-upload\" \".c\")]\n (try\n (io/copy reader tmp-file)\n ; Upload\n (c/exec :mkdir :-p bin-dir)\n (c/exec :chmod \"a+rwx\" bin-dir)\n (c/upload (.getCanonicalPath tmp-file) (str bin-dir \"/\" bin \".c\"))\n (c/cd bin-dir\n (c/exec :gcc (str bin \".c\") :-lm)\n (c/exec :mv \"a.out\" bin))\n (finally\n (.delete tmp-file)))))\n bin))\n\n(defn compile-c-resource!\n \"Given a resource name (e.g. a string filename in resources/) containing C\n source code, spits out a binary to `/`\"\n [resource bin]\n (with-open [r (io/reader (io/resource resource))]\n (compile-c-reader! r bin)))\n\n;; Specific nemeses\n\n(defn set-time!\n \"Set the local node time in POSIX seconds.\"\n [t]\n (c/su (c/exec :date \"+%s\" :-s (str \\@ (long t)))))\n\n(defn clock-scrambler\n \"Randomizes the system clock of all nodes within a dt-second window.\"\n [dt]\n (reify Nemesis\n (setup! [this test]\n this)\n\n (invoke! [this test op]\n (assoc op :value\n (c/with-test-nodes test\n (set-time! (+ (/ (System/currentTimeMillis) 1000)\n (- (rand/long (* 2 dt)) dt))))))\n\n (teardown! [this test]\n (c/with-test-nodes test\n (set-time! (/ (System/currentTimeMillis) 1000))))))\n\n(defn node-start-stopper\n \"Takes a targeting function which, given a list of nodes, returns a single\n node or collection of nodes to affect, and two functions `(start! test node)`\n invoked on nemesis start, and `(stop! test node)` invoked on nemesis stop.\n Returns a nemesis which responds to :start and :stop by running the start!\n and stop! fns on each of the given nodes. During `start!` and `stop!`, binds\n the `jepsen.control` session to the given node, so you can just call `(c/exec\n ...)`.\n\n The targeter can take either (targeter test nodes) or, if that fails,\n (targeter nodes).\n\n Re-selects a fresh node (or nodes) for each start--if targeter returns nil,\n skips the start. The return values from the start and stop fns will become\n the :values of the returned :info operations from the nemesis, e.g.:\n\n {:value {:n1 [:killed \\\"java\\\"]}}\"\n [targeter start! stop!]\n (let [nodes (atom nil)]\n (reify Nemesis\n (setup! [this test] this)\n\n (invoke! [this test op]\n (locking nodes\n (assoc op :type :info, :value\n (case (:f op)\n :start (let [ns (:nodes test)\n ns (try (targeter test ns)\n (catch clojure.lang.ArityException e\n (targeter ns)))\n ns (util/coll ns)]\n (if ns\n (if (compare-and-set! nodes nil ns)\n (c/on-nodes test ns start!)\n (str \"nemesis already disrupting \"\n (pr-str @nodes)))\n :no-target))\n :stop (if-let [ns @nodes]\n (let [value (c/on-nodes test ns stop!)]\n (reset! nodes nil)\n value)\n :not-started)))))\n\n (teardown! [this test]))))\n\n(defn hammer-time\n \"Responds to `{:f :start}` by pausing the given process name on a given node\n or nodes using SIGSTOP, and when `{:f :stop}` arrives, resumes it with\n SIGCONT. Picks the node(s) to pause using `(targeter list-of-nodes)`, which\n defaults to `jepsen.rand/nth`. Targeter may return either a single node or a\n collection of nodes.\"\n ([process] (hammer-time rand/nth process))\n ([targeter process]\n (node-start-stopper targeter\n (fn start [t n]\n (c/su (c/exec :killall :-s \"STOP\" process))\n [:paused process])\n (fn stop [t n]\n (c/su (c/exec :killall :-s \"CONT\" process))\n [:resumed process]))))\n\n(defn truncate-file\n \"A nemesis which responds to\n ```clj\n {:f :truncate\n :value {\\\"some-node\\\" {:file \\\"/path/to/file or /path/to/dir\\\"\n :drop 64}}}\n ```\n where the value is a map of nodes to `{:file, :drop}` maps, on those nodes,\n drops the last `:drop` bytes from the given file, or a random file from the given directory.\"\n []\n (reify Nemesis\n (setup! [this test] this)\n\n (invoke! [this test op]\n (assert (= (:f op) :truncate))\n (let [plan (:value op)]\n (->> (c/on-nodes test\n (keys plan)\n (fn [_ node]\n (let [{:keys [file drop]} (plan node)\n _ (assert (string? file))\n _ (assert (integer? drop))\n file (if (cu/file? file)\n file\n (rand/nth (cu/ls-full file)))]\n (c/su\n (c/exec :truncate :-c :-s (str \"-\" drop) file))\n {:file file :drop drop})))\n (assoc op :value))))\n\n (teardown! [this test])\n\n Reflection\n (fs [this]\n #{:truncate})))\n\n(def bitflip-dir\n \"Where do we install the bitflip utility?\"\n \"/opt/jepsen/bitflip\")\n\n(defrecord Bitflip []\n Nemesis\n (setup! [this test]\n (c/with-test-nodes test\n (c/su\n (cu/install-archive! \"https://github.com/aybabtme/bitflip/releases/download/v0.2.0/bitflip_0.2.0_Linux_x86_64.tar.gz\" bitflip-dir))\n this)\n this)\n\n (invoke! [this test {:keys [value] :as op}]\n (->> (c/on-nodes test (keys value)\n (fn flip [test node]\n (let [{:keys [file probability]} (get value node)\n _ (when-not file\n (throw+ {:type ::no-file}))\n file (if (cu/file? file)\n file\n (rand/nth (cu/ls-full file)))\n probability (or probability 0.01)\n percent (* 100 probability)]\n (c/su\n (c/exec (str bitflip-dir \"/bitflip\")\n :spray\n (format \"percent:%.32f\" percent)\n file))\n {:file file :probability probability})))\n (assoc op :value)))\n\n (teardown! [this test])\n\n Reflection\n (fs [this]\n #{:bitflip}))\n\n(defn bitflip\n \"A nemesis which introduces random bitflips in files. Takes operations like:\n ```clj\n {:f :bitflip\n :value {\\\"some-node\\\" {:file \\\"/path/to/file or /path/to/dir\\\"\n :probability 1e-3}}}\n ```\n This flips 1 x 10^-3 of the bits in `/path/to/file`, or a random file in `/path/to/dir`, on \\\"some-node\\\".\"\n []\n (Bitflip.))\n" }, { "path": "jepsen/src/jepsen/net/proto.clj", "content": "(ns jepsen.net.proto\n \"Protocols for network manipulation. High-level functions live in\n jepsen.net.\")\n\n(defprotocol Net\n (drop! [net test src dest]\n \"Drop traffic from src to dest.\")\n (heal! [net test]\n \"End all traffic drops and restores network to fast operation.\")\n (slow! [net test]\n [net test opts]\n \"Delays network packets with options:\n\n ```clj\n {:mean ; (in ms)\n :variance ; (in ms)\n :distribution} ; (e.g. :normal)\n ```\")\n (flaky! [net test]\n \"Introduces randomized packet loss\")\n (fast! [net test]\n \"Removes packet loss and delays.\")\n (shape! [net test nodes behavior]\n \"Shapes network behavior,\n i.e. packet delay, loss, corruption, duplication, reordering, and rate\n for the given nodes.\"))\n\n(defprotocol PartitionAll\n \"This optional protocol provides support for making multiple network changes\n in a single call. If you don't support this protocol, we'll use drop!\n instead.\"\n (drop-all! [net test grudge]\n \"Takes a grudge: a map of nodes to collections of nodes they\n should drop messages from, and makes the appropriate changes to\n the network.\"))\n" }, { "path": "jepsen/src/jepsen/net.clj", "content": "(ns jepsen.net\n \"Controls network manipulation.\n\n TODO: break this up into jepsen.net.proto (polymorphism) and jepsen.net\n (wrapper fns, default args, etc)\"\n (:require [dom-top.core :refer [real-pmap]]\n [clojure.string :as str]\n [clojure.tools.logging :refer [info warn]]\n [jepsen.control :refer :all]\n [jepsen.control.net :as control.net]\n [jepsen.net.proto :as p :refer [Net PartitionAll]]\n [potemkin :refer [import-vars]]\n [clj-commons.slingshot :refer [throw+ try+]]))\n\n; These were extracted to jepsen.net.proto, but we retain them here for\n; compatibility/API simplicity.\n(import-vars [jepsen.net.proto\n drop!\n heal!\n slow!\n flaky!\n fast!\n shape!])\n\n; Top-level API functions\n(defn drop-all!\n \"Takes a test and a grudge: a map of nodes to collections of nodes they\n should drop messages from, and makes those changes to the test's network.\"\n [test grudge]\n (let [net (:net test)]\n (if (satisfies? PartitionAll net)\n ; Fast path\n (p/drop-all! net test grudge)\n\n ; Fallback\n (->> grudge\n ; We'll expand {dst [src1 src2]} into ((src1 dst) (src2 dst) ...)\n (mapcat (fn expand [[dst srcs]]\n (map list srcs (repeat dst))))\n (real-pmap (partial apply drop! net test))\n dorun))))\n\n(def tc \"/sbin/tc\")\n\n(defn net-dev\n \"Returns the network interface of the current host.\"\n []\n (let [choices (su (exec :ip :-o :link :show))\n iface (->> choices\n (str/split-lines)\n (map (fn [ln] (let [[_match iface] (re-find #\"\\d+: ([^:@]+).+\" ln)] iface)))\n (remove #(= \"lo\" %))\n (first))]\n (assert iface\n (str \"Couldn't determine network interface!\\n\" choices))\n iface))\n\n(defn qdisc-del\n \"Deletes root qdisc for given dev on current node.\"\n [dev]\n (try+\n (su (exec tc :qdisc :del :dev dev :root))\n (catch [:exit 2] _\n ; no qdisc to del\n nil)))\n\n(def all-packet-behaviors\n \"All of the available network packet behaviors, and their default option\n values.\n\n Caveats:\n\n - Behaviors are applied to a node's network interface and affect all DB to\n DB node traffic\n - `:delay` - Use `:normal` distribution of delays for more typical network\n behavior\n - `:loss` - When used locally (not on a bridge or router), the loss is\n reported to the upper level protocols. This may cause TCP to\n resend and behave as if there was no loss.\n\n See [tc-netem(8)](https://manpages.debian.org/bullseye/iproute2/tc-netem.8).\"\n {:delay {:time :50ms\n :jitter :10ms\n :correlation :25%\n :distribution :normal}\n :loss {:percent :20%\n :correlation :75%}\n :corrupt {:percent :20%\n :correlation :75%}\n :duplicate {:percent :20%\n :correlation :75%}\n :reorder {:percent :20%\n :correlation :75%}\n :rate {:rate :1mbit}})\n\n(defn- behaviors->netem\n \"Given a map of behaviors, returns a sequence of netem options.\"\n [behaviors]\n (->>\n ; :reorder requires :delay\n (if (and (:reorder behaviors)\n (not (:delay behaviors)))\n (assoc behaviors :delay (:delay all-packet-behaviors))\n behaviors)\n ; fill in all unspecified opts with default values\n (reduce (fn [acc [behavior opts]]\n (assoc acc behavior (merge (behavior all-packet-behaviors) opts)))\n {})\n ; build a tc cmd line combining all behaviors\n (reduce (fn [args [behavior {:keys [time jitter percent correlation distribution rate] :as _opts}]]\n (case behavior\n :delay\n (concat args [:delay time jitter correlation :distribution distribution])\n (:loss :corrupt :duplicate :reorder)\n (concat args [behavior percent correlation])\n :rate\n (concat args [:rate rate])))\n [])))\n\n(defn- net-shape!\n \"Shared convenience call for iptables/ipfilter. Shape the network with tc\n qdisc, netem, and filter(s) so target nodes have given behavior.\"\n [_net test targets behavior]\n (let [results (on-nodes test\n (fn [test node]\n (let [nodes (set (:nodes test))\n targets (set targets)\n targets (if (contains? targets node)\n (disj nodes node)\n targets)\n dev (net-dev)]\n ; start with no qdisc\n (qdisc-del dev)\n (if (and (seq targets)\n (seq behavior))\n ; node will need a prio qdisc, netem qdisc, and a filter per target\n (do\n (su\n ; root prio qdisc, bands 1:1-3 are system default prio\n (exec tc\n :qdisc :add :dev dev\n :root :handle \"1:\"\n :prio :bands 4 :priomap 1 2 2 2 1 2 0 0 1 1 1 1 1 1 1 1)\n ; band 1:4 is a netem qdisc for the behavior\n (exec tc\n :qdisc :add :dev dev\n :parent \"1:4\" :handle \"40:\"\n :netem (behaviors->netem behavior))\n ; filter dst ip's to netem qdisc with behavior\n (doseq [target targets]\n (exec tc\n :filter :add :dev dev\n :parent \"1:0\"\n :protocol :ip :prio :3 :u32 :match :ip :dst (control.net/ip target)\n :flowid \"1:4\")))\n targets)\n ; no targets and/or behavior, so no qdisc/netem/filters\n nil))))]\n ; return a more readable value\n (if (and (seq targets) (seq behavior))\n [:shaped results :netem (vec (behaviors->netem behavior))]\n [:reliable results])))\n\n(def noop\n \"Does nothing.\"\n (reify Net\n (drop! [net test src dest])\n (heal! [net test])\n (slow! [net test])\n (slow! [net test opts])\n (flaky! [net test])\n (fast! [net test])\n (shape! [net test nodes behavior])))\n\n(def iptables\n \"Default iptables (assumes we control everything).\"\n (reify Net\n (drop! [net test src dest]\n (on-nodes test [dest]\n (fn [test node]\n (su (exec :iptables :-A :INPUT :-s (control.net/ip src) :-j\n :DROP :-w)))))\n\n (heal! [net test]\n (with-test-nodes test\n (su\n (exec :iptables :-F :-w)\n (exec :iptables :-X :-w))))\n\n (slow! [net test]\n (with-test-nodes test\n (su (exec tc :qdisc :add :dev :eth0 :root :netem :delay :50ms\n :10ms :distribution :normal))))\n\n (slow! [net test {:keys [mean variance distribution]\n :or {mean 50\n variance 10\n distribution :normal}}]\n (with-test-nodes test\n (su (exec tc :qdisc :add :dev :eth0 :root :netem :delay\n (str mean \"ms\")\n (str variance \"ms\")\n :distribution distribution))))\n\n (flaky! [net test]\n (with-test-nodes test\n (su (exec tc :qdisc :add :dev :eth0 :root :netem :loss \"20%\"\n \"75%\"))))\n\n (fast! [net test]\n (with-test-nodes test\n (try\n (su (exec tc :qdisc :del :dev :eth0 :root))\n (catch RuntimeException e\n (if (re-find #\"Error: Cannot delete qdisc with handle of zero.\"\n (.getMessage e))\n nil\n (throw e))))))\n\n (shape! [net test nodes behavior]\n (net-shape! net test nodes behavior))\n\n PartitionAll\n (drop-all! [net test grudge]\n (on-nodes test\n (keys grudge)\n (fn snub [_ node]\n (when (seq (get grudge node))\n (su (exec :iptables :-A :INPUT :-s\n (->> (get grudge node)\n (map control.net/ip)\n (str/join \",\"))\n :-j :DROP :-w))))))))\n\n(def ipfilter\n \"IPFilter rules\"\n (reify Net\n (drop! [net test src dest]\n (on dest (su (exec :echo :block :in :from src :to :any | :ipf :-f :-))))\n\n (heal! [net test]\n (with-test-nodes test\n (su (exec :ipf :-Fa))))\n\n (slow! [net test]\n (with-test-nodes test\n (su (exec :tc :qdisc :add :dev :eth0 :root :netem :delay :50ms\n :10ms :distribution :normal))))\n\n (slow! [net test {:keys [mean variance distribution]\n :or {mean 50\n variance 10\n distribution :normal}}]\n (with-test-nodes test\n (su (exec tc :qdisc :add :dev :eth0 :root :netem :delay\n (str mean \"ms\")\n (str variance \"ms\")\n :distribution distribution))))\n\n (flaky! [net test]\n (with-test-nodes test\n (su (exec :tc :qdisc :add :dev :eth0 :root :netem :loss \"20%\"\n \"75%\"))))\n\n (fast! [net test]\n (with-test-nodes test\n (su (exec :tc :qdisc :del :dev :eth0 :root))))\n\n (shape! [net test nodes behavior]\n (net-shape! net test nodes behavior))))\n" }, { "path": "jepsen/src/jepsen/os/centos.clj", "content": "(ns jepsen.os.centos\n \"Common tasks for CentOS boxes.\"\n (:require [clojure.set :as set]\n [clojure.tools.logging :refer [info]]\n [jepsen.util :as u]\n [jepsen.os :as os]\n [jepsen.control :as c]\n [jepsen.control.util :as cu]\n [jepsen.net :as net]\n [clojure.string :as str]))\n\n(defn setup-hostfile!\n \"Makes sure the hostfile has a loopback entry for the local hostname\"\n []\n (let [name (c/exec :hostname)\n hosts (c/exec :cat \"/etc/hosts\")\n hosts' (->> hosts\n str/split-lines\n (map (fn [line]\n (if (and (re-find #\"^127\\.0\\.0\\.1\" line)\n (not (re-find (re-pattern name) line)))\n (str line \" \" name)\n line)))\n (str/join \"\\n\"))]\n (c/su (c/exec :echo hosts' :> \"/etc/hosts\"))))\n\n(defn time-since-last-update\n \"When did we last run a yum update, in seconds ago\"\n []\n (- (Long/parseLong (c/exec :date \"+%s\"))\n (Long/parseLong (c/exec :stat :-c \"%Y\" \"/var/log/yum.log\"))))\n\n(defn update!\n \"Yum update.\"\n []\n (c/su (c/exec :yum :-y :update)))\n\n(defn maybe-update!\n \"Yum update if we haven't done so recently.\"\n []\n (try (when (< 86400 (time-since-last-update))\n (update!))\n (catch Exception e\n (update!))))\n\n(defn installed\n \"Given a list of centos packages (strings, symbols, keywords, etc), returns\n the set of packages which are installed, as strings.\"\n [pkgs]\n (let [pkgs (->> pkgs (map name) set)]\n (->> (c/exec :yum :list :installed)\n str/split-lines\n (map (comp first #(str/split %1 #\"\\s+\")))\n (map (comp second (partial re-find #\"(.*)\\.[^\\-]+\")))\n set\n ((partial clojure.set/intersection pkgs))\n u/spy)))\n\n(defn uninstall!\n \"Removes a package or packages.\"\n [pkg-or-pkgs]\n (let [pkgs (if (coll? pkg-or-pkgs) pkg-or-pkgs (list pkg-or-pkgs))\n pkgs (installed pkgs)]\n (info \"Uninstalling\" pkgs)\n (c/su (apply c/exec :yum :-y :remove pkgs))))\n\n(defn installed?\n \"Are the given packages, or singular package, installed on the current\n system?\"\n [pkg-or-pkgs]\n (let [pkgs (if (coll? pkg-or-pkgs) pkg-or-pkgs (list pkg-or-pkgs))]\n (every? (installed pkgs) (map name pkgs))))\n\n(defn installed-version\n \"Given a package name, determines the installed version of that package, or\n nil if it is not installed.\"\n [pkg]\n (some->> (c/exec :yum :list :installed)\n str/split-lines\n (map (comp first #(str/split %1 #\";\")))\n (map (partial re-find #\"(.*).[^\\-]+\"))\n (filter #(= (second %) (name pkg)))\n first\n first\n (re-find #\".*-([^\\-]+)\")\n second))\n\n(defn install\n \"Ensure the given packages are installed. Can take a flat collection of\n packages, passed as symbols, strings, or keywords, or, alternatively, a map\n of packages to version strings.\"\n [pkgs]\n (if (map? pkgs)\n ; Install specific versions\n (dorun\n (for [[pkg version] pkgs]\n (when (not= version (installed-version pkg))\n (info \"Installing\" pkg version)\n (c/exec :yum :-y :install\n (str (name pkg) \"-\" version)))))\n\n ; Install any version\n (let [pkgs (set (map name pkgs))\n missing (set/difference pkgs (installed pkgs))]\n (when-not (empty? missing)\n (c/su\n (info \"Installing\" missing)\n (apply c/exec :yum :-y :install missing))))))\n\n(defn install-start-stop-daemon!\n \"Installs start-stop-daemon on centos\"\n []\n (info \"Installing start-stop-daemon\")\n (c/su\n (c/exec :wget \"http://ftp.de.debian.org/debian/pool/main/d/dpkg/dpkg_1.19.8.tar.xz\")\n (c/exec :tar :-xf :dpkg_1.19.8.tar.xz)\n (c/exec \"bash\" \"-c\" \"cd dpkg-1.19.8 && ./configure\")\n (c/exec \"bash\" \"-c\" \"cd dpkg-1.19.8 && make\")\n (c/exec \"bash\" \"-c\" \"cp /dpkg-1.19.8/utils/start-stop-daemon /usr/bin/start-stop-daemon\")\n (c/exec \"bash\" \"-c\" \"rm -f dpkg_1.19.8.tar.xz\")))\n\n(defn installed-start-stop-daemon?\n \"Is start-stop-daemon Installed?\"\n []\n (->> (c/exec :ls \"/usr/bin\")\n str/split-lines\n (some #(if (re-find #\"start-stop-daemon\" %) true))))\n\n(deftype CentOS []\n os/OS\n (setup! [_ test node]\n (info node \"setting up centos\")\n\n (setup-hostfile!)\n\n (maybe-update!)\n\n (c/su\n ; Packages!\n (install [:wget\n :gcc\n :gcc-c++\n :curl\n :vim-common\n :unzip\n :rsyslog\n :iptables\n :ncurses-devel\n :iproute\n :logrotate]))\n\n (if (not= true (installed-start-stop-daemon?)) (install-start-stop-daemon!) (info \"start-stop-daemon already installed\"))\n\n (u/meh (net/heal! (:net test) test)))\n\n (teardown! [_ test node]))\n\n(def os \"Support for CentOS.\" (CentOS.))\n" }, { "path": "jepsen/src/jepsen/os/debian.clj", "content": "(ns jepsen.os.debian\n \"Common tasks for Debian Trixie.\"\n (:require [clojure [set :as set]\n [string :as str]]\n [clojure.tools.logging :refer [info]]\n [jepsen [control :as c :refer [|]]\n [net :as net]\n [os :as os]\n [util :as util :refer [meh]]]\n [jepsen.control.util :as cu]\n [clj-commons.slingshot :refer [try+ throw+]]))\n\n(def node-locks\n \"Prevents running apt operations concurrently on the same node.\"\n (util/named-locks))\n\n(defn setup-hostfile!\n \"Makes sure the hostfile has a loopback entry for the local hostname\"\n []\n (let [name (c/exec :hostname)\n hosts (c/exec :cat \"/etc/hosts\")\n hosts' (->> hosts\n str/split-lines\n (map (fn [line]\n (if (re-find #\"^127\\.0\\.0\\.1\\t\" line)\n (str \"127.0.0.1\\tlocalhost\") ; name)\n line)))\n (str/join \"\\n\"))]\n (when-not (= hosts hosts')\n (c/su (c/exec :echo hosts' :> \"/etc/hosts\")))))\n\n(defn time-since-last-update\n \"When did we last run an apt-get update, in seconds ago\"\n []\n (- (Long/parseLong (c/exec :date \"+%s\"))\n (Long/parseLong (c/exec :stat :-c \"%Y\" \"/var/cache/apt/pkgcache.bin\" \"||\" :echo 0))))\n\n(defn update!\n \"Apt-get update.\"\n []\n (util/with-named-lock node-locks c/*host*\n (c/su (c/exec :apt-get :--allow-releaseinfo-change :update))))\n\n(defn maybe-update!\n \"Apt-get update if we haven't done so recently.\"\n []\n (when (< 86400 (time-since-last-update))\n (update!)))\n\n(defn installed\n \"Given a list of debian packages (strings, symbols, keywords, etc), returns\n the set of packages which are installed, as strings.\"\n [pkgs]\n (let [pkgs (->> pkgs (map name) set)]\n (->> (apply c/exec :dpkg :--get-selections pkgs)\n str/split-lines\n (map (fn [line] (str/split line #\"\\s+\")))\n (filter #(= \"install\" (second %)))\n (map first)\n (map (fn [p] (str/replace p #\":amd64|:i386\" {\":amd64\" \"\" \":i386\" \"\"})))\n set)))\n\n(defn uninstall!\n \"Removes a package or packages.\"\n [pkg-or-pkgs]\n (util/with-named-lock node-locks c/*host*\n (let [pkgs (if (coll? pkg-or-pkgs) pkg-or-pkgs (list pkg-or-pkgs))\n pkgs (installed pkgs)]\n (c/su (apply c/exec :apt-get :remove :--purge :-y pkgs)))))\n\n(defn installed?\n \"Are the given debian packages, or singular package, installed on the current\n system?\"\n [pkg-or-pkgs]\n (let [pkgs (if (coll? pkg-or-pkgs) pkg-or-pkgs (list pkg-or-pkgs))]\n (every? (installed pkgs) (map name pkgs))))\n\n(defn installed-version\n \"Given a package name, determines the installed version of that package, or\n nil if it is not installed.\"\n [pkg]\n (->> (c/exec :apt-cache :policy (name pkg))\n (re-find #\"Installed: ([^\\s]+)\")\n second))\n\n(defn install\n \"Ensure the given packages are installed. Can take a flat collection of\n packages, passed as symbols, strings, or keywords, or, alternatively, a map\n of packages to version strings. Can optionally take a collection of\n additional CLI options to be passed to apt-get.\"\n ([pkgs]\n (install pkgs []))\n ([pkgs apt-opts]\n (if (map? pkgs)\n ; Install specific versions\n (dorun\n (for [[pkg version] pkgs]\n (when (not= version (installed-version pkg))\n (util/with-named-lock node-locks c/*host*\n (info \"Installing\" pkg version)\n (c/su\n (c/exec :env \"DEBIAN_FRONTEND=noninteractive\"\n :apt-get :install\n :-y\n :--allow-downgrades\n :--allow-change-held-packages\n apt-opts\n (str (name pkg) \"=\" version)))))))\n\n ; Install any version\n (let [pkgs (set (map name pkgs))\n missing (set/difference pkgs (installed pkgs))]\n (when-not (empty? missing)\n (util/with-named-lock node-locks c/*host*\n (c/su\n (info \"Installing\" missing)\n (apply c/exec :env \"DEBIAN_FRONTEND=noninteractive\"\n :apt-get :install\n :-y\n :--allow-downgrades\n :--allow-change-held-packages\n apt-opts\n missing))))))))\n\n(defn add-key!\n \"Receives an apt key from the given keyserver.\"\n [keyserver key]\n (c/su\n (c/exec :apt-key :adv\n :--keyserver keyserver\n :--recv key)))\n\n(defn add-repo!\n \"Adds an apt repo (and optionally a key from the given keyserver).\"\n ([repo-name apt-line]\n (add-repo! repo-name apt-line nil nil))\n ([repo-name apt-line keyserver key]\n (let [list-file (str \"/etc/apt/sources.list.d/\" (name repo-name) \".list\")]\n (when-not (cu/exists? list-file)\n (info \"setting up\" repo-name \"apt repo\")\n (when (or keyserver key)\n (add-key! keyserver key))\n (c/exec :echo apt-line :> list-file)\n (update!)))))\n\n(defn install-jdk11!\n \"Installs an openjdk jdk11 via stretch-backports.\"\n []\n (c/su\n (add-repo!\n \"stretch-backports\"\n \"deb http://deb.debian.org/debian stretch-backports main\")\n (install [:openjdk-11-jdk])))\n\n(deftype Debian []\n os/OS\n (setup! [_ test node]\n (info node \"setting up debian\")\n\n (setup-hostfile!)\n (maybe-update!)\n\n (c/su\n ; Packages!\n (install [:apt-transport-https\n :apt-utils\n :build-essential\n :bzip2\n :curl\n :dirmngr\n :faketime\n :iproute2\n :iptables\n :iputils-ping\n :logrotate\n :man-db\n :netcat-openbsd\n :ntpsec-ntpdate\n :psmisc\n :rsyslog\n :tar\n :tcpdump\n :unzip\n :vim\n :wget]))\n\n (meh (net/heal! (:net test) test)))\n\n (teardown! [_ test node]))\n\n(def os \"An implementation of the Debian OS.\" (Debian.))\n" }, { "path": "jepsen/src/jepsen/os/smartos.clj", "content": "(ns jepsen.os.smartos\n \"Common tasks for SmartOS boxes.\"\n (:require [clojure.set :as set]\n [clojure.tools.logging :refer [info]]\n [jepsen.util :refer [meh]]\n [jepsen.os :as os]\n [jepsen.control :as c]\n [jepsen.control.util :as cu]\n [jepsen.net :as net]\n [clojure.string :as str]))\n\n(defn setup-hostfile!\n \"Makes sure the hostfile has a loopback entry for the local hostname\"\n []\n (let [name (c/exec :hostname)\n hosts (c/exec :cat \"/etc/hosts\")\n hosts' (->> hosts\n str/split-lines\n (map (fn [line]\n (if (and (re-find #\"^127\\.0\\.0\\.1\\t\" line)\n (not (re-find (re-pattern name) line)))\n (str line \" \" name)\n line)))\n (str/join \"\\n\"))]\n (c/su (c/exec :echo hosts' :> \"/etc/hosts\"))))\n\n(defn time-since-last-update\n \"When did we last run a pkgin update, in seconds ago\"\n []\n (- (Long/parseLong (c/exec :date \"+%s\"))\n (Long/parseLong (c/exec :stat :-c \"%Y\" \"/var/db/pkgin/sql.log\"))))\n\n(defn update!\n \"Pkgin update.\"\n []\n (c/su (c/exec :pkgin :update)))\n\n(defn maybe-update!\n \"Pkgin update if we haven't done so recently.\"\n []\n (try (when (< 86400 (time-since-last-update))\n (update!))\n (catch Exception e\n (update!))))\n\n(defn installed\n \"Given a list of pkgin packages (strings, symbols, keywords, etc), returns\n the set of packages which are installed, as strings.\"\n [pkgs]\n (let [pkgs (->> pkgs (map name) set)]\n (->> (c/exec :pkgin :-p :list)\n str/split-lines\n (map (comp first #(str/split %1 #\";\")))\n (map (comp second (partial re-find #\"(.*)-[^\\-]+\")))\n set\n (#(filter %1 pkgs))\n set)))\n\n(defn uninstall!\n \"Removes a package or packages.\"\n [pkg-or-pkgs]\n (let [pkgs (if (coll? pkg-or-pkgs) pkg-or-pkgs (list pkg-or-pkgs))\n pkgs (installed pkgs)]\n (c/su (apply c/exec :pkgin :-y :remove pkgs))))\n\n(defn installed?\n \"Are the given packages, or singular package, installed on the current\n system?\"\n [pkg-or-pkgs]\n (let [pkgs (if (coll? pkg-or-pkgs) pkg-or-pkgs (list pkg-or-pkgs))]\n (every? (installed pkgs) (map name pkgs))))\n\n(defn installed-version\n \"Given a package name, determines the installed version of that package, or\n nil if it is not installed.\"\n [pkg]\n (some->> (c/exec :pkgin :-p :list)\n str/split-lines\n (map (comp first #(str/split %1 #\";\")))\n (map (partial re-find #\"(.*)-[^\\-]+\"))\n (filter #(= (second %) (name pkg)))\n first\n first\n (re-find #\".*-([^\\-]+)\")\n second))\n\n(defn install\n \"Ensure the given packages are installed. Can take a flat collection of\n packages, passed as symbols, strings, or keywords, or, alternatively, a map\n of packages to version strings.\"\n [pkgs]\n (if (map? pkgs)\n ; Install specific versions\n (dorun\n (for [[pkg version] pkgs]\n (when (not= version (installed-version pkg))\n (info \"Installing\" pkg version)\n (c/exec :pkgin :-y :install\n (str (name pkg) \"-\" version)))))\n\n ; Install any version\n (let [pkgs (set (map name pkgs))\n missing (set/difference pkgs (installed pkgs))]\n (when-not (empty? missing)\n (c/su\n (info \"Installing\" missing)\n (apply c/exec :pkgin :-y :install missing))))))\n\n(def os\n (reify os/OS\n (setup! [_ test node]\n (info node \"setting up smartos\")\n\n (setup-hostfile!)\n\n (maybe-update!)\n\n (c/su\n ; Packages!\n (install [:wget\n :curl\n :vim\n :unzip\n :rsyslog\n :logrotate]))\n\n (c/su\n (c/exec :svcadm :enable :-r :ipfilter))\n\n (meh (net/heal! (:net test) test)))\n\n (teardown! [_ test node])))\n" }, { "path": "jepsen/src/jepsen/os/ubuntu.clj", "content": "(ns jepsen.os.ubuntu\n \"Common tasks for Ubuntu boxes. Tested against Ubuntu 18.04.\"\n (:require [clojure.set :as set]\n [clojure.tools.logging :refer [info]]\n [jepsen.util :refer [meh]]\n [jepsen.os :as os]\n [jepsen.control :as c :refer [|]]\n [jepsen.control.util :as cu]\n [jepsen.net :as net]\n [jepsen.os.debian :as debian]\n [clojure.string :as str]))\n\n(deftype Ubuntu []\n os/OS\n (setup! [_ test node]\n (info node \"setting up ubuntu\")\n\n (debian/setup-hostfile!)\n\n (debian/maybe-update!)\n\n (c/su\n ; Packages!\n (debian/install [:apt-transport-https\n :wget\n :curl\n :vim\n :man-db\n :faketime\n :ntpdate\n :unzip\n :iptables\n :psmisc\n :tar\n :bzip2\n :iputils-ping\n :iproute2\n :rsyslog\n :sudo\n :logrotate]))\n\n (meh (net/heal! (:net test) test)))\n\n (teardown! [_ test node]))\n\n(def os \"An implementation of the Ubuntu OS.\" (Ubuntu.))\n" }, { "path": "jepsen/src/jepsen/os.clj", "content": "(ns jepsen.os\n \"Controls operating system setup and teardown.\")\n\n(defprotocol OS\n (setup! [os test node] \"Set up the operating system on this particular\n node.\")\n (teardown! [os test node] \"Tear down the operating system on this particular\n node.\"))\n\n(def noop\n \"Does nothing\"\n (reify OS\n (setup! [os test node])\n (teardown! [os test node])))\n" }, { "path": "jepsen/src/jepsen/print.clj", "content": "(ns jepsen.print\n \"Handles printing and logging things as strings or to the console.\"\n (:require [clojure.string :as str]\n [clojure.java.io :as io]\n [clojure.tools.logging :refer [info warn]]\n [fipp.edn :as fipp.edn :refer [pretty-coll]]\n [fipp.ednize :refer [edn record->tagged]]\n [fipp.visit :refer [visit visit*]]\n [fipp.engine :refer (pprint-document)]\n [jepsen [history :as h]]\n [jepsen.history.fold :refer [loopf]])\n (:import (jepsen.history Op)\n (java.io File\n RandomAccessFile)))\n\n\n; Directly from fipp.edn; this is the most compact way I can find to override a\n; single datatype's printing.\n(defrecord JepsenPrinter [symbols print-meta print-length print-level]\n fipp.visit/IVisitor\n\n (visit-unknown [this x]\n (visit this (edn x)))\n\n (visit-nil [this]\n [:text \"nil\"])\n\n (visit-boolean [this x]\n [:text (str x)])\n\n (visit-string [this x]\n [:text (binding [*print-readably* true]\n (pr-str x))])\n\n (visit-character [this x]\n [:text (binding [*print-readably* true]\n (pr-str x))])\n\n (visit-symbol [this x]\n [:text (str x)])\n\n (visit-keyword [this x]\n [:text (str x)])\n\n (visit-number [this x]\n (binding [*print-dup* false]\n [:text (pr-str x)]))\n\n (visit-seq [this x]\n (if-let [pretty (symbols (first x))]\n (pretty this x)\n (pretty-coll this \"(\" x :line \")\" visit)))\n\n (visit-vector [this x]\n (pretty-coll this \"[\" x :line \"]\" visit))\n\n (visit-map [this x]\n (pretty-coll this \"{\" x [:span \",\" :line] \"}\"\n (fn [printer [k v]]\n [:span (visit printer k) \" \" (visit printer v)])))\n\n (visit-set [this x]\n (pretty-coll this \"#{\" x :line \"}\" visit))\n\n (visit-tagged [this {:keys [tag form]}]\n [:group \"#\" (str tag)\n (when (or (and print-meta (meta form))\n (not (coll? form)))\n \" \")\n (visit this form)])\n\n (visit-meta [this m x]\n (if print-meta\n [:align [:span \"^\" (visit this m)] :line (visit* this x)]\n (visit* this x)))\n\n (visit-var [this x]\n [:text (str x)])\n\n (visit-pattern [this x]\n [:text (pr-str x)])\n\n (visit-record [this x]\n (if (instance? Op x)\n (fipp.visit/visit-map this x)\n (visit this (record->tagged x)))))\n\n(defn pretty\n ([x] (pretty x {}))\n ([x options]\n (let [defaults {:symbols {}\n :print-length *print-length*\n :print-level *print-level*\n :print-meta *print-meta*}\n printer (map->JepsenPrinter (merge defaults options))]\n (binding [*print-meta* false]\n (visit printer x)))))\n\n(defn pprint\n \"Like Fipp's pprint, but with a few Jepsen-specific changes to make output\n more readable.\"\n ([x] (pprint x {}))\n ([x options]\n (-> (pretty x options)\n (pprint-document options))))\n\n(defn pprint-str\n \"Pretty-prints to a string.\"\n [x]\n (with-out-str (pprint x {:width 78})))\n\n(defn spy\n \"Useful for logging in threading macros: logs x (pretty-printed), and returns\n x\"\n [x]\n (info (pprint-str x))\n x)\n\n;; Printing histories and logging to the console\n\n(def buf-size 1048576)\n\n(defn concat-files!\n \"Appends contents of all fs, writing to out. Returns fs.\"\n [out fs]\n (with-open [oc (.getChannel (RandomAccessFile. (io/file out) \"rw\"))]\n (doseq [f fs]\n (with-open [fc (.getChannel (RandomAccessFile. (io/file f) \"r\"))]\n (let [size (.size fc)]\n (loop [position 0]\n (when (< position size)\n (recur (+ position (.transferTo fc\n position\n (min (- size position)\n buf-size)\n oc)))))))))\n fs)\n\n(defn op->str\n \"Format an operation as a string.\"\n [op]\n (str (:process op) \\tab\n (:type op) \\tab\n (pr-str (:f op)) \\tab\n (pr-str (:value op))\n (when-let [err (:error op)]\n (str \\tab err))))\n\n(defn prn-op\n \"Prints an operation to the console.\"\n [op]\n (pr (:process op)) (print \\tab)\n (pr (:type op)) (print \\tab)\n (pr (:f op)) (print \\tab)\n (pr (:value op))\n (when-let [err (:error op)]\n (print \\tab) (print err))\n (print \\newline))\n\n(defn print-history\n \"Prints a history to the console.\"\n ([history]\n (print-history prn-op history))\n ([printer history]\n (doseq [op history]\n (printer op))))\n\n(defn write-history!\n \"Writes a history to a file.\"\n ([f history]\n (write-history! f prn-op history))\n ([f printer history]\n (with-open [w (io/writer f)]\n (binding [*out* w]\n (print-history printer history)))))\n\n(defn pwrite-history!\n \"Writes history, taking advantage of more cores.\"\n ([f history]\n (pwrite-history! f prn-op history))\n ([f printer history]\n (h/fold history\n (loopf {:name [:pwrite-history (str printer)]}\n ; Reduce\n ([file (File/createTempFile \"jepsen-history\" \".part\")\n writer (io/writer file)]\n [op]\n (do (binding [*out* writer\n *flush-on-newline* false]\n (printer op))\n (recur file writer))\n (do (.flush ^java.io.Writer writer)\n (.close ^java.io.Writer writer)\n file))\n ; Combine\n ([files []]\n [file]\n (recur (conj files file))\n (try (concat-files! f files)\n f\n (finally\n (doseq [^File f files] (.delete f)))))))))\n\n(defn log-op\n \"Logs an operation and returns it.\"\n [op]\n (info (op->str op))\n op)\n\n\n(def logger (agent nil))\n\n(defn log-print\n [_ & things]\n (apply println things))\n\n(defn log\n [& things]\n (apply send-off logger log-print things))\n\n(defn test->str\n \"Pretty-prints a test to a string. This binds *print-length* to avoid printing\n infinite sequences for generators.\"\n [test]\n ; What we're doing here is basically recreating normal map pretty-printing at\n ; the top level, but overriding generators so that they only print 8 or so\n ; elements.\n (with-out-str\n (fipp.engine/pprint-document\n [:group \"{\"\n [:nest 1\n (->> test\n (map (fn [[k v]]\n [:group\n (pretty k)\n :line\n (if (= k :generator)\n (binding [*print-length* 8]\n (pretty v))\n (pretty v))]))\n (interpose [:line \", \" \"\"]))]\n \"}\"]\n {:width 80})))\n\n; JDK logging\n\n(defn all-jdk-loggers []\n (let [manager (java.util.logging.LogManager/getLogManager)]\n (->> manager\n .getLoggerNames\n java.util.Collections/list\n (map #(.getLogger manager %)))))\n\n(defmacro mute-jdk [& body]\n `(let [loggers# (all-jdk-loggers)\n levels# (map #(.getLevel %) loggers#)]\n (try\n (doseq [l# loggers#]\n (.setLevel l# java.util.logging.Level/OFF))\n ~@body\n (finally\n (dorun (map (fn [logger# level#] (.setLevel logger# level#))\n loggers#\n levels#))))))\n\n(defmacro mute [& body]\n `(mute-jdk\n ~@body))\n\n" }, { "path": "jepsen/src/jepsen/reconnect.clj", "content": "(ns jepsen.reconnect\n \"Stateful wrappers for automatically reconnecting network clients.\n\n A wrapper is a map with a connection atom `conn` and a pair of functions:\n `(open)`, which opens a new connection, and `(close conn)`, which closes a\n connection. We use these to provide a with-conn macro that acquires the\n current connection from a wrapper, evaluates body, and automatically\n closes/reopens the connection when errors occur.\n\n Connect/close/reconnect lock the wrapper, but multiple threads may acquire\n the current connection at once.\"\n (:require [clojure.tools.logging :refer [info warn]]\n [jepsen.util :as util]\n [clj-commons.slingshot :refer [try+ throw+]])\n (:import (java.io InterruptedIOException)\n (java.util.concurrent.locks ReentrantReadWriteLock)))\n\n(defn wrapper\n \"A wrapper is a stateful construct for talking to a database. Options:\n\n :name An optional name for this wrapper (for debugging logs)\n :open A function which generates a new conn\n :close A function which closes a conn\n :log? Whether to log reconnect messages. A special value, :minimal\n logs only a single line rather than a full stacktrace.\"\n [options]\n (assert (ifn? (:open options)))\n (assert (ifn? (:close options)))\n {:open (:open options)\n :close (:close options)\n :log? (:log? options)\n :name (:name options)\n :lock (ReentrantReadWriteLock.)\n :conn (atom nil)})\n\n(defmacro with-lock\n [wrapper lock-method & body]\n `(let [lock# (~lock-method ^ReentrantReadWriteLock (:lock ~wrapper))]\n (.lock lock#)\n (try ~@body\n (finally\n (.unlock lock#)))))\n\n(defmacro with-read-lock\n [wrapper & body]\n `(with-lock ~wrapper .readLock ~@body))\n\n(defmacro with-write-lock\n [wrapper & body]\n `(with-lock ~wrapper .writeLock ~@body))\n\n(defn conn\n \"Active connection for a wrapper, if one exists.\"\n [wrapper]\n @(:conn wrapper))\n\n(defn open!\n \"Given a wrapper, opens a connection. Noop if conn is already open.\"\n [wrapper]\n (with-write-lock wrapper\n (when-not (conn wrapper)\n (let [new-conn ((:open wrapper))]\n (when (nil? new-conn)\n (throw (IllegalStateException.\n (str \"Reconnect wrapper \" (:name wrapper)\n \"'s :open function returned nil \"\n \"instead of a connection!\"))))\n (reset! (:conn wrapper) new-conn))))\n wrapper)\n\n(defn close!\n \"Closes a wrapper.\"\n [wrapper]\n (with-write-lock wrapper\n (when-let [c (conn wrapper)]\n ((:close wrapper) c)\n (reset! (:conn wrapper) nil)))\n wrapper)\n\n(defn reopen!\n \"Reopens a wrapper's connection.\"\n [wrapper]\n (with-write-lock wrapper\n (when-let [c (conn wrapper)]\n ((:close wrapper) c))\n (let [c' ((:open wrapper))]\n (when (nil? c')\n (throw (IllegalStateException.\n (str \"Reconnect wrapper \" (:name wrapper)\n \"'s :open function returned nil \"\n \"instead of a connection!\"))))\n (reset! (:conn wrapper) c')))\n wrapper)\n\n(defmacro with-conn\n \"Acquires a read lock, takes a connection from the wrapper, and evaluates\n body with that connection bound to c. If any Exception is thrown, closes the\n connection and opens a new one.\"\n [[c wrapper] & body]\n ; We want to hold the read lock while executing the body, but we're going to\n ; release it in complicated ways, so we can't use the with-read-lock macro\n ; here.\n `(let [read-lock# (.readLock ^ReentrantReadWriteLock (:lock ~wrapper))]\n (.lock read-lock#)\n (let [~c (conn ~wrapper)]\n (try (when (nil? ~c)\n (throw+ {:type ::no-conn\n :wrapper ~wrapper}))\n ~@body\n (catch InterruptedException e#\n ; When threads are interrupted, we're generally\n ; terminating--there's no reason to reopen or log a message here.\n (throw e#))\n (catch InterruptedIOException e#\n ; Ditto here; this is a consequence of an interrupt, and we\n ; should, I think, treat it as if it were an interrupt itself.\n (throw e#))\n (catch Exception e#\n ; We can't acquire the write lock until we release our read lock,\n ; because ???\n (.unlock read-lock#)\n (try\n (with-write-lock ~wrapper\n (when (identical? ~c (conn ~wrapper))\n ; This is the same conn that yielded the error\n (cond (= :minimal (:log? ~wrapper))\n (warn (str (.getName (class e#))\n \" with conn \"\n (pr-str (:name ~wrapper))\n \"; reopening.\"))\n (:log? ~wrapper)\n (warn e# (str \"Encountered error with conn \"\n (pr-str (:name ~wrapper))\n \"; reopening\")))\n (reopen! ~wrapper)))\n (catch InterruptedException e#\n ; Same here\n (throw e#))\n (catch Exception e2#\n ; We don't want to lose the original exception, but we will\n ; log the reconnect error here. If we don't throw the\n ; original exception, our caller might not know what kind of\n ; error occurred in their transaction logic!\n (cond (= :minimal (:log? ~wrapper))\n (warn (str (.getName (class e2#))\n \" reopening \" (pr-str (:name ~wrapper))))\n\n (:log? ~wrapper)\n (warn e2# \"Error reopening\" (pr-str (:name ~wrapper)))))\n (finally\n (.lock read-lock#)))\n ; Right, that's done with, now we can propagate the exception\n (throw e#))\n (finally\n (.unlock read-lock#))))))\n" }, { "path": "jepsen/src/jepsen/repl.clj", "content": "(ns jepsen.repl\n \"Helper functions for mucking around with tests!\"\n (:require [jepsen [history :as h]\n [report :as report]\n [store :as store]]))\n\n(defn latest-test\n \"Returns the most recently run test\"\n []\n (store/latest))\n" }, { "path": "jepsen/src/jepsen/report.clj", "content": "(ns jepsen.report\n \"Prints out stuff.\"\n (:require [jepsen.util :as util]\n [clojure.java.io :as io]\n [clojure.pprint :refer [pprint]]))\n\n(defmacro to\n \"Binds stdout to a file for the duration of body.\"\n [filename & body]\n `(let [filename# ~filename]\n (io/make-parents filename#)\n (with-open [w# (io/writer filename#)]\n (try\n (binding [*out* w#] ~@body)\n (finally\n (println \"Report written to\" filename#))))))\n" }, { "path": "jepsen/src/jepsen/role.clj", "content": "(ns jepsen.role\n \"Supports tests where each node has a single, distinct role. For instance,\n one node might run ZooKeeper, and the remaining nodes might run Kafka.\n\n Using this namespace requires the test to have a :roles map, whose keys are\n arbitrary roles, and whose corresponding values are vectors of nodes in the\n test, like so:\n\n {:mongod [\\\"n1\\\" \\\"n2\\\"]\n :mongos [\\\"n3\\\"]}\"\n (:require [dom-top.core :refer [loopr]]\n [jepsen [client :as client]\n [db :as db]\n [nemesis :as n]]\n [jepsen.nemesis.combined :as nc]\n [clj-commons.slingshot :refer [try+ throw+]])\n (:import (java.util.concurrent CyclicBarrier)))\n\n(defn role\n \"Takes a test and node. Returns the role for that particular node. Throws if\n the test does not define a role for that node.\"\n [test node]\n (loopr []\n [[role nodes] (:roles test)\n n nodes]\n (if (= n node)\n role\n (recur))\n (throw+ {:type ::no-role-for-node\n :node node\n :roles (:roles test)})))\n\n(defn nodes\n \"Returns a vector of nodes associated with a given role, in test order. Right\n now this returns nil when given a role not in the roles map. I'm not sure if\n that's more or less useful than throwing. This may change.\"\n [test role]\n (get (:roles test) role))\n\n(defn restrict-test\n \"Takes a test map and a role. Returns a version of the test map where the\n :nodes are only those for this specific role, and the :barrier is replaced by\n a fresh CyclicBarrier for the appropriate number of nodes.\"\n [role test]\n (let [nodes (nodes test role)\n n (count nodes)]\n (assoc test\n :nodes nodes\n :barrier (if (pos? n)\n (CyclicBarrier. n)\n :jepsen.core/no-barrier))))\n\n(defmacro db-helper*\n \"We have to figure out the role, db, and restricted test for every single fn.\n This anaphoric macro binds these variables to strip out boilerplate. Only for\n use in DB below, or when writing your own DB and you use *exactly* the form\n below.\"\n [& body]\n `(let [~'role (role ~'test ~'node)\n ~'db (or (get ~'dbs ~'role)\n (throw+ {:type ::no-db-for-role\n :role ~'role\n :dbs ~'dbs}))\n ~'test (restrict-test ~'role ~'test)]\n ~@body))\n\n(defrecord DB\n [dbs]\n db/DB\n (setup! [_ test node] (db-helper* (db/setup! db test node)))\n (teardown! [_ test node] (db-helper* (db/teardown! db test node)))\n\n db/Kill\n (kill! [_ test node] (db-helper* (db/kill! db test node)))\n (start! [_ test node] (db-helper* (db/start! db test node)))\n\n db/Pause\n (pause! [_ test node] (db-helper* (db/pause! db test node)))\n (resume! [_ test node] (db-helper* (db/resume! db test node)))\n\n db/Primary\n (primaries [db test]\n ; Call for each role, then combine\n (->> (:roles test)\n keys\n (mapcat (fn [role]\n (let [db (get dbs role)\n test (restrict-test role test)]\n (when (satisfies? db/Primary db)\n (db/primaries db test)))))\n (into [])))\n\n ; Setup-primary! always uses the first node; we do that for each role\n ; independently iff they support Primary.\n (setup-primary! [db test node]\n (->> (:roles test)\n keys\n (mapv (fn [role]\n (let [db (get dbs role)\n test (restrict-test role test)]\n (when (satisfies? db/Primary db)\n (db/setup-primary! db test (first (:nodes test)))))))))\n\n\n db/LogFiles\n (log-files [db test node]\n (db-helper* (db/log-files db test node))))\n\n(defn db\n \"Takes a map of role -> DB and creates a composite DB which implements the\n full suite of DB protocols. Setup! on this DB calls the setup! for that\n particular role's DB for that node, with a restricted test, and so\n on.\"\n [dbs]\n (DB. dbs))\n\n(defrecord RestrictedClient [role client]\n client/Client\n (open! [this test node]\n (let [node-index (.indexOf ^java.util.List (:nodes test) node)\n role-nodes (nodes test role)\n _ (assert (pos? (count role-nodes))\n (str \"No nodes for role \" (pr-str role)\n \" (roles are \" (pr-str (:roles test))))\n node (nth role-nodes (mod node-index (count role-nodes)))]\n (client/open! client test node))))\n\n(defn restrict-client\n \"Your test has nodes with different roles, but only one role is client-facing.\n\n Wraps a jepsen Client `c` in a new Client specific to the given role. This\n client responds *only* to (client/open! wrapper test node). Instead of\n connecting to the given node, calls `(client/open! c test node'), where node'\n is a node with the given role.\n\n Note that this wrapper evaporates after open!; the inner client takes over\n thereafter. Calls to `invoke!` etc go directly to the inner client and will\n receive the full test map, rather than a restricted one. This may come back\n to bite us later, in which case we'll change.\"\n [role client]\n (RestrictedClient. role client))\n\n(defrecord RestrictedNemesis [role nemesis]\n n/Reflection\n (fs [_] (n/fs nemesis))\n\n n/Nemesis\n (setup! [this test]\n (RestrictedNemesis. role (n/setup! nemesis (restrict-test role test))))\n\n (invoke! [this test op]\n (n/invoke! nemesis (restrict-test role test) op))\n\n (teardown! [this test]\n (n/teardown! nemesis (restrict-test role test))))\n\n(defn restrict-nemesis\n \"Wraps a Nemesis in a new one restricted to a specific role. Calls to the\n underlying nemesis receive a restricted test map.\"\n [role nemesis]\n (RestrictedNemesis. role nemesis))\n\n(defn restrict-nemesis-package\n \"Restricts a jepsen.nemesis.combined package to act purely on a single role.\n Right now we just restrict the nemesis, not the generators; maybe later we'll\n need to do the generators too. Operations in this package have their\n operation `:f`s lifted to `:f [role f]`. Also adds a :role key to the\n package, for your use later.\"\n [role package]\n (-> package\n (assoc :role role\n :nemesis (restrict-nemesis role (:nemesis package)))\n (->> (nc/f-map (partial vector role)))))\n" }, { "path": "jepsen/src/jepsen/store/FileOffsetOutputStream.java", "content": "package jepsen.store.format;\n\nimport java.io.IOException;\nimport java.io.OutputStream;\nimport java.nio.ByteBuffer;\nimport java.nio.channels.FileChannel;\nimport java.util.zip.CRC32;\n\n// This class provides an OutputStream linked to a FileChannel at a particular\n// offset; each write to this stream is written to the corresponding file. Also\n// tracks the count and CRC32 of all streamed bytes.\npublic class FileOffsetOutputStream extends OutputStream implements AutoCloseable {\n public final FileChannel file;\n public final long offset;\n public final ByteBuffer singleByteBuffer;\n public long currentOffset;\n public final CRC32 checksum;\n\n public FileOffsetOutputStream(FileChannel file, long offset, CRC32 checksum) {\n super();\n this.file = file;\n this.offset = offset;\n this.currentOffset = offset;\n this.singleByteBuffer = ByteBuffer.allocate(1);\n this.checksum = checksum;\n }\n\n // Returns how many bytes have been written to this stream\n public long bytesWritten() {\n return currentOffset - offset;\n }\n\n // Returns current CRC32\n public CRC32 checksum() {\n return checksum;\n }\n\n public void close() {\n }\n\n public void flush() throws IOException {\n file.force(false);\n }\n\n public void write(int b) throws IOException {\n //System.out.printf(\"Wrote %d to offset %d\\n\", b, currentOffset);\n // Copy byte into our buffer\n singleByteBuffer.put(0, (byte) b);\n // Write buffer and advance\n singleByteBuffer.rewind();\n final int written = file.write(singleByteBuffer, currentOffset);\n assert written == 1;\n currentOffset += written;\n checksum.update(b);\n }\n\n public void write(byte[] bs) throws IOException {\n //System.out.printf(\"Wrote fast %d\", bs.length);\n final ByteBuffer buf = ByteBuffer.wrap(bs);\n final int written = file.write(buf, currentOffset);\n assert written == buf.limit();\n currentOffset += written;\n checksum.update(bs);\n }\n\n public void write(byte[] bs, int offset, int len) throws IOException {\n //System.out.printf(\"Wrote fast %d\", len);\n final ByteBuffer buf = ByteBuffer.wrap(bs, offset, len);\n final int written = file.write(buf, currentOffset);\n assert written == buf.limit();\n currentOffset += written;\n checksum.update(bs, offset, len);\n }\n}\n" }, { "path": "jepsen/src/jepsen/store/FressianReader.java", "content": "// Copyright (c) Metadata Partners, LLC, with modifications by Jepsen, LLC.\n// All rights reserved. The use and distribution terms for this software are\n// covered by the Eclipse Public License 1.0\n// (http://opensource.org/licenses/eclipse-1.0.php) which can be found in the\n// file epl-v10.html at the root of this distribution.\n// By using this software in any fashion, you are agreeing to be bound by\n// the terms of this license.\n// You must not remove this notice, or any other, from this software.\n\n// This is a very straightforward patch to the original\n// (https://github.com/Datomic/fressian/blob/43e34cade9b7b498fa88db1dd88546ff07f2282a/src/org/fressian/FressianReader.java)\n// which modifies the coreHandlers map to construct vectors rather than\n// arraylists. If Fressian ever makes this configurable (it's sooooo close\n// already!) we can get rid of this file.\n\npackage jepsen.store;\n\nimport clojure.lang.PersistentVector;\n\nimport org.fressian.*;\nimport org.fressian.handlers.*;\nimport org.fressian.impl.*;\n\nimport java.io.*;\nimport java.util.*;\n\nimport static org.fressian.impl.Fns.*;\n\npublic class FressianReader implements org.fressian.Reader, Closeable {\n private final RawInput is;\n private ArrayList priorityCache;\n private ArrayList structCache;\n public final Map standardExtensionHandlers;\n private final ILookup handlerLookup;\n private byte[] byteBuffer;\n\n public FressianReader(InputStream is) {\n this(is, null, true);\n }\n\n public FressianReader(InputStream is, ILookup handlerLookup) {\n this(is, handlerLookup, true);\n }\n\n public FressianReader(InputStream is, ILookup handlerLookup, boolean validateAdler) {\n standardExtensionHandlers = Handlers.extendedReadHandlers;\n this.is = new RawInput(is, validateAdler);\n this.handlerLookup = handlerLookup;\n resetCaches();\n }\n\n public boolean readBoolean() throws IOException {\n int code = readNextCode();\n\n switch (code) {\n case Codes.TRUE:\n return true;\n case Codes.FALSE:\n return false;\n default: {\n Object result = read(code);\n if (result instanceof Boolean) {\n return (Boolean) result;\n } else {\n throw expected(\"boolean\", code, result);\n }\n }\n }\n }\n\n public long readInt() throws IOException {\n return internalReadInt();\n }\n\n private long internalReadInt() throws IOException {\n long result;\n int code = readNextCode();\n switch (code) {\n\n //INT_PACKED_1_FIRST\n case 0xFF:\n result = -1;\n break;\n\n case 0x00:\n case 0x01:\n case 0x02:\n case 0x03:\n case 0x04:\n case 0x05:\n case 0x06:\n case 0x07:\n case 0x08:\n case 0x09:\n case 0x0A:\n case 0x0B:\n case 0x0C:\n case 0x0D:\n case 0x0E:\n case 0x0F:\n case 0x10:\n case 0x11:\n case 0x12:\n case 0x13:\n case 0x14:\n case 0x15:\n case 0x16:\n case 0x17:\n case 0x18:\n case 0x19:\n case 0x1A:\n case 0x1B:\n case 0x1C:\n case 0x1D:\n case 0x1E:\n case 0x1F:\n case 0x20:\n case 0x21:\n case 0x22:\n case 0x23:\n case 0x24:\n case 0x25:\n case 0x26:\n case 0x27:\n case 0x28:\n case 0x29:\n case 0x2A:\n case 0x2B:\n case 0x2C:\n case 0x2D:\n case 0x2E:\n case 0x2F:\n case 0x30:\n case 0x31:\n case 0x32:\n case 0x33:\n case 0x34:\n case 0x35:\n case 0x36:\n case 0x37:\n case 0x38:\n case 0x39:\n case 0x3A:\n case 0x3B:\n case 0x3C:\n case 0x3D:\n case 0x3E:\n case 0x3F:\n result = (long) code & 0xff;\n break;\n\n// INT_PACKED_2_FIRST\n case 0x40:\n case 0x41:\n case 0x42:\n case 0x43:\n case 0x44:\n case 0x45:\n case 0x46:\n case 0x47:\n case 0x48:\n case 0x49:\n case 0x4A:\n case 0x4B:\n case 0x4C:\n case 0x4D:\n case 0x4E:\n case 0x4F:\n case 0x50:\n case 0x51:\n case 0x52:\n case 0x53:\n case 0x54:\n case 0x55:\n case 0x56:\n case 0x57:\n case 0x58:\n case 0x59:\n case 0x5A:\n case 0x5B:\n case 0x5C:\n case 0x5D:\n case 0x5E:\n case 0x5F:\n result = ((long) (code - Codes.INT_PACKED_2_ZERO) << 8) | is.readRawInt8();\n break;\n\n// INT_PACKED_3_FIRST\n case 0x60:\n case 0x61:\n case 0x62:\n case 0x63:\n case 0x64:\n case 0x65:\n case 0x66:\n case 0x67:\n case 0x68:\n case 0x69:\n case 0x6A:\n case 0x6B:\n case 0x6C:\n case 0x6D:\n case 0x6E:\n case 0x6F:\n result = ((long) (code - Codes.INT_PACKED_3_ZERO) << 16) | is.readRawInt16();\n break;\n\n\n// INT_PACKED_4_FIRST\n case 0x70:\n case 0x71:\n case 0x72:\n case 0x73:\n result = ((long) (code - Codes.INT_PACKED_4_ZERO << 24)) | is.readRawInt24();\n break;\n\n\n// INT_PACKED_5_FIRST\n case 0x74:\n case 0x75:\n case 0x76:\n case 0x77:\n result = ((long) (code - Codes.INT_PACKED_5_ZERO) << 32) | is.readRawInt32();\n break;\n\n// INT_PACKED_6_FIRST\n case 0x78:\n case 0x79:\n case 0x7A:\n case 0x7B:\n result = (((long) code - Codes.INT_PACKED_6_ZERO) << 40) | is.readRawInt40();\n break;\n\n// INT_PACKED_7_FIRST\n case 0x7C:\n case 0x7D:\n case 0x7E:\n case 0x7F:\n result = (((long) code - Codes.INT_PACKED_7_ZERO) << 48) | is.readRawInt48();\n break;\n\n case Codes.INT:\n result = is.readRawInt64();\n break;\n\n default: {\n Object o = read(code);\n if (o instanceof Long) {\n return (Long) o;\n } else {\n throw expected(\"int64\", code, o);\n }\n }\n }\n return result;\n }\n\n public double readDouble() throws IOException {\n int code = readNextCode();\n double d = internalReadDouble(code);\n return d;\n }\n\n public float readFloat() throws IOException {\n int code = readNextCode();\n float result;\n switch (code) {\n case Codes.FLOAT:\n result = is.readRawFloat();\n break;\n default: {\n Object o = read(code);\n if (o instanceof Float) {\n return (Float) o;\n } else {\n throw expected(\"float\", code, o);\n }\n }\n }\n return result;\n }\n\n public Object readObject() throws IOException {\n return read(readNextCode());\n }\n\n private Object read(int code) throws IOException {\n Object result;\n switch (code) {\n\n //INT_PACKED_1_FIRST\n case 0xFF:\n result = -1L;\n break;\n\n case 0x00:\n case 0x01:\n case 0x02:\n case 0x03:\n case 0x04:\n case 0x05:\n case 0x06:\n case 0x07:\n case 0x08:\n case 0x09:\n case 0x0A:\n case 0x0B:\n case 0x0C:\n case 0x0D:\n case 0x0E:\n case 0x0F:\n case 0x10:\n case 0x11:\n case 0x12:\n case 0x13:\n case 0x14:\n case 0x15:\n case 0x16:\n case 0x17:\n case 0x18:\n case 0x19:\n case 0x1A:\n case 0x1B:\n case 0x1C:\n case 0x1D:\n case 0x1E:\n case 0x1F:\n case 0x20:\n case 0x21:\n case 0x22:\n case 0x23:\n case 0x24:\n case 0x25:\n case 0x26:\n case 0x27:\n case 0x28:\n case 0x29:\n case 0x2A:\n case 0x2B:\n case 0x2C:\n case 0x2D:\n case 0x2E:\n case 0x2F:\n case 0x30:\n case 0x31:\n case 0x32:\n case 0x33:\n case 0x34:\n case 0x35:\n case 0x36:\n case 0x37:\n case 0x38:\n case 0x39:\n case 0x3A:\n case 0x3B:\n case 0x3C:\n case 0x3D:\n case 0x3E:\n case 0x3F:\n result = (long) code & 0xff;\n break;\n\n// INT_PACKED_2_FIRST\n case 0x40:\n case 0x41:\n case 0x42:\n case 0x43:\n case 0x44:\n case 0x45:\n case 0x46:\n case 0x47:\n case 0x48:\n case 0x49:\n case 0x4A:\n case 0x4B:\n case 0x4C:\n case 0x4D:\n case 0x4E:\n case 0x4F:\n case 0x50:\n case 0x51:\n case 0x52:\n case 0x53:\n case 0x54:\n case 0x55:\n case 0x56:\n case 0x57:\n case 0x58:\n case 0x59:\n case 0x5A:\n case 0x5B:\n case 0x5C:\n case 0x5D:\n case 0x5E:\n case 0x5F:\n result = ((long) (code - Codes.INT_PACKED_2_ZERO) << 8) | is.readRawInt8();\n break;\n\n// INT_PACKED_3_FIRST\n case 0x60:\n case 0x61:\n case 0x62:\n case 0x63:\n case 0x64:\n case 0x65:\n case 0x66:\n case 0x67:\n case 0x68:\n case 0x69:\n case 0x6A:\n case 0x6B:\n case 0x6C:\n case 0x6D:\n case 0x6E:\n case 0x6F:\n result = ((long) (code - Codes.INT_PACKED_3_ZERO) << 16) | is.readRawInt16();\n break;\n\n// INT_PACKED_4_FIRST\n case 0x70:\n case 0x71:\n case 0x72:\n case 0x73:\n result = ((long) (code - Codes.INT_PACKED_4_ZERO << 24)) | is.readRawInt24();\n break;\n\n// INT_PACKED_5_FIRST\n case 0x74:\n case 0x75:\n case 0x76:\n case 0x77:\n result = ((long) (code - Codes.INT_PACKED_5_ZERO) << 32) | is.readRawInt32();\n break;\n\n// INT_PACKED_6_FIRST\n case 0x78:\n case 0x79:\n case 0x7A:\n case 0x7B:\n result = (((long) code - Codes.INT_PACKED_6_ZERO) << 40) | is.readRawInt40();\n break;\n\n// INT_PACKED_7_FIRST\n case 0x7C:\n case 0x7D:\n case 0x7E:\n case 0x7F:\n result = (((long) code - Codes.INT_PACKED_7_ZERO) << 48) | is.readRawInt48();\n break;\n\n case Codes.PUT_PRIORITY_CACHE:\n result = readAndCacheObject(getPriorityCache());\n break;\n\n case Codes.GET_PRIORITY_CACHE:\n result = lookupCache(getPriorityCache(), readInt32());\n break;\n\n case Codes.PRIORITY_CACHE_PACKED_START + 0:\n case Codes.PRIORITY_CACHE_PACKED_START + 1:\n case Codes.PRIORITY_CACHE_PACKED_START + 2:\n case Codes.PRIORITY_CACHE_PACKED_START + 3:\n case Codes.PRIORITY_CACHE_PACKED_START + 4:\n case Codes.PRIORITY_CACHE_PACKED_START + 5:\n case Codes.PRIORITY_CACHE_PACKED_START + 6:\n case Codes.PRIORITY_CACHE_PACKED_START + 7:\n case Codes.PRIORITY_CACHE_PACKED_START + 8:\n case Codes.PRIORITY_CACHE_PACKED_START + 9:\n case Codes.PRIORITY_CACHE_PACKED_START + 10:\n case Codes.PRIORITY_CACHE_PACKED_START + 11:\n case Codes.PRIORITY_CACHE_PACKED_START + 12:\n case Codes.PRIORITY_CACHE_PACKED_START + 13:\n case Codes.PRIORITY_CACHE_PACKED_START + 14:\n case Codes.PRIORITY_CACHE_PACKED_START + 15:\n case Codes.PRIORITY_CACHE_PACKED_START + 16:\n case Codes.PRIORITY_CACHE_PACKED_START + 17:\n case Codes.PRIORITY_CACHE_PACKED_START + 18:\n case Codes.PRIORITY_CACHE_PACKED_START + 19:\n case Codes.PRIORITY_CACHE_PACKED_START + 20:\n case Codes.PRIORITY_CACHE_PACKED_START + 21:\n case Codes.PRIORITY_CACHE_PACKED_START + 22:\n case Codes.PRIORITY_CACHE_PACKED_START + 23:\n case Codes.PRIORITY_CACHE_PACKED_START + 24:\n case Codes.PRIORITY_CACHE_PACKED_START + 25:\n case Codes.PRIORITY_CACHE_PACKED_START + 26:\n case Codes.PRIORITY_CACHE_PACKED_START + 27:\n case Codes.PRIORITY_CACHE_PACKED_START + 28:\n case Codes.PRIORITY_CACHE_PACKED_START + 29:\n case Codes.PRIORITY_CACHE_PACKED_START + 30:\n case Codes.PRIORITY_CACHE_PACKED_START + 31:\n result = lookupCache(getPriorityCache(), code - Codes.PRIORITY_CACHE_PACKED_START);\n break;\n\n case Codes.STRUCT_CACHE_PACKED_START + 0:\n case Codes.STRUCT_CACHE_PACKED_START + 1:\n case Codes.STRUCT_CACHE_PACKED_START + 2:\n case Codes.STRUCT_CACHE_PACKED_START + 3:\n case Codes.STRUCT_CACHE_PACKED_START + 4:\n case Codes.STRUCT_CACHE_PACKED_START + 5:\n case Codes.STRUCT_CACHE_PACKED_START + 6:\n case Codes.STRUCT_CACHE_PACKED_START + 7:\n case Codes.STRUCT_CACHE_PACKED_START + 8:\n case Codes.STRUCT_CACHE_PACKED_START + 9:\n case Codes.STRUCT_CACHE_PACKED_START + 10:\n case Codes.STRUCT_CACHE_PACKED_START + 11:\n case Codes.STRUCT_CACHE_PACKED_START + 12:\n case Codes.STRUCT_CACHE_PACKED_START + 13:\n case Codes.STRUCT_CACHE_PACKED_START + 14:\n case Codes.STRUCT_CACHE_PACKED_START + 15: {\n StructType st = (StructType) lookupCache(getStructCache(), code - Codes.STRUCT_CACHE_PACKED_START);\n result = handleStruct(st.tag, st.fields);\n break;\n }\n\n case Codes.MAP:\n result = handleStruct(\"map\", 1);\n break;\n\n case Codes.SET:\n result = handleStruct(\"set\", 1);\n break;\n\n case Codes.UUID:\n result = handleStruct(\"uuid\", 2);\n break;\n\n case Codes.REGEX:\n result = handleStruct(\"regex\", 1);\n break;\n\n case Codes.URI:\n result = handleStruct(\"uri\", 1);\n break;\n\n case Codes.BIGINT:\n result = handleStruct(\"bigint\", 1);\n break;\n\n case Codes.BIGDEC:\n result = handleStruct(\"bigdec\", 2);\n break;\n\n case Codes.INST:\n result = handleStruct(\"inst\", 1);\n break;\n\n case Codes.SYM:\n result = handleStruct(\"sym\", 2);\n break;\n\n case Codes.KEY:\n result = handleStruct(\"key\", 2);\n break;\n\n case Codes.INT_ARRAY:\n result = handleStruct(\"int[]\", 2);\n break;\n\n case Codes.LONG_ARRAY:\n result = handleStruct(\"long[]\", 2);\n break;\n\n case Codes.FLOAT_ARRAY:\n result = handleStruct(\"float[]\", 2);\n break;\n\n case Codes.BOOLEAN_ARRAY:\n result = handleStruct(\"boolean[]\", 2);\n break;\n\n case Codes.DOUBLE_ARRAY:\n result = handleStruct(\"double[]\", 2);\n break;\n\n case Codes.OBJECT_ARRAY:\n result = handleStruct(\"Object[]\", 2);\n break;\n\n case Codes.BYTES_PACKED_LENGTH_START + 0:\n case Codes.BYTES_PACKED_LENGTH_START + 1:\n case Codes.BYTES_PACKED_LENGTH_START + 2:\n case Codes.BYTES_PACKED_LENGTH_START + 3:\n case Codes.BYTES_PACKED_LENGTH_START + 4:\n case Codes.BYTES_PACKED_LENGTH_START + 5:\n case Codes.BYTES_PACKED_LENGTH_START + 6:\n case Codes.BYTES_PACKED_LENGTH_START + 7:\n result = internalReadBytes(code - Codes.BYTES_PACKED_LENGTH_START);\n break;\n\n case Codes.BYTES:\n result = internalReadBytes(readCount());\n break;\n\n case Codes.BYTES_CHUNK:\n result = internalReadChunkedBytes();\n break;\n\n case Codes.STRING_PACKED_LENGTH_START + 0:\n case Codes.STRING_PACKED_LENGTH_START + 1:\n case Codes.STRING_PACKED_LENGTH_START + 2:\n case Codes.STRING_PACKED_LENGTH_START + 3:\n case Codes.STRING_PACKED_LENGTH_START + 4:\n case Codes.STRING_PACKED_LENGTH_START + 5:\n case Codes.STRING_PACKED_LENGTH_START + 6:\n case Codes.STRING_PACKED_LENGTH_START + 7:\n result = internalReadString(code - Codes.STRING_PACKED_LENGTH_START).toString();\n break;\n\n case Codes.STRING:\n result = internalReadString(readCount()).toString();\n break;\n\n case Codes.STRING_CHUNK:\n result = internalReadChunkedString(readCount());\n break;\n\n case Codes.LIST_PACKED_LENGTH_START + 0:\n case Codes.LIST_PACKED_LENGTH_START + 1:\n case Codes.LIST_PACKED_LENGTH_START + 2:\n case Codes.LIST_PACKED_LENGTH_START + 3:\n case Codes.LIST_PACKED_LENGTH_START + 4:\n case Codes.LIST_PACKED_LENGTH_START + 5:\n case Codes.LIST_PACKED_LENGTH_START + 6:\n case Codes.LIST_PACKED_LENGTH_START + 7:\n result = internalReadList(code - Codes.LIST_PACKED_LENGTH_START);\n break;\n\n case Codes.LIST:\n result = internalReadList(readCount());\n break;\n\n case Codes.BEGIN_CLOSED_LIST:\n result = ((ConvertList) getHandler(\"list\")).convertList(readClosedList());\n break;\n\n case Codes.BEGIN_OPEN_LIST:\n result = ((ConvertList) getHandler(\"list\")).convertList(readOpenList());\n break;\n\n case Codes.TRUE:\n result = Boolean.TRUE;\n break;\n\n case Codes.FALSE:\n result = Boolean.FALSE;\n break;\n\n case Codes.DOUBLE:\n case Codes.DOUBLE_0:\n case Codes.DOUBLE_1:\n result = ((ConvertDouble) getHandler(\"double\")).convertDouble(internalReadDouble(code));\n break;\n\n case Codes.FLOAT:\n result = ((ConvertFloat) getHandler(\"float\")).convertFloat(is.readRawFloat());\n break;\n\n case Codes.INT:\n result = is.readRawInt64();\n break;\n\n case Codes.NULL:\n result = null;\n break;\n\n case Codes.FOOTER: {\n int calculatedLength = is.getBytesRead() - 1;\n int magicFromStream = (int) ((code << 24) + (int) is.readRawInt24());\n validateFooter(calculatedLength, magicFromStream);\n return readObject();\n }\n case Codes.STRUCTTYPE: {\n Object tag = readObject();\n int fields = readInt32();\n getStructCache().add(new StructType(tag, fields));\n result = handleStruct(tag, fields);\n break;\n }\n case Codes.STRUCT: {\n StructType st = (StructType) lookupCache(getStructCache(), readInt32());\n result = handleStruct(st.tag, st.fields);\n break;\n }\n\n case Codes.RESET_CACHES: {\n resetCaches();\n result = readObject();\n break;\n }\n\n\n default:\n throw expected(\"any\", code);\n }\n return result;\n }\n\n private Object handleStruct(Object tag, int fields) throws IOException {\n ReadHandler h = lookup(handlerLookup, tag);\n if (h == null)\n h = (ReadHandler) standardExtensionHandlers.get(tag);\n if (h == null)\n return new TaggedObject(tag, readObjects(fields));\n else\n return h.read(this, tag, fields);\n }\n\n private int readCount() throws IOException {\n return readInt32();\n }\n\n private int internalReadInt32() throws IOException {\n return intCast(internalReadInt());\n }\n\n private int readInt32() throws IOException {\n return intCast(readInt());\n }\n\n private StringBuilder internalReadString(int length) throws IOException {\n return internalReadStringBuilder(new StringBuilder(length), length);\n }\n\n private StringBuilder internalReadStringBuilder(StringBuilder buf, int length) throws IOException {\n if ((byteBuffer == null) || (byteBuffer.length < length))\n byteBuffer = new byte[length];\n is.readFully(byteBuffer, 0, length);\n readUTF8Chars(buf, byteBuffer, 0, length);\n return buf;\n }\n\n private String internalReadChunkedString(int length) throws IOException {\n StringBuilder buf = internalReadString(length);\n boolean done = false;\n while (!done) {\n int code = readNextCode();\n switch (code) {\n case Codes.STRING_PACKED_LENGTH_START + 0:\n case Codes.STRING_PACKED_LENGTH_START + 1:\n case Codes.STRING_PACKED_LENGTH_START + 2:\n case Codes.STRING_PACKED_LENGTH_START + 3:\n case Codes.STRING_PACKED_LENGTH_START + 4:\n case Codes.STRING_PACKED_LENGTH_START + 5:\n case Codes.STRING_PACKED_LENGTH_START + 6:\n case Codes.STRING_PACKED_LENGTH_START + 7:\n internalReadStringBuilder(buf, code - Codes.STRING_PACKED_LENGTH_START).toString();\n done = true;\n break;\n\n case Codes.STRING:\n internalReadStringBuilder(buf, readCount());\n done = true;\n break;\n\n case Codes.STRING_CHUNK:\n internalReadStringBuilder(buf, readCount());\n break;\n default:\n throw expected(\"chunked string\", code);\n }\n }\n return buf.toString();\n }\n\n private byte[] internalReadBytes(int length) throws IOException {\n byte[] result = new byte[length];\n is.readFully(result, 0, length);\n return result;\n }\n\n private byte[] internalReadChunkedBytes() throws IOException {\n ArrayList chunks = new ArrayList();\n int code = Codes.BYTES_CHUNK;\n while (code == Codes.BYTES_CHUNK) {\n chunks.add(internalReadBytes(readCount()));\n code = readNextCode();\n }\n if (code != Codes.BYTES) {\n throw expected(\"conclusion of chunked bytes\", code);\n }\n chunks.add(internalReadBytes(readCount()));\n int length = 0;\n for (int n=0; n < chunks.size(); n++) {\n length = length + chunks.get(n).length;\n }\n byte[] result = new byte[length];\n int pos = 0;\n for (int n=0; n < chunks.size(); n++) {\n System.arraycopy(chunks.get(n), 0, result, pos, chunks.get(n).length);\n pos += chunks.get(n).length;\n }\n return result;\n }\n\n private Object getHandler(String tag) {\n Object o = coreHandlers.get(tag);\n if (o == null) {\n throw new RuntimeException(\"No read handler for type \" + tag);\n }\n return o;\n }\n\n private double internalReadDouble(int code) throws IOException {\n switch (code) {\n case Codes.DOUBLE:\n return is.readRawDouble();\n case Codes.DOUBLE_0:\n return 0.0D;\n case Codes.DOUBLE_1:\n return 1.0D;\n default: {\n Object o = read(code);\n if (o instanceof Double) {\n return (Double) o;\n } else {\n throw expected(\"double\", code, o);\n }\n }\n }\n }\n\n private Object[] readObjects(int length) throws IOException {\n Object[] objects = new Object[length];\n for (int n = 0; n < length; n++) {\n objects[n] = readObject();\n }\n return objects;\n }\n\n private Object[] readClosedList() throws IOException {\n ArrayList objects = new ArrayList();\n while (true) {\n int code = readNextCode();\n if (code == Codes.END_COLLECTION) {\n return objects.toArray();\n }\n objects.add(read(code));\n }\n }\n\n private Object[] readOpenList() throws IOException {\n ArrayList objects = new ArrayList();\n int code;\n while (true) {\n try {\n code = readNextCode();\n } catch (EOFException e) {\n code = Codes.END_COLLECTION;\n }\n if (code == Codes.END_COLLECTION) {\n return objects.toArray();\n }\n objects.add(read(code));\n }\n }\n\n public void close() throws IOException {\n is.close();\n }\n\n static class MapEntry implements Map.Entry {\n public final Object key;\n public final Object value;\n\n public MapEntry(Object key, Object value) {\n this.key = key;\n this.value = value;\n }\n\n public Object getKey() {\n return key;\n }\n\n public Object getValue() {\n return value;\n }\n\n public Object setValue(Object o) {\n throw new UnsupportedOperationException();\n }\n }\n\n // placeholder for objects still being read in\n static private Object UNDER_CONSTRUCTION = new Object();\n\n private Object lookupCache(ArrayList cache, int index) {\n if (index < cache.size()) {\n Object result = cache.get(index);\n if (result == UNDER_CONSTRUCTION)\n throw new RuntimeException(\"Unable to resolve circular reference in cache\");\n else\n return result;\n } else {\n throw new RuntimeException(\"Requested object beyond end of cache at \" + index);\n }\n }\n\n private List internalReadList(int length) throws IOException {\n return ((ConvertList) getHandler(\"list\")).convertList(readObjects(length));\n }\n\n private void validateFooter(int calculatedLength, int magicFromStream) throws IOException {\n if (magicFromStream != Codes.FOOTER_MAGIC) {\n throw new RuntimeException(String.format(\"Invalid footer magic, expected %X got %X\", Codes.FOOTER_MAGIC, magicFromStream));\n }\n int lengthFromStream = (int) is.readRawInt32();\n if (lengthFromStream != calculatedLength) {\n throw new RuntimeException(String.format(\"Invalid footer length, expected %X got %X\", calculatedLength, lengthFromStream));\n }\n is.validateChecksum();\n is.reset();\n resetCaches();\n }\n\n private ArrayList getPriorityCache() {\n if (priorityCache == null) priorityCache = new ArrayList();\n return priorityCache;\n }\n\n private ArrayList getStructCache() {\n if (structCache == null) structCache = new ArrayList();\n return structCache;\n }\n\n private void resetCaches() {\n if (priorityCache != null) priorityCache.clear();\n if (structCache != null) structCache.clear();\n }\n\n public void validateFooter() throws IOException {\n int calculatedLength = is.getBytesRead();\n int magicFromStream = (int) is.readRawInt32();\n validateFooter(calculatedLength, magicFromStream);\n }\n\n private int readNextCode() throws IOException {\n return is.readRawByte();\n }\n\n private Object readAndCacheObject(ArrayList cache) throws IOException {\n int index = cache.size();\n cache.add(UNDER_CONSTRUCTION);\n Object o = readObject();\n cache.set(index, o);\n return o;\n }\n\n public static final Map coreHandlers;\n\n static {\n HashMap handlers = new HashMap();\n handlers.put(\"list\", new ConvertList() {\n public List convertList(Object[] items) {\n return PersistentVector.create(items);\n }\n });\n\n handlers.put(\"bytes\", new ConvertBytes() {\n public Object convertBytes(byte[] bytes) {\n return bytes;\n }\n });\n\n handlers.put(\"double\", new ConvertDouble() {\n public Object convertDouble(double d) {\n return Double.valueOf(d);\n }\n });\n\n handlers.put(\"float\", new ConvertFloat() {\n public Object convertFloat(float f) {\n return Float.valueOf(f);\n }\n });\n coreHandlers = Collections.unmodifiableMap(handlers);\n }\n\n}\n" }, { "path": "jepsen/src/jepsen/store/format.clj", "content": "(ns jepsen.store.format\n \"Jepsen tests are logically a map. To save this map to disk, we originally\n wrote it as a single Fressian file. This approach works reasonably well, but\n has a few problems:\n\n - We write test files multiple times: once at the end of a test, and once\n once the analysis is complete--in case the analysis fails. Rewriting the\n entire file is inefficient. It would be nice to incrementally append new\n state.\n\n - Histories are *enormous* relative to tests, but we force readers to\n deserialize them before being able to get to any other high-level keys in the\n test--for instance, the result map.\n\n - It might be nice, someday, to have histories bigger than fit into memory.\n\n - We have no way to incrementally write the history, which means if a test\n crashes during the run we lose everything.\n\n - Deserializing histories is a linear process, but it would be nice for\n analyses to be able to parallelize.\n\n - The web view needs a *little* metadata quickly: the name, the date, the\n valid field of the result map. Forcing it to deserialize the entire world to\n get this information is bad.\n\n - Likewise, loading tests at the REPL is cumbersome--if all one wants is the\n results, you should be able to skip the history. Working with the history\n should ideally be lazy.\n\n I held off on designing a custom serialization format for Jepsen for many\n years, but at this point the design constraints feel pretty well set, and I\n think the time is right to design a custom format.\n\n\n ## File Format Structure\n\n Jepsen files begin with the magic UTF8 string JEPSEN, followed by a 32-byte\n big-endian unsigned integer version field, which we use to read old formats\n when necessary. Then there is a 64-bit offset into the file where the *block\n index*--the metadata structure--lives. There follows a series of *blocks*:\n\n 6 32 64\n | \\\"JEPSEN\\\" | version | block-index-offset | block 1 | block 2 | ...\n\n In general, files are written by appending blocks sequentially to the end of\n the file---this allows Jepsen to write files in (mostly) a single pass,\n without moving large chunks of bytes around. When one is ready to save the\n file, one writes a new index block to the end of the file which provides the\n offsets of all the (active) blocks in the file, and finally updates the\n block-index-offset at the start of the file to point to that most-recent\n index block.\n\n All integers are signed and big-endian, unless otherwise noted. This is the\n JVM, after all.\n\n Blocks may be sparse--their lengths may be shorter than the distance to the\n start of the next block. This is helpful if one needs to rewrite blocks\n later: you can leave padding for their sizes to change.\n\n The top-level value of the file (e.g. the test map) is given in the block\n index.\n\n\n ## Block Structure\n\n All blocks begin with an 8-byte length prefix which indicates the length of\n the block in bytes, including the length prefix itself. Then follows a CRC32\n checksum. Third, we have a 16-bit block type field, which\n identifies how to interpret the block. Finally, we have the block's data,\n which is type-dependent.\n\n 64 32 16\n | length | checksum | type | ... data ...\n\n Checksums are computed by taking the CRC32 of the data region, THEN the block\n header: the length, the checksum (all zeroes, for purposes of computing the\n checksum itself), and the type. We compute checksums this way so that writers\n can write large blocks of data with an unknown size in a single pass.\n\n\n ## Index Blocks (Type 1)\n\n An index block lays out the overall arrangement of the file: it stores a map\n of logical block numbers to file offsets, and also stores a root id, which\n identifies the block containing the top-level test map. The root id comes\n first, and is followed by the block map: a series of pairs, each a 32-bit\n logical block ID and an offset into the file.\n\n 32 32 64 32 64\n root id | id 1 | offset 1 | id 2 | offset 2 | ...\n\n There is no block with ID 0: 0 is used as a nil sentinel when one wishes to\n indicate the absence of a block.\n\n\n ## Fressian Blocks (Type 2)\n\n A *Fressian block* encodes data (often a key-value map) using the Fressian\n serialization format. This is already the workhorse for Jepsen serialization,\n but we introduce a twist: large values, like the history and results, can be\n stored in other blocks. That way you don't have to deserialize the entire\n thing in order to read the top-level structure.\n\n We create a special datatype, BlockRef, which we encode as a 'block-ref' tag\n in Fressian. This ref simply contains the ID of the block which encodes that\n tag's value.\n\n | fressian data ... |\n\n\n ## PartialMap (Type 3)\n\n Results are a bit weird. We want to efficiently fetch the :valid? field from\n them, but the rest of the result map could be *enormous*. To speed this up,\n we want to be able to write *part* of a map (for instance, just the results\n :valid? field), and store the rest in a different block.\n\n A PartialMap is essentially a cons cell: it comprises a Fressian-encoded map\n and a pointer to the ID of a *rest* block (also a PartialMap) which encodes\n the remainder of the map. This makes access to those parts of the map encoded\n in the head cell fast.\n\n 32\n | rest-ptr | fressian data ...\n\n When rest-ptr is 0, that indicates there is no more data remaining.\n\n\n ## FressianStream (Type 4)\n\n A FressianStream block allows us to write multiple Fressian-encoded values\n into a single block. We represent it as:\n\n | fressian data 1 ... | fressian data 2 ... | ...\n\n Writers can write any number of Fressian-encoded values to the stream one\n after the next. Readers start at the beginning and read values until the\n block is exhausted. There is no count associated with this block type; it\n must be inferred by reading all elements. We generally deserialize streams as\n vectors to enable O(1) access and faster reductions over elements.\n\n ## BigVector (Type 5)\n\n Histories are chonky boys. 100K operations (each a map) are common, and it's\n conceivable we might want to work with histories of tens of millions of\n operations. We also want to write them incrementally, so that we can recover\n from crashes. It's also nice to be able to deserialize small bits of the\n history, or to reduce over it in parallel. To do this, we need a streaming\n format for large vectors.\n\n We write each chunk of the vector as a separate block. Then we refer to those\n chunks with a BigVector, which stores some basic metadata about the vector as\n a whole, and then pointers to each block. Its format is:\n\n 64 64 32 64 32\n | count | index 1 | pointer 1 | index 2 | pointer 2 | ...\n\n Count is the number of elements in the vector overall. Index 1 is always\n 0--the offset of the first element in the first chunk. Pointer 1 is the block\n ID of the Fressian block which contains the first chunk's data. Index 2 is\n the index of the first element in the second chunk, and pointer 2 is the\n block ID of the second chunk's data, and so on.\n\n Chunk data can be stored in a Fressian block, a FressianStream block, or\n another BigVector.\n\n Access to BigVectors looks very much like a regular Clojure vector. We\n deserialize chunks on-demand, caching results as they're accessed. We can\n offer O(1) `count` through the count field. We implement `nth` by finding the\n chunk a given index belongs to and then looking up the index in that chunk.\n Assoc works by assoc'ing into that particular chunk, leaving other chunks\n unchanged.\n\n ## That's It\n\n There's a lot of obvious stuff I've left out here--metadata, top-level\n integrity checks, garbage collection, etc etc... but I think we can\n actually skip almost all of it and get a ton of benefit for the limited\n use case Jepsen needs.\n\n 1. Write the header.\n\n 2. Write an empty vector as block 1, for the history.\n\n 3. Write the initial test map as a PartialMap block to block 2, pointing to\n block 1 as the history. Write an index block pointing to 2 as the root.\n\n 4. Write the history incrementally as the test proceeds. Write operations as\n they occur to a new FressianStream block. Periodically, and at the end of the\n history:\n\n a. Seal that FressianStream block, writing the headers. Call that block id\n B.\n b. Write a new version of the history block with a new chunk appended: B.\n c. Write a new index block with the new history block version.\n\n This ensures that if we crash during the run, we can recover at least some\n of the history up to the most recent checkpoint.\n\n 5. Write the results as a PartialMap to blocks 4 and 5: 4 containing the\n :valid? field, and 5 containing the rest of the results.\n\n 6. The test may contain state which changed by the end of the test, and we\n might want to save that state. Write the entire test map again as block 6,\n again using block 1 as the history, and now block 5 as the results map. Write\n a new index block with block 6 as the root.\n\n To read this file, we:\n\n 1. Check the magic and version.\n\n 2. Read the index block offset.\n\n 3. Read the index block into memory.\n\n 4. Look up the root block ID, use the index to work out its offset, read that\n block, and decode it into a lazy map structure.\n\n When it comes time to reference the results or history in that lazy map, we\n look up the right block in the block index, seek to that offset, and decode\n whatever's there.\n\n Decoding a block is straightforward. We grab the length header, run a CRC\n over that region of the file, check the block type, then decode the remaining\n data based on the block structure.\"\n (:require [byte-streams :as bs]\n [clojure [set :as set]\n [walk :as walk]]\n [clojure.data.fressian :as fress]\n [clojure.tools.logging :refer [info warn]]\n [clojure.core.reducers :as r]\n [clojure.java.io :as io]\n [dom-top.core :refer [assert+]]\n [jepsen [history :as history]\n [util :as util :refer [map-vals\n with-thread-name]]\n [fs-cache :refer [write-atomic!]]]\n [jepsen.history.core :refer [soft-chunked-vector]]\n [jepsen.store.fressian :as jsf]\n [potemkin :refer [def-map-type\n definterface+]]\n [clj-commons.slingshot :refer [try+ throw+]])\n (:import (java.io BufferedOutputStream\n Closeable\n EOFException\n File\n InputStream\n OutputStream\n PipedInputStream\n PipedOutputStream)\n (java.nio ByteBuffer)\n (java.nio.channels FileChannel\n FileChannel$MapMode)\n (java.nio.file StandardOpenOption)\n (java.util Arrays)\n (java.util.concurrent ArrayBlockingQueue\n BlockingQueue\n ForkJoinTask)\n (java.util.function Consumer)\n (java.util.zip CRC32)\n (jepsen.history.core SoftChunkedVector)\n (jepsen.store.format FileOffsetOutputStream)\n (org.fressian.handlers WriteHandler\n ReadHandler)))\n\n(def magic\n \"The magic string at the start of Jepsen files.\"\n \"JEPSEN\")\n\n(def magic-size\n \"Bytes it takes to store the magic string.\"\n (count magic))\n\n(def magic-offset\n \"Where the magic is written\"\n 0)\n\n(def current-version\n \"The current file version.\n\n Version 0 was the first version of the file format.\n\n Version 1 added support for FressianStream and BigVector blocks.\"\n 1)\n\n(def version-size\n \"Bytes it takes to store a version.\"\n 4)\n\n(def version-offset\n \"Where in the file the version begins\"\n (+ magic-offset magic-size))\n\n(def block-id-size\n \"How many bytes per block ID?\"\n 4)\n\n(def block-offset-size\n \"How many bytes per block offset address?\"\n 8)\n\n(def block-index-offset-offset\n \"Where in the file do we write the offset of the index block?\"\n (+ version-offset version-size))\n\n(def first-block-offset\n \"Where in the file the first block begins.\"\n (+ block-index-offset-offset block-offset-size))\n\n;; Block Headers\n\n(def block-len-size\n \"How long is the length prefix for a block?\"\n 8)\n\n(def block-len-offset\n \"Where do we write a block length in a block header?\"\n 0)\n\n(def block-checksum-size\n \"How long is the checksum for a block?\"\n 4)\n\n(def block-checksum-offset\n \"Where do we write a checksum in the block header?\"\n (+ block-len-offset block-len-size))\n\n(def block-type-size\n \"How long is the type for a block?\"\n 16)\n\n(def block-type-offset\n \"Where do we store the block type in a block header?\"\n (+ block-checksum-offset block-checksum-size))\n\n(def short->block-type\n \"A map of integers to block types.\"\n {(short 1) :block-index\n (short 2) :fressian\n (short 3) :partial-map\n (short 4) :fressian-stream\n (short 5) :big-vector})\n\n(def block-type->short\n \"A map of block types to integer codes.\"\n (->> short->block-type (map (juxt val key)) (into {})))\n\n(def block-header-size\n \"How long is a block header?\"\n (+ block-len-size block-checksum-size block-type-size))\n\n(def big-vector-count-size\n \"How many bytes do we use to store a bigvector's count?\"\n 8)\n\n(def big-vector-index-size\n \"How many bytes do we use to store a bigvector element's index?\"\n 8)\n\n;; Perf tuning\n\n(def large-region-size\n \"How big does a file region have to be before we just mmap it instead of\n doing file reads?\"\n (* 1024 1024)) ; 1M\n\n(def fressian-buffer-size\n \"How many bytes should we buffer before writing Fressian data to disk?\"\n 16384) ; 16K\n\n(def big-vector-chunk-size\n \"How many elements should we write to a chunk of a BigVector before starting\n a new one?\"\n 16384)\n\n(defrecord BlockRef [^int id])\n\n(defn block-ref\n \"Constructs a new BlockRef object pointing to the given block ID.\"\n [id]\n (BlockRef. id))\n\n(defrecord Handle\n [^FileChannel file ; The filechannel we use for reads and writes\n version ; An atom: what version is this file? Initially nil.\n block-index ; An atom to a block index: a map of block IDs to offsets\n written? ; An atom: have we written to this file yet?\n read? ; An atom: have we read this file yet?\n ]\n\n Closeable\n (close [this]\n (reset! block-index :closed)\n (.close file)))\n\n(defn version\n \"Returns the version of a Handle.\"\n [^Handle handle]\n @(.version handle))\n\n(defn ^Handle open\n \"Constructs a new handle for a Jepsen file of the given path (anything which\n works with io/file).\"\n [path]\n (let [path (-> path io/file .toPath)\n f (FileChannel/open path\n (into-array StandardOpenOption\n [StandardOpenOption/CREATE\n StandardOpenOption/READ\n StandardOpenOption/WRITE]))\n block-index (atom {:root nil\n :blocks {}})]\n (Handle. f (atom nil) block-index (atom false) (atom false))))\n\n(defn close!\n \"Closes a Handle\"\n [^Closeable handle]\n (.close handle)\n nil)\n\n(defn flush!\n \"Flushes writes to a Handle to disk.\"\n [handle]\n (.force ^FileChannel (:file handle) false)\n handle)\n\n; General IO routines\n\n(defn write-file!\n \"Takes a FileChannel, an offset, and a ByteBuffer. Writes the ByteBuffer to\n the FileChannel at the given offset completely. Returns number of bytes\n written.\"\n [^FileChannel file offset ^ByteBuffer buffer]\n (let [size (.remaining ^ByteBuffer buffer)\n written (.write file buffer offset)]\n ; Gonna punt on this for now because the position semantics are\n ; tricky and I'm kinda hoping we never hit it\n (assert+ (= size written)\n {:type ::incomplete-write\n :offset offset\n :expected size\n :actual written})\n written))\n\n(defn ^ByteBuffer read-file\n \"Returns a ByteBuffer corresponding to a given file region. Uses mmap for\n large regions, or regular read calls for small ones.\"\n [^FileChannel file, ^long offset, ^long size]\n (if (<= size large-region-size)\n ; Small region: read directly\n (let [buf (ByteBuffer/allocate size)\n bytes-read (.read file buf offset)]\n (assert+ (= size bytes-read)\n {:type ::incomplete-read\n :offset offset\n :expected size\n :actual bytes-read})\n (.rewind buf))\n ; Big region: mmap\n (.map file FileChannel$MapMode/READ_ONLY offset size)))\n\n; General file headers\n\n(defn write-header!\n \"Takes a Handle and writes the initial magic bytes and version number.\n Initializes the handle's version to current-version if it hasn't already been\n set. Returns handle.\"\n [^Handle handle]\n (swap! (.version handle) (fn [v]\n (if (or (nil? v)\n (= v current-version))\n current-version\n (throw+\n {:type ::can't-write-old-version\n :current-version current-version\n :handle-version v}))))\n (let [buf (ByteBuffer/allocate (+ magic-size version-size))\n file ^FileChannel (:file handle)]\n (.position file 0)\n (bs/transfer magic file {:close? false})\n (.putInt buf (version handle))\n (.flip buf)\n (write-file! file version-offset buf))\n handle)\n\n(defn check-magic\n \"Takes a Handle and reads the magic bytes, ensuring they match.\"\n [handle]\n (let [file ^FileChannel (:file handle)\n buf (ByteBuffer/allocate magic-size)]\n (let [read-bytes (.read file buf magic-offset)\n _ (.flip buf)\n fmagic (bs/convert buf String)]\n (when (or (not= magic-size read-bytes)\n (not= magic fmagic))\n (throw+ {:type ::magic-mismatch\n :expected magic\n :actual (if (= -1 read-bytes)\n :eof\n fmagic)}))))\n handle)\n\n(defn check-version!\n \"Takes a Handle and reads the version. Ensures it's a version we can decode,\n and updates the Handle's version if it hasn't already been set.\"\n [^Handle handle]\n (let [file ^FileChannel (:file handle)\n buf (ByteBuffer/allocate version-size)\n read-bytes (.read file buf version-offset)\n fversion (.getInt buf 0)]\n (when-not (= version-size read-bytes)\n (throw+ {:type ::version-incomplete\n :expected version-size\n :actual read-bytes}))\n (when-not (contains? #{0 1} fversion)\n (throw+ {:type ::version-mismatch\n :expected version\n :actual (if (= -1 read-bytes)\n :eof\n fversion)}))\n (swap! (.version handle) (fn [v]\n (if (or (nil? v)\n (= fversion v))\n fversion\n (throw+ {:type ::can't-load-mixed-version\n :handle-version v\n :file-version fversion}))))\n handle))\n\n(defn prep-write!\n \"Called when we write anything to a handle. Ensures that we've written the\n header before doing anything else. Returns handle.\"\n [handle]\n (when (compare-and-set! (:written? handle) false true)\n (write-header! handle))\n handle)\n\n(declare load-block-index!)\n\n(defn prep-read!\n \"Called when we read anything from a handle. Ensures that we've checked the\n magic, version, and loaded the block index.\"\n [handle]\n (when (compare-and-set! (:read? handle) false true)\n (-> handle check-magic check-version! load-block-index!))\n handle)\n\n; Fetching and updating the block index offset root pointer\n\n(defn write-block-index-offset!\n \"Takes a handle and the offset of a block index block to use as the new root.\n Updates the file's block pointer. Returns handle.\"\n [handle root]\n (let [buf (ByteBuffer/allocate block-offset-size)]\n (.putLong buf 0 root)\n (write-file! (:file handle) block-index-offset-offset buf))\n handle)\n\n(defn read-block-index-offset\n \"Takes a handle and returns the current root block index offset from its\n file. Throws :type ::no-block-index if the block index is 0 or the file is\n too short.\"\n [handle]\n (try+\n (let [buf ^ByteBuffer (read-file (:file handle)\n block-index-offset-offset\n block-offset-size)\n offset (.getLong buf 0)]\n (when (zero? offset)\n (throw+ {:type ::no-block-index}))\n offset)\n (catch [:type ::incomplete-read] e\n (throw+ {:type ::no-block-index}))))\n\n; Working with block headers\n\n(defn ^ByteBuffer block-header\n \"Returns a blank ByteBuffer for a block header. All fields zero.\"\n []\n (ByteBuffer/allocate block-header-size))\n\n(defn block-header-type\n \"Returns the type of a block header, as a keyword.\"\n [^ByteBuffer header]\n (short->block-type (.getShort header block-type-offset)))\n\n(defn set-block-header-type!\n \"Sets the type (a keyword) in a block header. Returns the header.\"\n [^ByteBuffer buf block-type]\n (let [type-short (assert+ (block-type->short block-type)\n {:type ::no-such-block-type\n :block-type block-type})]\n (.putShort buf block-type-offset type-short)))\n\n(defn block-header-length\n \"Fetches the length of a block header.\"\n [^ByteBuffer header]\n (.getLong header block-len-offset))\n\n(defn set-block-header-length!\n \"Sets the length in a block header. Returns the block header.\"\n [^ByteBuffer buf length]\n (.putLong buf block-len-offset length))\n\n(defn block-header-checksum\n \"Fetches the checksum of a block header.\"\n [^ByteBuffer header]\n (.getInt header block-checksum-offset))\n\n(defn set-block-header-checksum!\n \"Sets the checksum in a block header. Returns the block header.\"\n [^ByteBuffer buf checksum]\n (.putInt buf block-checksum-offset checksum))\n\n(defn block-checksum-given-data-checksum\n \"Computes the checksum of a block, given a ByteBuffer header, and an\n already-computed CRC32 checksum of the data. Useful for streaming writers\n which compute their own checksums while writing. Mutates data-crc in place; I\n can't figure out how to safely copy it.\"\n [^ByteBuffer header, ^CRC32 data-crc]\n (let [header' (-> (block-header)\n (set-block-header-type! (block-header-type header))\n (set-block-header-length! (block-header-length header)))]\n (.update data-crc ^ByteBuffer header')\n (unchecked-int (.getValue data-crc))))\n\n(defn ^Integer block-checksum\n \"Compute the checksum of a block, given two bytebuffers: one for the header,\n and one for the data.\"\n [header, ^ByteBuffer data]\n (let [c (CRC32.)]\n (.rewind data)\n ;(bs/print-bytes data)\n (.update c data)\n (block-checksum-given-data-checksum header c)))\n\n(defn check-block-checksum\n \"Verifies the checksum of a block, given two ByteBuffers: one for the header,\n and one for the data.\"\n [^ByteBuffer header ^ByteBuffer data]\n (let [expected (block-header-checksum header)\n actual (block-checksum header data)]\n (assert+ (= expected actual)\n {:type ::checksum-mismatch\n :expected expected\n :actual actual})))\n\n(defn ^ByteBuffer read-block-header\n \"Fetches the ByteBuffer for a block header at the given offset.\"\n [handle ^long offset]\n (let [file ^FileChannel (:file handle)\n buf (block-header)\n read-bytes (.read file buf offset)]\n (assert+ (= read-bytes block-header-size)\n {:type ::block-header-truncated\n :offset offset\n :length (max 0 read-bytes)})\n ;(info :read-block-header :offset offset\n ; :type (block-header-type buf)\n ; :length (block-header-length buf)\n ; :checksum (block-header-checksum buf))\n (.rewind buf)\n buf))\n\n(defn ^ByteBuffer read-block-data\n \"Fetches the ByteBuffer for a block's data, given a block header stored at\n the given offset.\"\n [handle offset header]\n (let [file ^FileChannel (:file handle)\n data-length (- (block-header-length header) block-header-size)\n buf (ByteBuffer/allocateDirect data-length)\n read-bytes (.read file buf (+ offset block-header-size))]\n ;(info :read-block-data :offset offset\n ; :block-header-size block-header-size\n ; :data-length data-length\n ; :data \"\\n\"\n ; (with-out-str (bs/print-bytes (.rewind buf))))\n (assert+ (= read-bytes data-length)\n {:type ::block-data-truncated\n :offset offset\n :expected data-length\n :actual read-bytes})\n (.rewind buf)\n buf))\n\n(defn write-block-header!\n \"Writes a block header to the given offset in the file backed by the given\n handle. Returns handle.\"\n [handle ^long offset ^ByteBuffer block-header]\n (.rewind block-header)\n (let [written (.write ^FileChannel (:file handle) block-header offset)]\n (assert+ (= written block-header-size)\n {:type ::block-header-write-failed\n :written written\n :expected block-header-size}))\n ;(info :wrote-block-header :offset offset\n ; :type (block-header-type block-header)\n ; :length (block-header-length block-header)\n ; :checksum (block-header-checksum block-header))\n handle)\n\n(defn write-block-data!\n \"Writes block data to the given block offset (e.g. the address of the header,\n not the data itself) in the file, backed by the given handle. Returns\n handle.\"\n [handle ^long offset ^ByteBuffer data]\n (.rewind data)\n (write-file! (:file handle) (+ offset block-header-size) data)\n handle)\n\n(defn ^ByteBuffer block-header-for-length-and-checksum!\n \"An optimized way to construct a block header, a block type, the length of a\n data region (not including headers) and the CRC checksum of that data.\n Mutates the checksum in place.\"\n [block-type data-length data-checksum]\n (let [header (block-header)]\n (-> header\n (set-block-header-type! block-type)\n (set-block-header-length! (+ block-header-size data-length))\n (set-block-header-checksum! (block-checksum-given-data-checksum\n header data-checksum)))))\n\n(defn ^ByteBuffer block-header-for-data\n \"Takes a block type and a ByteBuffer of data, and constructs a block header\n whose type is the given type, and which has the appropriate length and\n checksum for the given data.\"\n [block-type ^ByteBuffer data]\n (let [header (block-header)]\n (-> header\n (set-block-header-type! block-type)\n (set-block-header-length! (+ block-header-size (.limit data)))\n (set-block-header-checksum! (block-checksum header data)))))\n\n(defn write-block!\n \"Writes a block to a handle at the given offset, given a block type as a\n keyword and a ByteBuffer for the block's data. Returns handle.\"\n [handle ^long offset block-type data]\n (-> handle\n (write-block-header! offset (block-header-for-data block-type data))\n (write-block-data! offset data)))\n\n(defn read-block-by-offset*\n \"Takes a Handle and the offset of a block. Reads the block header and data,\n validates the checksum, and returns a map of:\n\n {:header header, as bytebuffer\n :data data, as bytebuffer}\"\n [handle offset]\n (let [file ^FileChannel (:file handle)\n header (read-block-header handle offset)\n data (read-block-data handle offset header)]\n (check-block-checksum header data)\n (.rewind data)\n {:header header\n :data data}))\n\n(declare read-block-index-block\n read-fressian-block\n read-partial-map-block\n read-fressian-stream-block\n read-big-vector-block)\n\n(defn read-block-by-offset\n \"Takes a Handle and the offset of a block. Reads the block header, validates\n the checksum, and interprets the block data depending on the block type.\n Returns a map of:\n\n {:type The block type, as a keyword\n :offset The offset of this block\n :length How many bytes are in this block, total\n :data The interpreted data stored in this block---depends on block type}\"\n [handle offset]\n (prep-read! handle)\n (let [{:keys [header data]} (read-block-by-offset* handle offset)\n type (block-header-type header)]\n {:type type\n :offset offset\n :length (block-header-length header)\n :data (case type\n :block-index (read-block-index-block handle data)\n :fressian (read-fressian-block handle data)\n :partial-map (read-partial-map-block handle data)\n :fressian-stream (read-fressian-stream-block handle data)\n :big-vector (read-big-vector-block handle data))}))\n\n;; Block indices\n\n(defn new-block-id!\n \"Takes a handle and returns a fresh block ID for that handle, mutating the\n handle so that this ID will not be allocated again.\"\n [handle]\n (let [index (:block-index handle)\n bs (:blocks @index)\n id (int (if (empty? bs)\n 1 ; Blocks start at 1\n (inc (reduce max (keys bs)))))]\n (swap! index assoc-in [:blocks id] :reserved)\n id))\n\n(defn next-block-offset\n \"Takes a handle and returns the offset of the next block. Right now this is\n just the end of the file.\"\n [handle]\n (max (.size ^FileChannel (:file handle))\n first-block-offset))\n\n(defn assoc-block!\n \"Takes a handle, a block ID, and its corresponding offset. Updates the\n handle's block index (in-memory) to add this mapping. Returns handle.\"\n [handle id offset]\n (swap! (:block-index handle) assoc-in [:blocks id] offset)\n handle)\n\n(defn set-root!\n \"Takes a handle and a block ID. Updates the handle's block index (in-memory)\n to point to this block ID as the root. Returns handle.\"\n [handle root-id]\n (swap! (:block-index handle) assoc :root root-id)\n handle)\n\n(defn block-index-data-size\n \"Takes a block index and returns the number of bytes required for that block\n to be written, NOT including headers.\"\n [index]\n (+ block-id-size\n (* (count (:blocks index))\n (+ block-id-size block-offset-size))))\n\n(defn write-block-index!\n \"Writes a block index for a Handle, based on whatever that Handle's current\n block index is. Automatically generates a new block ID for this index and\n adds it to the handle as well. Then writes a new block index offset pointing\n to this block index. Returns handle.\"\n ([handle]\n (let [id (new-block-id! handle)\n offset (next-block-offset handle)\n _ (assoc-block! handle id offset)]\n (write-block-index! handle offset)))\n ([handle offset]\n (prep-write! handle)\n (let [file ^FileChannel (:file handle)\n index @(:block-index handle)\n data (ByteBuffer/allocate (block-index-data-size index))]\n ; Write the root ID\n (.putInt data (or (:root index) (int 0)))\n ; And each block mapping\n (doseq [[id offset] (:blocks index)]\n (when-not (= :reserved offset)\n (.putInt data id)\n (.putLong data offset)))\n (.flip data)\n\n ; Write the header and data to the file.\n (write-block! handle offset :block-index data)\n ; And the block index offset\n (write-block-index-offset! handle offset))\n handle))\n\n(defn read-block-index-block\n \"Takes a ByteBuffer and reads a block index from it: a map of\n\n {:root root-id\n :blocks {id offset, id2 offset2, ...}}\"\n [handle ^ByteBuffer data]\n (let [root (.getInt data)]\n (loop [index (transient {})]\n (if (.hasRemaining data)\n (let [id (.getInt data)\n offset (.getLong data)]\n (recur (assoc! index id offset)))\n {:root (if (zero? root) nil root)\n :blocks (persistent! index)}))))\n\n(defn load-block-index!\n \"Takes a handle, reloads its block index from disk, and returns handle.\"\n [handle]\n (let [block (read-block-by-offset handle (read-block-index-offset handle))]\n (assert+ (= :block-index (:type block))\n {:type ::block-type-mismatch\n :expected :block-index\n :actual (:type block)})\n (reset! (:block-index handle) (:data block))\n ;(info :block-index (:data block))\n )\n handle)\n\n(defn read-block-by-id\n \"Takes a handle and a logical block id. Looks up the offset for the given\n block and reads it using read-block-by-offset (which includes verifying the\n checksum).\"\n [handle id]\n (assert (instance? Integer id)\n (str \"Block ids are integers, not \" (class id) \" - \" (pr-str id)))\n (prep-read! handle)\n (if-let [offset (get-in @(:block-index handle) [:blocks id])]\n (read-block-by-offset handle offset)\n (throw+ {:type ::block-not-found\n :id id\n :known-block-ids (sort (keys (:blocks @(:block-index handle))))})))\n\n(defn read-root\n \"Takes a handle. Looks up the root block from the current block index and\n reads it. Returns nil if there is no root.\"\n [handle]\n (prep-read! handle)\n (when-let [root (:root @(:block-index handle))]\n (read-block-by-id handle root)))\n\n;; Fressian blocks\n\n(def fressian-write-handlers\n \"How do we write Fressian data?\"\n (-> jsf/write-handlers*\n (assoc jepsen.store.format.BlockRef\n {\"block-ref\" (reify WriteHandler\n (write [_ w block-ref]\n (.writeTag w \"block-ref\" 1)\n (.writeObject w (:id block-ref))))})\n fress/associative-lookup\n fress/inheritance-lookup))\n\n(def fressian-read-handlers\n \"How do we read Fressian data?\"\n (-> jsf/read-handlers*\n (assoc \"block-ref\" (reify ReadHandler\n (read [_ rdr tag component-count]\n (block-ref (int (.readObject rdr))))))\n fress/associative-lookup))\n\n(defn write-fressian-to-file!\n \"Takes a FileChannel, an offset, a checksum, and a data structure as\n Fressian. Writes the data structure as Fressian to the file at the given\n offset. Returns the size of the data that was just written, in bytes. Mutates\n checksum with written bytes.\"\n [^FileChannel file, ^long offset, ^CRC32 checksum, data]\n ; First, write the data to the file directly; then we'll go back and write\n ; the header.\n (with-open [foos (FileOffsetOutputStream.\n file offset checksum)\n bos (BufferedOutputStream.\n foos fressian-buffer-size)\n w ^Closeable (jsf/writer\n bos {:handlers fressian-write-handlers})]\n (jsf/write-object+ {:handlers fressian-write-handlers} w data)\n (.flush bos)\n (.bytesWritten foos)))\n\n(defn write-fressian-block!*\n \"Takes a handle, a byte offset, and some Clojure data. Writes that data to a\n Fressian block at the given offset. Returns handle.\"\n [handle offset data]\n ; First, write the data to the file directly; then we'll go back and write\n ; the header.\n (let [data-offset (+ offset block-header-size)\n checksum (CRC32.)\n data-size (write-fressian-to-file!\n (:file handle) data-offset checksum data)\n ; Construct a ByteBuffer over the region we just wrote\n ;TODO: unused?\n data-buf (read-file (:file handle) data-offset data-size)\n ; And build our header\n header (block-header-for-length-and-checksum!\n :fressian data-size checksum)]\n ; Now write the header; data's already in the file.\n (write-block-header! handle offset header)\n handle))\n\n(defn write-fressian-block!\n \"Takes a handle, an optional block ID, and some Clojure data. Writes that\n data to a Fressian block at the end of the file, records the new block in the\n handle's block index, and returns the ID of the newly written block.\"\n ([handle data]\n (write-fressian-block! handle (new-block-id! handle) data))\n ([handle id data]\n (let [offset (next-block-offset handle)]\n (-> handle\n (write-fressian-block!* offset data)\n (assoc-block! id offset))\n id)))\n\n(defn read-fressian-block\n \"Takes a handle and a ByteBuffer of data from a Fressian block. Returns its\n parsed contents.\"\n [handle ^ByteBuffer data]\n (with-open [is (bs/to-input-stream data)\n r ^Closeable (jsf/reader\n is {:handlers fressian-read-handlers})]\n (fress/read-object r)))\n\n;; Fressian stream blocks\n\n(defrecord FressianStreamBlockWriter\n [handle\n ^int block-id\n ^long offset\n ^CRC32 checksum\n ^FileOffsetOutputStream file-offset-output-stream\n ^BufferedOutputStream buffered-output-stream\n ^Closeable fressian-writer]\n\n Closeable\n (close [this]\n (.close fressian-writer)\n ; We have to make sure anything we wrote to the stream is actually flushed\n (.flush buffered-output-stream)\n (.close file-offset-output-stream)\n ; Now we write the block header\n (let [data-size (.bytesWritten file-offset-output-stream)\n header (block-header-for-length-and-checksum!\n :fressian-stream data-size checksum)]\n (write-block-header! handle offset header)\n (assoc-block! handle block-id offset))))\n\n(defn fressian-stream-block-writer!\n \"Takes a handle. Creates a new block ID, and prepares to write a new\n FressianStream block at the end of the file. Returns a\n FressianStreamBlockWriter which can be used to write elements to the\n FressianStream. When closed, the writer writes the block header and updates\n the handle's block index to refer to the new block.\"\n [handle]\n (let [offset (next-block-offset handle)\n data-offset (+ offset block-header-size)\n block-id (new-block-id! handle)\n checksum (CRC32.)\n file (:file handle)\n foos (FileOffsetOutputStream. file data-offset checksum)\n bos (BufferedOutputStream. foos fressian-buffer-size)\n fw (jsf/writer bos {:handlers fressian-write-handlers})]\n (FressianStreamBlockWriter. handle block-id offset checksum foos bos fw)))\n\n(defn append-to-fressian-stream-block!\n \"Takes a FressianStreamBlockWriter and a Clojure value. Appends that value as\n Fressian to the stream. Returns writer.\"\n [^FressianStreamBlockWriter writer data]\n (fress/write-object (.fressian-writer writer) data)\n writer)\n\n(defn read-fressian-stream-block\n \"Takes a handle and a ByteBuffer of data from a FressianStream block. Returns\n its contents as a vector.\"\n [handle ^ByteBuffer data]\n (with-open [is (bs/to-input-stream data)\n r ^Closeable (jsf/reader\n is {:handlers fressian-read-handlers})]\n (loop [v (transient [])]\n (let [element (try (fress/read-object r)\n (catch EOFException _ ::eof))]\n (if (identical? element ::eof)\n (persistent! v)\n (recur (conj! v element)))))))\n\n;; BigVector blocks\n\n(defn write-big-vector-block!\n \"Takes a handle, a block ID, a count, and a vector of [initial-index\n block-id] chunks. Writes a BigVector block with the given count and chunks to\n the end of the file. Records the freshly written block in the handle's block\n index, and returns ID.\"\n [handle id element-count chunks]\n (let [offset (next-block-offset handle)\n data-size (+ big-vector-count-size\n (* (count chunks)\n (+ big-vector-index-size block-id-size)))\n buf (ByteBuffer/allocate data-size)]\n ; Write element count\n (.putLong buf element-count)\n ; Write chunks\n (doseq [[initial-index block-id] chunks]\n (.putLong buf initial-index)\n (.putInt buf block-id))\n (.flip buf)\n (write-block! handle offset :big-vector buf)\n (assoc-block! handle id offset)\n id))\n\n(defrecord BigVectorBlockWriter\n [^int block-id, ^BlockingQueue queue, worker]\n Closeable\n (close [this]\n (.put queue ::finished)\n @worker))\n\n(defn big-vector-block-writer-worker!\n \"Loop which writes values from a BigVectorBlockWriter's queue to disk.\"\n [handle block-id elements-per-chunk ^BlockingQueue queue]\n (try\n (loop [; Number of elements written to completed blocks. We use\n ; this for the initial block index of each streaming\n ; block.\n completed-count 0\n ; How many elements have we written to the current,\n ; uncompleted chunk?\n uncompleted-count 0\n ; Vector of [initial-index block-id] chunks\n chunks []\n ; Streaming block writer for current chunk\n ^Closeable chunk-writer\n (fressian-stream-block-writer! handle)]\n ; Write elements\n (let [element (.take queue)]\n (if (= ::finished element)\n ; Wrap up!\n (do (.close chunk-writer)\n (let [chunks (conj chunks [completed-count\n (:block-id chunk-writer)])]\n (write-big-vector-block! handle\n block-id\n (+ completed-count uncompleted-count)\n chunks)\n (write-block-index! handle)))\n ; Write element\n (if (< uncompleted-count elements-per-chunk)\n ; Room in this chunk\n (do (append-to-fressian-stream-block! chunk-writer element)\n (recur completed-count\n (inc uncompleted-count)\n chunks\n chunk-writer))\n ; Chunk full; seal and start a fresh one\n (do (.close chunk-writer)\n (let [chunks (conj chunks [completed-count\n (:block-id chunk-writer)])\n completed-count (+ completed-count uncompleted-count)]\n (write-big-vector-block! handle\n block-id\n completed-count\n chunks)\n (write-block-index! handle)\n (let [writer' (fressian-stream-block-writer! handle)]\n (append-to-fressian-stream-block! writer' element)\n (recur completed-count 1 chunks writer'))))))))\n (catch Throwable t\n (warn t \"Big vector block writer crashed!\")\n (throw t))))\n\n(defn big-vector-block-writer!\n \"Takes a handle, a optional block ID, and the maximum number of elements per\n chunk. Returns a BigVectorBlockWriter which can have elements appended to it\n via append-to-big-vector-block!. Those elements, in turn, are appended to a\n series of newly created FressianStream blocks, each of which is stitched\n together into a BigVector block with the given ID. As each chunk of writes is\n finished, the writer automatically writes a new block index, ensuring we can\n recover at least part of the history from crashes.\n\n The writer is asynchronous: it internally spawns a thread for serialization\n and IO. Appends to the writer are transferred to the IO thread via a\n queue; the IO thread then writes them to disk. Closing the\n writer blocks until the transfer queue is exhausted.\"\n ([handle elements-per-chunk]\n (big-vector-block-writer! handle (new-block-id! handle) elements-per-chunk))\n ([handle block-id elements-per-chunk]\n ; The queue here is twice the size of a chunk--we don't want to sprint ahead\n ; of the writer *too* far, but we definitely need to buffer at least a full\n ; chunk while the previous chunk is being sealed off.\n (let [queue (ArrayBlockingQueue. (* 2 elements-per-chunk))\n worker (future\n (with-thread-name \"jepsen history writer\"\n (big-vector-block-writer-worker! handle\n block-id\n elements-per-chunk\n queue)))]\n (BigVectorBlockWriter. block-id queue worker))))\n\n(defn append-to-big-vector-block!\n \"Appends an element to a BigVector block writer. This function is\n asynchronous and returns as soon as the writer's queue has accepted the\n element. Close the writer to complete the process. Returns writer.\"\n [^BigVectorBlockWriter w element]\n (.put ^BlockingQueue (.queue w) element)\n w)\n\n(defn read-big-vector-block\n \"Takes a handle and a ByteBuffer for a big-vector block. Returns a lazy\n vector (specifically, a soft chunked vector) representing its data.\"\n [handle ^ByteBuffer buf]\n (let [count (.getLong buf)\n chunk-count (/ (- (.limit buf) big-vector-count-size)\n (+ big-vector-index-size block-id-size))\n indices (long-array chunk-count)\n block-ids (int-array chunk-count)\n chunks (object-array chunk-count)\n chunk-locks (object-array (take chunk-count (repeatedly #(Object.))))]\n ; Read chunk indices and block IDs\n (loop [i 0]\n (if (= i chunk-count)\n ; Done\n (let [load-chunk (fn load-chunk [i]\n (->> (aget block-ids i)\n (read-block-by-id handle)\n :data))]\n ; We pack the block IDs into the vector's name field so we can GC\n ; later. Sort of a hack but ah well.\n (soft-chunked-vector {:block-ids block-ids}\n count indices load-chunk))\n ; Read first index & block ID\n (do (aset-long indices i (.getLong buf))\n (aset-int block-ids i (.getInt buf))\n (recur (inc i)))))))\n\n;; Partial map blocks\n\n(defn write-partial-map-block!*\n \"Takes a handle, a byte offset, a Clojure map, and the ID of the block which\n stores the rest of the map (use `nil` if there is no more to the PartialMap).\n Writes the map and rest pointer to a PartialMap block at the given offset.\n Returns handle.\"\n [handle offset m rest-id]\n (assert (map? m))\n (let [; First, write the rest pointer to the file\n file (:file handle)\n checksum (CRC32.)\n rest-buf (doto (ByteBuffer/allocate block-id-size)\n (.putInt 0 (if rest-id (int rest-id) 0))\n .rewind)\n rest-offset (+ offset block-header-size)\n _ (write-file! file rest-offset rest-buf)\n _ (.update checksum (.rewind rest-buf))\n ; Next, stream the map as Fressian to the rest of the block.\n map-size (write-fressian-to-file!\n file\n (+ rest-offset block-id-size)\n checksum\n m)\n ; And construct a buffer over the entire block data region\n data-buf (read-file file rest-offset (+ block-id-size map-size))\n ; And construct our header\n header (block-header-for-length-and-checksum!\n :partial-map (+ block-id-size map-size) checksum)]\n ; Write header\n (write-block-header! handle offset header))\n handle)\n\n(defn write-partial-map-block!\n \"Takes a handle, a Clojure map, and the ID of the block which stores the rest\n of the map (use `nil` if there is no more data to the PartialMap). Writes the\n map to a new PartialMap block, records it in the handle's block index, and\n returns the ID of this block itself. Optionally takes an explicit ID for this\n block.\"\n ([handle m rest-id]\n (write-partial-map-block! handle (new-block-id! handle) m rest-id))\n ([handle id m rest-id]\n (let [offset (next-block-offset handle)]\n (-> handle\n (write-partial-map-block!* offset m rest-id)\n (assoc-block! id offset))\n id)))\n\n; A lazy map structure which has a map m and a *rest-map*: a Delay which can\n; unpack to another PartialMap (presumably by reading another block in the\n; file).\n(defprotocol IPartialMap\n (partial-map-rest-id [this]))\n\n(def-map-type PartialMap [m rest-id rest-map metadata]\n (get [this key default-value]\n ; Try to retrieve from this map, or from the rest map.\n (if (contains? m key)\n (get m key)\n (get @rest-map key default-value)))\n\n (assoc [this key value]\n ; We associate onto the top-level map.\n (PartialMap. (assoc m key value) rest-id rest-map metadata))\n\n (dissoc [this key]\n ; Here we have to strip out the key at every level\n (PartialMap. (dissoc m key)\n rest-id\n (delay (dissoc @rest-map key))\n metadata))\n\n (keys [this]\n ; We unify keys at all levels recursively.\n (distinct (concat (keys m) (keys @rest-map))))\n\n (meta [this]\n metadata)\n\n (with-meta [this metadata']\n (PartialMap. m rest-id rest-map metadata'))\n\n IPartialMap\n (partial-map-rest-id [this]\n rest-id))\n\n(defn read-partial-map-block\n \"Takes a handle and a ByteBuffer for a partial-map block. Returns a lazy map\n representing its data.\"\n [handle ^ByteBuffer data]\n (let [; Read next ID\n rest-id (.getInt data)\n rest-id (when-not (zero? rest-id) rest-id)\n ; And read map\n m (with-open [is (bs/to-input-stream data)\n r ^Closeable (jsf/reader is)]\n (fress/read-object r))\n ; Construct a lazy delay for the rest of the partialmap. Zero denotes\n ; there's no more.\n rest-map (delay\n (when rest-id\n (let [block (read-block-by-id handle rest-id)]\n (assert+ (= :partial-map (:type block))\n {:type ::block-type-mismatch\n :expected :partial-map\n :actual (:type block)})\n (:data block))))]\n ; Construct lazy map\n (PartialMap. m rest-id rest-map {})))\n\n;; Test-specific writing\n\n(defn write-initial-test!\n \"Writes an initial test to a handle, making the test the root. Creates an\n (initially nil) block for the history. Called when we first begin a test.\n Returns test with additional metadata, so we can write the history and\n results later.\"\n [handle test]\n (let [history-id (write-fressian-block! handle nil)\n id (write-fressian-block!\n handle (assoc test :history (block-ref history-id)))]\n (-> handle (set-root! id) write-block-index!)\n (vary-meta test assoc ::history-id history-id)))\n\n(defn ^BigVectorBlockWriter test-history-writer!\n \"Takes a handle and a test created with write-initial-test!, and returns a\n BigVectorBlockWriter for writing operations to the history. Append elements\n using `append-to-big-vector-block!`, and .close the writer when done.\"\n ([handle test]\n (test-history-writer! handle test big-vector-chunk-size))\n ([handle test chunk-size]\n (let [history-id (::history-id (meta test))\n _ (assert+ (integer? history-id)\n {:type ::no-history-id-in-meta})]\n (big-vector-block-writer! handle\n history-id\n chunk-size))))\n\n(defn write-test-with-history!\n \"Takes a handle and a test created with write-initial-test!, and writes it\n again as the root. Used for rewriting a test after running it, but before\n analysis, in case there's state that changed. Returns test.\"\n [handle test]\n (let [history-id (::history-id (meta test))\n _ (assert+ (integer? history-id)\n {:type ::no-history-id-in-meta})\n test-id (write-fressian-block!\n handle\n (assoc test :history (block-ref history-id)))]\n (-> handle (set-root! test-id) write-block-index!)\n test))\n\n(defn write-test-with-results!\n \"Takes a handle and a test created with write-initial-test!, and appends its\n :results as a partial map block: :valid? in the top tier, and other results\n below. Writes test using those results and history blocks. Returns test, with\n ::results-id metadata pointing to the block ID of these results.\"\n [handle test]\n (prep-read! handle)\n (let [history-id (::history-id (meta test))\n _ (assert+ (integer? history-id)\n {:type ::no-history-id-in-meta})\n results (:results test)\n more-id (write-partial-map-block!\n handle (dissoc results :valid?) nil)\n results-id (write-partial-map-block!\n handle (select-keys results [:valid?]) more-id)\n test-id (write-fressian-block!\n handle\n (assoc test\n :history (block-ref history-id)\n :results (block-ref results-id)))]\n (-> handle (set-root! test-id) write-block-index!)\n (vary-meta test assoc ::results-id results-id)))\n\n(defn write-test!\n \"Writes an entire test map to a handle, making the test the root. Useful for\n re-writing a completed test that's already in memory, and migrating existing\n Fressian tests to the new format. Returns handle.\"\n [handle test]\n (let [; Where will we store the remainder of the :results field?\n more-results-id (new-block-id! handle)\n\n ; Write the minimal part of the results\n results (:results test)\n results-id (write-partial-map-block! handle\n (select-keys results [:valid?])\n more-results-id)\n ; And the rest of the results\n _ (write-partial-map-block! handle\n more-results-id\n (dissoc results :valid?)\n nil)\n ; Next, the history\n history-id (write-fressian-block! handle (:history test))\n\n ; And finally, the test\n test (assoc test\n :history (block-ref history-id)\n :results (block-ref results-id))\n test-id (write-fressian-block! handle test)]\n (-> handle\n (set-root! test-id)\n write-block-index!)))\n\n(def-map-type LazyTest [m history results metadata]\n (get [this key default-value]\n (condp identical? key\n :history (if history @history default-value)\n :results (if results @results default-value)\n (get m key default-value)))\n\n (assoc [this key value]\n (condp identical? key\n :history (LazyTest. m (deliver (promise) value) results metadata)\n :results (LazyTest. m history (deliver (promise) value) metadata)\n (LazyTest. (assoc m key value) history results metadata)))\n\n (dissoc [this key]\n (condp identical? key\n :history (LazyTest. m nil results metadata)\n :results (LazyTest. m history nil metadata)\n (LazyTest. (dissoc m key) history results metadata)))\n\n (keys [this]\n (cond-> (keys m)\n history (conj :history)\n results (conj :results)))\n\n (meta [this]\n metadata)\n\n (with-meta [this metadata']\n (LazyTest. m history results metadata')))\n\n(defn read-test\n \"Reads a test from a handle's root. Constructs a lazy test map where history\n and results are loaded as-needed from the file. Leave the handle open so this\n map can use it; it'll be automatically closed when this map is GCed. Includes\n metadata so that this test can be rewritten using write-results!\"\n [handle]\n (let [test (:data (read-root handle))\n h (:history test)\n r (:results test)\n history (when h\n (delay\n (when-let [ops (:data (read-block-by-id handle (:id h)))]\n (history/history\n ops\n (if (<= 1 (version handle))\n ; In version 1, we started writing ops as Ops and\n ; assigning indices on write.\n {:dense-indices? true\n :have-indices? true\n :already-ops? true}\n ; Before that, we wrote ops as maps without indices\n {})))))\n results (when r\n (delay (:data (read-block-by-id handle (:id r)))))]\n (LazyTest. (dissoc test :history :results)\n history\n results\n {::history-id (:id h)\n ::results-id (:id r)})))\n\n\n;; Garbage collection\n\n(defn find-references\n \"A little helper function for finding BlockRefs in a nested data structure.\n Returns the IDs of all BlockRefs.\"\n [x]\n (let [refs (atom #{})]\n (walk/postwalk (fn find [x]\n (when (instance? BlockRef x)\n (swap! refs conj (:id x)))\n x)\n x)\n @refs))\n\n(defn block-references\n \"Takes a handle and a block ID, and returns the set of all block IDs which\n that block references. Right now we do this by parsing the block data; later\n we might want to move references into block headers. With no block ID,\n returns references from the root.\"\n ([handle]\n (if-let [root (:root @(:block-index handle))]\n (conj (block-references handle root) root)\n #{}))\n ([handle block-id]\n (let [block (read-block-by-id handle block-id)\n shallow-refs\n (case (:type block)\n :block-index #{}\n :fressian (find-references (:data block))\n :partial-map (if-let [id (partial-map-rest-id (:data block))]\n #{id}\n #{})\n :fressian-stream (find-references (:data block))\n :big-vector (-> (.name ^SoftChunkedVector (:data block))\n :block-ids\n set))]\n (->> shallow-refs\n (map (partial block-references handle))\n (cons shallow-refs)\n (reduce set/union)))))\n\n(defn copy!\n \"Takes two handles: a reader and a writer. Copies the root and any other\n referenced blocks from reader to writer.\"\n [r w]\n (prep-read! r)\n (prep-write! w)\n (when-let [root (:root @(:block-index r))]\n (let [r-file ^FileChannel (:file r)\n w-file ^FileChannel (:file w)\n block-index @(:block-index r)\n ; What blocks are reachable from the root?\n block-ids (block-references r)\n ; Fetch lengths and offsets for those block IDs\n headers (->> block-ids\n (map (fn get-header [block-id]\n (let [offset (get-in block-index\n [:blocks block-id])\n header (read-block-header r offset)]\n [block-id\n {:length (block-header-length header)\n :offset offset}])))\n (into {}))\n ; Order these: root first, then by size, small blocks first\n block-ids (->> (disj block-ids root)\n (sort-by (comp :length headers))\n (cons root))\n ; Work out new block index. Bit of a hack here: we want to write our\n ; block index at the start of the file, which means all the other\n ; offsets depend on it, so we need to know exactly how big it is.\n ; We'll use block-index-size, which doesn't actually care about the\n ; blocks themselves; just how many there are. We add an extra `nil`\n ; block for the block index block itself.\n block-index-size (+ block-header-size\n (block-index-data-size\n {:blocks (cons nil block-ids)}))\n ; Now work out the IDS and offsets for our new index\n block-index'\n (loop [; Offset in new file\n offset (+ first-block-offset\n block-index-size)\n ; Remaining old block IDs\n block-ids block-ids\n ; New block index\n block-index' {:blocks {}}]\n (if-not (seq block-ids)\n block-index'\n (let [block-id (first block-ids)\n length (:length (get headers block-id))\n offset' (+ offset length)]\n (recur (+ offset length)\n (next block-ids)\n (cond-> (assoc-in block-index'\n [:blocks block-id]\n offset)\n ; If this is the root block, update root too\n (= root block-id) (assoc :root block-id))))))]\n ; Clobber writer's block index\n (reset! (:block-index w) block-index')\n ; Write block index. Make sure we're actually starting where we think\n ; we are...\n (assert (= first-block-offset (next-block-offset w)))\n (write-block-index! w)\n ; And that we finish at the offset we thought we would...\n (assert+ (= (+ first-block-offset block-index-size)\n (next-block-offset w))\n {:type ::unexpected-block-index-size\n :expected block-index-size\n :actual (- (next-block-offset w) first-block-offset)})\n\n ; Copy remaining blocks in order\n (.position w-file ^long (+ first-block-offset\n block-index-size))\n (doseq [block-id block-ids]\n (let [{:keys [offset length]} (get headers block-id)\n copied (.transferTo r-file offset length w-file)]\n (when-not (= length copied)\n (throw+ {:type ::copy-failed\n :expected-bytes length\n :copied-bytes copied})))))))\n\n(defn gc!\n \"Garbage-collects a file (anything that works with io/file) in-place.\"\n [file]\n (write-atomic! [tmp (io/file file)]\n (with-open [r ^Closeable (open file)\n w ^Closeable (open tmp)]\n (copy! r w))))\n" }, { "path": "jepsen/src/jepsen/store/fressian.clj", "content": "(ns jepsen.store.fressian\n \"Supports serialization of various Jepsen datatypes via Fressian.\"\n (:require [clojure.data.fressian :as fress]\n [clojure.java.io :as io]\n [clojure [datafy :refer [datafy]]\n [walk :as walk]]\n [clojure.tools.logging :refer [info warn]]\n [clj-time.local :as time.local]\n [clj-time.format :as time.format]\n [multiset.core :as multiset]\n [jepsen [history]\n [print :refer [pprint]]\n [util :as util]]\n [clj-commons.slingshot :refer [try+ throw+]])\n (:import (java.io ByteArrayOutputStream\n Closeable)\n (java.time Instant)\n (java.util AbstractList\n Collections\n HashMap)\n (jepsen.history Op)\n (jepsen.store FressianReader)\n (org.fressian.handlers ConvertList\n WriteHandler\n ReadHandler)\n (multiset.core MultiSet)))\n\n(def write-handlers*\n (-> {clojure.lang.Atom\n {\"atom\" (reify WriteHandler\n (write [_ w a]\n (.writeTag w \"atom\" 1)\n (.writeObject w @a)))}\n\n org.joda.time.DateTime\n {\"date-time\" (reify WriteHandler\n (write [_ w t]\n (.writeTag w \"date-time\" 1)\n (.writeObject w (time.local/format-local-time\n t :basic-date-time))))}\n\n clojure.lang.PersistentHashSet\n {\"persistent-hash-set\" (reify WriteHandler\n (write [_ w set]\n (.writeTag w \"persistent-hash-set\" 1)\n (.writeObject w (seq set))))}\n\n clojure.lang.PersistentTreeSet\n {\"persistent-sorted-set\" (reify WriteHandler\n (write [_ w set]\n (.writeTag w \"persistent-sorted-set\" 1)\n (.writeObject w (seq set))))}\n\n clojure.lang.MapEntry\n {\"map-entry\" (reify WriteHandler\n (write [_ w e]\n (.writeTag w \"map-entry\" 2)\n (.writeObject w (key e))\n (.writeObject w (val e))))}\n\n multiset.core.MultiSet\n {\"multiset\" (reify WriteHandler\n (write [_ w set]\n (.writeTag w \"multiset\" 1)\n (.writeObject w (multiset/multiplicities set))))}\n\n\n java.lang.Throwable\n {\"throwable\" (reify WriteHandler\n (write [_ w e]\n (warn e \"Can't fully serialize Throwable as Fressian\")\n (.writeTag w \"throwable\" 1)\n (.writeObject w (datafy e))))}\n\n java.time.Instant\n {\"instant\" (reify WriteHandler\n (write [_ w instant]\n (.writeTag w \"instant\" 1)\n (.writeObject w (.toString instant))))}\n\n jepsen.history.Op\n {\"jepsen.history.Op\" (reify WriteHandler\n (write [_ w op]\n ; We cache type and f. Thought about process,\n ; but I think they might be too\n ; high-cardinality.\n (.writeTag w \"jepsen.history.Op\" 7)\n (.writeInt w (.index ^Op op))\n (.writeInt w (.time ^Op op))\n (.writeObject w (.type ^Op op) true)\n (.writeObject w (.process ^Op op))\n (.writeObject w (.f ^Op op) true)\n (.writeObject w (.value ^Op op))\n (.writeObject w (.__extmap ^Op op))))}}\n (merge fress/clojure-write-handlers)))\n\n(def write-handlers\n (-> write-handlers*\n fress/associative-lookup\n fress/inheritance-lookup))\n\n(def read-handlers*\n (-> {\"atom\" (reify ReadHandler\n (read [_ rdr tag component-count]\n (atom (.readObject rdr))))\n\n \"date-time\" (reify ReadHandler\n (read [_ rdr tag component-count]\n (time.format/parse\n (:basic-date-time time.local/*local-formatters*)\n (.readObject rdr))))\n\n \"persistent-hash-set\" (reify ReadHandler\n (read [_ rdr tag component-count]\n (assert (= 1 component-count))\n (into #{} (.readObject rdr))))\n\n \"persistent-sorted-set\" (reify ReadHandler\n (read [_ rdr tag component-count]\n (assert (= 1 component-count))\n (into (sorted-set) (.readObject rdr))))\n\n \"jepsen.history.Op\" (reify ReadHandler\n (read [_ r tag component-count]\n (assert (= 7 component-count))\n (Op. (.readInt r) ; index\n (.readInt r) ; time\n (.readObject r) ; type\n (.readObject r) ; process\n (.readObject r) ; f\n (.readObject r) ; value\n nil ; meta\n (.readObject r) ; extmap\n )))\n\n \"map-entry\" (reify ReadHandler\n (read [_ rdr tag component-count]\n (clojure.lang.MapEntry. (.readObject rdr)\n (.readObject rdr))))\n\n \"multiset\" (reify ReadHandler\n (read [_ rdr tag component-count]\n (multiset/multiplicities->multiset\n (.readObject rdr))))\n\n \"instant\" (reify ReadHandler\n (read [_ rdr tag component-count]\n (Instant/parse (.readObject rdr))))\n\n \"vec\" (reify ReadHandler\n (read [_ rdr tag component-count]\n (vec (.readObject rdr))))}\n\n (merge fress/clojure-read-handlers)))\n\n(def read-handlers\n (fress/associative-lookup read-handlers*))\n\n(defn postprocess-fressian\n \"DEPRECATED: we now decode vectors directly in the Fressian reader.\n\n Fressian likes to give us ArrayLists, which are kind of a PITA when you're\n used to working with vectors.\n\n We now write sequential types as their own vector wrappers, which means this\n is not necessary going forward, but I'm leaving this in place in case you\n have historical tests you need to re-process.\"\n [obj]\n (info \"jepsen.store.fressian/postprocess-fressian is no longer necessary; our reader decodes lists directly as vectors.\")\n (walk/prewalk (fn transform [x]\n (cond (instance? clojure.lang.Atom x)\n (atom (postprocess-fressian @x))\n\n (instance? AbstractList x)\n (vec x)\n\n :else x))\n obj))\n\n(defn reader\n \"Creates a Fressian reader given an InputStream. Options:\n\n :handlers Read handlers\"\n ([input-stream]\n (reader input-stream {}))\n ([input-stream opts]\n (FressianReader. input-stream\n (:handlers opts read-handlers)\n false)))\n\n(defn writer\n \"Creates a Fressian writer given an OutputStream. Options:\n\n :handlers Write handlers\"\n ([output-stream]\n (writer output-stream {}))\n ([output-stream opts]\n (fress/create-writer output-stream\n :handlers (:handlers opts write-handlers))))\n\n(defn write-object+\n \"Takes options for `writer`, a Fressian writer, and an object `x`. Writes `x`\n object to the given writer. If the write fails due to an unknown handler,\n backs up, traverses the structure of `x`, and determines the path to the\n specific part which could not be serialized, throwing a more specific error.\n Uses `writer-opts` to create new writers for this debugging process, if\n necessary.\"\n ([writer-opts writer x]\n (try (fress/write-object writer x)\n (catch IllegalArgumentException e\n (if (re-find #\"^Cannot write .+ as tag null\" (.getMessage e))\n (do (write-object+ writer-opts writer [] x)\n ; Uh, if we got here, something went wrong\n (throw+ {:type ::not-fressian-serializable-not-reproducible\n :class (class x)\n :x x}\n e))\n ; Some other exception\n (throw e)))))\n ; Debugging path\n ([writer-opts _ path x]\n (if-let [e (with-open [; Make a writer\n bos (ByteArrayOutputStream.)\n w ^Closeable (writer bos writer-opts)]\n ; Try writing x\n (try (fress/write-object w x)\n nil\n (catch IllegalArgumentException e e)))]\n ; Can't write this!\n (or (cond ; For sequential collections, try each index in turn\n (sequential? x)\n (->> x\n (map-indexed (fn seq-traversal [i x]\n (write-object+ writer-opts writer\n (conj path i) x)))\n (remove nil?)\n first)\n\n ; For maps, try each key\n (map? x)\n (->> x\n (map (fn map-traversal [[k x]]\n (write-object+ writer-opts nil (conj path k) x)))\n (remove nil?)\n first)\n\n ; Not traversable; this is the end!\n true\n false)\n ; Either this was non-traversable OR every piece of this collection\n ; was serializable.\n (throw+ {:type ::not-fressian-serializable\n :path path\n :class (class x)\n :object x}\n e))\n ; Can write this; move on.\n nil)))\n" }, { "path": "jepsen/src/jepsen/store.clj", "content": "(ns jepsen.store\n \"Persistent storage for test runs and later analysis.\"\n (:refer-clojure :exclude [load test])\n (:require [clojure.data.fressian :as fress]\n [clojure.edn :as edn]\n [clojure.java.io :as io]\n [clojure [string :as str]\n [walk :as walk]]\n [clojure.tools.logging :refer :all]\n [clj-time.core :as time]\n [clj-time.local :as time.local]\n [clj-time.coerce :as time.coerce]\n [clj-time.format :as time.format]\n [unilog.config :as unilog]\n [multiset.core :as multiset]\n [jepsen [fs-cache :refer [write-atomic!]]\n [print :refer [pprint]]\n [util :as util]]\n [jepsen.store [fressian :as jsf]\n [format :as store.format]])\n (:import (java.util AbstractList)\n (java.io Closeable\n File)\n (java.nio.file Files\n FileSystems\n Path)\n (java.nio.file.attribute FileAttribute\n PosixFilePermissions)\n (java.time Instant)\n (org.fressian.handlers WriteHandler ReadHandler)\n (multiset.core MultiSet)))\n\n(def ^String base-dir \"store\")\n\n; These were moved into their own namespace, and are here for backwards\n; compatibility\n(def write-handlers jsf/write-handlers)\n(def read-handlers jsf/read-handlers)\n\n(defn ^File path\n \"With one arg, a test, returns the directory for that test's results. Given\n additional arguments, returns a file with that name in the test directory.\n Nested paths are flattened: (path t [:a [:b :c] :d) expands to .../a/b/c/d.\n Nil path components are ignored: (path t :a nil :b) expands to .../a/b.\n\n Test must have only two keys: :name, and :start-time. :start-time may be a\n string, or a DateTime.\"\n ([test]\n (assert (:name test))\n (assert (:start-time test))\n (io/file base-dir\n (:name test)\n (let [t (:start-time test)]\n (if (string? t)\n t\n (time.local/format-local-time t :basic-date-time)))))\n ([test & args]\n (->> args\n flatten\n (remove nil?)\n (map str)\n (apply io/file (path test)))))\n\n(defn ^File path!\n \"Like path, but ensures the path's containing directories exist.\"\n [& args]\n (let [path (apply path args)]\n (io/make-parents path)\n path))\n\n(defn ^File jepsen-file\n \"Gives the path to a .jepsen file encoding all the results from a test.\"\n [test]\n (path test \"test.jepsen\"))\n\n(defn ^File jepsen-file!\n \"Gives the path to a .jepsen file, ensuring its directory exists.\"\n [test]\n (path! test \"test.jepsen\"))\n\n(defn ^File fressian-file\n \"Gives the path to a fressian file encoding all the results from a test.\"\n [test]\n (path test \"test.fressian\"))\n\n(defn ^File fressian-file!\n \"Gives the path to a fressian file encoding all the results from a test,\n ensuring its containing directory exists.\"\n [test]\n (path! test \"test.fressian\"))\n\n(def default-nonserializable-keys\n \"What keys in a test can't be serialized to disk, by default?\"\n #{:barrier :db :os :net :client :checker :nemesis :generator :model :remote\n :store})\n\n(defn nonserializable-keys\n \"What keys in a test can't be serialized to disk? The union of default\n nonserializable keys, plus any in :nonserializable-keys.\"\n [test]\n (into default-nonserializable-keys (:nonserializable-keys test)))\n\n(defn serializable-test\n \"Takes a test and returns it without its serializable keys.\"\n [test]\n (apply dissoc test (nonserializable-keys test)))\n\n(defn load-fressian-file\n \"Loads an arbitrary Fressian file.\"\n [file]\n (with-open [is (io/input-stream file)\n in ^Closeable (jsf/reader is)]\n (fress/read-object in)))\n\n(defn load-jepsen-file\n \"Loads a test from an arbitrary Jepsen file. This is lazy, and retains a\n filehandle which will remain open until all references to this test are gone\n and the GC kicks in.\"\n [file]\n (store.format/read-test (store.format/open file)))\n\n(defn load\n \"Loads a specific test, either given a map with {:name ... :start-time ...},\n or by name and time as separate arguments. Prefers to load a .jepsen file,\n falls back to .fressian.\"\n ([test]\n (let [jepsen (jepsen-file test)\n fressian (fressian-file test)]\n (if (.exists jepsen)\n (load-jepsen-file jepsen)\n (load-fressian-file fressian))))\n ([test-name test-time]\n (load {:name test-name\n :start-time test-time})))\n\n(defn class-name->ns-str\n \"Turns a class string into a namespace string (by translating _ to -)\"\n [class-name]\n (str/replace class-name #\"_\" \"-\"))\n\n(defn edn-tag->constructor\n \"Takes an edn tag and returns a constructor fn taking that tag's value and\n building an object from it.\"\n [tag]\n (let [c (resolve tag)]\n (when (nil? c)\n (throw (RuntimeException. (str \"EDN tag \" (pr-str tag) \" isn't resolvable to a class\"))))\n\n (when-not ((supers c) clojure.lang.IRecord)\n (throw (RuntimeException.\n (str \"EDN tag \" (pr-str tag)\n \" looks like a class, but it's not a record,\"\n \" so we don't know how to deserialize it.\"))))\n\n (let [; Translate from class name \"foo.Bar\" to namespaced constructor fn\n ; \"foo/map->Bar\"\n constructor-name (-> (name tag)\n class-name->ns-str\n (str/replace #\"\\.([^\\.]+$)\" \"/map->$1\"))\n constructor (resolve (symbol constructor-name))]\n (when (nil? constructor)\n (throw (RuntimeException.\n (str \"EDN tag \" (pr-str tag) \" looks like a record, but we don't\"\n \" have a map constructor \" constructor-name \" for it\"))))\n constructor)))\n\n(def memoized-edn-tag->constructor (memoize edn-tag->constructor))\n\n(defn default-edn-reader\n \"We use defrecords heavily and it's nice to be able to deserialize them.\"\n [tag value]\n (if-let [c (memoized-edn-tag->constructor tag)]\n (c value)\n (throw (RuntimeException.\n (str \"Don't know how to read edn tag \" (pr-str tag))))))\n\n(defn load-results-edn\n \"Loads the results map for a test by parsing the result.edn file, instead of\n test.jepsen.\"\n [test]\n (with-open [file (java.io.PushbackReader.\n (io/reader (path test \"results.edn\")))]\n (edn/read {:default default-edn-reader} file)))\n\n(defn load-results\n \"Loads the results map for a test by name and time. Prefers a lazy map from\n test.fressian; falls back to parsing results.edn.\"\n [test-name test-time]\n (let [test {:name test-name, :start-time test-time}\n jepsen (jepsen-file test)]\n (if (.exists jepsen)\n (:results (load-jepsen-file jepsen))\n (load-results-edn test))))\n\n(def memoized-load-results (memoize load-results))\n\n(defn dir?\n \"Is this a directory?\"\n [^File f]\n (.isDirectory f))\n\n(defn file-name\n \"Maps a File to a string name.\"\n [^File f]\n (.getName f))\n\n(defn virtual-dir?\n \"Is this a . or .. directory entry?\"\n [f]\n (let [n (file-name f)]\n (or (= n \".\")\n (= n \"..\"))))\n\n(defn symlink?\n \"Is this a symlink?\"\n [^File f]\n (Files/isSymbolicLink (.toPath f)))\n\n(defn test-names\n \"Returns a seq of all known test names.\"\n []\n (->> (io/file base-dir)\n (.listFiles)\n (remove virtual-dir?)\n (remove symlink?)\n (filter dir?)\n (map file-name)))\n\n(defn tests\n \"If given a test name, returns a map of test runs to deref-able tests. With\n no test name, returns a map of test names to maps of runs to deref-able\n tests.\"\n ([]\n (->> (test-names)\n (map (juxt identity tests))\n (into {})))\n ([test-name]\n (assert test-name)\n (->> test-name\n name\n (io/file base-dir)\n (.listFiles)\n (remove virtual-dir?)\n (remove symlink?)\n (filter dir?)\n (map file-name)\n (map (fn [f] [f (delay (load test-name f))]))\n (into {}))))\n\n(defn all-tests\n \"A plain old vector of test delays, sorted in chronological order. Unlike\n `tests`, attempts to load tests with no .fressian or .jepsen file will return\n `nil` here, instead of throwing. Helpful when you want to slice and dice all\n tests at the REPL.\"\n []\n (->> (tests)\n (mapcat val)\n (sort)\n (map val)\n (map (fn [test-delay] (delay (try @test-delay\n (catch java.io.FileNotFoundException e\n nil)))))))\n\n(defn test\n \"Like `load`, loads a specific test. Frequently you don't care about\n individual test names; you just want \\\"the last test\\\", or \\\"the third most\n recent\\\". This function can take:\n\n - A Long. (test 0) returns the first test ever run; (test 2) loads the\n third. (test -1) loads the most recent test; -2 the\n next-to-most-recent.\n\n - A String. Can be a directory name, in which case we look for a\n test.jepsen in that directory.\"\n [which]\n (condp instance? which\n Long (let [tests-by-time (all-tests)\n i (if (neg? which)\n (+ (count tests-by-time) which)\n which)]\n (-> tests-by-time (nth i) deref))\n\n String (load-jepsen-file (io/file which \"test.jepsen\"))))\n\n(defn write-jepsen!\n \"Takes a test and saves it as a .jepsen binary file.\"\n [test]\n (write-atomic! [tmp (path! test \"test.jepsen\")]\n (with-open [w (store.format/open tmp)]\n (store.format/write-test! w (serializable-test test))))\n test)\n\n(defn migrate-to-jepsen-format!\n \"Loads every test and copies their Fressian files to the new on-disk\n format.\"\n []\n (->> (tests)\n vals\n (mapcat vals)\n (pmap (fn [test]\n (let [t1 (System/nanoTime)]\n (try\n (when-not (.exists (path @test \"test.jepsen\"))\n (let [t2 (System/nanoTime)\n _ (write-jepsen! @test)\n t3 (System/nanoTime)]\n (info \"Migrated\" (str (path @test))\n \"in\" (float (* 1e-9 (- t2 t1)))\n \"+\" (float (* 1e-9 (- t3 t2))) \"seconds\")))\n (catch java.io.FileNotFoundException _\n ; No file; don't worry about it.\n )\n (catch java.io.EOFException _\n ; File truncated, probably crashed during write\n (warn \"Couldn't migrate test; .fressian truncated\"))\n (catch Exception e\n (warn e \"Couldn't migrate test\"))))))\n dorun))\n\n(defn latest\n \"Loads the latest test\"\n []\n (when-let [t (->> (tests)\n vals\n (apply concat)\n sort\n util/fast-last\n val)]\n @t))\n\n(defn update-symlink!\n \"Takes a test and a symlink path. Creates a symlink from that path to the\n test directory, if it exists.\"\n [test dest]\n (when (.exists (path test))\n (let [src (.toPath (path test))\n dest (.. FileSystems\n getDefault\n (getPath base-dir (into-array dest)))\n _ (Files/deleteIfExists dest)]\n (Files/createSymbolicLink dest (.relativize (.getParent dest) src)\n (make-array FileAttribute 0)))))\n\n(defn update-current-symlink!\n \"Creates a `current` symlink to the currently running test, if a store\n directory exists.\"\n [test]\n (update-symlink! test [\"current\"]))\n\n(defn update-symlinks!\n \"Creates `latest` and `current` symlinks to the given test, if a store\n directory exists.\"\n [test]\n (doseq [dest [[\"current\"]\n [\"latest\"]\n [(:name test) \"latest\"]]]\n (update-symlink! test dest)))\n\n(defmacro with-out-file\n \"Binds stdout to a file for the duration of body.\"\n [test filename & body]\n `(let [filename# (path! ~test ~filename)]\n (with-open [w# (io/writer filename#)]\n (try\n (binding [*out* w#] ~@body)\n (finally\n (info \"Wrote\" (.getCanonicalPath filename#)))))))\n\n(defn write-results!\n \"Writes out a results.edn file.\"\n [test]\n (with-out-file test \"results.edn\"\n (pprint (:results test))))\n\n(defn write-history!\n \"Writes out history.txt and history.edn files.\"\n [test]\n (->> [(future\n (util/with-thread-name \"jepsen history.txt\"\n (util/pwrite-history! (path! test \"history.txt\") (:history test))))\n (future\n (util/with-thread-name \"jepsen history.edn\"\n (util/pwrite-history! (path! test \"history.edn\") prn\n (:history test))))]\n (map deref)\n dorun))\n\n(defn write-fressian-file!\n \"Writes a data structure to the given file, as Fressian. For instance:\n\n (write-fressian-file! {:foo 2} (path! test \\\"foo.fressian\\\")).\"\n [data file]\n (with-open [os (io/output-stream file)\n out ^Closeable (jsf/writer os)]\n (fress/write-object out data)))\n\n(defn write-fressian!\n \"Write the entire test as a .fressian file.\"\n [test]\n (write-fressian-file! (serializable-test test) (fressian-file! test)))\n\n; Top-level API for writing tests\n\n(defn close!\n \"Takes a test map and closes its store handle, if one exists. Returns test\n without store handle.\"\n [test]\n (when-let [handle (:handle (:store test))]\n (store.format/close! handle))\n (update test :store dissoc :handle))\n\n(defmacro with-handle\n \"Takes a binding symbol and a test expression. Opens a store.format handle\n for writing and reading test data, and evaluates body with that handle open,\n closing it automatically at the end of the block. Within block, test-sym is\n bound to test-expr, but with a special key :store :handle being the writer\n handle. Returns the value of the body.\n\n The generator interpreter, save-0, save-1, etc. use this handle to\n write and read test data as the test is run.\"\n [[test-sym test-expr] & body]\n `(with-open [handle# (store.format/open (jepsen-file! ~test-expr))]\n (let [~test-sym (assoc-in ~test-expr [:store :handle] handle#)]\n ~@body)))\n\n(defn save-0!\n \"Writes a test at the start of a test run. Updates symlinks. Returns a new\n version of test which should be used for subsequent writes.\"\n [test]\n (let [stest (serializable-test test)\n stest' (store.format/write-initial-test! (:handle (:store test))\n stest)]\n (update-current-symlink! test)\n (vary-meta test merge (meta stest'))))\n\n(defn save-1!\n \"Phase 1: after completing the history, writes test.jepsen and history files\n to disk and updates latest symlinks. Returns test with metadata which should\n be preserved for calls to save-2!\"\n [test]\n (let [stest (serializable-test test)\n jepsen (future (util/with-thread-name \"jepsen format\"\n (store.format/write-test-with-history!\n (:handle (:store test)) stest)))\n history (future (util/with-thread-name \"jepsen history\"\n (write-history! stest)))]\n @jepsen @history\n (update-symlinks! test)\n ; We want to merge the jepsen writer's metadata back into the original test.\n (vary-meta test merge (meta @jepsen))))\n\n(defn save-2!\n \"Phase 2: after computing results, we update the .jepsen file and write\n results as EDN. Returns test with metadata that should be preserved for\n future save calls.\"\n [test]\n (let [stest (serializable-test test)\n jepsen (future (util/with-thread-name \"jepsen format\"\n (store.format/write-test-with-results!\n (:handle (:store test)) stest)))\n results (future (util/with-thread-name \"jepsen results\"\n (write-results! stest)))]\n @jepsen @results\n (update-symlinks! test)\n ; Return the Jepsen writer's results; it's got metadata.\n (vary-meta test merge (meta @jepsen))))\n\n(def console-appender\n {:appender :console\n :pattern \"%p\\t[%t] %c: %m%n\"})\n\n(def default-logging-overrides\n \"Logging overrides that we apply by default\"\n ; SSHJ loves to spew log errors everywhere when your SSH dir doesn't contain\n ; literally every kind of key.\n {\"net.schmizz.concurrent.Promise\" :off\n \"net.schmizz.sshj.transport.random.JCERandom\" :warn\n \"net.schmizz.sshj.transport.TransportImpl\" :warn\n \"net.schmizz.sshj.connection.channel.direct.SessionChannel\" :warn\n \"clj-libssh2.session\" :warn\n \"clj-libssh2.authentication\" :warn\n \"clj-libssh2.known-hosts\" :warn\n \"clj-libssh2.ssh\" :warn\n \"clj-libssh2.channel\" :warn})\n\n(defn start-logging!\n \"Starts logging to a file in the test's directory. Also updates current\n symlink. Test may include a :logging key, which should be a map with the\n following optional options:\n\n {:overrides A map of packages to log level keywords}\n\n Test may also include a :logging-json? flag, which produces JSON structured\n Jepsen logs.\"\n [test]\n (unilog/start-logging!\n {:level \"info\"\n :console false\n :appenders [console-appender\n {:appender :file\n :encoder (if (:logging-json? test) :json :pattern)\n :pattern \"%d{ISO8601}{GMT}\\t%p\\t[%t] %c: %m%n\"\n :file (.getCanonicalPath (path! test \"jepsen.log\"))}]\n :overrides (merge default-logging-overrides\n (:overrides (:logging test)))})\n (update-current-symlink! test))\n\n(defn stop-logging!\n \"Resets logging to console only.\"\n []\n (unilog/start-logging!\n {:level \"info\"\n :console false\n :appenders [console-appender]}))\n\n(defn delete-file-recursively!\n [^File f]\n (let [func (fn [func ^File f]\n (when (.isDirectory f)\n (doseq [f2 (.listFiles f)]\n (func func f2)))\n (clojure.java.io/delete-file f))]\n (func func (clojure.java.io/file f))))\n\n(defn delete!\n \"Deletes all tests, or all tests under a given name, or, if given a date as\n well, a specific test.\"\n ([]\n (dorun (map delete! (test-names))))\n ([test-name]\n (dorun (map delete! (repeat test-name) (keys (tests test-name)))))\n ([test-name test-time]\n (delete-file-recursively! (path {:name test-name, :start-time test-time}))))\n" }, { "path": "jepsen/src/jepsen/tests/adya.clj", "content": "(ns jepsen.tests.adya\n \"Generators and checkers for tests of Adya's proscribed behaviors for\n weakly-consistent systems. See http://pmg.csail.mit.edu/papers/adya-phd.pdf\"\n (:require [jepsen [client :as client]\n [checker :as checker]\n [generator :as gen]\n [independent :as independent]]\n [clojure.core.reducers :as r]\n [clojure.set :as set]))\n\n(defn g2-gen\n \"With concurrent, unique keys, emits pairs of :insert ops of the form [key\n [a-id b-id]], where one txn has a-id and the other has b-id. a-id and b-id\n are globally unique. Only two insert ops are generated for any given key.\n Keys and ids are positive integers.\n\n G2 clients use two tables:\n\n create table a (\n id int primary key,\n key int,\n value int\n );\n create table b (\n id int primary key,\n key int,\n value int\n );\n\n G2 clients take operations like {:f :insert :value [key [a-id nil]]}, and in\n a single transaction, perform a read of tables a and b like so:\n\n select * from a where key = ? and value % 3 = 0\n select * from b where key = ? and value % 3 = 0\n\n and fail if either query returns more than zero rows. If both tables are\n empty, the client should insert a row like\n\n {:key key :id a-id :value 30}\n\n into table a, if a-id is present. If b-id is present, insert into table b\n instead. Iff the insert succeeds, return :type :ok with the operation value\n unchanged.\n\n We're looking to detect violations based on *predicates*; databases may\n prevent anti-dependency cycles with individual primary keys, but selects\n based on predicates might observe stale data. Clients should feel free to\n choose predicates and values in creative ways.\"\n []\n (let [ids (atom 0)]\n (independent/concurrent-generator\n 2\n (range)\n (fn [k]\n [(gen/once (fn [_ _]\n {:type :invoke :f :insert :value [nil (swap! ids inc)]}))\n (gen/once (fn [_ _]\n {:type :invoke :f :insert :value [(swap! ids inc) nil]}))]))))\n\n(defn g2-checker\n \"Verifies that at most one :insert completes successfully for any given key.\"\n []\n (reify checker/Checker\n (check [this test history opts]\n ; There should be at most one successful insert for any given key\n (let [keys (reduce (fn [m op]\n (if (= :insert (:f op))\n (let [k (key (:value op))]\n (if (= :ok (:type op))\n (update m k (fnil inc 0))\n (update m k #(or % 0))))\n m))\n {}\n history)\n insert-count (->> keys\n (filter (fn [[k cnt]] (pos? cnt)))\n count)\n illegal (->> keys\n (keep (fn [[k cnt :as pair]]\n (when (< 1 cnt) pair)))\n (into (sorted-map)))]\n {:valid? (empty? illegal)\n :key-count (count keys)\n :legal-count (- insert-count (count illegal))\n :illegal-count (count illegal)\n :illegal illegal}))))\n" }, { "path": "jepsen/src/jepsen/tests/bank.clj", "content": "(ns jepsen.tests.bank\n \"Helper functions for doing bank tests, where you simulate transfers between\n accounts, and verify that reads always show the same balance. The test map\n should have these additional options:\n\n :accounts A collection of account identifiers.\n :total-amount Total amount to allocate.\n :max-transfer The largest transfer we'll try to execute.\"\n (:refer-clojure :exclude [read test])\n (:require [clojure.core.reducers :as r]\n [jepsen [checker :as checker]\n [generator :as gen]\n [history :as h]\n [random :as rand]\n [store :as store]\n [util :as util]]\n [jepsen.checker.perf :as perf]\n [gnuplot.core :as g]))\n\n(defn read\n \"A generator of read operations.\"\n [_ _]\n {:type :invoke, :f :read})\n\n(defn transfer\n \"Generator of a transfer: a random amount between two randomly selected\n accounts.\"\n [test _]\n {:type :invoke\n :f :transfer\n :value {:from (rand/nth (:accounts test))\n :to (rand/nth (:accounts test))\n :amount (+ 1 (rand/long (:max-transfer test)))}})\n\n(def diff-transfer\n \"Transfers only between different accounts.\"\n (gen/filter (fn [op] (not= (-> op :value :from)\n (-> op :value :to)))\n transfer))\n\n(defn generator\n \"A mixture of reads and transfers for clients.\"\n []\n (gen/mix [diff-transfer read]))\n\n(defn err-badness\n \"Takes a bank error and returns a number, depending on its type. Bigger\n numbers mean more egregious errors.\"\n [test err]\n (case (:type err)\n :unexpected-key (count (:unexpected err))\n :nil-balance (count (:nils err))\n :wrong-total (Math/abs (float (/ (- (:total err) (:total-amount test))\n (:total-amount test))))\n :negative-value (- (reduce + (:negative err)))))\n\n(defn check-op\n \"Takes a single op and returns errors in its balance\"\n [accts total negative-balances? op]\n (let [ks (keys (:value op))\n balances (vals (:value op))]\n (cond (not-every? accts ks)\n {:type :unexpected-key\n :unexpected (remove accts ks)\n :op op}\n\n (some nil? balances)\n {:type :nil-balance\n :nils (->> (:value op)\n (remove val)\n (into {}))\n :op op}\n\n (not= total (reduce + balances))\n {:type :wrong-total\n :total (reduce + balances)\n :op op}\n\n (and (not negative-balances?) (some neg? balances))\n {:type :negative-value\n :negative (filter neg? balances)\n :op op})))\n\n(defn checker\n \"Verifies that all reads must sum to (:total test), and, unless\n :negative-balances? is true, checks that all balances are\n non-negative.\"\n [checker-opts]\n (reify checker/Checker\n (check [this test history opts]\n (let [accts (set (:accounts test))\n total (:total-amount test)\n reads (->> history\n (h/filter (h/has-f? :read))\n h/oks)\n errors (->> reads\n (r/map (partial check-op\n accts\n total\n (:negative-balances? checker-opts)))\n (r/filter identity)\n (group-by :type))]\n {:valid? (every? empty? (vals errors))\n :read-count (count reads)\n :error-count (reduce + (map count (vals errors)))\n :first-error (util/min-by (comp :index :op) (map first (vals errors)))\n :errors (->> errors\n (map\n (fn [[type errs]]\n [type\n (merge {:count (count errs)\n :first (first errs)\n :worst (util/max-by\n (partial err-badness test)\n errs)\n :last (peek errs)}\n (if (= type :wrong-total)\n {:lowest (util/min-by :total errs)\n :highest (util/max-by :total errs)}\n {}))]))\n (into {}))}))))\n\n(defn ok-reads\n \"Filters a history to just OK reads. Returns nil if there are none.\"\n [history]\n (let [h (filter #(and (h/ok? %)\n (= :read (:f %)))\n history)]\n (when (seq h)\n (vec h))))\n\n(defn by-node\n \"Groups operations by node.\"\n [test history]\n (let [nodes (:nodes test)\n n (count nodes)]\n (->> history\n (r/filter (comp number? :process))\n (group-by (fn [op]\n (let [p (:process op)]\n (nth nodes (mod p n))))))))\n\n(defn points\n \"Turns a history into a seqeunce of [time total-of-accounts] points.\"\n [history]\n (mapv (fn [op]\n [(util/nanos->secs (:time op))\n (reduce + (remove nil? (vals (:value op))))])\n history))\n\n(defn plotter\n \"Renders a graph of balances over time\"\n []\n (reify checker/Checker\n (check [this test history opts]\n (when-let [reads (ok-reads history)]\n (let [totals (->> reads\n (by-node test)\n (util/map-vals points))\n colors (perf/qs->colors (keys totals))\n path (.getCanonicalPath\n (store/path! test (:subdirectory opts) \"bank.png\"))\n preamble (concat (perf/preamble path)\n [['set 'title (str (:name test) \" bank\")]\n '[set ylabel \"Total of all accounts\"]])\n series (for [[node data] totals]\n {:title node\n :with :points\n :pointtype 2\n :linetype (colors node)\n :data data})]\n (-> {:preamble preamble\n :series series}\n (perf/with-range)\n (perf/with-nemeses history (:nemeses (:plot test)))\n perf/plot!)\n {:valid? true})))))\n\n(defn test\n \"A partial test; bundles together some default choices for keys and amounts\n with a generator and checker. Options:\n\n :negative-balances? if true, doesn't verify that balances remain positive\"\n ([]\n (test {:negative-balances? false}))\n ([opts]\n {:max-transfer 5\n :total-amount 100\n :accounts (vec (range 8))\n :checker (checker/compose {:SI (checker opts)\n :plot (plotter)})\n :generator (generator)}))\n" }, { "path": "jepsen/src/jepsen/tests/causal.clj", "content": "(ns jepsen.tests.causal\n (:refer-clojure :exclude [test])\n (:require [jepsen [checker :as checker]\n [generator :as gen]\n [history :as h]\n [independent :as independent]]\n [clojure.tools.logging :refer [info warn]]\n [clojure.pprint :refer [pprint]]))\n\n(defprotocol Model\n (step [model op]))\n\n(defrecord Inconsistent [msg]\n Model\n (step [this op] this)\n\n Object\n (toString [this] msg))\n\n(defn inconsistent\n \"Represents an invalid termination of a model; e.g. that an operation could\n not have taken place.\"\n [msg]\n (Inconsistent. msg))\n\n(defn inconsistent?\n \"Is a model inconsistent?\"\n [model]\n (instance? Inconsistent model))\n\n(defrecord CausalRegister [value counter last-pos]\n Model\n (step [r op]\n (let [c (inc counter)\n v' (:value op)\n pos (:position op)\n link (:link op)]\n (if-not (or (= link :init)\n (= link last-pos))\n (inconsistent (str \"Cannot link \" link\n \" to last-seen position \" last-pos))\n (condp = (:f op)\n :write (cond\n ;; Write aligns with next counter, OK\n (= v' c)\n (CausalRegister. v' c pos)\n\n ;; Attempting to write an unknown value\n (not= v' c)\n (inconsistent (str \"expected value \" c\n \" attempting to write \"\n v' \" instead\")))\n\n :read-init (cond\n ;; Read a non-0 value from a freshly initialized register\n (and (= 0 counter)\n (not= 0 v'))\n (inconsistent (str \"expected init value 0, read \" v'))\n\n ;; Read the expected value of the register,\n ;; update the last known position\n (or (nil? v')\n (= value v'))\n (CausalRegister. value counter pos)\n\n ;; Read a value that we haven't written\n true (inconsistent (str \"can't read \" v'\n \" from register \" value)))\n\n :read (cond\n ;; Read the expected value of the register,\n ;; update the last known position\n (or (nil? v')\n (= value v'))\n (CausalRegister. value counter pos)\n\n ;; Read a value that we haven't written\n true (inconsistent (str \"can't read \" v'\n \" from register \" value)))))))\n Object\n (toString [this] (pr-str value)))\n\n(defn causal-register []\n (CausalRegister. 0 0 nil))\n\n(defn check\n \"A series of causally consistent (CC) ops are a causal order (CO). We issue a\n CO of 5 read (r) and write (w) operations (r w r w r) against a register\n (key). All operations in this CO must appear to execute in the order provided\n by the issuing site (process). We also look for anomalies, such as unexpected\n values\"\n [model]\n (reify checker/Checker\n (check [this test history opts]\n (let [completed (h/oks history)]\n (loop [s model\n history completed]\n (if (empty? history)\n ;; We've checked every operation in the history\n {:valid? true\n :model s}\n\n ;; checking checking checking...\n (let [op (first history)\n s' (step s op)]\n (if (inconsistent? s')\n {:valid? false\n :error (:msg s')}\n (recur s' (rest history))))))))))\n\n;; Generators\n(defn r [_ _] {:type :invoke, :f :read})\n(defn ri [_ _] {:type :invoke, :f :read-init})\n(defn cw1 [_ _] {:type :invoke, :f :write, :value 1})\n(defn cw2 [_ _] {:type :invoke, :f :write, :value 2})\n\n(defn test\n [opts]\n {:checker (independent/checker (check (causal-register)))\n :generator (->> (independent/concurrent-generator\n 1\n (range)\n (fn [k] [ri cw1 r cw2 r]))\n (gen/stagger 1)\n (gen/nemesis\n (cycle [(gen/sleep 10)\n {:type :info, :f :start}\n (gen/sleep 10)\n {:type :info, :f :stop}]))\n (gen/time-limit (:time-limit opts)))})\n" }, { "path": "jepsen/src/jepsen/tests/causal_reverse.clj", "content": "(ns jepsen.tests.causal-reverse\n \"Checks for a strict serializability anomaly in which T1 < T2, but T2 is\n visible without T1.\n\n We perform concurrent blind inserts across n keys, and meanwhile, perform\n reads of n keys in a transaction. To verify, we replay the history,\n tracking the writes which were known to have completed before the invocation\n of any write w_i. If w_i is visible, and some w_j < w_i is *not* visible,\n we've found a violation of strict serializability.\n\n Splits keys up onto different tables to make sure they fall in different\n shard ranges\"\n (:require [jepsen [checker :as checker]\n [generator :as gen]\n [history :as h]\n [independent :as independent]]\n [clojure.core.reducers :as r]\n [clojure.set :as set]\n [clojure.tools.logging :refer :all]))\n\n(defn graph\n \"Takes a history and returns a first-order write precedence graph.\"\n [history]\n (loop [completed (sorted-set)\n expected {}\n [op & more :as history] history]\n (cond\n ;; Done\n (not (seq history))\n expected\n\n ;; We know this value is definitely written\n (= :write (:f op))\n (cond\n ;; Write is beginning; record precedence\n (h/invoke? op)\n (recur completed\n (assoc expected (:value op) completed)\n more)\n\n ;; Write is completing; we can now expect to see\n ;; it\n (h/ok? op)\n (recur (conj completed (:value op))\n expected more)\n\n ;; Not a write, ignore and continue\n true (recur completed expected more))\n true (recur completed expected more))))\n\n(defn errors\n \"Takes a history and an expected graph of write precedence, returning ops that\n violate the expected write order.\"\n [history expected]\n (let [h (->> history\n (h/filter (h/has-f? :read))\n (h/filter h/ok?))\n f (fn [errors op]\n (let [seen (:value op)\n our-expected (->> seen\n (map expected)\n (reduce set/union))\n missing (set/difference our-expected\n seen)]\n (if (empty? missing)\n errors\n (conj errors\n (-> op\n (dissoc :value)\n (assoc :missing missing)\n (assoc :expected-count\n (count our-expected)))))))]\n (reduce f [] h)))\n\n(defn checker\n \"Takes a history of writes and reads. Verifies that subquent writes do not\n appear without prior acknowledged writes.\"\n []\n (reify checker/Checker\n (check [this test history opts]\n (let [expected (graph history)\n errors (errors history expected)]\n {:valid? (empty? errors)\n :errors errors}))))\n\n(defn r [] {:type :invoke, :f :read, :value nil})\n(defn w [k] {:type :invoke, :f :write, :value k})\n\n(defn workload\n \"A package of a generator and checker. Options:\n\n :nodes A set of nodes you're going to operate on. We only care\n about the count, so we can figure out how many workers\n to use per key.\n :per-key-limit Maximum number of ops per key. Default 500.\"\n [opts]\n {:checker (checker/compose\n {:perf (checker/perf)\n :sequential (independent/checker (checker))})\n :generator (let [n (count (:nodes opts))\n reads {:f :read}\n writes (map (fn [x] {:f :write, :value x}) (range))]\n (independent/concurrent-generator\n n\n (range)\n (fn [k]\n ; TODO: I'm not entirely sure this is the same--I\n ; thiiiink the original generator didn't actually mean to\n ; re-use the same write generator for each distinct key,\n ; but if it *did* and relied on that behavior, this will\n ; break.\n (->> (gen/mix [reads writes])\n (gen/stagger 1/100)\n (gen/limit (:per-key-limit opts 500))))))})\n" }, { "path": "jepsen/src/jepsen/tests/cycle/append.clj", "content": "(ns jepsen.tests.cycle.append\n \"Detects cycles in histories where operations are transactions over named\n lists lists, and operations are either appends or reads. See elle.list-append\n for docs.\"\n (:refer-clojure :exclude [test])\n (:require [elle.list-append :as la]\n [jepsen [checker :as checker]\n [generator :as gen]\n [store :as store]]))\n\n(defn checker\n \"Full checker for append and read histories. See elle.list-append for\n options.\"\n ([]\n (checker {}))\n ([opts]\n (reify checker/Checker\n (check [this test history checker-opts]\n (la/check (assoc opts :directory\n (.getCanonicalPath\n (store/path! test (:subdirectory checker-opts) \"elle\")))\n history)))))\n\n(defn gen\n \"Wrapper for elle.list-append/gen; as a Jepsen generator.\"\n [opts]\n (la/gen opts))\n\n(defn test\n \"A partial test, including a generator and checker. You'll need to provide a\n client which can understand operations of the form:\n\n {:type :invoke, :f :txn, :value [[:r 3 nil] [:append 3 2] [:r 3]]}\n\n and return completions like:\n\n {:type :ok, :f :txn, :value [[:r 3 [1]] [:append 3 2] [:r 3 [1 2]]]}\n\n where the key 3 identifies some list, whose value is initially [1], and\n becomes [1 2].\n\n Options are passed directly to elle.list-append/check and\n elle.list-append/gen; see their docs for full options.\"\n [opts]\n {:generator (gen opts)\n :checker (checker opts)})\n" }, { "path": "jepsen/src/jepsen/tests/cycle/wr.clj", "content": "(ns jepsen.tests.cycle.wr\n \"A test which looks for cycles in write/read transactions. Writes are assumed\n to be unique, but this is the only constraint. See elle.rw-register for docs.\"\n (:refer-clojure :exclude [test])\n (:require [elle [rw-register :as r]]\n [jepsen [checker :as checker]\n [generator :as gen]\n [store :as store]]))\n\n(defn gen\n \"Wrapper around elle.rw-register/gen.\"\n [opts]\n (r/gen opts))\n\n(defn checker\n \"Full checker for write-read registers. See elle.rw-register for options.\"\n ([]\n (checker {}))\n ([opts]\n (reify checker/Checker\n (check [this test history checker-opts]\n (r/check (assoc opts :directory\n (.getCanonicalPath\n (store/path! test (:subdirectory checker-opts) \"elle\")))\n history)))))\n\n(defn test\n \"A partial test, including a generator and a checker. You'll need to provide a client which can understand operations of the form:\n\n {:type :invoke, :f :txn, :value [[:r 3 nil] [:w 3 6]}\n\n and return completions like:\n\n {:type :ok, :f :txn, :value [[:r 3 1] [:w 3 6]]}\n\n Where the key 3 identifies some register whose value is initially 1, and\n which this transaction sets to 6.\n\n Options are passed directly to elle.rw-register/check and\n elle.rw-register/gen; see their docs for full options.\"\n [opts]\n {:generator (gen opts)\n :checker (checker opts)})\n" }, { "path": "jepsen/src/jepsen/tests/cycle.clj", "content": "(ns jepsen.tests.cycle\n \"Tests based on transactional cycle detection via Elle. If you're looking for\n code that used to be here, see elle.core.\"\n (:require [jepsen [checker :as checker]\n [store :as store]]\n [elle.core :as elle]\n [clj-commons.slingshot :refer [try+ throw+]]))\n\n(defn checker\n \"Takes a function which takes a history and returns a [graph, explainer]\n pair, and returns a checker which uses those graphs to identify cyclic\n dependencies.\"\n [analyze-fn]\n (reify checker/Checker\n (check [this test history opts]\n (elle/check {:analyzer analyze-fn} history))))\n" }, { "path": "jepsen/src/jepsen/tests/kafka.clj", "content": "(ns jepsen.tests.kafka\n \"This workload is intended for systems which behave like the popular Kafka\n queue. This includes Kafka itself, as well as compatible systems like\n Redpanda.\n\n At the abstract level of this workload, these systems provide a set of\n totally-ordered append-only logs called *partitions*, each of which stores a\n single arbitrary (and, for our purposes, unique) *message* at a particular\n *offset* into the log. Partitions are grouped together into *topics*: each\n topic is therefore partially ordered.\n\n Each client has a *producer* and a *consumer* aspect; in Kafka these are\n separate clients, but for Jepsen's purposes we combine them. A\n producer can *send* a message to a topic-partition, which assigns it a\n unique, theoretically monotonically-increasing offset and saves it durably at\n that offset. A consumer can *subscribe* to a topic, in which case the system\n aautomatically assigns it any number of partitions in that topic--this\n assignment can change at any time. Consumers can also assign themselves\n specific partitions manually. When a consumer *polls*, it receives messages\n and their offsets from whatever topic-partitions it is currently assigned to,\n and advances its internal state so that the next poll (barring a change in\n assignment) receives the immediately following messages.\n\n ## Operations\n\n To subscribe to a new set of topics, we issue an operation like:\n\n {:f :subscribe, :value [k1, k2, ...]}\n\n or\n\n {:f :assign, :value [k1, k2, ...]}\n\n ... where k1, k2, etc denote specific partitions. For subscribe,\n we convert those partitions to the topics which contain them, and subscribe\n to those topics; the database then controls which specific partitions we get.\n Just like the Kafka client API, both subscribe and assign replace the current\n topics for the consumer.\n\n Assign ops can also have a special key `:seek-to-beginning? true` which\n indicates that the client should seek to the beginning of all its partitions.\n\n Reads and writes (and mixes thereof) are encoded as a vector of\n micro-operations:\n\n {:f :poll, :value [op1, op2, ...]}\n {:f :send, :value [op1, op2, ...]}\n {:f :txn, :value [op1, op2, ...]}\n\n Where :poll and :send denote transactions comprising only reads or writes,\n respectively, and :txn indicates a general-purpose transaction. Operations\n are of two forms:\n\n [:send key value]\n\n ... instructs a client to append `value` to the integer `key`--which maps\n uniquely to a single topic and partition. These operations are returned as:\n\n [:send key [offset value]]\n\n where offset is the returned offset of the write, if available, or `nil` if\n it is unknown (e.g. if the write times out).\n\n Reads are invoked as:\n\n [:poll]\n\n ... which directs the client to perform a single `poll` operation on its\n consumer. The results of that poll are expanded to:\n\n [:poll {key1 [[offset1 value1] [offset2 value2] ...],\n key2 [...]}]\n\n Where key1, key2, etc are integer keys obtained from the topic-partitions\n returned by the call to poll, and the value for that key is a vector of\n [offset value] pairs, corresponding to the offset of that message in that\n particular topic-partition, and the value of the message---presumably,\n whatever was written by `[:send key value]` earlier.\n\n When polling *without* using assign, clients should call `.commitSync` before\n returning a completion operation.\n\n Before a transaction completes, we commit its offsets.\n\n All transactions may return an optional key :rebalance-log, which is a vector\n of rebalancing events (changes in assigned partitions) that occurred during\n the execution of that transaction. Each rebalance event is a map like:\n\n {:keys [k1 k2 ...]}\n\n There may be more keys in this map; I can't remember right now.\n\n ## Topic-partition Mapping\n\n We identify topics and partitions using abstract integer *keys*, rather than\n explicit topics and partitions. The client is responsible for mapping these\n keys bijectively to topics and partitions.\n\n ## Analysis\n\n From this history we can perform a number of analyses:\n\n 1. For any observed value of a key, we check to make sure that its writer was\n either :ok or :info; if the writer :failed, we know this constitutes an\n aborted read.\n\n 2. We verify that all sends and polls agree on the value for a given key and\n offset. We do not require contiguity in offsets, because transactions add\n invisible messages which take up an offset slot but are not visible to the\n API. If we find divergence, we know that Kakfa disagreed about the value at\n some offset.\n\n Having verified that each [key offset] pair uniquely identifies a single\n value, we eliminate the offsets altogether and perform the remainder of the\n analysis purely in terms of keys and values. We construct a graph where\n vertices are values, and an edge v1 -> v2 means that v1 immediately precedes\n v2 in the offset order (ignoring gaps in the offsets, which we assume are due\n to transaction metadata messages).\n\n 3. For each key, we take the highest observed offset, and then check that\n every :ok :send operation with an equal or lower offset was *also* read by at\n least one consumer. If we find one, we know a write was lost!\n\n 4. We build a dependency graph between pairs of transactions T1 and T2, where\n T1 != T2, like so:\n\n ww. T1 sent value v1 to key k, and T2 sent v2 to k, and o1 < o2\n in the version order for k.\n\n wr. T1 sent v1 to k, and T2's highest read of k was v1.\n\n rw. T1's highest read of key k was offset o1, and T2 sent offset o2 to k,\n and o1 < o2 in the version order for k.\n\n Our use of \\\"highest offset\\\" is intended to capture the fact that each poll\n operation observes a *range* of offsets, but in general those offsets could\n have been generated by *many* transactions. If we drew wr edges for every\n offset polled, we'd generate superfluous edges--all writers are already\n related via ww dependencies, so the final wr edge, plus those ww edges,\n captures those earlier read values.\n\n We draw rw edges only for the final versions of each key observed by a\n transaction. If we drew rw edges for an earlier version, we would incorrectly\n be asserting that later transactions were *not* observed!\n\n We perform cycle detection and categorization of anomalies from this graph\n using Elle.\n\n 5. Internal Read Contiguity: Within a transaction, each pair of reads on the\n same key should be directly related in the version order. If we observe a gap\n (e.g. v1 < ... < v2) that indicates this transaction skipped over some\n values. If we observe an inversion (e.g. v2 < v1, or v2 < ... < v1) then we\n know that the transaction observed an order which disagreed with the \\\"true\\\"\n order of the log.\n\n 6. Internal Write Contiguity: Gaps between sequential pairs of writes to the\n same key are detected via Elle as write cycles. Inversions are not, so we\n check for them explicitly: a transaction sends v1, then v2, but v2 < v1 or v2\n < ... v1 in the version order.\n\n 7. Intermediate reads? I assume these happen constantly, but are they\n supposed to? It's not totally clear what this MEANS, but I think it might\n look like a transaction T1 which writes [v1 v2 v3] to k, and another T2 which\n polls k and observes any of v1, v2, or v3, but not *all* of them. This\n miiight be captured as a wr-rw cycle in some cases, but perhaps not all,\n since we're only generating rw edges for final reads.\n\n 8. Precommitted reads. These occur when a transaction observes a value that\n it wrote. This is fine in most transaction systems, but illegal in Kafka,\n which assumes that consumers (running at read committed) *never* observe\n uncommitted records.\"\n (:require [analemma [xml :as xml]\n [svg :as svg]]\n [bifurcan-clj [core :as b]\n [int-map :as bim]\n [list :as bl]\n [map :as bm]\n [set :as bs]]\n [clojure [datafy :refer [datafy]]\n [pprint :refer [pprint]]\n [set :as set]]\n [clojure.core.reducers :as r]\n [clojure.java.io :as io]\n [clojure.tools.logging :refer [info warn]]\n [dom-top.core :refer [assert+ real-pmap loopr]]\n [elle [core :as elle]\n [graph :as g]\n [list-append :refer [rand-bg-color]]\n [txn :as txn]\n [util :refer [index-of]]\n [rels :refer [ww wr rw]]]\n [gnuplot.core :as gnuplot]\n [jepsen [checker :as checker]\n [client :as client]\n [generator :as gen]\n [history :as h]\n [random :as rand]\n [store :as store]\n [util :as util :refer [map-vals\n meh\n nanos->secs\n pprint-str]]]\n [jepsen.checker.perf :as perf]\n [jepsen.tests.cycle.append :as append]\n [clj-commons.slingshot :refer [try+ throw+]]\n [tesser.core :as t]))\n\n;; Generator\n\n(defn txn-generator\n \"Takes a list-append generator and rewrites its transactions to be [:poll] or\n [:send k v] micro-ops. Also adds a :keys field onto each operation, with a\n set of keys that txn would have interacted with; we use this to generate\n :subscribe ops later.\"\n [la-gen]\n (gen/map (fn rewrite-op [op]\n (-> op\n (assoc :keys (set (map second (:value op))))\n (update :value\n (partial mapv (fn rewrite-mop [[f k v]]\n (case f\n :append [:send k v]\n :r [:poll]))))))\n la-gen))\n\n(defrecord InterleaveSubscribes [sub-p gen]\n gen/Generator\n (op [this test context]\n ; When we're asked for an operation, ask the underlying generator for\n ; one...\n (when-let [[op gen'] (gen/op gen test context)]\n (if (= :pending op)\n [:pending this]\n (let [this' (InterleaveSubscribes. sub-p gen')]\n (if (< (rand/double) sub-p)\n ; At random, emit a subscribe/assign op instead.\n (let [f (rand/nth (vec (:sub-via test)))\n op {:f f, :value (vec (:keys op))}]\n [(gen/fill-in-op op context) this])\n ; Or pass through the op directly\n [(dissoc op :keys) this'])))))\n\n ; Pass through updates\n (update [this test context event]\n (InterleaveSubscribes.\n sub-p\n (gen/update gen test context event))))\n\n(defn interleave-subscribes\n \"Takes CLI options (:sub-p) and a txn generator. Keeps track of the keys\n flowing through it, interspersing occasional :subscribe or :assign operations\n for recently seen keys.\"\n [opts txn-gen]\n (InterleaveSubscribes. (:sub-p opts 1/64) txn-gen))\n\n(defn tag-rw\n \"Takes a generator and tags operations as :f :poll or :send if they're\n entirely comprised of send/polls.\"\n [gen]\n (gen/map (fn tag-rw [op]\n (case (->> op :value (map first) set)\n #{:poll} (assoc op :f :poll)\n #{:send} (assoc op :f :send)\n op))\n gen))\n\n(defn firstv\n \"First for vectors.\"\n [v]\n (nth v 0))\n\n(defn secondv\n \"Second for vectors.\"\n [v]\n (nth v 1))\n\n(defn op->max-poll-offsets\n \"Takes an operation and returns a map of keys to the highest offsets polled.\"\n [{:keys [type f value]}]\n (case type\n (:info, :ok)\n (case f\n (:poll, :txn)\n (reduce (fn [offsets [f :as mop]]\n (case f\n :poll (->> (second mop)\n (map-vals (fn [pairs]\n (->> pairs\n (map first)\n (remove nil?)\n (reduce max -1))))\n (merge-with max offsets))\n :send offsets))\n {}\n value)\n nil)\n nil))\n\n(defn op->max-send-offsets\n \"Takes an operation and returns a map of keys to the highest offsets sent.\"\n [{:keys [type f value]}]\n (case type\n (:info, :ok)\n (case f\n (:send, :txn)\n (reduce (fn [offsets [f :as mop]]\n (case f\n :poll offsets\n :send (let [[_ k v] mop]\n (when (and (vector? v) (first v))\n (assoc offsets k (max (get offsets k 0)\n (first v)))))))\n {}\n value)\n nil)\n nil))\n\n(defn op->max-offsets\n \"Takes an operation (presumably, an OK or info one) and returns a map of keys\n to the highest offsets interacted with, either via send or poll, in that op.\"\n [op]\n (merge-with max\n (op->max-poll-offsets op)\n (op->max-send-offsets op)))\n\n(defrecord PollUnseen [gen sent polled]\n ; sent and polled are both maps of keys to maximum offsets sent and polled,\n ; respectively.\n gen/Generator\n (op [this test context]\n (when-let [[op gen'] (gen/op gen test context)]\n (if (= :pending op)\n [:pending this]\n (let [this' (PollUnseen. gen' sent polled)]\n ; About 1/3 of the time, merge our sent-but-unpolled keys into an\n ; assign/subscribe\n (if (and (< (rand/double) 1/3)\n (< 0 (count sent))\n (or (= :assign (:f op))\n (= :subscribe (:f op))))\n [(assoc op\n :value (->> (:value op)\n (concat (keys sent))\n distinct\n vec)\n ; Just for debugging, so you can look at the log and tell\n ; what's going on\n :unseen (->> sent\n (map (fn [[k sent-offset]]\n [k {:polled (polled k -1)\n :sent sent-offset}]))\n (into (sorted-map))))\n this']\n\n ; Pass through\n [op this'])))))\n\n ; Look at the offsets we sent and polled, and advance our state to match\n (update [this test context event]\n (if (= :ok (:type event))\n (let [sent' (merge-with max sent (op->max-send-offsets event))\n polled' (merge-with max polled (op->max-poll-offsets event))\n ; Trim keys we're caught up on\n [sent' polled']\n (loopr [sent sent'\n polled polled']\n [k (distinct (concat (keys sent') (keys polled')))]\n (if (< (polled k -1) (sent k -1))\n ; We have unseen elements\n (recur sent polled)\n ; We're caught up!\n (recur (dissoc sent k) (dissoc polled k))))]\n (PollUnseen. (gen/update gen test context event) sent' polled'))\n ; No change\n this)))\n\n(defn poll-unseen\n \"Wraps a generator. Keeps track of every offset that is successfully sent,\n and every offset that's successfully polled. When there's a key that has some\n offsets which were sent but not polled, we consider that unseen. This\n generator occasionally rewrites assign/subscribe operations to try and catch\n up to unseen keys.\"\n [gen]\n (PollUnseen. gen {} {}))\n\n(defrecord TrackKeyOffsets [gen offsets]\n gen/Generator\n (op [this test context]\n (when-let [[op gen'] (gen/op gen test context)]\n (if (= :pending op)\n [:pending this]\n [op (TrackKeyOffsets. gen' offsets)])))\n\n (update [this test context event]\n (when (= :ok (:type event))\n (let [op-offsets (op->max-offsets event)]\n (when-not (empty? op-offsets)\n (swap! offsets #(merge-with max % op-offsets)))))\n (TrackKeyOffsets.\n (gen/update gen test context event) offsets)))\n\n(defn track-key-offsets\n \"Wraps a generator. Keeps track of every key that generator touches in the\n given atom, which is a map of keys to highest offsets seen.\"\n [keys-atom gen]\n (TrackKeyOffsets. gen keys-atom))\n\n(defrecord FinalPolls [target-offsets gen]\n gen/Generator\n (op [this test context]\n ;(info \"waiting for\" target-offsets)\n (when-not (empty? target-offsets)\n (when-let [[op gen'] (gen/op gen test context)]\n [op (assoc this :gen gen')])))\n\n (update [this test context {:keys [type f value] :as event}]\n ; (info :update event)\n (if (and (= type :ok)\n (= f :poll))\n (let [offsets' (reduce (fn [target-offsets' [k seen-offset]]\n (if (<= (get target-offsets' k -1)\n seen-offset)\n ; We've read past our target offset for\n ; this key\n (dissoc target-offsets' k)\n target-offsets'))\n target-offsets\n (op->max-offsets event))]\n (when-not (identical? target-offsets offsets')\n (info \"Process\" (:process event) \"now waiting for\" offsets'))\n (FinalPolls. offsets' gen))\n ; Not relevant\n this)))\n\n(defn final-polls\n \"Takes an atom containing a map of keys to offsets. Constructs a generator\n which:\n\n 1. Checks the topic-partition state from the admin API\n\n 2. Crashes the client, to force a fresh one to be opened, just in case\n there's broken state inside the client.\n\n 3. Assigns the new client to poll every key, and seeks to the beginning\n\n 4. Polls repeatedly\n\n This process repeats every 10 seconds until polls have caught up to the\n offsets in the offsets atom.\"\n [offsets]\n (delay\n (let [offsets @offsets]\n (info \"Polling up to offsets\" offsets)\n (->> [{:f :crash}\n {:f :debug-topic-partitions, :value (keys offsets)}\n {:f :assign, :value (keys offsets), :seek-to-beginning? true}\n (->> {:f :poll, :value [[:poll]], :poll-ms 1000}\n repeat\n (gen/stagger 1/5))]\n (gen/time-limit 10000)\n repeat\n (FinalPolls. offsets)))))\n\n(defn crash-client-gen\n \"A generator which, if the test has :crash-clients? true, periodically emits\n an operation to crash a random client.\"\n [opts]\n (when (:crash-clients? opts)\n (->> (repeat {:f :crash})\n (gen/stagger (/ (:crash-client-interval opts 30)\n (:concurrency opts))))))\n\n;; Checker ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n\n(defn assocv\n \"An assoc on vectors which allows you to assoc at arbitrary indexes, growing\n the vector as needed. When v is nil, constructs a fresh vector rather than a\n map.\"\n [v i value]\n (if v\n (if (<= i (count v))\n (assoc v i value)\n (let [nils (repeat (- i (count v)) nil)]\n (assoc (into v nils) i value)))\n ; Nil is treated as an empty vector.\n (recur [] i value)))\n\n(defn nth+\n \"Nth for vectors, but returns nil instead of out-of-bounds.\"\n [v i]\n (when (< i (count v))\n (nth v i)))\n\n(defn op-writes-helper\n \"Takes an operation and a function which takes an offset-value pair. Returns\n a map of keys written by this operation to the sequence of (f [offset value])\n sends for that key. Note that offset may be nil.\"\n [op f]\n (when (#{:txn :send} (:f op))\n (reduce (fn [writes mop]\n (if (= :send (first mop))\n (let [[_ k v] mop\n vs (get writes k [])\n ; Values can be either a literal value or a [offset value]\n ; pair.\n value (if (vector? v)\n (f v)\n (f [nil v]))]\n (assoc writes k (conj vs value)))\n ; Something other than a send\n writes))\n {}\n (:value op))))\n\n(defn op-writes\n \"Returns a map of keys to the sequence of all values written to that key in\n an op.\"\n [op]\n (op-writes-helper op second))\n\n(defn op-write-offsets\n \"Returns a map of keys to the sequence of all offsets written to that key in\n an op.\"\n [op]\n (op-writes-helper op first))\n\n(defn op-write-pairs\n \"Returns a map of keys to the sequence of all [offset value] pairs written to\n that key in an op.\"\n [op]\n (op-writes-helper op identity))\n\n(defn op-reads-helper\n \"Takes an operation and a function which takes an offset-value pair. Returns\n a map of keys read by this operation to the sequence of (f [offset value])\n read for that key.\"\n [^jepsen.history.Op op f]\n ; This shows up in lots of our tight loops, so it's full of\n ; micro-optimizations\n ; shape\n (when (or (identical? :txn (.f op))\n (identical? :poll (.f op)))\n (let [r (reduce (fn mop [res mop]\n (if (and (identical? :poll (nth mop 0))\n (<= 2 (count mop)))\n (reduce (fn per-key [res [k pairs]]\n (let [vs' (reduce (fn per-pair [vs pair]\n (conj! vs (f pair)))\n (get res k (transient []))\n pairs)]\n (assoc! res k vs')))\n res\n (nth mop 1))\n res))\n (transient {})\n (.value op))]\n ; Persist\n (update-vals (persistent! r) persistent!))))\n\n(defn op-read-pairs\n \"Returns a map of keys to the sequence of all [offset value] pairs read for\n that key.\"\n [op]\n (op-reads-helper op identity))\n\n(defn op-read-offsets\n \"Returns a map of keys to the sequence of all offsets read for that key.\"\n [op]\n (op-reads-helper op firstv))\n\n(defn op-reads\n \"Returns a map of keys to the sequence of all values read for that key.\"\n [op]\n (op-reads-helper op secondv))\n\n(defn op-reads-index\n \"We call op-reads a LOT. This takes a history and builds an efficient index,\n then returns a function (op-reads op) which works just like (op-reads op),\n but is memoized.\"\n [history]\n (let [reducer (fn reducer\n ([] (b/linear (bim/int-map)))\n ([index] index)\n ([index ^jepsen.history.Op op]\n (bim/put index (.index op) (op-reads op))))\n combiner (fn combiner\n ([] (b/linear (bim/int-map)))\n ([index] (b/forked index))\n ([index1 index2]\n (bm/merge index1 index2)))\n fold {:name :op-reads-index\n :reducer reducer\n :combiner combiner}\n index (h/fold history fold)]\n (fn memoized [^jepsen.history.Op op]\n (bim/get index (.index op) nil))))\n\n(defn op-pairs\n \"Returns a map of keys to the sequence of all [offset value] pairs either\n written or read for that key; writes first.\"\n [op]\n (merge-with concat (op-write-pairs op) (op-read-pairs op)))\n\n(defn reads-of-key\n \"Returns a seq of all operations which read the given key, and, optionally,\n read the given value.\"\n ([k history]\n (->> history\n (filter (comp #{:txn :send :poll} :f))\n (filter (fn [op]\n (contains? (op-reads op) k)))))\n ([k v history]\n (->> history\n (reads-of-key k)\n (filter (fn [op]\n (some #{v} (get (op-reads op) k)))))))\n\n(defn writes-of-key\n \"Returns a seq of all operations which wrote the given key, and, optionally,\n sent the given value.\"\n ([k history]\n (->> history\n (filter (comp #{:txn :send :poll} :f))\n (filter (fn [op]\n (contains? (op-writes op) k)))))\n ([k v history]\n (->> history\n (writes-of-key k)\n (filter (fn [op]\n (some #{v} (get (op-writes op) k)))))))\n\n(defn reads-of-key-offset\n \"Returns a seq of all operations which read the given key and offset.\"\n [k offset history]\n (->> history\n (reads-of-key k)\n (filter (fn [op]\n (some #{offset} (get (op-read-offsets op) k))))))\n\n(defn writes-of-key-offset\n \"Returns a seq of all operations which wrote the given key and offset.\"\n [k offset history]\n (->> history\n (writes-of-key k)\n (filter (fn [op]\n (some #{offset} (get (op-write-offsets op) k))))))\n\n(defn reads-of-key-value\n \"Returns a seq of all operations which read the given key and value.\"\n [k value history]\n (->> history\n (reads-of-key k)\n (filter (fn [op] (some #{value} (get (op-reads op) k))))))\n\n(defn writes-of-key-value\n \"Returns a seq of all operations which wrote the given key and value.\"\n [k value history]\n (->> history\n (writes-of-key k)\n (filter (fn [op] (some #{value} (get (op-writes op) k))))))\n\n(defn op-around-key-offset\n \"Takes an operation and returns that operation with its value trimmed so that\n any send/poll operations are constrained to just the given key, and values\n within n of the given offset. Returns nil if operation is not relevant.\"\n ([k offset op]\n (op-around-key-offset k offset 3 op))\n ([k offset n op]\n (when (and (not= :invoke (:type op))\n (#{:send :poll :txn} (:f op)))\n (let [value'\n (keep (fn [[f v :as mop]]\n (case f\n :poll (when-let [pairs (get v k)]\n ; Trim pairs to region around offset\n (let [trimmed\n (filter (fn [[o v]]\n (<= (- offset n) o (+ offset n)))\n pairs)]\n (when (seq trimmed)\n [:poll {k trimmed}])))\n :send (let [[_ k2 v-or-pair] mop]\n (when (vector? v-or-pair)\n (let [[o v] v-or-pair]\n (when (and (= k k2)\n (<= (- offset n) o (+ offset n)))\n mop))))))\n (:value op))]\n (when-not (empty? value')\n (assoc op :value value'))))))\n\n(defn around-key-offset\n \"Filters a history to just those operations around a given key and offset;\n trimming their mops to just those regions as well.\"\n ([k offset history]\n (around-key-offset k offset 3 history))\n ([k offset n history]\n (keep (partial op-around-key-offset k offset n) history)))\n\n(defn around-some\n \"Clips a sequence to just those elements near a predicate. Takes a predicate,\n a range n, and a sequence xs. Returns the series of all x in xs such x is\n within n elements of some x' matching predicate.\"\n [pred n coll]\n (let [indices (first\n (reduce (fn [[indices i] x]\n (if (pred x)\n [(into indices (range (- i n) (+ i n 1))) (inc i)]\n [indices (inc i)]))\n [#{} 0]\n coll))]\n (first (reduce (fn [[out i] x]\n (if (indices i)\n [(conj out x) (inc i)]\n [out (inc i)]))\n [[] 0]\n coll))))\n\n(defn op-around-key-value\n \"Takes an operation and returns that operation with its value trimmed so that\n any send/poll operations are constrained to just the given key, and values\n within n of the given value. Returns nil if operation is not relevant.\"\n ([k value op]\n (op-around-key-value k value 3 op))\n ([k value n op]\n (when (and (= :ok (:type op))\n (#{:send :poll :txn} (:f op)))\n (let [value'\n (keep (fn [[f v :as mop]]\n (case f\n :poll (when-let [pairs (get v k)]\n ; Trim pairs to region around offset\n (let [trimmed (around-some (comp #{value} second)\n n pairs)]\n (when (seq trimmed)\n {k trimmed})))\n :send (let [[_ k2 [o v]] mop]\n (when (and (= k k2) (= value v))\n mop))))\n (:value op))]\n (when-not (empty? value')\n (assoc op :value value'))))))\n\n(defn around-key-value\n \"Filters a history to just those operations around a given key and value;\n trimming their mops to just those regions as well.\"\n ([k value history]\n (around-key-value k value 3 history))\n ([k value n history]\n (keep (partial op-around-key-value k value n) history)))\n\n(defn writes-by-type\n \"Takes a history and constructs a map of types (:ok, :info, :fail) to maps of\n keys to the set of all values which were written for that key. We use this to\n identify, for instance, what all the known-failed writes were for a given\n key.\"\n [history]\n (->> history\n (remove (comp #{:invoke} :type))\n (filter (comp #{:txn :send} :f))\n (group-by :type)\n (map-vals (fn [ops]\n (->> ops\n ; Construct a seq of {key [v1 v2 ...]} maps\n (map op-writes)\n ; And turn [v1 v2 ...] into #{v1 v2 ...}\n (map (partial map-vals set))\n ; Then merge them all together\n (reduce (partial merge-with set/union) {}))))))\n\n(defn reads-by-type\n \"Takes a history and an op-reads fn, and constructs a map of types (:ok,\n :info, :fail) to maps of keys to the set of all values which were read for\n that key. We use this to identify, for instance, the known-successful reads\n for some key as a part of finding lost updates.\"\n [history op-reads]\n (->> history\n (remove (comp #{:invoke} :type))\n (filter (comp #{:txn :poll} :f))\n (group-by :type)\n (map-vals (fn [ops]\n (->> ops\n (map op-reads)\n (map (partial map-vals set))\n (reduce (partial merge-with set/union) {}))))))\n\n\n(defn must-have-committed?\n \"Takes a reads-by-type map and a (presumably :info) transaction which sent\n something. Returns true iff the transaction was :ok, or if it was :info and\n we can prove that some send from this transaction was read.\"\n [reads-by-type op]\n (or (= :ok (:type op))\n (and (= :info (:type op))\n (let [ok (:ok reads-by-type)]\n (some (fn [[k vs]]\n (let [ok-vs (get ok k #{})]\n (some ok-vs vs)))\n (op-writes op))))))\n\n(defn version-orders-update-log\n \"Updates a version orders log with the given offset and value.\"\n [log offset value]\n (bm/update (or log (bim/int-map))\n offset\n (fn update [values]\n (bs/add (if (nil? values)\n (b/linear bs/empty)\n values)\n value))))\n\n(defn version-orders-reduce-mop\n \"Takes a logs object from version-orders and a micro-op, and integrates that\n micro-op's information about offsets into the logs.\"\n [logs mop]\n (case (firstv mop)\n :send (let [[_ k v] mop]\n (if (vector? v)\n (let [[offset value] v]\n (if offset\n ; We completed the send and know an offset\n (bm/update logs k version-orders-update-log offset value)\n ; Not sure what the offset was\n logs))\n ; Not even offset structure: maybe an :info txn\n logs))\n\n :poll (loopr [logs logs]\n [; For each key and series of pairs polled for that key\n [k pairs] (second mop)\n ; And for each offset and value in those pairs\n [offset value] pairs]\n (recur (if offset\n (bm/update logs k\n version-orders-update-log offset value)\n ; Don't know offset\n logs)))))\n\n(defn index-seq\n \"Takes a seq of distinct values, and returns a map of:\n\n {:by-index A vector of the sequence\n :by-value A map of values to their indices in the vector.}\"\n [xs]\n {:by-index (vec xs)\n :by-value (into {} (map-indexed (fn [i x] [x i]) xs))})\n\n(defn log->value->first-index\n \"Takes a log: a vector of sets of read values for each offset in a partition,\n possibly including `nil`s. Returns a map which takes a value to the index\n where it first appeared.\"\n [log]\n (->> (remove nil? log)\n (reduce (fn [[earliest i] values]\n [(reduce (fn [earliest value]\n (if (contains? earliest value)\n earliest\n (assoc earliest value i)))\n earliest\n values)\n (inc i)])\n [{} 0])\n first))\n\n(defn log->last-index->values\n \"Takes a log: a vector of sets of read values for each offset in a partition,\n possibly including `nil`s. Returns a vector which takes indices (dense\n offsets) to sets of values whose *last* appearance was at that position.\"\n [log]\n (->> (remove nil? log)\n ; Build up a map of values to their latest indexes\n (reduce (fn latest [[latest i] values]\n [(reduce (fn [latest value]\n (assoc latest value i))\n latest\n values)\n (inc i)])\n [{} 0])\n first\n ; Then invert that map into a vector of indexes to sets\n (reduce (fn [log [value index]]\n (let [values (get log index #{})]\n (assocv log index (conj values value))))\n [])))\n\n(defn datafy-version-order-log\n \"Turns a bifurcan integer map of Bifurcan sets, and converts it to a vector\n of Clojure sets.\"\n [m]\n (let [size (b/size m)]\n (if (= 0 size)\n []\n (let [; Since keys are sorted...\n max-i (bm/key (b/nth m (dec size)))]\n ; Create a vector for each index up to and including max-i\n (loop [v (transient [])\n i 0]\n (if (< max-i i)\n ; Done\n (persistent! v)\n ; Copy this offset into the vector\n (let [values (bim/get m i nil)\n values (when values\n (set values))]\n (recur (assoc! v i values)\n (inc i)))))))))\n\n(defn version-orders\n \"Takes a history and a reads-by-type structure. Constructs a map of:\n\n {:orders A map of keys to orders for that key. Each order is a map of:\n {:by-index A vector which maps indices to single values,\n in log order.\n :by-value A map of values to indices in the log.\n :log A vector which maps offsets to sets of values\n in log order.}\n\n :errors A series of error maps describing any incompatible orders, where\n a single offset for a key maps to multiple values.}\n\n Offsets are directly from Kafka. Indices are *dense* offsets, removing gaps\n in the log.\n\n Note that we infer version orders from sends only when we can prove their\n effects were visible, but from *all* polls, including :info and :fail ones.\n Why? Because unlike a traditional transaction, where you shouldn't trust\n reads in aborted txns, pollers in Kafka's transaction design are *always*\n supposed to emit safe data regardless of whether the transaction commits or\n not.\"\n [history reads-by-type]\n ; First, build up our logs concurrently. We start with a Bifurcan map of keys\n ; to logs. Each log is a Bifurcan integer map of offsets to sets of values.\n ; This gives us efficient mergeability.\n (let [fold\n {:name :version-orders\n :reducer\n (fn reducer\n ([] (b/linear bm/empty))\n ([logs] logs)\n ([logs op]\n (case (:f op)\n (:poll, :send, :txn)\n (if (must-have-committed? reads-by-type op)\n ; OK or info, and we can prove effects were visible\n (reduce version-orders-reduce-mop logs (:value op))\n ; We're not sure it was bisible, just use the polls.\n (reduce version-orders-reduce-mop logs\n (r/filter (comp #{:poll} firstv) (:value op))))\n ; Some non-transactional op\n logs)))\n ; Merge logs together\n :combiner\n (fn combiner\n ([] (b/linear bm/empty))\n ([logs]\n ; Convert back to Clojure\n (loopr [logs' (transient {})]\n [k-log logs]\n (let [k (bm/key k-log)\n log (bm/value k-log)]\n (recur\n (assoc! logs' k (datafy-version-order-log log))))\n (persistent! logs')))\n ; Merge two logs\n ([logs1 logs2]\n (bm/merge logs1 logs2\n (fn merge-log [log1 log2]\n (bm/merge log1 log2\n (fn merge-offset [vs1 vs2]\n (bs/union vs1 vs2)))))))}\n logs (h/fold history fold)]\n ; Transform our logs to orders.\n {:errors\n (->> logs\n (mapcat (fn errors [[k log]]\n (->> log\n (reduce (fn [[offset index errs] values]\n (condp <= (count values)\n ; Divergence\n 2 [(inc offset) (inc index)\n (conj errs {:key k\n :offset offset\n :index index\n :values\n (into (sorted-set)\n values)})]\n ; No divergence\n 1 [(inc offset) (inc index) errs]\n ; Hole in log\n 0 [(inc offset) index errs]))\n [0 0 []])\n last)))\n seq)\n :orders\n (map-vals\n (fn key-order [log]\n (assoc (->> log (remove nil?) (map first) index-seq)\n :log log))\n logs)}))\n\n(defn g1a-cases\n \"Takes a partial analysis and looks for aborted reads, where a known-failed\n write is nonetheless visible to a committed read. Returns a seq of error\n maps, or nil if none are found.\"\n [{:keys [history writes-by-type writer-of op-reads]}]\n (let [failed (:fail writes-by-type)\n ops (->> history\n h/oks\n (h/filter (h/has-f? #{:txn :poll})))]\n (->> (for [op ops\n [k vs] (op-reads op)\n v vs\n :when (contains? (get failed k) v)]\n {:key k\n :value v\n :writer (get-in writer-of [k v])\n :reader op})\n seq)))\n\n(defn precommitted-read-cases\n \"Takes a partial analysis with a history and looks for a transaction which\n observed its own writes. Returns a vector of error maps, or nil if none are\n found.\n\n This is legal in most DBs, but in Kafka's model, sent values are supposed to\n be invisible to *all* pollers until their producing txn commits.\"\n [{:keys [history op-reads]}]\n (->> (t/keep (fn check-op [op]\n (let [reads (op-reads op)\n writes (op-writes op)]\n (loopr []\n [[k vs] writes]\n (let [k-writes (set vs)\n k-reads (set (get reads k))\n bad (set/intersection k-writes k-reads)]\n (if (empty? bad)\n (recur)\n {:op op\n :key k\n :value (first bad)}))))))\n (t/into [])\n (h/tesser history)\n util/nil-if-empty))\n\n(defn lost-write-cases\n \"Takes a partial analysis and looks for cases of lost write: where a write\n that we *should* have observed is somehow not observed. Of course we cannot\n expect to observe everything: for example, if we send a message to Redpanda\n at the end of a test, and don't poll for it, there's no chance of us seeing\n it at all! Or a poller could fall behind.\n\n What we do instead is identify the highest read value for each key v_max, and\n then take the set of all values *prior* to it in the version order: surely,\n if we read v_max = 3, and the version order is [1 2 3 4], we should also have\n read 1 and 2.\n\n It's not *quite* this simple. If a message appears at multiple offsets, the\n version order will simply pick one for us, which leads to nondeterminism. If\n an offset has multiple messages, a successfully inserted message could appear\n *nowhere* in the version order.\n\n To deal with this, we examine the raw logs for each key, and build two index\n structures. The first maps values to their earliest (index) appearance in the\n log: we use this to determine the highest index that must have been read. The\n second is a vector which maps indexes to sets of values whose *last*\n appearance in the log was at that index. We use this vector to identify which\n values ought to have been read.\n\n Once we've derived the set of values we ought to have read for some key k, we\n run through each poll of k and cross off the values read. If there are any\n values left, they must be lost updates.\"\n [{:keys [history version-orders reads-by-type writer-of readers-of]}]\n (assert history)\n (assert version-orders)\n (assert reads-by-type)\n (assert writer-of)\n (assert readers-of)\n ; Start with all the values we know were read\n (->> (:ok reads-by-type)\n (mapcat\n (fn [[k vs]]\n ; Great, now for this key, find the highest index observed\n (let [vo (get version-orders k)\n ; For each value, what's the earliest index we observed\n ; that value at?\n value->first-index (log->value->first-index (:log vo))\n ; And for each index, which values appeared at that index\n ; *last*?\n last-index->values (log->last-index->values (:log vo))\n\n ; From each value, we take the latest of the earliest\n ; indices that value appeared at.\n bound (->> vs\n ; We might observe a value but *not* know\n ; its offset from either write or read.\n ; When this happens, we can't say anything\n ; about how much of the partition should\n ; have been observed, so we skip it.\n (keep value->first-index)\n (reduce max -1))\n ; Now take a prefix of last-index->values up to that\n ; index; these are the values we should have observed.\n must-read (->> (inc bound)\n (subvec last-index->values 0)\n ; This is a vector of sets. We glue them\n ; together this way to preserve index order.\n (mapcat identity)\n distinct)\n ; To demonstrate these errors to users, we want to prove that\n ; some reader observed the maximum offset (and therefore\n ; someone else should have observed lower offsets).\n max-read (->> (nth last-index->values bound)\n first ; If there were conflicts, any value ok\n (vector k)\n (get-in readers-of)\n first)\n ; Now we go *back* to the read values vs, and strip them\n ; out from the must-read set; anything left is something we\n ; failed to read.\n lost (remove vs must-read)\n ; Because we performed this computation based on the\n ; version order, we may have flagged info/fail writes as\n ; lost. We need to go through and check that the writers\n ; are either a.) OK, or b.) info AND one of their writes\n ; was read.\n lost\n (filter\n (fn double-check [v]\n (let [w (or (get-in writer-of [k v])\n (throw+ {:type :no-writer-of\n :key k\n :value v}))]\n (must-have-committed? reads-by-type w)))\n lost)]\n (->> lost\n (map (fn [v]\n {:key k\n :value v\n :index (get value->first-index v)\n :max-read-index bound\n :writer (get-in writer-of [k v])\n :max-read max-read}))))))\n seq))\n\n(defn strip-types\n \"Takes a collection of maps, and removes their :type fields. Returns nil if\n none remain.\"\n [ms]\n (seq (map (fn [m] (dissoc m :type)) ms)))\n\n(defn int-poll-skip+nonmonotonic-cases-per-key\n \"A reducer for int-poll-skip+nonmonotonic-cases. Takes version orders, an op,\n a rebalanced-keys set, a transient vector of error maps and a [key, values]\n pair from (op-reads). Adds an error if we can find one in some key.\"\n [version-orders op rebalanced-keys errs [k vs]]\n (if (rebalanced-keys k)\n ; We rebalanced this key; we shouldn't expect any kind of internal\n ; consistency.\n errs\n ; Proceed\n (let [{:keys [by-index by-value]} (get version-orders k)]\n ; Zip along each pair of observed values, looking at the delta of their\n ; indices\n (loopr [errs errs\n i1 nil ; Previous index\n v1 ::init] ; Previous value\n [v2 vs]\n (let [; What are their indices in the log?\n i2 (get by-value v2)\n delta (if (and i1 i2)\n (- i2 i1)\n ; We don't know; assume we just incremented by 1\n 1)]\n (recur\n (cond (< 1 delta)\n (conj! errs\n {:type :skip\n :key k\n :values [v1 v2]\n :delta delta\n :skipped (map by-index (range (inc i1) i2))\n :op op})\n\n (< delta 1)\n (conj! errs {:type :nonmonotonic\n :key k\n :values [v1 v2]\n :delta delta\n :op op})\n\n true\n errs)\n i2\n v2))\n ; Done looping through values\n errs))))\n\n(defn int-poll-skip+nonmonotonic-cases\n \"Takes a partial analysis and looks for cases where a single transaction\n contains:\n\n {:skip A pair of poll values which read the same key and skip\n over some part of the log which we know should exist.\n :nonmonotonic A pair of poll values which *contradict* the log order,\n or repeat the same value.}\n\n When a transaction's rebalance log includes a key which would otherwise be\n involved in one of these violations, we don't report it as an error: we\n assume that rebalances invalidate any assumption of monotonically advancing\n offsets.\"\n [{:keys [history version-orders op-reads]}]\n (->> (t/mapcat\n (fn per-op [op]\n (let [rebalanced-keys (->> op :rebalance-log\n (mapcat :keys)\n set)]\n ; Consider each key\n (persistent!\n (reduce (partial int-poll-skip+nonmonotonic-cases-per-key\n version-orders\n op\n rebalanced-keys)\n (transient [])\n (op-reads op))))))\n (t/group-by :type)\n (t/into [])\n (h/tesser history)\n (map-vals strip-types)))\n\n(defn int-send-skip+nonmonotonic-cases\n \"Takes a partial analysis and looks for cases where a single transaction\n contains a pair of sends to the same key which:\n\n {:skip Skips over some indexes of the log\n :nonmonotonic Go backwards (or stay in the same place) in the log}\"\n [{:keys [history version-orders]}]\n (->> history\n (remove (comp #{:invoke} :type))\n (mapcat (fn per-op [op]\n ; Consider each pair of sends to a given key in this op...\n (->> (for [[k vs] (op-writes op)\n [v1 v2] (partition 2 1 vs)]\n (let [{:keys [by-index by-value]} (get version-orders k)\n i1 (get by-value v1)\n i2 (get by-value v2)\n delta (if (and i1 i2)\n (- i2 i1)\n 1)]\n (cond (< 1 delta)\n {:type :skip\n :key k\n :values [v1 v2]\n :delta delta\n :skipped (map by-index (range (inc i1) i2))\n :op op}\n\n (< delta 1)\n {:type :nonmonotonic\n :key k\n :values [v1 v2]\n :delta delta\n :op op})))\n (remove nil?))))\n (group-by :type)\n (map-vals strip-types)))\n\n(defn poll-skip+nonmonotonic-cases-per-process\n \"Per-process helper for poll-skip+nonmonotonic cases.\"\n [version-orders op-reads ops]\n ; Iterate over this process's operations, building up a vector of\n ; errors.\n (loopr\n [errors [] ; A vector of error maps\n last-reads {}] ; A map of key -> op last last read that key\n [op ops]\n (case (:f op)\n ; When we assign or subscribe a new topic, preserve *only*\n ; those last-reads which we're still subscribing to.\n (:assign, :subscribe)\n (recur errors\n (if (#{:invoke :fail} (:type op))\n last-reads\n (select-keys last-reads (:value op))))\n\n (:txn, :poll)\n (let [reads (op-reads op)\n ; Look at each key and values read by this op.\n errs (for [[k reads] reads]\n ; What was the last op that read this key?\n (if-let [last-op (get last-reads k)]\n ; Compare the index of the last thing read by\n ; the last op read to the index of our first\n ; read\n (let [vo (get-in version-orders [k :by-value])\n v (-> last-op op-reads (get k) last)\n v' (first reads)\n i (get vo v)\n i' (get vo v')\n delta (if (and i i')\n (- i' i)\n 1)]\n [(when (< 1 delta)\n ; We can show that this op skipped an\n ; index!\n (let [voi (-> version-orders (get k) :by-index)\n skipped (map voi (range (inc i) i'))]\n {:type :skip\n :key k\n :delta delta\n :skipped skipped\n :ops [last-op op]}))\n (when (< delta 1)\n ; Aha, this wasn't monotonic!\n {:type :nonmonotonic\n :key k\n :values [v v']\n :delta delta\n :ops [last-op op]})])\n ; First read of this key\n nil))\n errors' (->> errs\n (mapcat identity)\n (remove nil?)\n (into errors))\n ; Update our last-reads index for this op's read keys.\n last-reads'\n (case (:type op)\n :ok\n (reduce (fn update-last-read [lr k]\n (assoc lr k op))\n last-reads\n (keys reads))\n\n ; If this was an invoke, nothing changes. If it failed\n ; or crashed, we want the offsets to remain unchanged as\n ; well.\n (:invoke, :fail, :info) last-reads)]\n (recur errors' last-reads'))\n\n ; Some other :f\n (recur errors last-reads))\n ; Done with history\n errors))\n\n(defn poll-skip+nonmonotonic-cases\n \"Takes a partial analysis and checks each process's operations sequentially,\n looking for cases where a single process either jumped backwards or skipped\n over some region of a topic-partition. Returns a task of a map:\n\n {:nonmonotonic Cases where a process started polling at or before a\n previous operation last left off\n :skip Cases where two successive operations by a single process\n skipped over one or more values for some key.}\"\n [{:keys [history by-process version-orders op-reads]}]\n (let [tasks (mapv (fn [[process ops]]\n ; Reduce each process, keeping track of the most recent\n ; read index for each key. Each one is a specific task.\n (h/task history\n poll-skip+nonmonotonic-cases-per-process\n []\n (poll-skip+nonmonotonic-cases-per-process\n version-orders\n op-reads\n ops)))\n by-process)]\n ; Join tasks\n (h/task-call history\n :poll-skip+nonmonotonic-cases\n tasks\n (fn accrete [tasks]\n (->> (mapcat identity tasks)\n (group-by :type)\n (map-vals strip-types))))))\n\n(defn nonmonotonic-send-cases\n \"Takes a partial analysis and checks each process's operations sequentially,\n looking for cases where a single process's sends to a given key go backwards\n relative to the version order.\"\n [{:keys [history by-process version-orders]}]\n ; First, consider each process' completions...\n (->> by-process\n ; Then reduce each process, keeping track of the most recent sent\n ; index for each key.\n (map-vals\n (fn per-process [ops]\n ; Iterate over this process's operations, building up a vector of\n ; errors.\n (loop [ops ops\n errors []\n last-sends {}] ; Key -> Most recent op to send to that key\n (if-not (seq ops)\n ; Done\n errors\n ; Process this op\n (let [op (first ops)]\n (if-not (or (identical? :ok (:type op))\n (identical? :info (:type op)))\n ; Irrelevant\n (recur (next ops)\n errors\n last-sends)\n\n (case (:f op)\n ; When we assign or subscribe a new topic, preserve *only*\n ; those last-reads which we're still subscribing to.\n (:assign, :subscribe)\n (recur (next ops)\n errors\n (if (#{:invoke :fail} (:type op))\n last-sends\n (select-keys last-sends (:value op))))\n\n (:send, :txn)\n (let [; Look at each key and values sent by this op.\n sends (op-writes op)\n errs (for [[k sends] sends]\n ; What was the last op that sent to this key?\n (if-let [last-op (get last-sends k)]\n ; Compare the index of the last thing sent\n ; by the last op to the index of our first\n ; send\n (let [vo (get-in version-orders\n [k :by-value])\n v (-> last-op op-writes (get k)\n last)\n v' (first sends)\n i (get vo v)\n i' (get vo v')\n delta (if (and i i')\n (- i' i)\n 1)]\n (when (< delta 1)\n ; Aha, this wasn't monotonic!\n {:key k\n :values [v v']\n :delta (- i' i)\n :ops [last-op op]}))\n ; First send to this key\n nil))\n errs (->> errs\n (remove nil?))\n ; Update our last-reads index for this op's sent keys\n last-sends' (->> (keys sends)\n (reduce (fn update-last-send [lr k]\n (assoc lr k op))\n last-sends))]\n (recur (next ops) (into errors errs) last-sends'))\n\n ; Some other :f\n (recur (next ops) errors last-sends))))))))\n ; Join together errors from all processes\n (mapcat val)\n seq))\n\n(defn duplicate-cases\n \"Takes a partial analysis and identifies cases where a single value appears\n at more than one offset in a key.\"\n [{:keys [version-orders]}]\n (->> version-orders\n (mapcat (fn per-key [[k version-order]]\n (->> (:log version-order) ; Take every single read value\n (mapcat identity)\n frequencies ; Get a frequency count\n (filter (fn dup? [[value number]]\n (< 1 number)))\n ; And with those dups, construct a more detailed error\n (map (fn [[value number]]\n {:key k\n :value value\n :count number\n ; Run through the log to find offsets\n :offsets (loopr [i 0\n offsets []]\n [vs (:log version-order)]\n (recur (inc i)\n (if (contains? vs value)\n (conj offsets i)\n offsets))\n offsets)})))))\n seq))\n\n(defn unseen\n \"Takes a partial analysis and yields a series of maps like\n\n {:time The time in nanoseconds\n :unseen A map of keys to the number of messages in that key which have\n been successfully acknowledged, but not polled by any client.}\n\n The final map in the series includes a :messages key: a map of keys to sets\n of messages that were unseen.\"\n [{:keys [history op-reads]}]\n (let [; We'll ignore everything but OK txns\n history (->> history\n (h/filter h/ok?)\n (h/filter (h/has-f? #{:poll :send :txn})))\n ; For converting clojure sets to bifurcan\n ->set (fn [k v] (bs/from v))]\n (loopr [; A vector of output observations\n out (transient [])\n ; A map of keys to bifurcan sets of successfully sent values\n sent (b/linear (bm/map))\n ; A bifurcan map of keys to bifurcan sets of successfully read\n ; values\n polled (b/linear (bm/map))]\n ; For each op...\n [{:keys [type f time] :as op} history]\n (let [; Merge in what this op sent\n sent' (bm/merge sent\n (-> op op-writes bm/from\n (bm/map-values ->set))\n bs/union)\n ; Merge in what this op polled\n polled' (bm/merge polled\n (-> op op-reads bm/from\n (bm/map-values ->set))\n bs/union)\n ; What haven't we seen?\n unseen (bm/merge sent' polled' bs/difference)]\n ; We don't have to keep looking for things we've seen, sow e can\n ; recur with unseen rather than sent'\n (recur (conj! out {:time time\n :unseen (-> unseen\n (bm/map-values #(b/size %2))\n datafy)})\n unseen\n polled'))\n ; Done iterating over history\n (let [out (persistent! out)]\n (when (seq out)\n (update out (dec (count out)) assoc :messages\n (-> sent\n (bm/map-values #(datafy %2))\n datafy)))))))\n\n(defn plot-bounds\n \"Quickly determine {:min-x, :max-x, :min-y, :max-y} from a series of [x y]\n points. Nil if there are no points.\"\n [points]\n (when (seq points)\n (loopr [min-x ##Inf\n max-x ##-Inf\n min-y ##Inf\n max-y ##-Inf]\n [[x y] points]\n (let [x (double x)\n y (double y)]\n (recur (min min-x x)\n (max max-x x)\n (min min-y y)\n (max max-y y)))\n {:min-x min-x\n :max-x max-x\n :min-y min-y\n :max-y max-y})))\n\n(defn downsample-plot\n \"Sometimes we wind up feeding absolutely huge plots to gnuplot, which chews\n up a lot of CPU time. We downsample these points, skipping points which are\n close in both x and y.\"\n [points]\n (when (seq points)\n (let [{:keys [min-x max-x min-y max-y]} (plot-bounds points)\n ; Estimate steps for a meaningful change on the plot\n dx (double (/ (- max-x min-x) 200))\n dy (double (/ (- max-y min-y) 100))]\n (loopr [points' (transient [])\n last-x ##-Inf\n last-y ##-Inf]\n [[x y :as point] points]\n (let [x (double x)\n y (double y)]\n (if (or ; Don't downsample when we jump around in time\n (< x last-x)\n (< dx (Math/abs (- x last-x)))\n (< dy (Math/abs (- y last-y))))\n (recur (conj! points' point) x y)\n (recur points' last-x last-y)))\n ; Done\n (let [points' (persistent! points')]\n ;(info \"Downsampled\" (count points) \"to\" (count points') \"points\")\n points')))))\n\n\n(defn plot-unseen!\n \"Takes a test, a collection of unseen measurements, and options (e.g. those\n to checker/check). Plots a graph file (unseen.png) in the store directory.\"\n [test unseen {:keys [subdirectory]}]\n (let [ks (-> unseen peek :unseen keys sort reverse vec)\n ; Turn these into stacked graphs\n datasets (reduce\n (fn [datasets {:keys [time unseen]}]\n ; We go through keys in reverse order so that the last\n ; key in the legend is on the bottom of the chart\n (->> ks reverse\n (reduce (fn [[datasets sum] k]\n (if-let [count (get unseen k 0)]\n (let [t (nanos->secs time)\n sum' (+ sum count)\n dataset (get datasets k [])\n dataset' (conj dataset [t sum'])]\n [(assoc datasets k dataset') sum'])\n ; Key doesn't exist yet\n [datasets sum]))\n [datasets 0])\n first))\n {}\n unseen)\n ; Downsample datasets; plotting lots of points is slow\n datasets (update-vals datasets downsample-plot)\n ; Grab just the final poll section of history\n final-polls (->> test :history rseq\n (take-while (comp #{:poll :crash :assign\n :debug-topic-partitions} :f)))\n ; Draw a line for the start and end of final polls.\n final-poll-lines (->> [(first final-polls) (last final-polls)]\n (map (comp nanos->secs :time))\n (map (fn [t]\n [:set :arrow\n :from (gnuplot/list t [:graph 0])\n :to (gnuplot/list t [:graph 1])\n :lc :rgb \"#F3974A\"\n :lw \"1\"\n :nohead])))\n output (.getCanonicalPath\n (store/path! test subdirectory \"unseen.png\"))\n preamble (concat (perf/preamble output)\n [[:set :title (str (:name test) \" unseen\")]\n '[set ylabel \"Unseen messages\"]]\n final-poll-lines)\n series (for [k ks]\n {:title (str \"key \" k)\n :with '[filledcurves x1]\n :data (datasets k)})]\n (-> {:preamble preamble, :series series}\n perf/with-range\n perf/plot!\n (try+ (catch [:type :jepsen.checker.perf/no-points] _ :no-points)))))\n\n(defn realtime-lag\n \"Takes a history and yields a series of maps of the form\n\n {:process The process performing a poll\n :key The key being polled\n :time The time the read began, in nanos\n :lag The realtime lag of this key, in nanos.\n\n The lag of a key k in a poll is the conservative estimate of how long it has\n been since the highest value in that poll was the final message in log k.\n\n For instance, given:\n\n {:time 1, :type :ok, :value [:send :x [0 :a]]}\n {:time 2, :type :ok, :value [:poll {:x [0 :a]}]}\n\n The lag of this poll is zero, since we observed the most recent completed\n write to x. However, if we:\n\n {:time 3, :type :ok, :value [:send :x [1 :b]]}\n {:time 4, :type :invoke, :value [:poll]}\n {:time 5, :type :ok, :value [:poll {:x []}]}\n\n The lag of this read is 4 - 3 = 1. By time 3, offset 1 must have existed for\n key x. However, the most recent offset we observed was 0, which could only\n have been the most recent offset up until the write of offset 1 at time 3.\n Since our read could have occurred as early as time 4, the lag is at least 1.\n\n Might want to make this into actual [lower upper] ranges, rather than just\n the lower bound on lag, but conservative feels OK for starters.\"\n [history]\n ; First, build up a map of keys to vectors, where element i of the vector for\n ; key k is the time at which we knew offset i+1 was no longer the most recent\n ; thing in the log. Thus the first entry in each vector is the time at which\n ; the log was no longer *empty*. The second entry is the time at which offset\n ; 0 was no longer current, and so on.\n (let [expired\n (reduce\n (fn expired [expired {:keys [type f time value] :as op}]\n ; What are the most recent offsets we know exist?\n (let [known-offsets (op->max-offsets op)]\n (reduce\n (fn [expired [k known-offset]]\n ; For this particulary key, we know this offset exists.\n ; Therefore we *also* know every lower offset should\n ; exist. We zip backwards, filling in offsets with the\n ; current time, until we hit an offset where a lower\n ; time exists.\n (loop [expired-k (get expired k [])\n i known-offset]\n (if (or (neg? i) (get expired-k i))\n ; We've gone back before the start of the vector, or\n ; we hit an index that's already known to be expired\n ; earlier.\n (assoc expired k expired-k)\n ; Update this index\n (recur (assocv expired-k i time) (dec i)))))\n expired\n known-offsets)))\n {}\n history)]\n ; Now work through the history, turning each poll operation into a lag map.\n (loopr [; A map of processes to keys to the highest offset that process has\n ; seen. Keys in this map correspond to the keys this process\n ; currently has :assign'ed. If using `subscribe`, keys are filled in\n ; only when they appear in poll operations. The default offset is\n ; -1.\n process-offsets {}\n ; A vector of output lag maps.\n lags []]\n [{:keys [type process f value] :as op} history]\n (if-not (= :ok type)\n ; Only OK ops matter\n (recur process-offsets lags)\n\n (case f\n ; When we assign something, we replace the process's offsets map.\n :assign\n (recur (let [offsets (get process-offsets process {})]\n ; Preserve keys that we're still subscribing to;\n ; anything else gets reset to offset -1. This is gonna\n ; break if we use something other than auto_offset_reset\n ; = earliest, but... deal with that later. I've got\n ; limited time here and just need to get SOMETHING\n ; working.\n (assoc process-offsets process\n (merge (zipmap value (repeat -1))\n (select-keys offsets value))))\n lags)\n\n ; When we subscribe, we're not necessarily supposed to get\n ; updates for the key we subscribed to--we subscribe to *topics*,\n ; not individual partitions. We might get *no* updates, if other\n ; subscribers have already claimed all the partitions for that\n ; topic. We reset the offsets map to empty, to be conservative.\n :subscribe\n (recur (assoc process-offsets process {}) lags)\n\n (:poll, :txn)\n (let [invoke-time (:time (h/invocation history op))\n ; For poll ops, we merge all poll mop results into this\n ; process's offsets, then figure out how far behind each\n ; key based on the time that key offset expired.\n offsets' (merge-with max\n (get process-offsets process {})\n (op->max-offsets op))\n lags' (->> offsets'\n (map (fn [[k offset]]\n ; If we've read *nothing*, then we're at\n ; offset -1. Element 0 in the expired\n ; vector for k tells us the time when the\n ; first element was definitely present.\n ; If we read offset 0, we want to consult\n ; element 1 of the vector, which tells us\n ; when offset 0 was no longer the tail,\n ; and so on.\n (let [expired-k (get expired k [])\n i (inc offset)\n expired-at (get-in expired\n [k (inc offset)]\n ##Inf)\n lag (-> invoke-time\n (- expired-at)\n (max 0))]\n {:time invoke-time\n :process process\n :key k\n :lag lag})))\n (into lags))]\n (recur (assoc process-offsets process offsets')\n lags'))\n\n ; Anything else, pass through\n (recur process-offsets lags)))\n lags)))\n\n(defn op->thread\n \"Returns the thread which executed a given operation.\"\n [test op]\n (-> op :process (mod (:concurrency test))))\n\n(defn plot-realtime-lag!\n \"Takes a test, a collection of realtime lag measurements, and options (e.g.\n those to checker/check). Plots a graph file (realtime-lag.png) in the store\n directory\"\n [test lags {:keys [nemeses subdirectory filename\n group-fn group-name]}]\n (let [nemeses (or nemeses (:nemeses (:plot test)))\n datasets (->> lags\n (group-by group-fn)\n (map-vals (fn per-group [lags]\n ; At any point in time, we want the maximum\n ; lag for this thread across any key.\n (->> lags\n (util/partition-by-vec :time)\n (mapv (fn ->point [lags]\n (let [p (util/max-by :lag lags)]\n [(nanos->secs (:time p))\n (nanos->secs (:lag p))])))\n downsample-plot))))\n output (.getCanonicalPath\n (store/path! test subdirectory\n (or filename \"realtime-lag.png\")))\n preamble (concat (perf/preamble output)\n [[:set :title (str (:name test)\n \" realtime lag by \"\n group-name)]\n '[set ylabel \"Lag (s)\"]])\n series (for [g (util/polysort (keys datasets))]\n {:title (str group-name \" \" g)\n :with 'linespoints\n :data (datasets g)})]\n (-> {:preamble preamble\n :series series}\n perf/with-range\n perf/plot!\n (try+ (catch [:type :jepsen.checker.perf/no-points] _ :no-points)))))\n\n(defn plot-realtime-lags!\n \"Constructs realtime lag plots for all processes together, and then another\n broken out by process, and also by key.\"\n [{:keys [history] :as test} lags opts]\n (->> [{:group-name \"thread\", :group-fn (partial op->thread test)}\n {:group-name \"key\", :group-fn :key}\n {:group-name \"thread-key\", :group-fn (juxt (partial op->thread test)\n :key)}]\n (mapcat (fn per-group [{:keys [group-name group-fn] :as opts2}]\n (let [opts (merge opts opts2)]\n ; All together\n (cons (h/task history plot-realtime-lag []\n (let [file (str \"realtime-lag-\" group-name\n \".png\")\n opts (assoc opts :filename file)]\n (plot-realtime-lag! test lags opts)))\n ; And broken down\n (->> lags\n (group-by group-fn)\n (map (fn breakdown [[thread lags]]\n (h/task history plot-realtime-lag-sub []\n (plot-realtime-lag!\n test\n lags\n (assoc opts\n :subdirectory\n (str \"realtime-lag-\"\n group-name)\n :filename\n (str thread \".png\")))))))))))\n doall\n (mapv deref)))\n\n(defn worst-realtime-lag\n \"Takes a seq of realtime lag measurements, and finds the point with the\n highest lag.\"\n [lags]\n (or (util/max-by :lag lags) {:time 0 :lag 0}))\n\n(defn key-order-viz\n \"Takes a key, a log for that key (a vector of offsets to sets of elements\n which were observed at that offset) and a history of ops relevant to that\n key. Constructs an XML structure visualizing all sends/polls of that log's\n offsets.\"\n [k log history]\n (let [; Turn an index into a y-coordinate\n i->y (fn [i] (* (inc i) 14))\n ; Turn an offset into an x-coordinate\n offset->x (fn [offset] (* (inc offset) 24))\n ; Constructs an SVG cell for a single value. Takes a log, a y\n ; coordinate, wr (either \"w\" or \"r\", so we can tell what was written vs\n ; read, an offset, and a value.\n cell (fn cell [log y wr offset value]\n (let [compat? (try (-> log (nth offset) count (< 2))\n (catch IndexOutOfBoundsException _\n ; Not in version order, e.g.\n ; a failed send\n true))\n style (str (when-not compat?\n (str \"background: \"\n (rand-bg-color value) \"; \")))]\n [:text (cond-> {:x (offset->x offset)\n :y y\n :style style})\n (str wr value)]))\n ; Turn a log, index, and op, read pairs, and write pairs in that op\n ; into an SVG element\n row (fn row [i {:keys [type time f process value] :as op}\n write-pairs read-pairs]\n (let [y (i->y i)\n rows (concat\n (for [[offset value] read-pairs :when offset]\n (cell log y \"r\" offset value))\n (for [[offset value] write-pairs :when offset]\n (cell log y \"w\" offset value)))]\n (when (seq rows)\n (into [:g {:style (str ; Colored borders based on op type\n \"outline-offset: 1px; \"\n \"outline: 1px solid \"\n (case type\n :ok \"#ffffff\"\n :info \"#FFAA26\"\n :fail \"#FEB5DA\")\n \"; \")}\n [:title (str (name type) \" \" (name f)\n \" by process \" process \"\\n\"\n (pr-str value))]]\n rows))))\n ; Compute rows and bounds\n [_ max-x max-y rows]\n (loopr [i 0\n max-x 0\n max-y 0\n rows []]\n [op history]\n (if-let [row (row i op\n (get (op-write-pairs op) k)\n (get (op-read-pairs op) k))]\n (if-let [cells (drop 3 row)]\n (do ;(info :cells (pr-str cells))\n ;(info :row (pr-str row))\n (let [max-y (->> cells first second :y long\n (max max-y))\n max-x (->> cells\n (map (comp :x second))\n (reduce max max-x)\n long)]\n (recur (inc i)\n max-x\n max-y\n (conj rows row))))\n ; No cells here\n (recur (inc i) max-x max-y (conj rows row)))\n ; Nothing relevant here, skip it\n (recur i max-x max-y rows)))\n ;_ (info :rows (with-out-str (pprint rows)))\n svg (svg/svg {\"version\" \"2.0\"\n \"width\" (+ max-x 20)\n \"height\" (+ max-y 20)}\n [:style \"svg {\n font-family: Helvetica, Arial, sans-serif;\n font-size: 10px;\n }\"]\n (cons :g rows))]\n svg))\n\n(defn render-order-viz!\n \"Takes a test, an analysis, and for each key with certain errors\n renders an HTML timeline of how each operation perceived that key's log.\"\n [test {:keys [version-orders errors history] :as analysis}]\n (let [history (h/remove h/invoke? history)]\n (->> (select-keys errors [:inconsistent-offsets\n :duplicate\n :lost-write\n :G1a])\n (mapcat val)\n (map :key)\n (concat (->> errors :unseen :unseen keys))\n distinct\n (mapv (fn [k]\n (h/task history render-order-viz []\n (let [svg (key-order-viz\n k\n (get-in version-orders [k :log])\n history)\n path (store/path! test \"orders\"\n (if (integer? k)\n (format \"%03d.svg\" k)\n (str k \".svg\")))]\n (spit path (xml/emit svg))))))\n (mapv deref))))\n\n(defn consume-counts\n \"Kafka transactions are supposed to offer 'exactly once' processing: a\n transaction using the subscribe workflow should be able to consume an offset\n and send something to an output queue, and if this transaction is successful,\n it should happen at most once. It's not exactly clear to me *how* these\n semantics are supposed to work--it's clearly not once per consumer group,\n because we routinely see dups with only one consumer group. As a fallback, we\n look for single consumer per process, which should DEFINITELY hold, but...\n appears not to.\n\n We verify this property by looking at all committed transactions which\n performed a poll while subscribed (not assigned!) and keeping track of the\n number of times each key and value is polled. Yields a map of keys to values\n to consumed counts, wherever that count is more than one.\"\n [{:keys [history op-reads]}]\n (loopr [counts {} ; process->k->v->count\n subscribed #{}] ; set of processes which are subscribed\n [{:keys [type f process value] :as op} history]\n (if (not= type :ok)\n (recur counts subscribed)\n (case f\n :subscribe (recur counts (conj subscribed process))\n (:txn, :poll)\n (if (subscribed process)\n ; Increment the count for each value read by this txn\n (recur (loopr [counts counts]\n [[k vs] (op-reads op)\n v vs]\n (recur (update-in\n counts [process k v] (fnil inc 0))))\n subscribed)\n ; Don't care; this might be an assign poll, and assigns are free\n ; to double-consume\n (recur counts subscribed))\n\n ; Default\n (recur counts subscribed)))\n ; Finally, compute a distribution, and filter out anything which was\n ; only read once.\n (loopr [dist (sorted-map)\n dups (sorted-map)]\n [[p k->v->count] counts\n [k v->count] k->v->count\n [v count] v->count]\n (recur (update dist count (fnil inc 0))\n (if (< 1 count)\n (let [k-dups' (-> (get dups k (sorted-map))\n (assoc v count))]\n (assoc dups k k-dups'))\n dups))\n {:distribution dist\n :dup-counts dups})))\n\n(defn writer-of\n \"Takes a history and builds a map of keys to values to the completion\n operation which attempted to write that value.\"\n [history]\n (loopr [writer-of (transient {})]\n [op (remove (comp #{:invoke} :type) history)\n [k vs] (op-writes op)\n v vs]\n (let [k-writer-of (get writer-of k (transient {}))\n k-writer-of' (assoc! k-writer-of v op)]\n (recur (assoc! writer-of k k-writer-of')))\n (map-vals persistent! (persistent! writer-of))))\n\n(defn readers-of\n \"Takes a history and an op-reads fn, and builds a map of keys to values to\n vectors of completion operations which observed those that value.\"\n [history op-reads]\n (loopr [readers (transient {})]\n [op (h/remove h/invoke? history)\n [k vs] (op-reads op)\n v vs]\n (let [k-readers (get readers k (transient {}))\n kv-readers (get k-readers v [])\n kv-readers' (conj kv-readers op)\n k-readers' (assoc! k-readers v kv-readers')]\n (recur (assoc! readers k k-readers')))\n (map-vals persistent! (persistent! readers))))\n\n(defn previous-value\n \"Takes a version order for a key and a value. Returns the previous value in\n the version order, or nil if either we don't know v2's index or v2 was the\n first value in the version order.\"\n [version-order v2]\n (when-let [i2 (-> version-order :by-value (get v2))]\n (when (< 0 i2)\n (-> version-order :by-index (nth (dec i2))))))\n\n(defn mop-index\n \"Takes an operation, a function f (:poll or :send), a key k, and a value v.\n Returns the index (0, 1, ...) within that operation's value which performed\n that poll or send, or nil if none could be found.\"\n [op f k v]\n (loopr [i 0\n mop-index nil]\n [[fun a b] (:value op)]\n (if mop-index\n (recur i mop-index)\n (if (and (= f fun)\n (case f\n :send (and (= k a)\n (if (vector? b)\n (= v (second b))\n (= v b)))\n :poll (when-let [pairs (get a k)]\n (some (comp #{v} second) pairs))))\n (recur (inc i) i)\n (recur (inc i) mop-index)))\n mop-index))\n\n(defrecord WWExplainer [writer-of version-orders]\n elle/DataExplainer\n (explain-pair-data [_ a b]\n (->> (for [[k vs] (op-writes b)\n v2 vs]\n (when-let [v1 (previous-value (version-orders k) v2)]\n (if-let [writer (-> writer-of (get k) (get v1))]\n (when (= a writer)\n {:type :ww\n :key k\n :value v1\n :value' v2\n :a-mop-index (mop-index a :send k v1)\n :b-mop-index (mop-index b :send k v2)})\n (throw+ {:type :no-writer-of-value, :key k, :value v1}))))\n (remove nil?)\n first))\n\n (render-explanation [_ {:keys [key value value'] :as m} a-name b-name]\n (str a-name \" sent \" (pr-str value) \" to \" (pr-str key)\n \" before \" b-name \" sent \" (pr-str value'))))\n\n; A trivial explainer which refuses to acknowledge any connection between\n; things.\n(defrecord NeverExplainer []\n elle/DataExplainer\n (explain-pair-data [_ a b] nil)\n (render-explanation [_ _ _ _] nil))\n\n(defn ww-graph\n \"Analyzes a history to extract write-write dependencies. T1 < T2 iff T1 sends\n some v1 to k and T2 sends some v2 to k and v1 < v2 in the version order.\"\n [{:keys [writer-of version-orders ww-deps]} history]\n {:graph (if-not ww-deps\n ; We might ask not to infer ww dependencies, in which case this\n ; graph is empty.\n (g/op-digraph)\n (loopr [g (b/linear (g/op-digraph))]\n [[k v->writer] writer-of ; For every key\n [v2 op2] v->writer] ; And very value written in that key\n (let [version-order (get version-orders k)]\n (if-let [v1 (previous-value version-order v2)]\n (if-let [op1 (v->writer v1)]\n (if (= op1 op2)\n (recur g) ; No self-edges\n (recur (g/link g op1 op2 ww)))\n (throw+ {:type :no-writer-of-value\n :key k\n :value v1}))\n ; This is the first value in the version order.\n (recur g)))\n (b/forked g)))\n :explainer (if-not ww-deps\n (NeverExplainer.)\n (WWExplainer. writer-of version-orders))})\n\n(defrecord WRExplainer [writer-of op-reads]\n elle/DataExplainer\n (explain-pair-data [_ a b]\n (->> (for [[k vs] (op-reads b)\n v vs]\n (if-let [writer (-> writer-of (get k) (get v))]\n (when (= a writer)\n {:type :wr\n :key k\n :value v\n :a-mop-index (mop-index a :send k v)\n :b-mop-index (mop-index b :poll k v)})\n (throw+ {:type :no-writer-of-value, :key k, :value v})))\n (remove nil?)\n first))\n\n (render-explanation [_ {:keys [key value] :as m} a-name b-name]\n (str a-name \" sent \" (pr-str value) \" to \" (pr-str key)\n \" which was polled by \" b-name)))\n\n(defn wr-graph\n \"Analyzes a history to extract write-read dependencies. T1 < T2 iff T1 writes\n some v to k and T2 reads k.\"\n [{:keys [writer-of readers-of op-reads]} history]\n {:graph (loopr [g (b/linear (g/op-digraph))]\n [[k v->readers] readers-of\n [v readers] v->readers]\n (if-let [writer (-> writer-of (get k) (get v))]\n (let [; The simple way, which is also, per profiler, slow\n ;readers (remove #{writer} readers)\n readers\n (loopr [readers' (b/linear (bl/list))]\n [reader readers]\n (recur\n ; For ops in a history, we have fast equality\n (if (h/index= reader writer)\n readers'\n (bl/add-last readers' reader))))]\n (recur (g/link-to-all g writer readers wr)))\n (throw+ {:type :no-writer-of-value, :key k, :value v}))\n (b/forked g))\n :explainer (WRExplainer. writer-of op-reads)})\n\n(defn graph\n \"A combined Elle dependency graph between completion operations.\"\n [analysis history]\n ((elle/combine (partial ww-graph analysis)\n (partial wr-graph analysis)\n ;(partial rw-graph analysis))\n )\n history))\n\n(defn cycles!\n \"Finds a map of cycle names to cyclic anomalies in a partial analysis.\"\n [{:keys [history directory] :as analysis}]\n ; Bit of a hack--our tests leave off :type fairly often, so we don't bother\n ; running this analysis for those tests.\n (when (:type (first history))\n (let [opts (cond-> {:consistency-models [:strict-serializable]}\n (contains? analysis :directory)\n (assoc :directory (str directory \"/elle\")))\n ; For our purposes, we only want to infer cycles over txn/poll/send\n ; ops\n history (h/filter (h/has-f? #{:txn :poll :send}) history)\n analyzer (->> opts\n txn/additional-graphs\n (into [(partial graph analysis)])\n (apply elle/combine))]\n (:anomalies (txn/cycles! opts analyzer history)))))\n\n(defn analysis\n \"Builds up intermediate data structures used to understand a history. Options\n include:\n\n :directory - Used for generating output files\n :ww-deps - Whether to perform write-write inference on the basis of log\n offsets.\"\n ([history]\n (analysis history {}))\n ([history opts]\n (let [t (fn trace-logging [msg val]\n ;(info msg)\n val)\n history (h/client-ops history)\n ; Basically this whole thing is a giant asynchronous graph of\n ; computation--we want to re-use expensive computational passes\n ; wherever possible. We fire off a bunch of history tasks and let it\n ; handle the dependency graph to maximize concurrency.\n op-reads (h/task history op-reads []\n (t :op-reads (op-reads-index history)))\n unseen (h/task history unseen [op-reads op-reads]\n (t :unseen\n (unseen {:history history\n :op-reads op-reads})))\n writes-by-type (h/task history writes-by-type []\n (t :writes-by-type\n (writes-by-type history)))\n reads-by-type (h/task history reads-by-type [op-reads op-reads]\n (t :reads-by-type\n (reads-by-type history op-reads)))\n version-orders (h/task history version-orders [rs reads-by-type]\n (t :version-orders\n (version-orders history rs)))\n ; Break up version orders into errors vs the orders themselves\n version-order-errors (h/task history version-order-errors\n [vos version-orders]\n (:errors vos))\n version-orders (h/task history version-orders-orders\n [vos version-orders]\n (:orders vos))\n writer-of (h/task history writer-of []\n (writer-of history))\n readers-of (h/task history readers-of [op-reads op-reads]\n (readers-of history op-reads))\n cycles (h/task history cycles [wo writer-of\n ro readers-of\n vos version-orders\n ors op-reads]\n (t :cycles\n (cycles!\n (assoc opts\n :history history\n :writer-of wo\n :readers-of ro\n :version-orders vos\n :op-reads ors))))\n by-process (h/task history by-process []\n (group-by :process history))\n ; Sort of a hack; we only bother computing this for \"real\" histories\n ; because our test suite often leaves off processes and times\n realtime-lag (h/task history realtime-lag []\n (let [op (first history)]\n (when (and (:process op)\n (:time op))\n (realtime-lag history))))\n worst-realtime-lag (h/task history worst-realtime-lag\n [rt realtime-lag]\n (worst-realtime-lag rt))\n precommitted-read-cases (h/task history precommitted-read-cases\n [op-reads op-reads]\n (t :precommitted-read\n (precommitted-read-cases\n {:history history\n :op-reads op-reads})))\n g1a-cases (h/task history g1a-cases [wbt writes-by-type\n wo writer-of\n ors op-reads]\n (t :g1a (g1a-cases\n {:history history\n :writer-of wo\n :writes-by-type wbt\n :op-reads ors})))\n lost-write-cases (h/task history lost-write-cases [vos version-orders\n rbt reads-by-type\n wo writer-of\n ro readers-of]\n (t :lost-write\n (lost-write-cases\n {:history history\n :version-orders vos\n :reads-by-type rbt\n :writer-of wo\n :readers-of ro})))\n poll-skip+nm-cases (h/task history poll-skip+nm-cases\n [bp by-process\n vos version-orders\n ors op-reads]\n (t :poll-skip\n @(poll-skip+nonmonotonic-cases\n {:history history\n :by-process bp\n :version-orders vos\n :op-reads ors})))\n nonmonotonic-send-cases (h/task history nonmonotonic-send-cases\n [bp by-process\n vos version-orders]\n (t :nm-send\n (nonmonotonic-send-cases\n {:history history\n :by-process bp\n :version-orders vos})))\n int-poll-skip+nm-cases (h/task history int-poll-skip+nonmonotonic-cases\n [vos version-orders\n ors op-reads]\n (t :int-poll-skip\n (int-poll-skip+nonmonotonic-cases\n {:history history\n :version-orders vos\n :op-reads ors})))\n int-send-skip+nm-cases (h/task history int-send-skip+nm-cases\n [vos version-orders]\n (t :int-send-skip\n (int-send-skip+nonmonotonic-cases\n {:history history\n :version-orders vos})))\n duplicate-cases (h/task history duplicate-cases [vos version-orders]\n (t :dup (duplicate-cases {:version-orders vos})))\n poll-skip-cases (:skip @poll-skip+nm-cases)\n nonmonotonic-poll-cases (:nonmonotonic @poll-skip+nm-cases)\n int-poll-skip-cases (:skip @int-poll-skip+nm-cases)\n int-nm-poll-cases (:nonmonotonic @int-poll-skip+nm-cases)\n int-send-skip-cases (:skip @int-send-skip+nm-cases)\n int-nm-send-cases (:nonmonotonic @int-send-skip+nm-cases)\n last-unseen (-> (peek @unseen)\n (update :unseen\n (fn [unseen]\n (->> unseen\n (filter (comp pos? val))\n (into (sorted-map)))))\n (update :messages\n (fn [messages]\n (->> messages\n (filter (comp seq val))\n (into (sorted-map))))))\n ]\n {:errors (cond-> {}\n @duplicate-cases\n (assoc :duplicate @duplicate-cases)\n\n int-poll-skip-cases\n (assoc :int-poll-skip int-poll-skip-cases)\n\n int-nm-poll-cases\n (assoc :int-nonmonotonic-poll int-nm-poll-cases)\n\n int-nm-send-cases\n (assoc :int-nonmonotonic-send int-nm-send-cases)\n\n int-send-skip-cases\n (assoc :int-send-skip int-send-skip-cases)\n\n @version-order-errors\n (assoc :inconsistent-offsets @version-order-errors)\n\n @precommitted-read-cases\n (assoc :precommitted-read @precommitted-read-cases)\n\n @g1a-cases\n (assoc :G1a @g1a-cases)\n\n @lost-write-cases\n (assoc :lost-write @lost-write-cases)\n\n nonmonotonic-poll-cases\n (assoc :nonmonotonic-poll nonmonotonic-poll-cases)\n\n @nonmonotonic-send-cases\n (assoc :nonmonotonic-send @nonmonotonic-send-cases)\n\n poll-skip-cases\n (assoc :poll-skip poll-skip-cases)\n\n (seq (:unseen last-unseen))\n (assoc :unseen last-unseen)\n\n true\n (merge @cycles))\n :history history\n :op-reads @op-reads\n :realtime-lag @realtime-lag\n :worst-realtime-lag @worst-realtime-lag\n :unseen @unseen\n :version-orders @version-orders})))\n\n(defn condense-error\n \"Takes a test and a pair of an error type (e.g. :lost-write) and a seq of\n errors. Returns a pair of [type, {:count n, :errors [...]}], which tries to\n show the most interesting or severe errors without making the pretty-printer\n dump out two gigabytes of EDN.\"\n [test [type errs]]\n [type\n (case type\n :unseen (if (:all-errors test)\n errs\n (assoc errs :messages\n (map-vals (comp (partial take 32) sort)\n (:messages errs))))\n {:count (if (coll? errs) (count errs) 1)\n :errs\n (if (:all-errors test)\n errs\n (case type\n :duplicate (take 32 (sort-by :count errs))\n (:G0, :G0-process, :G0-realtime,\n :G1c, :G1c-process, :G1c-realtime)\n (take 8 (sort-by (comp count :steps) errs))\n :inconsistent-offsets (take 32 (sort-by (comp count :values) errs))\n :int-nonmonotonic-poll (take 8 (sort-by :delta errs))\n :int-nonmonotonic-send (take 8 (sort-by :delta errs))\n :int-poll-skip (take-last 8 (sort-by :delta errs))\n :int-send-skip (take-last 8 (sort-by :delta errs))\n :nonmonotonic-poll (take 8 (sort-by :delta errs))\n :nonmonotonic-send (take 8 (sort-by :delta errs))\n :poll-skip (take-last 8 (sort-by :delta errs))\n errs))})])\n\n(defn allowed-error-types\n \"Redpanda does a lot of *things* that are interesting to know about, but not\n necessarily bad or against-spec. For instance, g0 cycles are normal in the\n Kafka transactional model, and g1c is normal with wr-only edges at\n read-uncommitted but *not* with read-committed. This is a *very* ad-hoc\n attempt to encode that so that Jepsen's valid/invalid results are somewhat\n meaningful.\n\n Takes a test, and returns a set of keyword error types (e.g. :poll-skip)\n which this test considers allowable.\"\n [test]\n (cond-> #{; int-send-skip is normal behavior: transaction writes interleave\n ; constantly in the Kafka transaction model. We don't even bother\n ; looking at external send skips.\n :int-send-skip\n ; Likewise, G0 is always allowed, since writes are never isolated\n :G0 :G0-process :G0-realtime\n ; These are less-precise versions of G0/G0-realtime\n :PL-1-cycle-exists :strong-PL-1-cycle-exists\n }\n\n ; With subscribe, we expect external poll skips and nonmonotonic\n ; polls, because our consumer might be rebalanced between\n ; transactions. Without subscribe, we expect consumers to proceed\n ; in order.\n (:subscribe (:sub-via test)) (conj :poll-skip :nonmonotonic-poll)\n\n ; When we include ww edges, G1c is normal--the lack of write\n ; isolation means we should expect cycles like t0 > history\n h/infos\n (h/filter (h/has-f? #{:txn :send :poll}))\n (h/map :error)\n distinct)\n ; Which errors are bad enough to invalidate the test?\n bad-error-types (->> (keys errors)\n (remove (allowed-error-types test))\n sort)\n ; Render plots\n order-viz-task (h/task history order-viz []\n (render-order-viz! test analysis))\n plot-unseen-task (h/task history plot-unseen []\n (plot-unseen! test unseen opts))\n plot-realtime-lags-task (h/task history plot-realtime-lags []\n (plot-realtime-lags!\n test realtime-lag opts))]\n ; Block on tasks\n @consume-counts-task\n @order-viz-task\n @plot-unseen-task\n @plot-realtime-lags-task\n\n ; Construct results\n (->> errors\n (map (partial condense-error test))\n (into (sorted-map))\n (merge {:valid? (empty? bad-error-types)\n :worst-realtime-lag (-> worst-realtime-lag\n (update :time nanos->secs)\n (update :lag nanos->secs))\n :bad-error-types bad-error-types\n :error-types (sort (keys errors))\n :info-txn-causes info-txn-causes}))))))\n\n(defn stats-checker\n \"Wraps a (jepsen.checker/stats) with a new checker that returns the same\n results, except it won't return :valid? false if :crash or\n :debug-topic-partitions ops always crash. You might want to wrap your\n existing stats checker with this.\"\n ([]\n (stats-checker (checker/stats)))\n ([c]\n (reify checker/Checker\n (check [this test history opts]\n (let [res (checker/check c test history opts)]\n (if (every? :valid? (vals (dissoc (:by-f res)\n :debug-topic-partitions\n :crash)))\n (assoc res :valid? true)\n res))))))\n\n(defn workload\n \"Constructs a workload (a map with a generator, client, checker, etc) given\n an options map. Options are:\n\n :crash-clients? If set, periodically emits a :crash operation which the\n client responds to with :info; this forces the client to be\n torn down and replaced by a fresh client.\n\n :crash-client-interval How often, in seconds, to crash clients. Default is\n 30 seconds.\n\n :sub-via A set of subscription methods: either #{:assign} or\n #{:subscribe}.\n\n :txn? If set, generates transactions with multiple send/poll\n micro-operations.\n\n :sub-p The probability that the generator emits an\n assign/subscribe op.\n\n These options must also be present in the test map, because they are used by\n the checker, client, etc at various points. For your convenience, they are\n included in the workload map returned from this function; merging that map\n into your test should do the trick.\n\n ... plus those taken by jepsen.tests.cycle.append/test, e.g. :key-count,\n :min-txn-length, ...\"\n [opts]\n (let [workload (append/test\n (assoc opts\n ; TODO: don't hardcode these\n :max-txn-length (if (:txn? opts) 4 1)))\n max-offsets (atom (sorted-map))]\n (-> workload\n (merge (select-keys opts [:crash-clients?\n :crash-client-interval\n :sub-via\n :txn?]))\n (assoc :checker (checker)\n :final-generator (gen/each-thread (final-polls max-offsets))\n :generator (gen/any\n (crash-client-gen opts)\n (->> (:generator workload)\n txn-generator\n tag-rw\n (track-key-offsets max-offsets)\n (interleave-subscribes opts)\n poll-unseen))))))\n" }, { "path": "jepsen/src/jepsen/tests/linearizable_register.clj", "content": "(ns jepsen.tests.linearizable-register\n \"Common generators and checkers for linearizability over a set of independent\n registers. Clients should understand three functions, for writing a value,\n reading a value, and compare-and-setting a value from v to v'. Reads receive\n `nil`, and replace it with the value actually read.\n\n {:type :invoke, :f :write, :value [k v]}\n {:type :invoke, :f :read, :value [k nil]}\n {:type :invoke, :f :cas, :value [k [v v']]}\"\n (:refer-clojure :exclude [test])\n (:require [jepsen [client :as client]\n [checker :as checker]\n [independent :as independent]\n [generator :as gen]\n [random :as rand]]\n [jepsen.checker.timeline :as timeline]\n [knossos.model :as model]))\n\n(defn w [_ _] {:type :invoke, :f :write, :value (rand/long 5)})\n(defn r [_ _] {:type :invoke, :f :read})\n(defn cas [_ _] {:type :invoke, :f :cas, :value [(rand/long 5) (rand/long 5)]})\n\n(defn test\n \"A partial test, including a generator, model, and checker. You'll need to\n provide a client. Options:\n\n :nodes A set of nodes you're going to operate on. We only care\n about the count, so we can figure out how many workers\n to use per key.\n :model A model for checking. Default is (model/cas-register).\n :per-key-limit Maximum number of ops per key.\n :process-limit Maximum number of processes that can interact with a\n given key. Default 20.\"\n [opts]\n {:checker (independent/checker\n (checker/compose\n {:linearizable (checker/linearizable\n {:model (:model opts (model/cas-register))})\n :timeline (timeline/html)}))\n :generator (let [n (count (:nodes opts))]\n (independent/concurrent-generator\n (* 2 n)\n (range)\n (fn [k]\n (cond->> (gen/reserve n r (gen/mix [w cas cas]))\n ; We randomize the limit a bit so that over time, keys\n ; become misaligned, which prevents us from lining up\n ; on Significant Event Boundaries.\n (:per-key-limit opts)\n (gen/limit (* (+ (rand/double 0.1) 0.9)\n (:per-key-limit opts 20)))\n\n true\n (gen/process-limit (:process-limit opts 20))))))})\n" }, { "path": "jepsen/src/jepsen/tests/long_fork.clj", "content": "(ns jepsen.tests.long-fork\n \"Tests for an anomaly in parallel snapshot isolation (but which is prohibited\n in normal snapshot isolation). In long-fork, concurrent write transactions\n are observed in conflicting order. For example:\n\n T1: (write x 1)\n T2: (write y 1)\n T3: (read x nil) (read y 1)\n T4: (read x 1) (read y nil)\n\n T3 implies T2 < T1, but T4 implies T1 < T2. We aim to observe these\n conflicts.\n\n To generalize to multiple updates...\n\n Let a write transaction be a transaction of the form [(write k v)], executing\n a single write to a single register. Assume no two write transactions have\n the same key *and* value.\n\n Let a read transaction be a transaction of the form [(read k1 v1) (read k2\n v2) ...], reading multiple distinct registers.\n\n Let R be a set of reads, and W be a set of writes. Let the total set of\n transactions T = R U W; e.g. there are only reads and writes. Let the initial\n state be empty.\n\n Serializability implies that there should exist an order < over T, such that\n every read observes the state of the system as given by the prefix of all\n write transactions up to some point t_i.\n\n Since each value is written exactly once, a sequence of states with the same\n value for a key k must be *contiguous* in this order. That is, it would be\n illegal to read:\n\n [(r x 0)] [(r x 1)] [(r x 0)]\n\n ... because although we can infer (w x 0) happened before t1, and (w x 1)\n happened between t2, there is no *second* (w x 0) that can satisfy t3.\n Visually, imagine bars which connect identical values from reads, keeping\n them together:\n\n key r1 r2 r3 r4\n\n x 0 1 --- 1 --- 1\n\n y 0 1 --- 1 0\n\n z 0 --- 0 2 1\n\n A long fork anomaly manifests when we cannot construct an order where these\n bars connect identical values into contiguous blocks.\n\n Note that more than one value may change between reads: we may not observe\n every change.\n\n Note that the values for a given key are not monotonic; we must treat them as\n unordered, opaque values because the serialization order of writes is (in\n general) arbitrary. It would be easier if we knew the write order up front.\n The classic example of long fork uses inserts because we know the states go\n from `nil` to `some-value`, but in our case, it could be 0 -> 1, or 1 -> 0.\n\n To build a graph like this, we need an incremental process. We know the\n initial state was [nil nil nil ...], so we can start there. Let our sequence\n be:\n\n r0\n\n x nil\n y nil\n z nil\n\n We know that values can only change *away* from nil. This implies that those\n reads with the most nils must come adjacent to r0. In general, if there\n exists a read r1 adjacent to r0, then there must not exist any read r2 such\n that r2 has more in common with r0 than r1. This assumes that all reads are\n total.\n\n Additionally, if the graph is to be... smooth, as opposed to forking, there\n are only two directions to travel from any given read. This implies there can\n be at most two reads r1 and r2 with an equal number of links *and* distinct\n links to r0. If a third read with this property exists, there's 'nowhere to\n put it' without creating a fork.\n\n We can verify this property in roughly linear time, which is nice. It\n doesn't, however, prevent *closed loops* with no forking structure.\n\n To do loops, I think we have to actually do the graph traversal. Let's punt\n on that for now.\"\n (:require [clojure.tools.logging :refer [info warn]]\n [jepsen [generator :as gen]\n [checker :as checker]\n [history :as h]\n [random :as rand]\n [util]]\n [jepsen.txn.micro-op :as mop]\n [clj-commons.slingshot :refer [try+ throw+]]))\n\n(defn group-for\n \"Takes a key and returns the collection of keys for its group.\n Lower inclusive, upper exclusive.\"\n [n k]\n (let [m (mod k n)\n l (- k m)\n u (+ l n)]\n (range l u)))\n\n(defn read-txn-for\n \"Takes a group size and a key and generates a transaction reading that key's\n group in shuffled order.\"\n [n k]\n (->> (group-for n k)\n rand/shuffle\n (mapv (fn [k] [:r k nil]))))\n\n; n is the group size.\n; next-key is the next free key we have to allocate.\n; workers is a map of worker numbers to the last key that worker wrote.\n(defrecord Generator [n next-key workers]\n gen/Generator\n (update [this test ctx event] this)\n\n (op [this test ctx]\n ; If a worker's last written key is nil, it can either issue a read for a\n ; write in progress, or it can perform a write itself. To write, it\n ; generates a fresh integer from next-key. and writes it, recording that\n ; key in the workers map. If it *is* present in the map, it issues a read\n ; to the group covering that key.\n (let [process (gen/some-free-process ctx)\n worker (gen/process->thread ctx process)]\n (if worker\n (if-let [k (get workers worker)]\n ; We wrote a key; produce a read and clear our last written key.\n [(gen/fill-in-op\n {:process process, :f :read, :value (read-txn-for n k)}\n ctx)\n (Generator. n next-key (assoc workers worker nil))]\n ; OK we didn't wite a key--let's try one of two random options.\n (if-let [k (and (< (rand/double) 0.5)\n (rand/nth-empty (keep val workers)))]\n ; Read some other active group\n [(gen/fill-in-op\n {:process process, :f :read, :value (read-txn-for n k)}\n ctx)\n this]\n\n ; Write a fresh key\n [(gen/fill-in-op\n {:process process, :f :write, :value [[:w next-key 1]]}\n ctx)\n (Generator. n (inc next-key) (assoc workers worker next-key))]))\n [:pending this]))))\n\n(defn generator\n \"Generates single inserts followed by group reads, mixed with reads of other\n concurrent groups, just for grins. Takes a group size n.\"\n [n]\n (Generator. n 0 {}))\n\n(defn read-compare\n \"Given two maps of keys to values, a and b, returns -1 if a dominates, 0 if\n the two are equal, 1 if b dominates, or nil if a and b are incomparable.\"\n [a b]\n (when (not= (count a) (count b))\n (throw+ {:type :illegal-history\n :reads [a b]\n :msg \"These reads did not query for the same keys, and therefore cannot be compared.\"}))\n\n (reduce (fn [res k]\n (let [va (get a k)\n vb (get b k ::not-found)]\n (cond ; Different key sets\n (= ::not-found vb)\n (throw+ {:type :illegal-history\n :reads [a b]\n :key k\n :msg \"These reads did not query for the same keys, and therefore cannot be compared.\"})\n\n ; Both equal\n (= va vb) res\n\n ; A bigger here\n (nil? vb) (if (pos? res)\n (reduced nil)\n -1)\n\n ; B bigger here\n (nil? va) (if (neg? res)\n (reduced nil)\n 1)\n\n ; Different values, both present; this is illegal\n true (throw+ {:type :illegal-history\n :key k\n :msg \"These two read states contain distinct values for the same key; this checker assumes only one write occurs per key.\"\n :reads [a b]}))))\n 0\n (keys a)))\n\n(defn read-op->value-map\n \"Takes a read operation, and converts it to a map of keys to values.\"\n [op]\n (loop [ops (seq (:value op))\n m (transient {})]\n (if-not ops\n (persistent! m)\n (let [[f k v] (first ops)]\n (recur (next ops) (assoc! m k v))))))\n\n(defn distinct-pairs\n \"Given a collection, returns a sequence of all unique 2-element sets taken\n from that collection.\"\n [coll]\n (->> (for [a coll, b coll :when (not= a b)] #{a b})\n distinct\n (map vec)))\n\n(defn find-forks\n \"Given a set of read ops, compares every one to ensure a total order exists.\n If mutually incomparable reads exist, returns the pair.\"\n [ops]\n (->> (distinct-pairs ops)\n (keep (fn [[a b]]\n (when (nil? (read-compare (read-op->value-map a)\n (read-op->value-map b)))\n [a b])))))\n\n(defn read-txn?\n \"Is this transaction a pure read txn?\"\n [txn]\n (every? mop/read? txn))\n\n(defn write-txn?\n \"Is this a pure write transaction?\"\n [txn]\n (and (= 1 (count txn))\n (mop/write? (first txn))))\n\n(defn legal-txn?\n \"Checks to ensure a txn is legal.\"\n [txn]\n (or (read-txn? txn)\n (write-txn? txn)))\n\n(defn op-read-keys\n \"Given a read op, returns the set of keys read.\"\n [op]\n (->> op :value (map mop/key) set))\n\n(defn groups\n \"Given a group size n, and a set of read ops, partitions those read\n operations by group. Throws if any group has the wrong size.\"\n [n read-ops]\n (reduce (fn [groups [group ops]]\n (when (not= n (count group))\n (throw+ {:type :illegal-history\n :op (first ops)\n :msg (str \"Every read in this history should have observed exactly \"\n n \" keys, but this read observed \"\n (count group) \" instead: \" (pr-str group))}))\n (conj groups ops))\n []\n (group-by op-read-keys read-ops)))\n\n(defn ensure-no-long-forks\n \"Returns a checker error if any long forks exist.\"\n [n reads]\n (let [forks (->> reads\n (groups n)\n (mapcat find-forks))]\n (when (seq forks)\n {:valid? false\n :forks forks})))\n\n(defn ensure-no-multiple-writes-to-one-key\n \"Returns a checker error if we have multiple writes to one key, or nil if\n things are OK.\"\n [history]\n (let [res (->> history\n h/invokes\n (h/filter (comp write-txn? :value))\n (reduce (fn [ks op]\n (let [k (-> op :value first second)]\n (if (get ks k)\n (reduced {:valid? :unknown\n :error [:multiple-writes k]})\n (conj ks k))))\n #{}))]\n (when (map? res)\n res)))\n\n(defn reads\n \"All ok read ops\"\n [history]\n (->> history\n h/oks\n (h/filter (comp read-txn? :value))))\n\n(defn early-reads\n \"Given a set of read txns finds those that are too early to tell us anything;\n e.g. all nil\"\n [reads]\n (->> (map :value reads)\n (remove (partial some mop/value))))\n\n(defn late-reads\n \"Given a set of read txns, finds those that are too late to tell us anything;\n e.g. all 1.\"\n [reads]\n (->> (map :value reads)\n (filter (partial every? mop/value))))\n\n(defn checker\n \"Takes a group size n, and a history of :txn transactions. Verifies that no\n key is written multiple times. Searches for read transactions where one read\n observes x but not y, and another observes y but not x.\"\n [n]\n (reify checker/Checker\n (check [this test history opts]\n (let [reads (reads history)]\n (merge {:reads-count (count reads)\n :early-read-count (count (early-reads reads))\n :late-read-count (count (late-reads reads))}\n (or (ensure-no-multiple-writes-to-one-key history)\n (ensure-no-long-forks n reads)\n {:valid? true}))))))\n\n(defn workload\n \"A package of a checker and generator to look for long forks. n is the group\n size: how many keys to check simultaneously.\"\n ([] (workload 2))\n ([n]\n {:checker (checker n)\n :generator (generator n)}))\n" }, { "path": "jepsen/src/jepsen/tests.clj", "content": "(ns jepsen.tests\n \"Provide utilities for writing tests using jepsen.\"\n (:require [jepsen.os :as os]\n [jepsen.db :as db]\n [jepsen.client :as client]\n [jepsen.control :as control]\n [jepsen.nemesis :as nemesis]\n [jepsen.checker :as checker]\n [jepsen.net :as net]))\n\n(def noop-test\n \"Boring test stub.\n Typically used as a basis for writing more complex tests.\n \"\n {:nodes [\"n1\" \"n2\" \"n3\" \"n4\" \"n5\"]\n :name \"noop\"\n :os os/noop\n :db db/noop\n :net net/iptables\n :remote control/ssh\n :client client/noop\n :nemesis nemesis/noop\n :generator nil\n :checker (checker/unbridled-optimism)})\n\n(defn atom-db\n \"Wraps an atom as a database.\"\n [state]\n (reify db/DB\n (setup! [db test node] (reset! state 0))\n (teardown! [db test node] (reset! state :done))))\n\n(defn atom-client\n \"A CAS client which uses an atom for state. Should probably move this into\n core-test.\"\n ([state]\n (atom-client state (atom [])))\n ([state meta-log]\n (reify client/Client\n (open! [this test node]\n (swap! meta-log conj :open)\n this)\n (setup! [this test]\n (swap! meta-log conj :setup)\n this)\n (teardown! [this test] (swap! meta-log conj :teardown))\n (close! [this test] (swap! meta-log conj :close))\n (invoke! [this test op]\n ; We sleep here to make sure we actually have some concurrency.\n (Thread/sleep 1)\n (case (:f op)\n :write (do (reset! state (:value op))\n (assoc op :type :ok))\n\n :cas (let [[cur new] (:value op)]\n (try\n (swap! state (fn [v]\n (if (= v cur)\n new\n (throw (RuntimeException. \"CAS failed\")))))\n (assoc op :type :ok)\n (catch RuntimeException e\n (assoc op :type :fail))))\n\n :read (assoc op :type :ok\n :value @state))))))\n" }, { "path": "jepsen/src/jepsen/util.clj", "content": "(ns jepsen.util\n \"Kitchen sink\"\n (:refer-clojure :exclude [parse-long]) ; Clojure added this in 1.11.1\n (:require [clj-time.core :as time]\n [clj-time.local :as time.local]\n [clojure [string :as str]\n [pprint :as pprint]\n [walk :as walk]]\n [clojure.core.reducers :as r]\n [clojure.data.generators :as dg]\n [clojure.java [io :as io]\n [shell :as shell]]\n [clojure.tools.logging :refer [debug info warn]]\n [dom-top.core :as dt :refer [loopr bounded-future]]\n [fipp.ednize]\n [jepsen [generator :as gen]\n [history :as h]\n [print :as print :refer [pprint]]\n [random :as rand]]\n [jepsen.history.fold :refer [loopf]]\n [potemkin :refer [definterface+ import-vars]]\n [clj-commons.slingshot :refer [try+ throw+]]\n [tesser.core :as t])\n (:import (java.lang.reflect Method)\n (java.util.concurrent.locks LockSupport)\n (java.util.concurrent ExecutionException)\n (java.io File\n RandomAccessFile)\n (jepsen.history Op)))\n\n; These are functions that used to live in util, but are now in their own\n; namespaces.\n(import-vars [jepsen.random\n :refer [zipf exp nonempty-subset nth-empty]\n :rename {exp rand-exp\n nonempty-subset random-nonempty-subset\n nth rand-nth\n nth-empty rand-nth-empty}])\n\n\n(defn default\n \"Like assoc, but only fills in values which are NOT present in the map.\"\n [m k v]\n (if (contains? m k)\n m\n (assoc m k v)))\n\n(defn exception?\n \"Is x an Exception?\"\n [x]\n (instance? Exception x))\n\n(defn fcatch\n \"Takes a function and returns a version of it which returns, rather than\n throws, exceptions.\"\n [f]\n (fn wrapper [& args]\n (try (apply f args)\n (catch Exception e e))))\n\n(defn exception-message\n \"In several places we catch ExceptionInfos, and their string representations\n usually conceal the important information in their data maps. This function\n returns a string, suitable for logging, describing an error. It takes a\n Throwable and any number of args, joined together with spaces. For ex-infos,\n it follows that with a pretty-printed ex-data map.\"\n ([^Throwable t, msg]\n (if (instance? clojure.lang.ExceptionInfo t)\n (str msg \"\\n\" (with-out-str (pprint (ex-data t))))\n msg))\n ([t msg & more-messages]\n (exception-message t (str msg \" \" (str/join \" \" more-messages)))))\n\n(defn name+\n \"Tries name, falls back to pr-str.\"\n [x]\n (if (instance? clojure.lang.Named x)\n (name x)\n (pr-str x)))\n\n(def uninteresting-exceptions\n \"Exceptions which are less interesting; used by real-pmap and other cases where we want to pick a *meaningful* exception.\"\n #{java.util.concurrent.BrokenBarrierException\n java.util.concurrent.TimeoutException\n InterruptedException})\n\n(defn real-pmap\n \"Like pmap, but runs a thread per element, which prevents deadlocks when work\n elements have dependencies. The dom-top real-pmap throws the first exception\n it gets, which might be something unhelpful like InterruptedException or\n BrokenBarrierException. This variant works like that real-pmap, but throws\n more interesting exceptions when possible.\"\n [f coll]\n (let [[results exceptions] (dt/real-pmap-helper f coll)]\n (when (seq exceptions)\n (throw (or (first (remove (comp uninteresting-exceptions class)\n exceptions))\n (first exceptions))))\n results))\n\n(defn processors\n \"How many processors on this platform?\"\n []\n (.. Runtime getRuntime availableProcessors))\n\n(defmacro with-shutdown-hook\n \"Takes an expression and a body. Registers the expression as a shutdown hook.\n Evaluates body, then unregisters the shutdown hook.\"\n [hook & body]\n `(let [^Runnable hook-fn# (bound-fn []\n (with-thread-name \"Jepsen shutdown hook\"\n ~hook))\n ^Thread hook-thread# (Thread. hook-fn#)]\n (.. (Runtime/getRuntime) (addShutdownHook hook-thread#))\n (try ~@body\n (finally\n (.. (Runtime/getRuntime) (removeShutdownHook hook-thread#))))))\n\n(defn majority\n \"Given a number, returns the smallest integer strictly greater than half.\"\n [n]\n (inc (long (Math/floor (/ n 2)))))\n\n(defn minority\n \"Given a number, returns the largest integer strictly less than half. Minimum\n 0.\"\n [n]\n (max 0 (dec (long (Math/ceil (/ n 2))))))\n\n(defn minority-third\n \"Given a number, returns the largest integer strictly less than 1/3rd.\n Helpful for testing byzantine fault-tolerant systems.\"\n [n]\n (-> n dec (/ 3) long))\n\n(defn partition-by-vec\n \"A faster version of partition-by which returns a vector of vectors, rather\n than using lazy seqs. Comes at the cost of eager evaluation.\"\n [f xs]\n (if (seq xs)\n (loopr [fx ::init ; (f x)\n chunks (transient [])\n chunk (transient [])]\n [x' xs]\n (let [fx' (f x')]\n (cond ; Same chunk\n (= fx fx')\n (recur fx chunks (conj! chunk x'))\n\n ; New chunk. First element?\n (identical? ::init fx)\n (recur fx' chunks (conj! chunk x'))\n\n ; New chunk, later element\n true\n (recur fx'\n (conj! chunks (persistent! chunk))\n (transient [x']))))\n ; Done; fold in last chunk\n (let [chunk (persistent! chunk)]\n (persistent!\n (if (= 0 (count chunk))\n chunks\n (conj! chunks chunk)))))\n []))\n\n(defn extreme-by*\n \"Helper for min-by and max-by\"\n [f coll retain?]\n (loopr [x nil\n fx ::init]\n [x' coll]\n (let [fx' (f x')]\n (cond ; First round\n (identical? fx ::init)\n (recur x' fx')\n\n ; x' bigger\n (retain? (compare fx fx'))\n (recur x' fx')\n\n ; Keep looking\n true\n (recur x fx)))\n x))\n\n(defn min-by\n \"Finds the minimum element of a collection based on some (f element), which\n returns Comparables. If `coll` is empty, returns nil.\"\n [f coll]\n (extreme-by* f coll pos?))\n\n(defn max-by\n \"Finds the maximum element of a collection based on some (f element), which\n returns Comparables. If `coll` is empty, returns nil.\"\n [f coll]\n (extreme-by* f coll neg?))\n\n(defn fast-last\n \"Like last, but O(1) on counted collections.\"\n [coll]\n (nth coll (dec (count coll))))\n\n(defn rand-distribution\n \"Generates a random value with a distribution (default `:uniform`) of:\n\n ```clj\n ; Uniform distribution from min (inclusive, default 0) to max (exclusive,\n ; default Long/MAX_VALUE).\n {:distribution :uniform, :min 0, :max 1024}\n\n ; Geometric distribution with mean 1/p, starting at 0.\n {:distribution :geometric, :p 1e-3}\n\n ; Zipfian integer in [0, n) with skew s (default ~1)\n {:distribution :zipf, :n 10, :skew 1.5}\n\n ; Select a value from a sequence with equal probability.\n {:distribution :one-of, :values [-1, 4097, 1e+6]}\n\n ; Select a value based on weights. :weights are {value weight ...}\n {:distribution :weighted :weights {1e-3 1 1e-4 3 1e-5 1}}\n ```\"\n ([] (rand-distribution {}))\n ([distribution-map]\n (let [{:keys [distribution min max p n skew values weights]} distribution-map\n distribution (or distribution :uniform)\n min (or min 0)\n max (or max Long/MAX_VALUE)\n _ (assert (case distribution\n :uniform (< min max)\n :geometric (number? p)\n :zipf (and (integer? n)\n (or (nil? skew) (number? skew)))\n :one-of (seq values)\n :weighted (and (map? weights)\n (->> weights\n vals\n (every? number?)))\n false)\n (str \"Invalid distribution-map: \" distribution-map))]\n (case distribution\n :uniform (rand/long min max)\n :geometric (rand/geometric p)\n :zipf (if skew\n (rand/zipf skew n)\n (rand/zipf n))\n :one-of (rand/nth values)\n :weighted (rand/weighted weights)))))\n\n(defn fraction\n \"a/b, but if b is zero, returns unity.\"\n [a b]\n (if (zero? b)\n 1\n (/ a b)))\n\n(defn inc*\n \"Like inc, but (inc nil) => 1.\"\n [x]\n (if (nil? x)\n 1\n (inc x)))\n\n(defn local-time\n \"Local time.\"\n []\n (time.local/local-now))\n\n(defn chunk-vec\n \"Partitions a vector into reducibles of size n (somewhat like partition-all)\n but uses subvec for speed.\n\n (chunk-vec 2 [1]) ; => ([1])\n (chunk-vec 2 [1 2 3]) ; => ([1 2] [3])\"\n ([^long n v]\n (let [c (count v)]\n (->> (range 0 c n)\n (map #(subvec v % (min c (+ % n))))))))\n\n(defn concat-files!\n \"Moved to jepsen.print/concat-files!\"\n [out fs]\n (print/concat-files! out fs))\n\n(defn op->str\n \"Moved to jepsen.print/op->str\"\n [op]\n (print/op->str op))\n\n(defn prn-op\n \"Moved to jepsen.print/prn-op\"\n [op]\n (print/prn-op op))\n\n(defn print-history\n \"Moved to jepsen.print/print-history\"\n ([history]\n (print/print-history history))\n ([printer history]\n (print/print-history printer history)))\n\n(defn write-history!\n \"Moved to jepsen.print/write-history!\"\n ([f history]\n (print/write-history! f history))\n ([f printer history]\n (print/write-history! f printer history)))\n\n(defn pwrite-history!\n \"Moved to jepsen.print/pwrite-history!\"\n ([f history]\n (print/pwrite-history! f history))\n ([f printer history]\n (print/pwrite-history! f printer history)))\n\n(defn log-op\n \"Moved to jepsen.print/log-op\"\n [op]\n (print/log-op op))\n\n(def log-print\n \"Moved to jepsen.print/log-print\"\n print/log-print)\n\n(def log\n \"Moved to jepsen.print/log\"\n print/log)\n\n(defn test->str\n \"Moved to jepsen.print/test->str\"\n [test]\n (print/test->str test))\n\n(defn all-jdk-loggers\n \"Moved to jepsen.print/all-jdk-loggers\"\n []\n (print/all-jdk-loggers))\n\n(defmacro mute-jdk\n \"Moved to jepsen.print/mute-jdk\"\n [& body]\n `(print/mute-jdk ~@body))\n\n(defmacro mute\n \"Moved to jepsen.print/mute\"\n [& body]\n `(print/mute ~@body))\n\n(defn ms->nanos [ms] (* ms 1000000))\n\n(defn nanos->ms [nanos] (/ nanos 1000000))\n\n(defn secs->nanos [s] (* s 1e9))\n\n(defn nanos->secs [nanos] (/ nanos 1e9))\n\n(defn ^Long linear-time-nanos\n \"A linear time source in nanoseconds.\"\n []\n (System/nanoTime))\n\n(def ^:dynamic ^Long *relative-time-origin*\n \"A reference point for measuring time in a test run.\"\n nil)\n\n(defmacro with-relative-time\n \"Binds *relative-time-origin* at the start of body.\"\n [& body]\n `(binding [*relative-time-origin* (linear-time-nanos)]\n (info \"Relative time begins now\")\n ~@body))\n\n(defn relative-time-nanos\n \"Time in nanoseconds since *relative-time-origin*\"\n []\n (- (linear-time-nanos) *relative-time-origin*))\n\n(defn sleep\n \"High-resolution sleep; takes a (possibly fractional) time in ms.\"\n [dt]\n (let [t (+ (long (ms->nanos dt))\n (System/nanoTime))]\n (while (< (+ (System/nanoTime) 10000) t)\n (LockSupport/parkNanos (- t (System/nanoTime))))))\n\n(defmacro time-\n [& body]\n `(let [t0# (System/nanoTime)]\n ~@body\n (nanos->ms (- (System/nanoTime) t0#))))\n\n(defn pprint-str\n \"Moved to print/pprint-str\"\n [x]\n (print/pprint-str x))\n\n(defn spy\n \"Moved to print/spy\"\n [x]\n (print/spy x))\n\n(defmacro timeout\n \"Times out body after n millis, returning timeout-val.\"\n [millis timeout-val & body]\n `(let [worker# (future ~@body)\n retval# (try\n (deref worker# ~millis ::timeout)\n (catch ExecutionException ee#\n (throw (.getCause ee#))))]\n (if (= retval# ::timeout)\n (do (future-cancel worker#)\n ~timeout-val)\n retval#)))\n\n(defn await-fn\n \"Invokes a function (f) repeatedly. Blocks until (f) returns, rather than\n throwing. Returns that return value. Catches Exceptions (except for\n InterruptedException) and retries them automatically. Options:\n\n :retry-interval How long between retries, in ms. Default 1s.\n :log-interval How long between logging that we're still waiting, in ms.\n Default `retry-interval.\n :log-message What should we log to the console while waiting?\n :timeout How long until giving up and throwing :type :timeout, in\n ms. Default 60 seconds.\"\n ([f]\n (await-fn f {}))\n ([f opts]\n (let [log-message (:log-message opts (str \"Waiting for \" f \"...\"))\n retry-interval (long (:retry-interval opts 1000))\n log-interval (:log-interval opts retry-interval)\n timeout (:timeout opts 60000)\n t0 (linear-time-nanos)\n log-deadline (atom (+ t0 (* 1e6 log-interval)))\n deadline (+ t0 (* 1e6 timeout))]\n (loop []\n (let [res (try\n (f)\n (catch InterruptedException e\n (throw e))\n (catch Exception e\n (let [now (linear-time-nanos)]\n ; Are we out of time?\n (when (<= deadline now)\n (throw+ {:type :timeout} e))\n\n ; Should we log something?\n (when (<= @log-deadline now)\n (info log-message)\n (swap! log-deadline + (* log-interval 1e6)))\n\n ; Right, sleep and retry\n (Thread/sleep retry-interval)\n ::retry)))]\n (if (= ::retry res)\n (recur)\n res))))))\n\n(defmacro retry\n \"Evals body repeatedly until it doesn't throw, sleeping dt seconds.\"\n [dt & body]\n `(loop []\n (let [res# (try ~@body\n (catch Throwable e#\n; (warn e# \"retrying in\" ~dt \"seconds\")\n ::failed))]\n (if (= res# ::failed)\n (do (Thread/sleep (* ~dt 1000))\n (recur))\n res#))))\n\n(defrecord Retry [bindings])\n\n(defmacro with-retry\n \"It's really fucking inconvenient not being able to recur from within (catch)\n expressions. This macro wraps its body in a (loop [bindings] (try ...)).\n Provides a (retry & new bindings) form which is usable within (catch) blocks:\n when this form is returned by the body, the body will be retried with the new\n bindings.\"\n [initial-bindings & body]\n (assert (vector? initial-bindings))\n (assert (even? (count initial-bindings)))\n (let [bindings-count (/ (count initial-bindings) 2)\n body (walk/prewalk (fn [form]\n (if (and (seq? form)\n (= 'retry (first form)))\n (do (assert (= bindings-count\n (count (rest form))))\n `(Retry. [~@(rest form)]))\n form))\n body)\n retval (gensym 'retval)]\n `(loop [~@initial-bindings]\n (let [~retval (try ~@body)]\n (if (instance? Retry ~retval)\n (recur ~@(->> (range bindings-count)\n (map (fn [i] `(nth (.bindings ~retval) ~i)))))\n ~retval)))))\n\n(deftype Return [value])\n\n(defn letr-rewrite-return\n \"Rewrites (return x) to (Return. x) in expr. Returns a pair of [changed?\n expr], where changed is whether the expression contained a return.\"\n [expr]\n (let [return? (atom false)\n expr (walk/prewalk\n (fn [form]\n (if (and (seq? form)\n (= 'return (first form)))\n (do (assert\n (= 2 (count form))\n (str (pr-str form) \" should have one argument\"))\n (reset! return? true)\n `(Return. ~(second form)))\n form))\n expr)]\n [@return? expr]))\n\n(defn letr-partition-bindings\n \"Takes a vector of bindings [sym expr, sym' expr, ...]. Returns\n binding-groups: a sequence of vectors of bindgs, where the final binding in\n each group has an early return. The final group (possibly empty!) contains no\n early return.\"\n [bindings]\n (->> bindings\n (partition 2)\n (reduce (fn [groups [sym expr]]\n (let [[return? expr] (letr-rewrite-return expr)\n groups (assoc groups\n (dec (count groups))\n (-> (peek groups) (conj sym) (conj expr)))]\n (if return?\n (do (assert (symbol? sym)\n (str (pr-str sym \" must be a symbol\")))\n (conj groups []))\n groups)))\n [[]])))\n\n(defn letr-let-if\n \"Takes a sequence of binding groups and a body expression, and emits a let\n for the first group, an if statement checking for a return, and recurses;\n ending with body.\"\n [groups body]\n (assert (pos? (count groups)))\n (if (= 1 (count groups))\n ; Final group with no returns\n `(let ~(first groups) ~@body)\n\n ; Group ending in a return\n (let [bindings (first groups)\n final-sym (nth bindings (- (count bindings) 2))]\n `(let ~bindings\n (if (instance? Return ~final-sym)\n (.value ~final-sym)\n ~(letr-let-if (rest groups) body))))))\n\n(defmacro letr\n \"Let bindings, plus early return.\n\n You want to do some complicated, multi-stage operation assigning lots of\n variables--but at different points in the let binding, you need to perform\n some conditional check to make sure you can proceed to the next step.\n Ordinarily, you'd intersperse let and if statements, like so:\n\n (let [res (network-call)]\n (if-not (:ok? res)\n :failed-network-call\n\n (let [people (:people (:body res))]\n (if (zero? (count people))\n :no-people\n\n (let [res2 (network-call-2 people)]\n ...\n\n This is a linear chain of operations, but we're forced to nest deeply because\n we have no early-return construct. In ruby, we might write\n\n res = network_call\n return :failed_network_call if not x.ok?\n\n people = res[:body][:people]\n return :no-people if people.empty?\n\n res2 = network_call_2 people\n ...\n\n which reads the same, but requires no nesting thanks to Ruby's early return.\n Clojure's single-return is *usually* a boon to understandability, but deep\n linear branching usually means something like\n\n - Deep nesting (readability issues)\n - Function chaining (lots of arguments for bound variables)\n - Throw/catch (awkward exception wrappers)\n - Monadic interpreter (slow, indirect)\n\n This macro lets you write:\n\n (letr [res (network-call)\n _ (when-not (:ok? res) (return :failed-network-call))\n people (:people (:body res))\n _ (when (zero? (count people)) (return :no-people))\n res2 (network-call-2 people)]\n ...)\n\n letr works like let, but if (return x) is ever returned from a binding, letr\n returns x, and does not evaluate subsequent expressions.\n\n If something other than (return x) is returned from evaluating a binding,\n letr binds the corresponding variable as normal. Here, we use _ to indicate\n that we're not using the results of (when ...), but this is not mandatory.\n You cannot use a destructuring bind for a return expression.\n\n letr is not a *true* early return--(return x) must be a *terminal* expression\n for it to work--like (recur). For example,\n\n (letr [x (do (return 2) 1)]\n x)\n\n returns 1, not 2, because (return 2) was not the terminal expression.\n\n return only works within letr's bindings, not its body.\"\n [bindings & body]\n (assert (vector? bindings))\n (assert (even? (count bindings)))\n (let [groups (letr-partition-bindings bindings)]\n (letr-let-if (letr-partition-bindings bindings) body)))\n\n(defn map-kv\n \"Takes a function (f [k v]) which returns [k v], and builds a new map by\n applying f to every pair.\"\n [f m]\n (into {} (r/map f m)))\n\n(defn map-keys\n \"Maps keys in a map.\"\n [f m]\n (map-kv (fn [[k v]] [(f k) v]) m))\n\n(defn map-vals\n \"Maps values in a map.\"\n [f m]\n (map-kv (fn [[k v]] [k (f v)]) m))\n\n(defn compare<\n \"Like <, but works on any comparable objects, not just numbers.\"\n [a b]\n (neg? (compare a b)))\n\n(defn poly-compare\n \"Comparator function for sorting heterogenous collections.\"\n [a b]\n (try (compare a b)\n (catch java.lang.ClassCastException e\n (compare (str (class a)) (str (class b))))))\n\n(defn polysort\n \"Sort, but on heterogenous collections.\"\n [coll]\n (sort poly-compare coll))\n\n(defn integer-interval-set-str\n \"Takes a set of integers and yields a sorted, compact string representation.\"\n [set]\n (if (some nil? set)\n (str set)\n (let [[runs start end]\n (reduce (fn r [[runs start end] cur]\n (cond ; Start new run\n (nil? start) [runs cur cur]\n\n ; Continue run\n (= cur (inc end)) [runs start cur]\n\n ; Break!\n :else [(conj runs [start end]) cur cur]))\n [[] nil nil]\n (sort set))\n runs (if (nil? start) runs (conj runs [start end]))]\n (str \"#{\"\n (->> runs\n (map (fn m [[start end]]\n (if (= start end)\n start\n (str start \"..\" end))))\n (str/join \" \"))\n \"}\"))))\n\n(defmacro meh\n \"Returns, rather than throws, exceptions.\"\n [& body]\n `(try ~@body (catch Exception e# e#)))\n\n(defmacro with-thread-name\n \"Sets the thread name for duration of block.\"\n [thread-name & body]\n `(let [old-name# (.. Thread currentThread getName)]\n (try\n (.. Thread currentThread (setName (name ~thread-name)))\n ~@body\n (finally (.. Thread currentThread (setName old-name#))))))\n\n(defn maybe-number\n \"Tries reading a string as a long, then double, then string. Passes through\n nil. Useful for getting nice values out of stats APIs that just dump a bunch\n of heterogenously-typed strings at you.\"\n [s]\n (when s\n (try (Long/parseLong s)\n (catch java.lang.NumberFormatException e\n (try (Double/parseDouble s)\n (catch java.lang.NumberFormatException e\n s))))))\n\n(defn coll\n \"Wraps non-collection things into singleton lists, and leaves colls as\n themselves. Useful when you can take either a single thing or a sequence of\n things.\"\n [thing-or-things]\n (cond (nil? thing-or-things) nil\n (coll? thing-or-things) thing-or-things\n true (list thing-or-things)))\n\n(defn sequential\n \"Wraps non-sequential things into singleton lists, and leaves sequential\n things or nil as themselves. Useful when you can take either a single thing\n or a sequence of things.\"\n [thing-or-things]\n (cond (nil? thing-or-things) nil\n (sequential? thing-or-things) thing-or-things\n true (list thing-or-things)))\n\n(defn nil-if-empty\n \"Takes a seqable and returns it, or nil if (seq seqable) is nil. Helpful when\n you want to return a vector if non-empty, or nil otherwise.\"\n [seqable]\n (if (nil? (seq seqable))\n nil\n seqable))\n\n(defn history->latencies\n \"Takes a history--a sequence of operations--and returns a new history where\n operations have two new keys:\n\n :latency the time in nanoseconds it took for the operation to complete.\n :completion the next event for that process\"\n [history]\n (h/ensure-pair-index history)\n (h/map (fn add-latency [^Op op]\n (if (h/invoke? op)\n (if-let [^Op c (h/completion history op)]\n (assoc op\n :completion c\n :latency (- (.time c) (.time op)))\n op)\n op))\n history))\n\n(defn nemesis-intervals\n \"Given a history where a nemesis goes through :f :start and :f :stop type\n transitions, constructs a sequence of pairs of start and stop ops. Since a\n nemesis usually goes :start :start :stop :stop, we construct pairs of the\n first and third, then second and fourth events. Where no :stop op is present,\n we emit a pair like [start nil]. Optionally, a map of start and stop sets may\n be provided to match on user-defined :start and :stop keys.\n\n Multiple starts are ended by the same pair of stops, so :start1 :start2\n :start3 :start4 :stop1 :stop2 yields:\n\n [start1 stop1]\n [start2 stop2]\n [start3 stop1]\n [start4 stop2]\"\n ([history]\n (nemesis-intervals history {}))\n ([history opts]\n ;; Default to :start and :stop if no region keys are provided\n (let [start (:start opts #{:start})\n stop (:stop opts #{:stop})\n [intervals starts]\n ; First, group nemesis ops into pairs (one for invoke, one for\n ; complete)\n (->> history\n (filter #(= :nemesis (:process %)))\n (partition 2)\n ; Verify that every pair has identical :fs. It's possible\n ; that nemeses might, some day, log more types of :info\n ; ops, maybe not in a call-response pattern, but that'll\n ; break us.\n (filter (fn [[a b]] (= (:f a) (:f b))))\n ; Now move through all nemesis ops, keeping track of all start\n ; pairs, and closing those off when we see a stop pair.\n (reduce (fn [[intervals starts :as state] [a b :as pair]]\n (let [f (:f a)]\n (cond (start f) [intervals (conj starts pair)]\n (stop f) [(->> starts\n (mapcat (fn [[s1 s2]]\n [[s1 a] [s2 b]]))\n (into intervals))\n []]\n true state)))\n [[] []]))]\n ; Complete unfinished intervals\n (into intervals (mapcat (fn [[s1 s2]] [[s1 nil] [s2 nil]]) starts)))))\n\n\n(defn longest-common-prefix\n \"Given a collection of sequences, finds the longest sequence which is a\n prefix of every sequence given.\"\n [cs]\n (when (seq cs)\n (reduce (fn prefix [s1 s2]\n (let [len (->> (map = s1 s2)\n (take-while true?)\n count)]\n ; Avoid unnecessary seq wrapping\n (if (= len (count s1))\n s1\n (take len s2))))\n cs)))\n\n(defn drop-common-proper-prefix\n \"Given a collection of sequences, removes the longest common proper prefix\n from each one.\"\n [cs]\n (map (partial drop (reduce min\n (count (longest-common-prefix cs))\n (map (comp dec count) cs)))\n cs))\n\n(definterface ILazyAtom\n (init []))\n\n(defn lazy-atom\n \"An atom with lazy state initialization. Calls (f) on first use to provide\n the initial value of the atom. Only supports swap/reset/deref. Reset bypasses\n lazy initialization. If f throws, behavior is undefined (read: proper\n fucked).\"\n [f]\n (let [state ^clojure.lang.Atom (atom ::fresh)]\n (reify\n ILazyAtom\n (init [_]\n (let [s @state]\n (if-not (identical? s ::fresh)\n ; Regular old value\n s\n\n ; Someone must initialize. Everyone form an orderly queue.\n (do (locking state\n (if (identical? @state ::fresh)\n ; We're the first.\n (reset! state (f))))\n\n ; OK, definitely initialized now.\n @state))))\n\n clojure.lang.IAtom\n (swap [this f]\n (.init this)\n (.swap state f))\n (swap [this f a]\n (.init this)\n (.swap state f a))\n (swap [this f a b]\n (.init this)\n (.swap state f a b))\n (swap [this f a b more]\n (.init this)\n (.swap state f a b more))\n\n (compareAndSet [this v v']\n (.init this)\n (.compareAndSet state v v'))\n\n (reset [this v]\n (.reset state v))\n\n clojure.lang.IDeref\n (deref [this]\n (.init this)))))\n\n(defn named-locks\n \"Creates a mutable data structure which backs a named locking mechanism.\n\n Named locks are helpful when you need to coordinate access to a dynamic pool\n of resources. For instance, you might want to prohibit multiple threads from\n executing a command on a remote node at once. Nodes are uniquely identified\n by a string name, so you could write:\n\n (defonce node-locks (named-locks))\n\n ...\n (defn start-db! [node]\n (with-named-lock node-locks node\n (c/exec :service :meowdb :start)))\n\n Now, concurrent calls to start-db! will not execute concurrently.\n\n The structure we use to track named locks is an atom wrapping a map, where\n the map's keys are any object, and the values are canonicalized versions of\n that same object. We use standard Java locking on the canonicalized versions.\n This is basically an arbitrary version of string interning.\"\n []\n (atom {}))\n\n(defn get-named-lock!\n \"Given a pool of locks, and a lock name, returns the object used for locking\n in that pool. Creates the lock if it does not already exist.\"\n [locks name]\n (-> locks\n (swap! (fn [locks]\n (if-let [o (get locks name)]\n locks\n (assoc locks name name))))\n (get name)))\n\n(defmacro with-named-lock\n \"Given a lock pool, and a name, locks that name in the pool for the duration\n of the body.\"\n [locks name & body]\n `(locking (get-named-lock! ~locks ~name) ~@body))\n\n(defn contains-many?\n \"Takes a map and any number of keys, returning true if all of the keys are\n present. Ex. (contains-many? {:a 1 :b 2 :c 3} :a :b :c) => true\"\n [m & ks]\n (every? #(contains? m %) ks))\n\n(defn parse-long\n \"Parses a string to a Long. Look, we use this a lot, okay?\"\n [s]\n (Long/parseLong s))\n\n(defn ex-root-cause\n \"Unwraps throwables to return their original cause.\"\n [^Throwable t]\n (if-let [cause (.getCause t)]\n (recur cause)\n t))\n\n(defn arities\n \"The arities of a function class.\"\n [^Class c]\n (keep (fn [^Method method]\n (when (re-find #\"invoke\" (.getName method))\n (alength (.getParameterTypes method))))\n (-> c .getDeclaredMethods)))\n\n(defn fixed-point\n \"Applies f repeatedly to x until it converges.\"\n [f x]\n (let [x' (f x)]\n (if (= x x')\n x\n (recur f x'))))\n\n(defn sh\n \"A wrapper around clojure.java.shell's sh which throws on nonzero exit.\"\n [& args]\n (let [res (apply shell/sh args)]\n (when-not (zero? (:exit res))\n (throw+ (assoc res :type ::nonzero-exit)\n (str \"Shell command \" (pr-str args)\n \" returned exit status \" (:exit res) \"\\n\"\n (:out res) \"\\n\"\n (:err res))))\n res))\n\n(defn deepfind\n \"Finds things that match a predicate in a nested structure. Returns a\n lazy sequence of matching things, each represented by a vector *path* which\n denotes how to access that object, ending in the matching thing itself. Path\n elements are:\n\n - keys for maps\n - integers for sequentials\n - :member for sets\n - :deref for deref-ables.\n\n (deepfind string? [:a {:b \\\"foo\\\"} :c])\n ; => ([1 :b \\\"foo\\\"])\n \"\n ([pred haystack]\n (deepfind pred [] haystack))\n ([pred path haystack]\n (cond ; This is a match; we're done\n (pred haystack)\n [(conj path haystack)]\n\n (map? haystack)\n (mapcat (fn [[k v]]\n (deepfind pred (conj path k) v))\n haystack)\n\n (sequential? haystack)\n (->> haystack\n (map-indexed (fn [i x] (deepfind pred (conj path i) x)))\n (mapcat identity))\n\n (set? haystack)\n (mapcat (partial deepfind pred (conj path :member)) haystack)\n\n (instance? clojure.lang.IDeref haystack)\n (deepfind pred (conj path :deref) @haystack)\n\n true\n nil)))\n\n(definterface+ IForgettable\n (forget! [this]\n \"Allows this forgettable reference to be reclaimed by the GC at some\n later time. Future attempts to dereference it may throw. Returns\n self.\"))\n\n(deftype Forgettable [^:unsynchronized-mutable x]\n IForgettable\n (forget! [this]\n (set! x ::forgotten)\n this)\n\n ; When used as a generator, Forgettables are transparently unwrapped.\n jepsen.generator.Generator\n (update [this test ctx event]\n (gen/update @this test ctx event))\n\n (op [this test ctx]\n (gen/op @this test ctx))\n\n clojure.lang.IDeref\n (deref [this]\n (let [x x]\n (if (identical? x ::forgotten)\n (throw+ {:type ::forgotten})\n x)))\n\n Object\n (toString [this]\n (let [x x]\n (str \"#\")))\n\n (equals [this other]\n (identical? this other)))\n\n(defn forgettable\n \"Constructs a deref-able reference to x which can be explicitly forgotten.\n Helpful for controlling access to infinite seqs (e.g. the generator) when you\n don't have firm control over everyone who might see them.\"\n [x]\n (Forgettable. x))\n\n(defmethod pprint/simple-dispatch jepsen.util.Forgettable\n [^Forgettable f]\n (let [prefix (format \"#\"\n (pprint/pprint-indent :block (-> (count prefix) (- 2) -))\n (pprint/pprint-newline :linear)\n (pprint/write-out (try+ @f\n (catch [:type ::forgotten] e\n \"?\"))))))\n\n(prefer-method pprint/simple-dispatch\n jepsen.util.Forgettable clojure.lang.IDeref)\n\n(extend-protocol fipp.ednize/IOverride jepsen.util.Forgettable)\n(extend-protocol fipp.ednize/IEdn jepsen.util.Forgettable\n (-edn [f]\n (fipp.ednize/tagged-object f\n (try+ @f\n (catch [:type ::forgotten] e\n '?)))))\n" }, { "path": "jepsen/src/jepsen/web.clj", "content": "(ns jepsen.web\n \"Web server frontend for browsing test results.\"\n (:require [jepsen.store :as store]\n [clojure.string :as str]\n [clojure.edn :as edn]\n [clojure.java [io :as io]]\n [clojure.tools.logging :refer :all]\n [clojure.pprint :refer [pprint]]\n [clj-commons.byte-streams :as bs]\n [clj-time [coerce :as time.coerce]\n [core :as time]\n [local :as time.local]\n [format :as timef]]\n [hiccup.core :as h]\n [ring.util.response :as response]\n [org.httpkit.server :as server])\n (:import (java.io File\n FileInputStream\n PipedInputStream\n PipedOutputStream\n OutputStream)\n (java.nio CharBuffer)\n (java.nio.file Path\n Files)\n (java.nio.file.attribute FileTime)\n (java.util.zip ZipEntry\n ZipOutputStream)))\n\n(def colors\n {:ok \"#6DB6FE\"\n :info \"#FFAA26\"\n :fail \"#FEB5DA\"\n nil \"#eaeaea\"})\n\n(def valid-color\n (comp colors {true :ok\n :unknown :info\n false :fail}))\n\n; Path/File protocols\n(extend-protocol io/Coercions\n Path\n (as-file [^Path p] (.toFile p))\n (as-url [^Path p] (.toURL (.toUri p))))\n\n(defn url-encode-path-components\n \"URL encodes *individual components* of a path, leaving / as / instead of\n encoded.\"\n [^String x]\n (str/replace (java.net.URLEncoder/encode x \"UTF-8\") #\"%2F\" \"/\"))\n\n(def test-cache\n \"An in-memory cache of {:name, :start-time, :valid?} maps, indexed by an\n ordered map of [:start-time :name]. Earliest start times at the front.\"\n (atom (sorted-map-by (comp - compare))))\n\n(def test-cache-key\n \"Function which extracts the key for the test cache from a map.\"\n (juxt :start-time :name))\n\n(def test-cache-mutable-window\n \"How far back in the test cache do we refresh on every page load?\"\n 2)\n\n(def page-limit\n \"How many test rows per page?\"\n 128)\n\n(def basic-date-time (timef/formatters :basic-date-time))\n\n(defn parse-time\n \"Parses a time from a string\"\n [t]\n (-> (timef/parse-local basic-date-time t)\n time.coerce/to-date-time))\n\n(defn fast-tests\n \"Abbreviated set of tests: just name, start-time, results. Memoizes\n (partially) via test-cache.\"\n []\n (let [cached @test-cache\n ; Drop the most recent n keys from the cache--these we assume may have\n ; changed recently.\n cached (->> (keys cached)\n (take test-cache-mutable-window)\n (reduce dissoc cached))]\n (->> (for [[name runs] (store/tests)\n [time test] runs]\n (let [t {:name name,\n :start-time (parse-time time)}]\n (or (get cached (test-cache-key t))\n ; Fetch from disk if not cached. Note that we construct a new\n ; map so we can release the filehandle associated with the lazy\n ; test map.\n (try\n (let [results {:valid? (:valid? (store/load-results\n name time)\n :incomplete)}\n t (-> t (assoc :results results))]\n (swap! test-cache assoc (test-cache-key t) t)\n t)\n (catch java.io.EOFException e\n (assoc t :results {:valid? :incomplete}))\n (catch java.io.FileNotFoundException e\n (assoc t :results {:valid? :incomplete}))\n (catch java.lang.RuntimeException e\n ; Um???\n (warn e \"Unable to parse\" (str name \"/\" time))\n (assoc t :results {:valid? :incomplete}))))))\n (sort-by :start-time)\n reverse\n vec)))\n\n(defn test-header\n []\n [:tr\n [:th \"Name\"]\n [:th \"Time\"]\n [:th \"Valid?\"]\n [:th \"Results\"]\n [:th \"History\"]\n [:th \"Log\"]\n [:th \"Zip\"]])\n\n(defn relative-path\n \"Relative path, as a Path.\"\n [base target]\n (let [base (.toPath (io/file base))\n target (.toPath (io/file target))]\n (.relativize base target)))\n\n(defn url\n \"Takes a test and filename components; returns a URL for that file.\"\n [t & args]\n (url-encode-path-components\n (str \"/files/\" (-> ^File (apply store/path t args)\n .getPath\n (str/replace #\"\\Astore/\" \"\")\n (str/replace #\"/\\Z\" \"\")))))\n\n(defn file-url\n \"URL for a File\"\n [f]\n (url-encode-path-components\n (str \"/files/\" (->> f io/file .toPath (relative-path store/base-dir)))))\n\n\n(defn test-row\n \"Turns a test map into a table row.\"\n [t]\n (let [r (:results t)\n time (->> t\n :start-time\n (timef/unparse (timef/formatters :date-hour-minute-second)))]\n [:tr\n [:td [:a {:href (url t \"\")} (:name t)]]\n [:td [:a {:href (url t \"\")} time]]\n [:td {:style (str \"background: \" (valid-color (:valid? r)))}\n (:valid? r)]\n [:td [:a {:href (url t \"results.edn\")} \"results.edn\"]]\n [:td [:a {:href (url t \"history.txt\")} \"history.txt\"]]\n [:td [:a {:href (url t \"jepsen.log\")} \"jepsen.log\"]]\n [:td [:a {:href (str (url t) \".zip\")} \"zip\"]]]))\n\n(defn params\n \"Parses a query params map from a request.\"\n [req]\n (when-let [q (:query-string req)]\n (->> (str/split q #\"&\")\n (keep (fn [pair]\n (when (not= \"\" pair)\n (let [[k v] (str/split pair #\"=\")]\n [(keyword k) v]))))\n (into {}))))\n\n(defn home\n \"Home page\"\n [req]\n (let [params (params req)\n after (if-let [a (:after params)]\n (parse-time a)\n ; In the year three thousaaaaaand\n (parse-time \"30000101T000000.000Z\"))\n tests (->> (fast-tests)\n (drop-while (fn [t]\n (->> (:start-time t)\n (time/after? after)\n not))))\n more? (< page-limit (count tests))\n tests (take page-limit tests)]\n {:status 200\n :headers {\"Content-Type\" \"text/html\"}\n :body (h/html\n [:h1 \"Jepsen\"]\n [:table {:cellspacing 3\n :cellpadding 3}\n [:thead (test-header)]\n [:tbody (map test-row tests)]]\n (when more?\n [:p [:a {:href (str \"/?after=\"\n (->> (last tests)\n :start-time\n time.coerce/to-date-time\n (timef/unparse basic-date-time)))}\n \"Older tests...\"]]))}))\n\n(defn dir-cell\n \"Renders a File (a directory) for a directory view.\"\n [^File f]\n (let [results-file (io/file f \"results.edn\")\n valid? (try (with-open [r (java.io.PushbackReader.\n (io/reader results-file))]\n (:valid?\n (clojure.edn/read\n {:default vector}\n r)))\n (catch java.io.FileNotFoundException e\n nil)\n (catch RuntimeException e\n (info e :caught)\n :unknown))]\n [:a {:href (file-url f)\n :style \"text-decoration: none;\n color: #000;\"}\n [:div {:style (str \"background: \" (valid-color valid?) \";\\n\"\n \"display: inline-block;\n margin: 10px;\n padding: 10px;\n overflow: hidden;\n width: 280px;\")}\n (.getName f)]]))\n\n(defn file-cell\n \"Renders a File for a directory view.\"\n [^File f]\n [:div {:style \"display: inline-block;\n margin: 10px;\n overflow: hidden;\"}\n [:div {:style \"height: 200px;\n width: 300px;\n overflow: hidden;\"}\n [:a {:href (file-url f)\n :style \"text-decoration: none;\n color: #555;\"}\n (cond\n (re-find #\"\\.(png|jpg|jpeg|gif)$\" (.getName f))\n [:img {:src (file-url f)\n :title (.getName f)\n :style \"width: auto;\n height: 200px;\"}]\n\n (re-find #\"\\.(txt|edn|json|yaml|log|stdout|stderr)$\" (.getName f))\n [:pre\n (with-open [r (io/reader f)]\n (let [buf (CharBuffer/allocate 4096)]\n (.read r buf)\n (.flip buf)\n (.toString buf)))]\n\n true\n [:div {:style \"background: #F4F4F4;\n width: 100%;\n height: 100%;\"}])]]\n\n [:a {:href (file-url f)} (.getName f)]])\n\n(defn dir-sort\n \"Sort a collection of Files. If everything's an integer, sort numerically,\n else alphanumerically.\"\n [files]\n (if (every? (fn [^File f] (re-find #\"^\\d+$\" (.getName f))) files)\n (sort-by #(Long/parseLong (.getName ^File %)) files)\n (sort files)))\n\n(defn js-escape\n \"Escape a Javascript string.\"\n [s]\n (-> s\n (str/replace \"\\\\\" \"\\\\\\\\\")\n (str/replace \"'\" \"\\\\x27\")\n (str/replace \"\\\"\" \"\\\\x22\")))\n\n(defn clj-escape\n \"Escape a Clojure string.\"\n [s]\n (-> (str/escape s {\\\" \"\\\\\\\"\"\n \\\\ \"\\\\\\\\\"})))\n\n(defn dir\n \"Serves a directory.\"\n [^File dir]\n {:status 200\n :headers {\"Content-Type\" \"text/html\"}\n ; Breadcrumbs\n :body (h/html (->> dir\n (.toPath)\n (iterate #(.getParent ^Path %))\n (take-while #(-> store/base-dir\n io/file\n .getCanonicalFile\n .toPath\n (not= (.toAbsolutePath ^Path %))))\n (drop 1)\n reverse\n (map (fn [^Path component]\n [:a {:style \"margin: 0 0.3em\"\n :href (file-url component)}\n (.getFileName component)]))\n (cons [:a {:style \"margin-right: 0.3em\"\n :href \"/\"}\n \"jepsen\"])\n (interpose \"/\"))\n ; Title\n (let [path (js-escape\n (str \\\" (clj-escape (.getCanonicalPath dir)) \\\"))]\n ; You can click to copy the full local path\n [:h1 {:onclick (str \"navigator.clipboard.writeText('\"\n path \"')\")}\n (.getName dir)\n ; Or download a zip file\n [:a {:style \"font-size: 60%;\n margin-left: 0.3em;\"\n :href (file-url (str dir \".zip\"))}\n \".zip\"]])\n [:div\n (->> dir\n .listFiles\n (filter (fn [^File f] (.isDirectory f)))\n dir-sort\n (map dir-cell))]\n [:div\n (->> dir\n .listFiles\n (remove (fn [^File f] (.isDirectory f)))\n (sort-by (fn [^File f]\n [(not= (.getName f) \"results.edn\")\n (not= (.getName f) \"history.txt\")\n (.getName f)]))\n (map file-cell))])})\n\n(defn zip-path!\n \"Writes a path to a zipoutputstream\"\n [^ZipOutputStream zipper base ^File file]\n (when (.isFile file)\n (let [relpath (str (relative-path base file))\n entry (doto (ZipEntry. relpath)\n (.setCreationTime (FileTime/fromMillis\n (.lastModified file))))\n buf (byte-array (* 16 1024 1024))]\n (with-open [input (FileInputStream. file)]\n (.putNextEntry zipper entry)\n (loop []\n (let [read (.read input buf)]\n (if (< 0 read)\n (do (.write zipper buf 0 read)\n (recur))\n (.closeEntry zipper)))))))\n zipper)\n\n(defn zip-strip-dir\n \"Strips the .zip off the end of a directory.\"\n [^File dir]\n (-> dir\n (.getCanonicalFile)\n str\n (str/replace #\"\\.zip\\z\" \"\")\n io/file))\n\n(defn zip-java\n \"Serves a directory as a zip file, using the Java zip library. Strips .zip\n off the extension.\"\n [req ^File dir]\n (let [f (zip-strip-dir dir)\n pipe-in (PipedInputStream. (* 16 1024 1024))\n pipe-out (PipedOutputStream. pipe-in)]\n (future\n (try\n (with-open [zipper (ZipOutputStream. pipe-out)]\n (doseq [file (file-seq f)]\n (zip-path! zipper f file)))\n (catch Exception e\n (warn e \"Error streaming zip for\" dir))\n (finally\n (.close pipe-out))))\n {:status 200\n :headers {\"Content-Type\" \"application/zip\"}\n :body pipe-in}))\n\n(defn zip-shell\n \"Serves a directory as a zip file, shelling out to `zip`. This is\n significantly faster than zip-java`, but less portable.\"\n [req ^File dir]\n (let [builder (doto (ProcessBuilder. [\"/usr/bin/zip\" \"-r\" \"-\" \".\"])\n (.directory (zip-strip-dir dir)))\n process (.start builder)]\n (.close (.getOutputStream process))\n ; Await process and log output\n (future\n (.waitFor process)\n (let [exit (.exitValue process)]\n (when-not (= 0 exit)\n (warn \"`zip` exited with non-zero exit\" exit \"in directory\" (.getCanonicalPath dir) \":\\n\"\n (bs/convert (.getErrorStream process) String)))))\n\n {:status 200\n :headers {\"Content-Type\" \"application/zip\"}\n :body (.getInputStream process)}))\n\n\n(defn zip\n \"Zips a directory using either zip-java or zip-shell.\"\n [req dir]\n (try\n (zip-shell req dir)\n (catch java.io.IOException e\n (warn e \"Error zipping directory using `zip`, falling back to JVM zip\")\n (zip-java req dir))))\n\n(defn assert-file-in-scope!\n \"Throws if the given file is outside our store directory.\"\n [^File f]\n (assert (.startsWith (.toPath (.getCanonicalFile f))\n (.toPath (.getCanonicalFile (io/file store/base-dir))))\n \"File out of scope.\"))\n\n(def e404\n {:status 404\n :headers {\"Content-Type\" \"text/plain\"}\n :body \"404 not found\"})\n\n(def content-type\n \"Map of extensions to known content-types\"\n {\"txt\" \"text/plain\"\n \"log\" \"text/plain\"\n \"edn\" \"text/plain\" ; Wrong, but we like seeing it in-browser\n \"json\" \"text/plain\" ; Ditto\n \"html\" \"text/html\"\n \"svg\" \"image/svg+xml\"})\n\n(defn files\n \"Serve requests for /files/ urls\"\n [req]\n (let [pathname ((re-find #\"^/files/(.+)\\z\" (:uri req)) 1)\n ext (when-let [m (re-find #\"\\.(\\w+)\\z\" pathname)] (m 1))\n f (File. store/base-dir ^String pathname)]\n (assert-file-in-scope! f)\n (cond\n (.isFile f)\n (let [res (response/file-response pathname\n {:root store/base-dir\n :index-files? false\n :allow-symlinks? false})]\n (if-let [ct (content-type ext)]\n (-> res\n (response/content-type ct)\n (response/charset \"utf-8\"))\n res))\n\n (= ext \"zip\")\n (zip req f)\n\n (.isDirectory f)\n (dir f)\n\n true\n e404)))\n\n(defn app [req]\n; (info :req (with-out-str (pprint req)))\n (let [req (assoc req :uri (java.net.URLDecoder/decode\n ^String (:uri req) \"UTF-8\"))]\n (condp re-find (:uri req)\n #\"^/$\" (home req)\n #\"^/files/\" (files req)\n e404)))\n\n(defn serve!\n \"Starts an http server with the given httpkit options.\"\n ([options]\n (let [s (server/run-server app options)]\n (info \"I'll see YOU after the function\")\n s)))\n" }, { "path": "jepsen/test/jepsen/checker/timeline_test.clj", "content": "(ns jepsen.checker.timeline-test\n (:refer-clojure :exclude [set])\n (:require [clojure [datafy :refer [datafy]]\n [pprint :refer [pprint]]\n [test :refer :all]]\n [jepsen [checker :refer :all]\n [history :as h]\n [store :as store]\n [tests :as tests]\n [util :as util]]\n [jepsen.checker.timeline :as t]))\n\n(deftest timeline-test\n (let [test (assoc tests/noop-test\n :start-time 0)\n history (h/history\n [{:process 0, :time 0, :type :invoke, :f :write, :value 3}\n {:process 1, :time 1000000, :type :invoke, :f :read, :value nil}\n {:process 0, :time 2000000, :type :info, :f :read, :value nil}\n {:process 1, :time 3000000, :type :ok, :f :read, :value 3}])\n opts {}]\n (is (= [:html\n [:head\n [:style\n \".ops { position: absolute; }\\n.op { position: absolute; padding: 2px; border-radius: 2px; box-shadow: 0 1px 3px rgba(0,0,0,0.12), 0 1px 2px rgba(0,0,0,0.24); transition: all 0.3s cubic-bezier(.25,.8,.25,1); overflow: hidden; }\\n.op.invoke { background: #eeeeee; }\\n.op.ok { background: #6DB6FE; }\\n.op.info { background: #FFAA26; }\\n.op.fail { background: #FEB5DA; }\\n.op:target { box-shadow: 0 14px 28px rgba(0,0,0,0.25), 0 10px 10px rgba(0,0,0,0.22); }\\n\"]]\n [:body\n [:div\n [:a {:href \"/\"} \"jepsen\"]\n \" / \"\n [:a {:href \"/files/noop\"} \"noop\"]\n \" / \"\n [:a {:href \"/files/noop/0\"} \"0\"]\n \" / \"\n [:a {:href \"/files/noop/0/\"} \"independent\"]\n \" / \"\n [:a {:href \"/files/noop/0/independent/\"} \"\"]]\n [:h1 \"noop key \"]\n nil\n [:div\n {:class \"ops\"}\n [[:a\n {:href \"#i2\"}\n [:div\n {:class \"op info\",\n :id \"i2\",\n :style \"width:100;left:0;top:0;height:80\",\n :title\n \"Dur: 2 ms\\nErr: nil\\nWall-clock Time: 1970-01-01T00:00:00.002Z\\n\\nOp:\\n{:process 0\\n :type :info\\n :f :read\\n :index 2\\n :value }\"}\n \"0 read 3
\"]]\n [:a\n {:href \"#i3\"}\n [:div\n {:class \"op ok\",\n :id \"i3\",\n :style \"width:100;left:106;top:16;height:32\",\n :title\n \"Dur: 2 ms\\nErr: nil\\nWall-clock Time: 1970-01-01T00:00:00.003Z\\n\\nOp:\\n{:process 1\\n :type :ok\\n :f :read\\n :index 3\\n :value 3}\"}\n \"1 read
3\"]]]]]]\n (t/hiccup test history opts)))))\n" }, { "path": "jepsen/test/jepsen/checker_test.clj", "content": "(ns jepsen.checker-test\n (:refer-clojure :exclude [set])\n (:use clojure.test)\n (:require [clojure [datafy :refer [datafy]]\n [pprint :refer [pprint]]]\n [jepsen [checker :refer :all]\n [db :as db]\n [history :as h]\n [store :as store]\n [tests :as tests]\n [util :as util]]\n [jepsen.checker.perf :as cp]\n [knossos [model :as model]]\n [multiset.core :as multiset]))\n\n; Helpers for making ops\n(defn invoke-op\n [process f value]\n (h/op {:index -1, :type :invoke, :process process, :f f, :value value}))\n\n(defn ok-op\n [process f value]\n (h/op {:index -1, :type :ok, :process process, :f f, :value value}))\n\n(defn fail-op\n [process f value]\n (h/op {:index -1, :type :fail, :process process, :f f, :value value}))\n\n(defn info-op\n [process f value]\n (h/op {:index -1, :type :info, :process process, :f f, :value value}))\n\n(defn history\n \"Takes a sequence of operations and adds times and indexes, returning a\n History.\"\n [h]\n (->> (condp = (count h)\n 0 h\n 1 [(assoc (first h) :time 0)]\n (reduce (fn [h op]\n (conj h (assoc op :time (+ (:time (peek h)) 1000000))))\n [(assoc (first h) :time 0)]\n (rest h)))\n h/strip-indices\n h/history))\n\n(deftest unhandled-exceptions-test\n (let [e1 (datafy (IllegalArgumentException. \"bad args\"))\n e2 (datafy (IllegalArgumentException. \"bad args 2\"))\n e3 (datafy (IllegalStateException. \"bad state\"))]\n (is (= {:valid? true\n :exceptions\n [{:class 'java.lang.IllegalArgumentException\n :count 2\n :example (h/op {:index 1, :process 0, :type :info, :f :foo,\n :value 1, :exception e1 :error [\"Whoops!\"]})}\n {:class 'java.lang.IllegalStateException\n :example (h/op {:index 5, :process 0, :type :info, :f :foo, :value\n 1, :exception e3, :error :oh-no})\n :count 1}]}\n (check (unhandled-exceptions) nil\n (h/history\n [{:process 0, :type :invoke, :f :foo, :value 1}\n {:process 0, :type :info, :f :foo, :value 1,\n :exception e1, :error [\"Whoops!\"]}\n {:process 0, :type :invoke, :f :foo, :value 1}\n {:process 0, :type :info, :f :foo, :value 1,\n :exception e2, :error [\"Whoops!\" 2]}\n {:process 0, :type :invoke, :f :foo, :value 1}\n {:process 0, :type :info, :f :foo, :value 1,\n :exception e3, :error :oh-no}])\n {})))))\n\n(deftest stats-test\n (is (= {:valid? false\n :count 5\n :fail-count 3\n :info-count 1\n :ok-count 1\n :by-f {:foo {:valid? true\n :count 2\n :ok-count 1\n :fail-count 1\n :info-count 0}\n :bar {:valid? false\n :count 3\n :ok-count 0\n :fail-count 2\n :info-count 1}}}\n (check (stats) nil\n (h/history [{:process 1, :f :foo, :type :ok}\n {:process 2, :f :foo, :type :fail}\n {:process 3, :f :bar, :type :info}\n {:process 4, :f :bar, :type :fail}\n {:process 5, :f :bar, :type :fail}])\n {}))))\n\n(deftest queue-test\n (testing \"empty\"\n (is (:valid? (check (queue nil) nil (h/history []) {}))))\n\n (testing \"Possible enqueue but no dequeue\"\n (is (:valid? (check (queue (model/unordered-queue)) nil\n (h/history [(invoke-op 1 :enqueue 1)]) {}))))\n\n (testing \"Definite enqueue but no dequeue\"\n (is (:valid? (check (queue (model/unordered-queue)) nil\n (h/history [(ok-op 1 :enqueue 1)]) {}))))\n\n (testing \"concurrent enqueue/dequeue\"\n (is (:valid? (check (queue (model/unordered-queue)) nil\n (h/history [(invoke-op 2 :dequeue nil)\n (invoke-op 1 :enqueue 1)\n (ok-op 2 :dequeue 1)]) {}))))\n\n (testing \"dequeue but no enqueue\"\n (is (not (:valid? (check (queue (model/unordered-queue)) nil\n (h/history [(ok-op 1 :dequeue 1)]) {}))))))\n\n(deftest set-test-\n (let [h (h/history\n [; OK writes\n {:process 0, :type :invoke, :f :add, :value 0}\n {:process 0, :type :ok, :f :add, :value 0}\n {:process 0, :type :invoke, :f :add, :value 1}\n {:process 0, :type :ok, :f :add, :value 1}\n ; Info writes\n {:process 1, :type :invoke, :f :add, :value 10}\n {:process 1, :type :info, :f :add, :value 10}\n {:process 1, :type :invoke, :f :add, :value 11}\n {:process 1, :type :info, :f :add, :value 11}\n ; Failed writes\n {:process 2, :type :invoke, :f :add, :value 20}\n {:process 2, :type :fail, :f :add, :value 20}\n {:process 2, :type :invoke, :f :add, :value 21}\n {:process 2, :type :fail, :f :add, :value 21}\n\n ; Final read\n {:process 4, :type :invoke, :f :read, :value nil}\n {:process 4, :type :ok, :f :read, :value #{0 10 20 30}}])]\n (is (= {:valid? false\n :ok-count 3\n :ok \"#{0 10 20}\"\n :lost-count 1\n :lost \"#{1}\"\n :acknowledged-count 2\n :recovered-count 2\n :recovered \"#{10 20}\"\n :attempt-count 6\n :unexpected-count 1\n :unexpected \"#{30}\"}\n (check (set) nil h nil)))))\n\n(deftest total-queue-test\n (testing \"empty\"\n (is (:valid? (check (total-queue) nil (history []) {}))))\n\n (testing \"sane\"\n (is (= (check (total-queue) nil\n (history\n [(invoke-op 1 :enqueue 1)\n (invoke-op 2 :enqueue 2)\n (ok-op 2 :enqueue 2)\n (invoke-op 3 :dequeue 1)\n (ok-op 3 :dequeue 1)\n (invoke-op 3 :dequeue 2)\n (ok-op 3 :dequeue 2)])\n {})\n {:valid? true\n :duplicated (multiset/multiset)\n :lost (multiset/multiset)\n :unexpected (multiset/multiset)\n :recovered (multiset/multiset 1)\n :attempt-count 2\n :acknowledged-count 1\n :ok-count 2\n :unexpected-count 0\n :lost-count 0\n :duplicated-count 0\n :recovered-count 1})))\n\n (testing \"pathological\"\n (is (= (check (total-queue) nil\n (history\n [(invoke-op 1 :enqueue :hung)\n (invoke-op 2 :enqueue :enqueued)\n (ok-op 2 :enqueue :enqueued)\n (invoke-op 3 :enqueue :dup)\n (ok-op 3 :enqueue :dup)\n (invoke-op 4 :dequeue nil) ; nope\n (invoke-op 5 :dequeue nil)\n (ok-op 5 :dequeue :wtf)\n (invoke-op 6 :dequeue nil)\n (ok-op 6 :dequeue :dup)\n (invoke-op 7 :dequeue nil)\n (ok-op 7 :dequeue :dup)])\n {})\n {:valid? false\n :lost (multiset/multiset :enqueued)\n :unexpected (multiset/multiset :wtf)\n :recovered (multiset/multiset)\n :duplicated (multiset/multiset :dup)\n :acknowledged-count 2\n :attempt-count 3\n :ok-count 1\n :lost-count 1\n :unexpected-count 1\n :duplicated-count 1\n :recovered-count 0}))))\n\n(deftest unique-ids-test\n (testing \"empty\"\n (is (= {:valid? true\n :attempted-count 0\n :acknowledged-count 0\n :duplicated-count 0\n :duplicated {}\n :range [nil nil]}\n (check (unique-ids) nil (history []) nil))))\n\n (testing \"dups\"\n (is (= {:valid? false\n :attempted-count 5\n :acknowledged-count 4\n :duplicated-count 1\n :duplicated {0 3}\n :range [0 1]}\n (check (unique-ids) nil\n (history [(invoke-op 0 :generate nil)\n (ok-op 0 :generate 0)\n (invoke-op 1 :generate nil)\n (ok-op 1 :generate 1)\n (invoke-op 2 :generate nil)\n (ok-op 2 :generate 0)\n (invoke-op 3 :generate nil)\n (ok-op 3 :generate 0)\n (invoke-op 4 :generate nil)\n (info-op 4 :generate nil)])\n {})))))\n\n(deftest counter-test\n (testing \"empty\"\n (is (= (check (counter) nil (history []) {})\n {:valid? true\n :reads []\n :errors []})))\n\n (testing \"initial read\"\n (is (= (check (counter)\n nil\n (history [(invoke-op 0 :read nil)\n (ok-op 0 :read 0)])\n {})\n {:valid? true\n :reads [[0 0 0]]\n :errors []})))\n\n (testing \"ignore failed ops\"\n (is (= {:valid? true\n :reads [[0 0 0]]\n :errors []}\n (check (counter) nil\n (history\n [(invoke-op 0 :add 1)\n (fail-op 0 :add 1)\n (invoke-op 0 :read nil)\n (ok-op 0 :read 0)])\n {}))))\n\n (testing \"incomplete history\"\n (is (= {:valid? true\n :reads [[0 0 1]\n [0 1 1]]\n :errors []}\n (check (counter) nil\n (history\n [(invoke-op 0 :add 1)\n (invoke-op 1 :read nil)\n (ok-op 1 :read 0)\n (invoke-op 1 :read nil)\n (ok-op 1 :read 1)])\n {}))))\n\n (testing \"initial invalid read\"\n (is (= (check (counter) nil\n (history [(invoke-op 0 :read nil)\n (ok-op 0 :read 1)])\n {})\n {:valid? false\n :reads [[0 1 0]]\n :errors [[0 1 0]]})))\n\n (testing \"interleaved concurrent reads and writes\"\n (is (= (check (counter) nil\n (history\n [(invoke-op 0 :read nil)\n (invoke-op 1 :add 1)\n (invoke-op 2 :read nil)\n (invoke-op 3 :add 2)\n (invoke-op 4 :read nil)\n (invoke-op 5 :add 4)\n (invoke-op 6 :read nil)\n (invoke-op 7 :add 8)\n (invoke-op 8 :read nil)\n (ok-op 0 :read 6)\n (ok-op 1 :add 1)\n (ok-op 2 :read 0)\n (ok-op 3 :add 2)\n (ok-op 4 :read 3)\n (ok-op 5 :add 4)\n (ok-op 6 :read 100)\n (ok-op 7 :add 8)\n (ok-op 8 :read 15)])\n {})\n {:valid? false\n :reads [[0 6 15] [0 0 15] [0 3 15] [0 100 15] [0 15 15]]\n :errors [[0 100 15]]})))\n\n (testing \"rolling reads and writes\"\n (is (= (check (counter) nil\n (history\n [(invoke-op 0 :read nil)\n (invoke-op 1 :add 1)\n (ok-op 0 :read 0)\n (invoke-op 0 :read nil)\n (ok-op 1 :add 1)\n (invoke-op 1 :add 2)\n (ok-op 0 :read 3)\n (invoke-op 0 :read nil)\n (ok-op 1 :add 2)\n (ok-op 0 :read 5)])\n {})\n {:valid? false\n :reads [[0 0 1] [0 3 3] [1 5 3]]\n :errors [[1 5 3]]}))))\n\n(deftest compose-test\n (is (= (check (compose {:a (unbridled-optimism) :b (unbridled-optimism)})\n nil nil {})\n {:a {:valid? true}\n :b {:valid? true}\n :valid? true})))\n\n(deftest broaden-range-test\n (are [a b, a' b'] (= [a' b'] (cp/broaden-range [a b]))\n ; Broadening identical points\n 0 0 -1 1\n -1 -1 -2 0\n 4 4 3 5\n ; Normal integers\n 0 1 0.0 1\n 1 2 1.0 2\n 9 10 9.0 10\n 0 10 0.0 10\n ; Bigger integers\n 1000 10000 1000.0 10000\n 1234 5678 1000.0 6000.0\n ; Tiny numbers\n ; I don't like these answers but whatever\n 0.03415 0.03437 0.034140000000000004 0.034370000000000005\n ))\n\n(deftest bucket-points-test\n (is (= (cp/bucket-points 2\n [[1 :a]\n [7 :g]\n [5 :e]\n [2 :b]\n [3 :c]\n [4 :d]\n [6 :f]])\n {1 [[1 :a]]\n 3 [[2 :b]\n [3 :c]]\n 5 [[5 :e]\n [4 :d]]\n 7 [[7 :g]\n [6 :f]]})))\n\n(deftest latencies->quantiles-test\n (is (= {0 [[5/2 0] [15/2 20] [25/2 25]]\n 1 [[5/2 10] [15/2 25] [25/2 25]]}\n (cp/latencies->quantiles 5 [0 1] (partition 2 [0 0\n 1 10\n 2 1\n 3 1\n 4 1\n 5 20\n 6 21\n 7 22\n 8 25\n 9 25\n 10 25])))))\n\n(defn perf-gen\n ([latency]\n (perf-gen latency nil))\n ([latency nemesis?]\n (let [f (rand-nth [:write :read])\n proc (rand-int 100)\n time (long (* 1e9 (rand-int 100)))\n type (rand-nth [:ok :ok :ok :ok :ok\n :fail :info :info])]\n [(h/op {:index -1, :process proc, :type :invoke, :f f, :time time})\n (h/op {:index -1, :process proc, :type type, :f f,\n :time (+ time latency)})])))\n\n(deftest perf-test\n (let [history (->> (repeatedly #(long (/ 1e9 (inc (rand-int 1000)))))\n (mapcat perf-gen)\n (take 2000)\n h/strip-indices\n h/history)]\n\n ; Go check store/latency graph, store/perf graph, etc to make sure these\n ; look right\n (testing \"can render latency-graph\"\n (is (= (check (latency-graph)\n {:name \"latency graph\"\n :start-time 0}\n history\n {})\n {:valid? true})))\n\n (testing \"can render rate-graph\"\n (is (= (check (rate-graph)\n {:name \"rate graph\"\n :start-time 0}\n history\n {})\n {:valid? true})))\n\n (testing \"can render combined perf graph\"\n (is (= (check (perf)\n {:name \"perf graph\"\n :start-time 0}\n history\n {})\n {:latency-graph {:valid? true},\n :rate-graph {:valid? true},\n :valid? true})))\n\n (testing \"can render a :start :stop nemesis region without opts\"\n (let [checker (perf)\n test {:name \"nemesis compatibility perf test\"\n :start-time 0}\n nemesis-ops [{:type :info\n :process :nemesis\n :f :start\n :value nil\n :time (long (* 1e9 5))}\n {:type :info\n :process :nemesis\n :f :start\n :value [:isolated {\"n2\" #{\"n1\" \"n4\" \"n3\"}, \"n5\" #{\"n1\" \"n4\" \"n3\"}, \"n1\" #{\"n2\" \"n5\"}, \"n4\" #{\"n2\" \"n5\"}, \"n3\" #{\"n2\" \"n5\"}}]\n :time (long (* 1e9 20))}\n {:type :info\n :process :nemesis\n :f :stop\n :value nil\n :time (long (* 1e9 50))}\n {:type :info\n :process :nemesis\n :f :stop\n :value :network-healed\n :time (long (* 1e9 90))}]\n history (->> (into history nemesis-ops)\n h/strip-indices\n h/history)]\n (is (= (check checker test history {})\n {:latency-graph {:valid? true},\n :rate-graph {:valid? true},\n :valid? true}))))\n\n (testing \"can render single nemesis events as bars\"\n (let [checker (perf {:nemeses #{{:name \"solo nemeses\"}}})\n test {:name \"nemeses solo event\"\n :start-time 0}\n nemesis-ops [{:type :info\n :process :nemesis\n :f :nemesize\n :value :spooky!\n :time (long (* 1e9 20))}\n {:type :info\n :process :nemesis\n :f :nemesize\n :value :woah!\n :time (long (* 1e9 80))}]\n history (->> (into history nemesis-ops)\n h/strip-indices\n h/history)]\n (is (= (check checker test history {})\n {:latency-graph {:valid? true},\n :rate-graph {:valid? true},\n :valid? true}))))\n\n (testing \"unfinished starts\"\n (let [checker (perf)\n test {:name \"nemeses unfinished start\"\n :start-time 0}\n nemesis-ops [{:type :info,\n :process :nemesis\n :f :start\n :time (long (* 1e9 20))}\n {:type :info\n :process :nemesis\n :f :start\n :time (long (* 1e9 25))}]\n history (->> (into history nemesis-ops)\n h/strip-indices\n h/history)]\n (is (= (check checker test history {})\n {:latency-graph {:valid? true},\n :rate-graph {:valid? true},\n :valid? true}))))\n\n (testing \"can render nemeses with custom styling\"\n (let [checker (perf {:nemeses #{{:name \"cool nemesis 8)\"\n :fill-color \"#6DB6FE\"\n :transparency 0.5\n :line-color \"#6DB6FE\"\n :line-width 2}}})\n test {:name \"nemeses styling perf test\"\n :start-time 0}\n nemesis-ops [{:type :info\n :process :nemesis\n :f :start\n :value nil\n :time (long (* 1e9 5))}\n {:type :info\n :process :nemesis\n :f :start\n :value [:isolated {\"n2\" #{\"n1\" \"n4\" \"n3\"}, \"n5\" #{\"n1\" \"n4\" \"n3\"}, \"n1\" #{\"n2\" \"n5\"}, \"n4\" #{\"n2\" \"n5\"}, \"n3\" #{\"n2\" \"n5\"}}]\n :time (long (* 1e9 20))}\n {:type :info\n :process :nemesis\n :f :stop\n :value nil\n :time (long (* 1e9 50))}\n {:type :info\n :process :nemesis\n :f :stop\n :value :network-healed\n :time (long (* 1e9 90))}]\n history (->> (into history nemesis-ops)\n h/strip-indices\n h/history)]\n (is (= (check checker test history {})\n {:latency-graph {:valid? true},\n :rate-graph {:valid? true},\n :valid? true}))))\n\n (testing \"can render multiple nemesis regions\"\n (let [checker (perf {:nemeses #{{:name \"1\"\n :start #{:start1}\n :stop #{:stop1}\n :fill-color \"#800080\"\n :transparency 0.2}\n {:name \"2\"\n :start #{:start2.1 :start2.2}\n :stop #{:stop2.1 :stop2.2}\n :fill-color \"#87A96B\"\n :transparency 0.2}}})\n test {:name \"nemeses multiregions perf test\"\n :start-time 0}\n\n ;; Hnnnnnnnnnng we should simplify this... ugly brute force\n nemesis-ops [{:type :info\n :process :nemesis\n :f :start1\n :value nil\n :time (long (* 1e9 5))}\n {:type :info\n :process :nemesis\n :f :start1\n :value [:isolated {\"n2\" #{\"n1\" \"n4\" \"n3\"}, \"n5\" #{\"n1\" \"n4\" \"n3\"}, \"n1\" #{\"n2\" \"n5\"}, \"n4\" #{\"n2\" \"n5\"}, \"n3\" #{\"n2\" \"n5\"}}]\n :time (long (* 1e9 20))}\n {:type :info\n :process :nemesis\n :f :stop1\n :value nil\n :time (long (* 1e9 40))}\n {:type :info\n :process :nemesis\n :f :stop1\n :value :network-healed\n :time (long (* 1e9 60))}\n\n {:type :info\n :process :nemesis\n :f :start2.1\n :value nil\n :time (long (* 1e9 30))}\n {:type :info\n :process :nemesis\n :f :start2.2\n :value [:isolated {\"n2\" #{\"n1\" \"n4\" \"n3\"}, \"n5\" #{\"n1\" \"n4\" \"n3\"}, \"n1\" #{\"n2\" \"n5\"}, \"n4\" #{\"n2\" \"n5\"}, \"n3\" #{\"n2\" \"n5\"}}]\n :time (long (* 1e9 65))}\n {:type :info\n :process :nemesis\n :f :stop2.2\n :value nil\n :time (long (* 1e9 45))}\n {:type :info\n :process :nemesis\n :f :stop2.1\n :value :network-healed\n :time (long (* 1e9 95))}]\n history (->> (into history nemesis-ops)\n h/strip-indices\n h/history)]\n (is (= (check checker test history {})\n {:latency-graph {:valid? true},\n :rate-graph {:valid? true},\n :valid? true}))))))\n\n(deftest clock-plot-test\n (check (clock-plot)\n {:name \"clock plot test\"\n :start-time 0}\n (history\n [{:process :nemesis, :time 500000000, :clock-offsets {\"n1\" 2.1}}\n {:process :nemesis, :time 1000000000, :clock-offsets {\"n1\" 0\n \"n2\" -3.1}}\n {:process :nemesis, :time 1500000000, :clock-offsets {\"n1\" 1\n \"n2\" -2}}\n {:process :nemesis, :time 2000000000, :clock-offsets {\"n1\" 2\n \"n2\" -4.1}}])\n {}))\n\n(deftest op-color-plot-test\n (check (op-color-plot {})\n {:name \"op color plot test\"\n :start-time 0}\n (history\n [{:process 0, :type :invoke}\n {:process 0, :type :ok}\n {:process 0, :type :invoke}\n {:process 0, :type :ok}\n {:process 0, :type :invoke}\n {:process 0, :type :fail}\n {:process 0, :type :invoke}\n {:process 0, :type :info}])\n {}))\n\n(deftest set-full-test\n ; Helper fn to check a history\n (let [c (fn [h]\n (check (set-full) nil (history h) {}))]\n (testing \"never read\"\n (is (= {:lost []\n :attempt-count 1\n :lost-count 0\n :never-read [0]\n :never-read-count 1\n :stale-count 0\n :stale []\n :worst-stale []\n :stable-count 0\n :duplicated-count 0\n :duplicated {}\n :valid? :unknown}\n (c [(invoke-op 0 :add 0)\n (ok-op 0 :add 0)]))))\n\n (let [a (invoke-op 0 :add 0)\n a' (ok-op 0 :add 0)\n r (invoke-op 1 :read nil)\n r+ (ok-op 1 :read #{0})\n r- (ok-op 1 :read #{})]\n (testing \"never confirmed, never read\"\n (is (= {:valid? :unknown\n :attempt-count 1\n :lost []\n :lost-count 0\n :never-read [0]\n :never-read-count 1\n :stale-count 0\n :stale []\n :duplicated-count 0\n :duplicated {}\n :worst-stale []\n :stable-count 0}\n (c [a r r-]))))\n (testing \"successful read either concurrently or after\"\n (is (= {:valid? true\n :attempt-count 1\n :lost []\n :lost-count 0\n :never-read []\n :never-read-count 0\n :stale-count 0\n :stale []\n :worst-stale []\n :duplicated-count 0\n :duplicated {}\n :stable-count 1\n :stable-latencies {0 0, 0.5 0, 0.95 0, 0.99 0, 1 0}}\n (c [r a r+ a']) ; Concurrent read before\n (c [r a a' r+]) ; Concurrent read outside\n (c [a r r+ a']) ; Concurrent read inside\n (c [a r a' r+]) ; Concurrent read after\n (c [a a' r r+]) ; Subsequent read\n )))\n\n (testing \"Absent read after\"\n (is (= {:valid? false\n :attempt-count 1\n :lost [0]\n :lost-count 1\n :never-read []\n :never-read-count 0\n :stale-count 0\n :stale []\n :worst-stale []\n :stable-count 0\n :duplicated-count 0\n :duplicated {}\n :lost-latencies {0 0, 0.5 0, 0.95 0, 0.99 0, 1 0}}\n (c [a a' r r-]))))\n\n (testing \"Absent read concurrently\"\n (is (= {:valid? :unknown\n :attempt-count 1\n :lost []\n :lost-count 0\n :never-read [0]\n :never-read-count 1\n :stale-count 0\n :stale []\n :worst-stale []\n :duplicated-count 0\n :duplicated {}\n :stable-count 0}\n (c [r a r- a']) ; Read before\n (c [r a a' r-]) ; Read outside\n (c [a r r- a']) ; Read inside\n (c [a r a' r-]) ; Read after\n ))))\n\n (let [a0 (invoke-op 0 :add 0)\n a0' (ok-op 0 :add 0)\n a1 (invoke-op 1 :add 1)\n a1' (ok-op 1 :add 1)\n r2 (invoke-op 2 :read nil)\n r3 (invoke-op 3 :read nil)\n r2' (ok-op 2 :read #{})\n r3' (ok-op 3 :read #{})\n r2'0 (ok-op 2 :read #{0})\n r3'0 (ok-op 3 :read #{0})\n r2'1 (ok-op 2 :read #{1})\n r3'1 (ok-op 3 :read #{1})\n r2'01 (ok-op 2 :read #{0 1})\n r3'01 (ok-op 3 :read #{0 1})]\n (testing \"write, present, missing\"\n (is (= {:valid? false\n :attempt-count 2\n :lost [0 1]\n :lost-count 2\n :never-read []\n :never-read-count 0\n :stale-count 0\n :stale []\n :worst-stale []\n :stable-count 0\n :duplicated-count 0\n :duplicated {}\n :lost-latencies {0 3, 0.5 4, 0.95 4, 0.99 4,\n 1 4}}\n ; We write a0 and a1 concurrently, reading 1 before a1\n ; completes. Then we read both, 0, then nothing.\n (c [a0 a1 r2 r2'1 a0' a1' r2 r2'01 r2 r2'0 r2 r2']))))\n (testing \"write, flutter, stable/lost\"\n (is (= {:valid? false\n :attempt-count 2\n :lost [0]\n :lost-count 1\n :never-read []\n :never-read-count 0\n :duplicated-count 0\n :duplicated {}\n ; 1 should have been done at 4, is missing at time 6000, and\n ; recovered at 7000.\n :stale-count 1\n :stale [1]\n :worst-stale [{:element 1\n :known (assoc r2'1\n :index 4\n :time 4000000)\n :last-absent (assoc r2\n :index 6\n :time 6000000)\n :lost-latency nil\n :outcome :stable\n :stable-latency 2}]\n :stable-count 1\n ; We know 0 is done at time 1000, but it goes missing after\n ; 6000.\n :lost-latencies {0 5, 0.5 5, 0.95 5,\n 0.99 5, 1 5}\n ; 1 is known at time 4 (not 5! The read sees it before the\n ; write completes). It is missing at 6000, and recovered at\n ; 7000.\n :stable-latencies {0 2, 0.5 2, 0.95 2,\n 0.99 2, 1 2}}\n ; We write a0, then a1, reading 1 before a1 completes, then just\n ; 0 and 1 concurrently, but 1 starting later. This is a recovery\n ; of 1, but 0 should be lost, because there's no time after\n ; which an operation can begin and always observe 0.\n ;\n ; t 0 1 2 3 4 5 6 7 8 9\n (c [a0 a0' a1 r2 r2'1 a1' r2 r3 r3'1 r2'0])))))))\n\n(deftest log-file-pattern-test\n (let [test (assoc tests/noop-test\n :name \"checker-log-file-pattern\"\n :start-time 0\n :nodes [\"n1\" \"n2\" \"n3\"])]\n ; Create fake logfiles\n (spit (store/path! test \"n1\" \"db.log\") \"foo\\nevil1\\nevil2 more text\\nbar\")\n (spit (store/path! test \"n2\" \"db.log\") \"foo\\nbar\\nbaz evil\\nfoo\\n\")\n ; Check\n (let [res (check (log-file-pattern \"evil\\\\d+\" \"db.log\")\n test nil nil)]\n (is (= false (:valid? res)))\n (is (= 2 (:count res)))\n (is (= [{:node \"n1\", :line \"evil1\"}\n {:node \"n1\", :line \"evil2 more text\"}]\n (:matches res))))))\n" }, { "path": "jepsen/test/jepsen/cli_test.clj", "content": "(ns jepsen.cli-test\n (:require [clojure [test :refer :all]]\n [jepsen [cli :as cli]]))\n\n(deftest without-default-for-test\n (is (= [[\"-w\" \"--workload NAME\" \"What workload should we run?\"\n :parse-fn :foo]\n [\"-a\" \"--another\" \"Some other option\"\n :default false]\n [nil \"--[no-]flag\" \"A boolean flag\"]]\n (cli/without-defaults-for\n [:workload :flag]\n [[\"-w\" \"--workload NAME\" \"What workload should we run?\"\n :default :append\n :parse-fn :foo]\n [\"-a\" \"--another\" \"Some other option\"\n :default false]\n [nil \"--[no-]flag\" \"A boolean flag\"\n :default true]]))))\n\n\n" }, { "path": "jepsen/test/jepsen/common_test.clj", "content": "(ns jepsen.common-test\n \"Support functions for writing tests.\"\n (:require [clojure.tools.logging :refer :all]\n [jepsen [control :as c]\n [core :as jepsen]\n [os :as os]\n [store :as store]\n [tests :as tests]]\n [jepsen.os.debian :as debian]\n [unilog.config :as unilog]))\n\n(defn quiet-logging\n \"A fixture to quiet down logging, call f, then restore it.\"\n [f]\n (unilog/start-logging!\n {:level \"info\"\n :console false\n :appenders [store/console-appender]\n :overrides (merge store/default-logging-overrides\n {\"clj-ssh.ssh\" :error\n \"jepsen.db\" :error\n \"jepsen.core\" :error\n \"jepsen.control.util\" :error\n \"jepsen.independent\" :error\n \"jepsen.generator\" :error\n \"jepsen.lazyfs\" :error\n \"jepsen.os.debian\" :error\n \"jepsen.print\" :error\n \"jepsen.store\" :error\n \"jepsen.tests.kafka\" :error\n \"jepsen.util\" :error\n \"net.schmizz.sshj\" :error\n })})\n (f)\n (store/stop-logging!))\n\n(defonce setup-os-run?\n (atom false))\n\n(defn setup-os!\n \"Fixture for tests. Sets up the OS on each remote node. Runs only once, to\n save time.\"\n [f]\n (when-not @setup-os-run?\n (let [test (assoc tests/noop-test :os debian/os)]\n (jepsen/with-sessions [test test]\n (c/with-all-nodes test\n (os/setup! (:os test) test c/*host*))))\n (reset! setup-os-run? true))\n (f))\n" }, { "path": "jepsen/test/jepsen/control/net_test.clj", "content": "(ns jepsen.control.net-test\n (:require [clojure [pprint :refer [pprint]]\n [test :refer :all]]\n [jepsen [control :as c]]\n [jepsen.control.net :as cn]))\n\n(deftest ip-by-local-dns-test\n (is (= \"72.14.179.192\" (cn/ip-by-local-dns \"aphyr.com\"))))\n\n(deftest ^:integration ip-by-remote-getent-test\n (c/on \"n1\"\n (is (= \"72.14.179.192\" (cn/ip-by-remote-getent \"aphyr.com\")))))\n\n(deftest ip-test\n (is (= \"72.14.179.192\" (cn/ip \"aphyr.com\"))))\n" }, { "path": "jepsen/test/jepsen/control/util_test.clj", "content": "(ns jepsen.control.util-test\n (:require [clojure.tools.logging :refer [info warn]]\n [clojure [string :as str]\n [test :refer :all]]\n [clojure.java.io :as io]\n [jepsen [common-test :refer [quiet-logging]]\n [control :as c]]\n [jepsen.control [util :as util]\n [sshj :as sshj]]\n [clj-commons.slingshot :refer [try+ throw+]]))\n\n(use-fixtures :once\n quiet-logging\n (fn with-ssh [t]\n (c/with-ssh {}\n (c/on \"n1\"\n (t)))))\n\n(defn assert-file-exists\n \"Asserts that a file exists at a given destination\"\n [dest file]\n (is (util/exists? (io/file dest file))))\n\n(defn assert-file-cached\n \"Asserts that a file from a url was downloaded and cached in the wget-cache-dir\"\n [url]\n (assert-file-exists util/wget-cache-dir (util/encode url)))\n\n(defn start-test-daemon!\n \"Starts a Perl daemon for testing. Returns the PID string.\"\n [logfile pidfile]\n (c/exec :rm :-f logfile pidfile)\n (util/start-daemon! {:env {:DOG \"bark\"\n :CAT \"meow mix\"}\n :chdir \"/tmp\"\n :logfile logfile\n :pidfile pidfile}\n \"/usr/bin/perl\"\n :-e\n \"$|++; print \\\"$ENV{'CAT'}\\\\n\\\"; sleep 10;\")\n (Thread/sleep 100)\n (str/trim (c/exec :cat pidfile)))\n\n(defn assert-daemon-stopped!\n \"Asserts that the pidfile is cleaned up and the process is no longer running.\"\n [pidfile pid]\n (testing \"pidfile cleaned up\"\n (is (not (util/exists? pidfile))))\n (testing \"process exited\"\n (is (try+ (c/exec :kill :-0 pid)\n false\n (catch [:exit 1] _ true)))))\n\n(deftest ^:integration daemon-test\n (let [logfile \"/tmp/jepsen-daemon-test.log\"\n pidfile \"/tmp/jepsen-daemon-test.pid\"]\n (let [pid (start-test-daemon! logfile pidfile)]\n (testing \"pidfile exists\"\n (is (re-find #\"\\d+\" pid)))\n (testing \"daemon running\"\n (is (try+ (c/exec :kill \"-0\" pid)\n true\n (catch [:exit 1] _ false))))\n\n (let [log (c/exec :cat logfile)\n lines (str/split log #\"\\n\")]\n (testing \"log starts with Jepsen debug line\"\n (is (re-find #\"^\\d{4}-\\d{2}-\\d{2} \\d{2}:\\d{2}:\\d{2} Jepsen starting DOG=bark CAT=\\\"meow mix\\\" /usr/bin/perl -e \\\"\"\n (first lines))))\n (testing \"env vars threaded through to daemon\"\n (is (= \"meow mix\" (nth lines 1)))))\n\n (testing \"shutdown\"\n (util/stop-daemon! \"/usr/bin/perl\" pidfile)\n (assert-daemon-stopped! pidfile pid)))\n\n (testing \"shutdown with pid\"\n (let [pid (start-test-daemon! logfile pidfile)]\n (util/stop-daemon! nil pidfile :TERM)\n (assert-daemon-stopped! pidfile pid)))\n\n (testing \"sigterm shutdown with command name\"\n (let [pid (start-test-daemon! logfile pidfile)]\n (util/stop-daemon! \"/usr/bin/perl\" pidfile :TERM)\n (assert-daemon-stopped! pidfile pid)))))\n\n(deftest ^:integration install-archive-test\n (testing \"without auth credentials\"\n (let [dest \"/tmp/test\"\n url \"https://storage.googleapis.com/etcd/v3.0.0/etcd-v3.0.0-linux-amd64.tar.gz\"]\n (util/install-archive! (str url) dest {:force? true})\n (assert-file-exists dest \"etcd\")\n (assert-file-cached url)))\n\n (testing \"with auth credentials\"\n (let [dest \"/tmp/test\"\n url \"https://aphyr.com/jepsen-auth/test.zip\"]\n (util/install-archive! (str url) dest {:force? true\n :user? \"jepsen\"\n :pw? \"hunter2\"})\n (assert-file-exists dest \"zeroes.txt\")\n (assert-file-cached url))))\n\n(deftest ^:integration cached-wget-test\n (testing \"without auth credentials\"\n (let [url \"https://aphyr.com/jepsen/test.zip\"]\n (util/cached-wget! url {:force? true})\n (assert-file-cached url)))\n (testing \"with auth credentials\"\n (let [url \"https://aphyr.com/jepsen-auth/test.zip\"]\n (util/cached-wget! url {:force? true :user? \"jepsen\" :pw? \"hunter2\"})\n (assert-file-cached url))))\n\n(deftest ^:integration tarball-test\n ; Populate a temporary directory\n (let [dir (util/tmp-dir!)]\n (try\n (util/write-file! \"foo\" (str dir \"/foo.txt\"))\n (util/write-file! \"bar\" (str dir \"/bar.txt\"))\n ; Tar it up\n (let [tarball (util/tarball! dir)]\n (try\n (is (string? tarball))\n (is (re-find #\"^/.+\\.tar\\.gz$\" tarball))\n ; Extract it\n (let [dir2 (util/tmp-dir!)]\n (try\n (util/install-archive! (str \"file://\" tarball) dir2)\n (is (= \"foo\" (c/exec :cat (str dir2 \"/foo.txt\"))))\n (is (= \"bar\" (c/exec :cat (str dir2 \"/bar.txt\"))))\n (finally\n (c/exec :rm :-rf dir2))))\n (finally\n (c/exec :rm :-rf tarball))))\n (finally\n (c/exec :rm :-rf dir)))))\n\n(deftest ^:integration ls-test\n (let [dir (util/tmp-dir!)]\n (try\n (c/exec :mkdir :-p (str dir \"/foo/bar\"))\n (util/write-file! \"baz\" (str dir \"/foo/bar/baz\"))\n (util/write-file! \"blarg\" (str dir \"/foo/bar/blarg\"))\n (util/write-file! \"xyzzy\" (str dir \"/xyzzy\"))\n\n (testing \"simple\"\n (is (= [\"foo\"\n \"xyzzy\"]\n (util/ls dir))))\n\n (testing \"recursive\"\n (is (= [\"foo\"\n \"foo/bar\"\n \"foo/bar/baz\"\n \"foo/bar/blarg\"\n \"xyzzy\"]\n (util/ls dir {:recursive? true}))))\n\n (testing \"full path\"\n (is (= [(str dir \"/foo\")\n (str dir \"/xyzzy\")]\n (util/ls dir {:full-path? true}))))\n\n (testing \"files\"\n (is (= [\"foo/bar/baz\"\n \"foo/bar/blarg\"\n \"xyzzy\"]\n (util/ls dir {:recursive? true, :types [:file]}))))\n\n (testing \"dirs\"\n (is (= [\"foo\"]\n (util/ls dir {:types [:dir]}))))\n\n (testing \"trailing /\"\n (is (= [\"xyzzy\"]\n (util/ls dir {:types [:file]})\n (util/ls (str dir \"/\") {:types [:file]}))))\n (finally\n (c/exec :rm :-rf dir)))))\n" }, { "path": "jepsen/test/jepsen/control_test.clj", "content": "(ns jepsen.control-test\n (:require [clojure [string :as str]\n [test :refer :all]]\n [clojure.java.io :as io]\n [clojure.tools.logging :refer [info warn]]\n [jepsen [control :as c]\n [common-test :refer [quiet-logging]]\n [util :refer [contains-many? real-pmap]]]\n [jepsen.control [sshj :as sshj]\n [clj-ssh :as clj-ssh]\n [util :as cu]]\n [clj-commons.slingshot :refer [try+ throw+]])\n (:import (java.io File)))\n\n(use-fixtures :once quiet-logging)\n\n(def test-resource\n \"A file in /resources that we can use to verify uploads/downloads.\"\n \"bump-time.c\")\n\n(defn test-remote\n [remote]\n (c/with-ssh {}\n (c/with-remote remote\n (testing \"on failure, session throws debug data\"\n (try+\n (c/on \"thishostshouldnotresolve\"\n (c/exec :echo \"hello\")\n (is false))\n (catch [:type :jepsen.control/session-error] e\n (is (= \"Error opening SSH session. Verify username, password, and node hostnames are correct.\" (:message e)))\n (is (= \"thishostshouldnotresolve\" (:host e)))\n (is (= 22 (:port e)))\n (is (= \"root\" (:username e)))\n (is (= \"root\" (:password e))))))\n\n (c/on \"n1\"\n (testing \"simple exec\"\n (is (= (c/exec :whoami) \"root\")))\n\n (testing \"on failure, throws debug data.\"\n (try+\n (c/exec :thiscmdshouldnotexist)\n (catch [:type :jepsen.control/nonzero-exit] e\n (is (= \"n1\" (:host e)))\n (is (= \"cd /; thiscmdshouldnotexist\" (:cmd e)))\n (is (= \"\" (:out e)))\n (is (= \"bash: line 1: thiscmdshouldnotexist: command not found\\n\"\n (:err e)))\n (is (= 127 (:exit e))))))\n\n (let [remote-path \"/tmp/jepsen-upload-test\"\n contents (slurp (io/resource test-resource))]\n (testing \"upload\"\n (c/exec :rm :-f remote-path)\n (c/upload-resource! test-resource remote-path)\n (is (= contents (str (c/exec :cat remote-path) \"\\n\"))))\n\n (testing \"upload as different user\"\n (c/exec :rm :-f remote-path)\n (c/sudo \"nobody\"\n (c/upload-resource! test-resource remote-path)\n (is (= contents (str (c/exec :cat remote-path) \"\\n\")))\n (is (= \"nobody\" (c/exec :stat :-c \"%U\" remote-path)))))\n\n (testing \"download\"\n (let [tmp (File/createTempFile \"jepsen-download\" \".test\")]\n (try\n (.delete tmp)\n (c/download remote-path (.getCanonicalPath tmp))\n (is (= contents (slurp tmp)))\n (finally\n (.delete tmp)))))\n\n (testing \"download as different user\"\n (let [tmp (File/createTempFile \"jepsen-download\" \".test\")]\n (try\n (.delete tmp)\n ; What we should REALLY do here is show that we can log in as a\n ; passwordless sudo user without privileges to read a file,\n ; then download it anyway, but... that'd require extra setup\n ; for the test env that I don't want to do yet.\n (c/sudo \"nobody\"\n (c/download remote-path (.getCanonicalPath tmp)))\n (is (= contents (slurp tmp)))\n (finally\n (.delete tmp)))))\n\n (c/exec :rm :-f remote-path))\n\n (testing \"very basic stdin\"\n (let [string \"hi\"\n res (-> {:cmd \"cat\", :in string}\n c/ssh*\n c/throw-on-nonzero-exit\n :out)]\n (is (= string res))))\n\n (testing \"write file as different user\"\n ; This uses stdin to write the file contents, and wrapping it in a\n ; sudo requires that we *not* provide a password for sudo here, lest\n ; it be passed in to cat and show up in the file.\n (c/su \"nobody\"\n (let [tmp (cu/tmp-file!)\n string \"bark\\narf\"]\n (try\n (cu/write-file! string tmp)\n (is (= string (c/exec :cat tmp)))\n (finally\n (c/exec :rm :-f tmp))))))\n\n ;(testing \"writing to file\"\n ; (let [file \"/tmp/jepsen/test/write-file-test\"\n ; string \"foo\\nbar\"]\n ; (c/exec :mkdir :-p \"/tmp/jepsen/test\")\n ; (cu/write-file! string file)\n ; (is (= string (c/exec :cat file)))))\n\n (testing \"thread safety\"\n (let [; Concurrency\n concurrency 20\n ; Makes the string we echo bigger or smaller\n str-count 10\n ; How many times do we run each command?\n rep-count 5\n ; What strings are we going to echo on each channel?\n xs (->> (range concurrency)\n (map (fn [i]\n (str/join \",\" (repeat str-count i)))))\n t0 (System/nanoTime)]\n ; On concurrency channels, echo that string several times, making\n ; sure it comes back properly.\n (->> (for [x xs]\n (future\n (dotimes [i rep-count]\n ;(info :call node :i i :x x)\n (is (= x (c/exec :echo x))))))\n vec\n (mapv deref))\n ;(info :time (-> (System/nanoTime) (- t0) (/ 1e6)) \"ms\")\n ))\n\n (testing \"handles interrupts correctly\"\n (let [thread (Thread/currentThread)\n ; Interrupt ourselves during exec\n killer (future\n (Thread/sleep 20)\n (.interrupt thread))\n res (try (c/exec :sleep 1)\n :unreachable\n (catch InterruptedException ee\n :interrupted)\n (catch java.io.InterruptedIOException e\n :interrupted-io))]\n (is #{:interrupted :interrupted-io} res)))))))\n\n(deftest ^:integration clj-ssh-remote-test\n ;(info :clj-ssh)\n (test-remote (clj-ssh/remote)))\n\n(deftest ^:integration sshj-remote-test\n ;(info :sshj)\n (test-remote (sshj/remote)))\n" }, { "path": "jepsen/test/jepsen/core_test.clj", "content": "(ns jepsen.core-test\n (:refer-clojure :exclude [run!])\n (:require [clojure [pprint :refer [pprint]]\n [string :as str]\n [test :refer :all]]\n [dom-top.core :refer [loopr]]\n [jepsen [checker :as checker]\n [client :as client]\n [common-test :refer [quiet-logging]]\n [control :as control]\n [core :refer :all]\n [db :as db]\n [generator :as gen]\n [history :as h]\n [nemesis :as nemesis]\n [nemesis-test :as nemesis-test]\n [os :as os]\n [store :as store]\n [tests :as tst]\n [util :as util]]\n [jepsen.generator.context :as gen.ctx]\n [jepsen.tests.cycle.append :as list-append])\n (:import (jepsen.history IHistory\n Op)))\n\n(use-fixtures :once quiet-logging)\n\n(defn tracking-client\n \"Tracks connections in an atom.\"\n ([conns]\n (tracking-client conns (atom 0)))\n ([conns uid]\n (reify client/Client\n (open! [c test node]\n (let [uid (swap! uid inc)] ; silly hack\n (swap! conns conj uid)\n (tracking-client conns uid)))\n\n (setup! [c test] c)\n\n (invoke! [c test op]\n (assoc op :type :ok))\n\n (teardown! [c test] c)\n\n (close! [c test]\n (swap! conns disj uid)))))\n\n(deftest most-interesting-exception-test\n ; Verifies that we get interesting, rather than interrupted or broken barrier\n ; exceptions, out of tests\n (let [db (reify db/DB\n (setup! [this test node]\n ; One thread throws\n (when (= (nth (:nodes test) 2) node)\n (throw (RuntimeException. \"hi\")))\n\n (throw (java.util.concurrent.BrokenBarrierException. \"oops\")))\n\n (teardown! [this test node]))\n test (assoc tst/noop-test\n :pure-generators true\n :name \"interesting exception\"\n :db db\n :ssh {:dummy? true})]\n (is (thrown-with-msg? RuntimeException #\"^hi$\" (run! test)))))\n\n(defn list-append-test\n \"Tests a list-append workload on a simple in-memory database. Runs n ops.\n Helpful stress & sanity test for generators, writing and reading histories,\n and the Elle checker.\"\n [n]\n (let [state (atom {})\n ; Takes a state, a txn, and a volatile for the completed txn to go to.\n ; Applies txn to state, returning new state, and updating volatile.\n apply-txn (fn apply-txn [state txn txn'-volatile]\n (loopr [state' (transient state)\n txn' (transient [])]\n [[f k v :as mop] txn]\n (case f\n :r (recur state'\n (conj! txn' [f k (get state' k)]))\n :append (recur (assoc! state' k\n (conj (get state' k []) v))\n (conj! txn' mop)))\n (do (vreset! txn'-volatile (persistent! txn'))\n (persistent! state'))))\n t1 (volatile! nil)\n client (reify client/Client\n (open! [this test node] this)\n (setup! [this test] this)\n (invoke! [this test op]\n (let [txn' (volatile! nil)]\n (swap! state apply-txn (:value op) txn')\n (assoc op :type :ok, :value @txn')))\n (teardown! [this test]\n (vreset! t1 (System/nanoTime)))\n (close! [this test]))\n test (-> tst/noop-test\n (merge (list-append/test {})\n {:name \"list-append\"\n :client client\n :concurrency 100\n :ssh {:dummy? true}})\n (update :generator #(->> %\n gen/clients\n (gen/limit n))))\n t0 (System/nanoTime)\n test (run! test)\n t1 @t1\n t2 (System/nanoTime)\n h (:history test)\n r (:results test)]\n (testing \"history\"\n (is (= (* 2 n) (count h)))\n (is (instance? IHistory h))\n (is (instance? Op (first h))))\n (testing \"results\"\n (is (= true (:valid? r))))\n (assoc test\n :run-time (double (util/nanos->secs (- t1 t0)))\n :check-time (double (util/nanos->secs (- t2 t1))))))\n\n(deftest list-append-short-test\n (list-append-test 100))\n\n(deftest ^:perf list-append-perf-test\n (let [n (long 1e6)\n {:keys [run-time check-time]} (list-append-test n)]\n (println (format \"list-append-perf-test: %d ops run in %.2f s (%.2f ops/sec); checked in %.2f s (%.2f ops/sec)\"\n n run-time (/ n run-time)\n check-time (/ n check-time)))))\n\n(deftest ^:integration basic-cas-test\n (let [state (atom nil)\n meta-log (atom [])\n db (tst/atom-db state)\n n 1000\n nemesis (nemesis-test/test-nem :nem #{:fault})\n test (assoc tst/noop-test\n :name \"basic cas pure-gen\"\n :db db\n :client (tst/atom-client state meta-log)\n :nemesis nemesis\n :concurrency 10\n :pure-generators true\n :generator\n (->> (gen/phases\n {:f :read}\n (->> (gen/reserve\n 5 (repeat {:f :read})\n (gen/mix\n [(fn [] {:f :write\n :value (rand-int 5)})\n (fn [] {:f :cas\n :value [(rand-int 5)\n (rand-int 5)]})]))\n (gen/limit n)))\n (gen/nemesis {:type :info, :f :fault})))\n test (run! test)\n h (:history test)\n invokes (partial filter h/invoke?)\n oks (partial filter h/ok?)\n reads (partial filter (comp #{:read} :f))\n writes (partial filter (comp #{:write} :f))\n cases (partial filter (comp #{:cas} :f))\n values (partial map :value)\n smol? #(<= 0 % 4)\n smol-vec? #(and (vector? %)\n (= 2 (count %))\n (every? smol? %))]\n (testing \"db teardown\"\n (is (= :done @state)))\n\n (testing \"client setup/teardown\"\n (let [n (count (:nodes test))\n n2 (* 2 n)\n setup (take n2 @meta-log)\n run (->> @meta-log (drop n2) (drop-last n2))\n teardown (take-last n2 @meta-log)]\n (is (= {:open n :setup n} (frequencies setup)))\n (is (= {:open n2 :close n2} (frequencies run)))\n (is (= {:teardown n :close n} (frequencies teardown)))))\n\n (testing \"nemesis setup/teardown\"\n (let [ops (filter (comp #{:nemesis} :process) h)\n _ (is (= 2 (count ops)))\n [op op'] ops]\n ; Generator should have produced a fault\n (is (= :fault (:f op)))\n (is (= :fault (:f op')))\n ; The nemesis should have been set up, but we won't have seen that\n ; change the original nemesis.\n (is (false? (:setup? nemesis)))\n ; But since we write the nemesis to the completion value, THAT should\n ; have been set up.\n (let [nemesis' (:value op')]\n (is (= :nem (:id nemesis')))\n (is (true? (:setup? nemesis'))))\n ; Finally, we want to make sure we actually tore down the nemesis. This\n ; one's stateful, so we read it from the original nemesis.\n (is (true? @(:teardown? nemesis)))))\n\n (is (:valid? (:results test)))\n (testing \"first read\"\n (is (= 0 (:value (first (oks (reads h)))))))\n (testing \"history\"\n ; 1 initial read, 1 nemesis fault\n (is (= (* 2 (+ 2 n)) (count h)))\n (is (= #{:read :write :cas :fault} (set (map :f h))))\n (is (every? nil? (values (invokes (reads h)))))\n (is (every? smol? (values (oks (reads h)))))\n (is (every? smol? (values (writes h))))\n (is (every? smol-vec? (values (cases h)))))))\n\n(deftest ^:integration ssh-test\n (let [os-startups (atom {})\n os-teardowns (atom {})\n db-startups (atom {})\n db-teardowns (atom {})\n db-primaries (atom [])\n nonce (rand-int Integer/MAX_VALUE)\n nonce-file \"/tmp/jepsen-test\"\n test (run! (assoc tst/noop-test\n :name \"ssh test\"\n :pure-generators true\n :os (reify os/OS\n (setup! [_ test node]\n (swap! os-startups assoc node\n (control/exec :hostname)))\n\n (teardown! [_ test node]\n (swap! os-teardowns assoc node\n (control/exec :hostname))))\n\n :db (reify db/DB\n (setup! [_ test node]\n (swap! db-startups assoc node\n (control/exec :hostname))\n (control/exec :echo nonce :> nonce-file))\n\n (teardown! [_ test node]\n (swap! db-teardowns assoc node\n (control/exec :hostname))\n (control/exec :rm :-f nonce-file))\n\n db/Primary\n (setup-primary! [_ test node]\n (swap! db-primaries conj\n (control/exec :hostname)))\n\n db/LogFiles\n (log-files [_ test node]\n [nonce-file]))))]\n\n (is (:valid? (:results test)))\n (is (apply =\n (str nonce)\n (->> test\n :nodes\n (map #(->> (store/path test (name %)\n (str/replace nonce-file #\".+/\" \"\"))\n slurp\n str/trim)))))\n (is (= @os-startups @os-teardowns @db-startups @db-teardowns\n {\"n1\" \"n1\"\n \"n2\" \"n2\"\n \"n3\" \"n3\"\n \"n4\" \"n4\"\n \"n5\" \"n5\"}))\n (is (= @db-primaries [\"n1\"]))))\n\n(deftest ^:integration worker-recovery-test\n ; Workers should only consume n ops even when failing.\n (let [invocations (atom 0)\n n 12]\n (run! (assoc tst/noop-test\n :name \"worker recovery\"\n :client (reify client/Client\n (open! [c t n] c)\n (setup! [c t])\n (invoke! [_ _ _]\n (swap! invocations inc)\n (/ 1 0))\n (teardown! [c t])\n (close! [c t]))\n :checker (checker/unbridled-optimism)\n :pure-generators true\n :generator (->> (repeat {:f :read})\n (gen/limit n)\n (gen/nemesis nil))))\n (is (= n @invocations))))\n\n(deftest ^:integration generator-recovery-test\n ; Throwing an exception from a generator shouldn't break the core. We use\n ; gen/phases to force a synchronization barrier in the generator, which would\n ; ordinarily deadlock when one worker thread prematurely exits, and prove\n ; that we can knock other worker threads out of that barrier and have them\n ; abort cleanly.\n (let [conns (atom #{})]\n (is (thrown-with-msg?\n clojure.lang.ExceptionInfo #\"Divide by zero\"\n (run! (assoc tst/noop-test\n :name \"generator recovery\"\n :client (tracking-client conns)\n :pure-generators true\n :generator (gen/clients\n (gen/phases\n (gen/each-thread\n (gen/once\n (fn [test ctx]\n (if (= [0] (seq (gen.ctx/free-threads ctx)))\n (/ 1 0)\n {:type :invoke, :f :meow}))))\n (gen/once {:type :invoke, :f :done})))))))\n (is (empty? @conns))))\n\n(deftest ^:integration worker-error-test\n ; Errors in client and nemesis setup and teardown should be rethrown from\n ; tests.\n (let [client (fn [t]\n (reify client/Client\n (open! [c test node] (if (= :open t) (assert false) c))\n (setup! [c test] (if (= :setup t) (assert false)))\n (invoke! [c test op] (assoc op :type :ok))\n (teardown! [c test] (if (= :teardown t) (assert false)))\n (close! [c test] (if (= :close t) (assert false)))))\n nemesis (fn [t]\n (reify nemesis/Nemesis\n (setup! [n test] (if (= :setup t) (assert false) n))\n (invoke! [n test op] op)\n (teardown! [n test] (if (= :teardown t) (assert false)))))\n test (fn [client-type nemesis-type]\n (run! (assoc tst/noop-test\n :pure-generators true\n :client (client client-type)\n :nemesis (nemesis nemesis-type))))]\n (testing \"client open\" (is (thrown-with-msg? AssertionError #\"false\" (test :open nil))))\n (testing \"client setup\" (is (thrown-with-msg? AssertionError #\"false\" (test :setup nil))))\n (testing \"client teardown\" (is (thrown-with-msg? AssertionError #\"false\" (test :teardown nil))))\n (testing \"client close\" (is (thrown-with-msg? AssertionError #\"false\" (test :close nil))))\n (testing \"nemesis setup\" (is (thrown-with-msg? AssertionError #\"false\" (test :setup nil))))\n (testing \"nemesis teardown\" (is (thrown-with-msg? AssertionError #\"false\" (test :teardown nil))))))\n" }, { "path": "jepsen/test/jepsen/db/watchdog_test.clj", "content": "(ns jepsen.db.watchdog-test\n (:require [clojure [pprint :refer [pprint]]\n [test :refer :all]]\n [jepsen [client :as client]\n [common-test :refer [quiet-logging]]\n [control :as c]\n [core :as jepsen]\n [db :as db]\n [generator :as gen]\n [history :as h]\n [nemesis :as n]\n [tests :refer [noop-test]]]\n [jepsen.control [util :as cu]]\n [jepsen.db.watchdog :as w]\n [clj-commons.slingshot :refer [try+ throw+]]))\n\n(use-fixtures :once quiet-logging)\n\n; This DB likes to crash all the time\n(defrecord CrashDB []\n db/DB\n (setup! [this test node]\n (db/start! this test node))\n\n (teardown! [this test node]\n (db/kill! this test node))\n\n db/Kill\n (kill! [_ test node]\n (cu/grepkill! \"sleep\"))\n\n (start! [_ test node]\n (cu/start-daemon! {:chdir \"/tmp/jepsen\"\n :pidfile \"/tmp/jepsen/watchdog-test.pid\"\n :logfile \"/tmp/jepsen/watchdog-test.log\"}\n \"/usr/bin/sleep\" 3))\n\n db/LogFiles\n (log-files [_ _ _])\n\n db/Primary\n (primaries [_ _])\n (setup-primary! [_ _ _]))\n\n(defn running?\n \"Is the DB running?\"\n [test node]\n (try+ (c/exec :pgrep \"sleep\")\n true\n (catch [:type :jepsen.control/nonzero-exit] _\n false)))\n\n; Just looks to see if it's running or not\n(defrecord Client []\n client/Client\n (open! [this test node]\n this)\n\n (setup! [_ _])\n\n (invoke! [_ test op]\n (let [r (c/on-nodes test running?)\n ; We're going to assume every node runs on the same schedule, at least at our granularity.\n _ (assert (apply = (vals r)))\n r (val (first r))]\n (assoc op :type :ok, :value r)))\n\n (teardown! [_ _])\n\n (close! [_ _]))\n\n; No way around this being slow, we actually have to run stuff on real nodes\n; and wait for it to die.\n(deftest ^:slow ^:integration watchdog-test\n (let [; We poll every second to see if things are running\n gen (->> (gen/repeat {:f :running})\n (gen/delay 1)\n ; We wait five seconds, kill everyone, wait five more, and restart.\n (gen/nemesis\n [(gen/sleep 5)\n {:type :info, :f :start}\n (gen/sleep 5)\n {:type :info, :f :stop}])\n (gen/time-limit 15))\n ; If you remove the w/db wrapper, the test will fail\n db (w/db {:running? running?}\n (CrashDB.))\n test (assoc noop-test\n :nodes [\"n1\"]\n :name \"watchdog-test\"\n :db db\n :client (Client.)\n :nemesis (n/node-start-stopper identity\n (partial db/kill! db)\n (partial db/start! db))\n :generator gen)\n test' (jepsen/run! test)\n ; Project down history\n h (->> (:history test')\n (h/remove h/invoke?)\n (h/map :value)\n (remove nil?))\n ; Divide the polls into three zones: the fresh cluster, once killed,\n ; and once restarted.\n [fresh _ dead _ restarted] (partition-by map? h)]\n\n ;(pprint fresh)\n ;(pprint dead)\n ;(pprint restarted)\n\n (testing \"fresh\"\n ; Initially, we should be running.\n (is (first fresh))\n ; But even though we die, we should be restarted and running at the end.\n (is (last fresh)))\n\n (testing \"dead\"\n ; We should never run during this part. We might race during the first op though.\n (is (every? false? (next dead))))\n\n (testing \"restarted\"\n ; Same deal, we should be running at the start and end.\n (is (first fresh))\n (is (last fresh)))\n ))\n" }, { "path": "jepsen/test/jepsen/db_test.clj", "content": "(ns jepsen.db-test\n \"Tests for jepsen.db\"\n (:require [clojure [test :refer :all]]\n [jepsen [db :as db]]))\n\n(defn log-db\n \"A DB which logs operations of the form [:prefix op test node] to the given atom, containing a vector.\"\n [log prefix]\n (reify db/DB\n (setup! [_ test node] (swap! log conj [prefix :setup! test node]))\n (teardown! [_ test node] (swap! log conj [prefix :teardown! test node]))\n\n db/Kill\n (start! [_ test node] (swap! log conj [prefix :start! test node]))\n (kill! [_ test node] (swap! log conj [prefix :kill! test node]))\n\n db/Pause\n (pause! [_ test node] (swap! log conj [prefix :pause! test node]))\n (resume! [_ test node] (swap! log conj [prefix :resume! test node]))\n\n db/Primary\n (primaries [_ test] [(first (:nodes test))])\n (setup-primary! [_ test node] (swap! log conj [prefix :setup-primary! test node]))\n\n db/LogFiles\n (log-files [db test node]\n [prefix])))\n\n(deftest map-test-test\n (let [n \"a\"\n t {:nodes [n]}\n log (atom [])\n db (db/map-test #(assoc % :nodes [\"b\"])\n (log-db log :log))\n t' {:nodes [\"b\"]}]\n (testing \"side effects\"\n (db/setup! db t n)\n (db/teardown! db t n)\n (db/kill! db t n)\n (db/start! db t n)\n (db/pause! db t n)\n (db/resume! db t n)\n (db/setup-primary! db t n)\n (is (= [[:log :setup! t' n]\n [:log :teardown! t' n]\n [:log :kill! t' n]\n [:log :start! t' n]\n [:log :pause! t' n]\n [:log :resume! t' n]\n [:log :setup-primary! t' n]]\n @log)))\n ; We don't test primaries or log-files, maybe add this later.\n ))\n" }, { "path": "jepsen/test/jepsen/fs_cache_test.clj", "content": "(ns jepsen.fs-cache-test\n (:require [clojure [test :refer :all]]\n [clojure.java.io :as io]\n [clojure.tools.logging :refer [info warn]]\n [jepsen [control :as c]\n [common-test :refer [quiet-logging]]\n [fs-cache :as cache]]\n [jepsen.control [sshj :as sshj]\n [util :as cu]]))\n\n(use-fixtures :once quiet-logging)\n(use-fixtures :each (fn [t]\n (cache/clear!)\n (t)\n (cache/clear!)))\n\n(deftest fs-path-test\n (is (= [\"dk_dog\"\n \"ds_meow\\\\/woof\\\\\\\\evil\"\n \"dl_3\"\n \"db_false\"\n \"db_true\"\n \"dm_11\"\n \"fn_12\"]\n (cache/fs-path [:cat/dog\n \"meow/woof\\\\evil\"\n 3\n false\n true\n 11M\n 12N]))))\n\n(deftest file-test\n (testing \"empty\"\n (is (thrown? IllegalArgumentException (cache/file []))))\n\n (testing \"single path\"\n (is (= (io/file \"/tmp/jepsen/cache/fk_foo\")\n (cache/file [:foo]))))\n\n (testing \"multiple paths\"\n (is (= (io/file \"/tmp/jepsen/cache/dk_foo/fs_bar\")\n (cache/file [:foo \"bar\"])))))\n\n(deftest file-test\n (let [f (io/file \"/tmp/jepsen/cache-test\")\n contents \"hello there\"\n path [:foo]]\n (spit f contents)\n\n (testing \"not cached\"\n (is (not (cache/cached? path)))\n (is (nil? (cache/load-file path))))\n\n (testing \"cached\"\n (cache/save-file! f path)\n (is (cache/cached? path)))\n\n (testing \"read as file\"\n (is (= contents (slurp (cache/load-file path)))))\n\n (testing \"read as string\"\n (is (= contents (cache/load-string path))))))\n\n(deftest string-test\n (let [contents \"foo\\nbar\"\n path [1 2 3]]\n (testing \"not cached\"\n (is (not (cache/cached? path)))\n (is (nil? (cache/load-string path))))\n\n (testing \"cached\"\n (cache/save-string! contents path)\n (is (cache/cached? path))\n (is (= contents (cache/load-string path))))))\n\n(deftest edn-test\n (let [contents {:foo [1 2N \"three\" 'four]}\n path [\"weirdly\" :specific true]]\n (testing \"not cached\"\n (is (not (cache/cached? path)))\n (is (nil? (cache/load-edn path))))\n\n (testing \"cached\"\n (cache/save-edn! contents path)\n (is (cache/cached? path))\n (is (= contents (cache/load-edn path))))))\n\n(defmacro on-n1\n \"Run form with an SSH connection to n1\"\n [& body]\n ; Right now sshj is faster but not yet the default, so we\n ; set it explicitly.\n `(c/with-remote (sshj/remote)\n (c/with-ssh {}\n (c/on \"n1\"\n ~@body))))\n\n(deftest ^:integration remote-test\n (on-n1\n (let [contents \"foo\\nbar\"\n local-path [:local]\n remote-path \"/tmp/jepsen/remote\"]\n (c/exec :rm :-rf \"/tmp/jepsen\")\n\n (testing \"upload\"\n (cache/save-string! contents local-path)\n (cache/deploy-remote! local-path remote-path)\n (is (= contents (c/exec :cat remote-path))))\n\n (testing \"download\"\n (cache/clear! local-path)\n (is (not (cache/cached? local-path)))\n (cache/save-remote! remote-path local-path)\n (is (cache/cached? local-path))\n (is (= contents (cache/load-string local-path)))))))\n" }, { "path": "jepsen/test/jepsen/generator/interpreter_test.clj", "content": "(ns jepsen.generator.interpreter-test\n (:refer-clojure :exclude [run!])\n (:require [clojure [data :refer [diff]]\n [datafy :refer [datafy]]]\n [clojure.tools.logging :refer [info warn]]\n [jepsen.generator :as gen]\n [jepsen.generator.interpreter :refer :all]\n [jepsen [common-test :refer [quiet-logging]]\n [core :as jepsen]\n [client :refer [Client]]\n [history :as h]\n [nemesis :refer [Nemesis]]\n [util :as util]\n [tests :as tests]]\n [clojure [pprint :refer [pprint]]\n [test :refer :all]]\n [clj-commons.slingshot :refer [try+ throw+]]))\n\n(use-fixtures :once quiet-logging)\n\n(def base-test\n (assoc tests/noop-test\n :concurrency 10))\n\n(defn ok-client\n []\n (reify Client\n (open! [this test node] this)\n (setup! [this test])\n (invoke! [this test op]\n (Thread/sleep 10)\n (assoc op :type :ok))\n (teardown! [this test])\n (close! [this test])))\n\n(defn info-nemesis\n []\n (reify Nemesis\n (setup! [this test] this)\n (invoke! [this test op] op)\n (teardown! [this test])))\n\n(deftest ^:perf perf-test\n (let [time-limit 15\n concurrency 1024\n test (assoc base-test\n :concurrency concurrency\n :client (reify Client\n (open! [this test node] this)\n (setup! [this test])\n (invoke! [this test op]\n (assoc op :type\n (condp < (rand)\n ; 1 in 10 ops crash\n 0.9 :info\n ; 3 in 10 fail\n 0.6 :fail\n ; 6 in 10 succeed\n :ok)\n :value :foo))\n (teardown! [this test])\n (close! [this test]))\n :nemesis (reify Nemesis\n (setup! [this test] this)\n (invoke! [this test op]\n (assoc op :type :info, :value :broken))\n (teardown! [this test]))\n :generator\n (gen/phases\n (->> (gen/reserve (long (/ concurrency 4))\n (->> (range)\n (map (fn [x] {:f :write, :value x})))\n\n (long (/ concurrency 2))\n (fn cas-gen [test ctx]\n {:f :cas\n :value [(rand-int 5) (rand-int 5)]})\n\n (repeat {:f :read}))\n (gen/nemesis\n (gen/mix [(gen/repeat {:type :info, :f :break})\n (gen/repeat {:type :info, :f :repair})]))\n (gen/time-limit time-limit))\n (gen/log \"Recovering\")))\n h (:history (jepsen/run! test))\n rate (float (/ (count h) 2 time-limit))]\n (prn :generator-interpeter-rate rate)\n (is (< 10000 rate))))\n\n(deftest run!-test\n (let [time-limit 1\n sleep-duration 1/10\n test (assoc base-test\n :name \"interpreter-run-test\"\n :client (reify Client\n (open! [this test node] this)\n (setup! [this test])\n (invoke! [this test op]\n (assoc op :type (rand-nth [:ok :info :fail])\n :value :foo))\n (teardown! [this test])\n (close! [this test]))\n :nemesis (reify Nemesis\n (setup! [this test] this)\n (invoke! [this test op]\n (assoc op :type :info, :value :broken))\n (teardown! [this test]))\n :generator\n (gen/phases\n (->> (gen/reserve 2 (->> (range)\n (map (fn [x] {:f :write, :value x})))\n 5 (fn cas-gen [test ctx]\n {:f :cas\n :value [(rand-int 5) (rand-int 5)]})\n (repeat {:f :read}))\n (gen/nemesis\n (gen/mix [(gen/repeat {:type :info, :f :break})\n (gen/repeat {:type :info, :f :repair})]))\n (gen/time-limit time-limit))\n (gen/log \"Recovering\")\n (gen/nemesis {:type :info, :f :recover})\n (gen/sleep sleep-duration)\n (gen/log \"done recovering; final read\")\n (gen/clients (gen/until-ok (repeat {:f :read})))))\n h (:history (jepsen/run! test))\n nemesis-ops (filter (comp #{:nemesis} :process) h)\n client-ops (remove (comp #{:nemesis} :process) h)]\n\n (testing \"general structure\"\n (is (sequential? h))\n (is (indexed? h))\n (is (counted? h))\n (is (= #{:invoke :ok :info :fail} (set (map :type h))))\n (is (every? integer? (map :time h))))\n\n (testing \"timestamps\"\n (is (distinct? (map :time h)))\n (is (= (sort (map :time h)) (map :time h))))\n\n (testing \"client ops\"\n (is (seq client-ops))\n (is (every? #{:write :read :cas} (map :f client-ops))))\n\n (testing \"nemesis ops\"\n (is (seq nemesis-ops))\n (is (every? #{:break :repair :recover} (map :f nemesis-ops))))\n\n (testing \"mixed, recover, final read\"\n (let [recoveries (keep-indexed (fn [index op]\n (when (= :recover (:f op))\n index))\n h)\n recovery (first recoveries)\n mixed (take recovery h)\n mixed-clients (filter (comp number? :process) mixed)\n mixed-nemesis (remove (comp number? :process) mixed)\n final (drop (+ 2 recovery) h)]\n\n (testing \"mixed\"\n (is (pos? (count mixed)))\n (is (some #{:nemesis} (map :process mixed)))\n (is (some number? (map :process mixed)))\n (is (= #{:invoke :ok :info :fail} (set (map :type mixed))))\n (is (= #{:write :read :cas} (set (map :f mixed-clients))))\n (is (= #{:break :repair} (set (map :f mixed-nemesis))))\n\n (let [by-f (group-by :f mixed-clients)\n n (count mixed-clients)]\n ;(pprint (util/map-vals (comp float #(/ % n) count) by-f))\n (testing \"writes\"\n (is (< 1/10 (/ (count (by-f :write)) n) 3/10))\n (is (distinct? (map :value (filter (comp #{:invoke} :type)\n (by-f :write))))))\n (testing \"cas\"\n (is (< 4/10 (/ (count (by-f :cas)) n) 6/10))\n (is (every? vector? (map :value (filter (comp #{:invoke} :type)\n (by-f :cas))))))\n\n (testing \"read\"\n (is (< 2/10 (/ (count (by-f :read)) n) 4/10)))))\n\n (testing \"recovery\"\n (is (= 2 (count recoveries)))\n (is (= (inc (first recoveries)) (second recoveries))))\n\n (testing \"final read\"\n (is (pos? (count final)))\n (is (every? number? (map :process final)))\n (is (every? (comp #{:read} :f) final))\n (is (pos? (count (filter (comp #{:ok} :type) final)))))))\n\n (testing \"fast enough\"\n ; On my box, ~18K ops/sec. This is a good place to profile, I\n ; think--there's some low-hanging fruit in OnThreads `update`, which\n ; calls process->thread with a linear cost.\n ; (prn (float (/ (count h) time-limit)))\n (is (< 5000 (float (/ (count h) time-limit)))))\n ))\n\n(deftest run!-end-process-test\n ; When a client explicitly signifies that it'd like to end the process, we\n ; should spawn a new one.\n (let [test (assoc base-test\n :name \"interpreter-run-end-process-test\"\n :concurrency 1\n :client (reify Client\n (open! [this test node] this)\n (setup! [this test])\n (invoke! [this test op]\n (assoc op :type :fail, :end-process? true))\n (teardown! [this test])\n (close! [this test]))\n :generator (->> {:f :wag}\n (repeat 3)\n gen/clients))\n h (:history (jepsen/run! test))\n completions (h/remove h/invoke? h)]\n (is (= [[0 :fail :wag]\n [1 :fail :wag]\n [2 :fail :wag]]\n (map (juxt :process :type :f) completions)))))\n\n(deftest run!-throw-test\n (testing \"worker throws\"\n (let [opens (atom 0) ; Number of calls to open a client\n closes (atom 0) ; Number of calls to close a client\n test (assoc base-test\n :name \"generator interpreter run!-throw-test\"\n :concurrency 1\n :client (reify Client\n (open! [this test node]\n (swap! opens inc)\n this)\n (setup! [this test])\n (invoke! [this test op]\n (assert false))\n (teardown! [this test])\n (close! [this test]\n (swap! closes inc)))\n :nemesis (reify Nemesis\n (setup! [this test] this)\n (invoke! [this test op] (assert false))\n (teardown! [this test]))\n :generator\n (->> (repeat 2 {:f :read})\n (gen/nemesis\n (repeat 2 {:type :info, :f :break}))))\n h (:history (jepsen/run! test))\n completions (h/remove h/invoke? h)\n err \"indeterminate: Assert failed: false\"]\n (is (= [[:nemesis :info :break nil]\n [:nemesis :info :break err]\n [:nemesis :info :break nil]\n [:nemesis :info :break err]\n [0 :invoke :read nil]\n [0 :info :read err]\n [1 :invoke :read nil]\n [1 :info :read err]]\n (->> h\n ; Try to cut past parallel nondeterminism\n (sort-by :process util/poly-compare)\n (map (juxt :process :type :f :error)))))\n ; We should have closed everything that we opened\n (is (= @opens @closes))))\n\n (testing \"generator op throws\"\n (let [call-count (atom 0)\n gen (->> (fn []\n (swap! call-count inc)\n (assert false))\n (gen/limit 2))\n test (assoc base-test\n :client (ok-client)\n :nemesis (info-nemesis)\n :generator gen)\n e (try+ (:history (jepsen/run! test))\n :nope\n (catch [:type :jepsen.generator/op-threw] e e))]\n (is (= 1 @call-count))\n (is (= :jepsen.generator/op-threw (:type e)))\n (is (= (dissoc (datafy (gen/context test)) :time)\n (dissoc (:context e) :time)))))\n\n (testing \"generator update throws\"\n (let [gen (->> (reify gen/Generator\n (op [this test ctx]\n [(first (gen/op {:f :write, :value 2} test ctx))\n this])\n\n (update [this test ctx event]\n (assert false)))\n (gen/limit 2)\n gen/validate\n gen/friendly-exceptions)\n test (assoc base-test\n :client (ok-client)\n :nemesis (info-nemesis)\n :generator gen)\n e (try+ (:history (jepsen/run! test))\n :nope\n (catch [:type :jepsen.generator/update-threw] e e))]\n (testing \"context map\"\n (let [expected-ctx (-> (datafy (gen/context test))\n (assoc :time (:time (:context e))\n :next-thread-index 1)\n (update :free-threads disj\n (:process (:event e))))]\n (is (= expected-ctx (:context e)))))\n (is (= (h/op {:index 0\n :f :write\n :value 2\n :time (:time (:context e))\n :process (:process (:event e))\n :type :invoke})\n (:event e))))))\n" }, { "path": "jepsen/test/jepsen/generator_test.clj", "content": "(ns jepsen.generator-test\n (:require [jepsen.generator [context :as ctx]\n [test :as gen.test]]\n [jepsen [generator :as gen]\n [history :as h]\n [independent :as independent]\n [util :as util]]\n [clojure [pprint :refer [pprint]]\n [test :refer :all]]\n [clj-commons.slingshot :refer [try+ throw+]])\n (:import (io.lacuna.bifurcan IMap\n Map\n Set)))\n\n;; Independent tests\n\n(deftest independent-sequential-test\n (is (= [[0 0 [:x 0]]\n [0 1 [:x 1]]\n [10 1 [:x 2]]\n [10 0 [:y 0]]\n [20 0 [:y 1]]\n [20 1 [:y 2]]]\n (->> (independent/sequential-generator\n [:x :y]\n (fn [k]\n (->> (range)\n (map (partial hash-map :type :invoke, :value))\n (gen/limit 3))))\n gen/clients\n gen.test/perfect\n (map (juxt :time :process :value))))))\n\n(deftest independent-concurrent-test\n ; All 3 groups can concurrently execute the first 2 values from k0, k1, k2\n (is (= [[0 4 [:k2 :v0]]\n [0 5 [:k2 :v1]]\n [0 0 [:k0 :v0]]\n [0 3 [:k1 :v0]]\n [0 2 [:k1 :v1]]\n [0 1 [:k0 :v1]]\n\n ; Worker 1 in group 0 finishes k0\n [10 1 [:k0 :v2]]\n ; Worker 2 in group 1 finishes k1\n [10 2 [:k1 :v2]]\n ; Worker 3 in group 1 starts k3, since k1 is done\n [10 3 [:k3 :v0]]\n ; And worker 0 in group 0 starts k4, since k0 is done\n [10 0 [:k4 :v0]]\n ; And worker 5 in group 2 finishes k2\n [10 5 [:k2 :v2]]\n\n ; All keys have now started execution. Group 1 (workers 2 and 3) is\n ; free, but can't start a new key since there are none left pending.\n ; Worker 0 in group 0 can continue k4\n [20 0 [:k4 :v1]]\n ; Workers 2 and 3 in group 1 finish off k3\n [20 3 [:k3 :v1]]\n [20 2 [:k3 :v2]]\n ; Finally, process 1 in group 0 finishes k4\n [20 1 [:k4 :v2]]]\n (->> (independent/concurrent-generator\n 2 ; 2 threads per group\n [:k0 :k1 :k2 :k3 :k4] ; 5 keys\n (fn [k]\n (->> [:v0 :v1 :v2] ; Three values per key\n (map (partial hash-map :type :invoke, :value)))))\n (gen.test/perfect (gen.test/n+nemesis-context 6)) ; 3 groups of 2 threads each\n (map (juxt :time :process :value))))))\n\n(deftest independent-deadlock-case\n (is (= [[0 0 :meow [0 nil]]\n [0 1 :meow [0 nil]]\n [10 1 :meow [1 nil]]\n [10 0 :meow [1 nil]]\n [20 1 :meow [2 nil]]]\n (->> (independent/concurrent-generator\n 2\n (range)\n (fn [k] (gen/each-thread {:f :meow})))\n (gen/limit 5)\n gen/clients\n gen.test/perfect\n (map (juxt :time :process :f :value))))))\n" }, { "path": "jepsen/test/jepsen/independent_test.clj", "content": "(ns jepsen.independent-test\n (:require [clojure.test :refer :all]\n [clojure.pprint :refer [pprint]]\n [clojure.set :as set]\n [jepsen [common-test :refer [quiet-logging]]\n [history :as h]]\n [jepsen.independent :refer :all]\n [jepsen.checker :as checker]\n [jepsen.generator :as gen]\n [jepsen.generator.test :as gen.test]\n [jepsen.history.core :as hc :refer [chunked]]))\n\n(use-fixtures :once quiet-logging)\n\n; Tests for independent generators are in generator-test; might want to pull\n; them over here later.\n\n(deftest subhistories-test\n (let [n 12\n h0 (->> (range n)\n (mapv (fn [i]\n {:type :invoke, :f :foo, :value (tuple (mod i 3) i)})))\n ; We want to explicitly chunk this history\n chunk-size 3\n chunk-count (/ n chunk-size)\n _ (assert integer? chunk-count)\n h (h/history\n (hc/soft-chunked-vector\n chunk-count\n ; Starting indices\n (range 0 n chunk-size)\n ; Loader\n (fn load-nth [i]\n (let [start (* chunk-size i)]\n (subvec h0 start (+ start chunk-size))))))\n shs (subhistories (history-keys h) h)]\n (is (= {0 [0 3 6 9]\n 1 [1 4 7 10]\n 2 [2 5 8 11]}\n (update-vals shs (partial map :value))))))\n\n(deftest checker-test\n (let [even-checker (reify checker/Checker\n (check [this test history opts]\n {:valid? (even? (count history))}))\n history (->> (fn [k] (->> (range k)\n (map (partial array-map :value))))\n (sequential-generator [0 1 2 3])\n (gen/nemesis nil)\n (gen.test/perfect (gen.test/n+nemesis-context 3))\n (concat [{:value :not-sharded}])\n (h/history))]\n (is (= {:valid? false\n :results {1 {:valid? true}\n 2 {:valid? false}\n 3 {:valid? true}}\n :failures [2]}\n (checker/check (checker even-checker)\n {:name \"independent-checker-test\"\n :start-time 0}\n history\n {})))))\n" }, { "path": "jepsen/test/jepsen/lazyfs_test.clj", "content": "(ns jepsen.lazyfs-test\n \"Tests for the lazyfs write-losing filesystem\"\n (:require [clojure [data :refer [diff]]\n [pprint :refer [pprint]]\n [string :as str]\n [test :refer :all]]\n [clojure.java.io :as io]\n [clojure.test.check [clojure-test :refer :all]\n [generators :as g]\n [properties :as prop]\n [results :refer [Result]]]\n [clojure.tools.logging :refer [info warn]]\n [dom-top.core :refer [loopr]]\n [jepsen [checker :as checker]\n [client :as client]\n [common-test :refer [quiet-logging]]\n [control :as c]\n [core :as jepsen]\n [db :as db]\n [generator :as gen]\n [lazyfs :as lazyfs]\n [nemesis :as nem]\n [os :as os]\n [tests :as tests]\n [util :as util :refer [pprint-str\n timeout]]]\n [jepsen.control [core :as cc]\n [util :as cu]\n [sshj :as sshj]]\n [jepsen.os.debian :as debian]\n [clj-commons.slingshot :refer [try+ throw+]]))\n\n; (use-fixtures :once quiet-logging)\n\n(defrecord FileSetClient [dir file node]\n client/Client\n (open! [this test node]\n (assoc this\n :file (str dir \"/set\")\n :node node))\n\n (setup! [this test]\n this)\n\n (invoke! [this test op]\n (-> (c/on-nodes test [node]\n (fn [_ _]\n (case (:f op)\n :add (do (c/exec :echo (str (:value op) \" \") :>> file)\n (assoc op :type :ok))\n :read (let [vals (-> (c/exec :cat file)\n (str/split #\"\\s+\")\n (->> (remove #{\"\"})\n (mapv parse-long)))]\n (assoc op :type :ok, :value vals)))))\n (get node)))\n\n (teardown! [this test])\n\n (close! [this test]))\n\n(defn file-set-client\n \"Writes a set to a single file on one node, in the given directory.\"\n [dir]\n (map->FileSetClient {:dir dir}))\n\n(deftest ^:integration file-set-test\n (let [dir \"/tmp/jepsen/file-set-test\"\n lazyfs (lazyfs/lazyfs dir)\n test (assoc tests/noop-test\n :name \"lazyfs file set\"\n :os debian/os\n :db (lazyfs/db lazyfs)\n :client (file-set-client dir)\n :nemesis (lazyfs/nemesis lazyfs)\n :generator (gen/phases\n (->> (range)\n (map (fn [x] {:f :add, :value x}))\n (gen/delay 1/100)\n (gen/nemesis\n (->> {:type :info\n :f :lose-unfsynced-writes\n :value [\"n1\"]}\n repeat\n (gen/delay 1/2)))\n (gen/time-limit 5))\n (gen/clients {:f :read}))\n :checker (checker/set)\n :nodes [\"n1\"])\n test (jepsen/run! test)]\n ;(pprint (:history test))\n ;(pprint (:results test))\n (is (false? (:valid? (:results test))))\n (is (pos? (:ok-count (:results test))))\n (is (pos? (:lost-count (:results test))))))\n" }, { "path": "jepsen/test/jepsen/nemesis/combined_test.clj", "content": "(ns jepsen.nemesis.combined-test\n (:require [clojure [pprint :refer [pprint]]\n [test :refer :all]]\n [jepsen [common-test :refer [quiet-logging]]\n [core :as jepsen]\n [db :as db]\n [util :as util]\n [generator :as gen]]\n [jepsen.generator [interpreter :as interpreter]\n [interpreter-test :as it]]\n [jepsen.nemesis.combined :refer :all]))\n\n(use-fixtures :once quiet-logging)\n\n(defn first-primary-db\n \"A database whose primary is always \\\"n1\\\"\"\n []\n (reify db/DB\n (setup! [this test node]\n )\n\n (teardown! [this test node]\n )\n\n db/Primary\n (primaries [this test]\n [\"n1\"])))\n\n(deftest partition-package-gen-test\n (let [check-db (fn [db primaries?]\n (let [pkg (partition-package {:faults #{:partition}\n :interval 3/100\n :db db})\n n 10 ; Op count\n gen (gen/nemesis (gen/limit n (:generator pkg)))\n test (assoc it/base-test\n :name \"nemesis.combined partition-package-gen-test\"\n :client (it/ok-client)\n :nemesis (it/info-nemesis)\n :generator gen)\n ; Generate some ops\n h (:history (jepsen/run! test))]\n ; Should be alternating start/stop ops\n (is (= (take (* 2 n)\n (cycle [:start-partition :start-partition\n :stop-partition :stop-partition]))\n (map :f h)))\n ; Ensure we generate valid target values\n (let [targets (cond-> #{:one :minority-third :majority\n :majorities-ring}\n primaries? (conj :primaries))]\n (is (->> (filter (comp #{:stop-partition} :f) h)\n (map :value)\n (every? nil?)))\n (is (->> (filter (comp #{:start-partition} :f) h)\n (map :value)\n (every? targets))))))]\n (testing \"no primaries\"\n (check-db db/noop false))\n\n (testing \"primaries\"\n (check-db (first-primary-db) true))))\n" }, { "path": "jepsen/test/jepsen/nemesis/file_test.clj", "content": "(ns jepsen.nemesis.file-test\n (:require [clj-commons.byte-streams :as bs]\n [clojure [pprint :refer [pprint]]\n [set :as set]\n [string :as str]\n [test :refer :all]]\n [clojure.java [io :as io]\n [shell :as shell]]\n [clojure.test.check [clojure-test :refer [defspec]]\n [generators :as g]\n [properties :as prop]\n [results :as results :refer [Result]]\n [rose-tree :as rose]]\n [clojure.tools.logging :refer [info warn]]\n [com.gfredericks.test.chuck.clojure-test\n :as chuck\n :refer [checking for-all]]\n [dom-top.core :refer [loopr]]\n [jepsen [client :as client]\n [common-test :refer [quiet-logging\n setup-os!]]\n [control :as c]\n [core :as jepsen]\n [generator :as gen]\n [history :as h]\n [os :as os]\n [tests :as tests]\n [util :as util]]\n [jepsen.control.util :as cu]\n [jepsen.nemesis.file :as nf]\n [jepsen.os.debian :as debian]\n [clj-commons.slingshot :refer [try+ throw+]])\n (:import (java.nio ByteBuffer)\n (java.nio.channels FileChannel\n FileChannel$MapMode)\n (java.nio.file Files\n Path\n Paths\n StandardOpenOption)))\n\n(def test-n\n \"Number of trials for generative tests\"\n 100)\n\n;; Fixtures\n\n(defn install-xxd!\n \"Fixture for tests. Installs xxd on each remote node.\"\n [f]\n ; Also suppress logging\n (let [test (assoc tests/noop-test :os debian/os)]\n (jepsen/with-sessions [test test]\n (c/with-all-nodes test\n (debian/install [\"xxd\"])))\n (f)))\n\n(defn sh\n \"Runs shell command, throws on nonzero exit\"\n [& args]\n (let [res (apply shell/sh args)]\n (when (not= 0 (:exit res))\n (throw+ (assoc res\n :cmd args)))\n res))\n\n(def src\n \"Source file.\"\n \"resources/corrupt-file.c\")\n\n(def dir\n \"Temp dir for binaries, data files, etc.\"\n \"/tmp/jepsen/nemesis/file\")\n\n(def bin\n \"Binary file\"\n (str dir \"/corrupt-file\"))\n\n(defn build-local!\n \"Fixture for tests. Compiles the corrupt-file binary locally, stashing it in\n /tmp/jepsen/bin/corrupt-file. Wipes the directory when done.\"\n [f]\n (sh \"mkdir\" \"-p\" dir)\n (sh \"gcc\" src \"-o\" bin \"-lm\" \"-Wall\" \"-Wextra\")\n (f)\n #_(sh \"rm\" \"-rf\" dir))\n\n(use-fixtures :once quiet-logging setup-os! install-xxd! build-local! setup-os!)\n\n;; Tests\n\n(deftest ^:integration truncate-file-test\n (let [f1 \"/tmp/truncate-demo1\" ; For truncation to n bytes\n f2 \"/tmp/truncate-demo2\" ; For -n bytes\n node (first (:nodes tests/noop-test))\n test (assoc tests/noop-test\n :name \"truncate-file-test\"\n :nemesis (nf/corrupt-file-nemesis)\n :generator\n (->> [{:type :info, :f :truncate-file, :value [{:node node, :file f1, :size 5}]}\n {:type :info, :f :truncate-file, :value [{:node node, :file f2, :size -5}]}]\n gen/nemesis))\n ; Create files\n _ (c/on node\n (cu/write-file! \"abcdefg\" f1)\n (cu/write-file! \"abcdefg\" f2))\n ; Run test\n test' (jepsen/run! test)]\n ; Check file sizes\n (c/on node\n (is (= \"abcde\" (c/exec :cat f1)))\n (is (= \"ab\" (c/exec :cat f2))))))\n\n(deftest ^:integration copy-file-chunks-helix-test\n (let [file \"/tmp/corrupt-demo\"\n ; A file is a series of chunks made up of words.\n word-size 3 ; the word \"32 \" denotes word 2 in chunk 3.\n chunk-size (* word-size 4)\n chunk-count 5\n test (assoc tests/noop-test\n :name \"corrupt-file-test\"\n :nemesis (nf/corrupt-file-nemesis)\n :generator\n (->> {:type :info, :f :copy-file-chunks}\n gen/repeat\n (nf/helix-gen\n {:file file\n :chunk-size chunk-size})\n ; We do three passes to make sure it leaves\n ; untouched chunks correct\n (gen/limit 3)\n gen/nemesis))\n ; Start by creating files with predictable bytes\n string (str/join (for [chunk (range chunk-count)\n i (range (/ chunk-size word-size))]\n (str chunk i \" \")))\n nodes (:nodes test)\n n (count nodes)\n _ (c/on-many nodes\n (cu/write-file! string file))\n\n ; To parse these strings back into vectors of chunks...\n parse-word (fn [[chunk word space]]\n (assert (= \\space space))\n [(parse-long (str chunk))\n (parse-long (str word))])\n parse-chunk (fn [chunk]\n (mapv parse-word (partition-all word-size chunk)))\n parse (fn [data]\n (mapv parse-chunk (partition-all chunk-size data)))\n data (parse string)\n\n ; Valid chunks\n valid-chunk? (set data)\n\n ; Run test\n test' (jepsen/run! test)\n h (:history test')\n ]\n (is (= 6 (count h)))\n ; (pprint h)\n ; Check contents of files\n (c/on-many nodes\n (let [string' (c/exec :cat file)\n data' (parse string')]\n ; (info data')\n ; Obviously\n (is (not= data data'))\n ; Same length\n (is (= (count string) (count string')))\n ; But every chunk should be valid\n (is (every? valid-chunk? data))\n ; And the modulos of the bad chunks are all the same\n (->> data'\n ; Extract expected and actual chunk IDs (these will all be the\n ; same because chunks are valid)\n (map-indexed (fn [expected-i chunk]\n [expected-i (first (first chunk))]))\n ; Retain just the modulos of those which differ\n (keep (fn [[expected actual]]\n (when (not= expected actual)\n (mod actual n))))\n set\n count\n (= 1) is)))))\n\n(deftest ^:integration snapshot-file-chunks-helix-test\n (let [file \"/tmp/snapshot-demo\"\n start 1\n end 5\n test (assoc tests/noop-test\n :nodes (take 3 (:nodes tests/noop-test))\n :name \"snapshot-file-test\"\n :nemesis (nf/corrupt-file-nemesis)\n ; We want to change the contents of the file between\n ; nemesis ops\n :client (reify client/Client\n (open! [this test node] this)\n (setup! [this test]\n (c/with-test-nodes test\n (c/su\n (cu/write-file! \"aa\" file))))\n (invoke! [this test op]\n (let [res (c/with-test-nodes test\n (c/su\n (let [before (c/exec :cat file)\n _ (cu/write-file! (:value op) file)\n after (c/exec :cat file)]\n [before after])))]\n (assoc op :type :ok, :value res)))\n (teardown! [this test])\n (close! [this test]))\n :generator\n (->> (gen/flip-flop\n (->> (gen/flip-flop (gen/repeat {:type :info, :f :snapshot-file-chunks})\n (gen/repeat {:type :info, :f :restore-file-chunks}))\n (nf/nodes-gen (comp dec util/majority count :nodes)\n {:file file\n :start start\n :end end})\n gen/nemesis)\n (gen/clients\n [{:f :w, :value \"bbbb\"}\n {:f :w, :value \"ccccccccccc\"}\n {:f :w, :value \"dddddddddd\"}\n {:f :w, :value \"e\"}]))\n (gen/limit 8)\n (gen/concurrency-limit 1)))\n ; Run test\n test' (jepsen/run! test)\n h (:history test')\n ;_ (pprint h)\n ; Extract the nodes we acted on\n affected-nodes (->> (filter (comp #{:nemesis} :process) h)\n (map :value)\n (filter map?)\n (map (comp set keys))\n (reduce set/union))]\n ; Should be just one node\n (is (= 1 (count affected-nodes)))\n\n ; On affected nodes...\n (is (= [; We start with a, snapshot, and write out four bs\n [\"aa\" \"bbbb\"]\n ; Nemesis restores [ a], we write c\n [\"babb\" \"ccccccccccc\"]\n ; Nemesis snapshots c, we write d\n [\"ccccccccccc\" \"dddddddddd\"]\n ; Nemesis restores c, we write e\n [\"dccccddddd\" \"e\"]\n ]\n (->> (h/client-ops h)\n (h/filter h/ok?)\n (h/map (fn [op]\n (get (:value op)\n (first affected-nodes)))))))))\n\n(deftest ^:integration bitflip-file-chunks-helix-test\n (let [file \"/tmp/bitflip-demo\"\n start 4\n end 11\n chunk-size 3\n index 2\n probability 0.5\n test (assoc tests/noop-test\n :nodes (take 3 (:nodes tests/noop-test))\n :name \"bitflip-file-test\"\n :nemesis (nf/corrupt-file-nemesis)\n :generator\n (->> {:type :info, :f :bitflip-file-chunks}\n (nf/nodes-gen\n (comp util/minority count :nodes)\n {:file file\n :start start\n :end end\n :chunk-size chunk-size\n :index index\n :probability probability})\n gen/nemesis\n (gen/limit 1)))\n ; Run test\n data \"ffffffffffffffffffffffff\"\n _ (c/on-many (:nodes test)\n (c/su (cu/write-file! data file)))\n ; Read back as hex\n data (c/on (first (:nodes test))\n (c/su (c/exec :xxd :-p file)))\n test' (jepsen/run! test)\n h (:history test')\n ;_ (pprint h)\n ; Extract the nodes we acted on\n affected-nodes (->> (filter (comp #{:nemesis} :process) h)\n (map :value)\n (filter map?)\n (map (comp set keys))\n (reduce set/union))\n ; Should be just one node\n _ (is (= 1 (count affected-nodes)))\n node (first affected-nodes)\n ; What's the file like there?\n data' (c/on node\n (c/su (c/exec :xxd :-p file)))]\n ; Should be unaffected outside range\n (is (= (subs data 0 (* 2 start)) (subs data' 0 (* 2 start))))\n (is (= (subs data (* 2 end)) (subs data' (* 2 end))))\n ; But modified in the range!\n (is (not= data data'))))\n\n;; Local generative tests\n\n\n(def data-file\n \"Our original data file.\"\n (str dir \"/data\"))\n\n(def data-file'\n \"Our corrupted data file.\"\n (str dir \"/data2\"))\n\n(def data-file''\n \"Sometimes you need three steps, you know?\"\n (str dir \"/data3\"))\n\n(def smol-int\n \"Very small positive integers, like mod and index.\"\n (g/large-integer* {:min 0\n :max 3}))\n\n(def medium-int\n \"Medium-sized positive integers. 1 K at most keeps our tests reasonably\n fast.\"\n (g/large-integer* {:min 0\n :max (* 1024)}))\n\n(def large-int\n \"Large integer generator for file sizes\"\n (g/large-integer* {:min 0\n ; We explicitly want to test over the 4 GB limit\n :max (* 8 1024 1024 1024)}))\n\n(defn maybe-neg\n \"Generator that turns positive numbers into possibly negative ones.\"\n [gen]\n (g/let [x gen\n neg? g/boolean]\n (if neg?\n (- x)\n x)))\n\n(def chunk-opts\n \"Generator for chunk options.\"\n (g/let [i smol-int\n mod smol-int\n chunk-size g/nat\n start medium-int\n end medium-int\n size medium-int]\n {:index i\n :modulus (+ i (inc mod))\n :chunk-size (inc chunk-size)\n :start start\n :end (+ start end)\n ; We provide a file size here too\n :size size}))\n\n(defn prob-gen\n \"Probability generator. Double between 0 and 1. Takes chunk options.\"\n [{:keys [chunk-size start end size]}]\n (g/let [scale (g/double* {:min 0.5, :max 1.5})]\n ; For small files, we want a high probability, otherwise we won't change\n ; anything. For large files, smaller p is fine; we want a few flips per\n ; chunk though.\n (let [bytes (-> (min size end) ; Last byte in file we affect\n (- start) ; Bytes in affected region\n (min chunk-size) ; Or bytes in chunk, whichever is smaller\n (max 0))]\n (if (= 0 bytes)\n ; Doesn't matter\n nil\n (-> bytes\n (* 8) ; Bytes->bits\n / ; Mean probability of one per chunk\n (* 3) ; To be safe\n (* scale) ; Noise\n (min 1.0)))))) ; Probability\n\n(defn corrupt!\n \"Calls corrupt-file with options from the given map.\"\n [opts]\n (apply sh bin\n (map str\n (concat\n (when-let [c (:chunk-size opts)] [\"--chunk-size\" c])\n (when-let [m (:mode opts)] [\"--mode\" m])\n (when-let [i (:index opts)] [\"--index\" i])\n (when-let [m (:modulus opts)] [\"--modulus\" m])\n (when-let [s (:start opts)] [\"--start\" s])\n (when-let [e (:end opts)] [\"--end\" e])\n (when-let [p (:probability opts)] [\"--probability\" p])\n [data-file']))))\n\n(defn make-file!\n \"Creates a data file of size, drawn from device dev. Returns file.\"\n ([dev size]\n (make-file! dev size data-file))\n ([dev size data-file]\n (sh \"rm\" \"-f\" data-file)\n (let [chunk-size (* 1024 1024)\n remainder (rem size chunk-size)\n chunks (long (/ (- size remainder) chunk-size))]\n (assert (= size (+ (* chunks chunk-size) remainder)))\n (sh \"touch\" data-file)\n (when (pos? chunks)\n ; Fill with chunks (for large files)\n (sh \"dd\"\n (str \"if=\" dev)\n (str \"of=\" data-file)\n (str \"bs=\" chunk-size)\n (str \"count=\" chunks)))\n (when (pos? remainder)\n ; Then leftovers\n (sh \"dd\"\n \"conv=notrunc\"\n \"oflag=append\"\n (str \"if=\" dev)\n (str \"of=\" data-file)\n (str \"bs=\" remainder)\n \"count=1\"))\n ; Double-check\n (assert (= size\n (-> data-file\n io/file\n .length))))\n data-file))\n\n(defn make-files!\n \"Like make-file!, but also creates an identical data-file'.\"\n [dev size]\n (let [f (make-file! dev size)]\n (sh \"cp\" f data-file'))\n data-file')\n\n(defn corrupted-chunks\n \"Which chunk indices are affected by the given options? Infinite seq.\"\n [{:keys [index modulus]}]\n (->> (range)\n (filter (fn [i]\n (= index (mod i modulus))))))\n\n(defn intact-chunks\n \"Which chunk indices are unaffected by the given options? Infinite seq.\"\n [{:keys [index modulus]}]\n (if (< modulus 2)\n nil\n (->> (range)\n (remove (fn [i]\n (= index (mod i modulus)))))))\n\n(defn open\n \"Opens a filechannel to the given path, as a string\"\n [file]\n (-> file\n io/file\n .toPath\n (FileChannel/open\n (into-array [StandardOpenOption/READ]))))\n\n(defn buffers\n \"Takes a FileChannel and an options map. Returns a map of:\n\n {:corrupted (ByteBuffer...)\n :intact (ByteBuffer...)\n\n For all the regions of the file which we think should have been corrupted, or\n left intact.\"\n [^FileChannel file, {:keys [start end chunk-size] :as opts}]\n (let [ro FileChannel$MapMode/READ_ONLY\n file-size (.size file)\n start (or start 0)\n end (or end file-size)\n ; Turn an upper bound, a maximum buffer size, and an offset into a\n ; ByteBuf into the file, or nil if out of bounds.\n buffer (fn buffer [upper-bound max-size start]\n (let [end (min (+ start max-size)\n file-size\n upper-bound)\n size (- end start)]\n (when (< 0 size)\n (.map file ro start size))))\n ; The region before/after the chunks might be bigger than we can map,\n ; so we break it up into 16M buffers\n buf-size (* 16 1024 1024)\n ; The intact region before the start\n prefix (->> (range 0 start buf-size)\n (keep (partial buffer start buf-size)))\n ; And at the end\n postfix (->> (range end file-size buf-size)\n (keep (partial buffer file-size buf-size))\n (take-while identity))\n ; Turn a chunk number into a buffer, or nil if out of bounds.\n chunk (fn chunk [i]\n (let [chunk-start (+ start (* i chunk-size))]\n (buffer end chunk-size chunk-start)))\n ; Corrupted chunks\n corrupted (->> (corrupted-chunks opts)\n (map chunk)\n (take-while identity))\n intact (->> (intact-chunks opts)\n (map chunk)\n (take-while identity))\n intact (concat prefix\n intact\n postfix)]\n {:corrupted corrupted\n :intact intact}))\n\n(defn buf-size\n \"Counts bytes in a ByteBuffer.\"\n [^ByteBuffer b]\n (.limit b))\n\n(defn equal-p\n \"Given two sequences of bytebuffers, what is the probability two\n corresponding buffers are equal? We do this probabilistically because\n sometimes a copy or bitflip or whatever will actually leave data intact.\"\n [as bs]\n (if (and (nil? (seq as))\n (nil? (seq bs)))\n ; Trivial case: no chunks in either\n 1\n (loop [count 0\n equal 0\n as as\n bs bs]\n (let [[a & as'] as\n [b & bs'] bs]\n ;(prn :compare a b)\n (cond ; Clean exit\n (and (nil? a) (nil? b))\n (/ equal count)\n\n ; Out of as\n (nil? a) (recur (inc count) equal as' bs')\n\n ; Out of bs\n (nil? b) (recur (inc count) equal as' bs')\n\n true\n (recur (inc count)\n (if (bs/bytes= a b)\n (inc equal)\n equal)\n as'\n bs'))))))\n\n(defn not-equal-p\n \"Given two sequences of bytebuffers, what is the probability the two are not\n equal?\"\n [as bs]\n (- 1 (equal-p as bs)))\n\n(defn bitflip-test-\n \"Helper for bitflip tests.\"\n [opts]\n ;(println \"------\")\n ;(pprint opts)\n\n (make-files! \"/dev/zero\" (:size opts))\n (let [res (corrupt! (assoc opts\n :mode \"bitflip\"))]\n #_(print (:out res)))\n\n ; Check that file sizes are equal\n (is (= (-> data-file io/file .length)\n (-> data-file' io/file .length)))\n\n ; Check chunks\n (with-open [data (open data-file)\n data' (open data-file')]\n (let [{:keys [corrupted intact]} (buffers data opts)\n buffers' (buffers data' opts)\n corrupted' (:corrupted buffers')\n intact' (:intact buffers')]\n (is (= 1 (equal-p intact intact')))\n (when (and (seq corrupted')\n ; We need at least a few bytes to know we probabilistically\n ; flipped something.\n (< 8 (reduce + (map buf-size corrupted'))))\n ; This is fairly weak--with higher p and chunks we should be\n ; able to do better.\n (is (< (equal-p corrupted corrupted') 1))))))\n\n(deftest bitflip-test\n (checking \"basic\" test-n\n [opts chunk-opts\n ; Our prob-gen isn't smart enough to figure out when the mod and\n ; index would end up just picking, say, one byte out of the\n ; file--it can generate far too small probabilties. We hardcode\n ; this to 1/8.\n ;p (prob-gen opts)\n ]\n (bitflip-test- (assoc opts :probability 0.125))))\n\n(deftest ^:slow bitflip-large-test\n ; This stresses our large file dynamics. 8 GB file, trimmed 1 GB from both\n ; ends.\n (let [size (* 1024 1024 1024 8)]\n (bitflip-test- {:modulus 128\n :index 1\n :chunk-size (* 1024 1024 16)\n :start (* 1 1024 1024 1024)\n :end (- size (* 1 1024 1024 1024))\n :size size\n :probability (double (/ 1 1024 1024 8))})))\n\n(defn copy-test-\n \"Helper for copy tests.\"\n [opts]\n ;(println \"------\")\n ;(pprint opts)\n\n (make-files! \"/dev/random\" (:size opts))\n (let [res (corrupt! (assoc opts\n :mode \"copy\"))]\n #_(print (:out res)))\n\n ; Check that file sizes are equal\n (is (= (-> data-file io/file .length)\n (-> data-file' io/file .length)))\n\n ; Check chunks\n (with-open [data (open data-file)\n data' (open data-file')]\n (let [{:keys [corrupted intact]} (buffers data opts)\n buffers' (buffers data' opts)\n corrupted' (:corrupted buffers')\n intact' (:intact buffers')]\n (is (= 1 (equal-p intact intact')))\n (when (and (seq corrupted')\n ; We need somewhere else to copy from\n (seq intact')\n ; And because there's a small chance we (e.g.) copied a single\n ; identical byte from another region, we require a minimum\n ; number of corrupted bytes. This is going to make shrinking\n ; miserable but I don't know a better option--this thing is\n ; fundamentally random and there IS a chance for it to be a\n ; noop and still be \"correct\".\n (< 8 (reduce + (map buf-size corrupted'))))\n\n (is (< (equal-p corrupted corrupted') 1/4))))))\n\n(deftest copy-test\n (checking \"basic\" test-n\n [opts chunk-opts]\n (copy-test- opts)))\n\n(deftest ^:slow copy-slow-test\n ; This stresses large file dynamics. 8GB file, trimmed 1 GB from both ends.\n (let [size (* 1024 1024 1024 8)]\n (copy-test- {:modulus 128\n :index 1\n :chunk-size (* 1024 1024 16)\n :start (* 1 1024 1024 1024)\n :end (- size (* 1 1024 1024 1024))\n :size size})))\n\n(defn snapshot-test-\n \"Helper for snapshot tests.\"\n [opts]\n ;(println \"------\")\n ;(pprint opts)\n\n (make-files! \"/dev/random\" (:size opts))\n (sh bin \"--clear-snapshots\")\n ; Take snapshots of original file\n (let [res (corrupt! (assoc opts :mode \"snapshot\"))]\n #_(print (:out res)))\n ; Now overwrite the fresh file with zeroes\n (make-file! \"/dev/zero\" (:size opts) data-file')\n ; And restore into it\n (let [res (corrupt! (assoc opts :mode \"restore\"))]\n #_(print (:out res)))\n\n ; Check that file sizes are equal\n (is (= (-> data-file io/file .length)\n (-> data-file' io/file .length)))\n\n ; Check chunks\n (with-open [data (open data-file)\n zero (open \"/dev/zero\") ; Can you mmap /dev/zero? We'll find out\n data' (open data-file')]\n (let [buffers (buffers data opts)\n buffers' (buffers data' opts)\n zero (buffers zero opts)]\n ; The \"intact\" regions should be all zeroes\n (is (= 1 (equal-p (:intact zero) (:intact buffers'))))\n ; And if we corrupted something, it should be identical to the\n ; original data\n (when (seq (:corrupted buffers'))\n (is (= 1 (equal-p (:corrupted buffers)\n (:corrupted buffers'))))))))\n\n(deftest ^:focus snapshot-test\n (checking \"basic\" test-n\n [opts chunk-opts]\n (snapshot-test- opts)))\n\n(deftest ^:slow snapshot-slow-test\n ; This stresses large file dynamics. 8GB file, trimmed 1 GB from both ends.\n (let [size (* 1024 1024 1024 8)]\n (snapshot-test- {:modulus 128\n :index 1\n :chunk-size (* 1024 1024 16)\n :start (* 1 1024 1024 1024)\n :end (- size (* 1 1024 1024 1024))\n :size size})))\n" }, { "path": "jepsen/test/jepsen/nemesis/time_test.clj", "content": "(ns jepsen.nemesis.time-test\n (:require [clojure [pprint :refer [pprint]]\n [test :refer :all]]\n [jepsen [core :as jepsen]\n [common-test :refer [quiet-logging]]\n [generator :as gen]\n [tests :as tests]]\n [jepsen.nemesis.time :as nt]))\n\n(use-fixtures :once quiet-logging)\n\n(deftest ^:integration bump-clock-test\n ; This isn't going to work on containers, but I at least want to test that it\n ; uploads and compiles the binary.\n (let [test (assoc tests/noop-test\n :name \"bump-clock-test\"\n :nemesis (nt/clock-nemesis)\n :generator (gen/nemesis\n (gen/limit 1 nt/bump-gen)))\n test' (jepsen/run! test)\n h (:history test')]\n (is (= 2 (count h)))\n ; If you ever run these tests on actual nodes where you CAN change the\n ; clock, you'll want an alternative condition here.\n (is (re-find #\"clock_settime: Operation not permitted\"\n (:err (:data (:exception (h 1))))))))\n" }, { "path": "jepsen/test/jepsen/nemesis_test.clj", "content": "(ns jepsen.nemesis-test\n (:require [clojure [pprint :refer [pprint]]\n [set :as set]\n [test :refer :all]]\n [jepsen [client :as client]\n [common-test :refer [quiet-logging setup-os!]]\n [control :as c]\n [core :as jepsen]\n [generator :as gen]\n [nemesis :refer :all]\n [tests :as tests]\n [util :refer [meh]]]\n [jepsen.control.net :as net]))\n\n(use-fixtures :once setup-os!)\n\n(defn edges\n \"A map of nodes to the set of nodes they can ping\"\n [test]\n (c/on-many (:nodes test)\n (into (sorted-set) (filter net/reachable? (:nodes test)))))\n\n(deftest bisect-test\n (is (= (bisect []) [[] []]))\n (is (= (bisect [1]) [[] [1]]))\n (is (= (bisect [1 2 3 4]) [[1 2] [3 4]]))\n (is (= (bisect [1 2 3 4 5]) [[1 2] [3 4 5]])))\n\n(deftest complete-grudge-test\n (is (= (complete-grudge (bisect [1 2 3 4 5]))\n {1 #{3 4 5}\n 2 #{3 4 5}\n 3 #{1 2}\n 4 #{1 2}\n 5 #{1 2}})))\n\n(deftest bridge-test\n (is (= (bridge [1 2 3 4 5])\n {1 #{4 5}\n 2 #{4 5}\n 4 #{1 2}\n 5 #{1 2}})))\n\n(defn symmetric-grudge?\n \"Is the given grudge map symmetric?\"\n [grudge]\n (every? (fn [[k vs]]\n (every? (fn [v] (contains? (get grudge v) k)) vs))\n grudge))\n\n(deftest majorities-ring-test\n (let [nodes (range 5)\n grudge (majorities-ring nodes)]\n (is (= (count grudge) (count nodes)))\n (is (= (set nodes) (set (keys grudge))))\n (is (every? (partial = 2) (map count (vals grudge))))\n (is (every? (fn [[node snubbed]]\n (not-any? #{node} snubbed))\n grudge))\n (is (distinct? (vals grudge))))\n\n (testing \"five-node-ring\"\n ; With exactly five nodes, we should obtain the degenerate case where every\n ; node can talk to its two nearest neighbors symmetrically. This means we\n ; should be able to traverse the ring in one direction, then go back the\n ; other way.\n (let [nodes (range 5)\n grudge (majorities-ring nodes)\n U (set (keys grudge))\n start (key (first grudge))\n path (loop [from nil\n node start\n return? false\n path []]\n (let [vis (set/difference U (get grudge node))]\n ; Should be exactly 3 connections\n (is (= 3 (count vis)))\n ; Nodes should see themselves\n (is (contains? vis node))\n ; Move on\n (if (and from (= start node))\n (if return?\n (conj path node) ; we're done\n (recur node from true (conj path node))) ; reverse\n ; Move on\n (let [node' (-> vis\n (disj node)\n (disj from)\n first)]\n (recur node\n node'\n return?\n (conj path node))))))]\n (testing \"path covers all nodes\"\n (is (= U (set path))))\n (testing \"path is palindromic\"\n (is (= path (reverse path))))\n (testing \"path is properly sized\"\n (is (= (inc (* 2 (count U))) (count path))))))\n\n (testing \"10 nodes\"\n (let [nodes (range 10)\n grudge (majorities-ring nodes)\n U (set (keys grudge))]\n ; If a -> b, b -> a\n (is (symmetric-grudge? grudge))\n ; Every node has a grudge\n (is (= (set nodes) U))\n ; Every node can see a majority\n (is (every? #(< (count %) 5) (vals grudge)))\n ; But every node bans at least 3 nodes.\n (is (every? #(<= 3 (count %)) (vals grudge))))))\n\n(deftest simple-partition-test)\n ;(let [n (partition-halves)]\n ; (try\n ; (client/setup! n noop-test nil)\n ; (is (= (edges noop-test)\n ; {:n1 #{:n1 :n2 :n3 :n4 :n5}\n ; :n2 #{:n1 :n2 :n3 :n4 :n5}\n ; :n3 #{:n1 :n2 :n3 :n4 :n5}\n ; :n4 #{:n1 :n2 :n3 :n4 :n5}\n ; :n5 #{:n1 :n2 :n3 :n4 :n5}}))\n\n ; (client/invoke! n noop-test {:f :start})\n ; (is (= (edges noop-test)\n ; {:n1 #{:n1 :n2}\n ; :n2 #{:n1 :n2}\n ; :n3 #{:n3 :n4 :n5}\n ; :n4 #{:n3 :n4 :n5}\n ; :n5 #{:n3 :n4 :n5}}))\n\n ; (client/invoke! n noop-test {:f :stop})\n ; (is (= (edges noop-test)\n ; {:n1 #{:n1 :n2 :n3 :n4 :n5}\n ; :n2 #{:n1 :n2 :n3 :n4 :n5}\n ; :n3 #{:n1 :n2 :n3 :n4 :n5}\n ; :n4 #{:n1 :n2 :n3 :n4 :n5}\n ; :n5 #{:n1 :n2 :n3 :n4 :n5}}))\n\n ; (finally\n ; (client/teardown! n noop-test)))))\n\n(defrecord TestNem [id fs setup? teardown?]\n Nemesis\n (setup! [this test]\n (assoc this :setup? true))\n\n (invoke! [this test op]\n (assert (contains? fs (:f op)))\n (assoc op :value this))\n\n (teardown! [this test]\n (reset! teardown? true))\n\n Reflection\n (fs [this]\n fs))\n\n(defn test-nem\n \"Constructs a test nemesis. Takes an ID (anything) and a set of fs.\"\n [id fs]\n (TestNem. id fs false (atom false)))\n\n(deftest compose-test\n (testing \"reflection\"\n (let [a (test-nem :a #{:a})\n b (test-nem :b #{:b})\n c (compose [a b])]\n (is (= #{:a} (fs a)))\n (is (= #{:b} (fs b)))\n ; Composed nemesis should handle both fs\n (is (= #{:a :b} (fs c)))\n (is (every? (comp false? :setup?) (:nemeses c)))\n (is (every? (comp false? deref :teardown?) (:nemeses c)))\n (let [c' (setup! c {})]\n ; Should propagate setup! through to children\n (is (= #{:a :b} (fs c')))\n (is (every? (comp true? :setup?) (:nemeses c')))\n (is (every? (comp false? deref :teardown?) (:nemeses c')))\n\n ; Should evaluate on sub-nemeses\n (let [[a' b'] (:nemeses c')]\n (is (= :a (:id a')))\n (is (= :b (:id b')))\n (is (= a' (:value (invoke! c' {} {:type :info, :f :a}))))\n (is (= b' (:value (invoke! c' {} {:type :info, :f :b})))))\n\n ; Should propagate teardown! through to children\n (teardown! c' {})\n (is (= #{:a :b} (fs c')))\n (is (every? (comp true? :setup?) (:nemeses c')))\n (is (every? (comp true? deref :teardown?) (:nemeses c')))))))\n\n(defn nonzero-file?\n \"Are there non-zero bytes in a file?\"\n [file]\n ; This is kind of a weird hack but we're just going to grep for something\n ; other than all-zeroes in the hexdump.\n (let [data' (c/on \"n1\"\n (c/su\n (c/exec :hd file c/| :head :-n 10)))]\n (boolean (re-find #\"\\s([1-9]0|0[1-9])\\s\" data'))))\n\n(deftest ^:integration bitflip-test\n ; First, create a file on n1 with a bunch of zeroes.\n (let [file \"/tmp/jepsen/zeroes\"]\n (c/on \"n1\"\n (c/su\n (c/exec :mkdir :-p \"/tmp/jepsen\")\n (c/exec :rm :-rf file)\n (c/exec :dd \"if=/dev/zero\" (str \"of=\" file) \"bs=1M\" \"count=1\")))\n (is (not (nonzero-file? file)))\n ; Then run a test with a nemesis that flips some bits.\n (let [test (assoc tests/noop-test\n :name \"bitflip test\"\n :nemesis (bitflip)\n :generator (gen/nemesis\n {:type :info\n :f :bitflip\n :value {\"n1\" {:file file\n :probability 0.01}}}))\n test' (jepsen/run! test)]\n ; We should see those bitflips!\n (is (nonzero-file? file)))))\n" }, { "path": "jepsen/test/jepsen/perf_test.clj", "content": "(ns jepsen.perf-test\n (:refer-clojure :exclude [run!])\n (:use clojure.test)\n (:require [jepsen.os :as os]\n [jepsen.db :as db]\n [jepsen.client :as client]\n [jepsen.generator :as gen]\n [jepsen.checker :as checker]\n [knossos.model :as model]))\n\n(deftest perf-test\n (let [history [{:process 3, :type :invoke, :f :read}\n {:process 4, :type :invoke, :f :cas, :value [3 3]}\n {:process 1, :type :invoke, :f :read}\n {:process 0, :type :invoke, :f :cas, :value [2 1]}\n {:process 2, :type :invoke, :f :read}\n {:value 0, :process 3, :type :ok, :f :read}\n {:value 0, :process 1, :type :ok, :f :read}\n {:process 3, :type :invoke, :f :read}\n {:value 0, :process 2, :type :ok, :f :read}\n {:process 2, :type :invoke, :f :read}\n {:value 0, :process 3, :type :ok, :f :read}\n {:value 0, :process 2, :type :ok, :f :read}\n {:process 3, :type :invoke, :f :read}\n {:value 0, :process 3, :type :ok, :f :read}\n {:process 3, :type :invoke, :f :read}\n {:value 0, :process 3, :type :ok, :f :read}\n {:process 0, :type :fail, :f :cas, :value [2 1]}\n {:process 4, :type :fail, :f :cas, :value [3 3]}\n {:process 3, :type :invoke, :f :cas, :value [1 2]}\n {:process 2, :type :invoke, :f :cas, :value [0 0]}\n {:process 1, :type :invoke, :f :cas, :value [3 2]}\n {:process 4, :type :invoke, :f :read}\n {:process 0, :type :invoke, :f :cas, :value [1 0]}\n {:process 3, :type :fail, :f :cas, :value [1 2]}\n {:process 2, :type :ok, :f :cas, :value [0 0]}\n {:value 0, :process 4, :type :ok, :f :read}\n {:process 1, :type :fail, :f :cas, :value [3 2]}\n {:process 1, :type :invoke, :f :read}\n {:process 2, :type :invoke, :f :cas, :value [1 4]}\n {:process 4, :type :invoke, :f :cas, :value [1 2]}\n {:process 3, :type :invoke, :f :cas, :value [0 1]}\n {:process 0, :type :fail, :f :cas, :value [1 0]}\n {:value 0, :process 1, :type :ok, :f :read}\n {:process 4, :type :fail, :f :cas, :value [1 2]}\n {:process 2, :type :fail, :f :cas, :value [1 4]}\n {:process 0, :type :invoke, :f :cas, :value [1 2]}\n {:process 1, :type :invoke, :f :read}\n {:process 4, :type :invoke, :f :read}\n {:process 3, :type :ok, :f :cas, :value [0 1]}\n {:process 0, :type :ok, :f :cas, :value [1 2]}\n {:value 2, :process 1, :type :ok, :f :read}\n {:value 2, :process 4, :type :ok, :f :read}\n {:process 2, :type :invoke, :f :cas, :value [2 4]}\n {:process 3, :type :invoke, :f :read}\n {:process 0, :type :invoke, :f :read}\n {:process 4, :type :invoke, :f :cas, :value [4 2]}\n {:process 2, :type :ok, :f :cas, :value [2 4]}\n {:value 2, :process 3, :type :ok, :f :read}\n {:process 1, :type :invoke, :f :cas, :value [2 0]}\n {:value 4, :process 0, :type :ok, :f :read}\n {:process 4, :type :ok, :f :cas, :value [4 2]}\n {:process 2, :type :invoke, :f :cas, :value [3 3]}\n {:process 1, :type :ok, :f :cas, :value [2 0]}\n {:process 3, :type :invoke, :f :cas, :value [4 4]}\n {:process 0, :type :invoke, :f :cas, :value [2 1]}\n {:process 1, :type :invoke, :f :read}\n {:process 4, :type :invoke, :f :read}\n {:process 3, :type :fail, :f :cas, :value [4 4]}\n {:process 2, :type :fail, :f :cas, :value [3 3]}\n {:value 0, :process 4, :type :ok, :f :read}\n {:value 0, :process 1, :type :ok, :f :read}\n {:process 3, :type :invoke, :f :cas, :value [2 4]}\n {:process 2, :type :invoke, :f :read}\n {:process 0, :type :fail, :f :cas, :value [2 1]}\n {:process 4, :type :invoke, :f :read}\n {:process 1, :type :invoke, :f :read}\n {:process 3, :type :fail, :f :cas, :value [2 4]}\n {:value 0, :process 2, :type :ok, :f :read}\n {:process 0, :type :invoke, :f :cas, :value [4 1]}\n {:value 0, :process 4, :type :ok, :f :read}\n {:process 3, :type :invoke, :f :cas, :value [3 0]}\n {:process 2, :type :invoke, :f :cas, :value [1 3]}\n {:value 0, :process 1, :type :ok, :f :read}\n {:process 4, :type :invoke, :f :read}\n {:process 0, :type :fail, :f :cas, :value [4 1]}\n {:process 2, :type :fail, :f :cas, :value [1 3]}\n {:process 3, :type :fail, :f :cas, :value [3 0]}\n {:process 0, :type :invoke, :f :cas, :value [0 1]}\n {:process 1, :type :invoke, :f :read}\n {:process 2, :type :invoke, :f :cas, :value [0 4]}\n {:value 0, :process 4, :type :ok, :f :read}\n {:value 1, :process 1, :type :ok, :f :read}\n {:process 4, :type :invoke, :f :read}\n {:process 3, :type :invoke, :f :cas, :value [2 1]}\n {:process 2, :type :fail, :f :cas, :value [0 4]}\n {:value 1, :process 4, :type :ok, :f :read}\n {:process 0, :type :ok, :f :cas, :value [0 1]}\n {:process 1, :type :invoke, :f :cas, :value [3 1]}\n {:process 2, :type :invoke, :f :cas, :value [3 3]}\n {:process 3, :type :fail, :f :cas, :value [2 1]}\n {:process 4, :type :invoke, :f :read}\n {:process 0, :type :invoke, :f :cas, :value [3 1]}\n {:process 1, :type :fail, :f :cas, :value [3 1]}\n {:process 2, :type :fail, :f :cas, :value [3 3]}\n {:value 1, :process 4, :type :ok, :f :read}\n {:process 0, :type :fail, :f :cas, :value [3 1]}\n {:process 2, :type :invoke, :f :read}\n {:process 3, :type :invoke, :f :cas, :value [4 4]}\n {:process 4, :type :invoke, :f :cas, :value [3 1]}\n {:process 1, :type :invoke, :f :read}\n {:process 3, :type :fail, :f :cas, :value [4 4]}\n {:process 0, :type :invoke, :f :read}\n {:process 4, :type :fail, :f :cas, :value [3 1]}\n {:value 1, :process 2, :type :ok, :f :read}\n {:value 1, :process 1, :type :ok, :f :read}\n {:process 3, :type :invoke, :f :read}\n {:value 1, :process 0, :type :ok, :f :read}\n {:process 4, :type :invoke, :f :read}\n {:process 2, :type :invoke, :f :read}\n {:value 1, :process 3, :type :ok, :f :read}\n {:process 0, :type :invoke, :f :read}\n {:process 3, :type :invoke, :f :read}\n {:value 1, :process 2, :type :ok, :f :read}\n {:value 1, :process 4, :type :ok, :f :read}\n {:value 1, :process 0, :type :ok, :f :read}\n {:value 1, :process 3, :type :ok, :f :read}\n {:process 1, :type :invoke, :f :cas, :value [2 2]}\n {:process 2, :type :invoke, :f :cas, :value [4 3]}\n {:process 1, :type :fail, :f :cas, :value [2 2]}\n {:process 2, :type :fail, :f :cas, :value [4 3]}]]\n (time\n (is (:valid? (checker/check (checker/linearizable {:model (model/->CASRegister 0)})\n {}\n history\n {}))))))\n" }, { "path": "jepsen/test/jepsen/print_test.clj", "content": "(ns jepsen.print-test\n (:require [clojure [pprint]\n [test :refer :all]]\n [jepsen [history :as h]\n [print :as p]]))\n\n; We don't want to print out jepsen.history.op everywhere; it's much harder to\n; read\n(deftest op-pprint-test\n (let [op (h/op {:index 0\n :time 1\n :process 2\n :type :ok\n :f :read\n :value \"hi\"})]\n (testing \"Clojure pprint\"\n (is (= \"{:process 2, :type :ok, :f :read, :value \\\"hi\\\", :index 0, :time 1}\\n\"\n (with-out-str (clojure.pprint/pprint op)))))\n\n (testing \"Jepsen Fipp pprint\"\n (is (= \"{:index 0, :time 1, :type :ok, :process 2, :f :read, :value \\\"hi\\\"}\\n\"\n (with-out-str (p/pprint op)))))))\n" }, { "path": "jepsen/test/jepsen/role_test.clj", "content": "(ns jepsen.role-test\n (:refer-clojure :exclude [test])\n (:require [clojure [pprint :refer [pprint]]\n [test :refer :all]]\n [jepsen [client :as client]\n [db :as db]\n [db-test :refer [log-db]]\n [generator :as gen]\n [role :as r]\n [nemesis :as n]]\n [jepsen.generator.test :as gt]\n [jepsen.nemesis.combined :as nc]\n [clj-commons.slingshot :refer [try+ throw+]])\n (:import (java.util.concurrent CyclicBarrier)))\n\n(def test\n \"A basic test map.\"\n {:nodes [\"a\" \"b\" \"c\" \"d\" \"e\"]\n :roles {:coord [\"a\"]\n :txn [\"b\" \"c\"]\n :storage [\"d\" \"e\"]}\n :concurrency 5\n :barrier (CyclicBarrier. 5)})\n\n(defn test=\n \"Special comparator for tests, equal in all but barrier\"\n [a b]\n (and (= (dissoc a :barrier) (dissoc b :barrier))\n (= (.getParties (:barrier a)) (.getParties (:barrier b)))))\n\n(deftest role-test\n (is (= :coord (r/role test \"a\")))\n (is (= :storage (r/role test \"e\")))\n (is (= {:type :jepsen.role/no-role-for-node\n :node \"fred\"\n :roles (:roles test)}\n (try+ (r/role test \"fred\")\n (catch map? e e)))))\n\n(deftest nodes-test\n (is (= [\"a\"] (r/nodes test :coord)))\n (is (= [\"b\" \"c\"] (r/nodes test :txn)))\n (is (= [\"d\" \"e\"] (r/nodes test :storage)))\n (is (= nil (r/nodes test :cat))))\n\n(deftest restrict-test-test\n (let [t (r/restrict-test :txn test)]\n (testing \"nodes\"\n (is (= [\"b\" \"c\"] (:nodes t))))\n (testing \"roles\"\n (is (= (:roles test) (:roles t))))\n (testing \"concurrency\"\n (is (= 5 (:concurrency t))))\n (testing \"barrier\"\n ; When doing DB setup, sub-nodes calling synchronize can't wait for the\n ; full set!\n (is (= 2 (.getParties (:barrier t)))))))\n\n(deftest db-test\n ; DBs are basically all stateful, so we simulate a bunch of stateful calls\n ; and check to see what it proxied to.\n (let [log (atom [])\n db (r/db {:coord (log-db log :coord)\n :txn (log-db log :txn)\n :storage (log-db log :storage)})\n coord-test (r/restrict-test :coord test)\n txn-test (r/restrict-test :txn test)\n storage-test (r/restrict-test :storage test)\n drain-log! (fn drain-log! []\n (let [l @log]\n (reset! log [])\n l))\n ; Special comparator for single log lines, equal in all but barrier\n ll= (fn ll= [a b]\n (and (= 4 (count a) (count b))\n (= (nth a 0) (nth b 0))\n (= (nth a 1) (nth b 1))\n (test= (nth a 2) (nth b 2))\n (= (nth a 3) (nth b 3))))\n ; Special comparator for groups of log lines, equal in all but barrier\n l= (fn l= [as bs]\n (and (= (count as) (count bs))\n (every? true? (map ll= as bs))))]\n\n (testing \"setup\"\n (db/setup! db test \"a\")\n (db/setup! db test \"b\")\n (is (l= [[:coord :setup! coord-test \"a\"]\n [:txn :setup! txn-test \"b\"]]\n (drain-log!))))\n\n (testing \"teardown\"\n (db/teardown! db test \"c\")\n (db/teardown! db test \"d\")\n (is (l= [[:txn :teardown! txn-test \"c\"]\n [:storage :teardown! storage-test \"d\"]]\n (drain-log!))))\n\n (testing \"kill\"\n (db/kill! db test \"e\")\n (db/start! db test \"a\")\n (is (l= [[:storage :kill! storage-test \"e\"]\n [:coord :start! coord-test \"a\"]]\n (drain-log!))))\n\n (testing \"pause\"\n (db/pause! db test \"a\")\n (db/resume! db test \"b\")\n (is (l= [[:coord :pause! coord-test \"a\"]\n [:txn :resume! txn-test \"b\"]]\n (drain-log!))))\n\n (testing \"primaries\"\n (is (= [\"a\" \"b\" \"d\"] (db/primaries db test))))\n\n (testing \"setup-primary!\"\n (db/setup-primary! db test \"a\")\n (is (l= [[:coord :setup-primary! coord-test \"a\"]\n [:storage :setup-primary! storage-test \"d\"]\n [:txn :setup-primary! txn-test \"b\"]]\n (sort (drain-log!)))))\n\n (testing \"log-files\"\n (is (= [:coord] (db/log-files db test \"a\")))\n (is (= [:storage] (db/log-files db test \"e\"))))\n ))\n\n(deftest restrict-client-test\n ; Clients need to remap nodes when calling open!\n (let [c (reify client/Client\n (open! [this test node]\n [:client node]))\n wrapper (r/restrict-client :txn c)]\n (is (= [:client \"b\"] (client/open! wrapper test \"a\")))\n (is (= [:client \"c\"] (client/open! wrapper test \"b\")))\n (is (= [:client \"b\"] (client/open! wrapper test \"c\")))\n (is (= [:client \"c\"] (client/open! wrapper test \"d\")))\n (is (= [:client \"b\"] (client/open! wrapper test \"e\")))\n ))\n\n; A trivial nemesis, just to verify we restrict tests properly.\n(defrecord Nemesis []\n n/Nemesis\n (setup! [this test]\n (assoc this :setup-test test))\n\n (invoke! [this test op]\n [test op])\n\n (teardown! [this test]\n test))\n\n(deftest restrict-nemesis-test\n (let [n (r/restrict-nemesis :storage (Nemesis.))\n rt (r/restrict-test :storage test)]\n (is (test= rt (:setup-test (:nemesis (n/setup! n test)))))\n (let [[test' op'] (n/invoke! n test :foo)]\n (is (test= rt test'))\n (is (= :foo op')))\n (is (test= rt (n/teardown! n test)))))\n\n(deftest restrict-nemesis-package-test\n (let [pkg (nc/partition-package {:faults #{:partition}})\n pkg' (r/restrict-nemesis-package :storage pkg)]\n ; We have tests for the nemesis already; just check the generator lifts\n ; properly\n (testing \"generator\"\n (let [ops (->> (:generator pkg')\n gen/nemesis\n (gen/limit 2)\n gt/perfect*\n (filter (comp #{:info} :type))\n ; values use rand-nth baked into fns in a way we can't\n ; make deterministic; just drop em\n (map #(dissoc % :value)))]\n (is (= [{:time 0,\n :type :info,\n :process :nemesis,\n :f [:storage :start-partition]}\n {:time 15702284397,\n :type :info,\n :process :nemesis,\n :f [:storage :stop-partition]}]\n ops))))))\n" }, { "path": "jepsen/test/jepsen/store/format_test.clj", "content": "(ns jepsen.store.format-test\n (:require [byte-streams :as bs]\n [clojure [pprint :refer [pprint]]\n [test :refer :all]]\n [clojure.core.reducers :as r]\n [clojure.java.io :as io]\n [clojure.tools.logging :refer [info warn]]\n [jepsen.store.format :refer :all]\n [jepsen [history :as h]\n [store :as store]]\n [clj-commons.slingshot :refer [try+ throw+]]))\n\n(def file \"/tmp/jepsen-format-test.jepsen\")\n\n(use-fixtures :each\n (fn wipe-file [t]\n (try (io/delete-file file)\n (catch java.io.IOException _\n ; Likely doesn't exist\n ))\n (t)))\n\n(defmacro is-thrown+\n \"Evals body and asserts that the slingshot pattern is thrown.\"\n [pattern & body]\n `(try+ ~@body\n (is false)\n (catch ~pattern e#\n (is true))))\n\n(deftest header-test\n (with-open [h1 (open file)\n h2 (open file)]\n (testing \"empty file\"\n (is-thrown+ [:type :jepsen.store.format/magic-mismatch\n :expected \"JEPSEN\"\n :actual :eof]\n (check-magic h2))\n\n (is-thrown+ [:type :jepsen.store.format/version-incomplete]\n (check-version! h2)))\n\n ; Write header\n (write-header! h1)\n (flush! h1)\n\n (testing \"with header\"\n (is (= h2 (check-magic h2)))\n (is (= h2 (check-version! h2)))\n (is (= current-version (version h2))))))\n\n(deftest block-index-test\n (with-open [h1 (open file)\n h2 (open file)]\n (testing \"empty file\"\n (is-thrown+ [:type :jepsen.store.format/no-block-index]\n (load-block-index! h1)))\n\n (testing \"trivial index\"\n (write-block-index! h1)\n (load-block-index! h2)\n (is (= {:root nil\n :blocks {(int 1) 18}}\n @(:block-index h2))))))\n\n(deftest read-block-by-id-test\n (with-open [w (open file)]\n (testing \"empty file\"\n (with-open [r (open file)]\n (is-thrown+ [:type :jepsen.store.format/magic-mismatch\n :expected \"JEPSEN\"\n :actual :eof]\n (read-block-by-id r (int 1)))))\n\n (testing \"file with no blocks\"\n (write-block-index! w)\n (with-open [r (open file)]\n (is-thrown+ [:type :jepsen.store.format/block-not-found\n :id (int 4)\n :known-block-ids [1]]\n (read-block-by-id r (int 4)))))))\n\n(deftest fressian-block-test\n (with-open [h1 (open file)\n h2 (open file)]\n (let [data {:foo 2 :bar [\"cat\" #{'mew}]}]\n (testing \"writing\"\n (->> (write-fressian-block! h1 data)\n (set-root! h1)\n write-block-index!))\n\n (testing \"reading\"\n (is (= data (:data (read-root h2))))))))\n\n(deftest partial-map-test\n (let [shallow {:shallow \"waters\"}\n deep {:deep \"lore\"}]\n (testing \"write\"\n (with-open [h (open file)]\n ; Just to push things around a bit\n (write-block-index! h)\n (let [; Write deep block\n deep-id (write-partial-map-block! h deep nil)\n ; Then shallow block pointing to deep\n shallow-id (write-partial-map-block! h shallow deep-id)]\n ; Make it the root\n (set-root! h shallow-id))\n\n ; And finalize\n (write-block-index! h)))\n\n (testing \"read\"\n (with-open [h (open file)]\n (let [m (:data (read-root h))]\n ; Instance checks get awkward with hot code reloading\n (is (= \"jepsen.store.format.PartialMap\" (.getName (class m))))\n (is (= \"waters\" (:shallow m)))\n (is (= \"lore\" (:deep m)))\n (is (= (merge deep shallow) m)))))))\n\n(defn write-big-vector!\n \"Takes a vector and writes it to the file as a big vector. Returns the block\n ID of the written block.\"\n [v]\n (with-open [h (open file)]\n ; Just to mess with offsets\n (write-block-index! h)\n (let [w (big-vector-block-writer! h 5)]\n (reduce append-to-big-vector-block! w v)\n (.close w)\n (:block-id w))))\n\n(defn check-big-vector!\n \"Writes and reads a bigvector, ensuring it's equal.\"\n [v]\n (let [id (write-big-vector! v)]\n (with-open [h (open file)]\n (let [v2 (:data (read-block-by-id h id))]\n (testing \"type\"\n (is (= \"jepsen.history.core.SoftChunkedVector\" (.getName (type v2)))))\n\n (testing \"equality\"\n ;(info :read-bigvec v2)\n ; Count\n (is (= (count v) (count v2)))\n ; Via reduce\n (is (= v (into [] v2)))\n ; Via seq\n (is (= v v2))\n ; Via parallel reducers/fold\n (is (= v (into [] (r/foldcat v2))))\n ; Via nth\n (doseq [i (range (count v))]\n (is (= (nth v i) (nth v2 i)))))\n\n (testing \"hashing\"\n (is (= (hash v) (hash v2))))\n\n (testing \"conj\"\n (is (= (conj v ::x) (conj v2 ::x))))\n\n (testing \"assoc\"\n (when (pos? (count v))\n (is (= (assoc v 0 ::x) (assoc v2 0 ::x)))\n (let [i (dec (count v))]\n (is (= (assoc v i ::x) (assoc v2 i ::x))))))\n\n (testing \"contains?\"\n (is (false? (contains? v2 -1)))\n (when (pos? (count v))\n (is (true? (contains? v2 0)))\n (is (true? (contains? v2 (dec (count v))))))\n (is (false? (contains? v2 (count v)))))\n\n (testing \"rseq\"\n (is (= (rseq v) (rseq v2))))\n\n (testing \"peek\"\n (is (= (peek v) (peek v2))))\n\n (testing \"pop\"\n (when (pos? (count v))\n (is (= (pop v) (pop v2)))))\n\n (testing \"empty\"\n (let [e (empty v2)]\n ; Right now our implementation falls back to regular vectors for\n ; this\n ;(is (= \"jepsen.store.format.BigVector\" (.getName (class e))))\n (is (= 0 (count e)))\n (is (= [] e))))\n\n (testing \"subvec\"\n (when (pos? (count v))\n (let [i (dec (count v))]\n (testing \"after first\"\n (is (= (subvec v 1) (subvec v2 1))))\n (testing \"up to last\"\n (is (= (subvec v 0 i) (subvec v2 0 i))))\n (when (< 1 (count v))\n (testing \"after first, up to last\"\n (is (= (subvec v 1 i) (subvec v2 1 i))))))))\n ))))\n\n(deftest big-vector-test\n (testing \"0\"\n (check-big-vector! []))\n (testing \"1\"\n (check-big-vector! [:x]))\n (testing \"6\"\n (check-big-vector! [:a :b :c :d :e :f]))\n (testing \"128\"\n (check-big-vector! (vec (range 128)))))\n\n(deftest write-test-test\n (let [test {:history [:a :b :c]\n :results {:valid? false\n :more [:oh :no]}\n :name \"hello\"\n :generator [:complex]}]\n (with-open [h (open file)]\n (write-test! h test))\n\n (with-open [h (open file)]\n (let [test' (read-test h)]\n (is (= test test'))))))\n\n;; Test-specific tests\n(let [base-test {:name \"a test\"\n :state :base\n :history nil}\n history-size 12\n history-chunk-size 5\n history (->> (range history-size)\n (mapcat (fn [i]\n [{:type :invoke, :process i}\n {:type :ok, :process i}]))\n h/history)\n run-test (assoc base-test\n :state :run\n :history history)\n results {:valid? false, :vent-cores :frog-blasted}\n final-test (assoc run-test\n :state :final\n :results results)\n read-test #(read-test (open file))]\n (deftest crash-recovery-test\n (let [history-id (promise)]\n (with-open [w (open file)]\n (testing \"empty file\"\n (is-thrown+ [:type :jepsen.store.format/magic-mismatch]\n (read-test)))\n\n (testing \"just header\"\n (write-header! w)\n (is-thrown+ [:type :jepsen.store.format/no-block-index]\n (read-test)))\n\n (testing \"base test\"\n ; First write an empty history block\n (deliver history-id (write-fressian-block! w nil))\n (info :history-id @history-id)\n\n (let [base-test' (assoc base-test :history (block-ref @history-id))\n id (write-fressian-block! w base-test')]\n (is-thrown+ [:type :jepsen.store.format/no-block-index]\n (read-test))\n\n (set-root! w id)\n (write-block-index! w)\n (is (= base-test (read-test)))))\n\n (testing \"history\"\n (let [hw (big-vector-block-writer! w @history-id history-chunk-size)\n ; Intermediate indices in the history where we check the state\n first-cut 1\n second-cut (+ history-chunk-size 1)]\n ; Stream the first op into the history. Test should be unchanged.\n (reduce append-to-big-vector-block! hw (subvec history 0 first-cut))\n (is (= base-test (read-test)))\n\n ; Stream the first block. Test should now have a partial history up\n ; to the first chunk.\n (reduce append-to-big-vector-block! hw\n (subvec history 1 (inc history-chunk-size)))\n (let [t (loop []\n ; Writing is async, so we do a little spinloop here\n (let [t (read-test)]\n (if (seq (:history t))\n t\n (do (Thread/sleep 5)\n (recur)))))]\n (is (= (assoc base-test :history\n (subvec history 0 history-chunk-size))\n t)))\n\n ; Stream the remainder of the history and close the writer; the\n ; test should now have the full history.\n (reduce append-to-big-vector-block! hw (subvec history second-cut))\n (.close hw)\n (let [t (read-test)]\n (is (= (assoc base-test :history history) t))\n (is (= \"jepsen.history.DenseHistory\" (.getName (type (:history t)))))\n (is (= \"jepsen.history.Op\" (.getName (type (first (:history t)))))))))\n\n (testing \"run test\"\n ; Write the run test version--it might have different fields than the\n ; original.\n (let [id (write-fressian-block! w (assoc run-test :history\n (block-ref @history-id)))]\n (set-root! w id)\n (write-block-index! w))\n (is (= run-test (read-test))))\n\n (testing \"analysis\"\n ; Write more results\n (let [more-results-id (write-partial-map-block!\n w (dissoc results :valid?) nil)\n _ (is (= run-test (read-test)))\n\n ; Write main results\n results-id (write-partial-map-block!\n w (select-keys results [:valid?]) more-results-id)\n _ (is (= run-test (read-test)))\n\n ; And new test block\n test-id (write-fressian-block!\n w (assoc final-test\n :history (block-ref @history-id)\n :results (block-ref results-id)))]\n (is (= run-test (read-test)))\n\n ; Save!\n (-> w (set-root! test-id) write-block-index!)\n (is (= final-test (read-test))))))))\n\n (deftest incremental-test-write-test\n ; This checks the write-initial-test, write-results, etc. functions\n (is-thrown+ [:type :jepsen.store.format/magic-mismatch] (read-test))\n\n ; Write initial test\n (with-open [w (open file)]\n (let [base-test' (write-initial-test! w base-test)]\n (is (= base-test (read-test)))\n\n ; Write history\n (with-open [hw (test-history-writer! w base-test')]\n (reduce append-to-big-vector-block! hw history))\n (is (= (assoc base-test :history history) (read-test)))\n\n ; Rewrite test\n (let [run-test' (merge base-test' run-test)\n run-test' (write-test-with-history! w run-test')]\n (is (= run-test (read-test)))\n\n ; Write results\n (let [final-test' (merge run-test' final-test)]\n (is-thrown+ [:type :jepsen.store.format/no-history-id-in-meta]\n (write-test-with-results! w final-test))\n (write-test-with-results! w final-test')\n (is (= final-test (read-test)))\n\n ; Write NEW results on top of old ones\n (let [final-test' (assoc final-test' :results {:valid? :unknown\n :whoopsie :daisy})]\n (write-test-with-results! w final-test')\n (is (= final-test' (read-test)))\n\n ; GC that!\n (let [size1 (.size ^java.nio.channels.FileChannel (:file w))\n _ (close! w)\n _ (gc! file)\n size2 (with-open [r (open file)]\n (.size ^java.nio.channels.FileChannel (:file r)))]\n (is (= final-test' (read-test)))\n (is (= 1602 size1))\n (is (= 639 size2))\n\n ; Now we should be able to open up this test, update its\n ; analysis, and write it back *re-using* the existing history.\n (with-open [r (open file)\n w (open file)]\n (let [test (jepsen.store.format/read-test r)\n test' (assoc test :results {:valid? :rewritten\n :new :findings})]\n (write-test-with-results! w test')\n (is (= test' (read-test)))))))))))))\n" }, { "path": "jepsen/test/jepsen/store_test.clj", "content": "(ns jepsen.store-test\n (:refer-clojure :exclude [load test])\n (:use clojure.test)\n (:require [clojure.data.fressian :as fress]\n [clojure.string :as str]\n [fipp.edn :refer [pprint]]\n [jepsen [common-test :refer [quiet-logging]]\n [core :as core]\n [core-test :as core-test]\n [generator :as gen]\n [history :as history :refer [op]]\n [store :refer :all]\n [tests :refer [noop-test]]]\n [jepsen.store [format :as store.format]\n [fressian :as store.fressian]]\n [multiset.core :as multiset])\n (:import (org.fressian.handlers WriteHandler ReadHandler)))\n\n(use-fixtures :once quiet-logging)\n\n(defrecord Kitten [fuzz mew])\n\n(def base-test (assoc noop-test\n :pure-generators true\n :name \"store-test\"\n :generator (->> [{:f :trivial}]\n gen/clients)\n :record (Kitten. \"fluffy\" \"smol\")\n :multiset (into (multiset/multiset)\n [1 1 2 3 5 8])\n :nil nil\n :boolean false\n :long 1\n :double 1.5\n :rational 5/7\n :bignum 123M\n :string \"foo\"\n :atom [\"blah\"]\n :vec [1 2 3]\n :seq (map inc [1 2 3])\n :cons (cons 1 (cons 2 nil))\n :set #{1 2 3}\n :map {:a 1 :b 2}\n :ops [(op {:time 3, :index 4, :process :nemesis, :f\n :foo, :value [:hi :there]})]\n :sorted-map (sorted-map 1 :x 2 :y)\n :plot {:nemeses\n #{{:name \"pause pd\",\n :color \"#C5A0E9\",\n :start #{:pause-pd},\n :stop #{:resume-pd}}}}))\n\n(defn fr\n \"Fressian roundtrip\"\n [x]\n (let [b (fress/write x :handlers write-handlers)\n ;_ (hexdump/print-dump (.array b))\n x' (with-open [in (fress/to-input-stream b)\n r (store.fressian/reader in)]\n (fress/read-object r))]\n x'))\n\n(deftest fressian-test\n (are [x] (= x (fr x))\n #{1 2 3}\n [#{5 6}\n #{:foo}]))\n\n(deftest fressian-vector-test\n ; Make sure we decode these as vecs, not arraylists.\n (is (vector? (fr [])))\n (is (vector? (fr [1])))\n (is (vector? (fr [:x :y])))\n (is (vector? (:foo (fr {:foo [:x :y]})))))\n\n(deftest ^:integration roundtrip-test\n (let [name (:name base-test)\n _ (delete! name)\n t (-> base-test\n core/run!)\n ; At this juncture we've run the test, and the history should be\n ; written.\n t' (load t)\n _ (is (= (:history t) (:history t')))\n _ (is (instance? jepsen.history.Op (first (:history t))))\n _ (is (instance? jepsen.history.Op (first (:history t'))))\n\n ; Now we're going to rewrite the results, adding a kitten\n [t serialized-t]\n (with-handle [t t]\n (let [t (-> t\n (assoc-in [:results :kitten] (Kitten. \"hi\" \"there\"))\n save-2!)\n serialized-t (dissoc t :db :os :net :client :checker :nemesis\n :generator :model :remote :store)]\n [t serialized-t]))\n ts (tests name)\n [time t'] (first ts)]\n (is (= 1 (count ts)))\n (is (string? time))\n\n (testing \"generic test load\"\n (is (= serialized-t @t')))\n (testing \"test.jepsen\"\n (is (= serialized-t (load-jepsen-file (jepsen-file t)))))\n (testing \"load-results\"\n (is (= (:results t) (load-results name time))))\n (testing \"results.edn\"\n (is (= (:results t) (load-results-edn t))))))\n" }, { "path": "jepsen/test/jepsen/tests/causal_reverse_test.clj", "content": "(ns jepsen.tests.causal-reverse-test\n (:require [jepsen.tests.causal-reverse :refer :all]\n [clojure.test :refer :all]\n [jepsen [checker :as checker]\n [history :as h]]))\n\n(defn invoke [process f value] {:type :invoke, :process process, :f f, :value value})\n(defn ok [process f value] {:type :ok, :process process, :f f, :value value})\n\n(deftest casusal-reverse-test\n (testing \"Can validate sequential histories\"\n (let [c (checker)\n valid (h/history\n [(invoke 0 :write 1)\n (ok 0 :write 1)\n (invoke 0 :write 2)\n (ok 0 :write 2)\n (invoke 0 :read nil)\n (ok 0 :read [1 2])])\n one-without-two (h/history\n [(invoke 0 :write 1)\n (ok 0 :write 1)\n (invoke 0 :write 2)\n (ok 0 :write 2)\n (invoke 0 :read nil)\n (ok 0 :read [1])])\n two-without-one (h/history\n [(invoke 0 :write 1)\n (ok 0 :write 1)\n (invoke 0 :write 2)\n (ok 0 :write 2)\n (invoke 0 :read nil)\n (ok 0 :read [2])])\n bigger (h/history\n [(invoke 0 :write 1)\n (ok 0 :write 1)\n (invoke 0 :write 2)\n (ok 0 :write 2)\n (invoke 0 :write 3)\n (ok 0 :write 3)\n (invoke 0 :write 4)\n (ok 0 :write 4)\n (invoke 0 :write 5)\n (ok 0 :write 5)\n (invoke 0 :read nil)\n (ok 0 :read [1 2 3 4 5])])]\n (is (:valid? (checker/check c nil valid nil)))\n (is (:valid? (checker/check c nil one-without-two nil)))\n (is (not (:valid? (checker/check c nil two-without-one nil))))\n (is (:valid? (checker/check c nil bigger nil)))))\n\n (testing \"Can validate concurrent histories\"\n (let [c (checker)\n concurrent1 (h/history\n [(invoke 0 :write 2)\n (invoke 0 :write 1)\n (ok 0 :write 1)\n (invoke 0 :read nil)\n (ok 0 :write 2)\n (ok 0 :read [1 2])])\n concurrent2 (h/history\n [(invoke 0 :write 1)\n (invoke 0 :write 2)\n (ok 0 :write 1)\n (invoke 0 :read nil)\n (ok 0 :write 2)\n (ok 0 :read [2 1])])]\n (is (:valid? (checker/check (checker) nil concurrent1 nil)))\n (is (:valid? (checker/check (checker) nil concurrent2 nil)))))\n\n ;; TODO Expand the checker to catch this sequential insert violation.\n #_(testing \"Can detect reverse causal anomaly\"\n (let [c (checker)\n reverse-causal-read (h/history [(invoke 0 :write 1)\n (ok 0 :write 1)\n (invoke 0 :write 2)\n (ok 0 :write 2)\n (invoke 0 :read nil)\n (ok 0 :read [2 1])])]\n (is (not (:valid? (checker/check c nil reverse-causal-read nil)))))))\n" }, { "path": "jepsen/test/jepsen/tests/kafka_test.clj", "content": "(ns jepsen.tests.kafka-test\n (:require [clojure [pprint :refer [pprint]]\n [test :refer :all]\n [set :as set]]\n [clojure.tools.logging :refer [info]]\n [dom-top.core :refer [loopr]]\n [jepsen [checker :as checker]\n [common-test :refer [quiet-logging]]\n [generator :as gen]\n [history :as h]\n [store :as store]\n [util :as util]]\n [jepsen.generator [context :as gen.ctx]\n [test :as gen.test]]\n [jepsen.tests.kafka :refer :all]))\n\n(use-fixtures :once quiet-logging)\n\n(defn deindex\n \"Strips :index field off a map, or a collection of maps.\"\n [coll-or-map]\n (if (map? coll-or-map)\n (dissoc coll-or-map :index)\n (map #(dissoc % :index) coll-or-map)))\n\n(defn o\n \"Shorthand op constructor\"\n [index process type f value]\n (h/op {:index index, :time index, :process process, :type type, :f f,\n :value value}))\n\n(deftest op->max-offsets-test\n (is (= {:x 5 :y 3}\n (op->max-offsets {:type :ok,\n :f :txn,\n :value [[:poll {:x [[2 nil] [5 nil] [4 nil]]}]\n [:send :y [2 nil]]\n [:send :y [3 nil]]]}))))\n\n(deftest log->last-index->values-test\n (testing \"empty\"\n (is (= [] (log->last-index->values []))))\n (testing \"standard\"\n (is (= [nil #{:a :b} nil #{:c} #{:d}]\n (log->last-index->values\n [nil #{:a} #{:a :b :c} nil #{:c} #{:c :d} #{:d}])))))\n\n(deftest log->value->first-index-test\n (testing \"empty\"\n (is (= {} (log->value->first-index []))))\n (testing \"standard\"\n (is (= {:a 0, :b 1, :c 1, :d 3}\n (log->value->first-index\n [nil #{:a} #{:a :b :c} nil #{:c} #{:c :d} #{:d}])))))\n\n(deftest version-orders-test\n ; Playing a little fast and loose here: when there's conflicts at an offset\n ; we choose a single value nondeterministically.\n (is (= {:orders {:x {:by-index [:a :c :b :d]\n :by-value {:a 0, :b 2, :c 1, :d 3}\n ; The raw log has a gap at offset 2.\n :log [#{:a} #{:b :c} nil #{:b} #{:d}]}}\n ; The write of c at 1 conflicts with the read of b at 1\n :errors [{:key :x, :index 1, :offset 1, :values #{:b :c}}]}\n (version-orders\n (h/history\n ; Read [a b] at offset 0 and 1\n [{:type :ok, :f :txn, :value [[:poll {:x [[0 :a] [1 :b]]}]]}\n ; But write c at offset 1, b at offset 3, and d at offset 4. Even\n ; though this crashes, we can prove it committed because we read\n ; :b.\n {:type :info, :f :txn, :value [[:send :x [1 :c]]\n [:send :x [3 :b]]\n [:send :x [4 :d]]]}])\n {:ok {:x #{:a :b}}})))\n\n (testing \"a real-world example\"\n (let [h (h/history\n [{:type :invoke, :f :send, :value [[:send 11 641]], :time 280153467070, :process 379}\n {:type :ok, :f :send, :value [[:send 11 [537 641]]], :time 280169754615, :process 379}\n {:type :invoke, :f :send, :value [[:send 11 645]], :time 283654729962, :process 363}\n {:type :ok, :f :send, :value [[:send 11 [537 645]]], :time 287474569112, :process 363}\n ])]\n (is (= [{:key 11\n :index 0\n :offset 537\n :values #{641 645}}]\n (:errors (version-orders h {})))))))\n\n(deftest inconsistent-offsets-test\n (testing \"info conflicts\"\n ; In this example, we have an info send which conflicts with an ok send. We\n ; shouldn't pick this up as a conflict, because we can assume the info\n ; didn't commit.\n (let [send-1 (o 0 0 :invoke :send [[:send :x 1] [:send :y 1]])\n send-1' (o 1 0 :info :send [[:send :x [0 1]] [:send :y 1]])\n ; This send of 2 conflicts at offset 0\n send-2 (o 2 1 :invoke :send [[:send :x 2]])\n send-2' (o 3 1 :ok :send [[:send :x [0 2]]])]\n (is (= nil\n (-> [send-1 send-1' send-2 send-2']\n h/history analysis :errors :inconsistent-offsets)))\n ; But if we introduce a read which observes send-1's send to y, then we\n ; know that either that read was an aborted read, OR that send-1\n ; committed. We assume send-1 committed, and flag this as an\n ; inconsistency.\n (let [poll-1 (o 4 2 :invoke :poll [[:poll]])\n poll-1' (o 5 2 :ok :poll [[:poll {:y [[5 1]]}]])]\n (is (= [{:key :x\n :index 0\n :offset 0\n :values #{1 2}}]\n (-> [send-1 send-1' send-2 send-2' poll-1 poll-1']\n h/history analysis :errors :inconsistent-offsets)))))))\n\n\n\n(deftest g1a-test\n ; If we can observe a failed write, we have a case of G1a.\n (let [send (o 0 0 :invoke :send [[:send :x 2] [:send :y 3]])\n send' (o 1 0 :fail :send [[:send :x 2] [:send :y 3]])\n poll (o 2 1 :invoke :poll [[:poll]])\n poll' (o 3 1 :ok :poll [[:poll {:x [[0 2]]}]])]\n (is (= [{:reader poll'\n :writer send'\n :key :x\n :value 2}]\n (-> [send send' poll poll'] h/history analysis :errors :G1a)))))\n\n(deftest lost-write-test\n (testing \"consistent\"\n ; We submit a at offset 0, b at offset 1, and d at offset 3. A read observes\n ; c at offset 2, which implies we should also have read a and b.\n (let [send-a (o 0 0 :invoke :send [[:send :x :a]])\n send-a' (o 1 0 :ok :send [[:send :x [0 :a]]])\n send-bd (o 2 0 :invoke :send [[:send :x :b] [:send :x :d]])\n send-bd' (o 3 0 :ok :send [[:send :x [1 :b]] [:send :x [3 :d]]])\n send-c (o 4 1 :invoke :send [[:send :x :c]])\n send-c' (o 5 1 :info :send [[:send :x :c]])\n poll (o 6 0 :invoke :poll [[:poll]])\n poll' (o 7 0 :ok :poll [[:poll {:x [[2 :c]]}]])]\n (is (= [{:key :x\n :value :a\n :index 0\n :max-read-index 2\n :writer send-a'\n :max-read poll'}\n {:key :x\n :value :b\n :index 1\n :max-read-index 2\n :writer send-bd'\n :max-read poll'}]\n (-> [send-a send-a' send-bd send-bd' send-c send-c' poll poll']\n h/history analysis :errors :lost-write)))))\n\n (testing \"inconsistent\"\n ; Here, we have inconsistent offsets. a is submitted at offset 0, but gets\n ; overwritten by b at offset 0. c appears at offset 2. We read c, which\n ; means we *also* should have read a and b; however, b's offset could win\n ; when we compute the version order. To compensate, we need more than the\n ; final version order indexes.\n (let [send-a (o 0 0 :invoke :send [[:send :x :a]])\n send-a' (o 1 0 :ok :send [[:send :x [0 :a]]])\n send-bc (o 2 0 :invoke :send [[:send :x :b] [:send :x :c]])\n send-bc' (o 3 0 :ok :send [[:send :x [0 :b]] [:send :x [2 :c]]])\n read-bc (o 4 0 :invoke :poll [[:poll]])\n read-bc' (o 5 0 :ok :poll [[:poll {:x [[0 :b] [2 :c]]}]])]\n (is (= [{:key :x\n :value :a\n :index 0\n :max-read-index 1 ; There is no offset 1\n :writer send-a'\n :max-read read-bc'}]\n (-> [send-a send-a' send-bc send-bc' read-bc read-bc']\n h/history analysis :errors :lost-write)))))\n\n (testing \"atomic\"\n ; When we have a crashed transaction, a read of any of its values should\n ; mean that *all* of its values are eligible for lost-update checking. Note\n ; that this relies on still getting offsets out of :info transactions.\n (let [; This send operation crashes, so we normally wouldn't detect it as\n ; a lost update\n send-ab (o 0 0 :invoke :send [[:send :x :a] [:send :y :b]])\n send-ab' (o 1 0 :info :send [[:send :x :a] [:send :y [0 :b]]])\n send-c (o 2 1 :invoke :send [[:send :y :c]])\n send-c' (o 3 1 :info :send [[:send :y :c]])\n ; However, this poll tells us send-ab must have committed (or else\n ; we'd have aborted read!\n poll-a (o 4 2 :invoke :poll [[:poll]])\n poll-a' (o 5 2 :ok :poll [[:poll {:x [[0 :a]]}]])\n ; And this tells us that we *should* have read b, since we saw c at a\n ; higher offset\n poll-c (o 6 3 :invoke :poll [[:poll]])\n poll-c' (o 7 3 :ok :poll [[:poll {:y [[1 :c]]}]])]\n ; Without the poll of a, we can't prove send-ab completed, and this is\n ; *not* a lost update.\n (is (= nil\n (-> [send-ab send-ab' send-c send-c' poll-c poll-c']\n h/history analysis :errors :lost-write)))\n ; But with the poll of a, it *is* a lost update\n (is (= [{:key :y\n :value :b\n :index 0\n :max-read-index 1\n :writer send-ab'\n :max-read poll-c'}]\n (-> [send-ab send-ab' send-c send-c' poll-a poll-a' poll-c poll-c']\n h/history analysis :errors :lost-write))))))\n\n(deftest poll-skip-test\n ; Process 0 observes offsets 1, 2, then 4, then 7, but we know 3 and 6\n ; existed due to other reads/writes. 5 might actually be a gap in the log.\n (let [poll-1-2 (o 0 0 :invoke :poll [[:poll]])\n poll-1-2' (o 1 0 :ok :poll [[:poll {:x [[1 :a], [2 :b]]}]])\n poll-3 (o 2 1 :invoke :poll [[:poll]])\n poll-3' (o 3 1 :ok :poll [[:poll {:x [[3 :c]]}]])\n poll-4 (o 6 0 :invoke :poll [[:poll]])\n poll-4' (o 7 0 :ok :poll [[:poll {:x [[4 :d]]}]])\n ; Reads and writes that let us know offsets 6 and 7 existed\n write-6 (o 10 2 :invoke :send [[:send :x :f]])\n write-6' (o 11 2 :ok :send [[:send :x [6 :f]]])\n poll-7 (o 12 0 :invoke :poll [[:poll]])\n poll-7' (o 13 0 :ok :poll [[:poll {:x [[7 :g]]}]])\n ; Sends to fill in polls\n write-* (o 14 3 :invoke :send [[:send :x :a]\n [:send :x :b]\n [:send :x :c]\n [:send :x :d]\n [:send :x :g]])\n write-*' (o 15 3 :info :send [[:send :x :a]\n [:send :x :b]\n [:send :x :c]\n [:send :x :d]\n [:send :x :g]])\n errs [{:key :x\n :ops (deindex [poll-1-2' poll-4'])\n :delta 2\n :skipped [:c]}\n {:key :x\n :ops (deindex [poll-4' poll-7'])\n :delta 2\n :skipped [:f]}]\n nm (fn [history]\n (when-let [es (-> history h/history analysis :errors :poll-skip)]\n ; Strip off indices to simplify test cases\n (map (fn [e] (update e :ops deindex)) es)))]\n (is (= errs (nm [poll-1-2 poll-1-2' poll-3 poll-3' poll-4 poll-4' write-6\n write-6' poll-7 poll-7' write-* write-*'])))\n\n ; But if process 0 subscribes/assigns to a set of keys that *doesn't*\n ; include :x, we allow skips.\n (testing \"with intermediate subscribe\"\n (let [sub-xy (o 4 0 :invoke :subscribe [:x :y])\n sub-xy' (o 5 0 :ok :subscribe [:x :y])\n assign-xy (o 8 0 :invoke :assign [:x :y])\n assign-xy' (o 9 0 :ok :assign [:x :y])\n sub-y (o 4 0 :invoke :subscribe [:y])\n sub-y' (o 5 0 :ok :subscribe [:y])\n assign-y (o 8 0 :invoke :assign [:y])\n assign-y' (o 9 0 :info :assign [:y])]\n (is (nil? (nm [poll-1-2 poll-1-2' poll-3 poll-3' sub-y sub-y' poll-4\n poll-4' assign-y assign-y' write-6 write-6' poll-7\n poll-7' write-* write-*'])))\n ; But subscribes that still cover x, we preserve state\n (is (= errs (nm [poll-1-2 poll-1-2' poll-3 poll-3' sub-xy sub-xy'\n poll-4 poll-4' assign-xy assign-xy' write-6 write-6'\n poll-7 poll-7' write-* write-*']))))))\n\n (testing \"txn abort\"\n ; Aborted transactions, both info and fail, should a.) pick up where the\n ; previous txn left off, and b.) reset the offset to the beginning\n (testing \"good\"\n (let [h (h/history\n [; Send a simple series of ints\n (o 0 0 :invoke :send [[:send :x 0]\n [:send :x 1]\n [:send :x 2]])\n (o 1 0 :ok :send [[:send :x [0 0]]\n [:send :x [1 1]]\n [:send :x [2 2]]])\n\n ; Poll 0\n (o 1 1 :invoke :txn [[:poll]])\n (o 2 1 :ok :txn [[:poll {:x [[0 0]]}]])\n\n ; Poll 1, 2, abort. This is correct.\n (o 3 1 :invoke :txn [[:poll]])\n (o 4 1 :fail :txn [[:poll {:x [[1 1] [2 2]]}]])\n\n ; Poll 1, 2, info. This is correct; we should have rewound.\n (o 5 1 :invoke :txn [[:poll]])\n (o 6 1 :info :txn [[:poll {:x [[1 1] [2 2]]}]])\n\n ; Poll 1, 2, ok. This is correct; we should have rewound.\n (o 7 1 :invoke :txn [[:poll]])\n (o 8 1 :ok :txn [[:poll {:x [[1 1] [2 2]]}]])])\n a (analysis h)]\n (is (empty? (:errors a)))))\n\n (testing \"abort doesn't roll back\"\n (let [h (h/history\n [; Send a simple series of ints\n (o 0 0 :invoke :send [[:send :x 0]\n [:send :x 1]\n [:send :x 2]\n [:send :x 3]\n [:send :x 4]\n [:send :x 5]])\n (o 1 0 :ok :send [[:send :x [0 0]]\n [:send :x [1 1]]\n [:send :x [2 2]]\n [:send :x [3 3]]\n [:send :x [4 4]]\n [:send :x [5 5]]])\n\n ; Poll 0\n (o 1 1 :invoke :txn [[:poll]])\n (o 2 1 :ok :txn [[:poll {:x [[0 0]]}]])\n\n ; Poll 1, 2, abort. This is fine\n (o 3 1 :invoke :txn [[:poll]])\n (o 4 1 :fail :txn [[:poll {:x [[1 1] [2 2]]}]])\n\n ; Poll 3 4 and fail. Even though it failed, this is bad; we\n ; should have rewound.\n (o 5 1 :invoke :txn [[:poll]])\n (o 6 1 :fail :txn [[:poll {:x [[3 3] [4 4]]}]])\n\n ; Poll 5 OK. This is also bad, we should still be back at 1 2\n (o 7 1 :invoke :txn [[:poll]])\n (o 8 1 :ok :txn [[:poll {:x [[5 5]]}]])])\n a (analysis h)]\n ; This is a poll skip!\n (is (= [; When we polled 3, 4, we should have seen 1.\n {:key :x\n :delta 3\n :skipped [1 2]\n :ops [(h 3) (h 7)]}\n ; Ditto, when we polled 5, we should have seen 1.\n {:key :x\n :delta 5\n :skipped [1 2 3 4]\n :ops [(h 3) (h 9)]}]\n (:poll-skip (:errors a))))))\n\n (testing \"info can be a poll-skip\"\n (let [h (h/history\n [; Send a simple series of ints\n (o 0 0 :invoke :send [[:send :x 0]\n [:send :x 1]\n [:send :x 2]\n [:send :x 3]\n [:send :x 4]\n [:send :x 5]])\n (o 1 0 :ok :send [[:send :x [0 0]]\n [:send :x [1 1]]\n [:send :x [2 2]]\n [:send :x [3 3]]\n [:send :x [4 4]]\n [:send :x [5 5]]])\n\n ; Poll 0\n (o 1 1 :invoke :txn [[:poll]])\n (o 2 1 :ok :txn [[:poll {:x [[0 0]]}]])\n\n ; Poll 1, 2, abort. This is fine\n (o 3 1 :invoke :txn [[:poll]])\n (o 4 1 :fail :txn [[:poll {:x [[1 1] [2 2]]}]])\n\n ; Poll 3 4 and crash. Even though it crashed, this is bad; we\n ; should have rewound.\n (o 5 1 :invoke :txn [[:poll]])\n (o 6 1 :info :txn [[:poll {:x [[3 3] [4 4]]}]])])\n a (analysis h)]\n ; This is a poll skip!\n (is (= [; When we polled 3, 4, we should have seen 1.\n {:key :x\n :delta 3\n :skipped [1 2]\n :ops [(h 3) (h 7)]}]\n (:poll-skip (:errors a))))))\n ))\n\n(deftest nonmonotonic-poll-test\n ; A nonmonotonic poll occurs when a single process performs two transactions,\n ; t1 and t2, both of which poll key k, and t2 begins with a value from k\n ; *prior* to t1's final value.\n ;\n ; Here process 0 polls 1 2 3, then goes back and reads 2 ... again.\n (let [send* (o 0 0 :invoke :send [[:send :x :a]\n [:send :x :b]\n [:send :x :c]\n [:send :x :d]])\n send*' (o 1 0 :ok :send [[:send :x :a]\n [:send :x :b]\n [:send :x :c]\n [:send :x :d]])\n poll-123 (o 2 0 :invoke :poll [[:poll]])\n poll-123' (o 3 0 :ok :poll [[:poll {:x [[1 :a], [2 :b], [3 :c]]}]])\n poll-234 (o 6 0 :invoke :poll [[:poll]])\n poll-234' (o 7 0 :ok :poll [[:poll {:x [[2 :b], [3 :c], [4 :d]]}]])\n nm (fn [history]\n (when-let [es (-> history h/history analysis :errors\n :nonmonotonic-poll)]\n ; Strip off indices to simplify test cases\n (map (fn [e] (update e :ops deindex)) es)))\n errs [{:key :x\n :ops (deindex [poll-123' poll-234'])\n :values [:c :b]\n :delta -1}]]\n (testing \"together\"\n (is (= errs (nm [send* send*' poll-123 poll-123' poll-234 poll-234']))))\n\n ; But if process 0 subscribes/assigns to a set of keys that *doesn't*\n ; include :x, we allow nonmonotonicity.\n (testing \"with intermediate subscribe\"\n (let [sub-xy (o 4 0 :invoke :subscribe [:x :y])\n sub-xy' (o 5 0 :ok :subscribe [:x :y])\n assign-xy (o 4 0 :invoke :assign [:x :y])\n assign-xy' (o 5 0 :ok :assign [:x :y])\n sub-y (o 4 0 :invoke :subscribe [:y])\n sub-y' (o 5 0 :ok :subscribe [:y])\n assign-y (o 4 0 :invoke :assign [:y])\n assign-y' (o 5 0 :ok :assign [:y])]\n (is (nil? (nm [send* send*' poll-123 poll-123' sub-y sub-y' poll-234\n poll-234'])))\n (is (nil? (nm [send* send*' poll-123 poll-123' assign-y assign-y'\n poll-234 poll-234'])))\n ; But subscribes that still cover x, we preserve state\n (is (= errs (nm [send* send*' poll-123 poll-123' sub-xy sub-xy'\n poll-234 poll-234'])))\n (is (= errs (nm [send* send*' poll-123 poll-123' assign-xy assign-xy'\n poll-234 poll-234'])))))))\n\n(deftest nonmonotonic-send-test\n ; A nonmonotonic send occurs when a single process performs two transactions\n ; t1 and t2, both of which send to key k, and t1's first send winds up\n ; ordered at or before t2's last send in the log.\n ;\n ; Here process 0 sends offsets 3, 4, then sends 1, 2\n (let [send-34 (o 0 0 :invoke :send [[:send :x :c] [:send :x :d]])\n send-34' (o 1 0 :ok :send [[:send :x [3 :c]] [:send :x [4 :d]]])\n send-12 (o 10 0 :invoke :send [[:send :x 1] [:send :x 2]])\n send-12' (o 11 0 :ok :send [[:send :x [1 :a]] [:send :x [2 :b]]])\n errs [{:key :x\n :values [:d :a]\n :delta -3\n :ops (deindex [send-34' send-12'])}]\n nm (fn [history]\n (when-let [es (-> history h/history analysis :errors\n :nonmonotonic-send)]\n ; Strip off indices to simplify test cases\n (map (fn [e] (update e :ops deindex)) es)))]\n (is (= errs (nm [send-34 send-34' send-12 send-12'])))\n\n ; But if process 0 subscribes/assigns to a set of keys that *doesn't*\n ; include :x, we allow nonmonotonicity.\n (testing \"with intermediate subscribe\"\n (let [sub-xy (o 2 0 :invoke :subscribe [:x :y])\n sub-xy' (o 3 0 :ok :subscribe [:x :y])\n assign-xy (o 2 0 :invoke :assign [:x :y])\n assign-xy' (o 3 0 :ok :assign [:x :y])\n sub-y (o 2 0 :invoke :subscribe [:y])\n sub-y' (o 3 0 :ok :subscribe [:y])\n assign-y (o 2 0 :invoke :assign [:y])\n assign-y' (o 3 0 :info :assign [:y])]\n (is (nil? (nm [send-34 send-34' sub-y sub-y' send-12 send-12'])))\n (is (nil? (nm [send-34 send-34' assign-y assign-y' send-12 send-12'])))\n ; But subscribes that still cover x, we preserve state\n (is (= errs (nm [send-34 send-34' sub-xy sub-xy' send-12 send-12'])))\n (is (= errs (nm [send-34 send-34' assign-xy assign-xy' send-12 send-12'])))))))\n\n(deftest int-poll-skip-test\n ; An *internal poll skip* occurs when within the scope of a single\n ; transaction successive calls to poll() (or a single poll()) skip over a\n ; message we know exists.\n ;\n ; One op observes offsets 1 and 4, but another observes offset 2, which tells\n ; us a gap exists.\n (let [; Sends so we can poll\n send* (o 0 1 :invoke :send [[:send :x :a]\n [:send :x :b]\n [:send :x :d]])\n send*' (o 1 1 :info :send [[:send :x :a]\n [:send :x :b]\n [:send :x :d]])\n ; Skip within a poll\n poll-1-4a (o 2 0 :invoke :poll [[:poll]])\n poll-1-4a' (o 3 0 :ok :poll [[:poll {:x [[1 :a], [4 :d]]}]])\n ; Skip between polls\n poll-1-4b (o 4 0 :invoke :poll [[:poll] [:poll]])\n poll-1-4b' (o 5 0 :ok :poll [[:poll {:x [[1 :a]]}]\n [:poll {:x [[4 :d]]}]])\n poll-2 (o 6 0 :invoke :poll [[:poll]])\n poll-2' (o 7 0 :ok :poll [[:poll {:x [[2 :b]]}]])]\n (is (= [{:key :x\n :values [:a :d]\n :skipped [:b]\n :delta 2\n :op poll-1-4a'}\n {:key :x\n :values [:a :d]\n :skipped [:b]\n :delta 2\n :op poll-1-4b'}]\n (-> [send* send*' poll-1-4a poll-1-4a' poll-1-4b poll-1-4b' poll-2\n poll-2']\n h/history\n analysis\n :errors\n :int-poll-skip)))))\n\n(deftest int-send-skip-test\n ; An *internal send skip* occurs when within the scope of a single\n ; transaction successive calls to send() wind up inserting to offsets which\n ; have other offsets between them.\n ;\n ; Here a single op inserts mixed in with another. We know a's offset, but we\n ; don't know c's. A poll, however, tells us there exists a b between them,\n ; and that c's offset is 3.\n (let [send-13 (o 0 0 :invoke :send [[:send :x :a] [:send :x :c]])\n send-13' (o 1 0 :ok :send [[:send :x [1 :a]] [:send :x :c]])\n send-b (o 2 1 :invoke :send [[:send :x :b]])\n send-b' (o 3 1 :info :send [[:send :x :b]])\n poll-23 (o 4 2 :invoke :poll [[:poll]])\n poll-23' (o 5 2 :ok :poll [[:poll {:x [[2 :b] [3 :c]]}]])]\n (is (= [{:key :x\n :values [:a :c]\n :skipped [:b]\n :delta 2\n :op send-13'}]\n (-> [send-13 send-13' send-b send-b' poll-23 poll-23']\n h/history\n analysis\n :errors\n :int-send-skip)))))\n\n(deftest int-nonmonotonic-poll-test\n ; An *internal nonmonotonic poll* occurs within the scope of a single\n ; transaction, where one or more poll() calls yield a pair of values such\n ; that the former has an equal or higher offset than the latter.\n (let [send* (o 0 0 :invoke :send [[:send :x :a]\n [:send :x :b]\n [:send :x :c]])\n send*' (o 1 0 :info :send [[:send :x :a]\n [:send :x :b]\n [:send :x :c]])\n poll-31a (o 2 0 :invoke :poll [[:poll]])\n poll-31a' (o 3 0 :ok :poll [[:poll {:x [[3 :c] [1 :a]]}]])\n ; This read of :b tells us there was an index between :a and :c; the\n ; delta is therefore -2.\n poll-33b (o 4 0 :invoke :poll [[:poll]])\n poll-33b' (o 5 0 :ok :poll [[:poll {:x [[2 :b] [3 :c]]}]\n [:poll {:x [[3 :c]]}]])]\n (is (= [{:key :x\n :values [:c :a]\n :delta -2\n :op poll-31a'}\n {:key :x\n :values [:c :c]\n :delta 0\n :op poll-33b'}]\n (-> [send* send*' poll-31a poll-31a' poll-33b poll-33b']\n h/history\n analysis :errors :int-nonmonotonic-poll)))))\n\n(deftest int-nonmonotonic-send-test\n ; An *internal nonmonotonic send* occurs within the scope of a single\n ; transaction, where two calls to send() insert values in an order which\n ; contradicts the version order.\n (let [; In this case, the offsets are directly out of order.\n send-31a (o 0 0 :invoke :send [[:send :x 3] [:send :x 1]])\n send-31a' (o 1 0 :ok :send [[:send :x [3 :c]] [:send :x [1 :a]]])\n ; Or we can infer the order contradiction from poll offsets\n send-42b (o 2 0 :invoke :send [[:send :y :d] [:send :y :b]])\n send-42b' (o 3 0 :info :send [[:send :y :d] [:send :y :b]])\n ; c has to come from somewhere, too\n send-3c (o 4 1 :invoke :send [[:send :y :c]])\n send-3c' (o 5 1 :info :send [[:send :y :c]])\n ; This poll tells us b < d on y\n poll-42b (o 6 0 :invoke :poll [[:poll]])\n poll-42b' (o 7 0 :ok :poll [[:poll {:y [[2 :b] [3 :c] [4 :d]]}]])]\n (is (= [{:key :x\n :values [:c :a]\n :delta -1\n :op send-31a'}\n {:key :y\n :values [:d :b]\n :delta -2\n :op send-42b'}]\n (-> [send-31a send-31a' send-42b send-42b' send-3c send-3c'\n poll-42b poll-42b']\n h/history\n analysis :errors :int-nonmonotonic-send)))))\n\n(deftest duplicate-test\n (testing \"basic\"\n ; A duplicate here means that a single value winds up at multiple positions\n ; in the log--reading the same log offset multiple times is a nonmonotonic\n ; poll.\n (let [; Here we have a send operation which puts a to 1, and a poll which\n ; reads a at 3; it must have been at both.\n send-a1 (o 0 0 :invoke :send [[:send :x :a]])\n send-a1' (o 1 0 :ok :send [[:send :x [1 :a]]])\n send-b2 (o 2 1 :invoke :send [[:send :x :b]])\n send-b2' (o 3 1 :info :send [[:send :x :b]])\n poll-a3 (o 4 2 :invoke :poll [[:poll]])\n poll-a3' (o 5 2 :ok :poll [[:poll {:x [[2 :b] [3 :a]]}]])]\n (is (= [{:key :x\n :value :a\n :count 2\n :offsets [1 3]}]\n (-> [send-a1 send-a1' send-b2 send-b2' poll-a3 poll-a3'] h/history analysis :errors :duplicate)))))\n\n (testing \"hash-insensitive\"\n ; Version orders are lossy: they destroy information when presented with\n ; inconsistent offsets. This can be a little confusing: sometimes you'll\n ; detect an inconsistent offset as a duplicate, other times not, depending\n ; on the hash. To test this, we spam a whole bunch of values at the same\n ; two offsets and verify they're all flagged as dups.\n (let [n 10\n values (into (sorted-set) (range n))\n h (loopr\n [index 0\n ops []]\n [value values]\n (recur\n (+ index 4)\n (conj ops\n ; Send value at offset 0, poll it at 1\n (o (+ index 0) 0 :invoke :send [[:send :x value]])\n (o (+ index 1) 0 :ok :send [[:send :x [0 value]]])\n (o (+ index 2) 1 :invoke :poll [[:poll]])\n (o (+ index 3) 1 :ok :poll\n [[:poll {:x [[1 value]]}]])))\n (h/history ops))\n a (analysis h)]\n (testing \"duplicates\"\n (is (= values\n (->> (:duplicate (:errors a))\n (map :value)\n (into (sorted-set))))))\n ; While we're here...\n (testing \"inconsistent offsets\"\n (is (= [{:key :x, :offset 0, :index 0, :values values}\n {:key :x, :offset 1, :index 1, :values values}]\n (:inconsistent-offsets (:errors a)))))))\n\n (testing \"aborted txns\"\n ; Transactions which abort can contain polls with duplicate information.\n ; Because the poller is supposed to never return bad information\n ; *regardless* of what's happening in the transaction, we want to detect\n ; these.\n (let [h (h/history\n ; We send 0 to offset 1\n [(o 0 0 :invoke :send [[:send :x 0]])\n (o 1 0 :ok :send [[:send :x [1 0]]])\n ; And fail to send 1 to offset 2 (but we get an offset for it!)\n (o 2 0 :invoke :send [[:send :x 1]])\n (o 3 0 :fail :send [[:send :x [2 1]]])\n ; Now we have an aborted poll that sees both of these at higher\n ; offsets. We want a duplicate for value 0, but not 1, because\n ; 1's *writes* never happened. GOD the Kafka transaction model\n ; is complicated.\n (o 4 1 :invoke :poll [[:poll]])\n (o 5 1 :fail :poll [[:poll {:x [[11 0] [12 1]]}]])])\n a (analysis h)]\n (is (= [{:key :x, :value 0, :count 2, :offsets [1 11]}]\n (:duplicate (:errors a))))))\n )\n\n(deftest realtime-lag-test\n (testing \"up to date\"\n (let [o (fn [time process type f value]\n {:time time, :process process, :type type, :f f, :value value})\n l (fn [time process k lag]\n {:time time, :process process, :key k, :lag lag})\n\n history\n (h/history\n [(o 0 0 :invoke :assign [:x])\n (o 1 0 :ok :assign [:x])\n ; This initial poll should observe nothing\n (o 2 0 :invoke :poll [[:poll]])\n (o 3 0 :ok :poll [[:poll {:x []}]])\n (o 4 0 :invoke :send [[:send :x :a]])\n (o 5 0 :ok :send [[:send :x [0 :a]]])\n ; This read started 1 second after x was acked, and failed to\n ; see it; lag must be at least 1.\n (o 6 0 :invoke :poll [[:poll]])\n (o 7 0 :ok :poll [[:poll {:x []}]])\n (o 8 1 :invoke :send [[:send :x :c] [:send :x :d]])\n (o 9 1 :ok :send [[:send :x [2 :c]] [:send :x [3 :d]]])\n ; Now we know offsets 1 (empty), 2 (c), and 3 (d) are\n ; present. If we read x=empty again, it must still be from\n ; time 5; the lag is therefor 5.\n (o 10 0 :invoke :poll [[:poll]])\n (o 11 0 :ok :poll [[:poll]])\n ; Let's read up to [1 :b], which hasn't completed yet, but\n ; which we know was no longer the most recent value as soon\n ; as [2 c] was written, at time 9. Now our lag is 12-9=3.\n (o 12 0 :invoke :poll [[:poll]])\n (o 13 0 :ok :poll [[:poll {:x [[0 :a] [1 :b]]}]])\n ; If we re-assign process 0 to x, and read nothing, our most\n ; recent read is still of [1 b]; our lag on x is now 16-9=7.\n ; Our lag on y is 0, since nothing was written to y.\n (o 14 0 :invoke :assign [:x :y])\n (o 15 0 :ok :assign [:x :y])\n (o 16 0 :invoke :poll [[:poll]])\n (o 17 0 :ok :poll [[:poll {}]])\n ; Now let's assign 0 to y, then x, which clears our offset of\n ; x. If we poll nothing, then we're rewound back to time 5.\n ; Our lag is therefore 22 - 5 = 17.\n (o 18 0 :invoke :assign [:y])\n (o 19 0 :ok :assign [:y])\n (o 20 0 :invoke :assign [:x])\n (o 21 0 :ok :assign [:x])\n (o 22 0 :invoke :poll [[:poll]])\n (o 23 0 :ok :poll [[:poll {}]])\n ; Now let's catch up to the most recent x: [3 d]. Our lag is\n ; 0.\n (o 24 0 :invoke :poll [[:poll] [:poll]])\n (o 25 0 :ok :poll [[:poll {:x [[0 :a] [1 :b]]}]\n [:poll {:x [[2 :c] [3 :d]]}]])\n ; And write x b, which gets reordered to offset 1.\n (o 26 1 :invoke :send [[:send :x :b]])\n (o 27 1 :info :send [[:send :x :b]])\n ])]\n (testing realtime-lag\n (is (= [(l 2 0 :x 0)\n (l 6 0 :x 1)\n (l 10 0 :x 5)\n (l 12 0 :x 3)\n (l 16 0 :x 7) (l 16 0 :y 0)\n (l 22 0 :x 17)\n (l 24 0 :x 0)]\n (realtime-lag history))))\n (testing \"worst realtime lag\"\n (is (= {:time 22, :process 0, :key :x, :lag 17}\n (:worst-realtime-lag (analysis history))))))))\n\n(deftest empty-history-test\n (let [history (h/history [(o 0 0 :invoke :assign [:x])\n (o 1 0 :ok :assign [:x])])\n c (checker)\n check (checker/check c\n {:name \"empty-history-test\"\n :start-time 0\n :history history}\n history\n nil)]\n (is (not (:valid? check)))))\n\n(deftest unseen-test\n (is (= [{:time 1, :unseen {}}\n {:time 3, :unseen {:x 2}}\n {:time 5, :unseen {:x 1}}\n {:time 7, :unseen {:x 0}, :messages {:x #{}}}]\n (-> [(o 0 0 :invoke :poll [[:poll]])\n (o 1 0 :ok :poll [[:poll {}]])\n (o 2 0 :invoke :send [[:send :x :a] [:send :x :b]])\n (o 3 0 :ok :send [[:send :x [0 :a]] [:send :x [1 :b]]])\n (o 4 0 :invoke :poll [[:poll]])\n (o 5 0 :ok :poll [[:poll {:x [[0 :a]]}]])\n (o 6 0 :invoke :poll [[:poll]])\n (o 7 0 :ok :poll [[:poll {:x [[1 :b]]}]])\n ]\n h/history\n analysis\n :unseen))))\n\n(deftest g0-test\n ; Here, two transactions write an object to two different keys, and obtain\n ; conflicting orders: a write cycle.\n (let [wa (o 0 0 :invoke :send [[:send :x :a] [:send :y :a]])\n wb (o 1 1 :invoke :send [[:send :x :b] [:send :y :b]])\n wa' (o 2 0 :ok :send [[:send :x [0 :a]] [:send :y [1 :a]]])\n wb' (o 3 1 :ok :send [[:send :x [1 :b]] [:send :y [0 :b]]])]\n (is (= [{:type :G0\n :cycle [wb' wa' wb']\n :steps [{:type :ww, :key :y, :value :b, :value' :a\n :a-mop-index 1, :b-mop-index 1}\n {:type :ww, :key :x, :value :a, :value' :b,\n :a-mop-index 0, :b-mop-index 0}]}]\n (-> [wa wb wa' wb'] h/history\n (analysis {:ww-deps true}) :errors :G0)))))\n\n(deftest g1c-pure-wr-test\n ; Transaction t1 is visible to t2, and t2 is visible to t1\n (let [t1 (o 0 0 :invoke :txn [[:send :x :a] [:poll]])\n t2 (o 1 1 :invoke :txn [[:send :y :b] [:poll]])\n t1' (o 2 0 :ok :txn [[:send :x [0 :a]] [:poll {:y [[0 :b]]}]])\n t2' (o 3 1 :ok :txn [[:send :y [0 :b]] [:poll {:x [[0 :a]]}]])]\n (is (= [{:type :G1c\n :cycle [t2' t1' t2']\n :steps [{:type :wr, :key :y, :value :b,\n :a-mop-index 0, :b-mop-index 1}\n {:type :wr, :key :x, :value :a\n :a-mop-index 0, :b-mop-index 1}]}]\n (-> [t1 t2 t1' t2'] h/history analysis :errors :G1c)))))\n\n(deftest g1c-ww-wr-test\n ; Transaction t1 writes something which is followed by a write of t2, but\n ; also observes a different write from t2\n (let [t1 (o 0 0 :invoke :txn [[:send :x :a] [:send :y :c]])\n t2 (o 1 1 :invoke :txn [[:poll] [:send :y :b]])\n t1' (o 2 0 :ok :txn [[:send :x [0 :a]] [:send :y [2 :c]]])\n t2' (o 3 1 :ok :txn [[:poll {:x [[0 :a]]}] [:send :y [1 :b]]])]\n (is (= [{:type :G1c\n :cycle [t1' t2' t1']\n :steps [{:type :wr, :key :x, :value :a,\n :a-mop-index 0, :b-mop-index 0}\n {:type :ww, :key :y, :value :b, :value' :c,\n :a-mop-index 1, :b-mop-index 1}]}]\n (-> [t1 t2 t1' t2'] h/history\n (analysis {:ww-deps true}) :errors :G1c)))))\n\n(deftest precommitted-read-test\n ; Transaction T1 observes its own write, which commits after the poll. This\n ; would be legal in most databases, but in Kafka's model, consumers at read\n ; committed are supposed to *never* observe values which haven't yet been\n ; committed, because consumers may sometimes not be participants in\n ; transaction control.\n (let [t1 (o 0 0 :invoke :txn [[:send :x :a] [:poll]])\n t1' (o 1 0 :ok :txn [[:send :x [0 :a]] [:poll {:x [[0 :a]]}]])\n r (-> [t1 t1']\n h/history\n analysis)]\n (is (= [{:op t1'\n :key :x\n :value :a}]\n (:precommitted-read (:errors r))))))\n\n(defn gen-poll-unseen-test-sim\n \"Simulator for gen.test. Takes an atom to the next offset we assign, and a\n context and invocation. Returns a completed op.\"\n [next-offset ctx op]\n (let [op (update op :time + gen.test/perfect-latency)]\n (case (:f op)\n (:poll :send :txn)\n (let [v' (mapv (fn [mop]\n (case (first mop)\n :send (let [[f k v] mop]\n [f k [(swap! next-offset inc) v]])\n :poll [:poll {}]))\n (:value op))]\n (assoc op :type :ok\n :value v'))\n\n ; Otherwise\n (assoc op :type :ok))))\n\n(deftest gen-poll-unseen-test\n ; We verify that a laggy DB which accepts sends but never returns them in\n ; polls causes repeated polling attempts even after the end of the key.\n (let [gen [(concat\n ; We do a single write and several (unsuccessful) polls of :x\n [{:f :send, :value [[:send :x 0]]}]\n (repeat 5 {:f :assign, :value [:x]})\n (repeat 5 {:f :poll, :value [[:poll]]})\n ; Then we move everyone on to :y and do a bunch of assigns.\n ; We've got a 1/3 chance to rewrite these to :x.\n (repeat 100 {:f :assign :value [:y]}))]\n ctx gen.test/default-context\n ; Returns a map of assigned keys to the number of times we assigned\n ; that specific combination of keys, e.g. {[:x] 5, [:x :y] 10}\n assigns-freq (fn [h]\n (->> h\n (filter (comp #{:assign} :f))\n (map :value)\n frequencies))\n sim (fn [gen]\n (gen.test/invocations\n (gen.test/simulate ctx gen\n (partial gen-poll-unseen-test-sim\n (atom 0)))))]\n (testing \"without unseen-poll\"\n (let [h (sim gen)]\n (is (= {[:x] 5\n [:y] 100}\n (assigns-freq h)))))\n (testing \"with unseen-poll\"\n (let [h (sim (poll-unseen gen))\n freqs (assigns-freq h)]\n ;(pprint freqs)\n (is (= #{[:x] [:y] [:x :y]} (set (keys freqs))))\n (is (= 5 (freqs [:x])))\n (is (< (freqs [:y] 100)))\n (is (< 0 (freqs [:x :y])))\n ; Check that our debugging key is present\n (is (= {:x {:polled -1, :sent 1}}\n (first (keep :unseen h))))\n ))))\n\n#_(deftest perf-test\n ; This is a little helper for performance benchmarking. Grab a\n ; slow-to-analyze test directory and it'll load the test.jepsen from it.\n (let [f \"slow-kafka\"\n test (store/test f)\n history (:history test)\n checker (checker)]\n (dotimes [i 3]\n (let [t0 (System/nanoTime)\n r (checker/check checker test history {})\n t1 (System/nanoTime)]\n (println \"Checked in\" (util/nanos->secs (- t1 t0)) \"seconds\")))))\n" }, { "path": "jepsen/test/jepsen/tests/long_fork_test.clj", "content": "(ns jepsen.tests.long-fork-test\n (:require [clojure.test :refer :all]\n [clojure.pprint :refer [pprint]]\n [jepsen [checker :as checker]\n [history :as h]]\n [jepsen.tests.long-fork :refer :all]))\n\n(deftest checker-test\n (let [; r1 sees 1 1 nil\n r1 {:type :invoke, :f :read, :value [[:r 0 nil] [:r 1 nil] [:r 2 nil]]}\n r1' {:type :ok, :f :read, :value [[:r 0 1] [:r 1 1] [:r 2 nil]]}\n ; r2 sees 1 nil 1\n r2 {:type :invoke, :f :read, :value [[:r 2 nil] [:r 0 nil] [:r 1 nil]]}\n r2' {:type :ok, :f :read, :value [[:r 2 1] [:r 0 1] [:r 1 nil]]}\n h (h/history [r1 r2 r1' r2'])\n [r1 r2 r1' r2'] h]\n (is (= {:valid? false\n :early-read-count 0\n :late-read-count 0\n :reads-count 2\n :forks [[r1' r2']]}\n (checker/check (checker 3) {} h {})))))\n" }, { "path": "jepsen/test/jepsen/util_test.clj", "content": "(ns jepsen.util-test\n (:refer-clojure :exclude [parse-long])\n (:require [clojure [pprint :refer [pprint]]\n [test :refer :all]]\n [fipp.edn :as fipp]\n [jepsen [history :as h]\n [util :refer :all]]))\n\n(deftest majority-test\n (is (= 1 (majority 0)))\n (is (= 1 (majority 1)))\n (is (= 2 (majority 2)))\n (is (= 2 (majority 3)))\n (is (= 3 (majority 4)))\n (is (= 3 (majority 5))))\n\n(deftest minority-test\n (are [expected n] (= expected (minority n))\n 0 0\n 0 1\n 0 2\n 1 3\n 1 4\n 2 5\n 2 6))\n\n(deftest integer-interval-set-str-test\n (is (= (integer-interval-set-str [])\n \"#{}\"))\n\n (is (= (integer-interval-set-str [1])\n \"#{1}\"))\n\n (is (= (integer-interval-set-str [1 2])\n \"#{1..2}\"))\n\n (is (= (integer-interval-set-str [1 2 3])\n \"#{1..3}\"))\n\n (is (= (integer-interval-set-str [1 3 5])\n \"#{1 3 5}\"))\n\n (is (= (integer-interval-set-str [1 2 3 5 7 8 9])\n \"#{1..3 5 7..9}\")))\n\n(deftest history->latencies-test\n (let [history\n (h/history\n [{:time 11457033239, :process 2, :type :invoke, :f :read}\n {:time 11457019103, :process 3, :type :invoke, :f :read}\n {:time 11457111283, :process 4, :type :invoke, :f :cas, :value [0 2]}\n {:time 11457094604, :process 0, :type :invoke, :f :cas, :value [4 4]}\n {:time 11457159210, :process 1, :type :invoke, :f :cas, :value [3 1]}\n {:value nil, :time 11473961208, :process 2, :type :ok, :f :read}\n {:value nil, :time 11473953899, :process 3, :type :ok, :f :read}\n {:time 11478831184, :process 4, :type :info, :f :cas, :value [0 2]}\n {:time 11478852616, :process 1, :type :fail, :f :cas, :value [3 1]}\n {:time 11478859479, :process 0, :type :fail, :f :cas, :value [4 4]}\n {:time 12475010505, :process 2, :type :invoke, :f :read}\n {:time 12475010560, :process :nem :type :info :f :hi}\n {:time 12475232472, :process 3, :type :invoke, :f :write, :value 0}\n {:value nil, :time 12477011002, :process 2, :type :ok, :f :read}\n {:time 12479523408, :process 4, :type :invoke, :f :cas, :value [1 0]}\n {:time 12479572112, :process 0, :type :invoke, :f :write, :value 1}\n {:time 12479552107, :process 1, :type :invoke, :f :cas, :value [4 3]}\n {:time 12480010179, :process 3, :type :ok, :f :write, :value 0}\n {:time 12481345684, :process 1, :type :fail, :f :cas, :value [4 3]}\n {:time 12484071466, :process 0, :type :ok, :f :write, :value 1}\n {:time 12484388730, :process 4, :type :ok, :f :cas, :value [1 0]}])\n h (history->latencies history)\n n->m (partial * 1e-6)]\n (->> h\n (filter #(= :invoke (:type %)))\n (map (juxt (comp n->m :time)\n (comp n->m :latency)))\n; (map (fn [[time latency]]\n; (println (str time \",\" latency))))\n ;TODO: actually assert something\n dorun)))\n\n(deftest longest-common-prefix-test\n (is (= nil (longest-common-prefix [])))\n (is (= [] (longest-common-prefix [[1 2] [3 4]])))\n (is (= [1 2] (longest-common-prefix [[1 2]])))\n (is (= [1 2 3] (longest-common-prefix [[1 2 3] [1 2 3 4] [1 2 3 6]]))))\n\n(deftest drop-common-proper-prefix-test\n (is (= [[3 4] [5 6]] (drop-common-proper-prefix [[1 3 4] [1 5 6]])))\n (is (= [[1]] (drop-common-proper-prefix [[1]])))\n (is (= [[2]] (drop-common-proper-prefix [[1 2]])))\n (is (= [[2] [2]] (drop-common-proper-prefix [[1 2] [1 2]]))))\n\n(deftest letr-test\n (testing \"no bindings\"\n (is (= (letr [] nil) nil))\n (is (= (letr [] 1 2) 2)))\n\n (testing \"standard bindings\"\n (is (= (letr [a 1, b a] 2 a) 1)))\n\n (testing \"early return\"\n (let [side-effect (atom false)]\n (is (= (letr [a 1\n x (if (pos? a) (return :pos) :neg)\n foo (reset! side-effect true)]\n x)\n :pos))\n (is (not @side-effect))))\n\n (testing \"using non-return branch\"\n (let [side-effect (atom false)]\n (is (= (letr [a -1\n x (if (pos? a) (return :pos) :neg)\n foo (reset! side-effect true)]\n x)\n :neg))\n (is @side-effect)))\n\n (testing \"multiple return\"\n (is (= (letr [a 2\n _ (when (= a 1) (return :1))\n _ (when (= a 2) (return :2))\n _ (when (= a 3) (return :3))]\n 4)\n :2))))\n\n(deftest timeout-test\n ; Fast operations pass through the inner result or exception.\n (is (= ::success (timeout 1000 ::timed-out\n ::success)))\n (is (thrown? ArithmeticException\n (timeout 1000 ::timed-out\n (/ 1 0))))\n ; Slow operations are interrupted and return timeout value.\n (is (= ::timed-out (timeout 10 ::timed-out\n (Thread/sleep 1000))))\n ; This is a more complicated version of the previous test that\n ; verifies that the function is interrupted when a timeout occurs.\n (let* [p (promise)\n ret (timeout 10 ::timed-out\n (try\n (Thread/sleep 1000)\n (deliver p ::finished)\n (catch InterruptedException e\n (deliver p ::exception))))]\n (is (= ::timed-out ret))\n (is (= ::exception (deref p 10 ::timed-out)))))\n\n(deftest lazy-atom-test\n (testing \"reads\"\n (let [calls (atom 0)\n a (lazy-atom (fn [] (swap! calls inc) 0))]\n (is (= 0 @calls))\n (is (= 0 @a))\n (is (= 1 @calls))\n (is (= 0 @a))\n (is (= 1 @calls))))\n\n (testing \"increments\"\n (let [calls (atom 0)\n a (lazy-atom (fn [] (Thread/sleep 10) (swap! calls inc) 0))\n f1 (future (swap! a inc))\n f2 (future (swap! a inc))]\n @f1\n @f2\n (is (= 1 @calls))\n (is (= 2 @a)))))\n\n(deftest nemesis-intervals-test\n (let [s1 {:process :nemesis, :f :start, :value 1}\n s2 {:process :nemesis, :f :start, :value 2}\n s3 {:process :nemesis, :f :start, :value 3}\n s4 {:process :nemesis, :f :start, :value 4}\n e1 {:process :nemesis, :f :stop, :value 1}\n e2 {:process :nemesis, :f :stop, :value 2}]\n (is (= [[s1 e1] [s2 e2] [s3 e1] [s4 e2]]\n (nemesis-intervals [s1 s2 s3 s4 e1 e2])))))\n\n(deftest rand-exp-test\n (let [n 500\n target-mean 30\n samples (take n (repeatedly (partial rand-exp target-mean)))\n sum (reduce + samples)\n mean (/ sum n)]\n ;(prn samples)\n (is (< (* target-mean 0.7)\n mean\n (* target-mean 1.3)))))\n\n(deftest zipf-test\n (let [n 1000\n skew 1.00001\n m 5\n samples (take n (repeatedly (partial zipf skew m)))\n f (frequencies samples)]\n (is (every? #(< -1 % m) samples))\n (is (< 1.5 (/ (f 0) (f 1)) 2.5))\n (is (< 2.5 (/ (f 0) (f 2)) 4))\n (is (< 4 (/ (f 0) (f 4)) 6))))\n\n(deftest forgettable-test\n (let [f (forgettable :foo)]\n (is (= :foo @f))\n (is (= \"#\" (str f)))\n (is (= \"#\\n\" (with-out-str (pprint f))))\n (is (re-find #\"^#object\\[jepsen.util.Forgettable \\\"0x\\w+\\\" :foo\\]\\n$\"\n (with-out-str (fipp/pprint f))))\n (forget! f)\n (is (thrown-with-msg? clojure.lang.ExceptionInfo\n #\"\\{:type :jepsen\\.util/forgotten\\}\"\n @f))))\n\n(deftest partition-by-vec-test\n (is (= [] (partition-by-vec first nil)))\n (is (= [] (partition-by-vec second [])))\n (is (= [[1] [2]] (partition-by-vec identity [1 2])))\n (is (= [[1 2] [-1 -2] [3 3 3]] (partition-by-vec pos? [1 2 -1 -2 3 3 3]))))\n" }, { "path": "txn/.gitignore", "content": "/target\n/classes\n/checkouts\npom.xml\npom.xml.asc\n*.jar\n*.class\n/.lein-*\n/.nrepl-port\n.hgignore\n.hg/\n" }, { "path": "txn/CHANGELOG.md", "content": "# Change Log\nAll notable changes to this project will be documented in this file. This change log follows the conventions of [keepachangelog.com](http://keepachangelog.com/).\n\n## [Unreleased]\n### Changed\n- Add a new arity to `make-widget-async` to provide a different widget shape.\n\n## [0.1.1] - 2018-03-28\n### Changed\n- Documentation on how to make the widgets.\n\n### Removed\n- `make-widget-sync` - we're all async, all the time.\n\n### Fixed\n- Fixed widget maker to keep working when daylight savings switches over.\n\n## 0.1.0 - 2018-03-28\n### Added\n- Files from the new template.\n- Widget maker public API - `make-widget-sync`.\n\n[Unreleased]: https://github.com/your-name/jepsen.txn/compare/0.1.1...HEAD\n[0.1.1]: https://github.com/your-name/jepsen.txn/compare/0.1.0...0.1.1\n" }, { "path": "txn/LICENSE", "content": "THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE PUBLIC\nLICENSE (\"AGREEMENT\"). ANY USE, REPRODUCTION OR DISTRIBUTION OF THE PROGRAM\nCONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT.\n\n1. DEFINITIONS\n\n\"Contribution\" means:\n\na) in the case of the initial Contributor, the initial code and\ndocumentation distributed under this Agreement, and\n\nb) in the case of each subsequent Contributor:\n\ni) changes to the Program, and\n\nii) additions to the Program;\n\nwhere such changes and/or additions to the Program originate from and are\ndistributed by that particular Contributor. A Contribution 'originates' from\na Contributor if it was added to the Program by such Contributor itself or\nanyone acting on such Contributor's behalf. Contributions do not include\nadditions to the Program which: (i) are separate modules of software\ndistributed in conjunction with the Program under their own license\nagreement, and (ii) are not derivative works of the Program.\n\n\"Contributor\" means any person or entity that distributes the Program.\n\n\"Licensed Patents\" mean patent claims licensable by a Contributor which are\nnecessarily infringed by the use or sale of its Contribution alone or when\ncombined with the Program.\n\n\"Program\" means the Contributions distributed in accordance with this\nAgreement.\n\n\"Recipient\" means anyone who receives the Program under this Agreement,\nincluding all Contributors.\n\n2. GRANT OF RIGHTS\n\na) Subject to the terms of this Agreement, each Contributor hereby grants\nRecipient a non-exclusive, worldwide, royalty-free copyright license to\nreproduce, prepare derivative works of, publicly display, publicly perform,\ndistribute and sublicense the Contribution of such Contributor, if any, and\nsuch derivative works, in source code and object code form.\n\nb) Subject to the terms of this Agreement, each Contributor hereby grants\nRecipient a non-exclusive, worldwide, royalty-free patent license under\nLicensed Patents to make, use, sell, offer to sell, import and otherwise\ntransfer the Contribution of such Contributor, if any, in source code and\nobject code form. This patent license shall apply to the combination of the\nContribution and the Program if, at the time the Contribution is added by the\nContributor, such addition of the Contribution causes such combination to be\ncovered by the Licensed Patents. The patent license shall not apply to any\nother combinations which include the Contribution. No hardware per se is\nlicensed hereunder.\n\nc) Recipient understands that although each Contributor grants the licenses\nto its Contributions set forth herein, no assurances are provided by any\nContributor that the Program does not infringe the patent or other\nintellectual property rights of any other entity. Each Contributor disclaims\nany liability to Recipient for claims brought by any other entity based on\ninfringement of intellectual property rights or otherwise. As a condition to\nexercising the rights and licenses granted hereunder, each Recipient hereby\nassumes sole responsibility to secure any other intellectual property rights\nneeded, if any. For example, if a third party patent license is required to\nallow Recipient to distribute the Program, it is Recipient's responsibility\nto acquire that license before distributing the Program.\n\nd) Each Contributor represents that to its knowledge it has sufficient\ncopyright rights in its Contribution, if any, to grant the copyright license\nset forth in this Agreement.\n\n3. REQUIREMENTS\n\nA Contributor may choose to distribute the Program in object code form under\nits own license agreement, provided that:\n\na) it complies with the terms and conditions of this Agreement; and\n\nb) its license agreement:\n\ni) effectively disclaims on behalf of all Contributors all warranties and\nconditions, express and implied, including warranties or conditions of title\nand non-infringement, and implied warranties or conditions of merchantability\nand fitness for a particular purpose;\n\nii) effectively excludes on behalf of all Contributors all liability for\ndamages, including direct, indirect, special, incidental and consequential\ndamages, such as lost profits;\n\niii) states that any provisions which differ from this Agreement are offered\nby that Contributor alone and not by any other party; and\n\niv) states that source code for the Program is available from such\nContributor, and informs licensees how to obtain it in a reasonable manner on\nor through a medium customarily used for software exchange.\n\nWhen the Program is made available in source code form:\n\na) it must be made available under this Agreement; and\n\nb) a copy of this Agreement must be included with each copy of the Program.\n\nContributors may not remove or alter any copyright notices contained within\nthe Program.\n\nEach Contributor must identify itself as the originator of its Contribution,\nif any, in a manner that reasonably allows subsequent Recipients to identify\nthe originator of the Contribution.\n\n4. COMMERCIAL DISTRIBUTION\n\nCommercial distributors of software may accept certain responsibilities with\nrespect to end users, business partners and the like. While this license is\nintended to facilitate the commercial use of the Program, the Contributor who\nincludes the Program in a commercial product offering should do so in a\nmanner which does not create potential liability for other Contributors.\nTherefore, if a Contributor includes the Program in a commercial product\noffering, such Contributor (\"Commercial Contributor\") hereby agrees to defend\nand indemnify every other Contributor (\"Indemnified Contributor\") against any\nlosses, damages and costs (collectively \"Losses\") arising from claims,\nlawsuits and other legal actions brought by a third party against the\nIndemnified Contributor to the extent caused by the acts or omissions of such\nCommercial Contributor in connection with its distribution of the Program in\na commercial product offering. The obligations in this section do not apply\nto any claims or Losses relating to any actual or alleged intellectual\nproperty infringement. In order to qualify, an Indemnified Contributor must:\na) promptly notify the Commercial Contributor in writing of such claim, and\nb) allow the Commercial Contributor to control, and cooperate with the\nCommercial Contributor in, the defense and any related settlement\nnegotiations. The Indemnified Contributor may participate in any such claim\nat its own expense.\n\nFor example, a Contributor might include the Program in a commercial product\noffering, Product X. That Contributor is then a Commercial Contributor. If\nthat Commercial Contributor then makes performance claims, or offers\nwarranties related to Product X, those performance claims and warranties are\nsuch Commercial Contributor's responsibility alone. Under this section, the\nCommercial Contributor would have to defend claims against the other\nContributors related to those performance claims and warranties, and if a\ncourt requires any other Contributor to pay any damages as a result, the\nCommercial Contributor must pay those damages.\n\n5. NO WARRANTY\n\nEXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS PROVIDED ON\nAN \"AS IS\" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER\nEXPRESS OR IMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR\nCONDITIONS OF TITLE, NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A\nPARTICULAR PURPOSE. Each Recipient is solely responsible for determining the\nappropriateness of using and distributing the Program and assumes all risks\nassociated with its exercise of rights under this Agreement , including but\nnot limited to the risks and costs of program errors, compliance with\napplicable laws, damage to or loss of data, programs or equipment, and\nunavailability or interruption of operations.\n\n6. DISCLAIMER OF LIABILITY\n\nEXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT NOR ANY\nCONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL,\nSPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION\nLOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN\nCONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)\nARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE\nEXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY\nOF SUCH DAMAGES.\n\n7. GENERAL\n\nIf any provision of this Agreement is invalid or unenforceable under\napplicable law, it shall not affect the validity or enforceability of the\nremainder of the terms of this Agreement, and without further action by the\nparties hereto, such provision shall be reformed to the minimum extent\nnecessary to make such provision valid and enforceable.\n\nIf Recipient institutes patent litigation against any entity (including a\ncross-claim or counterclaim in a lawsuit) alleging that the Program itself\n(excluding combinations of the Program with other software or hardware)\ninfringes such Recipient's patent(s), then such Recipient's rights granted\nunder Section 2(b) shall terminate as of the date such litigation is filed.\n\nAll Recipient's rights under this Agreement shall terminate if it fails to\ncomply with any of the material terms or conditions of this Agreement and\ndoes not cure such failure in a reasonable period of time after becoming\naware of such noncompliance. If all Recipient's rights under this Agreement\nterminate, Recipient agrees to cease use and distribution of the Program as\nsoon as reasonably practicable. However, Recipient's obligations under this\nAgreement and any licenses granted by Recipient relating to the Program shall\ncontinue and survive.\n\nEveryone is permitted to copy and distribute copies of this Agreement, but in\norder to avoid inconsistency the Agreement is copyrighted and may only be\nmodified in the following manner. The Agreement Steward reserves the right to\npublish new versions (including revisions) of this Agreement from time to\ntime. No one other than the Agreement Steward has the right to modify this\nAgreement. The Eclipse Foundation is the initial Agreement Steward. The\nEclipse Foundation may assign the responsibility to serve as the Agreement\nSteward to a suitable separate entity. Each new version of the Agreement will\nbe given a distinguishing version number. The Program (including\nContributions) may always be distributed subject to the version of the\nAgreement under which it was received. In addition, after a new version of\nthe Agreement is published, Contributor may elect to distribute the Program\n(including its Contributions) under the new version. Except as expressly\nstated in Sections 2(a) and 2(b) above, Recipient receives no rights or\nlicenses to the intellectual property of any Contributor under this\nAgreement, whether expressly, by implication, estoppel or otherwise. All\nrights in the Program not expressly granted under this Agreement are\nreserved.\n\nThis Agreement is governed by the laws of the State of New York and the\nintellectual property laws of the United States of America. No party to this\nAgreement will bring a legal action under this Agreement more than one year\nafter the cause of action arose. Each party waives its rights to a jury trial\nin any resulting litigation.\n" }, { "path": "txn/README.md", "content": "# Jepsen.txn\n\nSupport library for generating and analyzing transactional, multi-object\nhistories. This is very much a work in progress.\n\n## Concepts\n\nA *state* is a map of keys to values.\n\n```clj\n{:x 1\n :y 2}\n```\n\nOur data model is a set of *stateful objects*. An *object* is a uniquely named\nregister. Given a state, each object's value is given by that state's value for\nthe object's key.\n\nA *micro-op* is a primitive atomic transition over a state. We call these\n\"micro\" to distinguish them from \"ops\" in Jepsen. In this library, however,\nwe'll use *op* as a shorthand for micro-op unless otherwise specified.\n\n```clj\n[:r :x 1] ; Read the value of x, finding 1\n[:w :y 2] ; Write 2 to y\n```\n\nA *transaction* is an ordered sequence of micro-ops.\n\n```clj\n[[:w :x 1] [:r :x 1] [:w :y 2]] ; Set x to 1, read that write, set y to 2\n```\n\nA *sequential history* is an ordered sequence of transactions.\n\n```clj\n[[[:w :x 1] [:w :y 2]] ; Set x and y to 1 and 2\n [[:r :x 1]] ; Observe x = 1\n [[:r :y 2]]] ; Observe y = 2\n```\n\nA *history* is a concurrent history of Jepsen operations, each with an\narbitrary :f (which could be used to hint at the purpose or class of the\ntransaction being performed), and whose value is a transaction.\n\n```clj\n; A concurrent write of x=1 and read of x=1\n[{:process 0, :type :invoke, :f :txn, :value [[:w :x 1]]}\n {:process 1, :type :invoke, :f :txn, :value [[:r :x nil]]}\n {:process 0, :type :invoke, :f :txn, :value [[:w :x 1]]}\n {:process 1, :type :invoke, :f :txn, :value [[:r :x 1]]}]\n```\n\nAn *op interpreter* is a function that takes a state and a micro-op, and\napplies that operation to the state. It returns [state' op']: the resulting\nstate, and the op with any missing values (e.g. reads) filled in.\n\nA *simulator* simulates the effect of executing transactions on some example\nsystem. It takes an initial state, a sequence of operations, and produces a\nhistory by applying those operations to the system. It may simulate\nsinglethreaded or multithreaded execution, so long as each process's effects\nare singlethreaded. Simulators are useful for generating randomized histories\nwhich are known to conform to some consistency model, such as serializability\nor snapshot isolation, and those histories can be used to test programs that\nverify those properties.\n\n## License\n\nCopyright © 2018 Jepsen, LLC\n\nDistributed under the Eclipse Public License either version 1.0 or (at\nyour option) any later version.\n" }, { "path": "txn/doc/intro.md", "content": "# Introduction to jepsen.txn\n\nTODO: write [great documentation](http://jacobian.org/writing/what-to-write/)\n" }, { "path": "txn/project.clj", "content": "(defproject jepsen.txn \"0.1.4-SNAPSHOT\"\n :description \"Library for generating and analyzing multi-object transactional histories\"\n :url \"https://github.com/jepsen-io/jepsen\"\n :license {:name \"Eclipse Public License\"\n :url \"http://www.eclipse.org/legal/epl-v10.html\"}\n :test-selectors {:default (fn [m] (not (or (:perf m))))\n :all (fn [m] true)\n :perf :perf}\n :dependencies [[dom-top \"1.0.10\"]]\n :profiles {:dev {:dependencies [[org.clojure/clojure \"1.12.4\"]\n [criterium \"0.4.6\"]]}})\n" }, { "path": "txn/src/jepsen/txn/micro_op.clj", "content": "(ns jepsen.txn.micro-op\n \"Transactions are made up of micro-operations. This namespace helps us work\n with those.\"\n (:refer-clojure :exclude [key val]))\n\n(defn f\n \"What function is this op executing?\"\n [op]\n (nth op 0))\n\n(defn key\n \"What key did this op affect?\"\n [op]\n (nth op 1))\n\n(defn value\n \"What value did this op use?\"\n [op]\n (nth op 2))\n\n(defn read?\n \"Is the given operation a read?\"\n [op]\n (= :r (f op)))\n\n(defn write?\n \"Is the given operation a write?\"\n [op]\n (= :w (f op)))\n\n(defn op?\n \"Is this a legal operation?\"\n [op]\n (and (= 3 (count op))\n (#{:r :w} (f op))))\n" }, { "path": "txn/src/jepsen/txn.clj", "content": "(ns jepsen.txn\n \"Manipulates transactions. Transactions are represented as a sequence of\n micro-operations (mops for short).\"\n (:require [dom-top.core :refer [loopr]]))\n\n(defn reduce-mops\n \"Takes a history of operations, where each operation op has a :value which is\n a transaction made up of [f k v] micro-ops. Runs a reduction over every\n micro-op, where the reduction function is of the form (f state op [f k v]).\n Saves you having to do endless nested reduces.\"\n [f init-state history]\n (reduce (fn op [state op]\n (reduce (fn mop [state mop]\n (f state op mop))\n state\n (:value op)))\n init-state\n history))\n\n(defn op-mops\n \"A lazy sequence of all [op mop] pairs from a history.\"\n [history]\n (mapcat (fn [op] (map (fn [mop] [op mop]) (:value op))) history))\n\n(defn reads\n \"Given a transaction, returns a map of keys to sets of all values that\n transaction read.\"\n [txn]\n (loopr [reads (transient {})]\n [[f k v] txn]\n (if (= :r f)\n (let [vs (get reads k #{})]\n (recur (assoc! reads k (conj vs v))))\n (recur reads))\n (persistent! reads)))\n\n(defn writes\n \"Given a transaction, returns a map of keys to sets of all values that\n transaction wrote.\"\n [txn]\n (loopr [writes (transient {})]\n [[f k v] txn]\n (if (= :w f)\n (let [vs (get writes k #{})]\n (recur (assoc! writes k (conj vs v))))\n (recur writes))\n (persistent! writes)))\n\n(defn ext-reads\n \"Given a transaction, returns a map of keys to values for its external reads:\n values that transaction observed which it did not write itself.\"\n [txn]\n (loop [ext (transient {})\n ignore? (transient #{})\n txn txn]\n (if (seq txn)\n (let [[f k v] (first txn)]\n (recur (if (or (not= :r f)\n (ignore? k))\n ext\n (assoc! ext k v))\n (conj! ignore? k)\n (next txn)))\n (persistent! ext))))\n\n(defn ext-writes\n \"Given a transaction, returns the map of keys to values for its external\n writes: final values written by the txn.\"\n [txn]\n (loop [ext (transient {})\n txn txn]\n (if (seq txn)\n (let [[f k v] (first txn)]\n (recur (if (= :r f)\n ext\n (assoc! ext k v))\n (next txn)))\n (persistent! ext))))\n\n(defn int-write-mops\n \"Returns a map of keys to vectors of of all non-final write mops to that key.\"\n [txn]\n (loop [int (transient {})\n txn txn]\n (if (seq txn)\n (let [[f k v :as mop] (first txn)]\n (recur (if (= :r f)\n int\n (let [writes (get int k [])]\n (assoc! int k (conj writes mop))))\n (next txn)))\n ; All done; trim final writes.\n (->> int\n persistent!\n (keep (fn [[k vs]]\n (when (< 1 (count vs))\n [k (subvec vs 0 (dec (count vs)))])))\n (into {})))))\n" }, { "path": "txn/test/jepsen/txn_test.clj", "content": "(ns jepsen.txn-test\n (:require [clojure.test :refer :all]\n [criterium.core :refer [quick-bench bench with-progress-reporting]]\n [jepsen.txn :refer :all]))\n\n(deftest ext-reads-test\n (testing \"no ext reads\"\n (is (= {} (ext-reads [])))\n (is (= {} (ext-reads [[:w :x 2] [:r :x 2]]))))\n\n (testing \"some reads\"\n (is (= {:x 2} (ext-reads [[:w :y 1] [:r :x 2] [:w :x 3] [:r :x 3]])))))\n\n(deftest ext-writes-test\n (testing \"no ext writes\"\n (is (= {} (ext-writes [])))\n (is (= {} (ext-writes [[:r :x 1]]))))\n\n (testing \"ext writes\"\n (is (= {:x 1 :y 2} (ext-writes [[:w :x 1] [:r :y 0] [:w :y 1] [:w :y 2]])))))\n\n(deftest ^:perf ext-reads-perf\n (with-progress-reporting\n (bench (ext-reads [[:w :y 1] [:r :x 2] [:w :x 3] [:r :x 3]]))))\n" } ]