reformatting

script/jepsen.garage/.envrc

@@ -0,0 +1 @@
+use nix

script/jepsen.garage/.gitignore

@@ -0,0 +1,16 @@
+/target
+/classes
+/checkouts
+profiles.clj
+pom.xml
+pom.xml.asc
+*.jar
+*.class
+/.lein-*
+/.nrepl-port
+/.prepl-port
+.hgignore
+.hg/
+.direnv
+/store
+.vagrant

script/jepsen.garage/README.md

@@ -0,0 +1,39 @@
+# jepsen.garage
+
+Jepsen checking of Garage consistency properties.
+
+## Usage
+
+Requirements:
+
+- vagrant
+- VirtualBox, configured so that nodes can take an IP in a private network `192.168.56.0/24`
+- a user that can create VirtualBox VMs
+- leiningen
+- gnuplot
+
+Set up VMs:
+
+```
+vagrant up
+```
+
+Run tests (this one should fail):
+
+```
+lein run test --nodes-file nodes.vagrant --time-limit 64 --concurrency 50 --rate 50 --workload reg
+```
+
+These ones are working:
+
+```
+lein run test --nodes-file nodes.vagrant --time-limit 64 --rate 50  --concurrency 50 --workload set1
+lein run test --nodes-file nodes.vagrant --time-limit 64 --rate 50  --concurrency 50 --workload set2
+```
+
+## License
+
+Copyright © 2023 Alex Auvolat
+
+This program and the accompanying materials are made available under the
+terms of the GNU Affero General Public License v3.0.

script/jepsen.garage/Vagrantfile

@@ -0,0 +1,29 @@
+# -*- mode: ruby -*-
+# vi: set ft=ruby :
+#
+
+def vm(config, hostname, ip)
+  config.vm.hostname = hostname
+  config.vm.network "private_network", ip: ip
+end
+
+Vagrant.configure("2") do |config|
+  config.vm.box = "generic/debian10"
+
+  config.vm.provider "virtualbox" do |vb|
+    vb.gui = false
+    vb.memory = "512"
+  end
+
+  config.vm.provision "shell", inline: <<-SHELL
+    echo "root:root" | chpasswd
+    mkdir -p /root/.ssh
+    echo "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIJpaBZdYxHqMxhv2RExAOa7nkKhPBOHupMP3mYaZ73w9 lx@lindy" >> /root/.ssh/authorized_keys
+  SHELL
+
+  config.vm.define "n1" do |config| vm(config, "n1", "192.168.56.21") end
+  config.vm.define "n2" do |config| vm(config, "n2", "192.168.56.22") end
+  config.vm.define "n3" do |config| vm(config, "n3", "192.168.56.23") end
+  config.vm.define "n4" do |config| vm(config, "n4", "192.168.56.24") end
+  config.vm.define "n5" do |config| vm(config, "n5", "192.168.56.25") end
+end

script/jepsen.garage/nodes.vagrant

@@ -0,0 +1,5 @@
+192.168.56.21
+192.168.56.22
+192.168.56.23
+192.168.56.24
+192.168.56.25

script/jepsen.garage/project.clj

@@ -0,0 +1,10 @@
+(defproject jepsen.garage "0.1.0-SNAPSHOT"
+  :description "Jepsen testing for Garage"
+  :url "https://git.deuxfleurs.fr/Deuxfleurs/garage"
+  :license {:name "AGPLv3"
+            :url "https://www.gnu.org/licenses/agpl-3.0.en.html"}
+  :main jepsen.garage
+  :dependencies [[org.clojure/clojure "1.11.1"]
+                 [jepsen "0.3.2-SNAPSHOT"]
+                 [amazonica "0.3.163"]]
+  :repl-options {:init-ns jepsen.garage})

script/jepsen.garage/shell.nix

@@ -0,0 +1,8 @@
+{ pkgs ? import <nixpkgs> { } }:
+pkgs.mkShell {
+  nativeBuildInputs = with pkgs; [
+    leiningen
+    vagrant
+    gnuplot
+  ];
+}

