mirror of
https://git.deuxfleurs.fr/Deuxfleurs/garage.git
synced 2024-11-21 15:41:02 +00:00
refactor jepsen code
This commit is contained in:
parent
84d43501ce
commit
ddd3de7fce
5 changed files with 83 additions and 77 deletions
|
@ -9,7 +9,7 @@
|
||||||
[tests :as tests]]
|
[tests :as tests]]
|
||||||
[jepsen.os.debian :as debian]
|
[jepsen.os.debian :as debian]
|
||||||
[jepsen.garage
|
[jepsen.garage
|
||||||
[grg :as grg]
|
[daemon :as grg]
|
||||||
[reg :as reg]
|
[reg :as reg]
|
||||||
[set :as set]]))
|
[set :as set]]))
|
||||||
|
|
||||||
|
|
|
@ -1,24 +1,22 @@
|
||||||
(ns jepsen.garage.grg
|
(ns jepsen.garage.daemon
|
||||||
(:require [clojure.tools.logging :refer :all]
|
(:require [clojure.tools.logging :refer :all]
|
||||||
[jepsen [control :as c]
|
[jepsen [control :as c]
|
||||||
[core :as jepsen]
|
[core :as jepsen]
|
||||||
[db :as db]]
|
[db :as db]]
|
||||||
[jepsen.control.util :as cu]
|
[jepsen.control.util :as cu]))
|
||||||
[amazonica.aws.s3 :as s3]
|
|
||||||
[slingshot.slingshot :refer [try+]]))
|
|
||||||
|
|
||||||
; CONSTANTS -- HOW GARAGE IS SET UP
|
; CONSTANTS -- HOW GARAGE IS SET UP
|
||||||
|
|
||||||
(def dir "/opt/garage")
|
(def base-dir "/opt/garage")
|
||||||
(def data-dir (str dir "/data"))
|
(def data-dir (str base-dir "/data"))
|
||||||
(def meta-dir (str dir "/meta"))
|
(def meta-dir (str base-dir "/meta"))
|
||||||
(def binary (str dir "/garage"))
|
(def binary (str base-dir "/garage"))
|
||||||
(def logfile (str dir "/garage.log"))
|
(def logfile (str base-dir "/garage.log"))
|
||||||
(def pidfile (str dir "/garage.pid"))
|
(def pidfile (str base-dir "/garage.pid"))
|
||||||
|
|
||||||
(def grg-admin-token "icanhazadmin")
|
(def admin-token "icanhazadmin")
|
||||||
(def grg-key "jepsen")
|
(def access-key "jepsen")
|
||||||
(def grg-bucket "jepsen")
|
(def bucket-name "jepsen")
|
||||||
|
|
||||||
; THE GARAGE DB
|
; THE GARAGE DB
|
||||||
|
|
||||||
|
@ -28,7 +26,7 @@
|
||||||
(c/su
|
(c/su
|
||||||
(c/trace
|
(c/trace
|
||||||
(info node "installing garage" version)
|
(info node "installing garage" version)
|
||||||
(c/exec :mkdir :-p dir)
|
(c/exec :mkdir :-p base-dir)
|
||||||
(let [url (str "https://garagehq.deuxfleurs.fr/_releases/" version "/x86_64-unknown-linux-musl/garage")
|
(let [url (str "https://garagehq.deuxfleurs.fr/_releases/" version "/x86_64-unknown-linux-musl/garage")
|
||||||
cache (cu/cached-wget! url)]
|
cache (cu/cached-wget! url)]
|
||||||
(c/exec :cp cache binary))
|
(c/exec :cp cache binary))
|
||||||
|
@ -45,8 +43,8 @@
|
||||||
"rpc_public_addr = \"" node ":3901\"\n"
|
"rpc_public_addr = \"" node ":3901\"\n"
|
||||||
"db_engine = \"lmdb\"\n"
|
"db_engine = \"lmdb\"\n"
|
||||||
"replication_mode = \"3\"\n"
|
"replication_mode = \"3\"\n"
|
||||||
"data_dir = \"" dir "/data\"\n"
|
"data_dir = \"" data-dir "\"\n"
|
||||||
"metadata_dir = \"" dir "/meta\"\n"
|
"metadata_dir = \"" meta-dir "\"\n"
|
||||||
"[s3_api]\n"
|
"[s3_api]\n"
|
||||||
"s3_region = \"us-east-1\"\n"
|
"s3_region = \"us-east-1\"\n"
|
||||||
"api_bind_addr = \"0.0.0.0:3900\"\n"
|
"api_bind_addr = \"0.0.0.0:3900\"\n"
|
||||||
|
@ -54,7 +52,7 @@
|
||||||
"api_bind_addr = \"0.0.0.0:3902\"\n"
|
"api_bind_addr = \"0.0.0.0:3902\"\n"
|
||||||
"[admin]\n"
|
"[admin]\n"
|
||||||
"api_bind_addr = \"0.0.0.0:3903\"\n"
|
"api_bind_addr = \"0.0.0.0:3903\"\n"
|
||||||
"admin_token = \"" grg-admin-token "\"\n")
|
"admin_token = \"" admin-token "\"\n")
|
||||||
"/etc/garage.toml"))))
|
"/etc/garage.toml"))))
|
||||||
|
|
||||||
(defn connect-node!
|
(defn connect-node!
|
||||||
|
@ -80,10 +78,10 @@
|
||||||
(c/trace
|
(c/trace
|
||||||
(c/exec binary :layout :apply :--version 1)
|
(c/exec binary :layout :apply :--version 1)
|
||||||
(info node "garage status:" (c/exec binary :status))
|
(info node "garage status:" (c/exec binary :status))
|
||||||
(c/exec binary :key :create grg-key)
|
(c/exec binary :key :create access-key)
|
||||||
(c/exec binary :bucket :create grg-bucket)
|
(c/exec binary :bucket :create bucket-name)
|
||||||
(c/exec binary :bucket :allow :--read :--write grg-bucket :--key grg-key)
|
(c/exec binary :bucket :allow :--read :--write bucket-name :--key access-key)
|
||||||
(info node "key info: " (c/exec binary :key :info grg-key))))
|
(info node "key info: " (c/exec binary :key :info access-key))))
|
||||||
|
|
||||||
(defn db
|
(defn db
|
||||||
"Garage DB for a particular version"
|
"Garage DB for a particular version"
|
||||||
|
@ -95,7 +93,7 @@
|
||||||
(cu/start-daemon!
|
(cu/start-daemon!
|
||||||
{:logfile logfile
|
{:logfile logfile
|
||||||
:pidfile pidfile
|
:pidfile pidfile
|
||||||
:chdir dir}
|
:chdir base-dir}
|
||||||
binary
|
binary
|
||||||
:server)
|
:server)
|
||||||
(c/exec :sleep 3)
|
(c/exec :sleep 3)
|
||||||
|
@ -121,58 +119,16 @@
|
||||||
(log-files [_ test node]
|
(log-files [_ test node]
|
||||||
[logfile])))
|
[logfile])))
|
||||||
|
|
||||||
; GARAGE S3 HELPER FUNCTIONS
|
(defn creds
|
||||||
|
"Obtain Garage credentials for node"
|
||||||
(defn s3-creds
|
|
||||||
"Get S3 credentials for node"
|
|
||||||
[node]
|
[node]
|
||||||
(let [key-info (c/on node (c/exec binary :key :info grg-key :--show-secret))
|
(let [key-info (c/on node (c/exec binary :key :info access-key :--show-secret))
|
||||||
[_ ak sk] (re-matches
|
[_ ak sk] (re-matches
|
||||||
#"(?s).*Key ID: (.*)\nSecret key: (.*)\nCan create.*"
|
#"(?s).*Key ID: (.*)\nSecret key: (.*)\nCan create.*"
|
||||||
key-info)]
|
key-info)]
|
||||||
{:access-key ak
|
{:access-key ak
|
||||||
:secret-key sk
|
:secret-key sk
|
||||||
:endpoint (str "http://" node ":3900")
|
:endpoint (str "http://" node ":3900")
|
||||||
:bucket grg-bucket
|
:bucket bucket-name
|
||||||
:client-config {:path-style-access-enabled true}}))
|
: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 []))
|
|
|
@ -13,7 +13,8 @@
|
||||||
[jepsen.checker.timeline :as timeline]
|
[jepsen.checker.timeline :as timeline]
|
||||||
[jepsen.control.util :as cu]
|
[jepsen.control.util :as cu]
|
||||||
[jepsen.os.debian :as debian]
|
[jepsen.os.debian :as debian]
|
||||||
[jepsen.garage.grg :as grg]
|
[jepsen.garage.daemon :as grg]
|
||||||
|
[jepsen.garage.s3api :as s3]
|
||||||
[knossos.model :as model]
|
[knossos.model :as model]
|
||||||
[slingshot.slingshot :refer [try+]]))
|
[slingshot.slingshot :refer [try+]]))
|
||||||
|
|
||||||
|
@ -24,7 +25,7 @@
|
||||||
(defrecord RegClient [creds]
|
(defrecord RegClient [creds]
|
||||||
client/Client
|
client/Client
|
||||||
(open! [this test node]
|
(open! [this test node]
|
||||||
(let [creds (grg/s3-creds node)]
|
(let [creds (grg/creds node)]
|
||||||
(info node "s3 credentials:" creds)
|
(info node "s3 credentials:" creds)
|
||||||
(assoc this :creds creds)))
|
(assoc this :creds creds)))
|
||||||
(setup! [this test])
|
(setup! [this test])
|
||||||
|
@ -32,11 +33,11 @@
|
||||||
(let [[k v] (:value op)]
|
(let [[k v] (:value op)]
|
||||||
(case (:f op)
|
(case (:f op)
|
||||||
:read
|
:read
|
||||||
(let [value (grg/s3-get (:creds this) k)]
|
(let [value (s3/get (:creds this) k)]
|
||||||
(assoc op :type :ok, :value (independent/tuple k value)))
|
(assoc op :type :ok, :value (independent/tuple k value)))
|
||||||
:write
|
:write
|
||||||
(do
|
(do
|
||||||
(grg/s3-put (:creds this) k v)
|
(s3/put (:creds this) k v)
|
||||||
(assoc op :type :ok)))))
|
(assoc op :type :ok)))))
|
||||||
(teardown! [this test])
|
(teardown! [this test])
|
||||||
(close! [this test]))
|
(close! [this test]))
|
||||||
|
|
48
script/jepsen.garage/src/jepsen/garage/s3api.clj
Normal file
48
script/jepsen.garage/src/jepsen/garage/s3api.clj
Normal file
|
@ -0,0 +1,48 @@
|
||||||
|
(ns jepsen.garage.s3api
|
||||||
|
(:require [clojure.tools.logging :refer :all]
|
||||||
|
[jepsen [control :as c]]
|
||||||
|
[amazonica.aws.s3 :as s3]
|
||||||
|
[slingshot.slingshot :refer [try+]]))
|
||||||
|
|
||||||
|
; GARAGE S3 HELPER FUNCTIONS
|
||||||
|
|
||||||
|
(defn 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 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 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 []))
|
|
@ -15,7 +15,8 @@
|
||||||
[jepsen.checker.timeline :as timeline]
|
[jepsen.checker.timeline :as timeline]
|
||||||
[jepsen.control.util :as cu]
|
[jepsen.control.util :as cu]
|
||||||
[jepsen.os.debian :as debian]
|
[jepsen.os.debian :as debian]
|
||||||
[jepsen.garage.grg :as grg]
|
[jepsen.garage.daemon :as grg]
|
||||||
|
[jepsen.garage.s3api :as s3]
|
||||||
[knossos.model :as model]
|
[knossos.model :as model]
|
||||||
[slingshot.slingshot :refer [try+]]))
|
[slingshot.slingshot :refer [try+]]))
|
||||||
|
|
||||||
|
@ -25,7 +26,7 @@
|
||||||
(defrecord SetClient [creds]
|
(defrecord SetClient [creds]
|
||||||
client/Client
|
client/Client
|
||||||
(open! [this test node]
|
(open! [this test node]
|
||||||
(let [creds (grg/s3-creds node)]
|
(let [creds (grg/creds node)]
|
||||||
(info node "s3 credentials:" creds)
|
(info node "s3 credentials:" creds)
|
||||||
(assoc this :creds creds)))
|
(assoc this :creds creds)))
|
||||||
(setup! [this test])
|
(setup! [this test])
|
||||||
|
@ -35,10 +36,10 @@
|
||||||
(case (:f op)
|
(case (:f op)
|
||||||
:add
|
:add
|
||||||
(do
|
(do
|
||||||
(grg/s3-put (:creds this) (str prefix v) "present")
|
(s3/put (:creds this) (str prefix v) "present")
|
||||||
(assoc op :type :ok))
|
(assoc op :type :ok))
|
||||||
:read
|
:read
|
||||||
(let [items (grg/s3-list (:creds this) prefix)
|
(let [items (s3/list (:creds this) prefix)
|
||||||
items-stripped (map (fn [o] (str/replace-first o prefix "")) items)
|
items-stripped (map (fn [o] (str/replace-first o prefix "")) items)
|
||||||
items-set (set (map read-string items-stripped))]
|
items-set (set (map read-string items-stripped))]
|
||||||
(assoc op :type :ok, :value (independent/tuple k items-set))))))
|
(assoc op :type :ok, :value (independent/tuple k items-set))))))
|
||||||
|
|
Loading…
Reference in a new issue