script/jepsen.garage/src/jepsen/garage.clj

@@ -0,0 +1,82 @@
+(ns jepsen.garage
+  (:require
+    [clojure.string :as str]
+    [jepsen
+     [checker :as checker]
+     [cli :as cli]
+     [generator :as gen]
+     [nemesis :as nemesis]
+     [tests :as tests]]
+    [jepsen.os.debian :as debian]
+    [jepsen.garage
+     [grg :as grg]
+     [reg :as reg]
+     [set :as set]]))
+
+(def workloads
+  "A map of workload names to functions that construct workloads, given opts."
+  {"reg"  reg/workload
+   "set1" set/workload1
+   "set2" set/workload2})
+
+(def cli-opts
+  "Additional command line options."
+  [["-I" "--increasing-timestamps" "Garage version with increasing timestamps on PutObject"
+    :default false]
+   ["-r" "--rate HZ" "Approximate number of requests per second, per thread."
+    :default  10
+    :parse-fn read-string
+    :validate [#(and (number? %) (pos? %)) "Must be a positive number"]]
+   [nil "--ops-per-key NUM" "Maximum number of operations on any given key."
+    :default  100
+    :parse-fn parse-long
+    :validate [pos? "Must be a positive integer."]]
+   ["-w" "--workload NAME" "Workload of test to run"
+    :default "reg"
+    :validate [workloads (cli/one-of workloads)]]])
+
+(defn garage-test
+  "Given an options map from the command line runner (e.g. :nodes, :ssh,
+  :concurrency, ...), constructs a test map."
+  [opts]
+  (let [workload ((get workloads (:workload opts)) opts)
+        garage-version (if (:increasing-timestamps opts)
+                         "03490d41d58576d7b3bcf977b2726d72a3a66ada"
+                         "v0.8.2")]
+    (merge tests/noop-test
+           opts
+           {:pure-generators  true
+            :name             (str "garage " (name (:workload opts)))
+            :os               debian/os
+            :db               (grg/db garage-version)
+            :client           (:client workload)
+            :generator        (gen/phases
+                                (->>
+                                  (:generator workload)
+                                  (gen/stagger (/ (:rate opts)))
+                                  (gen/nemesis
+                                    (cycle [(gen/sleep 5)
+                                            {:type :info, :f :start}
+                                            (gen/sleep 5)
+                                            {:type :info, :f :stop}]))
+                                  (gen/time-limit (:time-limit opts)))
+                                (gen/log "Healing cluster")
+                                (gen/nemesis (gen/once {:type :info, :f :stop}))
+                                (gen/log "Waiting for recovery")
+                                (gen/sleep 10)
+                                (gen/clients (:final-generator workload)))
+            :nemesis          (nemesis/partition-random-halves)
+            :checker          (checker/compose
+                                {:perf (checker/perf)
+                                 :workload (:checker workload)})
+            })))
+
+
+(defn -main
+  "Handles command line arguments. Can either run a test, or a web server for
+  browsing results."
+  [& args]
+  (cli/run! (merge (cli/single-test-cmd {:test-fn garage-test
+                                         :opt-spec cli-opts})
+                   (cli/serve-cmd))
+            args))

script/jepsen.garage/src/jepsen/garage/grg.clj

@@ -0,0 +1,135 @@
+(ns jepsen.garage.grg
+  (:require [clojure.tools.logging :refer :all]
+            [jepsen [control :as c]
+             [db :as db]]
+            [jepsen.control.util :as cu]
+            [amazonica.aws.s3 :as s3]
+            [slingshot.slingshot :refer [try+]]))
+
+; CONSTANTS -- HOW GARAGE IS SET UP
+
+(def dir "/opt/garage")
+(def binary (str dir "/garage"))
+(def logfile (str dir "/garage.log"))
+(def pidfile (str dir "/garage.pid"))
+
+(def grg-admin-token "icanhazadmin")
+(def grg-key "jepsen")
+(def grg-bucket "jepsen")
+
+; THE GARAGE DB
+
+(defn db
+  "Garage DB for a particular version"
+  [version]
+  (reify db/DB
+    (setup! [_ test node]
+      (info node "installing garage" version)
+      (c/su
+        (c/exec :mkdir :-p dir)
+        (let [url (str "https://garagehq.deuxfleurs.fr/_releases/" version "/x86_64-unknown-linux-musl/garage")
+              cache (cu/wget! url)]
+          (c/exec :cp cache binary))
+        (c/exec :chmod :+x binary)
+        (cu/write-file!
+          (str "rpc_secret = \"0fffabe52542c2b89a56b2efb7dfd477e9dafb285c9025cbdf1de7ca21a6b372\"\n"
+               "rpc_bind_addr = \"0.0.0.0:3901\"\n"
+               "rpc_public_addr = \"" node ":3901\"\n"
+               "db_engine = \"lmdb\"\n"
+               "replication_mode = \"3\"\n"
+               "data_dir = \"" dir "/data\"\n"
+               "metadata_dir = \"" dir "/meta\"\n"
+               "[s3_api]\n"
+               "s3_region = \"us-east-1\"\n"
+               "api_bind_addr = \"0.0.0.0:3900\"\n"
+               "[k2v_api]\n"
+               "api_bind_addr = \"0.0.0.0:3902\"\n"
+               "[admin]\n"
+               "api_bind_addr = \"0.0.0.0:3903\"\n"
+               "admin_token = \"" grg-admin-token "\"\n")
+          "/etc/garage.toml")
+        (cu/start-daemon!
+          {:logfile logfile
+           :pidfile pidfile
+           :chdir dir}
+          binary
+          :server)
+        (Thread/sleep 100)
+        (let [node-id (c/exec binary :node :id :-q)]
+          (info node "node id:" node-id)
+          (c/on-many (:nodes test)
+                     (c/exec binary :node :connect node-id))
+          (c/exec binary :layout :assign (subs node-id 0 16) :-c 1 :-z :dc1 :-t node))
+        (if (= node (first (:nodes test)))
+          (do
+            (Thread/sleep 2000)
+            (c/exec binary :layout :apply :--version 1)
+            (info node "garage status:" (c/exec binary :status))
+            (c/exec binary :key :new :--name grg-key)
+            (c/exec binary :bucket :create grg-bucket)
+            (c/exec binary :bucket :allow :--read :--write grg-bucket :--key grg-key)
+            (info node "key info: " (c/exec binary :key :info grg-key))))))
+    (teardown! [_ test node]
+      (info node "tearing down garage" version)
+      (c/su
+        (cu/stop-daemon! binary pidfile)
+        (c/exec :rm :-rf dir)))
+    db/LogFiles
+    (log-files [_ test node]
+      [logfile])))
+
+; GARAGE S3 HELPER FUNCTIONS
+
+(defn s3-creds
+  "Get S3 credentials for node"
+  [node]
+  (let [key-info (c/on node (c/exec binary :key :info grg-key))
+        [_ ak sk] (re-matches
+                    #"(?s).*Key ID: (.*)\nSecret key: (.*)\nCan create.*"
+                    key-info)]
+    {:access-key ak
+     :secret-key sk
+     :endpoint (str "http://" node ":3900")
+     :bucket grg-bucket
+     :client-config {:path-style-access-enabled true}}))
+
+(defn s3-get
+  "Helper for GetObject"
+  [creds k]
+  (try+
+    (-> (s3/get-object creds (:bucket creds) k)
+        :input-stream
+        slurp)
+    (catch (re-find #"Key not found" (.getMessage %)) ex
+      nil)))
+
+(defn s3-put
+  "Helper for PutObject or DeleteObject (is a delete if value is nil)"
+  [creds k v]
+  (if (= v nil)
+    (s3/delete-object creds
+                      :bucket-name (:bucket creds)
+                      :key k)
+    (let [some-bytes (.getBytes v "UTF-8")
+          bytes-stream (java.io.ByteArrayInputStream. some-bytes)]
+      (s3/put-object creds
+                     :bucket-name (:bucket creds)
+                     :key k
+                     :input-stream bytes-stream
+                     :metadata {:content-length (count some-bytes)}))))
+
+(defn s3-list
+  "Helper for ListObjects -- just lists everything in the bucket"
+  [creds prefix]
+  (defn list-inner [ct accum]
+    (let [list-result (s3/list-objects-v2 creds
+                                          {:bucket-name (:bucket creds)
+                                           :prefix prefix
+                                           :continuation-token ct})
+          new-object-summaries (:object-summaries list-result)
+          new-objects (map (fn [d] (:key d)) new-object-summaries)
+          objects (concat new-objects accum)]
+      (if (:truncated? list-result)
+        (list-inner (:next-continuation-token list-result) objects)
+        objects)))
+  (list-inner nil []))

script/jepsen.garage/src/jepsen/garage/reg.clj

@@ -0,0 +1,62 @@
+(ns jepsen.garage.reg
+  (:require [clojure.tools.logging :refer :all]
+            [clojure.string :as str]
+            [jepsen [checker :as checker]
+             [cli :as cli]
+             [client :as client]
+             [control :as c]
+             [db :as db]
+             [generator :as gen]
+             [independent :as independent]
+             [nemesis :as nemesis]
+             [tests :as tests]]
+            [jepsen.checker.timeline :as timeline]
+            [jepsen.control.util :as cu]
+            [jepsen.os.debian :as debian]
+            [jepsen.garage.grg :as grg]
+            [knossos.model :as model]
+            [slingshot.slingshot :refer [try+]]))
+
+(defn op-get [_ _] {:type :invoke, :f :read, :value nil})
+(defn op-put [_ _] {:type :invoke, :f :write, :value (str (rand-int 9))})
+(defn op-del [_ _] {:type :invoke, :f :write, :value nil})
+
+(defrecord RegClient [creds]
+  client/Client
+  (open! [this test node]
+    (let [creds (grg/s3-creds node)]
+      (info node "s3 credentials:" creds)
+      (assoc this :creds creds)))
+  (setup! [this test])
+  (invoke! [this test op]
+    (let [[k v] (:value op)]
+      (case (:f op)
+        :read
+          (let [value (grg/s3-get (:creds this) k)]
+            (assoc op :type :ok, :value (independent/tuple k value)))
+        :write
+          (do
+            (grg/s3-put (:creds this) k v)
+            (assoc op :type :ok)))))
+  (teardown! [this test])
+  (close! [this test]))
+
+(defn workload
+  "Tests linearizable reads and writes"
+  [opts]
+  {:client           (RegClient. nil)
+   :checker          (independent/checker
+                       (checker/compose
+                         {:linear (checker/linearizable
+                                    {:model     (model/register)
+                                     :algorithm :linear})
+                          :timeline (timeline/html)}))
+   :generator        (independent/concurrent-generator
+                       10
+                       (range)
+                       (fn [k]
+                         (->>
+                           (gen/mix [op-get op-put op-del])
+                           (gen/limit (:ops-per-key opts)))))})
+
+

script/jepsen.garage/src/jepsen/garage/set.clj

@@ -0,0 +1,114 @@
+(ns jepsen.garage.set
+  (:require [clojure.tools.logging :refer :all]
+            [clojure.string :as str]
+            [clojure.set :as set]
+            [jepsen [checker :as checker]
+             [cli :as cli]
+             [client :as client]
+             [control :as c]
+             [checker :as checker]
+             [db :as db]
+             [generator :as gen]
+             [independent :as independent]
+             [nemesis :as nemesis]
+             [tests :as tests]]
+            [jepsen.checker.timeline :as timeline]
+            [jepsen.control.util :as cu]
+            [jepsen.os.debian :as debian]
+            [jepsen.garage.grg :as grg]
+            [knossos.model :as model]
+            [slingshot.slingshot :refer [try+]]))
+
+(defn op-add-rand100 [_ _] {:type :invoke, :f :add, :value (rand-int 100)})
+(defn op-read [_ _] {:type :invoke, :f :read, :value nil})
+
+(defrecord SetClient [creds]
+  client/Client
+  (open! [this test node]
+    (let [creds (grg/s3-creds node)]
+      (info node "s3 credentials:" creds)
+      (assoc this :creds creds)))
+  (setup! [this test])
+  (invoke! [this test op]
+    (let [[k v] (:value op)
+          prefix (str "set" k "/")]
+      (case (:f op)
+        :add
+          (do
+            (grg/s3-put (:creds this) (str prefix v) "present")
+            (assoc op :type :ok))
+        :read
+          (let [items (grg/s3-list (:creds this) prefix)
+                items-stripped (map (fn [o] (str/replace-first o prefix "")) items)
+                items-set (set (map read-string items-stripped))]
+            (assoc op :type :ok, :value (independent/tuple k items-set))))))
+  (teardown! [this test])
+  (close! [this test]))
+
+(defn set-read-after-write
+  "Read-after-Write checker for set operations"
+  []
+  (reify checker/Checker
+    (check [this test history opts]
+      (let [init {:add-started #{}
+                  :add-done #{}
+                  :read-must-contain {}
+                  :missed #{}
+                  :unexpected #{}}
+            final (reduce
+                    (fn [state op]
+                      (case [(:type op) (:f op)]
+                        ([:invoke :add])
+                          (assoc state :add-started (conj (:add-started state) (:value op)))
+                        ([:ok :add])
+                          (assoc state :add-done (conj (:add-done state) (:value op)))
+                        ([:invoke :read])
+                          (assoc-in state [:read-must-contain (:process op)] (:add-done state))
+                        ([:ok :read])
+                          (let [read-must-contain (get (:process op) (:read-must-contain state))
+                                new-missed (set/difference read-must-contain (:value op))
+                                new-unexpected (set/difference (:value op) (:add-started state))]
+                            (assoc state
+                                   :read-must-contain (dissoc (:read-must-contain state) (:process op))
+                                   :missed (set/union (:missed state) new-missed),
+                                   :unexpected (set/union (:unexpected state) new-unexpected)))
+                         state))
+                    init history)
+            valid? (and (empty? (:missed final)) (empty? (:unexpected final)))]
+        (assoc final :valid? valid?)))))
+
+(defn workload1
+  "Tests insertions and deletions"
+  [opts]
+  {:client            (SetClient. nil)
+   :checker           (independent/checker
+                        (checker/compose
+                          {:set (checker/set)
+                           :timeline (timeline/html)}))
+   :generator         (independent/concurrent-generator
+                        10
+                        (range 100)
+                        (fn [k]
+                          (->> (range)
+                           (map (fn [x] {:type :invoke, :f :add, :value x}))
+                           (gen/limit (:ops-per-key opts)))))
+   :final-generator   (independent/sequential-generator
+                        (range 100)
+                        (fn [k] (gen/once op-read)))})
+
+(defn workload2
+  "Tests insertions and deletions"
+  [opts]
+  {:client            (SetClient. nil)
+   :checker           (independent/checker
+                        (checker/compose
+                          {:set-full (checker/set-full {:linearizable? false})
+                           :set-read-after-write (set-read-after-write)
+                           :timeline (timeline/html)}))
+   :generator         (independent/concurrent-generator
+                        10
+                        (range)
+                        (fn [k]
+                          (gen/mix [op-add-rand100 op-read])))})
+
+

script/jepsen.garage/test/jepsen/garage_test.clj

@@ -0,0 +1,7 @@
+(ns jepsen.garage-test
+  (:require [clojure.test :refer :all]
+            [jepsen.garage :refer :all]))
+
+(deftest a-test
+  (testing "FIXME, I fail."
+    (is (= 0 1))))