├── .gitignore ├── .hook.yaml ├── .travis-ci.sh ├── .travis.yml ├── .travis ├── ssh_config ├── travis_rsa.enc └── travis_rsa.pub ├── Capfile ├── LICENSE ├── Makefile ├── Makefile.detect-coq-version ├── README.md ├── build.sh ├── chord-serialized.install ├── chord-serialized.opam ├── chord.install ├── chord.opam ├── config ├── deploy.rb └── deploy │ ├── production.rb │ └── staging.rb ├── configure ├── core └── DynamicNet.v ├── deps ├── Dependencies.v ├── admit_analysis.md ├── all_used_admits.txt ├── chord_all_names.txt ├── dpdunused.txt ├── mkdeps.sh ├── stabilization_admits.txt ├── stabilization_names.txt └── unused.txt ├── doc ├── FILES.md ├── PROOF_ENGINEERING.md ├── QUESTIONS.md ├── STYLE.md ├── implementing-zave-chord.md ├── phase-three.md ├── phase-two.md └── tom-chord.md ├── extraction ├── chord-serialized │ ├── .gitignore │ ├── Makefile │ ├── _tags │ ├── coq │ │ └── ExtractChordSerialized.v │ ├── ml │ │ ├── ChordSerializedArrangement.ml │ │ ├── ChordUtil.ml │ │ ├── chordserialized.ml │ │ └── client.ml │ └── scripts │ │ ├── demo.py │ │ └── remove_module.pl └── chord │ ├── .gitignore │ ├── Makefile │ ├── _tags │ ├── coq │ └── ExtractChord.v │ ├── ml │ ├── ChordArrangement.ml │ ├── ChordUtil.ml │ ├── chord.ml │ └── client.ml │ └── scripts │ ├── demo.py │ ├── experiment_3.sh │ ├── head.json.oddity │ ├── oddity.sh │ └── tail.json.oddity ├── lib ├── Bitvectors.v ├── IDSpace.v ├── InfSeqTactics.v ├── Sorting.v └── capistrano │ └── tasks │ ├── chord.rake │ ├── chord_java.rake │ ├── chord_serialized.rake │ └── compilation.rake ├── proofalytics ├── .gitignore ├── Makefile ├── admits-links.awk ├── build-timer.sh ├── build-times-links.awk ├── csv-sort.awk ├── csv-table.awk ├── mkreport.sh ├── plot.sh ├── proof-linter.sh ├── proof-sizes-links.awk ├── proof-sizes.awk ├── proof-time-annot.awk ├── proof-timer.sh ├── proof-times-csv.awk ├── proof-times-links.awk ├── publish.sh ├── timestamp-lines.awk └── timestamp-lines.c ├── script ├── checkpaths.sh ├── coqproject.sh ├── extract_record_notation.py ├── find-bad-imports.sh ├── find-unused-imports.sh ├── orphaned-imports.awk └── time-coqc.sh ├── systems ├── chord-props │ ├── DeadNodesGoQuiet.v │ ├── FirstSuccNeverSelf.v │ ├── HashInjective.v │ ├── LiveNodeHasTickInTimeouts.v │ ├── LiveNodeInSuccLists.v │ ├── LiveNodePreservation.v │ ├── LiveNodesNotClients.v │ ├── LiveNodesStayLive.v │ ├── NodesAlwaysHaveLiveSuccs.v │ ├── NodesHaveState.v │ ├── NodesNotJoinedHaveNoSuccessors.v │ ├── PredNeverSelfInvariant.v │ ├── PtrCorrectInvariant.v │ ├── QueriesEventuallyStop.v │ ├── QueriesEventuallyStopMeasure.v │ ├── QueryInvariant.v │ ├── QueryTargetsJoined.v │ ├── RingCorrect.v │ ├── StabilizeOnlyWithFirstSucc.v │ ├── SuccessorNodesAlwaysValid.v │ ├── TickInvariant.v │ ├── TimeoutMeansActive.v │ ├── ValidPointersInvariant.v │ └── WfPtrSuccListInvariant.v ├── chord-serialized │ ├── ChordSerialized.v │ ├── ChordSerializedCorrect.v │ ├── ChordSerializedCorrectPhaseOne.v │ └── ChordSerializedSimulations.v ├── chord-util │ ├── ChannelLemmas.v │ ├── HandlerLemmas.v │ ├── LabeledLemmas.v │ ├── LabeledMeasures.v │ ├── PairIn.v │ ├── SystemLemmas.v │ ├── SystemPointers.v │ └── SystemReachable.v ├── chord │ ├── Chord.v │ └── ChordCorrectPhaseOne.v └── chordpy │ ├── README.md │ ├── data.py │ ├── demo.py │ ├── net.py │ ├── node.py │ └── report.py ├── verdi-chord-checkproofs.opam ├── verdi-chord.opam ├── words10.txt ├── words100.txt └── words50.txt /.gitignore: -------------------------------------------------------------------------------- 1 | *.vo 2 | *.glob 3 | *.v.d 4 | *.buildtime 5 | _CoqProject 6 | _CoqProject.tmp 7 | Makefile.coq 8 | Makefile.coq.bak 9 | Makefile.coq.conf 10 | log 11 | *~ 12 | .coq-native/ 13 | *.aux 14 | *.vio 15 | *.pyc 16 | .vagrant 17 | .coqdeps.d 18 | deps/*.dpd 19 | deps/*.dot 20 | deps/*.svg 21 | -------------------------------------------------------------------------------- /.hook.yaml: -------------------------------------------------------------------------------- 1 | deploy: ./build.sh -------------------------------------------------------------------------------- /.travis-ci.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | set -ev 4 | 5 | export MODE=$1 6 | 7 | eval $(opam config env) 8 | opam update 9 | 10 | case ${MODE} in 11 | proofalytics) 12 | opam pin add verdi-chord . --yes --verbose --no-action 13 | opam install verdi-chord --yes --verbose --deps-only 14 | ./configure 15 | make proofalytics & 16 | # Output to the screen intermittently to prevent a Travis timeout 17 | export PID=$! 18 | while [[ `ps -p $PID | tail -n +2` ]]; do 19 | echo 'proofalyzing...' 20 | sleep 10 21 | done 22 | ;; 23 | chord) 24 | opam pin add chord . --yes --verbose 25 | ;; 26 | chord-serialized) 27 | opam pin add chord-serialized . --yes --verbose 28 | ;; 29 | *) 30 | opam pin add verdi-chord . --yes --verbose 31 | ;; 32 | esac 33 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: generic 2 | 3 | services: 4 | - docker 5 | 6 | env: 7 | global: 8 | - THIS_REPO=verdi-chord 9 | matrix: 10 | - MODE=build COQ_VERSION=coq8.8-32bit 11 | - MODE=chord COQ_VERSION=coq8.8 12 | - MODE=chord-serialized COQ_VERSION=coq8.8 13 | 14 | # The "docker run" command will pull if needed. 15 | # Running this first gives two tries in case of network lossage. 16 | before_script: 17 | - timeout 5m docker pull palmskog/xenial-for-verdi-$COQ_VERSION || true 18 | 19 | # Using travis_wait here seems to cause the job to terminate after 1 minute 20 | # with no error (!). 21 | # The git commands are tried twice, in case of temporary network failure. 22 | # The fcntl line works around a bug where Travis truncates logs and fails. 23 | script: 24 | - python -c "import fcntl; fcntl.fcntl(1, fcntl.F_SETFL, 0)" 25 | - REMOTE_ORIGIN_URL=`git config --get remote.origin.url` 26 | - echo "THIS_REPO=${THIS_REPO}" 27 | - echo "COQ_VERSION=${COQ_VERSION}" 28 | - echo "MODE=${MODE}" 29 | - echo "TRAVIS_BRANCH=${TRAVIS_BRANCH}" 30 | - echo "REMOTE_ORIGIN_URL=${REMOTE_ORIGIN_URL}" 31 | - echo "TRAVIS_EVENT_TYPE=${TRAVIS_EVENT_TYPE}" 32 | - echo "TRAVIS_COMMIT=${TRAVIS_COMMIT}" 33 | - echo "TRAVIS_PULL_REQUEST=${TRAVIS_PULL_REQUEST}" 34 | - echo "TRAVIS_PULL_REQUEST_BRANCH=${TRAVIS_PULL_REQUEST_BRANCH}" 35 | - echo "TRAVIS_PULL_REQUEST_SHA=${TRAVIS_PULL_REQUEST_SHA}" 36 | - echo "TRAVIS_REPO_SLUG=${TRAVIS_REPO_SLUG}" 37 | - >- 38 | docker run palmskog/xenial-for-verdi-$COQ_VERSION /bin/bash -c "true && 39 | if [ $TRAVIS_EVENT_TYPE = pull_request ] ; then 40 | git clone --quiet --depth 9 $REMOTE_ORIGIN_URL $THIS_REPO || git clone --quiet --depth 9 $REMOTE_ORIGIN_URL $THIS_REPO 41 | cd $THIS_REPO 42 | git fetch origin +refs/pull/$TRAVIS_PULL_REQUEST/merge 43 | git checkout -qf $TRAVIS_PULL_REQUEST_SHA 44 | git config user.email noone@cares.com 45 | git config user.name Noone Cares 46 | git remote add theupstream https://github.com/$TRAVIS_REPO_SLUG.git 47 | git pull --depth 9 theupstream $TRAVIS_BRANCH || git pull --depth 9 theupstream $TRAVIS_BRANCH 48 | else 49 | git clone --quiet --depth 9 -b $TRAVIS_BRANCH $REMOTE_ORIGIN_URL $THIS_REPO || git clone --quiet --depth 9 -b $TRAVIS_BRANCH $REMOTE_ORIGIN_URL $THIS_REPO 50 | cd $THIS_REPO 51 | git checkout -qf $TRAVIS_COMMIT 52 | fi && 53 | openssl aes-256-cbc -K $encrypted_de10e8586561_key -iv $encrypted_de10e8586561_iv -in .travis/travis_rsa.enc -out .travis/travis_rsa -d && 54 | mkdir -p ~/.ssh && 55 | cp .travis/travis_rsa ~/.ssh && 56 | chmod 600 ~/.ssh/travis_rsa && 57 | cp .travis/ssh_config ~/.ssh/config && 58 | ./.travis-ci.sh $MODE" 59 | 60 | git: 61 | depth: 9 62 | 63 | notifications: 64 | slack: 65 | on_start: always 66 | rooms: 67 | - secure: zYqwI+++pjzZBHDjzIq8vmVUEYVHGxitauxDWLHz2FpqAGhrYrlhYeStkMMTOXHgz5I6W9r1Que0TRBl5nQ/RJ3cqaEHZnJHbKRBHn6V5iE09c2YkQzdECqIN7VNfVQ2vmYffx3ro22IvJZEJgi65NWkb8yqQJ5gvXry82+uUFb8d2pxzkmNk5lLPswzvujXPouVmSCdWzpLILaT+Pv5Z+nmKAW/7DXIyjpttZPo8E1nalhGBz6gPkRi8szV9OrhhTJ46rtjfGPxwtZBc8hFTYjrAHGmegPTcNurUlBXLsOGNEeCZ5hzoZO9c9h4FichnVUHJBG1MMLVst4Tm0JsD/YTsjq2o2osoMmACwdvVTNFJZac1vwmVhV2y3F0CT5YUNvifHyOivrnD/8l+ph3MJ7Sh5cAQI66FRt4zg7HxPYn/MrinhewDIHqgHWSl9deq7p2glHe/kYzds8/mYbpxYY9xrl7arJuXUw2f0U3dcuV7c9Dk2vrhPCFOQU2F6yxmRiJzyKNDh0Sy/j+Ps218rtlkbvLwnwnll/9y8vh9uit7WnHEKdESUQf2GbDbWIp2Gqmb8EbunFIrMi9AisfpJxN4tJ7f4UNFkdnQQtn4RZH9gJTf6Mk27PQXb+vyCpzJisE5NEYBN5PwJSLTD3rjAwFWG5O8ubXRwiR9Q4qIDw= 68 | -------------------------------------------------------------------------------- /.travis/ssh_config: -------------------------------------------------------------------------------- 1 | Host uwplse.org 2 | User uwplse 3 | IdentityFile ~/.ssh/travis_rsa 4 | StrictHostKeyChecking no 5 | CheckHostIP no 6 | PasswordAuthentication no 7 | -------------------------------------------------------------------------------- /.travis/travis_rsa.enc: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DistributedComponents/verdi-chord/762fe660c648d7f2a009d2beaa5cf3b8ea4ac593/.travis/travis_rsa.enc -------------------------------------------------------------------------------- /.travis/travis_rsa.pub: -------------------------------------------------------------------------------- 1 | ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQCi/qtoSS+8arcmqQaCTKO+MbmMzU4HdikZzMxJHFR8t/wooZZKlaUYh2nFGWm5rqQH27cNUjkgPoVa2lLRWdLhkWEZ3B98SpSceUNp/uWGRLmXHSZKa39J7DDIItfyaWqx66bLR4MwF32LgG5cr6vsBtNO88Q2loYyvDWQOAZIKz5M5kDL9tRV4KapAWhWwBEj031bYzqCzPV3cRG5Q8zU5oocV9+YEjYi0npM0HvEXTwzrV+VwNp+oD/eiURX+iFVj1xDeuuhHmbYQy8PUSQsdQw+bXiJEEHPzZW9v9iOjiTCkTl/OF85HFNu/F+Edcy4gLn2VhplmiBxVTeC5+oT dwoos@macreg14158.dyn.cs.washington.edu 2 | -------------------------------------------------------------------------------- /Capfile: -------------------------------------------------------------------------------- 1 | # Load DSL and set up stages 2 | require "capistrano/setup" 3 | 4 | # Include default deployment tasks 5 | require "capistrano/deploy" 6 | 7 | # Load the SCM plugin appropriate to your project: 8 | # 9 | # require "capistrano/scm/hg" 10 | # install_plugin Capistrano::SCM::Hg 11 | # or 12 | # require "capistrano/scm/svn" 13 | # install_plugin Capistrano::SCM::Svn 14 | # or 15 | require "capistrano/scm/git" 16 | install_plugin Capistrano::SCM::Git 17 | 18 | # Include tasks from other gems included in your Gemfile 19 | # 20 | # For documentation on these, see for example: 21 | # 22 | # https://github.com/capistrano/rvm 23 | # https://github.com/capistrano/rbenv 24 | # https://github.com/capistrano/chruby 25 | # https://github.com/capistrano/bundler 26 | # https://github.com/capistrano/rails 27 | # https://github.com/capistrano/passenger 28 | # 29 | # require "capistrano/rvm" 30 | # require "capistrano/rbenv" 31 | # require "capistrano/chruby" 32 | # require "capistrano/bundler" 33 | # require "capistrano/rails/assets" 34 | # require "capistrano/rails/migrations" 35 | # require "capistrano/passenger" 36 | require "capistrano/console" 37 | 38 | # Load custom tasks from `lib/capistrano/tasks` if you have any defined 39 | Dir.glob("lib/capistrano/tasks/*.rake").each { |r| import r } 40 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2014-2015, Verdi Team 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions are 6 | met: 7 | 8 | 1. Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | 2. Redistributions in binary form must reproduce the above copyright 12 | notice, this list of conditions and the following disclaimer in the 13 | documentation and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 16 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 17 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 18 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 19 | HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 20 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 21 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 22 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 23 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 24 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 25 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | include Makefile.detect-coq-version 2 | 3 | ifeq (,$(filter $(COQVERSION),8.6 8.7 8.8 8.9 trunk)) 4 | $(error "Verdi Chord is only compatible with Coq version 8.6.1 or later") 5 | endif 6 | 7 | COQPROJECT_EXISTS=$(wildcard _CoqProject) 8 | ifeq "$(COQPROJECT_EXISTS)" "" 9 | $(error "Run ./configure before running make") 10 | endif 11 | 12 | CHECKPATH := $(shell ./script/checkpaths.sh) 13 | 14 | ifneq ("$(CHECKPATH)","") 15 | $(info $(CHECKPATH)) 16 | $(warning checkpath reported an error) 17 | endif 18 | 19 | MLFILES = extraction/chord/coq/ExtractedChord.ml extraction/chord/coq/ExtractedChord.mli 20 | SERIALIZEDMLFILES = extraction/chord-serialized/coq/ExtractedChordSerialized.ml extraction/chord-serialized/coq/ExtractedChordSerialized.mli 21 | 22 | default: Makefile.coq 23 | $(MAKE) -f Makefile.coq 24 | 25 | quick: Makefile.coq 26 | $(MAKE) -f Makefile.coq quick 27 | 28 | checkproofs: quick 29 | $(MAKE) -f Makefile.coq checkproofs 30 | 31 | proofalytics: 32 | $(MAKE) -C proofalytics clean 33 | $(MAKE) -C proofalytics 34 | $(MAKE) -C proofalytics publish 35 | 36 | STDBUF=$(shell [ -x "$$(which gstdbuf)" ] && echo "gstdbuf" || echo "stdbuf") 37 | BUILDTIMER=$(PWD)/proofalytics/build-timer.sh $(STDBUF) -i0 -o0 38 | 39 | proofalytics-aux: Makefile.coq 40 | $(MAKE) -f Makefile.coq TIMECMD="$(BUILDTIMER)" 41 | 42 | Makefile.coq: _CoqProject 43 | coq_makefile -f _CoqProject -o Makefile.coq -install none \ 44 | -extra '$(MLFILES)' \ 45 | 'extraction/chord/coq/ExtractChord.v systems/chord/Chord.vo' \ 46 | '$$(COQC) $$(COQDEBUG) $$(COQFLAGS) extraction/chord/coq/ExtractChord.v' \ 47 | -extra '$(SERIALIZEDMLFILES)' \ 48 | 'extraction/chord-serialized/coq/ExtractChordSerialized.v systems/chord-serialized/ChordSerialized.vo' \ 49 | '$$(COQC) $$(COQDEBUG) $$(COQFLAGS) extraction/chord-serialized/coq/ExtractChordSerialized.v' 50 | 51 | 52 | clean: 53 | if [ -f Makefile.coq ]; then \ 54 | $(MAKE) -f Makefile.coq cleanall; fi 55 | rm -f Makefile.coq 56 | $(MAKE) -C extraction/chord clean 57 | $(MAKE) -C extraction/chord-serialized clean 58 | $(MAKE) -C proofalytics clean 59 | 60 | chord: 61 | +$(MAKE) -C extraction/chord chord.native client.native 62 | 63 | chord-serialized: 64 | +$(MAKE) -C extraction/chord-serialized chordserialized.native client.native 65 | 66 | $(MLFILES) $(SERIALIZEDMLFILES): Makefile.coq 67 | $(MAKE) -f Makefile.coq $@ 68 | 69 | lint: 70 | @echo "Possible use of hypothesis names:" 71 | find . -name '*.v' -exec grep -Hn 'H[0-9][0-9]*' {} \; 72 | 73 | distclean: clean 74 | rm -f _CoqProject 75 | 76 | .PHONY: default quick checkproofs clean lint distclean chord $(MLFILES) $(SERIALIZEDMLFILES) proofalytics proofalytics-aux 77 | 78 | .NOTPARALLEL: $(MLFILES) 79 | .NOTPARALLEL: $(SERIALIZEDMLFILES) 80 | -------------------------------------------------------------------------------- /Makefile.detect-coq-version: -------------------------------------------------------------------------------- 1 | COQVERSION = $(shell $(COQBIN)coqtop -v | head -1 | grep -E '(trunk|master)' | wc -l | sed 's/ *//g') 2 | 3 | ifneq "$(COQVERSION)" "0" 4 | COQVERSION = trunk 5 | else 6 | COQVERSION = $(shell $(COQBIN)coqtop -v | head -1 | sed 's/.*version \([0-9]\.[0-9]\)[^ ]* .*/\1/') 7 | endif 8 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Verdi Chord 2 | =========== 3 | 4 | [![Build Status](https://api.travis-ci.org/DistributedComponents/verdi-chord.svg?branch=master)](https://travis-ci.org/DistributedComponents/verdi-chord) 5 | 6 | An implementation of the Chord distributed lookup protocol in Coq using [the 7 | Verdi framework](http://verdi.uwplse.org/). 8 | 9 | Requirements 10 | ------------ 11 | 12 | Definitions and proofs: 13 | 14 | - [`Coq 8.7`](https://coq.inria.fr/coq-87) or [`Coq 8.8`](https://github.com/coq/coq/releases/tag/V8.8.1) 15 | - [`Mathematical Components 1.6 or 1.7`](http://math-comp.github.io/math-comp/) (`ssreflect`) 16 | - [`Verdi`](https://github.com/uwplse/verdi) 17 | - [`StructTact`](https://github.com/uwplse/StructTact) 18 | - [`InfSeqExt`](https://github.com/DistributedComponents/InfSeqExt) 19 | - [`Cheerios`](https://github.com/uwplse/cheerios) 20 | 21 | Executable code: 22 | 23 | - [`OCaml 4.02.3`](https://ocaml.org/docs/install.html) (or later) 24 | - [`OCamlbuild`](https://github.com/ocaml/ocamlbuild) 25 | - [`verdi-runtime`](https://github.com/DistributedComponents/verdi-runtime) 26 | - [`cheerios-runtime`](https://github.com/uwplse/cheerios) 27 | 28 | Building 29 | -------- 30 | 31 | We recommend installing the dependencies of Verdi Chord via 32 | [OPAM](http://opam.ocaml.org/doc/Install.html): 33 | 34 | ``` 35 | opam repo add coq-released https://coq.inria.fr/opam/released 36 | opam repo add distributedcomponents-dev http://opam-dev.distributedcomponents.net 37 | opam install coq-mathcomp-ssreflect verdi StructTact InfSeqExt cheerios 38 | ``` 39 | 40 | Then, run `./configure` in the root directory, and then run `make`. 41 | 42 | By default, the scripts look for `StructTact`, `InfSeqExt`, and `Verdi` in 43 | Coq's `user-contrib` directory, but this can be overridden by setting the 44 | `StructTact_PATH`, `InfSeqExt_PATH`, and `Verdi_PATH` environment variables. For 45 | example, the following shell command will build Chord using a copy of StructTact 46 | located in `../StructTact`. 47 | 48 | ``` 49 | StructTact_PATH=../StructTact ./build.sh 50 | ``` 51 | 52 | Running `chord` on a real network 53 | --------------------------------- 54 | 55 | First, be sure to install the specific dependencies for executable code; we recommend doing this via OPAM: 56 | ``` 57 | opam install ocamlbuild verdi-runtime cheerios-runtime 58 | ``` 59 | 60 | Then, execute `make chord` from the root of this repository. This will produce 61 | the executables `chord.native` and `client.native` in `./extraction/chord`. 62 | To start a ring of `n` nodes, run the following command: 63 | ``` 64 | extraction/chord/scripts/demo.py n 65 | ``` 66 | 67 | If you have a running node *N* at `127.0.0.2:6000` and no node at `127.0.0.1`, you can 68 | query *N* with `client.native` as follows. 69 | ``` 70 | client.native -bind 127.0.0.1 -node 127.0.0.2:6000 -query get_ptrs 71 | ``` 72 | This will print out the predecessor and successor pointers of *N*. The following 73 | query will ask *N* for its successor closest to the ID `md5("rdoenges")`. 74 | ``` 75 | client.native -bind 127.0.0.1 -node 127.0.0.2:6000 -query lookup 66e3ec3f16c5a8071d00b917ce3cc992 76 | ``` 77 | -------------------------------------------------------------------------------- /build.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | ./configure 3 | time make -k -j 3 "$@" 4 | -------------------------------------------------------------------------------- /chord-serialized.install: -------------------------------------------------------------------------------- 1 | bin: [ "extraction/chord-serialized/_build/ml/chordserialized.native" {"chord-serialized-server"} 2 | "extraction/chord-serialized/_build/ml/client.native" {"chord-serialized-client"} ] 3 | -------------------------------------------------------------------------------- /chord-serialized.opam: -------------------------------------------------------------------------------- 1 | opam-version: "1.2" 2 | version: "dev" 3 | maintainer: "palmskog@gmail.com" 4 | 5 | homepage: "https://github.com/DistributedComponents/verdi-chord" 6 | dev-repo: "https://github.com/DistributedComponents/verdi-chord.git" 7 | bug-reports: "https://github.com/DistributedComponents/verdi-chord/issues" 8 | license: "BSD" 9 | 10 | build: [ 11 | [ "./configure" ] 12 | [ make "-j%{jobs}%" "chord-serialized" ] 13 | ] 14 | available: [ ocaml-version >= "4.02.3" ] 15 | depends: [ 16 | "coq" {>= "8.7" & < "8.9~"} 17 | "coq-mathcomp-ssreflect" {>= "1.6" & < "1.8~"} 18 | "verdi" {= "dev"} 19 | "StructTact" {= "dev"} 20 | "InfSeqExt" {= "dev"} 21 | "verdi-runtime" {= "dev"} 22 | "cheerios" {= "dev"} 23 | "cheerios-runtime" {= "dev"} 24 | "ocamlbuild" {build} 25 | "yojson" {>= "1.4.1"} 26 | ] 27 | 28 | authors: [ 29 | "Ryan Doenges <>" 30 | "Doug Woos <>" 31 | "Karl Palmskog <>" 32 | "Zachary Tatlock <>" 33 | "James Wilcox <>" 34 | "Justin Adsuara <>" 35 | ] 36 | -------------------------------------------------------------------------------- /chord.install: -------------------------------------------------------------------------------- 1 | bin: [ "extraction/chord/_build/ml/chord.native" {"chord-server"} 2 | "extraction/chord/_build/ml/client.native" {"chord-client"} ] 3 | -------------------------------------------------------------------------------- /chord.opam: -------------------------------------------------------------------------------- 1 | opam-version: "1.2" 2 | version: "dev" 3 | maintainer: "palmskog@gmail.com" 4 | 5 | homepage: "https://github.com/DistributedComponents/verdi-chord" 6 | dev-repo: "https://github.com/DistributedComponents/verdi-chord.git" 7 | bug-reports: "https://github.com/DistributedComponents/verdi-chord/issues" 8 | license: "BSD" 9 | 10 | build: [ 11 | [ "./configure" ] 12 | [ make "-j%{jobs}%" "chord" ] 13 | ] 14 | available: [ ocaml-version >= "4.02.3" ] 15 | depends: [ 16 | "coq" {>= "8.7" & < "8.9~"} 17 | "coq-mathcomp-ssreflect" {>= "1.6" & < "1.8~"} 18 | "verdi" {= "dev"} 19 | "StructTact" {= "dev"} 20 | "InfSeqExt" {= "dev"} 21 | "verdi-runtime" {= "dev"} 22 | "cheerios" {= "dev"} 23 | "ocamlbuild" {build} 24 | "yojson" {>= "1.4.1"} 25 | ] 26 | 27 | authors: [ 28 | "Ryan Doenges <>" 29 | "Doug Woos <>" 30 | "Karl Palmskog <>" 31 | "Zachary Tatlock <>" 32 | "James Wilcox <>" 33 | "Justin Adsuara <>" 34 | ] 35 | -------------------------------------------------------------------------------- /config/deploy.rb: -------------------------------------------------------------------------------- 1 | # config valid only for current version of Capistrano 2 | lock "3.10.2" 3 | 4 | set :application, 'verdi-chord' 5 | set :repo_url, 'git@github.com:DistributedComponents/verdi-chord.git' 6 | 7 | # Default branch is :master 8 | # ask :branch, `git rev-parse --abbrev-ref HEAD`.chomp 9 | 10 | # Default deploy_to directory is /var/www/my_app_name 11 | set :deploy_to, '/home/pi/lib/verdi-chord' 12 | 13 | # Default value for :format is :airbrussh. 14 | # set :format, :airbrussh 15 | 16 | # You can configure the Airbrussh format using :format_options. 17 | # These are the defaults. 18 | # set :format_options, command_output: true, log_file: "log/capistrano.log", color: :auto, truncate: :auto 19 | set :format_options, command_output: true, log_file: "log/capistrano.log", color: :auto, truncate: false 20 | 21 | # Default value for :pty is false 22 | # set :pty, true 23 | 24 | # Default value for :linked_files is [] 25 | # append :linked_files, "config/database.yml", "config/secrets.yml" 26 | 27 | # Default value for linked_dirs is [] 28 | # append :linked_dirs, "log", "tmp/pids", "tmp/cache", "tmp/sockets", "public/system" 29 | append :linked_dirs, 30 | 'extraction/chord/tmp', 31 | 'extraction/chord/log', 32 | 'extraction/chord-serialized/tmp', 33 | 'extraction/chord-serialized/log' 34 | 35 | # Default value for default_env is {} 36 | # set :default_env, { path: "/opt/ruby/bin:$PATH" } 37 | set :default_env, {} 38 | 39 | # Default value for keep_releases is 5 40 | set :keep_releases, 3 41 | -------------------------------------------------------------------------------- /config/deploy/production.rb: -------------------------------------------------------------------------------- 1 | # server-based syntax 2 | # ====================== 3 | # Defines a single server with a list of roles and multiple properties. 4 | # You can define all roles on a single server, or split them: 5 | 6 | # server "example.com", user: "deploy", roles: %w{app db web}, my_property: :my_value 7 | # server "example.com", user: "deploy", roles: %w{app web}, other_property: :other_value 8 | # server "db.example.com", user: "deploy", roles: %w{db} 9 | 10 | # complete ring 11 | server 'discoberry01.cs.washington.edu', user: 'pi', roles: %w{client}, ip: '128.208.2.23', name: 'db01' 12 | server 'discoberry02.cs.washington.edu', user: 'pi', roles: %w{node root}, ip: '128.208.2.211', name: 'db02' 13 | server 'discoberry03.cs.washington.edu', user: 'pi', roles: %w{node base}, ip: '128.208.2.13', name: 'db03' 14 | server 'discoberry04.cs.washington.edu', user: 'pi', roles: %w{node base}, ip: '128.208.2.216', name: 'db04' 15 | server 'discoberry05.cs.washington.edu', user: 'pi', roles: %w{node ext}, ip: '128.208.2.214', name: 'db05', known: 'db02' 16 | server 'discoberry06.cs.washington.edu', user: 'pi', roles: %w{node ext}, ip: '128.208.2.212', name: 'db06', known: 'db03' 17 | server 'discoberry07.cs.washington.edu', user: 'pi', roles: %w{node base}, ip: '128.208.2.26', name: 'db07' 18 | server 'discoberry08.cs.washington.edu', user: 'pi', roles: %w{node ext}, ip: '128.208.2.30', name: 'db08', known: 'db04' 19 | server 'discoberry09.cs.washington.edu', user: 'pi', roles: %w{node}, ip: '128.208.2.27', name: 'db09' 20 | server 'discoberry10.cs.washington.edu', user: 'pi', roles: %w{node ext}, ip: '128.208.2.15', name: 'db10', known: 'db07' 21 | 22 | # subset ring 23 | #server 'discoberry01.cs.washington.edu', user: 'pi', roles: %w{node}, name: '23', succs: %w(13 216), preds: %w(211), ip: '128.208.2.23' 24 | #server 'discoberry02.cs.washington.edu', user: 'pi', roles: %w{node}, name: '211', succs: %w(23 13), preds: %w(216), ip: '128.208.2.211' 25 | #server 'discoberry03.cs.washington.edu', user: 'pi', roles: %w{node}, name: '13', succs: %w(216 211), preds: %w(23), ip: '128.208.2.13' 26 | #server 'discoberry04.cs.washington.edu', user: 'pi', roles: %w{node}, name: '216', succs: %w(211 23), preds: %w(13), ip: '128.208.2.216' 27 | 28 | # role-based syntax 29 | # ================== 30 | 31 | # Defines a role with one or multiple servers. The primary server in each 32 | # group is considered to be the first unless any hosts have the primary 33 | # property set. Specify the username and a domain or IP for the server. 34 | # Don't use `:all`, it's a meta role. 35 | 36 | # role :app, %w{deploy@example.com}, my_property: :my_value 37 | # role :web, %w{user1@primary.com user2@additional.com}, other_property: :other_value 38 | # role :db, %w{deploy@example.com} 39 | 40 | # Configuration 41 | # ============= 42 | # You can set any configuration variable like in config/deploy.rb 43 | # These variables are then only loaded and set in this stage. 44 | # For available Capistrano configuration variables see the documentation page. 45 | # http://capistranorb.com/documentation/getting-started/configuration/ 46 | # Feel free to add new variables to customise your setup. 47 | 48 | set :chord_node_port, 7000 49 | set :chord_serialized_node_port, 8000 50 | 51 | set :make_jobs, 2 52 | 53 | # Custom SSH Options 54 | # ================== 55 | # You may pass any option but keep in mind that net/ssh understands a 56 | # limited set of options, consult the Net::SSH documentation. 57 | # http://net-ssh.github.io/net-ssh/classes/Net/SSH.html#method-c-start 58 | # 59 | # Global options 60 | # -------------- 61 | # set :ssh_options, { 62 | # keys: %w(/home/rlisowski/.ssh/id_rsa), 63 | # forward_agent: false, 64 | # auth_methods: %w(password) 65 | # } 66 | # 67 | # The server-based syntax can be used to override options: 68 | # ------------------------------------ 69 | # server "example.com", 70 | # user: "user_name", 71 | # roles: %w{web app}, 72 | # ssh_options: { 73 | # user: "user_name", # overrides user setting above 74 | # keys: %w(/home/user_name/.ssh/id_rsa), 75 | # forward_agent: false, 76 | # auth_methods: %w(publickey password) 77 | # # password: "please use keys" 78 | # } 79 | -------------------------------------------------------------------------------- /config/deploy/staging.rb: -------------------------------------------------------------------------------- 1 | # server-based syntax 2 | # ====================== 3 | # Defines a single server with a list of roles and multiple properties. 4 | # You can define all roles on a single server, or split them: 5 | 6 | # server "example.com", user: "deploy", roles: %w{app db web}, my_property: :my_value 7 | # server "example.com", user: "deploy", roles: %w{app web}, other_property: :other_value 8 | # server "db.example.com", user: "deploy", roles: %w{db} 9 | 10 | 11 | 12 | # role-based syntax 13 | # ================== 14 | 15 | # Defines a role with one or multiple servers. The primary server in each 16 | # group is considered to be the first unless any hosts have the primary 17 | # property set. Specify the username and a domain or IP for the server. 18 | # Don't use `:all`, it's a meta role. 19 | 20 | # role :app, %w{deploy@example.com}, my_property: :my_value 21 | # role :web, %w{user1@primary.com user2@additional.com}, other_property: :other_value 22 | # role :db, %w{deploy@example.com} 23 | 24 | 25 | 26 | # Configuration 27 | # ============= 28 | # You can set any configuration variable like in config/deploy.rb 29 | # These variables are then only loaded and set in this stage. 30 | # For available Capistrano configuration variables see the documentation page. 31 | # http://capistranorb.com/documentation/getting-started/configuration/ 32 | # Feel free to add new variables to customise your setup. 33 | 34 | 35 | 36 | # Custom SSH Options 37 | # ================== 38 | # You may pass any option but keep in mind that net/ssh understands a 39 | # limited set of options, consult the Net::SSH documentation. 40 | # http://net-ssh.github.io/net-ssh/classes/Net/SSH.html#method-c-start 41 | # 42 | # Global options 43 | # -------------- 44 | # set :ssh_options, { 45 | # keys: %w(/home/rlisowski/.ssh/id_rsa), 46 | # forward_agent: false, 47 | # auth_methods: %w(password) 48 | # } 49 | # 50 | # The server-based syntax can be used to override options: 51 | # ------------------------------------ 52 | # server "example.com", 53 | # user: "user_name", 54 | # roles: %w{web app}, 55 | # ssh_options: { 56 | # user: "user_name", # overrides user setting above 57 | # keys: %w(/home/user_name/.ssh/id_rsa), 58 | # forward_agent: false, 59 | # auth_methods: %w(publickey password) 60 | # # password: "please use keys" 61 | # } 62 | -------------------------------------------------------------------------------- /configure: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | ## Configures and calls coqproject.sh (https://github.com/dwoos/coqproject) 4 | 5 | ## Configuration options for coqproject.sh 6 | DEPS=(StructTact InfSeqExt Verdi Cheerios) 7 | DIRS=(core systems/chord systems/chord-serialized systems/chord-util systems/chord-props lib extraction/chord/coq extraction/chord-serialized/coq) 8 | NAMESPACE_core="Verdi" 9 | NAMESPACE_systems="Chord" 10 | NAMESPACE_lib="Chord" 11 | NAMESPACE_systems_chord_util="Chord" 12 | NAMESPACE_systems_chord_props="Chord" 13 | NAMESPACE_systems_chord="Chord" 14 | NAMESPACE_extraction_chord_coq="Chord" 15 | NAMESPACE_systems_chord_serialized="Chord" 16 | NAMESPACE_extraction_chord_serialized_coq="Chord" 17 | 18 | CANARIES=("mathcomp.ssreflect.ssreflect" "Verdi requires mathcomp to be installed" "StructTact.StructTactics" "Build StructTact before building Verdi" "InfSeqExt.infseq" "Build InfSeqExt before building Verdi" "Cheerios.Cheerios" "Build Cheerios before building Verdi Chord") 19 | Verdi_DIRS=(core lib systems extraction) 20 | Cheerios_DIRS=(core extraction) 21 | source script/coqproject.sh 22 | -------------------------------------------------------------------------------- /deps/Dependencies.v: -------------------------------------------------------------------------------- 1 | Require Import dpdgraph.dpdgraph. 2 | 3 | Require Import Chord.LabeledLemmas. 4 | Require Import Chord.LabeledMeasures. 5 | Require Import Chord.SystemReachable. 6 | Require Import Chord.PairIn. 7 | Require Import Chord.SystemLemmas. 8 | Require Import Chord.HandlerLemmas. 9 | Require Import Chord.SystemPointers. 10 | Require Import Chord.ChordCorrectPhaseThree. 11 | Require Import Chord.ChordCorrectPhaseTwo. 12 | Require Import Chord.ChordCorrectPhaseOne. 13 | Require Import Chord.ChordStabilization. 14 | Require Import Chord.Chord. 15 | Require Import Chord.SuccessorNodesAlwaysValid. 16 | Require Import Chord.QueryTargetsJoined. 17 | Require Import Chord.LiveNodesStayLive. 18 | Require Import Chord.RingCorrect. 19 | Require Import Chord.NodesNotJoinedHaveNoSuccessors. 20 | Require Import Chord.ValidPointersInvariant. 21 | Require Import Chord.QueriesEventuallyStop. 22 | Require Import Chord.LiveNodeInSuccLists. 23 | Require Import Chord.HashInjective. 24 | Require Import Chord.PredNeverSelfInvariant. 25 | Require Import Chord.PtrCorrectInvariant. 26 | Require Import Chord.LiveNodesNotClients. 27 | Require Import Chord.NodesHaveState. 28 | Require Import Chord.StabilizeOnlyWithFirstSucc. 29 | Require Import Chord.NodesAlwaysHaveLiveSuccs. 30 | Require Import Chord.QueryInvariant. 31 | Require Import Chord.LiveNodeHasTickInTimeouts. 32 | Require Import Chord.LiveNodePreservation. 33 | Require Import Chord.FirstSuccNeverSelf. 34 | Require Import Chord.PtrsJoined. 35 | Require Import Chord.TickInvariant. 36 | Require Import Chord.DeadNodesGoQuiet. 37 | Require Import Chord.WfPtrSuccListInvariant. 38 | Require Import Chord.TimeoutMeansActive. 39 | Require Import Chord.Sorting. 40 | Require Import Chord.Bitvectors. 41 | Require Import Chord.InfSeqTactics. 42 | Require Import Chord.IDSpace. 43 | Require Import Verdi.DynamicNet. 44 | 45 | Set DependGraph File "deps/chord_all.dpd". 46 | Print FileDependGraph Chord.LabeledLemmas Chord.LabeledMeasures Chord.SystemReachable Chord.PairIn Chord.SystemLemmas Chord.HandlerLemmas Chord.SystemPointers Chord.ChordCorrectPhaseThree Chord.ChordCorrectPhaseTwo Chord.ChordCorrectPhaseOne Chord.ChordStabilization Chord.Chord Chord.SuccessorNodesAlwaysValid Chord.QueryTargetsJoined Chord.LiveNodesStayLive Chord.RingCorrect Chord.NodesNotJoinedHaveNoSuccessors Chord.ValidPointersInvariant Chord.QueriesEventuallyStop Chord.LiveNodeInSuccLists Chord.HashInjective Chord.PredNeverSelfInvariant Chord.PtrCorrectInvariant Chord.LiveNodesNotClients Chord.NodesHaveState Chord.StabilizeOnlyWithFirstSucc Chord.NodesAlwaysHaveLiveSuccs Chord.QueryInvariant Chord.LiveNodeHasTickInTimeouts Chord.LiveNodePreservation Chord.FirstSuccNeverSelf Chord.PtrsJoined Chord.TickInvariant Chord.DeadNodesGoQuiet Chord.WfPtrSuccListInvariant Chord.TimeoutMeansActive Chord.Sorting Chord.Bitvectors Chord.InfSeqTactics Chord.IDSpace Verdi.DynamicNet. 47 | 48 | Set DependGraph File "deps/chord_stabilization.dpd". 49 | Print DependGraph chord_stabilization. 50 | -------------------------------------------------------------------------------- /deps/admit_analysis.md: -------------------------------------------------------------------------------- 1 | I've admitted the top level phase two theorem and commented the rest of the file 2 | out. This leaves 28 admits. 3 | 4 | Out of those 28, we won't try to prove 5 | (1 admit) The phase two admit 6 | - `phase_two_without_phase_one` 7 | 8 | (4 admits) facts about pointers never getting worse. 9 | - `phase_one_error_continuously_nonincreasing` 10 | - `succs_error_nonincreasing` 11 | - `succs_error_helper_invar` 12 | - `has_first_succ_stable` 13 | 14 | (7 admits) facts about pointers pointing to live and/or joined nodes 15 | - `valid_ptrs_global_inductive` 16 | - `wf_ptr_succ_list_invariant'` 17 | - `successors_are_live_nodes` 18 | - `stabilize2_target_joined` 19 | - `join2_target_joined` 20 | - `stabilize_target_joined` 21 | - `successor_nodes_always_valid` 22 | 23 | (1 'admit') An axiom saying SUCC_LIST_LEN >= 2 24 | - `succ_list_len_lower_bound` 25 | 26 | This leaves the following 15 admits, which I think are provable in two months' 27 | worth of work. 28 | 29 | 2 tricky facts 30 | - `open_stabilize_request_until_response` 31 | - `not_skipped_means_incoming_succs_not_skipped` 32 | 33 | 5 things of a list lemma flavor 34 | - `in_concat` 35 | - `initial_esl_is_sorted_nodes_chopped` 36 | - `sorted_list_elements_not_between` 37 | - `live_node_in_succs_best_succ` 38 | - `has_succ_has_pred_inv` 39 | 40 | 2 grab bag 41 | - `adopting_succs_decreases_succs_error` 42 | - `constrained_Request_not_cleared_by_recv_handler` 43 | 44 | 2 grindy invariants 45 | - `query_message_ok_invariant` 46 | - `at_most_one_request_timeout_invariant` 47 | 48 | 4 eventually... arguments 49 | - `joins_stop` 50 | - `queries_eventually_stop` 51 | - `dead_node_channel_empties_out` 52 | - `dead_nodes_go_quiet` 53 | -------------------------------------------------------------------------------- /deps/all_used_admits.txt: -------------------------------------------------------------------------------- 1 | adopting_succs_decreases_succs_error 2 | at_most_one_request_timeout_invariant 3 | best_pred_is_best_first_succ 4 | better_pred_bool_total' 5 | better_pred_eventually_improves_succ 6 | constrained_Request_not_cleared_by_recv_handler 7 | dead_node_channel_empties_out 8 | dead_nodes_go_quiet 9 | error_decreases_when_succs_right 10 | error_means_merge_point_or_wrong_pred 11 | first_succ_error_nonincreasing 12 | first_succ_same_until_improvement 13 | has_first_succ_stable 14 | has_succ_has_pred_inv 15 | incoming_GotPredAndSuccs_with_a_after_p_causes_improvement 16 | in_concat 17 | initial_esl_is_sorted_nodes_chopped 18 | join2_target_joined 19 | joins_stop 20 | length_filter_by_cmp_same_eq 21 | live_node_in_succs_best_succ 22 | merge_points_preserved_until_error_drops 23 | notify_when_pred_None_eventually_improves 24 | notify_when_pred_worse_eventually_improves 25 | not_skipped_means_incoming_succs_not_skipped 26 | open_stabilize_request_until_response 27 | phase_one_error_continuously_nonincreasing 28 | phase_two_zero_error_locally_correct 29 | pred_bound_pred_not_worse 30 | pred_error_nonincreasing 31 | pred_same_until_improvement 32 | queries_eventually_stop 33 | query_message_ok_invariant 34 | RecvMsg_enabled_until_occurred 35 | sorted_list_elements_not_between 36 | stabilize2_target_joined 37 | stabilize_target_joined 38 | succ_between_improves_error 39 | successor_nodes_always_valid 40 | successors_are_live_nodes 41 | succ_list_len_lower_bound 42 | succs_error_helper_invar 43 | succs_error_nonincreasing 44 | valid_ptrs_global_inductive 45 | wf_ptr_succ_list_invariant' 46 | -------------------------------------------------------------------------------- /deps/mkdeps.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | set -e 3 | cd "$(dirname $BASH_SOURCE[0])" 4 | 5 | for i in $(seq $1 $2); do 6 | dpd2dot -o chord$i.dot -depth $i -root chord_stabilization chord_all.dpd 7 | echo "converting to svg" 8 | dot -Tsvg -o chord$i.svg chord$i.dot 9 | done 10 | -------------------------------------------------------------------------------- /deps/stabilization_admits.txt: -------------------------------------------------------------------------------- 1 | adopting_succs_decreases_succs_error 2 | at_most_one_request_timeout_invariant 3 | better_pred_eventually_improves_succ 4 | Classical_Prop:classic 5 | constrained_Request_not_cleared_by_recv_handler 6 | dead_node_channel_empties_out 7 | dead_nodes_go_quiet 8 | error_decreases_when_succs_right 9 | error_means_merge_point_or_wrong_pred 10 | first_succ_error_nonincreasing 11 | first_succ_same_until_improvement 12 | has_first_succ_stable 13 | has_succ_has_pred_inv 14 | incoming_GotPredAndSuccs_with_a_after_p_causes_improvement 15 | in_concat 16 | initial_esl_is_sorted_nodes_chopped 17 | join2_target_joined 18 | joins_stop 19 | live_node_in_succs_best_succ 20 | merge_points_preserved_until_error_drops 21 | notify_when_pred_None_eventually_improves 22 | not_skipped_means_incoming_succs_not_skipped 23 | open_stabilize_request_until_response 24 | phase_one_error_continuously_nonincreasing 25 | phase_two_zero_error_locally_correct 26 | pred_bound_pred_not_worse 27 | pred_error_nonincreasing 28 | pred_same_until_improvement 29 | queries_eventually_stop 30 | query_message_ok_invariant 31 | RecvMsg_enabled_until_occurred 32 | sorted_list_elements_not_between 33 | stabilize2_target_joined 34 | stabilize_target_joined 35 | succ_between_improves_error 36 | successor_nodes_always_valid 37 | successors_are_live_nodes 38 | succ_list_len_lower_bound 39 | succs_error_helper_invar 40 | succs_error_nonincreasing 41 | valid_ptrs_global_inductive 42 | wf_ptr_succ_list_invariant' 43 | -------------------------------------------------------------------------------- /doc/PROOF_ENGINEERING.md: -------------------------------------------------------------------------------- 1 | * make all proofs robust against changes in hypothesis names and 2 | ordering. the effort to do so will be more than made up for as you 3 | change your theorem statements. 4 | * don't say `P -> A /\ B` but instead say `(P -> A) /\ (P -> B)`, even 5 | if `P` is long (in which case maybe you should give it a name/notation). this 6 | makes automatic backwards reasoning easier. 7 | * don't say `P <-> Q` but instead say `(P -> Q) /\ (Q -> P)` even if `P` 8 | and `Q` are long (give them names/notations). this is also for 9 | backwards reasoning. 10 | * when deciding hypothesis order `P -> Q -> R`, place most restrictive 11 | hypothesis first. this helps because it reduces the chance that 12 | eauto will infer the wrong thing satisfying `P` but not `Q`. 13 | * obvious truism: constantly throw exploratory proofs away. it's 14 | not enough to play the video game until QED, produce a maintainable 15 | proof that liberally uses lemmas and tactics. 16 | * whenever possible, define complete "eliminator" lemmas for the facts 17 | you need to reason about. for example, `foo x = true -> P x /\ Q x` 18 | where `P` and `Q` is "all the information" contained in `foo x = 19 | true`. Do this instead of (or in addition to) proving `foo x = true 20 | -> P x` and `foo x = true -> Q x` because the complete eliminator 21 | avoids the need to manage the context in the common case: since the 22 | eliminator is complete, it is always safe to apply it. 23 | * eliminator lemmas don't work well with backwards reasoning. so it is 24 | common to reason forward with them. thus, for each commonly used 25 | eliminator lemma `foo_elim : foo x = true -> P x /\ Q x` , define a 26 | corresponding `do_foo_elim` tactic of the form 27 | ```ocaml 28 | match goal with 29 | | [ H : foo _ = true |- _ ] => apply foo_elim in H; break_and 30 | end. 31 | ``` 32 | * if necessary/convenient, use a general `elim` tactic that calls all 33 | your elimination tactics. 34 | * TEST THINGS. Verifying software is hard and verifying incorrect 35 | software is impossible, so any time spent finding bugs before starting to 36 | prove stuff will pay dividends down the road. 37 | * each lemma should unfold only one thing. think of this like the 38 | standard software engineering practice of hiding implementation 39 | details. this leads to somewhat longer proof developments, but they 40 | are much more robust to definition change. 41 | * avoid simpl-ing non-trivial definitions. a common anti-pattern: 42 | `simpl in *; repeat break_match; ...` this can be very convenient 43 | for exploratory proofs, but is generally unmaintainable and has 44 | horrible performance. instead, prove all the definitional equalities 45 | you need propositionally as lemmas. another option is to prove a 46 | high-level "definition" lemma, which is usually a big or of ands 47 | that does all the case analysis for you at once. this is much more 48 | efficient and maintainable. 49 | -------------------------------------------------------------------------------- /doc/QUESTIONS.md: -------------------------------------------------------------------------------- 1 | * reuse definitions from LabeledNet.v in Verdi? 2 | 3 | * move things to core! move other things to lib? (what does Ryan think) 4 | 5 | * handler lemmas, like SpecLemmas in Verdi, very big lemmas right now, decompose into smaller lemmas, don't get all cases everytime! 6 | 7 | * do we want intermediate reachability? weaker stuff? 8 | 9 | * reorganize ChordLabeled a bit, move to different dir, factor out Chord-specific stuff 10 | 11 | * ChordPromises: which ones are hard, which ones are impossible, which ones are easy? 12 | 13 | * client handling, client payload, client non-state 14 | 15 | * ask Ryan for more things to move! 16 | 17 | * naming conventions? 18 | 19 | * ask Ryan for difficulty of PhaseTwo admits 20 | 21 | * phase 3! we need at least some lemmas+admits 22 | 23 | * invariants in separate files?!? 24 | 25 | * state of the shim, client?!? 26 | 27 | * how do we start shim/client? 28 | -------------------------------------------------------------------------------- /doc/STYLE.md: -------------------------------------------------------------------------------- 1 | Filenames 2 | ======== 3 | 4 | * CamlCase for Coq files, example: `StateMachineHandlerMonad.v` 5 | * CamlCase for OCaml files, example: `VarDArrangement.ml` 6 | * lowercase with dashes for scripts, example: `proof-linter.sh` 7 | * UPPERCASE with underscores for documentation, example: `PROOF_ENGINEERING.md` 8 | 9 | Coq Files 10 | ========= 11 | 12 | Sections 13 | -------- 14 | 15 | * CamlCase name, example: `Section StepRelations.` 16 | * indentation of two spaces for all code inside a section 17 | 18 | Type Classes 19 | ------------ 20 | 21 | * CamlCase name 22 | * brackets on separate line indented by two spaces 23 | * field declaration with C-style naming on separate line indented by four spaces 24 | * one space between end of field declaration and semicolon 25 | 26 | Example: 27 | ``` 28 | Class GhostFailureParams `(P : FailureParams) := 29 | { 30 | ghost_data : Type; 31 | ghost_init : ghost_data ; 32 | ghost_net_handlers : 33 | name -> name -> msg -> (ghost_data * data) -> ghost_data ; 34 | ghost_input_handlers : 35 | name -> input -> (ghost_data * data) -> ghost_data 36 | }. 37 | ``` 38 | 39 | Type Class Instances 40 | -------------------- 41 | 42 | * C-style names 43 | * brackets on separate line indented by two spaces 44 | * field declaration with C-style naming on separate line indented by four spaces 45 | * one space between end of field declaration and semicolon 46 | 47 | Example: 48 | ``` 49 | Instance base_params : BaseParams := 50 | { 51 | data := raft_data ; 52 | input := raft_input ; 53 | output := raft_output 54 | }. 55 | ``` 56 | 57 | Theorems and Lemmas 58 | ------------------- 59 | 60 | * name uses underscore as separator 61 | * type declaration starts on a separate row 62 | * no unnecessary type declarations for quantified variables 63 | * line break after implication arrow 64 | * proof script indented by two spaces 65 | 66 | Example: 67 | ``` 68 | Theorem inverse_trace_relations_work : 69 | forall s tr, 70 | refl_trans_1n_trace step init s tr -> 71 | R s -> 72 | T tr. 73 | Proof. 74 | intros. find_apply_lem_hyp refl_trans_1n_n1_trace. 75 | remember init as s'. 76 | induction H. 77 | - subst. exfalso. eauto using R_false_init. 78 | - subst. concludes. 79 | destruct (R_dec x'); 80 | intuition eauto using T_monotonic, refl_trans_n1_1n_trace, R_implies_T. 81 | Qed. 82 | ``` 83 | 84 | Step Relation Definitions 85 | ------------------------- 86 | 87 | * C-style name of (`Inductive`) type 88 | * each case starts with a bar 89 | * name of a case is the type name in CamelCase, followed by an underscore and a C-style identifier 90 | * body of a case is indented by four spaces 91 | 92 | Example: 93 | ``` 94 | Inductive step_async : step_relation network (name * (input + list output)) := 95 | | StepAsync_deliver : forall net net' p xs ys out d l, 96 | nwPackets net = xs ++ p :: ys -> 97 | net_handlers (pDst p) (pSrc p) (pBody p) (nwState net (pDst p)) = (out, d, l) -> 98 | net' = mkNetwork (send_packets (pDst p) l ++ xs ++ ys) 99 | (update name_eq_dec (nwState net) (pDst p) d) -> 100 | step_async net net' [(pDst p, inr out)] 101 | | StepAsync_input : forall h net net' out inp d l, 102 | input_handlers h inp (nwState net h) = (out, d, l) -> 103 | net' = mkNetwork (send_packets h l ++ nwPackets net) 104 | (update name_eq_dec (nwState net) h d) -> 105 | step_async net net' [(h, inl inp); (h, inr out)]. 106 | ``` 107 | -------------------------------------------------------------------------------- /doc/phase-three.md: -------------------------------------------------------------------------------- 1 | Let *L* be the maximum length of successor lists. 2 | 3 | Let the error of a successor list be the length of its longest globally correct 4 | prefix. When a node *h* stabilizes with its correct first successor *s* and the 5 | error at *s* is *e*, the error at *h* becomes max(*e* - 1, 0). 6 | 7 | Since we're done with phase two and all first successors are correct, each node 8 | has error at most *L* - 1. 9 | 10 | Suppose that all nodes have error at most *L* - *k*, where *k* ≥ 1. Each node 11 | can stabilize to obtain error at most max(*L* - *k* - 1, 0). 12 | 13 | By induction on maximum error, this shows that eventually all nodes have error 14 | 0, i.e., correct successor lists of length *L*. 15 | -------------------------------------------------------------------------------- /doc/phase-two.md: -------------------------------------------------------------------------------- 1 | In phase two, we prove that predecessor pointers and first successor pointers 2 | are continuously globally correct. 3 | 4 | We can assume, thanks to phase one, that there will be no new joined nodes and 5 | that all joined nodes have live first successors which are themselves live. We 6 | can think of the first successor relation as a total function. 7 | ``` 8 | (-).succ : joined_node -> joined_node 9 | ``` 10 | The predecessor relation remains a partial function. 11 | ``` 12 | (-).pred : joined_node -> option joined_node 13 | ``` 14 | 15 | We write `a --> s` for `a.succ = s` and `p <~~ a` for `a.pred = Some p`. 16 | 17 | The error measure for `a --> s` is the number of nodes between `a` and `s` in 18 | identifier order. Likewise, the error measure for `p <~~ a` is the number of 19 | nodes between `p` and `a` in identifier order. The global error measure `Err` 20 | for phase two is the sum of these errors at every node. 21 | 22 | Suppose that `Err > 0`. 23 | 24 | If all successors are correct, somewhere we have `a <~~ 25 | h` with some other node `b` such that `a < b < h`. Since all successors are 26 | correct, there's a node `p --> h` such that `b <= p < h`. This node `p` will 27 | always point to `h` since there's no better successor for `p`. It will 28 | eventually stabilize, causing `h` to rectify with it and set `p <~~ h`, 29 | decreasing the error. 30 | 31 | If some successor is incorrect, we have `a --> c` with some other node `b` with 32 | `a < b < c`. If all these nodes are in the ring, then we have a contradiction 33 | since the ring is always ordered. So one of them isn't in the ring, meaning it's 34 | in an appendage. Since the existence of an appendage means we have a join point, 35 | we can proceed with an argument about join points. 36 | 37 | ## Join points 38 | A join point is three distinct nodes `a`, `b`, and `j` such that 39 | 40 | - `a --> j` 41 | - `b --> j` 42 | - `a < b` 43 | 44 | I'll draw a little picture for this and upload it. 45 | 46 | In a join point, there's nonzero successor error at `a` since `a < b < j`. There 47 | may also be predecessor error. If `j` has no predecessor, then it has error 48 | which will be reduced when `b` stabilizes with `j` and causes `j` to set `b <~~ 49 | j`. 50 | 51 | If there's a predecessor `p <~~ j`, then either `p <= a` or `a < p` in the 52 | identifier order unrolled with `j` at the top. 53 | 54 | If `p <= a`, then `b` will eventually stabilize and `j` will set `b' <~~ j` for 55 | some node `b'` equal to or better than `b`. 56 | 57 | If `a < p`, then `a` will eventually stabilize and set `a --> p'` for some node 58 | `p'` better than or equal to `p`. 59 | 60 | So join points eventually reduce error. This is enough to imply phase two if we 61 | assume that the error also never increases. 62 | -------------------------------------------------------------------------------- /doc/tom-chord.md: -------------------------------------------------------------------------------- 1 | let me amplify a bit on the (garbled audio) comment I made thursday about 2 | labelling distributed state transfers with version numbers. Obviously if you 3 | have see a path to proving correctness/liveness of the original chord algorithm 4 | and/or Zave's version of the algorithm, you can safely ignore this. one thing 5 | worth doing (imo), if we haven't yet, is to implement Zave's algorithm and then 6 | turn model checking loose on it. 7 | 8 | I set myself the task of trying to come up with a workable ring maintenance 9 | algorithm, under the Zave constraint -- joins, async comms, limited number of 10 | failures, eventually consistent, live, ring size > epsilon. Working through the 11 | details caused me to think proving liveness of Chord/Zave would be harder than 12 | I thought. 13 | 14 | The intuition behind version numbers is to turn distributed state management 15 | into a functional program (local state is never updated, it is just versioned). 16 | This can make invariants easier to specify. For example, finding an eventually 17 | consistent minimum spanning tree is trivial in this model and not otherwise -- 18 | you pong repeatedly from the root, with version numbers, and all state derived 19 | from the same version number is consistent everywhere, regardless of message 20 | order delivery and failures. So, somewhat trivially, if there are no further 21 | changes, a single recursively broadcast pong after the last change, and building 22 | state based on the highest numbered pong you have seen to date, is enough to get 23 | convergence. If you label messages with the version of known at the time at the 24 | source of the message, you can safely deliver it everywhere using that version 25 | of the MST (rather than the current state that may be dynamically being updated 26 | while the message is in flight!) -- if the specific MST version becomes 27 | disconnected by a later failure, you can just retry. 28 | 29 | The original Chord implementation did not do this; it attempts to update state 30 | in place, and so any proof needs to reason about the effect on global/local 31 | state of all possible join, failure, and message orderings. I don't know enough 32 | about Zave's changes to be able to speak authoritatively about it, so I started 33 | looking for a simple implementation of a Chord-like ring maintenance algorithm 34 | based on version #s where I could be easily convinced it is both correct and 35 | live. It is possible I'm just recapitulating Zave here. (Another place to look 36 | is Pastry -- unlike Chord, those authors did understand consensus.) 37 | 38 | My approach uses version #'s, commutativity, and chain replication. I assume we 39 | want to be able to survive k-1 failures (between reconvergence steps), and each 40 | node keeps k successors, and 1 predecessor. for now, i'm going to ignore key 41 | replication. 42 | 43 | 1) if we assume no joins, and up to k-1 failures, and the ring was k-connected 44 | prior to any failures, then it is simple to rebuild the k-successor list by 45 | repeated versioned pongs, MST style with a depth of k. 46 | 47 | 2) there are k+2 nodes whose state we need to update on a join (joiner, 48 | k predecessors, and the one successor). keeping things simple, let's insist 49 | that the k predecessors and the one successor need to have a consistent view 50 | of their state to proceed (which they can get from step 1). 51 | 52 | Secondly, let's insist that each successor node processes at most one join 53 | request at a time. No harm here -- the joiner talks to the successor, so if the 54 | joiner fails during the join process, the successor can pick up and move the 55 | system back to quiescence before accepting the next join request. 56 | 57 | I would like to further insist that none of the k predecessors processes a join 58 | request at the same time, as that would give us serializable updates to 59 | distributed state. as long as joins are serializable, we're done, because step 60 | 1 lets us recover from failures. However, since we're in a ring, we can't use 61 | per-node locks (because of deadlock). It is possible that we could devise 62 | a special purpose paxos like algorithm that is both non-blocking and 63 | serializable. Let me leave that option on the shelf for now, as my initial 64 | attempts in that direction weren't simple (e.g., it would probably need to 65 | involve 2k+1 nodes, not just the k+2 with state to be updated). 66 | 67 | Instead, let's note that simultaneous joins to different successors are 68 | commutative with respect to node state. The tricky part is to make that work 69 | despite k-1 failures that can occur during the join process. 70 | 71 | 3) a three phase algorithm 72 | 73 | a) verify all k+2 nodes have the same version. Joiner starts a message at the 74 | successor, which is forwarded to predecessors. when it reaches the tail (the 75 | kth predecessor), it goes back to the joiner, with success. If the predecessor 76 | links are wrong or any of the nodes are out of date, you can just drop, go back 77 | to step 1 (resynch state), and retry later 78 | 79 | at this point, all nodes know about the join (equal to "joined" in the Zave 80 | protocol?). 81 | 82 | b) joiner starts a versioned message at the successor with all of the 83 | information about the join (e.g., names and versions of the successor and 84 | predecessors). It proceeds to construct the new state needed at each node if 85 | this join succeeds, but the old state is kept around. commit happens when it 86 | reaches the tail and returns to the joiner. 87 | 88 | possible that multiple updates will proceed concurrently. Since you don't know 89 | if a change will commit, you need to keep multiple versions, and merge as 90 | necessary. 91 | 92 | at this point, all nodes have computed the new state (equal to "rectify" in the 93 | Zave protocol?) but have the old state to fall back upon 94 | 95 | c) garbage collection. joiner can pass a message from successor through all 96 | predecessors saying the update committed and it is ok to throw away the old 97 | state. 98 | 99 | during this join process, you need to do key replication across k+1 rather than 100 | k nodes -- the joiner, its immediate successor, and the k-1 other successors, so 101 | that the joiner is up to date with respect to the successor, and so that the 102 | successor can discard its (now redundantly stored) keys in step c. 103 | -------------------------------------------------------------------------------- /extraction/chord-serialized/.gitignore: -------------------------------------------------------------------------------- 1 | coq/*.ml 2 | coq/*.mli 3 | _build 4 | *.native 5 | lib 6 | log 7 | -------------------------------------------------------------------------------- /extraction/chord-serialized/Makefile: -------------------------------------------------------------------------------- 1 | OCAMLBUILD = ocamlbuild -pkgs 'verdi-runtime cheerios-runtime' -I ml -I coq -cflag -g 2 | 3 | CHORDSERIALIZEDMLFILES = coq/ExtractedChordSerialized.ml coq/ExtractedChordSerialized.mli 4 | 5 | default: chordserialized.native client.native 6 | 7 | $(CHORDSERIALIZEDMLFILES): 8 | +$(MAKE) -C ../.. extraction/chord-serialized/$@ 9 | 10 | chordserialized.native: $(CHORDSERIALIZEDMLFILES) ml/*.ml scripts/remove_module.pl 11 | perl scripts/remove_module.pl coq/ExtractedChordSerialized 12 | $(OCAMLBUILD) chordserialized.native 13 | 14 | client.native: $(CHORDSERIALIZEDMLFILES) ml/client.ml 15 | $(OCAMLBUILD) client.native 16 | 17 | clean: 18 | $(OCAMLBUILD) -clean 19 | 20 | .PHONY: default clean $(CHORDSERIALIZEDMLFILES) 21 | 22 | .NOTPARALLEL: chordserialized.native client.native 23 | .NOTPARALLEL: $(CHORDSERIALIZEDMLFILES) 24 | -------------------------------------------------------------------------------- /extraction/chord-serialized/_tags: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DistributedComponents/verdi-chord/762fe660c648d7f2a009d2beaa5cf3b8ea4ac593/extraction/chord-serialized/_tags -------------------------------------------------------------------------------- /extraction/chord-serialized/coq/ExtractChordSerialized.v: -------------------------------------------------------------------------------- 1 | Require Import Arith. 2 | Require Import ExtrOcamlBasic. 3 | 4 | Require Import Arith Even Div2 EqNat Euclid. 5 | Require Import ExtrOcamlBasic. 6 | Require Import ExtrOcamlString. 7 | Require Import ExtrOcamlNatInt. 8 | 9 | Require Import Chord.Chord. 10 | Require Import Chord.ChordSerialized. 11 | Import ChordSerialized. 12 | 13 | Require Import Cheerios.Cheerios. 14 | Require Import Cheerios.ExtrOcamlCheeriosBasic. 15 | 16 | Extract Inlined Constant Chord.SUCC_LIST_LEN => "3". 17 | 18 | (* We use the ocaml standard library implementation of MD5 to compute IDs. Since 19 | * Coq extracts strings to the ocaml type char list, we have to wrap the hash in 20 | * a conversion function from verdi-runtime. *) 21 | Extract Constant Chord.ocaml_hash => 22 | "(fun s -> 23 | (Util.char_list_of_string 24 | (Digest.string 25 | (Util.string_of_char_list s))))". 26 | (* MD5 digests are 16 bytes. *) 27 | Extract Inlined Constant Chord.N => "16". 28 | 29 | Extract Constant VectorEq.eqb => "(fun _ _ _ -> (=))". 30 | 31 | Extract Constant ChordSerializable.client_addr_dec => "Obj.magic". 32 | 33 | Definition handleNet : addr -> addr -> data -> payload -> res := 34 | ChordSerializedSystem.recv_handler. 35 | 36 | Definition init : addr -> list addr -> data * list (addr * payload) * list timeout := 37 | ChordSerializedSystem.start_handler. 38 | 39 | Definition handleTimeout : addr -> data -> timeout -> res := 40 | ChordSerializedSystem.timeout_handler. 41 | 42 | (* for debugging *) 43 | Definition deserializePayload w : option ChordSystem.payload := 44 | deserialize_top deserialize w. 45 | 46 | Extraction "extraction/chord-serialized/coq/ExtractedChordSerialized.ml" 47 | init 48 | handleNet 49 | handleTimeout 50 | deserializePayload 51 | 52 | is_request 53 | ascii_to_id 54 | id_to_ascii 55 | forge_pointer. -------------------------------------------------------------------------------- /extraction/chord-serialized/ml/ChordSerializedArrangement.ml: -------------------------------------------------------------------------------- 1 | open ExtractedChordSerialized 2 | open Printf 3 | open Str 4 | 5 | let chord_serialized_default_port = 8000 6 | 7 | let show_id i = 8 | Digest.to_hex (Util.string_of_char_list (id_to_ascii i)) 9 | 10 | let show_pointer p = 11 | show_id p.ChordIDSpace.ptrId 12 | 13 | let show_pointer_list ps = 14 | let strs = map show_pointer ps in 15 | "[" ^ String.concat ", " strs ^ "]" 16 | 17 | let show_addr a = 18 | Util.string_of_char_list a 19 | 20 | let caps_bool b = 21 | if b then "True" else "False" 22 | 23 | let show_opt_pointer p = 24 | Util.map_default show_pointer "None" p 25 | 26 | let show_msg : ChordSystem.payload -> string = function 27 | | ChordSystem.GetBestPredecessor p -> "GetBestPredecessor " ^ show_pointer p 28 | | ChordSystem.GotBestPredecessor p -> "GotBestPredecessor " ^ show_pointer p 29 | | ChordSystem.GetSuccList -> "GetSuccList" 30 | | ChordSystem.GotSuccList ps -> "GotSuccList " ^ show_pointer_list ps 31 | | ChordSystem.GetPredAndSuccs -> "GetPredAndSuccs" 32 | | ChordSystem.GotPredAndSuccs (pred, succs) -> "GotPredAndSuccs " ^ show_opt_pointer pred ^ " " ^ show_pointer_list succs 33 | | ChordSystem.Notify -> "Notify" 34 | | ChordSystem.Ping -> "Ping" 35 | | ChordSystem.Pong -> "Pong" 36 | | ChordSystem.Busy -> "Busy" 37 | 38 | let show_query = function 39 | | ChordSystem.Rectify p -> "Rectify " ^ show_pointer p 40 | | ChordSystem.Stabilize -> "Stabilize" 41 | | ChordSystem.Stabilize2 p -> "Stabilize2 " ^ show_pointer p 42 | | ChordSystem.Join p -> "Join " ^ show_pointer p 43 | | ChordSystem.Join2 p -> "Join2 " ^ show_pointer p 44 | 45 | let show_st_ptr st = 46 | show_pointer st.ChordSystem.ptr 47 | 48 | let show_request ((ptr, q), _) = 49 | Printf.sprintf "query(%s, %s)" (show_pointer ptr) (show_query q) 50 | 51 | let show_st_cur_request st = 52 | Util.map_default show_request "None" st.ChordSystem.cur_request 53 | 54 | let log_info_from st msg = 55 | let prefix = Printf.sprintf "node(%s):" (show_st_ptr st) in 56 | Util.info (prefix ^ msg) 57 | 58 | let log_dbg_from st msg = 59 | let prefix = Printf.sprintf "node(%s):" (show_st_ptr st) in 60 | Util.debug (prefix ^ msg) 61 | 62 | let log_st st = 63 | let log = log_info_from st in 64 | log ("succ_list := " ^ show_pointer_list st.ChordSystem.succ_list); 65 | log ("pred := " ^ show_opt_pointer st.ChordSystem.pred); 66 | log ("known := " ^ show_pointer st.ChordSystem.known); 67 | log ("joined := " ^ caps_bool st.ChordSystem.joined); 68 | log ("rectify_with := " ^ show_opt_pointer st.ChordSystem.rectify_with); 69 | log ("cur_request := " ^ show_st_cur_request st) 70 | 71 | let log_recv st src msg = 72 | let log = log_dbg_from st in 73 | log ("recv from " ^ show_addr src ^ ": " ^ show_msg msg) 74 | 75 | let log_send st dst msg = 76 | let log = log_dbg_from st in 77 | log ("send to " ^ show_addr dst ^ ":" ^ show_msg msg) 78 | 79 | let log_timeout st = function 80 | | ChordSystem.Tick -> log_dbg_from st "ticked" 81 | | ChordSystem.RectifyTick -> log_dbg_from st "ticked for rectify" 82 | | ChordSystem.KeepaliveTick -> log_dbg_from st "ticked for keepalive" 83 | | ChordSystem.Request (dead, msg) -> 84 | log_dbg_from st ("request " ^ show_msg msg 85 | ^ " from " ^ show_pointer st.ChordSystem.ptr 86 | ^ " to " ^ show_addr dead ^ " timed out") 87 | 88 | let rebracket4 (((a, b), c), d) = (a, b, c, d) 89 | let rebracket3 ((a, b), c) = (a, b, c) 90 | 91 | module type ChordSerializedConfig = sig 92 | val tick_timeout : float 93 | val keepalive_timeout : float 94 | val request_timeout : float 95 | val debug : bool 96 | end 97 | 98 | module ChordSerializedArrangement (C : ChordSerializedConfig) = struct 99 | type addr = string 100 | type name = ChordSystem.addr 101 | type state = ChordSystem._data 102 | type msg = ChordSerializedSystem.payload 103 | type timeout = ChordSystem._timeout 104 | type res = state * (name * msg) list * (timeout list) * (timeout list) 105 | let port = chord_serialized_default_port 106 | let addr_of_name = Util.string_of_char_list 107 | let name_of_addr s = 108 | Util.char_list_of_string s 109 | let start_handler n ks = 110 | Random.self_init (); 111 | rebracket3 (init n ks) 112 | let msg_handler s d m st = 113 | rebracket4 (handleNet s d m st) 114 | let timeout_handler n s t = 115 | rebracket4 (handleTimeout n s t) 116 | 117 | let deserialize_msg (b : msg) : Serializer_primitives.wire = b 118 | let serialize_msg msg = msg 119 | 120 | let fuzzy_timeout t = 121 | let fuzz = max (t /. 5.0) 2.0 in 122 | t +. Random.float fuzz 123 | 124 | let set_timeout = function 125 | | ChordSystem.Tick -> fuzzy_timeout C.tick_timeout 126 | | ChordSystem.RectifyTick -> fuzzy_timeout C.tick_timeout 127 | (* must be less than the request timeout *) 128 | | ChordSystem.KeepaliveTick -> C.keepalive_timeout 129 | | ChordSystem.Request (a, b) -> C.request_timeout 130 | 131 | let default_timeout = 1.0 132 | let debug = C.debug 133 | let debug_recv (st : state) ((src, msg) : name * msg) = 134 | match deserializePayload msg with 135 | | Some msg -> log_st st; 136 | log_recv st src msg; 137 | flush_all () 138 | | None -> failwith "received undeserializable message" 139 | 140 | let debug_send st (dst, msg) = 141 | match deserializePayload msg with 142 | | Some msg -> log_st st; 143 | log_send st dst msg; 144 | flush_all () 145 | | None -> failwith "sent undeserializable message" 146 | 147 | let debug_timeout st t = 148 | log_timeout st t; 149 | flush_all () 150 | end 151 | 152 | type chord_config = 153 | { tick_timeout : float 154 | ; keepalive_timeout : float 155 | ; request_timeout : float 156 | ; debug : bool 157 | } 158 | 159 | let run cc nm knowns = 160 | let module Conf = struct 161 | let tick_timeout = cc.tick_timeout 162 | let keepalive_timeout = cc.keepalive_timeout 163 | let request_timeout = cc.request_timeout 164 | let debug = cc.debug 165 | end in 166 | let module Shim = DynamicShim.Shim(ChordSerializedArrangement(Conf)) in 167 | Shim.main nm knowns 168 | -------------------------------------------------------------------------------- /extraction/chord-serialized/ml/ChordUtil.ml: -------------------------------------------------------------------------------- 1 | open Util 2 | 3 | let parse_addr s = 4 | match Str.split (Str.regexp ":") s with 5 | | addr::port::[] -> 6 | (* this should throw invalid arg when this is broken *) 7 | addr 8 | | _ -> invalid_arg s 9 | 10 | let parse_addr_arg opt = 11 | try 12 | parse_addr opt 13 | with Invalid_argument _ -> 14 | let msg = (Printf.sprintf "invalid address '%s', should take the form ip:port" opt) in 15 | invalid_arg msg 16 | 17 | let send_all sock buf = 18 | let rec send_chunk sock buf i l = 19 | let sent = Unix.send sock buf i l [] in 20 | if sent < l 21 | then send_chunk sock buf (i + sent) (l - sent) 22 | else () in 23 | send_chunk sock buf 0 (Bytes.length buf) 24 | 25 | let octets_to_ip o1 o2 o3 o4 = 26 | let so1 = Int32.shift_left o1 24 in 27 | let so2 = Int32.shift_left o2 16 in 28 | let so3 = Int32.shift_left o3 8 in 29 | Int32.logxor (Int32.logxor (Int32.logxor so1 so2) so3) o4 30 | 31 | (* Matches four groups of at most three digits separated by dots *) 32 | let weak_ip_regexp = 33 | Str.regexp "\\([0-9]?[0-9]?[0-9]\\)\\.\ 34 | \\([0-9]?[0-9]?[0-9]\\)\\.\ 35 | \\([0-9]?[0-9]?[0-9]\\)\\.\ 36 | \\([0-9]?[0-9]?[0-9]\\)$" 37 | 38 | (* Convert the string representation s of an ip, e.g., "10.14.122.04" to a 39 | 32-bit integer. 40 | Throws Invalid_argument if s does not represent a valid IPv4 address. *) 41 | let int_of_ip s = 42 | if Str.string_match weak_ip_regexp s 0 43 | then 44 | let int_of_kth_group k = Int32.of_string (Str.matched_group k s) in 45 | let numbers = List.map int_of_kth_group [1; 2; 3; 4] in 46 | match numbers with 47 | | [o1; o2; o3; o4] -> 48 | if List.for_all (fun x -> 0l <= x && x <= 255l) numbers 49 | then octets_to_ip o1 o2 o3 o4 50 | else invalid_arg s 51 | | _ -> invalid_arg s 52 | else invalid_arg s 53 | 54 | (* Pull out the nth octet of the 32-bit integer i (where n = 0, 1, 2, or 3) *) 55 | 56 | (* Convert a 32-bit integer to its dotted octet representation. *) 57 | let ip_of_int i = 58 | let octet n = 59 | let n = 8 * n in 60 | let mask = Int32.shift_left 255l n in 61 | Int32.shift_right_logical (Int32.logand mask i) n 62 | in 63 | let octets = List.map octet [3; 2; 1; 0] in 64 | String.concat "." (List.map Int32.to_string octets) 65 | 66 | let parse_ip s = 67 | ip_of_int (int_of_ip s) 68 | 69 | let ip_spec arg addr_ref doc = 70 | let parse opt = 71 | addr_ref := parse_ip opt 72 | in (arg, Arg.String parse, doc) 73 | 74 | let addr_spec arg addr_ref doc = 75 | let parse opt = 76 | addr_ref := Some (parse_addr_arg opt) 77 | in (arg, Arg.String parse, doc) 78 | 79 | let addrs_spec arg addrs_ref doc = 80 | let parse opt = 81 | addrs_ref := !addrs_ref @ [parse_addr_arg opt] 82 | in (arg, Arg.String parse, doc) 83 | -------------------------------------------------------------------------------- /extraction/chord-serialized/ml/chordserialized.ml: -------------------------------------------------------------------------------- 1 | open Printf 2 | open Str 3 | open ChordUtil 4 | 5 | type command_line_opts = 6 | { bind : string option ref 7 | ; ring : string list ref 8 | ; known : string option ref 9 | ; debug : bool ref 10 | ; request_timeout : float ref 11 | ; tick_timeout : float ref 12 | ; keepalive_timeout : float ref 13 | } 14 | 15 | let mk_default_opts () : command_line_opts = 16 | { bind = ref None 17 | ; ring = ref [] 18 | ; known = ref None 19 | ; debug = ref true 20 | ; request_timeout = ref 120.0 21 | ; tick_timeout = ref 30.0 22 | ; keepalive_timeout = ref 10.0 23 | } 24 | 25 | let mk_chord_config opts = 26 | if !(opts.keepalive_timeout) > !(opts.request_timeout) 27 | then invalid_arg "keepalive timeout must be greater than request timeout" 28 | else 29 | { ChordSerializedArrangement.tick_timeout = !(opts.tick_timeout) 30 | ; ChordSerializedArrangement.keepalive_timeout = !(opts.keepalive_timeout) 31 | ; ChordSerializedArrangement.request_timeout = !(opts.request_timeout) 32 | ; ChordSerializedArrangement.debug = !(opts.debug) 33 | } 34 | 35 | let validate_nm_knowns opts = 36 | match !(opts.bind), !(opts.ring), !(opts.known) with 37 | | Some b, s :: uccs, None -> b, s :: uccs 38 | | Some b, [], Some k -> b, [k] 39 | | Some b, [], None -> invalid_arg "please provide either -known or an intial ring using -ring" 40 | | Some b, s :: uccs, Some k -> invalid_arg "-known and -ring are mutually exclusive" 41 | | None, _, _ -> invalid_arg "please specify an address to bind to using -bind" 42 | 43 | let validate (opts : command_line_opts) = 44 | let cc = mk_chord_config opts in 45 | let nm, knowns = validate_nm_knowns opts in 46 | cc, nm, knowns 47 | 48 | let parse argv opts = 49 | let spec = 50 | [ addr_spec "-bind" opts.bind "{ip:port} address to listen for connections on" 51 | ; addrs_spec "-ring" opts.ring "{ip:port} node in initial ring" 52 | ; addr_spec "-known" opts.known "{ip:port} node to join ring with" 53 | ; ( "-request-timeout" 54 | , Arg.Set_float opts.request_timeout 55 | , "minimum length of time to use for request timeouts" 56 | ) 57 | ; ( "-tick-timeout" 58 | , Arg.Set_float opts.tick_timeout 59 | , "approximate time between ticks of the protocol" 60 | ) 61 | ; ( "-keepalive-timeout" 62 | , Arg.Set_float opts.keepalive_timeout 63 | , "time between keepalive messages" 64 | ) 65 | ; ( "-debug" 66 | , Arg.Set opts.debug 67 | , "run in debug mode" 68 | ) 69 | ] 70 | in 71 | let anon_args_fun _ = 72 | let msg = sprintf "%s does not take position arguments" argv.(0) in 73 | raise (Arg.Bad msg) 74 | in 75 | try 76 | Arg.parse_argv argv spec anon_args_fun "Try -help for help or one of the following."; 77 | validate opts 78 | with 79 | | Invalid_argument msg -> 80 | Arg.usage spec msg; 81 | exit 1 82 | | Arg.Bad msg -> 83 | print_string msg; 84 | exit 1 85 | 86 | let _ = 87 | let opts = mk_default_opts () in 88 | let cc, nm, knowns = parse Sys.argv opts in 89 | ChordSerializedArrangement.run cc nm knowns 90 | -------------------------------------------------------------------------------- /extraction/chord-serialized/ml/client.ml: -------------------------------------------------------------------------------- 1 | open ExtractedChordSerialized 2 | open ExtractedChordSerialized.ChordSerializedSystem 3 | open ExtractedChordSerialized.ChordIDSpace 4 | 5 | module type ClientSig = sig 6 | exception Wrong_response of string 7 | val lookup : string -> string -> id -> pointer 8 | val get_pred_and_succs : string -> string -> pointer option * pointer list 9 | end 10 | 11 | module Client : ClientSig = struct 12 | 13 | let setup_listen_fd listen_addr = 14 | let listen_fd = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in 15 | Unix.setsockopt listen_fd Unix.SO_REUSEADDR true; 16 | Unix.bind listen_fd (Unix.ADDR_INET (listen_addr, ChordSerializedArrangement.chord_serialized_default_port)); 17 | Unix.listen listen_fd 8; 18 | Unix.set_nonblock listen_fd; 19 | Printf.printf "[%s] started listening for connections" (Util.timestamp ()); 20 | print_newline (); 21 | listen_fd 22 | 23 | let setup_write_fd write_addr listen_addr = 24 | let write_fd = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in 25 | Unix.setsockopt write_fd Unix.SO_REUSEADDR true; 26 | Unix.bind write_fd (Unix.ADDR_INET (listen_addr, 0)); 27 | Unix.connect write_fd (Unix.ADDR_INET (write_addr, ChordSerializedArrangement.chord_serialized_default_port)); 28 | Printf.printf "[%s] opened connection" (Util.timestamp ()); 29 | print_newline (); 30 | write_fd 31 | 32 | let accept_read_fd listen_fd = 33 | Printf.printf "[%s] incoming connection" (Util.timestamp ()); 34 | print_newline (); 35 | let (read_fd, read_addr) = Unix.accept listen_fd in 36 | Unix.set_nonblock read_fd; 37 | begin 38 | match read_addr with 39 | | Unix.ADDR_INET (addr, port) -> 40 | Printf.printf "[%s] done processing new connection from %s" (Util.timestamp ()) (Unix.string_of_inet_addr addr); 41 | print_newline () 42 | | _ -> () 43 | end; 44 | read_fd 45 | 46 | exception Wrong_response of string 47 | 48 | let rec eloop timeout listen_fd read_fds read_bufs = 49 | let select_fds = listen_fd :: read_fds in 50 | let (ready_fds, _, _) = 51 | Util.select_unintr select_fds [] [] timeout 52 | in 53 | let (new_fds, res) = 54 | List.fold_left 55 | (fun (fds, res) fd -> 56 | if fd = listen_fd then 57 | let read_fd = accept_read_fd fd in 58 | (read_fd :: fds, res) 59 | else begin 60 | Printf.printf "[%s] receiving data" (Util.timestamp ()); 61 | print_newline (); 62 | match Util.recv_buf_chunk fd read_bufs with 63 | | None -> (fds, res) 64 | | Some buf -> (fds, Some buf) 65 | end) ([], None) ready_fds 66 | in 67 | match res with 68 | None -> eloop timeout listen_fd (new_fds @ read_fds) read_bufs 69 | | Some m -> (match deserializePayload m with 70 | None -> raise (Wrong_response "undeserializable") 71 | | Some Busy -> Printf.printf "repeating"; 72 | print_newline (); 73 | eloop timeout listen_fd (new_fds @ read_fds) read_bufs 74 | | _ -> m) 75 | 76 | let query listen_addr write_addr msg = 77 | let listen_fd = setup_listen_fd listen_addr in 78 | let write_fd = setup_write_fd write_addr listen_addr in 79 | let buf = serialize_top (payload_Serializer.serialize msg) in 80 | let read_bufs = Hashtbl.create 1 in 81 | Util.send_chunk write_fd buf; 82 | Printf.printf "[%s] sent message" (Util.timestamp ()); 83 | print_newline (); 84 | let buf = eloop 1.0 listen_fd [] read_bufs in 85 | deserializePayload buf 86 | 87 | let lookup bind node id = 88 | let p = forge_pointer id in 89 | let listen_addr = Unix.inet_addr_of_string bind in 90 | let write_addr = Unix.inet_addr_of_string node in 91 | match query listen_addr write_addr (GetBestPredecessor p) with 92 | | Some (GotBestPredecessor p) -> p 93 | | Some r -> raise (Wrong_response (ChordSerializedArrangement.show_msg r)) 94 | | None -> raise (Wrong_response "undeserializable") 95 | 96 | let get_pred_and_succs bind node = 97 | let listen_addr = Unix.inet_addr_of_string bind in 98 | let write_addr = Unix.inet_addr_of_string node in 99 | match query listen_addr write_addr GetPredAndSuccs with 100 | | Some (GotPredAndSuccs (p, ss)) -> (p, ss) 101 | | Some r -> raise (Wrong_response (ChordSerializedArrangement.show_msg r)) 102 | | None -> raise (Wrong_response "undeserializable") 103 | 104 | end 105 | 106 | let validate bind node query_type lookup_id = 107 | let handle_lookup b n = 108 | function 109 | | None -> invalid_arg "please specify an ID to look up" 110 | | Some id -> b, n, "lookup", id 111 | in 112 | match bind, node, query_type with 113 | | "", _, _ -> 114 | invalid_arg "please specify an IP to connect from with -bind" 115 | | b, Some n, "" -> 116 | invalid_arg "please specify a query type with -query" 117 | | b, Some n, "lookup" -> 118 | handle_lookup b n (Some lookup_id) 119 | | b, Some n, "get_ptrs" -> 120 | b, n, "get_ptrs", lookup_id 121 | | _, _, _ -> 122 | invalid_arg "please specify both -bind and -node" 123 | 124 | let parse argv = 125 | let bind = ref "" in 126 | let node = ref None in 127 | let lookup_id = ref None in 128 | let query_type = ref "" in 129 | let set_query_type s = query_type := s in 130 | let spec = 131 | [ ChordUtil.ip_spec "-bind" bind "{ip} address to connect from" 132 | ; ChordUtil.addr_spec "-node" node "{ip:port} node to query" 133 | ; ( "-query" 134 | , Arg.Symbol (["lookup"; "get_ptrs"], set_query_type) 135 | , " type of query to run. lookup asks the node to look up the given ID. get_ptrs \ 136 | asks the node for its predecessor and successors.") 137 | ] 138 | in 139 | let anonarg a = 140 | if !query_type = "lookup" 141 | then lookup_id := Some (ascii_to_id (Util.char_list_of_string (Digest.from_hex a))) 142 | else raise (Arg.Bad "not a lookup") 143 | in 144 | let usage = "USAGE:\n\ 145 | client.native -bind {ip} -node {ip:port} -query [ lookup {id} | get_ptrs ]\n" 146 | in 147 | Arg.parse spec anonarg usage; 148 | try 149 | validate !bind !node !query_type !lookup_id 150 | with Invalid_argument msg -> 151 | let full_usage = msg ^ "\n\n" ^ usage in 152 | Arg.usage spec full_usage; 153 | exit 1 154 | 155 | let _ = 156 | let bind, node, query_type, lookup_id = parse Sys.argv in 157 | match query_type, lookup_id with 158 | | "lookup", Some id -> 159 | let p = Client.lookup bind node id in 160 | print_endline (ChordSerializedArrangement.show_pointer p) 161 | | "get_ptrs", _-> 162 | let p, succs = Client.get_pred_and_succs bind node in 163 | print_endline (ChordSerializedArrangement.show_opt_pointer p); 164 | print_endline (ChordSerializedArrangement.show_pointer_list succs) 165 | | _ -> 166 | print_endline "unknown query type"; 167 | exit 1 168 | -------------------------------------------------------------------------------- /extraction/chord-serialized/scripts/demo.py: -------------------------------------------------------------------------------- 1 | # for computing chord IDs 2 | import md5 3 | import os.path 4 | import Queue 5 | import subprocess 6 | # for sys.argv 7 | import sys 8 | import threading 9 | 10 | CHORD_SERIALIZED = os.path.join(os.path.dirname(__file__), "../chordserialized.native") 11 | 12 | # Must agree with SUCC_LIST_LEN in ExtractChordSerialized.v 13 | SUCC_LIST_LEN = 3 14 | 15 | class Addr(object): 16 | def __init__(self, host, port): 17 | self.host = host 18 | self.port = int(port) 19 | 20 | def __repr__(self): 21 | return "{}:{}".format(self.host, self.port) 22 | 23 | # should agree with hash in ExtractChordSerialized.v 24 | def chordhash(self): 25 | md5.new(self.host).digest() 26 | 27 | # Each node's "read_thread" executes this function to put logged information 28 | # from its chordserialized.native process into the node's queue. 29 | def read_to_queue(f, queue): 30 | for line in f: 31 | if line != "": 32 | # trim newline from logged message 33 | queue.put(line[:-1]) 34 | 35 | class Node(object): 36 | def __init__(self, addr, ring=None, known=None): 37 | self.args = ["-bind", str(addr)] 38 | if ring is not None and known is None: 39 | self.knowns = ring 40 | for s in ring: 41 | self.args += ["-ring", str(s)] 42 | elif ring is None and known is not None: 43 | self.knowns = [known] 44 | self.args += ["-known", str(known)] 45 | else: 46 | raise InvalidArgumentException("please specify ring nodes or known, but not both") 47 | self.addr = addr 48 | self.proc = None 49 | self.output_queue = None 50 | self.buffer = "" 51 | 52 | def spawn(self): 53 | args = [CHORD_SERIALIZED] + self.args 54 | print "# executing", " ".join(args) 55 | self.proc = subprocess.Popen(args, stdin=open(os.devnull, "r"), stdout=subprocess.PIPE) 56 | q = Queue.Queue() 57 | self.read_thread = threading.Thread(target=read_to_queue, args=(self.proc.stdout, q)) 58 | self.read_thread.daemon = True 59 | self.read_thread.start() 60 | self.output_queue = q 61 | self.started = True 62 | 63 | def readlines(self): 64 | lines = [] 65 | while len(lines) == 0: 66 | try: 67 | lines.append(self.output_queue.get_nowait()) 68 | except Queue.Empty: 69 | break 70 | return lines 71 | 72 | def kill(self): 73 | self.proc.terminate() 74 | self.proc.wait() 75 | 76 | def __repr__(self): 77 | template = "Node(addr={}, knowns={}, started={})" 78 | return template.format(self.addr, self.knowns, self.started) 79 | 80 | def initial_ring(start, n): 81 | initial_addrs = [Addr("127.0.0.{}".format(start + i), 8000) for i in range(n)] 82 | nodes = [] 83 | for addr in initial_addrs: 84 | nodes.append(Node(addr, initial_addrs)) 85 | return nodes 86 | 87 | def main(count): 88 | nodes = initial_ring(1, count) 89 | for node in nodes: 90 | node.spawn() 91 | while True: 92 | lines = [] 93 | for node in nodes: 94 | for l in node.readlines(): 95 | if " - " not in l: 96 | print "# " + l 97 | else: 98 | timestamp, line = l.split(" - ", 1) 99 | lines.append((float(timestamp), line)) 100 | lines.sort(key=lambda (ts, _): ts) 101 | for (ts, line) in lines: 102 | sys.stdout.write(line + "\n") 103 | sys.stdout.flush() 104 | 105 | if __name__ == "__main__": 106 | if len(sys.argv) > 1: 107 | count = int(sys.argv[1]) 108 | else: 109 | count = 5 110 | main(count) 111 | -------------------------------------------------------------------------------- /extraction/chord-serialized/scripts/remove_module.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | # https://perlmaven.com/how-to-replace-a-string-in-a-file-with-perl 7 | 8 | my $serializer_name = $ARGV[0]; 9 | my $mli_name = $serializer_name . '.mli'; 10 | 11 | my $mli = read_file($mli_name); 12 | $mli =~ s/module.*\n WRITER//g; 13 | $mli =~ s/module.*\n READER//g; 14 | write_file($mli_name, $mli); 15 | exit; 16 | 17 | sub read_file { 18 | my ($filename) = @_; 19 | 20 | open my $in, '<:encoding(UTF-8)', $filename or die "Could not open '$filename' for reading $!"; 21 | local $/ = undef; 22 | my $all = <$in>; 23 | close $in; 24 | 25 | return $all; 26 | } 27 | 28 | sub write_file { 29 | my ($filename, $content) = @_; 30 | 31 | open my $out, '>:encoding(UTF-8)', $filename or die "Could not open '$filename' for writing $!";; 32 | print $out $content; 33 | close $out; 34 | 35 | return; 36 | } 37 | -------------------------------------------------------------------------------- /extraction/chord/.gitignore: -------------------------------------------------------------------------------- 1 | coq/*.ml 2 | coq/*.mli 3 | _build 4 | *.native 5 | lib 6 | log 7 | -------------------------------------------------------------------------------- /extraction/chord/Makefile: -------------------------------------------------------------------------------- 1 | OCAMLBUILD = ocamlbuild -package verdi-runtime -package yojson -I ml -I coq -cflag -g 2 | 3 | CHORDMLFILES = coq/ExtractedChord.ml coq/ExtractedChord.mli 4 | 5 | default: chord.native client.native 6 | 7 | $(CHORDMLFILES): 8 | +$(MAKE) -C ../.. extraction/chord/$@ 9 | 10 | chord.native: $(CHORDMLFILES) ml/*.ml 11 | $(OCAMLBUILD) chord.native 12 | 13 | client.native: $(CHORDMLFILES) ml/client.ml 14 | $(OCAMLBUILD) client.native 15 | 16 | clean: 17 | $(OCAMLBUILD) -clean 18 | 19 | .PHONY: default clean $(CHORDMLFILES) 20 | 21 | .NOTPARALLEL: chord.native client.native 22 | .NOTPARALLEL: $(CHORDMLFILES) 23 | -------------------------------------------------------------------------------- /extraction/chord/_tags: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DistributedComponents/verdi-chord/762fe660c648d7f2a009d2beaa5cf3b8ea4ac593/extraction/chord/_tags -------------------------------------------------------------------------------- /extraction/chord/coq/ExtractChord.v: -------------------------------------------------------------------------------- 1 | Require Import Arith. 2 | Require Import ExtrOcamlBasic. 3 | 4 | Require Import Arith Even Div2 EqNat Euclid. 5 | Require Import ExtrOcamlBasic. 6 | Require Import ExtrOcamlString. 7 | Require Import ExtrOcamlNatInt. 8 | 9 | Require Import Chord.Chord. 10 | Import Chord. 11 | 12 | Extract Inlined Constant Chord.SUCC_LIST_LEN => "3". 13 | 14 | (* We use the ocaml standard library implementation of MD5 to compute IDs. Since 15 | * Coq extracts strings to the ocaml type char list, we have to wrap the hash in 16 | * a conversion function from verdi-runtime. *) 17 | Extract Constant Chord.ocaml_hash => 18 | "(fun s -> 19 | (Util.char_list_of_string 20 | (Digest.string 21 | (Util.string_of_char_list s))))". 22 | (* MD5 digests are 16 bytes. *) 23 | Extract Inlined Constant Chord.N => "16". 24 | 25 | Extract Constant VectorEq.eqb => "(fun _ _ _ -> (=))". 26 | 27 | Definition handleNet : addr -> addr -> data -> payload -> res := 28 | recv_handler. 29 | 30 | Definition init : addr -> list addr -> data * list (addr * payload) * list timeout := 31 | start_handler. 32 | 33 | Definition handleTimeout : addr -> data -> timeout -> res := 34 | timeout_handler. 35 | 36 | Extraction "extraction/chord/coq/ExtractedChord.ml" 37 | init 38 | handleNet 39 | handleTimeout 40 | is_request 41 | ascii_to_id 42 | id_to_ascii 43 | forge_pointer. 44 | -------------------------------------------------------------------------------- /extraction/chord/ml/ChordUtil.ml: -------------------------------------------------------------------------------- 1 | open Util 2 | 3 | let parse_addr s = 4 | match Str.split (Str.regexp ":") s with 5 | | addr::port::[] -> 6 | (* this should throw invalid arg when this is broken *) 7 | addr 8 | | _ -> invalid_arg s 9 | 10 | let parse_addr_arg opt = 11 | try 12 | parse_addr opt 13 | with Invalid_argument _ -> 14 | let msg = (Printf.sprintf "invalid address '%s', should take the form ip:port" opt) in 15 | invalid_arg msg 16 | 17 | let send_all sock buf = 18 | let rec send_chunk sock buf i l = 19 | let sent = Unix.send sock buf i l [] in 20 | if sent < l 21 | then send_chunk sock buf (i + sent) (l - sent) 22 | else () in 23 | send_chunk sock buf 0 (Bytes.length buf) 24 | 25 | let octets_to_ip o1 o2 o3 o4 = 26 | let so1 = Int32.shift_left o1 24 in 27 | let so2 = Int32.shift_left o2 16 in 28 | let so3 = Int32.shift_left o3 8 in 29 | Int32.logxor (Int32.logxor (Int32.logxor so1 so2) so3) o4 30 | 31 | (* Matches four groups of at most three digits separated by dots *) 32 | let weak_ip_regexp = 33 | Str.regexp "\\([0-9]?[0-9]?[0-9]\\)\\.\ 34 | \\([0-9]?[0-9]?[0-9]\\)\\.\ 35 | \\([0-9]?[0-9]?[0-9]\\)\\.\ 36 | \\([0-9]?[0-9]?[0-9]\\)$" 37 | 38 | (* Convert the string representation s of an ip, e.g., "10.14.122.04" to a 39 | 32-bit integer. 40 | Throws Invalid_argument if s does not represent a valid IPv4 address. *) 41 | let int_of_ip s = 42 | if Str.string_match weak_ip_regexp s 0 43 | then 44 | let int_of_kth_group k = Int32.of_string (Str.matched_group k s) in 45 | let numbers = List.map int_of_kth_group [1; 2; 3; 4] in 46 | match numbers with 47 | | [o1; o2; o3; o4] -> 48 | if List.for_all (fun x -> 0l <= x && x <= 255l) numbers 49 | then octets_to_ip o1 o2 o3 o4 50 | else invalid_arg s 51 | | _ -> invalid_arg s 52 | else invalid_arg s 53 | 54 | (* Pull out the nth octet of the 32-bit integer i (where n = 0, 1, 2, or 3) *) 55 | 56 | (* Convert a 32-bit integer to its dotted octet representation. *) 57 | let ip_of_int i = 58 | let octet n = 59 | let n = 8 * n in 60 | let mask = Int32.shift_left 255l n in 61 | Int32.shift_right_logical (Int32.logand mask i) n 62 | in 63 | let octets = List.map octet [3; 2; 1; 0] in 64 | String.concat "." (List.map Int32.to_string octets) 65 | 66 | let parse_ip s = 67 | ip_of_int (int_of_ip s) 68 | 69 | let ip_spec arg addr_ref doc = 70 | let parse opt = 71 | addr_ref := parse_ip opt 72 | in (arg, Arg.String parse, doc) 73 | 74 | let addr_spec arg addr_ref doc = 75 | let parse opt = 76 | addr_ref := Some (parse_addr_arg opt) 77 | in (arg, Arg.String parse, doc) 78 | 79 | let addrs_spec arg addrs_ref doc = 80 | let parse opt = 81 | addrs_ref := !addrs_ref @ [parse_addr_arg opt] 82 | in (arg, Arg.String parse, doc) 83 | -------------------------------------------------------------------------------- /extraction/chord/ml/chord.ml: -------------------------------------------------------------------------------- 1 | open Printf 2 | open Str 3 | open ChordUtil 4 | 5 | type command_line_opts = 6 | { bind : string option ref 7 | ; ring : string list ref 8 | ; known : string option ref 9 | ; debug : bool ref 10 | ; request_timeout : float ref 11 | ; tick_timeout : float ref 12 | ; keepalive_timeout : float ref 13 | } 14 | 15 | let mk_default_opts () : command_line_opts = 16 | { bind = ref None 17 | ; ring = ref [] 18 | ; known = ref None 19 | ; debug = ref true 20 | ; request_timeout = ref 120.0 21 | ; tick_timeout = ref 30.0 22 | ; keepalive_timeout = ref 10.0 23 | } 24 | 25 | let mk_chord_config opts = 26 | if !(opts.keepalive_timeout) > !(opts.request_timeout) 27 | then invalid_arg "keepalive timeout must be greater than request timeout" 28 | else 29 | { ChordArrangement.tick_timeout = !(opts.tick_timeout) 30 | ; ChordArrangement.keepalive_timeout = !(opts.keepalive_timeout) 31 | ; ChordArrangement.request_timeout = !(opts.request_timeout) 32 | ; ChordArrangement.debug = !(opts.debug) 33 | } 34 | 35 | let validate_nm_knowns opts = 36 | match !(opts.bind), !(opts.ring), !(opts.known) with 37 | | Some b, s :: uccs, None -> b, s :: uccs 38 | | Some b, [], Some k -> b, [k] 39 | | Some b, [], None -> invalid_arg "please provide either -known or an intial ring using -ring" 40 | | Some b, s :: uccs, Some k -> invalid_arg "-known and -ring are mutually exclusive" 41 | | None, _, _ -> invalid_arg "please specify an address to bind to using -bind" 42 | 43 | let validate (opts : command_line_opts) = 44 | let cc = mk_chord_config opts in 45 | let nm, knowns = validate_nm_knowns opts in 46 | cc, nm, knowns 47 | 48 | let parse argv opts = 49 | let spec = 50 | [ addr_spec "-bind" opts.bind "{ip:port} address to listen for connections on" 51 | ; addrs_spec "-ring" opts.ring "{ip:port} node in initial ring" 52 | ; addr_spec "-known" opts.known "{ip:port} node to join ring with" 53 | ; ( "-request-timeout" 54 | , Arg.Set_float opts.request_timeout 55 | , "minimum length of time to use for request timeouts" 56 | ) 57 | ; ( "-tick-timeout" 58 | , Arg.Set_float opts.tick_timeout 59 | , "approximate time between ticks of the protocol" 60 | ) 61 | ; ( "-keepalive-timeout" 62 | , Arg.Set_float opts.keepalive_timeout 63 | , "time between keepalive messages" 64 | ) 65 | ; ( "-debug" 66 | , Arg.Set opts.debug 67 | , "run in debug mode" 68 | ) 69 | ] 70 | in 71 | let anon_args_fun _ = 72 | let msg = sprintf "%s does not take position arguments" argv.(0) in 73 | raise (Arg.Bad msg) 74 | in 75 | try 76 | Arg.parse_argv argv spec anon_args_fun "Try -help for help or one of the following."; 77 | validate opts 78 | with 79 | | Invalid_argument msg -> 80 | Arg.usage spec msg; 81 | exit 1 82 | | Arg.Bad msg -> 83 | print_string msg; 84 | exit 1 85 | 86 | let _ = 87 | let opts = mk_default_opts () in 88 | let cc, nm, knowns = parse Sys.argv opts in 89 | ChordArrangement.run cc nm knowns 90 | -------------------------------------------------------------------------------- /extraction/chord/ml/client.ml: -------------------------------------------------------------------------------- 1 | open ExtractedChord 2 | open ExtractedChord.ChordSystem 3 | open ExtractedChord.ChordIDSpace 4 | 5 | module type ClientSig = sig 6 | exception Wrong_response of string 7 | val lookup : string -> string -> id -> pointer 8 | val get_pred_and_succs : string -> string -> pointer option * pointer list 9 | end 10 | 11 | module Client : ClientSig = struct 12 | 13 | let serialize_msg msg = Marshal.to_bytes msg [] 14 | 15 | let deserialize_msg b = Marshal.from_bytes b 0 16 | 17 | let setup_listen_fd listen_addr = 18 | let listen_fd = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in 19 | Unix.setsockopt listen_fd Unix.SO_REUSEADDR true; 20 | Unix.bind listen_fd (Unix.ADDR_INET (listen_addr, ChordArrangement.chord_default_port)); 21 | Unix.listen listen_fd 8; 22 | Unix.set_nonblock listen_fd; 23 | Printf.printf "[%s] started listening for connections" (Util.timestamp ()); 24 | print_newline (); 25 | listen_fd 26 | 27 | let setup_write_fd write_addr listen_addr = 28 | let write_fd = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in 29 | Unix.setsockopt write_fd Unix.SO_REUSEADDR true; 30 | Unix.bind write_fd (Unix.ADDR_INET (listen_addr, 0)); 31 | Unix.connect write_fd (Unix.ADDR_INET (write_addr, ChordArrangement.chord_default_port)); 32 | Printf.printf "[%s] opened connection" (Util.timestamp ()); 33 | print_newline (); 34 | write_fd 35 | 36 | let accept_read_fd listen_fd = 37 | Printf.printf "[%s] incoming connection" (Util.timestamp ()); 38 | print_newline (); 39 | let (read_fd, read_addr) = Unix.accept listen_fd in 40 | Unix.set_nonblock read_fd; 41 | begin 42 | match read_addr with 43 | | Unix.ADDR_INET (addr, port) -> 44 | Printf.printf "[%s] done processing new connection from %s" (Util.timestamp ()) (Unix.string_of_inet_addr addr); 45 | print_newline () 46 | | _ -> () 47 | end; 48 | read_fd 49 | 50 | let rec eloop timeout listen_fd read_fds read_bufs = 51 | let select_fds = listen_fd :: read_fds in 52 | let (ready_fds, _, _) = 53 | Util.select_unintr select_fds [] [] timeout 54 | in 55 | let (new_fds, res) = 56 | List.fold_left 57 | (fun (fds, res) fd -> 58 | if fd = listen_fd then 59 | let read_fd = accept_read_fd fd in 60 | (read_fd :: fds, res) 61 | else begin 62 | Printf.printf "[%s] receiving data" (Util.timestamp ()); 63 | print_newline (); 64 | match Util.recv_buf_chunk fd read_bufs with 65 | | None -> (fds, res) 66 | | Some buf -> 67 | let m = deserialize_msg buf in 68 | (fds, Some m) 69 | end) ([], None) ready_fds 70 | in 71 | match res with 72 | None 73 | | Some Busy -> eloop timeout listen_fd (new_fds @ read_fds) read_bufs 74 | | Some m -> m 75 | 76 | let query listen_addr write_addr msg = 77 | let listen_fd = setup_listen_fd listen_addr in 78 | let write_fd = setup_write_fd write_addr listen_addr in 79 | let buf = serialize_msg msg in 80 | let read_bufs = Hashtbl.create 1 in 81 | Util.send_chunk write_fd buf; 82 | Printf.printf "[%s] sent message" (Util.timestamp ()); 83 | print_newline (); 84 | eloop 1.0 listen_fd [] read_bufs 85 | 86 | exception Wrong_response of string 87 | 88 | let lookup bind node id = 89 | let p = forge_pointer id in 90 | let listen_addr = Unix.inet_addr_of_string bind in 91 | let write_addr = Unix.inet_addr_of_string node in 92 | match query listen_addr write_addr (GetBestPredecessor p) with 93 | | GotBestPredecessor p -> p 94 | | r -> raise (Wrong_response (ChordArrangement.show_msg r)) 95 | 96 | let get_pred_and_succs bind node = 97 | let listen_addr = Unix.inet_addr_of_string bind in 98 | let write_addr = Unix.inet_addr_of_string node in 99 | match query listen_addr write_addr GetPredAndSuccs with 100 | | GotPredAndSuccs (p, ss) -> (p, ss) 101 | | r -> raise (Wrong_response (ChordArrangement.show_msg r)) 102 | 103 | end 104 | 105 | let validate bind node query_type lookup_id = 106 | let handle_lookup b n = 107 | function 108 | | None -> invalid_arg "please specify an ID to look up" 109 | | Some id -> b, n, "lookup", id 110 | in 111 | match bind, node, query_type with 112 | | "", _, _ -> 113 | invalid_arg "please specify an IP to connect from with -bind" 114 | | b, Some n, "" -> 115 | invalid_arg "please specify a query type with -query" 116 | | b, Some n, "lookup" -> 117 | handle_lookup b n (Some lookup_id) 118 | | b, Some n, "get_ptrs" -> 119 | b, n, "get_ptrs", lookup_id 120 | | _, _, _ -> 121 | invalid_arg "please specify both -bind and -node" 122 | 123 | let parse argv = 124 | let bind = ref "" in 125 | let node = ref None in 126 | let lookup_id = ref None in 127 | let query_type = ref "" in 128 | let set_query_type s = query_type := s in 129 | let spec = 130 | [ ChordUtil.ip_spec "-bind" bind "{ip} address to connect from" 131 | ; ChordUtil.addr_spec "-node" node "{ip:port} node to query" 132 | ; ( "-query" 133 | , Arg.Symbol (["lookup"; "get_ptrs"], set_query_type) 134 | , " type of query to run. lookup asks the node to look up the given ID. get_ptrs \ 135 | asks the node for its predecessor and successors.") 136 | ] 137 | in 138 | let anonarg a = 139 | if !query_type = "lookup" 140 | then lookup_id := Some (ascii_to_id (Util.char_list_of_string (Digest.from_hex a))) 141 | else raise (Arg.Bad "not a lookup") 142 | in 143 | let usage = "USAGE:\n\ 144 | client.native -bind {ip} -node {ip:port} -query [ lookup {id} | get_ptrs ]\n" 145 | in 146 | Arg.parse spec anonarg usage; 147 | try 148 | validate !bind !node !query_type !lookup_id 149 | with Invalid_argument msg -> 150 | let full_usage = msg ^ "\n\n" ^ usage in 151 | Arg.usage spec full_usage; 152 | exit 1 153 | 154 | let _ = 155 | let bind, node, query_type, lookup_id = parse Sys.argv in 156 | match query_type, lookup_id with 157 | | "lookup", Some id -> 158 | let p = Client.lookup bind node id in 159 | print_endline (ChordArrangement.show_pointer p) 160 | | "get_ptrs", _-> 161 | let p, succs = Client.get_pred_and_succs bind node in 162 | print_endline (ChordArrangement.show_opt_pointer p); 163 | print_endline (ChordArrangement.show_pointer_list succs) 164 | | _ -> 165 | print_endline "unknown query type"; 166 | exit 1 167 | -------------------------------------------------------------------------------- /extraction/chord/scripts/demo.py: -------------------------------------------------------------------------------- 1 | # for computing chord IDs 2 | import md5 3 | import os.path 4 | import Queue 5 | import subprocess 6 | # for sys.argv 7 | import sys 8 | import threading 9 | 10 | CHORD = os.path.join(os.path.dirname(__file__), "../chord.native") 11 | 12 | # Must agree with SUCC_LIST_LEN in ExtractChord.v 13 | SUCC_LIST_LEN = 3 14 | 15 | class Addr(object): 16 | def __init__(self, host, port): 17 | self.host = host 18 | self.port = int(port) 19 | 20 | def __repr__(self): 21 | return "{}:{}".format(self.host, self.port) 22 | 23 | # should agree with hash in ExtractChord.v 24 | def chordhash(self): 25 | md5.new(self.host).digest() 26 | 27 | # Each node's "read_thread" executes this function to put logged information 28 | # from its chord.native process into the node's queue. 29 | def read_to_queue(f, queue): 30 | for line in f: 31 | if line != "": 32 | # trim newline from logged message 33 | queue.put(line[:-1]) 34 | 35 | class Node(object): 36 | def __init__(self, addr, ring=None, known=None): 37 | self.args = ["-bind", str(addr)] 38 | if ring is not None and known is None: 39 | self.knowns = ring 40 | for s in ring: 41 | self.args += ["-ring", str(s)] 42 | elif ring is None and known is not None: 43 | self.knowns = [known] 44 | self.args += ["-known", str(known)] 45 | else: 46 | raise InvalidArgumentException("please specify ring nodes or known, but not both") 47 | self.addr = addr 48 | self.proc = None 49 | self.output_queue = None 50 | self.buffer = "" 51 | 52 | def spawn(self): 53 | args = [CHORD] + self.args 54 | print "# executing", " ".join(args) 55 | self.proc = subprocess.Popen(args, stdin=open(os.devnull, "r"), stdout=subprocess.PIPE) 56 | q = Queue.Queue() 57 | self.read_thread = threading.Thread(target=read_to_queue, args=(self.proc.stdout, q)) 58 | self.read_thread.daemon = True 59 | self.read_thread.start() 60 | self.output_queue = q 61 | self.started = True 62 | 63 | def readlines(self): 64 | lines = [] 65 | while len(lines) == 0: 66 | try: 67 | lines.append(self.output_queue.get_nowait()) 68 | except Queue.Empty: 69 | break 70 | return lines 71 | 72 | def kill(self): 73 | self.proc.terminate() 74 | self.proc.wait() 75 | 76 | def __repr__(self): 77 | template = "Node(addr={}, knowns={}, started={})" 78 | return template.format(self.addr, self.knowns, self.started) 79 | 80 | def initial_ring(start, n): 81 | initial_addrs = [Addr("127.0.0.{}".format(start + i), 7000) for i in range(n)] 82 | nodes = [] 83 | for addr in initial_addrs: 84 | nodes.append(Node(addr, initial_addrs)) 85 | return nodes 86 | 87 | def main(count): 88 | nodes = initial_ring(1, count) 89 | for node in nodes: 90 | node.spawn() 91 | while True: 92 | lines = [] 93 | for node in nodes: 94 | for l in node.readlines(): 95 | if " - " not in l: 96 | print "# " + l 97 | else: 98 | timestamp, line = l.split(" - ", 1) 99 | lines.append((float(timestamp), line)) 100 | lines.sort(key=lambda (ts, _): ts) 101 | for (ts, line) in lines: 102 | sys.stdout.write(line + "\n") 103 | sys.stdout.flush() 104 | 105 | if __name__ == "__main__": 106 | if len(sys.argv) > 1: 107 | count = int(sys.argv[1]) 108 | else: 109 | count = 5 110 | main(count) 111 | -------------------------------------------------------------------------------- /extraction/chord/scripts/experiment_3.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | scp rp2:/home/pi/lib/verdi-chord/shared/extraction/chord/log/chord.log db02-experiment_3.log 3 | scp rp3:/home/pi/lib/verdi-chord/shared/extraction/chord/log/chord.log db03-experiment_3.log 4 | scp rp4:/home/pi/lib/verdi-chord/shared/extraction/chord/log/chord.log db04-experiment_3.log 5 | scp rp5:/home/pi/lib/verdi-chord/shared/extraction/chord/log/chord.log db05-experiment_3.log 6 | scp rp6:/home/pi/lib/verdi-chord/shared/extraction/chord/log/chord.log db06-experiment_3.log 7 | scp rp7:/home/pi/lib/verdi-chord/shared/extraction/chord/log/chord.log db07-experiment_3.log 8 | scp rp8:/home/pi/lib/verdi-chord/shared/extraction/chord/log/chord.log db08-experiment_3.log 9 | scp rp10:/home/pi/lib/verdi-chord/shared/extraction/chord/log/chord.log db10-experiment_3.log 10 | mkdir -p experiment_3 11 | cat db02-experiment_3.log | grep ^[0-9] > experiment_3/db02-experiment_3.log 12 | cat db03-experiment_3.log | grep ^[0-9] > experiment_3/db03-experiment_3.log 13 | cat db04-experiment_3.log | grep ^[0-9] > experiment_3/db04-experiment_3.log 14 | cat db05-experiment_3.log | grep ^[0-9] > experiment_3/db05-experiment_3.log 15 | cat db06-experiment_3.log | grep ^[0-9] > experiment_3/db06-experiment_3.log 16 | cat db07-experiment_3.log | grep ^[0-9] > experiment_3/db07-experiment_3.log 17 | cat db08-experiment_3.log | grep ^[0-9] > experiment_3/db08-experiment_3.log 18 | cat db10-experiment_3.log | grep ^[0-9] > experiment_3/db10-experiment_3.log 19 | cd experiment_3 20 | sort -t';' -nk2 *.log | awk -F";" '{print $2","}' > data 21 | truncate -s 0 experiment_3.json 22 | cat ../head >> experiment_3.json 23 | cat data >> experiment_3.json 24 | cat ../tail >> experiment_3.json 25 | 26 | -------------------------------------------------------------------------------- /extraction/chord/scripts/head.json.oddity: -------------------------------------------------------------------------------- 1 | { 2 | "trace": [ 3 | 4 | -------------------------------------------------------------------------------- /extraction/chord/scripts/oddity.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | java -jar oddity.jar --trace-mode 3 | -------------------------------------------------------------------------------- /extraction/chord/scripts/tail.json.oddity: -------------------------------------------------------------------------------- 1 | ], 2 | "servers": [ 3 | "1abdebe5", 4 | "5549a41b", 5 | "5a667131", 6 | "93f2fbcb", 7 | "a6c3d9c4", 8 | "abb1fe30", 9 | "de352405", 10 | "ec317e2a" 11 | ] 12 | } 13 | -------------------------------------------------------------------------------- /lib/Bitvectors.v: -------------------------------------------------------------------------------- 1 | Require Import Bvector. 2 | Require Vector. 3 | Require Import Ascii. 4 | Require Import String. 5 | Require Import List. 6 | Import ListNotations. 7 | 8 | Definition ascii_to_vec (a : Ascii.ascii) : Bvector 8 := 9 | let (b1, b2, b3, b4, b5, b6, b7, b8) := a in 10 | Vector.of_list [b1; b2; b3; b4; b5; b6; b7; b8]. 11 | 12 | Lemma string_to_vec_helper : 13 | forall a s, 14 | 8 + 8 * (String.length s) = 8 * String.length (String a s). 15 | Proof using. 16 | intros. 17 | simpl. 18 | now repeat rewrite plus_n_Sm. 19 | Qed. 20 | 21 | Fixpoint string_to_vec (s : string) : Bvector (8 * String.length s). 22 | Proof using. 23 | refine match s as s' return Bvector (8 * String.length s') with 24 | | EmptyString => Bnil 25 | | String a s' => 26 | let bv := string_to_vec s' in 27 | _ 28 | end. 29 | rewrite <- (string_to_vec_helper a s'). 30 | exact (Vector.append (ascii_to_vec a) bv). 31 | Defined. 32 | 33 | Definition fixed_length_string_to_vec {n : nat} (asc : { s : string | String.length s = n }) : Bvector (8 * n). 34 | destruct asc as [str pf]. 35 | rewrite <- pf. 36 | exact (string_to_vec str). 37 | Defined. 38 | 39 | Fixpoint bit_list_to_string (bits : list bool) : string := 40 | match bits with 41 | | b1 :: b2 :: b3 :: b4 :: b5 :: b6 :: b7 :: b8 :: rest => 42 | let a := Ascii.Ascii b1 b2 b3 b4 b5 b6 b7 b8 in 43 | String a (bit_list_to_string rest) 44 | | _ => String.EmptyString 45 | end. 46 | 47 | Definition vec_to_string {n : nat} (b : Bvector n) : string := 48 | bit_list_to_string (Vector.to_list b). 49 | -------------------------------------------------------------------------------- /lib/InfSeqTactics.v: -------------------------------------------------------------------------------- 1 | Require Import StructTact.StructTactics. 2 | Require Import InfSeqExt.infseq. 3 | 4 | (** 5 | Given a hypothesis H of the form 6 | 7 | H: forall ex, 8 | P ex -> 9 | Q ex -> 10 | rest, 11 | 12 | replace H with 13 | 14 | H: forall ex, 15 | (Q /\_ P) ex -> 16 | rest. 17 | *) 18 | Ltac accum_and_tl H P Q rest ex := 19 | let H' := fresh in 20 | rename H into H'; 21 | assert (H: forall ex, (and_tl Q P) ex -> rest) 22 | by (intros; invcs_prop and_tl; auto); 23 | clear H'. 24 | 25 | Ltac prep_eventually_monotonic := 26 | repeat lazymatch goal with 27 | | [H: forall ex, ?fst ex -> ?P ex -> @?conclusion ex, 28 | H_P : eventually ?P ?s |- _] => 29 | fail 30 | | H: forall ex, ?fst ex -> ?snd ex -> ?tl |- _ => 31 | accum_and_tl H fst snd tl ex 32 | | H: forall ex, ?fst ex -> @?snd ex -> ?tl |- _ => 33 | accum_and_tl H fst snd tl ex 34 | | H: forall ex, @?fst ex -> ?snd ex -> ?tl |- _ => 35 | accum_and_tl H fst snd tl ex 36 | | H: forall ex, @?fst ex -> @?snd ex -> ?tl |- _ => 37 | accum_and_tl H fst snd tl ex 38 | end. 39 | 40 | Ltac prep_always_inv := 41 | apply always_inv; 42 | unfold and_tl in *; 43 | [intros; repeat break_and; break_and_goal|tauto]. 44 | 45 | Ltac lift_eventually lem := 46 | pose proof lem; 47 | unfold continuously in *; 48 | prep_eventually_monotonic; 49 | eapply eventually_monotonic; eauto; 50 | try prep_always_inv. 51 | 52 | 53 | (* would be nice to be able to tell which possible invariant things are actually 54 | going to be invariants before we apply inf_often_monotonic_invar, maybe a 55 | typeclass would help? *) 56 | Ltac prep_inf_often_monotonic_invar := 57 | repeat lazymatch goal with 58 | | [H: forall ex, ?fst ex -> ?P ex -> @?conclusion ex, 59 | H_P : inf_often ?P ?s |- inf_often ?conclusion ?s] => 60 | fail 61 | | H: forall ex, ?fst ex -> ?snd ex -> ?tl |- _ => 62 | accum_and_tl H fst snd tl ex 63 | | H: forall ex, ?fst ex -> @?snd ex -> ?tl |- _ => 64 | accum_and_tl H fst snd tl ex 65 | | H: forall ex, @?fst ex -> ?snd ex -> ?tl |- _ => 66 | accum_and_tl H fst snd tl ex 67 | | H: forall ex, @?fst ex -> @?snd ex -> ?tl |- _ => 68 | accum_and_tl H fst snd tl ex 69 | end. 70 | 71 | Ltac lift_inf_often lem := 72 | pose proof lem; 73 | prep_inf_often_monotonic_invar; 74 | eapply inf_often_monotonic_invar; eauto; 75 | try prep_always_inv. 76 | 77 | Ltac prep_always_monotonic := 78 | repeat lazymatch goal with 79 | (* | [H: forall ex, ?fst ex -> ?P ex -> @?conclusion ex, *) 80 | (* H_P : always ?P ?s |- _] => *) 81 | (* accum_and_tl H fst P (conclusion ex) ex; fail *) 82 | | H: forall ex, ?fst ex -> ?snd ex -> ?tl |- _ => 83 | accum_and_tl H fst snd tl ex 84 | | H: forall ex, ?fst ex -> @?snd ex -> ?tl |- _ => 85 | accum_and_tl H fst snd tl ex 86 | | H: forall ex, @?fst ex -> ?snd ex -> ?tl |- _ => 87 | accum_and_tl H fst snd tl ex 88 | | H: forall ex, @?fst ex -> @?snd ex -> ?tl |- _ => 89 | accum_and_tl H fst snd tl ex 90 | end. 91 | 92 | Ltac lift_always lem := 93 | pose proof lem; 94 | unfold inf_often in *; 95 | prep_always_monotonic; 96 | eapply always_monotonic; eauto; 97 | try prep_always_inv. 98 | 99 | Ltac find_continuously_and_tl := 100 | match goal with 101 | | H : continuously ?P ?ex, H' : continuously ?Q ?ex |- _ => 102 | pose proof (continuously_and_tl H H'); 103 | clear H H' 104 | end. 105 | 106 | Ltac find_always_and_tl := 107 | match goal with 108 | | H : always ?P ?ex, H' : always ?Q ?ex |- _ => 109 | pose proof (always_and_tl H H'); 110 | clear H H' 111 | end. 112 | -------------------------------------------------------------------------------- /lib/Sorting.v: -------------------------------------------------------------------------------- 1 | Require Import List. 2 | Import ListNotations. 3 | Require Import Sorting.Permutation. 4 | 5 | (** 6 | Lightly adapted from Coq stdlib mergesort to not be a functor. 7 | *) 8 | 9 | Section Sorting. 10 | Variable t : Type. 11 | Variable le : t -> t -> bool. 12 | 13 | Variable le_reflexive : 14 | forall x, le x x = true. 15 | 16 | Variable le_transitive : 17 | forall x y z, 18 | le x y = true -> 19 | le y z = true -> 20 | le x z = true. 21 | 22 | Variable le_total : 23 | forall x y, 24 | le x y = true \/ le y x = true. 25 | 26 | Inductive sorted : list t -> Prop := 27 | | SortedNil : 28 | sorted [] 29 | | SortedSingleton : 30 | forall x, sorted [x] 31 | | SortedCons : 32 | forall x y l, 33 | sorted (y :: l) -> 34 | le x y = true -> 35 | sorted (x :: y :: l). 36 | 37 | (* from Coq stdlib mergesort implementation *) 38 | Fixpoint merge l1 l2 := 39 | let fix merge_aux l2 := 40 | match l1, l2 with 41 | | [], _ => l2 42 | | _, [] => l1 43 | | a1::l1', a2::l2' => 44 | if le a1 a2 45 | then a1 :: merge l1' l2 46 | else a2 :: merge_aux l2' 47 | end 48 | in merge_aux l2. 49 | 50 | Definition tstack : Type := list (option (list t)). 51 | 52 | (* from Coq stdlib mergesort implementation *) 53 | Fixpoint merge_list_to_stack (stack : tstack) (l : list t) : tstack := 54 | match stack with 55 | | [] => [Some l] 56 | | None :: stack' => Some l :: stack' 57 | | Some l' :: stack' => None :: merge_list_to_stack stack' (merge l' l) 58 | end. 59 | 60 | (* from Coq stdlib mergesort implementation *) 61 | Fixpoint merge_stack (stack : tstack) : list t := 62 | match stack with 63 | | [] => [] 64 | | None :: stack' => merge_stack stack' 65 | | Some l :: stack' => merge l (merge_stack stack') 66 | end. 67 | 68 | (* from Coq stdlib mergesort implementation *) 69 | Fixpoint iter_merge (stack : tstack) (l : list t) : list t := 70 | match l with 71 | | [] => merge_stack stack 72 | | a::l' => iter_merge (merge_list_to_stack stack [a]) l' 73 | end. 74 | 75 | (* from Coq stdlib mergesort implementation *) 76 | Definition sort : list t -> list t := 77 | iter_merge []. 78 | 79 | (* all proofs below from Coq stdlib mergesort implementation *) 80 | 81 | Local Ltac invert H := inversion H; subst; clear H. 82 | 83 | Fixpoint flatten_stack (stack : list (option (list t))) := 84 | match stack with 85 | | [] => [] 86 | | None :: stack' => flatten_stack stack' 87 | | Some l :: stack' => l ++ flatten_stack stack' 88 | end. 89 | 90 | Theorem Permuted_merge : 91 | forall l1 l2, Permutation (l1++l2) (merge l1 l2). 92 | Proof. 93 | induction l1; simpl merge; intro. 94 | - assert (forall l, (fix merge_aux (l0 : list t) : list t := l0) l = l) 95 | as -> by (destruct l; trivial). (* Technical lemma *) 96 | apply Permutation_refl. 97 | - induction l2. 98 | rewrite app_nil_r. apply Permutation_refl. 99 | destruct (le a a0). 100 | + constructor; apply IHl1. 101 | + apply Permutation_sym, Permutation_cons_app, Permutation_sym, IHl2. 102 | Qed. 103 | 104 | Theorem Permuted_merge_stack : forall stack, 105 | Permutation (flatten_stack stack) (merge_stack stack). 106 | Proof. 107 | induction stack as [|[]]; simpl. 108 | - trivial. 109 | - transitivity (l ++ merge_stack stack). 110 | + apply Permutation_app_head; trivial. 111 | + apply Permuted_merge. 112 | - assumption. 113 | Qed. 114 | 115 | Theorem Permuted_merge_list_to_stack : 116 | forall stack l, 117 | Permutation (l ++ flatten_stack stack) 118 | (flatten_stack (merge_list_to_stack stack l)). 119 | Proof. 120 | induction stack as [|[]]; simpl; intros. 121 | - reflexivity. 122 | - rewrite app_assoc. 123 | etransitivity. 124 | + apply Permutation_app_tail. 125 | etransitivity. 126 | * apply Permutation_app_comm. 127 | * apply Permuted_merge. 128 | + apply IHstack. 129 | - reflexivity. 130 | Qed. 131 | 132 | Theorem Permuted_iter_merge : forall l stack, 133 | Permutation (flatten_stack stack ++ l) (iter_merge stack l). 134 | Proof. 135 | induction l; simpl; intros. 136 | - rewrite app_nil_r. apply Permuted_merge_stack. 137 | - change (a::l) with ([a]++l). 138 | rewrite app_assoc. 139 | etransitivity. 140 | + apply Permutation_app_tail. 141 | etransitivity. 142 | apply Permutation_app_comm. 143 | apply Permuted_merge_list_to_stack. 144 | + apply IHl. 145 | Qed. 146 | 147 | Theorem sort_permutes : 148 | forall l l', 149 | l' = sort l -> 150 | Permutation l l'. 151 | Proof. 152 | intros; subst; apply (Permuted_iter_merge l []). 153 | Qed. 154 | 155 | Fixpoint sorted_stack stack := 156 | match stack with 157 | | [] => True 158 | | None :: stack' => sorted_stack stack' 159 | | Some l :: stack' => sorted l /\ sorted_stack stack' 160 | end. 161 | 162 | Theorem sorted_merge : forall l1 l2, 163 | sorted l1 -> sorted l2 -> sorted (merge l1 l2). 164 | Proof. 165 | induction l1; induction l2; intros; simpl; auto. 166 | destruct (le a a0) eqn:Heq1. 167 | - invert H. 168 | simpl. constructor; trivial; rewrite Heq1; constructor. 169 | assert (sorted (merge (y::l) (a0::l2))) by (apply IHl1; auto). 170 | clear H0 H3 IHl1; simpl in *. 171 | destruct (le y a0); constructor; auto || rewrite Heq1; constructor. 172 | - assert (le a0 a = true). 173 | (destruct (le_total a0 a)); auto. 174 | rewrite H1 in Heq1. 175 | congruence. 176 | invert H0. 177 | constructor; trivial. 178 | assert (sorted (merge (a::l1) (y::l))) by auto using IHl1. 179 | clear IHl2; simpl in *. 180 | destruct (le a y); constructor; auto. 181 | Qed. 182 | 183 | Theorem sorted_merge_stack : forall stack, 184 | sorted_stack stack -> sorted (merge_stack stack). 185 | Proof. 186 | induction stack as [|[|]]; simpl; intros. 187 | constructor; auto. 188 | apply sorted_merge; tauto. 189 | auto. 190 | Qed. 191 | 192 | Theorem sorted_merge_list_to_stack : forall stack l, 193 | sorted_stack stack -> sorted l -> sorted_stack (merge_list_to_stack stack l). 194 | Proof. 195 | induction stack as [|[|]]; intros; simpl. 196 | auto. 197 | apply IHstack. destruct H as (_,H1). fold sorted_stack in H1. auto. 198 | apply sorted_merge; auto; destruct H; auto. 199 | auto. 200 | Qed. 201 | 202 | Theorem sorted_iter_merge : forall stack l, 203 | sorted_stack stack -> sorted (iter_merge stack l). 204 | Proof. 205 | intros stack l H; induction l in stack, H |- *; simpl. 206 | auto using sorted_merge_stack. 207 | assert (sorted [a]) by constructor. 208 | auto using sorted_merge_list_to_stack. 209 | Qed. 210 | 211 | Theorem sorted_sort : forall l, sorted (sort l). 212 | Proof. 213 | intro; apply sorted_iter_merge. constructor. 214 | Qed. 215 | End Sorting. 216 | -------------------------------------------------------------------------------- /lib/capistrano/tasks/chord_java.rake: -------------------------------------------------------------------------------- 1 | namespace :chord_java do 2 | 3 | def chord_java_pidfile_path 4 | "#{shared_path}/extraction/chord/tmp/chord_java.pid" 5 | end 6 | 7 | def chord_java_log_path 8 | "#{shared_path}/extraction/chord/log/chord_java.log" 9 | end 10 | 11 | desc 'test start' 12 | task :test_start do 13 | on roles(:root) do |node| 14 | execute '/sbin/start-stop-daemon', 15 | '--start', 16 | '--quiet', 17 | '--oknodo', 18 | '--make-pidfile', 19 | "--pidfile #{chord_java_pidfile_path}", 20 | '--background', 21 | "--chdir #{current_path}/../../../ChordJava", 22 | '--startas /bin/bash', 23 | "-- -c 'exec java Chord #{node.properties.ip}:#{fetch(:chord_node_port)} > #{chord_java_log_path} 2>&1'" 24 | end 25 | end 26 | 27 | desc 'test stop' 28 | task :test_stop do 29 | on roles(:root) do 30 | execute '/sbin/start-stop-daemon', 31 | '--stop', 32 | '--oknodo', 33 | "--pidfile #{chord_java_pidfile_path}" 34 | end 35 | end 36 | 37 | desc 'experiment 3' 38 | task :experiment_3 do 39 | # for reference 40 | nodes = Hash[roles(:node).collect { |node| [node.properties.name, node] }] 41 | root = roles(:root).first 42 | 43 | # 0. truncate logs 44 | Rake::Task['chord_java:truncate_log'].execute 45 | 46 | # 1. start up 4 "randomly" chosen nodes 47 | on roles(:root) do |node| 48 | execute '/sbin/start-stop-daemon', 49 | '--start', 50 | '--quiet', 51 | '--oknodo', 52 | '--make-pidfile', 53 | "--pidfile #{chord_java_pidfile_path}", 54 | '--background', 55 | "--chdir #{current_path}/../../../ChordJava", 56 | '--startas /bin/bash', 57 | "-- -c 'exec java Chord #{node.properties.ip}:#{fetch(:chord_node_port)} > #{chord_java_log_path} 2>&1'" 58 | end 59 | 60 | on roles(:base) do |node| 61 | execute '/sbin/start-stop-daemon', 62 | '--start', 63 | '--quiet', 64 | '--oknodo', 65 | '--make-pidfile', 66 | "--pidfile #{chord_java_pidfile_path}", 67 | '--background', 68 | "--chdir #{current_path}/../../../ChordJava", 69 | '--startas /bin/bash', 70 | "-- -c 'exec java Chord #{node.properties.ip}:#{fetch(:chord_node_port)} #{root.properties.ip}:#{fetch(:chord_node_port)} > #{chord_java_log_path} 2>&1'" 71 | end 72 | 73 | # 2. pause to stabilize 4-node ring 74 | sleep(20) 75 | 76 | # 3. start 4 new "randomly" chosen nodes 77 | on roles(:ext) do |node| 78 | known = nodes[node.properties.known] 79 | execute '/sbin/start-stop-daemon', 80 | '--start', 81 | '--quiet', 82 | '--oknodo', 83 | '--make-pidfile', 84 | "--pidfile #{chord_java_pidfile_path}", 85 | '--background', 86 | "--chdir #{current_path}/../../../ChordJava", 87 | '--startas /bin/bash', 88 | "-- -c 'exec java Chord #{node.properties.ip}:#{fetch(:chord_node_port)} #{known.properties.ip}:#{fetch(:chord_node_port)} > #{chord_java_log_path} 2>&1'" 89 | end 90 | 91 | # 4. pause to stabilize 8-node ring 92 | sleep(20) 93 | 94 | # 5. shut down the 4 new nodes 95 | on roles(:ext) do 96 | execute '/sbin/start-stop-daemon', 97 | '--stop', 98 | '--oknodo', 99 | "--pidfile #{chord_java_pidfile_path}" 100 | end 101 | 102 | # 6. pause to stabilize 4-node ring 103 | sleep(20) 104 | 105 | # 7. stop remaining nodes 106 | on roles([:root, :base]) do 107 | execute '/sbin/start-stop-daemon', 108 | '--stop', 109 | '--oknodo', 110 | "--pidfile #{chord_java_pidfile_path}" 111 | end 112 | 113 | end 114 | 115 | desc 'truncate chord_java log' 116 | task :truncate_log do 117 | on roles(:node) do 118 | execute 'truncate', '-s 0', chord_java_log_path 119 | end 120 | end 121 | 122 | desc 'tail chord_java log' 123 | task :tail_log do 124 | on roles(:node) do 125 | execute 'tail', '-n 20', chord_java_log_path 126 | end 127 | end 128 | 129 | end 130 | -------------------------------------------------------------------------------- /lib/capistrano/tasks/chord_serialized.rake: -------------------------------------------------------------------------------- 1 | require 'digest' 2 | 3 | namespace :chord_serialized do 4 | 5 | def chord_serialized_log_path 6 | "#{shared_path}/extraction/chord-serialized/log/chord-serialized.log" 7 | end 8 | 9 | def client_serialized_log_path 10 | "#{shared_path}/extraction/chord-serialized/log/client.log" 11 | end 12 | 13 | def chord_serialized_pidfile_path 14 | "#{shared_path}/extraction/chord-serialized/tmp/chord-serialized.pid" 15 | end 16 | 17 | desc 'start serialized chord ring' 18 | task :start do 19 | ring = roles(:node).collect { |node| "-ring #{node.properties.ip}:#{fetch(:chord_serialized_node_port)}" }.join(' ') 20 | on roles(:node) do |node| 21 | execute '/sbin/start-stop-daemon', 22 | '--start', 23 | '--quiet', 24 | '--oknodo', 25 | '--make-pidfile', 26 | "--pidfile #{chord_serialized_pidfile_path}", 27 | '--background', 28 | "--chdir #{current_path}/extraction/chord-serialized", 29 | '--startas /bin/bash', 30 | "-- -c 'exec ./chordserialized.native -bind #{node.properties.ip}:#{fetch(:chord_serialized_node_port)} #{ring} > log/chord-serialized.log 2>&1'" 31 | end 32 | end 33 | 34 | desc 'start serialized chord with known' 35 | task :start_known do 36 | nodes = Hash[roles(:node).collect { |node| [node.properties.name, node] }] 37 | on roles(:node) do |node| 38 | known = nodes[ENV['KNOWN']] 39 | execute '/sbin/start-stop-daemon', 40 | '--start', 41 | '--quiet', 42 | '--oknodo', 43 | '--make-pidfile', 44 | "--pidfile #{chord_pidfile_path}", 45 | '--background', 46 | "--chdir #{current_path}/extraction/chord-serialized", 47 | '--startas /bin/bash', 48 | "-- -c 'exec ./chordserialized.native -bind #{node.properties.ip}:#{fetch(:chord_serialized_node_port)} -known #{known.properties.ip}:#{fetch(:chord_serialized_node_port)} > log/chord-serialized.log 2>&1'" 49 | end 50 | end 51 | 52 | desc 'stop serialized chord' 53 | task :stop do 54 | on roles(:node) do 55 | execute '/sbin/start-stop-daemon', 56 | '--stop', 57 | '--oknodo', 58 | "--pidfile #{chord_serialized_pidfile_path}" 59 | end 60 | end 61 | 62 | desc 'tail serialized chord log' 63 | task :tail_log do 64 | on roles(:node) do 65 | execute 'tail', '-n 20', chord_serialized_log_path 66 | end 67 | end 68 | 69 | desc 'truncate serialized chord log' 70 | task :truncate_log do 71 | on roles(:node) do 72 | execute 'truncate', '-s 0', chord_serialized_log_path 73 | end 74 | end 75 | 76 | desc 'truncate client log' 77 | task :truncate_client_log do 78 | on roles(:client) do 79 | execute 'truncate', '-s 0', client_serialized_log_path 80 | end 81 | end 82 | 83 | desc 'print entire serialized chord log' 84 | task :get_log do 85 | on roles(:node) do 86 | execute 'cat', chord_serialized_log_path 87 | end 88 | end 89 | 90 | desc 'print entire client log' 91 | task :get_client_log do 92 | on roles(:client) do 93 | execute 'cat', client_serialized_log_path 94 | end 95 | end 96 | 97 | desc 'client get ptrs' 98 | task :client_get_ptrs do 99 | nodes = Hash[roles(:node).collect { |node| [node.properties.name, node] }] 100 | node = nodes[ENV['NODE']] 101 | on roles(:client) do |client| 102 | execute "#{current_path}/extraction/chord-serialized/client.native", 103 | "-bind #{client.properties.ip}", 104 | "-node #{node.properties.ip}:#{fetch(:chord_serialized_node_port)}", 105 | "-query get_ptrs" 106 | end 107 | end 108 | 109 | desc 'client get ptrs locally' 110 | task :client_local_get_ptrs do 111 | nodes = Hash[roles(:node).collect { |node| [node.properties.name, node] }] 112 | node = nodes[ENV['NODE']] 113 | run_locally do 114 | execute 'extraction/chord-serialized/client.native', 115 | '-bind 0.0.0.0', 116 | "-node #{node.properties.ip}:#{fetch(:chord_serialized_node_port)}", 117 | '-query get_ptrs' 118 | end 119 | end 120 | 121 | desc 'client lookup' 122 | task :client_lookup do 123 | nodes = Hash[roles(:node).collect { |node| [node.properties.name, node] }] 124 | node = nodes[ENV['NODE']] 125 | hash = Digest::MD5.hexdigest(ENV['QUERY']) 126 | on roles(:client) do |client| 127 | execute "echo \"query: #{ENV['QUERY']} (#{hash})\" >> #{client_serialized_log_path} 2>&1" 128 | execute "#{current_path}/extraction/chord-serialized/client.native", 129 | "-bind #{client.properties.ip}", 130 | "-node #{node.properties.ip}:#{fetch(:chord_serialized_node_port)}", 131 | "-query lookup #{hash} >> #{client_serialized_log_path} 2>&1" 132 | end 133 | end 134 | 135 | desc 'client lookup locally' 136 | task :client_local_lookup do 137 | nodes = Hash[roles(:node).collect { |node| [node.properties.name, node] }] 138 | node = nodes[ENV['NODE']] 139 | hash = Digest::MD5.hexdigest(ENV['QUERY']) 140 | run_locally do 141 | execute 'extraction/chord-serialized/client.native', 142 | '-bind 0.0.0.0', 143 | "-node #{node.properties.ip}:#{fetch(:chord_serialized_node_port)}", 144 | "-query lookup #{hash}" 145 | end 146 | end 147 | 148 | desc 'experiment 1' 149 | task :experiment_1 do 150 | names = roles(:node).collect { |node| node.properties.name } 151 | 152 | # 0. truncate logs 153 | Rake::Task['chord_serialized:truncate_log'].execute 154 | Rake::Task['chord_serialized:truncate_client_log'].execute 155 | 156 | # 1. start up whole ring 157 | Rake::Task['chord_serialized:start'].execute 158 | 159 | # 2. pause 20 seconds 160 | sleep(20) 161 | 162 | # 3. send queries 163 | f = File.open('words100.txt') 164 | words = f.readlines 165 | words.each do |word| 166 | ENV['NODE'] = names.sample 167 | ENV['QUERY'] = word.strip 168 | Rake::Task['chord_serialized:client_lookup'].execute 169 | sleep(5) 170 | end 171 | 172 | # 4. stop ring 173 | Rake::Task['chord_serialized:stop'].execute 174 | end 175 | 176 | desc 'experiment 2' 177 | task :experiment_2 do 178 | names = roles(:node).collect { |node| node.properties.name } 179 | nodes = Hash[roles(:node).collect { |node| [node.properties.name, node] }] 180 | 181 | # 0. truncate logs 182 | Rake::Task['chord_serialized:truncate_log'].execute 183 | Rake::Task['chord_serialized:truncate_client_log'].execute 184 | 185 | # 1. start up whole ring 186 | Rake::Task['chord_serialized:start'].execute 187 | 188 | # 2. pause 20 seconds 189 | sleep(20) 190 | 191 | # 3. send first set of queries 192 | f = File.open('words50.txt') 193 | words = f.readlines 194 | words.each do |word| 195 | ENV['NODE'] = names.sample 196 | ENV['QUERY'] = word.strip 197 | Rake::Task['chord_serialized:client_lookup'].execute 198 | sleep(5) 199 | end 200 | 201 | # 4. stop one randomly chosen node 202 | stopped = names.sample 203 | node = nodes[stopped] 204 | on node do 205 | execute '/sbin/start-stop-daemon', 206 | '--stop', 207 | '--oknodo', 208 | "--pidfile #{chord_serialized_pidfile_path}" 209 | end 210 | 211 | # 5. send second set of queries 212 | names = names - [stopped] 213 | words.each do |word| 214 | ENV['NODE'] = names.sample 215 | ENV['QUERY'] = word.strip 216 | Rake::Task['chord_serialized:client_lookup'].execute 217 | sleep(5) 218 | end 219 | 220 | # 4. stop ring 221 | Rake::Task['chord_serialized:stop'].execute 222 | end 223 | 224 | end 225 | -------------------------------------------------------------------------------- /lib/capistrano/tasks/compilation.rake: -------------------------------------------------------------------------------- 1 | namespace :compilation do 2 | 3 | desc 'configure and compile' 4 | task :build do 5 | on roles(:node) do 6 | within release_path do 7 | execute './configure' 8 | execute :make, 9 | "-j #{fetch(:make_jobs)}", 10 | 'chord', 11 | 'chord-serialized' 12 | end 13 | end 14 | end 15 | 16 | desc 'compile' 17 | task :compile do 18 | on roles(:node) do 19 | within release_path do 20 | execute :make, 21 | "-j #{fetch(:make_jobs)}", 22 | 'chord', 23 | 'chord-serialized' 24 | end 25 | end 26 | end 27 | 28 | end 29 | 30 | after 'deploy:updated', 'compilation:build' 31 | -------------------------------------------------------------------------------- /proofalytics/.gitignore: -------------------------------------------------------------------------------- 1 | build-times.csv 2 | proof-sizes.csv 3 | proof-times.csv 4 | proof-times.ticks 5 | admit-count.txt 6 | index.html 7 | timestamp-lines 8 | dash/ 9 | -------------------------------------------------------------------------------- /proofalytics/Makefile: -------------------------------------------------------------------------------- 1 | LIBS= 2 | 3 | UNAME_S := $(shell uname -s) 4 | ifeq ($(UNAME_S),Linux) 5 | LIBS+= -lrt 6 | endif 7 | 8 | proofalytics: timestamp-lines 9 | ./proof-linter.sh 10 | ./proof-timer.sh 11 | ./mkreport.sh 12 | 13 | timestamp-lines: timestamp-lines.c 14 | gcc $< -o $@ $(LIBS) 15 | 16 | publish: 17 | ./publish.sh 18 | 19 | clean: 20 | rm -f build-times.csv proof-sizes.csv 21 | rm -f proof-times.csv proof-times.ticks 22 | rm -f index.html 23 | rm -f timestamp-lines 24 | 25 | .PHONY: proofalytics publish clean 26 | -------------------------------------------------------------------------------- /proofalytics/admits-links.awk: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | FS = "-|:" 3 | if(commit == "") { 4 | commit = "master" 5 | } 6 | gh = "https://github.com/DistributedComponents/verdi-chord/blob/" commit 7 | } 8 | 9 | { 10 | if(NF == 0) { 11 | print "" 12 | } else { 13 | printf(" %s:%s ", gh, $1, $2, $1, $2) 14 | ln = $0 15 | sub(/^[^-:]*[-:][^-:]*[-:]/, "", ln) 16 | print ln 17 | } 18 | } 19 | -------------------------------------------------------------------------------- /proofalytics/build-timer.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | cmd=$1 4 | shift 5 | 6 | t0=$(date +"%s") 7 | "$cmd" "$@" 8 | exit_code=$? 9 | t1=$(date +"%s") 10 | 11 | t=$(expr $t1 - $t0) 12 | for last; do true; done 13 | printf "%s,%d\n" "$last" "$t" > "${last}.buildtime" 14 | 15 | exit $exit_code 16 | -------------------------------------------------------------------------------- /proofalytics/build-times-links.awk: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | FS = "," 3 | if(commit == "") { 4 | commit = "master" 5 | } 6 | gh = "https://github.com/DistributedComponents/verdi-chord/blob/" commit 7 | } 8 | 9 | { 10 | if (NR == 1) { 11 | print $0 12 | } else { 13 | printf("%s,%s\n", gh, $1, $1, $2) 14 | } 15 | } 16 | -------------------------------------------------------------------------------- /proofalytics/csv-sort.awk: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if(key == "") { 3 | key = 1 4 | } 5 | sort = "sort --field-separator=, --numeric-sort --reverse --key=" key 6 | } 7 | 8 | NR < 2 { 9 | print $0 10 | next 11 | } 12 | 13 | { 14 | print $0 | sort 15 | } 16 | 17 | END { 18 | close(sort) 19 | } 20 | -------------------------------------------------------------------------------- /proofalytics/csv-table.awk: -------------------------------------------------------------------------------- 1 | function isnum(x) { 2 | return (x == x + 0) 3 | } 4 | 5 | BEGIN { 6 | printf("\n") 7 | FS = "," 8 | } 9 | 10 | { 11 | printf("\n") 12 | for(i=1; i<=NF; i++) { 13 | if(NR==1) { 14 | printf("\t\n", $i) 15 | } else if(isnum($i)) { 16 | printf("\t\n", $i) 17 | } else { 18 | printf("\t\n", $i) 19 | } 20 | } 21 | printf("\n") 22 | } 23 | 24 | END { 25 | printf("
\n\t\t%s\n\t\n\t\t%s\n\t\n\t\t%s\n\t
\n") 26 | } 27 | -------------------------------------------------------------------------------- /proofalytics/plot.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | name="$(basename "$1" .csv)" 4 | tmp="$(mktemp "pa-plot-$name.XXXXXX")" 5 | 6 | cat "$1" \ 7 | | sed 's/PA-\([^-]*\)-[^,]*,\s*\(.*\)/\1 \2/g' \ 8 | | sort \ 9 | | uniq \ 10 | | grep -v '[a-z]' \ 11 | > "$tmp" 12 | 13 | gnuplot < "$PROOF_SIZES" 13 | -------------------------------------------------------------------------------- /proofalytics/proof-sizes-links.awk: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | FS = "," 3 | if(commit == "") { 4 | commit = "master" 5 | } 6 | gh = "https://github.com/DistributedComponents/verdi-chord/blob/" commit 7 | } 8 | 9 | { 10 | if (NR == 1) { 11 | print $0 12 | } else { 13 | printf("%s,", gh, $4, $5, $1) 14 | printf("%s,%s,%s,%s\n", $2, $3, $4, $5) 15 | } 16 | } 17 | -------------------------------------------------------------------------------- /proofalytics/proof-sizes.awk: -------------------------------------------------------------------------------- 1 | # TODO support Program Definition 2 | 3 | function reset() { 4 | name = "" 5 | start = 0 6 | proof = "" 7 | lines = 0 8 | words = 0 9 | } 10 | 11 | BEGIN { 12 | print "proof,lines,words,file,lineno" 13 | reset() 14 | } 15 | 16 | /Lemma|Theorem|Example|Corollary|Remark|Definition|Fixpoint|Instance/ { 17 | reset() 18 | name = $2 19 | start = FNR 20 | } 21 | 22 | { 23 | proof = proof $0 24 | lines = lines + 1 25 | words = words + NF 26 | } 27 | 28 | /Qed\.|Defined\./ { 29 | if(name != "") { 30 | sub(/:$/, "", name) 31 | fn = FILENAME 32 | sub(/^.*\.\.\//, "", fn) 33 | printf("%s,%d,%d,%s,%d\n", name, lines, words, fn, start) 34 | } 35 | reset() 36 | } 37 | -------------------------------------------------------------------------------- /proofalytics/proof-time-annot.awk: -------------------------------------------------------------------------------- 1 | function reset() { 2 | file = "" 3 | name = "" 4 | line = "" 5 | prog = 0 6 | oblg = 0 7 | } 8 | 9 | function beep() { 10 | if(file == "") { 11 | print "proof-time-annot.awk: ERROR!" > "/dev/stderr" 12 | print "no token in " FILENAME " line " FNR > "/dev/stderr" 13 | close("/dev/stderr") 14 | exit 1 15 | } 16 | if(prog) { 17 | tok = file "__PROOFALYTICS__" name "@" oblg "__PROOFALYTICS__" line 18 | } else { 19 | tok = file "__PROOFALYTICS__" name "__PROOFALYTICS__" line 20 | } 21 | printf("Eval compute in ltac:(idtac \"%s\").\n", tok) 22 | } 23 | 24 | BEGIN { 25 | reset() 26 | } 27 | 28 | /^[[:space:]]*(Lemma|Theorem|Example|Corollary|Remark|Definition|Fixpoint|Instance)/ { 29 | reset() 30 | file = FILENAME 31 | sub(/^../, "", file) 32 | name = $2 33 | line = FNR 34 | } 35 | 36 | /^[[:space:]]*Program Definition/ { 37 | reset() 38 | file = FILENAME 39 | sub(/^../, "", file) 40 | name = $3 41 | line = FNR 42 | prog = 1 43 | oblg = 0 44 | } 45 | 46 | /^[[:space:]]*(Qed|Defined)\./ { 47 | beep() 48 | } 49 | 50 | { 51 | print $0 52 | } 53 | 54 | /^[[:space:]]*Proof\./ { 55 | beep() 56 | } 57 | 58 | /^[[:space:]]*Next Obligation\./ { 59 | oblg = oblg + 1 60 | beep() 61 | } 62 | 63 | /^[[:space:]]*(Qed|Defined)\./ { 64 | beep() 65 | if(!prog) { 66 | reset() 67 | } 68 | } 69 | -------------------------------------------------------------------------------- /proofalytics/proof-timer.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | set -e 4 | 5 | PADIR="$(cd "$(dirname "${BASH_SOURCE[0]}")" && pwd)" 6 | BUILD_TIMES="${PADIR}/build-times.csv" 7 | PROOF_TIMES="${PADIR}/proof-times.csv" 8 | PROOF_TICKS="${PADIR}/proof-times.ticks" 9 | 10 | STDBUF="$([ -x "$(which gstdbuf)" ] && echo "gstdbuf" || echo "stdbuf")" 11 | SEP="__PROOFALYTICS__" 12 | 13 | # initialize sandbox, must be sibling of verdi root 14 | SANDBOX="$(mktemp -d "${PADIR}/../../proofalytics-tmp-XXXXX")" 15 | cp -R "${PADIR}/.." "${SANDBOX}/" 16 | 17 | pushd "$SANDBOX" > /dev/null 18 | # annotate proofs 19 | for v in $(find . -name '*.v'); do 20 | scratch="$(mktemp "proot-time-annot-tmp-XXXXX")" 21 | gawk --lint=fatal -f "${PADIR}/proof-time-annot.awk" "$v" > "$scratch" 22 | mv "$scratch" "$v" 23 | done 24 | 25 | # build w/ timing and no buffers 26 | make clean 27 | #./configure 28 | "$STDBUF" -i0 -o0 make proofalytics-aux \ 29 | | "$STDBUF" -i0 -o0 "${PADIR}/timestamp-lines" \ 30 | > "$PROOF_TICKS" 31 | 32 | # build times csv 33 | echo "file,time" \ 34 | | gawk --lint=fatal -v key=2 -f "${PADIR}/csv-sort.awk" \ 35 | - $(find . -name '*.buildtime') \ 36 | > "$BUILD_TIMES" 37 | 38 | # proof times csv 39 | grep "$SEP" "$PROOF_TICKS" \ 40 | | sed "s/ /$SEP/" \ 41 | | gawk --lint=fatal -f "${PADIR}/proof-times-csv.awk" \ 42 | | gawk --lint=fatal -v key=2 -f "${PADIR}/csv-sort.awk" \ 43 | > "$PROOF_TIMES" 44 | popd > /dev/null 45 | 46 | # clean up 47 | rm -rf "$SANDBOX" 48 | -------------------------------------------------------------------------------- /proofalytics/proof-times-csv.awk: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | FS = "__PROOFALYTICS__" 3 | tinit = -1 4 | name = "" 5 | t0 = tinit 6 | t1 = tinit 7 | t2 = tinit 8 | 9 | print "proof,ltac,qed,file,lineno" 10 | } 11 | 12 | { 13 | if(name != $3) { 14 | name = $3 15 | t0 = $1 16 | t1 = tinit 17 | t2 = tinit 18 | } else if(t1 == tinit) { 19 | t1 = $1 20 | } else if(t2 == tinit) { 21 | t2 = $1 22 | 23 | sub(/:$/, "", name) 24 | lt = (t1 - t0) / 1.0e6 25 | qt = (t2 - t1) / 1.0e6 26 | printf("%s,%.2f,%.2f,%s,%d\n", name, lt, qt, $2, $4) 27 | 28 | # some neighboring proofs have same name 29 | name = "" 30 | } else { 31 | print "proof-times-csv.awk: ERROR!" > "/dev/stderr" 32 | print "bad state in " FILENAME " line " FNR > "/dev/stderr" 33 | close("/dev/stderr") 34 | exit 1 35 | } 36 | } 37 | -------------------------------------------------------------------------------- /proofalytics/proof-times-links.awk: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | FS = "," 3 | if(commit == "") { 4 | commit = "master" 5 | } 6 | gh = "https://github.com/DistributedComponents/verdi-chord/blob/" commit 7 | } 8 | 9 | { 10 | if (NR == 1) { 11 | print $0 12 | } else { 13 | printf("%s,", gh, $4, $5, $1) 14 | printf("%s,%s,%s,%s\n", $2, $3, $4, $5) 15 | } 16 | } 17 | -------------------------------------------------------------------------------- /proofalytics/publish.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | set -e 4 | 5 | PADIR="$(cd "$(dirname "${BASH_SOURCE[0]}")" && pwd)" 6 | 7 | SYNC="rsync --exclude '.*' --chmod=ug=rwX --chmod=o=rX --recursive" 8 | WEB_MACH="uwplse.org" 9 | WEB_PATH="/var/www/verdi/chord-dash/" 10 | RDASH="${WEB_MACH}:${WEB_PATH}" 11 | LDASH="${PADIR}/dash/" 12 | HOST="$([ "$TRAVIS_BRANCH" != "" ] && \ 13 | echo "travis" || \ 14 | hostname -s)" 15 | BRANCH="$([ "$TRAVIS_BRANCH" != "" ] && \ 16 | echo "$TRAVIS_BRANCH" || \ 17 | git rev-parse --abbrev-ref HEAD)" 18 | NONCE=$(printf "PA-%s-%s-%s-%s" \ 19 | $(TZ="America/Los_Angeles" date "+%y%m%d") \ 20 | $(TZ="America/Los_Angeles" date "+%H%M%S") \ 21 | "$HOST" \ 22 | "$BRANCH") 23 | REPDIR="${LDASH}${NONCE}" 24 | 25 | function main { 26 | echo "SYNC remote -> local" 27 | $SYNC "$RDASH" "$LDASH" 28 | 29 | mkdir "$REPDIR" 30 | cp index.html admit-count.txt qed-count.txt *.csv "$REPDIR" 31 | # publish ticks for debugging travis ci 32 | cp *.ticks "$REPDIR" 33 | 34 | echo "report,count" > "${LDASH}/admits.csv" 35 | echo "report,count" > "${LDASH}/qeds.csv" 36 | echo "report,time" > "${LDASH}/btimes.csv" 37 | mkindex > "${LDASH}index.html" 38 | echo "$(date) $(cat admit-count.txt)" >> "${LDASH}admit-log.txt" 39 | echo "$(date) $(cat qed-count.txt)" >> "${LDASH}qed-log.txt" 40 | 41 | pushd "$LDASH" > /dev/null 42 | ${PADIR}/plot.sh admits.csv 43 | ${PADIR}/plot.sh qeds.csv 44 | ${PADIR}/plot.sh btimes.csv 45 | popd > /dev/null 46 | 47 | echo "SYNC local -> remote" 48 | $SYNC "$LDASH" "$RDASH" 49 | } 50 | 51 | function mkindex { 52 | pushd "$LDASH" > /dev/null 53 | 54 | cat < 56 | 57 | 58 | 59 | Verdi Chord Proofalytics 60 | 102 | 103 | 104 |

Verdi Chord Proofalytics

105 |
106 |
107 |
108 | 147 |
    148 | EOF 149 | for rep in $(ls -r | grep 'PA-*'); do 150 | echo "
  • " 151 | 152 | d=$(echo $rep \ 153 | | sed 's|^...\([0-9][0-9]\)\([0-9][0-9]\)\([0-9][0-9]\).*$|20\1-\2-\3|') 154 | t=$(echo $rep \ 155 | | sed 's|^..........\([0-9][0-9]\)\([0-9][0-9]\)\([0-9][0-9]\).*$|\1:\2:\3|') 156 | h=$(echo $rep \ 157 | | gawk --lint=fatal -F "-" \ 158 | '{printf("%s", $4); \ 159 | for(i=5; i%s \ 164 |  at  %s \ 165 |  on  %s \ 166 |  in  %s\n" \ 167 | "$rep" "$d" "$t" "$h" "$b" 168 | 169 | echo "
     " 170 | echo "max ltac:  " 171 | cat "${rep}/proof-times.csv" \ 172 | | gawk --lint=fatal -v key=2 -f "${PADIR}/csv-sort.awk" \ 173 | | gawk --lint=fatal -F "," 'NR == 2 {print $1 " (" int($2/1000) " s)"}' 174 | 175 | echo "
     " 176 | echo "max qed:  " 177 | cat "${rep}/proof-times.csv" \ 178 | | gawk --lint=fatal -v key=3 -f "${PADIR}/csv-sort.awk" \ 179 | | gawk --lint=fatal -F "," 'NR == 2 {print $1 " (" int($2/1000) " s)"}' 180 | 181 | echo "
     " 182 | echo "build time:  " 183 | btime=$(gawk --lint=fatal \ 184 | 'BEGIN { FS = ","; tot = 0 } \ 185 | { tot += $2 } \ 186 | END { print tot }' \ 187 | "${rep}/build-times.csv") 188 | echo "$btime s" 189 | echo "${rep},$btime" >> "${LDASH}btimes.csv" 190 | 191 | if [ -f "${rep}/admit-count.txt" ]; then 192 | echo "
     " 193 | echo "admits:  " 194 | cat "${rep}/admit-count.txt" 195 | echo -n "${rep}," >> "${LDASH}admits.csv" 196 | cat "${rep}/admit-count.txt" >> "${LDASH}admits.csv" 197 | fi 198 | 199 | if [ -f "${rep}/qed-count.txt" ]; then 200 | echo "
     " 201 | echo "qeds:  " 202 | cat "${rep}/qed-count.txt" 203 | echo -n "${rep}," >> "${LDASH}qeds.csv" 204 | cat "${rep}/qed-count.txt" >> "${LDASH}qeds.csv" 205 | fi 206 | 207 | echo "
    • " 208 | done 209 | cat < 211 | 212 | 213 | EOF 214 | popd > /dev/null 215 | } 216 | 217 | main 218 | -------------------------------------------------------------------------------- /proofalytics/timestamp-lines.awk: -------------------------------------------------------------------------------- 1 | { 2 | printf("%s %s\n", strftime("%H%M%s"), $0); 3 | } 4 | -------------------------------------------------------------------------------- /proofalytics/timestamp-lines.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | 5 | // OS X does not have clock_gettime, use clock_get_time 6 | #ifdef __MACH__ 7 | #include 8 | #include 9 | #endif 10 | 11 | int 12 | main() { 13 | #ifdef __MACH__ 14 | clock_serv_t cclock; 15 | mach_timespec_t mts; 16 | host_get_clock_service(mach_host_self(), SYSTEM_CLOCK, &cclock); 17 | #endif 18 | struct timespec ts; 19 | char *line = NULL; 20 | size_t cap = 0; 21 | size_t len = 0; 22 | while((len = getline(&line, &cap, stdin)) != -1) { 23 | #ifdef __MACH__ 24 | clock_get_time(cclock, &mts); \ 25 | ts.tv_sec = mts.tv_sec; \ 26 | ts.tv_nsec = mts.tv_nsec; 27 | #else 28 | clock_gettime(CLOCK_REALTIME, &ts); 29 | #endif 30 | printf("%20f ", ts.tv_sec * 1.0e9 + ts.tv_nsec); 31 | fwrite(line, len, 1, stdout); 32 | } 33 | #ifdef __MACH__ 34 | mach_port_deallocate(mach_task_self(), cclock); 35 | #endif 36 | return 0; 37 | } 38 | -------------------------------------------------------------------------------- /script/checkpaths.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | set -e 4 | 5 | if ! [ -f _CoqProject ]; then 6 | exit 0 7 | fi 8 | 9 | if [ "${TRAVIS}x" != "x" ]; then 10 | exit 0 11 | fi 12 | 13 | 14 | grep '\.v' _CoqProject | sort > build.files 15 | find . -name '*.v' | sed 's!^\./!!' | sort > files 16 | 17 | comm -23 files build.files > files.missing.from.build 18 | comm -13 files build.files > nonexistant.build.files 19 | 20 | EXIT_CODE=0 21 | 22 | if [ -s files.missing.from.build ] 23 | then 24 | echo 'The following files are present but missing from Makefile.coq.' 25 | echo 'Perhaps you have added a new file and should rerun ./configure?' 26 | cat files.missing.from.build 27 | EXIT_CODE=1 28 | fi 29 | 30 | if [ -s nonexistant.build.files ] 31 | then 32 | echo 'The following files are present in Makefile.coq but to not exist.' 33 | echo 'Perhaps you have deleted a file and should rerun ./configure?' 34 | cat nonexistant.build.files 35 | EXIT_CODE=1 36 | fi 37 | 38 | rm -f files build.files files.missing.from.build nonexistant.build.files 39 | exit $EXIT_CODE 40 | -------------------------------------------------------------------------------- /script/coqproject.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | ### coqproject.sh 4 | ### Creates a _CoqProject file, including external dependencies. 5 | 6 | ### See the README.md file for a description. 7 | 8 | ## Implementation 9 | 10 | if [ -z ${DIRS+x} ]; then DIRS=(.); fi 11 | 12 | COQPROJECT_TMP=_CoqProject.tmp 13 | 14 | rm -f $COQPROJECT_TMP 15 | touch $COQPROJECT_TMP 16 | 17 | function dep_dirs_lines(){ 18 | dep_dirs_var="$2"_DIRS 19 | local -a 'dep_dirs=("${'"$dep_dirs_var"'[@]}")' 20 | if [ "x${dep_dirs[0]}" = "x" ]; then dep_dirs=(.); fi 21 | for dep_dir in "${dep_dirs[@]}"; do 22 | namespace_var=NAMESPACE_"$2"_"$dep_dir" 23 | namespace_var=${namespace_var//\//_} 24 | namespace_var=${namespace_var//-/_} 25 | namespace_var=${namespace_var//./_} 26 | namespace=${!namespace_var:=$2} 27 | if [ $dep_dir = "." ]; then 28 | LINE="-Q $1 $namespace" 29 | else 30 | LINE="-Q $1/$dep_dir $namespace" 31 | fi 32 | echo $LINE >> $COQPROJECT_TMP 33 | done 34 | } 35 | for dep in ${DEPS[@]}; do 36 | path_var="$dep"_PATH 37 | if [ ! "x${!path_var}" = "x" ]; then 38 | path=${!path_var} 39 | if [ ! -d "$path" ]; then 40 | echo "$dep not found at $path." 41 | exit 1 42 | fi 43 | 44 | pushd "$path" > /dev/null 45 | path=$(pwd) 46 | popd > /dev/null 47 | echo "$dep found at $path" 48 | 49 | dep_dirs_lines $path $dep 50 | fi 51 | done 52 | 53 | COQTOP="coqtop $(cat $COQPROJECT_TMP)" 54 | function check_canary(){ 55 | echo "Require Import $@." | $COQTOP 2>&1 | grep -i error 1> /dev/null 2>&1 56 | } 57 | i=0 58 | len="${#CANARIES[@]}" 59 | while [ $i -lt $len ]; do 60 | if check_canary ${CANARIES[$i]}; then 61 | echo "Error: ${CANARIES[$((i + 1))]}" 62 | exit 1 63 | fi 64 | let "i+=2" 65 | done 66 | 67 | for dir in ${DIRS[@]}; do 68 | namespace_var=NAMESPACE_"$dir" 69 | namespace_var=${namespace_var//\//_} 70 | namespace_var=${namespace_var//-/_} 71 | namespace_var=${namespace_var//./_} 72 | namespace=${!namespace_var:="''"} 73 | LINE="-Q $dir $namespace" 74 | echo $LINE >> $COQPROJECT_TMP 75 | done 76 | 77 | for dir in ${DIRS[@]}; do 78 | echo >> $COQPROJECT_TMP 79 | find $dir -iname '*.v' -not -name '*\#*' >> $COQPROJECT_TMP 80 | done 81 | 82 | for extra in ${EXTRA[@]}; do 83 | if ! grep --quiet "^$extra\$" $COQPROJECT_TMP; then 84 | echo >> $COQPROJECT_TMP 85 | echo $extra >> $COQPROJECT_TMP 86 | fi 87 | done 88 | 89 | mv $COQPROJECT_TMP _CoqProject 90 | -------------------------------------------------------------------------------- /script/extract_record_notation.py: -------------------------------------------------------------------------------- 1 | # This is the hackiest thing, but it will come in handy. 2 | 3 | import sys 4 | import re 5 | 6 | file_name = sys.argv[1] 7 | record_name = sys.argv[2] 8 | 9 | file = open(file_name).read() 10 | 11 | comment_regex = r'\(\*.*\*\)' 12 | record_regex = r'(Record %s.*\{(.*)\}\.)' % record_name 13 | record_sep = ';' 14 | field_name_regex = r'\s*(\w+)\s*:\s*' 15 | variable_regex = r'Variable ([^.]*)\.' 16 | 17 | n_variables = len(re.findall(variable_regex, file)) 18 | 19 | uncommented_file = re.sub(comment_regex, '', file) 20 | fields = re.search(record_regex, uncommented_file, re.DOTALL).group(2).split(record_sep) 21 | field_names = [re.match(field_name_regex, field).group(1) for field in fields] 22 | 23 | setters = "" 24 | notations = "" 25 | arguments = "" 26 | variables = ' _' * n_variables 27 | 28 | constructor_name = "mk" + record_name[0].upper() + record_name[1:] 29 | 30 | for field_name in field_names: 31 | setters += "\n\nDefinition set_%s_%s a v := %s" % (record_name,field_name,constructor_name) 32 | for fn in field_names: 33 | if fn == field_name: 34 | setters += " v" 35 | else: 36 | setters += " (%s a)" % fn 37 | setters += "." 38 | 39 | notations += "\n\nNotation \"{[ a 'with' '%s' := v ]}\" := (set_%s_%s %s a v)." % (field_name, record_name,field_name,variables) 40 | arguments += "\n\nArguments set_%s_%s %s/." % (record_name, field_name, " _" * (n_variables + 2)) 41 | 42 | setters += "\n" 43 | 44 | lines = file.split("\n") 45 | 46 | print "\n".join(lines[:-2]) 47 | print setters 48 | print "\n".join(lines[-2:]) 49 | print notations 50 | print arguments 51 | -------------------------------------------------------------------------------- /script/find-bad-imports.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | function find-line { 4 | DIR=$1; shift 5 | EXCLUDE_PATH_REGEX=$1; shift 6 | LINE=$1; shift 7 | 8 | find -E "$DIR" -name '*.v' \( -not -regex "$EXCLUDE_PATH_REGEX" \) -exec grep -Hni "$LINE" {} \+ 9 | } 10 | 11 | function find-redundant-imports { 12 | FILE_OF_IMPORTS=$1; shift 13 | EXCLUDE_PATH_REGEX=$1; shift 14 | 15 | sed -nE '/^[[:space:]]*(Require)?[[:space:]]+(Export)/p' "$FILE_OF_IMPORTS" | while read line 16 | do 17 | find-line "." "$EXCLUDE_PATH_REGEX" "${line//Export/Import}" 18 | done 19 | } 20 | 21 | echo "Looking for redundant imports." 22 | find-redundant-imports core/Verdi.v ".*/(core|lib)/.*" 23 | find-redundant-imports raft/Raft.v "(.*/(core|lib|systems)/.*)|(.*/Raft.v)" 24 | 25 | 26 | # Delete imports: 27 | # find . -proofs/ -name '*.v' \( -not -path '*/core/*' \) \ 28 | # -print -exec sed -ibak '/Require Import Net/d' {} \; 29 | 30 | echo "Looking for orphaned imports." 31 | find . -name '*.v' \( -not -path '*/lib/*' \) -exec awk -f script/orphaned-imports.awk {} \; 32 | -------------------------------------------------------------------------------- /script/find-unused-imports.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | function find_unused_imports_of_file { 4 | FILE=$1; shift 5 | 6 | echo "Considering file $FILE" 7 | 8 | cp "$FILE" "${FILE}.bak" 9 | N=0 10 | while read line 11 | do 12 | N=$((N+1)) 13 | echo "read line $N:" 14 | echo "$line" 15 | 16 | # We assume that all imports happen at the top of the file. 17 | # We allow blank lines and lines containing "Arguments" to be 18 | # contained in the imports section. 19 | if [[ "$line" =~ .*(Require|Import|Export|Arguments).*|^[[:space:]]*$ ]] 20 | then 21 | # Only check import statements for necessity, not blank 22 | # lines or Arguments commands. 23 | if [[ "$line" =~ .*(Require|Import|Export).* ]] 24 | then 25 | echo; echo; echo 26 | echo "Testing whether $line is necessary" 27 | 28 | sed -i "${N}d" "$FILE" 29 | 30 | TARGET="$(dirname $FILE)/$(basename $FILE .v).vo" 31 | rm -f "$TARGET" 32 | make -f Makefile.coq "$TARGET" 33 | exit_code=$? 34 | if [[ $exit_code -eq 0 ]] 35 | then 36 | echo "Build still passed with line $N removed from $FILE: " 37 | echo "$line" 38 | fi 39 | cp "${FILE}.bak" "$FILE" 40 | fi 41 | else 42 | break 43 | fi 44 | done < "$FILE.bak" 45 | rm -f "$FILE.bak" 46 | } 47 | 48 | git status | grep modified && { echo ERROR: working directory not clean; exit 1; } 49 | 50 | export -f find_unused_imports_of_file 51 | find . -name '*.v' -exec /bin/bash -c 'find_unused_imports_of_file "$0"' {} \; 52 | -------------------------------------------------------------------------------- /script/orphaned-imports.awk: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | importing = 1 3 | 4 | import_regex = "Require|Import|Export" 5 | } 6 | 7 | 8 | # many Verdi files contain an Arguments command in the middle of the imports 9 | # so we allow that here but do not count later occurences in the file 10 | # as violations of the "imports first" rule 11 | ! ($0 ~ import_regex || /Arguments/ || /^[[:space:]]*$/) { 12 | importing = 0 \ 13 | } 14 | 15 | $0 ~ import_regex { 16 | if (importing == 0) { 17 | printf("Orphaned import in %s!\n", FILENAME) 18 | printf("%s\n", $0) 19 | } 20 | } 21 | -------------------------------------------------------------------------------- /script/time-coqc.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | log=$1 4 | shift 5 | 6 | t0=$(date +"%s") 7 | coqc $@ 8 | t1=$(date +"%s") 9 | 10 | t=$(expr $t1 - $t0) 11 | for last; do true; done 12 | printf "%3d : %s\n" "$t" "$last" >> "$log" 13 | -------------------------------------------------------------------------------- /systems/chord-props/FirstSuccNeverSelf.v: -------------------------------------------------------------------------------- 1 | Require Import List. 2 | Import ListNotations. 3 | 4 | Require Import Chord.Chord. 5 | 6 | Require Import Chord.SystemReachable. 7 | 8 | Definition has_first_succ (gst : global_state) (h : addr) (s : pointer) : Prop := 9 | exists st, 10 | sigma gst h = Some st /\ 11 | hd_error (succ_list st) = Some s. 12 | 13 | Lemma has_first_succ_intro : 14 | forall gst h s st, 15 | sigma gst h = Some st -> 16 | hd_error (succ_list st) = Some s -> 17 | has_first_succ gst h s. 18 | Proof. 19 | intros. 20 | eexists; eauto. 21 | Qed. 22 | 23 | Theorem first_succ_never_self : 24 | forall gst h s, 25 | reachable_st gst -> 26 | has_first_succ gst h s -> 27 | h <> (addr_of s). 28 | Proof. 29 | (* 30 | Easy consequence of the (difficult) Zave invariant. 31 | 32 | DIFFCULTY: 1 33 | USED: In phase two. 34 | *) 35 | Admitted. -------------------------------------------------------------------------------- /systems/chord-props/HashInjective.v: -------------------------------------------------------------------------------- 1 | Require Import List. 2 | Import ListNotations. 3 | 4 | Require Import StructTact.StructTactics. 5 | Require Import StructTact.Util. 6 | 7 | Require Import Chord.Chord. 8 | Require Import Chord.SystemReachable. 9 | 10 | Set Bullet Behavior "Strict Subproofs". 11 | 12 | Lemma nodes_same_hash_still_injective : 13 | forall gst gst', 14 | nodes gst = nodes gst' -> 15 | hash_injective_on gst -> 16 | hash_injective_on gst'. 17 | Proof. 18 | unfold hash_injective_on. 19 | intros; repeat find_rewrite; auto. 20 | Qed. 21 | Hint Resolve nodes_same_hash_still_injective. 22 | 23 | Theorem hash_injective_invariant : 24 | forall gst, 25 | reachable_st gst -> 26 | hash_injective_on gst. 27 | Proof. 28 | eapply chord_net_invariant; do 2 autounfold; intros; 29 | try solve [inv_prop initial_st; tauto 30 | |eapply nodes_same_hash_still_injective; try eassumption; 31 | subst; auto]. 32 | unfold hash_injective_on, start_constraint in *; intros. 33 | repeat find_rewrite; in_crush; 34 | exfalso; find_eapply_prop hash; 35 | solve [repeat find_rewrite; now apply in_map 36 | |repeat find_reverse_rewrite; now apply in_map]. 37 | Qed. 38 | -------------------------------------------------------------------------------- /systems/chord-props/LiveNodeHasTickInTimeouts.v: -------------------------------------------------------------------------------- 1 | Require Import List. 2 | Import ListNotations. 3 | 4 | Require Import Omega. 5 | 6 | Require Import StructTact.StructTactics. 7 | Require Import StructTact.Update. 8 | Require Import StructTact.Util. 9 | 10 | Require Import InfSeqExt.infseq. 11 | 12 | Require Import Chord.Chord. 13 | 14 | Require Import Chord.SystemReachable. 15 | Require Import Chord.SystemLemmas. 16 | Require Import Chord.HandlerLemmas. 17 | 18 | Set Bullet Behavior "Strict Subproofs". 19 | 20 | Lemma live_node_fail_node : 21 | forall h h' gst, 22 | live_node (fail_node gst h) h' -> 23 | live_node gst h'. 24 | Proof. 25 | intros. 26 | unfold live_node in *. simpl in *. 27 | intuition. 28 | Qed. 29 | 30 | Ltac simpler := repeat (repeat find_inversion; subst; simpl in *; repeat rewrite_update); auto. 31 | 32 | Lemma do_delayed_queries_never_clears_tick : 33 | forall (h : addr) (st st' : data) (ms : list (addr * payload)) 34 | (nts cts : list timeout), 35 | do_delayed_queries h st = (st', ms, nts, cts) -> 36 | ~ In Tick cts. 37 | Proof. 38 | intros. 39 | unfold do_delayed_queries in *. 40 | break_match; simpl in *; subst; find_inversion; simpl in *; intuition; congruence. 41 | Qed. 42 | 43 | Lemma tick_not_in_timeouts_in : 44 | forall st, 45 | ~ In Tick (timeouts_in st). 46 | Proof. 47 | intros. 48 | unfold timeouts_in. 49 | repeat break_match; in_crush. 50 | discriminate. 51 | Qed. 52 | 53 | Lemma handle_msg_never_clears_tick : 54 | forall (h h' : addr) (st st' : data) m (ms : list (addr * payload)) 55 | (nts cts : list timeout), 56 | handle_msg h h' st m = (st', ms, nts, cts) -> 57 | ~ In Tick cts. 58 | Proof. 59 | intros. 60 | unfold handle_msg in *. 61 | repeat (break_match; simpler); 62 | unfold handle_query_res in *; repeat (break_match; simpler); 63 | unfold handle_query_req_busy in *; repeat (break_match; simpler); 64 | unfold handle_stabilize in *; repeat (break_match; simpler); 65 | unfold schedule_rectify_with in *; repeat (break_match; simpler); 66 | unfold end_query in *; repeat (break_match; simpler); 67 | unfold handle_rectify in *; repeat (break_match; simpler); 68 | unfold start_query in *; repeat (break_match; simpler); 69 | eauto using tick_not_in_timeouts_in; 70 | in_crush; eauto using tick_not_in_timeouts_in; try discriminate; 71 | eapply tick_not_in_timeouts_in; eauto. 72 | Qed. 73 | 74 | Lemma handle_msg_adds_tick_when_setting_joined : 75 | forall (h h' : addr) (st st' : data) m (ms : list (addr * payload)) 76 | (nts cts : list timeout), 77 | joined st = false -> 78 | joined st' = true -> 79 | handle_msg h h' st m = (st', ms, nts, cts) -> 80 | In Tick nts. 81 | Proof. 82 | intros. 83 | unfold handle_msg in *. 84 | repeat (break_match; simpler); 85 | unfold handle_query_res in *; repeat (break_match; simpler); 86 | unfold handle_query_req_busy in *; repeat (break_match; simpler); 87 | unfold handle_stabilize in *; repeat (break_match; simpler); 88 | unfold schedule_rectify_with in *; repeat (break_match; simpler); 89 | unfold end_query in *; repeat (break_match; simpler); 90 | unfold handle_rectify in *; repeat (break_match; simpler); 91 | unfold start_query in *; repeat (break_match; simpler); congruence. 92 | Qed. 93 | 94 | Lemma live_node_has_Tick_in_timeouts' : 95 | forall gst h, 96 | reachable_st gst -> 97 | live_node gst h -> 98 | In Tick (timeouts gst h). 99 | Proof. 100 | intros. induct_reachable_st; intros. 101 | - unfold live_node in *. 102 | rewrite Tick_in_initial_st; eauto with datatypes. 103 | - inv_prop step_dynamic. 104 | + subst. simpl in *. 105 | unfold live_node in *. simpl in *. 106 | intuition. 107 | * subst. exfalso. rewrite_update. 108 | break_exists. intuition. 109 | solve_by_inversion. 110 | * assert (h <> h0) by 111 | (intro; 112 | subst; rewrite_update; 113 | break_exists; intuition; solve_by_inversion). 114 | repeat rewrite_update. auto. 115 | + subst. simpl in *. eauto using live_node_fail_node. 116 | + subst. simpl in *. 117 | update_destruct; subst; 118 | unfold live_node in *; simpl in *; repeat rewrite_update; auto. 119 | intuition. break_exists. intuition. find_inversion. 120 | assert (joined st = true -> In Tick (timeouts gst h)) by 121 | (intros; apply IHreachable_st; intuition; eauto). 122 | unfold timeout_handler, timeout_handler_eff in *. 123 | break_match. 124 | * unfold tick_handler in *. 125 | repeat (break_match; simpler). 126 | concludes. 127 | unfold add_tick in *. repeat break_let. 128 | subst. find_inversion. in_crush. 129 | * unfold do_rectify in *. 130 | unfold start_query in *. 131 | repeat (break_match; simpler); 132 | try solve [apply remove_preserve; simpler; congruence 133 | |right; apply remove_preserve; simpler; congruence]. 134 | right. 135 | rewrite timeouts_in_None; auto. 136 | apply remove_preserve; simpler; congruence. 137 | * unfold keepalive_handler in *. simpl in *. 138 | find_inversion. simpl in *. 139 | right. apply remove_preserve; simpler; congruence. 140 | * destruct (request_timeout_handler h st a p) as [[[? ?] ?] ?] eqn:?. 141 | repeat handler_simpl. 142 | repeat (handler_def || handler_simpl); 143 | try solve [repeat apply remove_preserve; simpler; congruence]. 144 | in_crush. 145 | right. 146 | repeat apply remove_preserve; simpler; congruence. 147 | + subst. simpl in *. 148 | update_destruct; subst; 149 | unfold live_node in *; simpl in *; repeat rewrite_update; auto. 150 | intuition. break_exists. intuition. find_inversion. 151 | assert (joined d = true -> In Tick (timeouts gst (fst (snd m)))) by 152 | (intros; apply IHreachable_st; intuition; eauto). 153 | unfold recv_handler in *. repeat break_let. 154 | find_copy_apply_lem_hyp do_delayed_queries_never_clears_tick. 155 | repeat find_inversion. in_crush. 156 | match goal with 157 | | |- In Tick (?new_do_delayed 158 | ++ remove_all ?dec ?cleared_do_delayed ?new_handle_msg) 159 | \/ In Tick (remove_all _ (?cleared_handle_msg ++ ?cleared_do_delayed) ?old) => 160 | cut (In Tick new_handle_msg \/ In Tick (remove_all dec cleared_handle_msg old)) 161 | end. 162 | { intros. intuition. 163 | - left. in_crush. right. 164 | eauto using in_remove_all_preserve. 165 | - right. rewrite remove_all_app_l. 166 | rewrite remove_all_del_comm. 167 | eauto using in_remove_all_preserve. 168 | } 169 | find_copy_apply_lem_hyp handle_msg_never_clears_tick. 170 | match goal with 171 | | H : context [joined] |- _ => 172 | erewrite <- HandlerLemmas.joined_preserved_by_do_delayed_queries in H by eauto 173 | end. 174 | destruct (joined d) eqn:?; auto. 175 | * concludes. eauto using in_remove_all_preserve. 176 | * left. 177 | eauto using handle_msg_adds_tick_when_setting_joined. 178 | + subst. simpl in *. auto. 179 | + subst. simpl in *. auto. 180 | Qed. 181 | 182 | (* 183 | New nodes have no Tick. 184 | A node with no Tick sets joined = true iff it also registers a Tick. 185 | Having a Tick is preserved by the step. 186 | USED: In phase one. 187 | *) 188 | 189 | Lemma live_node_has_Tick_in_timeouts : 190 | forall ex h, 191 | lb_execution ex -> 192 | reachable_st (occ_gst (hd ex)) -> 193 | live_node (occ_gst (hd ex)) h -> 194 | In Tick (timeouts (occ_gst (hd ex)) h). 195 | Proof. 196 | eauto using live_node_has_Tick_in_timeouts'. 197 | Qed. 198 | -------------------------------------------------------------------------------- /systems/chord-props/LiveNodePreservation.v: -------------------------------------------------------------------------------- 1 | Require Import List. 2 | Import ListNotations. 3 | 4 | Require Import StructTact.StructTactics. 5 | Require Import StructTact.Util. 6 | 7 | Require Import Chord.Chord. 8 | Require Import Chord.HandlerLemmas. 9 | Require Import Chord.SystemReachable. 10 | Require Import Chord.SystemLemmas. 11 | 12 | Lemma live_node_preserved_by_rectify : 13 | forall h, 14 | chord_rectify_invariant (fun gst => live_node gst h). 15 | Proof. 16 | do 2 autounfold; intros. 17 | break_live_node. 18 | repeat handler_def; 19 | destruct (addr_eq_dec h h0); 20 | eapply live_node_characterization; 21 | repeat find_rewrite; rewrite_update; eauto; congruence. 22 | Qed. 23 | Hint Resolve live_node_preserved_by_rectify. 24 | 25 | Lemma live_node_preserved_by_request : 26 | forall h, 27 | chord_request_invariant (fun gst => live_node gst h). 28 | Proof. 29 | do 2 autounfold; intros. 30 | break_live_node. 31 | destruct (addr_eq_dec h h0); 32 | try solve [eapply live_node_characterization; 33 | repeat find_rewrite; rewrite_update; eauto; congruence]. 34 | subst. 35 | eapply live_node_characterization; 36 | repeat find_rewrite; rewrite_update; simpl; eauto. 37 | find_injection. 38 | erewrite <- joined_preserved_by_request_timeout_handler; eauto. 39 | Qed. 40 | Hint Resolve live_node_preserved_by_request. 41 | 42 | Lemma live_node_preserved_by_keepalive : 43 | forall h, 44 | chord_keepalive_invariant (fun gst => live_node gst h). 45 | Proof. 46 | do 2 autounfold; intros. 47 | break_live_node. 48 | handler_def. 49 | destruct (addr_eq_dec h h0); 50 | eapply live_node_characterization; 51 | repeat find_rewrite; rewrite_update; eauto; congruence. 52 | Qed. 53 | Hint Resolve live_node_preserved_by_keepalive. 54 | 55 | Lemma live_node_preserved_by_tick : 56 | forall h, 57 | chord_tick_invariant (fun gst => live_node gst h). 58 | Proof. 59 | do 2 autounfold; intros. 60 | break_live_node. 61 | find_copy_apply_lem_hyp joined_preserved_by_tick_handler. 62 | destruct (addr_eq_dec h h0); 63 | eapply live_node_characterization; 64 | repeat find_rewrite; rewrite_update; eauto; congruence. 65 | Qed. 66 | Hint Resolve live_node_preserved_by_tick. 67 | 68 | Lemma live_node_join_exists_after_simple_change : 69 | forall h src dst l succs gst gst' st st', 70 | live_node_in_msg_succ_lists gst -> 71 | In (src, (dst, GotSuccList succs)) l -> 72 | (forall x, In x l -> In x (msgs gst)) -> 73 | nodes gst = nodes gst' -> 74 | failed_nodes gst = failed_nodes gst' -> 75 | sigma gst h = Some st -> 76 | sigma gst' = update addr_eq_dec (sigma gst) h (Some st') -> 77 | joined st = joined st' -> 78 | length succs > 0 -> 79 | Exists (live_node gst') (map addr_of succs). 80 | Proof. 81 | intros. 82 | assert (Exists (live_node gst) (map addr_of succs)). 83 | { 84 | unfold live_node_in_msg_succ_lists in *; break_and. 85 | find_eapply_prop live_node_in_msg_succ_lists_join; eauto. 86 | } 87 | apply Exists_exists; find_apply_lem_hyp Exists_exists. 88 | break_exists_exists; split; break_and; auto. 89 | break_live_node. 90 | destruct (addr_eq_dec x h); subst; 91 | eapply live_node_characterization; 92 | repeat find_rewrite; rewrite_update; try find_injection; eauto. 93 | Qed. 94 | 95 | Lemma live_node_exists_after_simple_change : 96 | forall h src dst l succs gst gst' st st', 97 | live_node_in_msg_succ_lists gst -> 98 | (exists p, In (src, (dst, GotPredAndSuccs p succs)) l) -> 99 | (forall x, In x l -> In x (msgs gst)) -> 100 | nodes gst = nodes gst' -> 101 | failed_nodes gst = failed_nodes gst' -> 102 | sigma gst h = Some st -> 103 | sigma gst' = update addr_eq_dec (sigma gst) h (Some st') -> 104 | joined st = joined st' -> 105 | length succs > 0 -> 106 | Exists (live_node gst') (map addr_of (chop_succs (make_pointer src :: succs))). 107 | Proof. 108 | intros. 109 | break_exists. 110 | assert (Exists (live_node gst) (map addr_of (chop_succs (make_pointer src :: succs)))). 111 | { 112 | unfold live_node_in_msg_succ_lists in *; break_and. 113 | find_eapply_prop live_node_in_msg_succ_lists'; eauto. 114 | } 115 | apply Exists_exists; find_apply_lem_hyp Exists_exists. 116 | break_exists_exists; split; break_and; auto. 117 | break_live_node. 118 | destruct (addr_eq_dec x0 h); subst; 119 | eapply live_node_characterization; 120 | repeat find_rewrite; rewrite_update; try find_injection; eauto. 121 | Qed. 122 | 123 | Lemma live_node_not_just_started : 124 | forall h gst gst' k st ms nts, 125 | ~ In h (nodes gst) -> 126 | In k (nodes gst) -> 127 | ~ In k (failed_nodes gst) -> 128 | start_handler h [k] = (st, ms, nts) -> 129 | nodes gst' = h :: nodes gst -> 130 | failed_nodes gst' = failed_nodes gst -> 131 | timeouts gst' = update addr_eq_dec (timeouts gst) h nts -> 132 | sigma gst' = update addr_eq_dec (sigma gst) h (Some st) -> 133 | msgs gst' = map (send h) ms ++ msgs gst -> 134 | trace gst' = trace gst ++ map e_send (map (send h) ms) -> 135 | forall l, 136 | live_node gst' l -> 137 | l <> h. 138 | Proof. 139 | intros; intro; subst. 140 | assert (joined st = true). 141 | { 142 | inv_prop live_node; expand_def. 143 | repeat find_rewrite; rewrite_update; congruence. 144 | } 145 | assert (joined st = false) by 146 | eauto using joining_start_handler_st_joined. 147 | congruence. 148 | Qed. 149 | 150 | Lemma live_before_start_stays_live : 151 | forall h gst gst' k st ms nts, 152 | ~ In h (nodes gst) -> 153 | In k (nodes gst) -> 154 | ~ In k (failed_nodes gst) -> 155 | start_handler h [k] = (st, ms, nts) -> 156 | nodes gst' = h :: nodes gst -> 157 | failed_nodes gst' = failed_nodes gst -> 158 | timeouts gst' = update addr_eq_dec (timeouts gst) h nts -> 159 | sigma gst' = update addr_eq_dec (sigma gst) h (Some st) -> 160 | msgs gst' = map (send h) ms ++ msgs gst -> 161 | trace gst' = trace gst ++ map e_send (map (send h) ms) -> 162 | forall l, 163 | live_node gst l -> 164 | live_node gst' l. 165 | Proof. 166 | intros. 167 | inv_prop live_node; expand_def. 168 | eapply live_node_characterization; eauto; repeat find_rewrite; 169 | solve [now rewrite_update | in_crush]. 170 | Qed. 171 | -------------------------------------------------------------------------------- /systems/chord-props/LiveNodesNotClients.v: -------------------------------------------------------------------------------- 1 | Require Import List. 2 | Require Import Chord.Chord. 3 | Require Import Chord.SystemReachable. 4 | Require Import StructTact.StructTactics. 5 | Require Import StructTact.ListTactics. 6 | Require Import StructTact.Update. 7 | 8 | Set Bullet Behavior "Strict Subproofs". 9 | 10 | Lemma nodes_not_clients : 11 | forall gst, 12 | reachable_st gst -> 13 | forall h, 14 | In h (nodes gst) -> 15 | ~ client_addr h. 16 | Proof. 17 | intros until 1. 18 | pattern gst. 19 | apply chord_net_invariant; do 2 autounfold; intros; simpl in *; 20 | try solve [repeat find_rewrite; eauto]. 21 | - inv_prop initial_st; break_and. 22 | unfold not in *; eauto. 23 | - repeat find_rewrite. 24 | simpl in *; break_or_hyp; eauto. 25 | Qed. 26 | Hint Resolve nodes_not_clients. 27 | 28 | Lemma live_nodes_not_clients : 29 | forall gst h, 30 | reachable_st gst -> 31 | live_node gst h -> 32 | ~ client_addr h. 33 | Proof. 34 | intros. unfold live_node in *. 35 | intuition. eapply nodes_not_clients; eauto. 36 | Qed. 37 | Hint Resolve live_nodes_not_clients. 38 | 39 | Lemma sent_non_client_message_means_in_nodes : 40 | forall gst src dst p, 41 | reachable_st gst -> 42 | ~ client_payload p -> 43 | In (src, (dst, p)) (msgs gst) -> 44 | In src (nodes gst). 45 | Proof. 46 | intros. 47 | generalize dependent p. 48 | generalize dependent dst. 49 | generalize dependent src. 50 | pattern gst. 51 | apply chord_net_invariant; do 2 autounfold; simpl; intros; 52 | repeat find_rewrite; intuition eauto; 53 | try solve [ 54 | find_apply_lem_hyp in_app_or; break_or_hyp; 55 | [find_apply_lem_hyp in_map_iff; break_exists; break_and; 56 | unfold send in *; find_injection; in_crush 57 | |in_crush; eauto with datatypes] 58 | ]. 59 | - inv_prop initial_st; break_and. 60 | repeat find_rewrite. 61 | in_crush. 62 | - in_crush; eauto. 63 | unfold send in *. 64 | find_injection; tauto. 65 | - simpl in *. 66 | in_crush; eauto with datatypes. 67 | Qed. 68 | Hint Resolve sent_non_client_message_means_in_nodes. 69 | 70 | Lemma sent_client_message_means_client_or_in_nodes : 71 | forall gst src dst p, 72 | reachable_st gst -> 73 | client_payload p -> 74 | In (src, (dst, p)) (msgs gst) -> 75 | In src (nodes gst) \/ client_addr src. 76 | Proof. 77 | intros. 78 | generalize dependent p. 79 | generalize dependent dst. 80 | generalize dependent src. 81 | pattern gst. 82 | apply chord_net_invariant; do 2 autounfold; simpl; intros; 83 | unfold send in *; 84 | repeat find_rewrite; intuition eauto; 85 | try solve [ 86 | find_apply_lem_hyp in_app_or; break_or_hyp; 87 | [find_apply_lem_hyp in_map_iff; break_exists; break_and; 88 | unfold send in *; find_injection; in_crush 89 | |in_crush; eauto with datatypes] 90 | ]. 91 | - inv_prop initial_st; break_and. 92 | repeat find_rewrite. 93 | in_crush. 94 | - in_crush; eauto. 95 | find_injection; tauto. 96 | find_apply_hyp_hyp; tauto. 97 | - in_crush; eauto. 98 | find_injection; tauto. 99 | - simpl in *. 100 | eapply H6; eauto. 101 | in_crush; eauto. 102 | Qed. 103 | Hint Resolve sent_client_message_means_client_or_in_nodes. 104 | -------------------------------------------------------------------------------- /systems/chord-props/LiveNodesStayLive.v: -------------------------------------------------------------------------------- 1 | Require Import StructTact.StructTactics. 2 | Require Import StructTact.Util. 3 | Require Import Verdi.DynamicNet. 4 | 5 | Require Import Chord.Chord. 6 | Require Import Chord.HandlerLemmas. 7 | 8 | Set Bullet Behavior "Strict Subproofs". 9 | 10 | Ltac live_node_invariant_finish_goal := 11 | unfold live_node in *; simpl in *; intuition; 12 | update_destruct; subst; rewrite_update; eauto; 13 | break_exists; repeat find_inversion; eexists; intuition; eauto; simpl in *; congruence. 14 | 15 | Lemma live_node_invariant : 16 | forall gst l gst' h, 17 | labeled_step_dynamic gst l gst' -> 18 | live_node gst h -> 19 | live_node gst' h. 20 | Proof. 21 | intros. 22 | match goal with 23 | | H : labeled_step_dynamic _ _ _ |- _ => 24 | inv H 25 | end. 26 | - repeat unfold timeout_handler_l, timeout_handler_eff, 27 | do_delayed_queries, clear_delayed_queries, 28 | tick_handler, keepalive_handler, do_rectify, request_timeout_handler, 29 | add_tick, handle_query_timeout, clear_query, end_query, start_query, 30 | update_query, update_succ_list in *. 31 | repeat break_match; live_node_invariant_finish_goal. 32 | - repeat handler_def || handler_simpl; 33 | repeat unfold recv_handler_l, recv_handler, 34 | handle_msg, do_delayed_queries, 35 | clear_delayed_queries, tick_handler, keepalive_handler, do_rectify, request_timeout_handler, 36 | handle_rectify, handle_query_req, 37 | handle_query_req_busy, handle_query_res, start_query, 38 | schedule_rectify_with, 39 | handle_stabilize, 40 | add_tick, 41 | update_query, update_succ_list, 42 | end_query, clear_query 43 | in *; repeat break_match; live_node_invariant_finish_goal. 44 | - live_node_invariant_finish_goal. 45 | - live_node_invariant_finish_goal. 46 | Qed. 47 | -------------------------------------------------------------------------------- /systems/chord-props/NodesAlwaysHaveLiveSuccs.v: -------------------------------------------------------------------------------- 1 | Require Import List. 2 | Import ListNotations. 3 | Require Import Omega. 4 | 5 | Require Import StructTact.StructTactics. 6 | 7 | Require Import Chord.Chord. 8 | 9 | Require Import Chord.SystemLemmas. 10 | Require Import Chord.SystemReachable. 11 | Require Import Chord.RingCorrect. 12 | 13 | Definition nonempty_succ_lists (gst : global_state) : Prop := 14 | forall h st, 15 | In h (nodes gst) -> 16 | ~ In h (failed_nodes gst) -> 17 | sigma gst h = Some st -> 18 | joined st = true -> 19 | succ_list st <> []. 20 | 21 | Lemma nodes_have_nonempty_succ_lists : 22 | forall gst, 23 | reachable_st gst -> 24 | nonempty_succ_lists gst. 25 | Proof. 26 | unfold nonempty_succ_lists. 27 | intros. 28 | assert (live_node_in_succ_lists gst) by eauto. 29 | unfold live_node_in_succ_lists in *. 30 | assert (exists s, best_succ gst h s) by 31 | eauto using live_node_characterization. 32 | break_exists_name s. 33 | inv_prop best_succ; repeat break_exists; break_and. 34 | repeat find_rewrite. 35 | find_injection. 36 | intro. 37 | repeat find_rewrite. 38 | find_apply_lem_hyp (f_equal (@length addr)). 39 | rewrite app_length in *. 40 | simpl in *; omega. 41 | Qed. 42 | -------------------------------------------------------------------------------- /systems/chord-props/NodesHaveState.v: -------------------------------------------------------------------------------- 1 | Require Import List. 2 | 3 | Require Import StructTact.StructTactics. 4 | Require Import StructTact.Util. 5 | 6 | Require Import Chord.Chord. 7 | Require Import Chord.SystemReachable. 8 | 9 | Require Import Chord.SystemLemmas. 10 | Require Import Chord.HandlerLemmas. 11 | 12 | Set Bullet Behavior "Strict Subproofs". 13 | 14 | Definition nodes_have_state_invariant (gst : global_state) := 15 | forall h, In h (nodes gst) -> 16 | exists st, 17 | sigma gst h = Some st. 18 | Hint Unfold nodes_have_state_invariant. 19 | 20 | Theorem nodes_have_state_preserved : 21 | forall gst, 22 | reachable_st gst -> 23 | nodes_have_state_invariant gst. 24 | Proof using. 25 | eapply chord_net_invariant; do 2 autounfold; intros; 26 | repeat find_rewrite; 27 | repeat (update_destruct; rewrite_update); 28 | eauto with datatypes. 29 | simpl in *; break_or_hyp; 30 | congruence || eauto. 31 | Qed. 32 | 33 | Lemma nodes_have_state : 34 | forall gst h, 35 | In h (nodes gst) -> 36 | reachable_st gst -> 37 | exists st, 38 | sigma gst h = Some st. 39 | Proof. 40 | intros. 41 | now eapply nodes_have_state_preserved. 42 | Qed. 43 | Hint Resolve nodes_have_state. 44 | 45 | Lemma only_nodes_have_state : 46 | forall gst h st, 47 | sigma gst h = Some st -> 48 | reachable_st gst -> 49 | In h (nodes gst). 50 | Proof. 51 | intros. 52 | generalize dependent st. 53 | generalize dependent h. 54 | pattern gst. 55 | eapply chord_net_invariant; do 2 autounfold; intros; 56 | repeat find_rewrite; 57 | repeat handler_simpl; 58 | eauto with datatypes. 59 | inv_prop initial_st. 60 | break_and. 61 | destruct (In_dec addr_eq_dec h (nodes gst0)); eauto. 62 | assert (sigma gst0 h = None) by auto. 63 | congruence. 64 | Qed. 65 | Hint Resolve only_nodes_have_state. 66 | 67 | Lemma in_failed_in_nodes : 68 | forall gst h, 69 | reachable_st gst -> 70 | In h (failed_nodes gst) -> 71 | In h (nodes gst). 72 | Proof. 73 | induction 1; intros. 74 | - unfold initial_st in *. 75 | intuition; repeat find_rewrite; solve_by_inversion. 76 | - invcs H0; intuition. 77 | subst. auto. 78 | Qed. 79 | -------------------------------------------------------------------------------- /systems/chord-props/NodesNotJoinedHaveNoSuccessors.v: -------------------------------------------------------------------------------- 1 | Require Import List. 2 | Import ListNotations. 3 | Require Import StructTact.StructTactics. 4 | Require Import StructTact.Update. 5 | 6 | Require Import Chord.Chord. 7 | 8 | Require Import Chord.SystemReachable. 9 | Require Import Chord.HandlerLemmas. 10 | Require Import Chord.SystemLemmas. 11 | 12 | Set Bullet Behavior "Strict Subproofs". 13 | 14 | Definition joined_for_query (q : query) := 15 | match q with 16 | | Join p => false 17 | | Join2 p => false 18 | | _ => true 19 | end. 20 | 21 | 22 | Theorem cur_request_matches_joined : 23 | forall gst, 24 | reachable_st gst -> 25 | forall h st p q m, 26 | sigma gst h = Some st -> 27 | cur_request st = Some (p, q, m) -> 28 | joined st = joined_for_query q. 29 | Proof. 30 | induction 1; intros. 31 | - unfold initial_st in *. 32 | find_apply_lem_hyp sigma_initial_st_start_handler; eauto. 33 | subst. 34 | unfold start_handler in *. 35 | repeat break_match; simpl in *; try congruence. 36 | find_inversion. reflexivity. 37 | - invcs H0; simpl in *; eauto. 38 | + update_destruct; subst; rewrite_update; simpl in *; eauto. 39 | find_inversion. simpl in *. find_inversion. reflexivity. 40 | + update_destruct; subst; rewrite_update; simpl in *; eauto. 41 | find_inversion. 42 | repeat (handler_def || handler_simpl). 43 | + update_destruct; subst; rewrite_update; simpl in *; eauto. 44 | find_inversion. 45 | repeat (handler_def || handler_simpl). 46 | Qed. 47 | 48 | Theorem cur_request_join_not_joined : 49 | forall gst, 50 | reachable_st gst -> 51 | forall h st p q m, 52 | sigma gst h = Some st -> 53 | cur_request st = Some (p, Join q, m) -> 54 | joined st = false. 55 | Proof. 56 | eauto using cur_request_matches_joined. 57 | Qed. 58 | 59 | Theorem cur_request_join2_not_joined : 60 | forall gst, 61 | reachable_st gst -> 62 | forall h st p q m, 63 | sigma gst h = Some st -> 64 | cur_request st = Some (p, Join2 q, m) -> 65 | joined st = false. 66 | Proof. 67 | eauto using cur_request_matches_joined. 68 | Qed. 69 | 70 | Theorem nodes_not_joined_have_no_successors : 71 | forall gst, 72 | reachable_st gst -> 73 | forall h st, 74 | sigma gst h = Some st -> 75 | joined st = false -> 76 | succ_list st = []. 77 | Proof. 78 | induction 1; intros. 79 | - unfold initial_st in *. 80 | find_apply_lem_hyp sigma_initial_st_start_handler; eauto. 81 | subst. 82 | unfold start_handler in *. 83 | repeat break_match; simpl in *; congruence. 84 | - invcs H0; simpl in *; eauto. 85 | + update_destruct; subst; rewrite_update; simpl in *; eauto. 86 | find_inversion. reflexivity. 87 | + update_destruct; subst; rewrite_update; simpl in *; eauto. 88 | find_inversion. 89 | repeat (handler_def || handler_simpl); 90 | find_eapply_lem_hyp cur_request_matches_joined; eauto; 91 | simpl in *; congruence. 92 | + update_destruct; subst; rewrite_update; simpl in *; eauto. 93 | find_inversion. 94 | repeat (handler_def || handler_simpl); 95 | find_eapply_lem_hyp cur_request_matches_joined; eauto; 96 | simpl in *; congruence. 97 | (* 98 | Nodes do not set their successor lists until they finish joining. I don't really 99 | know what invariants are needed here but they shouldn't be too complicated? 100 | 101 | DIFFICULTY: 2 102 | USED: In phase one 103 | *) 104 | Qed. 105 | -------------------------------------------------------------------------------- /systems/chord-props/PredNeverSelfInvariant.v: -------------------------------------------------------------------------------- 1 | Require Import List. 2 | Import ListNotations. 3 | 4 | Require Import Chord.Chord. 5 | 6 | Require Import Chord.SystemReachable. 7 | 8 | Definition has_pred (gst : global_state) (h : addr) (p : option pointer) : Prop := 9 | exists st, 10 | sigma gst h = Some st /\ 11 | pred st = p. 12 | 13 | Lemma has_pred_intro : 14 | forall gst h p st, 15 | sigma gst h = Some st -> 16 | pred st = p -> 17 | has_pred gst h p. 18 | Proof. 19 | unfold has_pred. 20 | eauto. 21 | Qed. 22 | -------------------------------------------------------------------------------- /systems/chord-props/PtrCorrectInvariant.v: -------------------------------------------------------------------------------- 1 | Require Import List. 2 | Import ListNotations. 3 | Require Import StructTact.StructTactics. 4 | Require Import StructTact.Update. 5 | 6 | Require Import Chord.Chord. 7 | 8 | Require Import Chord.SystemReachable. 9 | Require Import Chord.SystemLemmas. 10 | 11 | Set Bullet Behavior "Strict Subproofs". 12 | 13 | 14 | Lemma do_delayed_queries_ptr : 15 | forall h st st' ms ts cts, 16 | do_delayed_queries h st = (st', ms, ts, cts) -> 17 | ptr st' = ptr st. 18 | Proof. 19 | intros. 20 | unfold do_delayed_queries, clear_delayed_queries in *. 21 | break_match; find_inversion; auto. 22 | Qed. 23 | 24 | Ltac simpler := repeat (repeat find_inversion; subst; simpl in *); auto. 25 | Lemma handle_msg_ptr : 26 | forall h h' st m st' ms ts cts, 27 | handle_msg h h' st m = (st', ms, ts, cts) -> 28 | ptr st' = ptr st. 29 | Proof. 30 | intros. 31 | unfold handle_msg in *. 32 | repeat (break_match; simpler); 33 | unfold handle_query_res in *; repeat (break_match; simpler); 34 | unfold handle_query_req_busy in *; repeat (break_match; simpler); 35 | unfold handle_stabilize in *; repeat (break_match; simpler); 36 | unfold schedule_rectify_with in *; repeat (break_match; simpler); 37 | unfold end_query in *; repeat (break_match; simpler); 38 | unfold handle_rectify in *; repeat (break_match; simpler); 39 | unfold start_query in *; repeat (break_match; simpler). 40 | Qed. 41 | 42 | (* 43 | This is a very good and easy invariant. At a node h, ptr st is a copy 44 | of a pointer to h. It's set when the node starts up and never changed 45 | anywhere. 46 | 47 | USED: In phase two. 48 | *) 49 | Lemma ptr_correct : 50 | forall gst h st, 51 | reachable_st gst -> 52 | sigma gst h = Some st -> 53 | ptr st = make_pointer h. 54 | Proof. 55 | intros. induct_reachable_st. 56 | - intros. 57 | unfold initial_st in *. 58 | find_apply_lem_hyp sigma_initial_st_start_handler; simpl in *; auto. subst. 59 | unfold start_handler in *. repeat break_match; simpl; auto. 60 | - intros. invcs H0; auto. 61 | + update_destruct; subst; rewrite_update; auto. 62 | now find_inversion. 63 | + update_destruct; subst; rewrite_update; auto. 64 | find_inversion. 65 | unfold timeout_handler, timeout_handler_eff in *. 66 | break_match. 67 | * unfold tick_handler in *. break_match; simpl in *; try solve_by_inversion. 68 | break_if; simpl in *; try solve_by_inversion. 69 | unfold add_tick, start_query in *. 70 | repeat break_let. 71 | subst. find_inversion. 72 | repeat break_match; simpl in *; 73 | find_inversion; simpl; auto. 74 | * unfold do_rectify in *. simpl in *. 75 | break_match; simpl in *; try solve_by_inversion; 76 | break_match; simpl in *; try solve_by_inversion; 77 | break_match; simpl in *; try solve_by_inversion. 78 | unfold start_query, update_pred in *; 79 | repeat break_match; simpl in *; find_inversion; simpl; auto. 80 | * simpl in *. find_inversion. auto. 81 | * unfold request_timeout_handler in *. 82 | repeat break_match; simpl in *; try solve_by_inversion. 83 | subst. unfold update_pred, handle_query_timeout, do_delayed_queries in *. 84 | repeat break_match; simpl in *; try find_inversion; simpl in *; auto; 85 | repeat find_rewrite || find_injection; 86 | simpl; eauto; 87 | unfold start_query in *; 88 | repeat break_match; try find_inversion; simpl in *; auto. 89 | + update_destruct; subst; rewrite_update; auto. 90 | find_inversion. 91 | unfold recv_handler in *. repeat break_let. find_inversion. 92 | find_apply_lem_hyp do_delayed_queries_ptr. 93 | repeat find_rewrite. 94 | find_apply_lem_hyp handle_msg_ptr. 95 | repeat find_rewrite. auto. 96 | Qed. 97 | -------------------------------------------------------------------------------- /systems/chord-props/QueriesEventuallyStopMeasure.v: -------------------------------------------------------------------------------- 1 | Require Import List. 2 | Import ListNotations. 3 | Require Import Relations. 4 | Require Import Omega. 5 | 6 | Require Import StructTact.StructTactics. 7 | Require Import StructTact.Update. 8 | Require Import StructTact.Dedup. 9 | Require Import StructTact.ListTactics. 10 | Require Import StructTact.ListUtil. 11 | Require Import InfSeqExt.infseq. 12 | Require Import InfSeqExt.classical. 13 | Require Import Chord.InfSeqTactics. 14 | 15 | Require Import Chord.Chord. 16 | 17 | Require Import Chord.HandlerLemmas. 18 | Require Import Chord.SystemReachable. 19 | Require Import Chord.SystemLemmas. 20 | Require Import Chord.LabeledLemmas. 21 | Require Import Chord.ChannelLemmas. 22 | Require Import Chord.LiveNodesNotClients. 23 | Require Import Chord.QueryInvariant. 24 | Require Import Chord.NodesHaveState. 25 | 26 | Set Bullet Behavior "Strict Subproofs". 27 | 28 | Set Implicit Arguments. 29 | 30 | Section find_chain. 31 | 32 | Variable A : Type. 33 | Variable A_eq_dec : forall x y : A, {x = y} + {x <> y}. 34 | Variable all : list A. 35 | Variable nodup_all : NoDup all. 36 | Variable next : A -> option A. 37 | 38 | Variable next_in_all : 39 | forall a a', 40 | In a all -> 41 | next a = Some a' -> 42 | In a' all. 43 | 44 | Fixpoint nextn a n : option A := 45 | match n with 46 | | 0 => Some a 47 | | S n => match next a with 48 | | None => None 49 | | Some a => nextn a n 50 | end 51 | end. 52 | 53 | Variable no_cycles : 54 | forall a n, 55 | nextn a n <> Some a. 56 | 57 | Lemma nextn_in_all : 58 | forall n a a', 59 | In a all -> 60 | nextn a n = Some a' -> 61 | In a' all. 62 | Proof. 63 | induction n; intros; simpl in *. 64 | - solve_by_inversion. 65 | - break_match; try congruence. eauto. 66 | Qed. 67 | 68 | Fixpoint chain (a : A) (fuel : nat) := 69 | match fuel with 70 | | 0 => None 71 | | S fuel => 72 | match (next a) with 73 | | None => Some [a] 74 | | Some a' => 75 | match (chain a' fuel) with 76 | | None => None 77 | | Some c => 78 | Some (a :: c) 79 | end 80 | end 81 | end. 82 | 83 | Lemma more_fuel_preserves_some : 84 | forall n n' a c, 85 | n <= n' -> 86 | chain a n = Some c -> 87 | chain a n' = Some c. 88 | Proof. 89 | induction n; intros; simpl in *. 90 | - congruence. 91 | - destruct n'; try omega. 92 | simpl. 93 | break_match; intuition. 94 | destruct (chain a0 n) eqn:chain_def; try congruence. 95 | specialize (IHn n'). 96 | eapply IHn in chain_def; eauto; try omega. 97 | repeat find_rewrite. auto. 98 | Qed. 99 | 100 | Lemma sufficient_fuel' : 101 | forall fuel l a, 102 | NoDup l -> 103 | (forall a' n, nextn a n = Some a' -> In a' l) -> 104 | S (length l) <= fuel -> 105 | exists c, 106 | chain a fuel = Some c. 107 | Proof. 108 | induction fuel; intros. 109 | - simpl in *. omega. 110 | - simpl. 111 | break_match; eauto. 112 | specialize (IHfuel (remove A_eq_dec a0 l) a0). 113 | conclude_using ltac:(eauto using remove_NoDup). 114 | forward IHfuel. 115 | { 116 | intros. 117 | apply remove_preserve. 118 | - intro. subst. intuition. eauto. 119 | - cut (nextn a (S n) = Some a'); eauto. 120 | simpl. repeat find_rewrite. auto. 121 | } 122 | concludes. 123 | assert (length l <> 0). 124 | { 125 | destruct l; simpl in *; auto. 126 | cut (nextn a 1 = Some a0); eauto. 127 | simpl. repeat find_rewrite. auto. 128 | } 129 | forward IHfuel. 130 | { 131 | cut (S (length (remove A_eq_dec a0 l)) = length l); [omega|]. 132 | eapply remove_length_in; eauto. 133 | cut (nextn a 1 = Some a0); eauto. 134 | simpl. repeat find_rewrite. auto. 135 | } concludes. 136 | break_exists. repeat find_rewrite. eauto. 137 | Qed. 138 | 139 | Lemma sufficient_fuel : 140 | forall a, 141 | In a all -> 142 | exists c, 143 | chain a (length all) = Some c. 144 | Proof. 145 | intros. 146 | eapply sufficient_fuel' with (l := (remove A_eq_dec a all)). 147 | - eauto using remove_NoDup. 148 | - intros. apply remove_preserve; eauto. eauto using nextn_in_all. 149 | - erewrite remove_length_in; eauto. 150 | Qed. 151 | 152 | End find_chain. -------------------------------------------------------------------------------- /systems/chord-props/StabilizeOnlyWithFirstSucc.v: -------------------------------------------------------------------------------- 1 | Require Import List. 2 | Import ListNotations. 3 | Require Import StructTact.StructTactics. 4 | Require Import StructTact.Util. 5 | Require Import StructTact.Update. 6 | 7 | Require Import Chord.Chord. 8 | 9 | Require Import Chord.SystemReachable. 10 | Require Import Chord.HandlerLemmas. 11 | Require Import Chord.SystemLemmas. 12 | Require Import Chord.QueryInvariant. 13 | 14 | Set Bullet Behavior "Strict Subproofs". 15 | 16 | Lemma timeouts_in_clear_rectify_with : 17 | forall st, 18 | timeouts_in (clear_rectify_with st) = timeouts_in st. 19 | Proof. 20 | intuition. 21 | Qed. 22 | 23 | Theorem stabilize_only_with_first_succ : 24 | forall gst, 25 | reachable_st gst -> 26 | forall h st dst, 27 | sigma gst h = Some st -> 28 | In (Request dst GetPredAndSuccs) (timeouts gst h) -> 29 | exists s, 30 | addr_of s = dst /\ 31 | cur_request st = Some (s, Stabilize, GetPredAndSuccs) /\ 32 | hd_error (succ_list st) = Some s. 33 | Proof. 34 | induction 1; intros. 35 | - exfalso. 36 | unfold initial_st in *. break_and. 37 | destruct (in_dec addr_eq_dec h (nodes gst)); intuition; [|find_apply_hyp_hyp; congruence]. 38 | destruct (start_handler h (nodes gst)) as [[?st ?ms] ?nts] eqn:?. 39 | copy_eapply_prop_hyp start_handler start_handler; eauto; break_and. 40 | unfold start_handler in *. 41 | repeat break_match; simpl in *; repeat find_inversion; subst; 42 | try solve [repeat find_reverse_rewrite; in_crush; congruence]. 43 | unfold empty_start_res in *. find_inversion. repeat find_reverse_rewrite; in_crush. 44 | - invcs H0; simpl in *; eauto. 45 | + update_destruct; subst; rewrite_update; simpl in *; eauto. 46 | find_inversion. intuition. congruence. 47 | + update_destruct; subst; rewrite_update; simpl in *; eauto. 48 | find_inversion. 49 | repeat (handler_def || handler_simpl); 50 | intuition; subst; try congruence; 51 | try solve [find_inversion; repeat find_rewrite; simpl in *; congruence]; 52 | try solve [find_apply_lem_hyp in_remove; eauto]; 53 | try solve [unfold hd_error in *; break_match; simpl in *; try solve_by_inversion; 54 | repeat find_inversion; eauto]; 55 | try solve [find_apply_lem_hyp in_remove_all_was_in; 56 | find_apply_lem_hyp in_remove; 57 | eapply_prop_hyp sigma sigma; eauto; break_exists; intuition; congruence]; 58 | try solve [exfalso; find_apply_lem_hyp in_remove_all_was_in; 59 | eapply at_most_one_request_timeout'_remove_drops_all; [| |eauto]; eauto; 60 | find_eapply_lem_hyp at_most_one_request_timeout_invariant; eauto]. 61 | + update_destruct; subst; rewrite_update; simpl in *; eauto. 62 | find_inversion. 63 | repeat (handler_def || handler_simpl); 64 | intuition; subst; try congruence; eauto; 65 | try solve [find_inversion; repeat find_rewrite; simpl in *; congruence]; 66 | try solve [find_apply_lem_hyp in_remove; eauto]; 67 | try solve [unfold hd_error in *; break_match; simpl in *; try solve_by_inversion; 68 | repeat find_inversion; eauto]; 69 | try solve [try find_apply_lem_hyp in_remove_all_was_in; 70 | try find_apply_lem_hyp in_remove; 71 | eapply_prop_hyp sigma sigma; eauto; break_exists; intuition; congruence]; 72 | try solve [exfalso; find_apply_lem_hyp in_remove_all_was_in; 73 | eapply at_most_one_request_timeout'_remove_drops_all; [| |eauto]; eauto; 74 | find_eapply_lem_hyp at_most_one_request_timeout_invariant; eauto]. 75 | * find_copy_apply_lem_hyp cur_request_timeouts_related_invariant_elim; eauto. 76 | inv_prop cur_request_timeouts_ok; try congruence. 77 | repeat find_rewrite. repeat find_inversion. 78 | in_crush. 79 | -- unfold timeouts_in in *. break_match; try solve_by_inversion. 80 | repeat break_let. in_crush. repeat find_inversion. 81 | eapply_prop_hyp sigma sigma; eauto. repeat find_rewrite. eauto. 82 | -- find_apply_lem_hyp in_remove_all_was_in; eauto. 83 | eapply_prop_hyp sigma sigma; eauto; repeat find_rewrite; eauto. 84 | * find_copy_apply_lem_hyp cur_request_timeouts_related_invariant_elim; eauto. 85 | inv_prop cur_request_timeouts_ok; try congruence. 86 | repeat find_rewrite. repeat find_inversion. 87 | unfold timeouts_in in *. repeat find_rewrite. simpl in *. 88 | exfalso. 89 | eapply at_most_one_request_timeout'_remove_drops_all; [| |eauto]; eauto. 90 | * find_copy_apply_lem_hyp cur_request_timeouts_related_invariant_elim; eauto. 91 | inv_prop cur_request_timeouts_ok; try congruence. 92 | repeat find_rewrite. repeat find_inversion. 93 | unfold timeouts_in in *. repeat find_rewrite. simpl in *. 94 | exfalso. 95 | find_apply_lem_hyp in_remove. 96 | eapply at_most_one_request_timeout'_remove_drops_all; [| |eauto]; eauto. 97 | * find_copy_apply_lem_hyp cur_request_timeouts_related_invariant_elim; eauto. 98 | inv_prop cur_request_timeouts_ok; try congruence. 99 | repeat find_rewrite. repeat find_inversion. 100 | unfold timeouts_in in *. repeat find_rewrite. simpl in *. 101 | exfalso. 102 | find_apply_lem_hyp in_remove. 103 | eapply at_most_one_request_timeout'_remove_drops_all; [| |eauto]; eauto. 104 | Qed. 105 | (* 106 | This lemma says that if we have an appropriate Request timeout, we 107 | have all the other trappings of a Stabilize request. It's going to be 108 | some work to prove because we have to show that 109 | - whenever we register timeouts we also set the other stuff 110 | - when the timeout isn't removed, the other stuff doesn't change 111 | 112 | DIFFICULTY: 3 113 | USED: In phase one. 114 | *) 115 | -------------------------------------------------------------------------------- /systems/chord-props/SuccessorNodesAlwaysValid.v: -------------------------------------------------------------------------------- 1 | Require Import List. 2 | Import ListNotations. 3 | 4 | Require Import StructTact.StructTactics. 5 | 6 | Require Import Chord.Chord. 7 | 8 | Require Import Chord.SystemReachable. 9 | Require Import Chord.SystemLemmas. 10 | 11 | Definition successor_nodes_valid (gst : global_state) : Prop := 12 | forall h p st, 13 | In p (succ_list st) -> 14 | sigma gst h = Some st -> 15 | In (addr_of p) (nodes gst) /\ 16 | exists pst, sigma gst (addr_of p) = Some pst /\ 17 | joined pst = true. 18 | 19 | Lemma successor_nodes_always_valid : 20 | forall gst, 21 | reachable_st gst -> 22 | successor_nodes_valid gst. 23 | Proof. 24 | (* 25 | IGNORE 26 | 27 | This invariant says every successor list pointer points to a node 28 | that's both live and has joined st = true. It will require some 29 | strengthening before it's inductive. 30 | - Need to add somethine about the contents of GotPredAndSuccs messages 31 | - Need to say nodes only end up in a sucessor list if they've joined 32 | 33 | DIFFICULTY: 3 34 | USED: In phase one. 35 | *) 36 | Admitted. 37 | 38 | Lemma active_successors_are_live_nodes : 39 | forall gst, 40 | reachable_st gst -> 41 | forall h p st, 42 | In p (succ_list st) -> 43 | sigma gst h = Some st -> 44 | ~ In (addr_of p) (failed_nodes gst) -> 45 | live_node gst (addr_of p). 46 | Proof. 47 | intros. 48 | find_apply_lem_hyp successor_nodes_always_valid. 49 | assert (exists pst, sigma gst (addr_of p) = Some pst /\ joined pst = true) 50 | by firstorder. 51 | firstorder using live_node_characterization. 52 | Qed. -------------------------------------------------------------------------------- /systems/chord-props/TickInvariant.v: -------------------------------------------------------------------------------- 1 | Require Import List. 2 | Import ListNotations. 3 | 4 | Require Import InfSeqExt.infseq. 5 | Require Import StructTact.StructTactics. 6 | 7 | Require Import Chord.Chord. 8 | Require Import Chord.ValidPointersInvariant. 9 | 10 | -------------------------------------------------------------------------------- /systems/chord-props/TimeoutMeansActive.v: -------------------------------------------------------------------------------- 1 | Require Import List. 2 | 3 | Require Import StructTact.StructTactics. 4 | 5 | Require Import Chord.Chord. 6 | Require Import Chord.SystemReachable. 7 | 8 | Require Import Chord.HandlerLemmas. 9 | 10 | Definition timeout_means_active_invariant (gst : global_state) : Prop := 11 | forall h t, 12 | In t (timeouts gst h) -> 13 | In h (nodes gst). 14 | Hint Unfold timeout_means_active_invariant. 15 | 16 | Theorem timeout_means_active_inductive : 17 | forall gst, 18 | reachable_st gst -> 19 | timeout_means_active_invariant gst. 20 | Proof using. 21 | eapply chord_net_invariant; do 2 autounfold; intros; 22 | repeat find_rewrite; 23 | repeat handler_simpl. 24 | inv_prop initial_st; expand_def. 25 | destruct (In_dec addr_eq_dec h (nodes gst)); auto. 26 | assert (timeouts gst h = nil). 27 | auto. 28 | repeat find_rewrite. 29 | exfalso; eapply in_nil; eauto. 30 | Qed. 31 | 32 | Lemma timeout_means_active : 33 | forall gst, 34 | reachable_st gst -> 35 | forall t h, 36 | In t (timeouts gst h) -> 37 | In h (nodes gst). 38 | Proof. 39 | intros. 40 | eapply timeout_means_active_inductive; eauto. 41 | Qed. 42 | -------------------------------------------------------------------------------- /systems/chord-props/ValidPointersInvariant.v: -------------------------------------------------------------------------------- 1 | Require Import List. 2 | Import ListNotations. 3 | Require Import StructTact.StructTactics. 4 | Require Import StructTact.Update. 5 | 6 | Require Import Chord.Chord. 7 | 8 | Require Import Chord.HandlerLemmas. 9 | Require Import Chord.SystemLemmas. 10 | Require Import Chord.SystemReachable. 11 | Require Import Chord.SystemPointers. 12 | 13 | Set Bullet Behavior "Strict Subproofs". 14 | 15 | Theorem valid_ptrs_global_inductive : 16 | forall gst, 17 | reachable_st gst -> 18 | valid_ptrs_global gst. 19 | Proof using. 20 | Admitted. 21 | 22 | Lemma cur_request_valid : 23 | forall gst, 24 | reachable_st gst -> 25 | forall h st dst q m, 26 | sigma gst h = Some st -> 27 | cur_request st = Some (dst, q, m) -> 28 | valid_ptr gst dst. 29 | Proof. 30 | intros. 31 | find_apply_lem_hyp valid_ptrs_global_inductive. 32 | unfold valid_ptrs_global in *. 33 | assert (lift_pred_opt (valid_ptrs_state gst) (Some st)). 34 | { 35 | repeat find_reverse_rewrite. 36 | firstorder. 37 | } 38 | invcs_prop valid_ptrs_state. 39 | unfold valid_ptrs_state, valid_ptrs_cur_request, valid_ptrs_some_cur_request in *. 40 | break_and. 41 | repeat find_rewrite. 42 | inv_prop valid_ptr; tauto. 43 | Qed. 44 | -------------------------------------------------------------------------------- /systems/chord-props/WfPtrSuccListInvariant.v: -------------------------------------------------------------------------------- 1 | Require Import List. 2 | Import ListNotations. 3 | 4 | Require Import StructTact.StructTactics. 5 | Require Import StructTact.ListTactics. 6 | 7 | Require Import Chord.Chord. 8 | 9 | Require Import Chord.SystemLemmas. 10 | Require Import Chord.SystemReachable. 11 | Require Import Chord.SystemPointers. 12 | Require Import Chord.QueryTargetsJoined. 13 | 14 | Lemma wf_ptr_succ_list_invariant' : 15 | forall gst h st p, 16 | reachable_st gst -> 17 | sigma gst h = Some st -> 18 | In p (succ_list st) -> 19 | wf_ptr p. 20 | Proof. 21 | intros. 22 | cut (all_ptrs wf_ptr gst); eauto using pointers_wf. 23 | intros. 24 | inv_prop all_ptrs. eauto. 25 | Qed. 26 | 27 | Lemma wf_ptr_succ_list_invariant : 28 | forall gst h st p rest, 29 | reachable_st gst -> 30 | sigma gst h = Some st -> 31 | succ_list st = p :: rest -> 32 | wf_ptr p. 33 | Proof. 34 | intros. 35 | eapply wf_ptr_succ_list_invariant'; eauto. find_rewrite. in_crush. 36 | Qed. 37 | -------------------------------------------------------------------------------- /systems/chord-util/PairIn.v: -------------------------------------------------------------------------------- 1 | Require Import List. 2 | Import ListNotations. 3 | Require Import mathcomp.ssreflect.ssreflect. 4 | 5 | Require Import StructTact.StructTactics. 6 | 7 | Inductive pair_in {A : Type} : A -> A -> list A -> Prop := 8 | | pair_in_head : 9 | forall a b l, 10 | pair_in a b (a :: b :: l) 11 | | pair_in_rest : 12 | forall a b l, 13 | pair_in a b l -> 14 | forall x, 15 | pair_in a b (x :: l). 16 | 17 | Lemma pair_in_sound : 18 | forall A (l : list A) xs a b ys, 19 | l = xs ++ a :: b :: ys -> 20 | pair_in a b l. 21 | Proof. 22 | move => A. 23 | elim => //=; first by case. 24 | move => a l IH. 25 | case => /= [a0 b|a0 l0 a1 b] ys H_eq. 26 | - find_injection. 27 | exact: pair_in_head. 28 | - find_injection. 29 | apply pair_in_rest. 30 | exact: IH. 31 | Qed. 32 | Hint Resolve pair_in_sound. 33 | 34 | Lemma pair_in_map : 35 | forall A B (f : A -> B) a b l, 36 | pair_in a b (map f l) -> 37 | exists a0 b0, 38 | a = f a0 /\ 39 | b = f b0 /\ 40 | pair_in a0 b0 l. 41 | Proof. 42 | intros. 43 | remember (map f l) as fl; revert Heqfl. 44 | generalize l. 45 | induction H; intros; subst. 46 | - destruct l1 as [|? [|? ?]]; simpl in *. 47 | + congruence. 48 | + congruence. 49 | + find_injection. 50 | repeat eexists. 51 | constructor. 52 | - destruct l1; simpl in *. 53 | + congruence. 54 | + find_injection. 55 | specialize (IHpair_in l1 eq_refl); break_exists; break_and; 56 | do 2 eexists; repeat split; try constructor; eauto. 57 | Qed. 58 | 59 | Lemma map_pair_in : 60 | forall A B (f : A -> B) a b a0 b0 l, 61 | pair_in a0 b0 l -> 62 | a = f a0 -> 63 | b = f b0 -> 64 | pair_in a b (map f l). 65 | Proof. 66 | induction 0; intros. 67 | - repeat inv_prop (@pair_in A). 68 | - inv_prop (@pair_in A). 69 | + constructor; eauto. 70 | + constructor; eauto. 71 | Qed. 72 | 73 | Lemma pair_in_firstn : 74 | forall (A : Type) (a b : A) k l, 75 | pair_in a b (firstn k l) -> 76 | pair_in a b l. 77 | Proof. 78 | move => A a b k l. 79 | move: l a b k. 80 | elim => //=. 81 | - move => a b. 82 | by case. 83 | - move => a l IH. 84 | move => a0 b. 85 | case => //=; first by move => H_p; inversion H_p. 86 | move => n H_p. 87 | inversion H_p; subst. 88 | * destruct n => //=. 89 | destruct l => //=. 90 | simpl in *. 91 | find_injection. 92 | exact: pair_in_head. 93 | * apply pair_in_rest. 94 | by eapply IH; eauto. 95 | Qed. 96 | -------------------------------------------------------------------------------- /systems/chordpy/README.md: -------------------------------------------------------------------------------- 1 | Quick start 2 | ----------- 3 | Run `python2 demo.py | python2 report.py | grep -v DEBUG` and watch the `f`s 4 | turn into `t`s. If you're not using Linux you probably have to bring more 5 | localhost IPs up before this will work: see the bottom of the "Running it" 6 | section for how to fix that. 7 | 8 | Introduction 9 | ============ 10 | This is an implementation of Pamela Zave's [correct specification][1] of Chord 11 | written in Python as preparation for a formal model in Coq. To this end, the 12 | code is structured into handlers to match the network semantics in 13 | DynamicNet.v, and accompanied with a tool for detecting violations of the 14 | inductive invariant presented in Zave's paper. 15 | 16 | Any design limitations in the Zave specification also apply to this 17 | implementation. For example, there's no key-value storage or external API 18 | available in this implementation, since Zave's paper doesn't include anything 19 | to that end. 20 | 21 | Running it 22 | ========== 23 | Presently the only available command just runs a demo, in which a ring of nodes 24 | is started up and then a few of them are killed off. This is an artifact of the 25 | code's general disorganization, and when I fix that I'll be sure to get the 26 | demo separated from the chord implementation itself. 27 | 28 | That said, the demo is pretty satisfying to watch. As mentioned above, running 29 | `python2 demo.py | python2 report.py` will get it going. Grepping out all the 30 | `DEBUG` lines will make the output far less noisy but is, of course, unwise if 31 | you're trying to debug anything. 32 | 33 | The demo in `demo.py` creates an ideal Chord ring composed of 40 subprocesses 34 | running Chord nodes. The ring is ideal because each Chord node is initialized 35 | with globally correct successor lists and predecessor pointers. The processes 36 | communicate using TCP over the localhost IP network. Once all those processes 37 | are up and running, the original process terminates two of them (causing two 38 | node failures) and shortly afterward adds another node with the join protocol. 39 | The remaining nodes will restore the ring to an ideal state, so that eventually 40 | the demo hosts an ideal Chord ring of 39 nodes. 41 | 42 | Note that on OS X, 127.0.0.1 seems to be the only address set up as a 43 | loopback address by default (as opposed to the whole 127.0.0.0/8 44 | subnet as on Linux). The chord demo relies on multiple addresses in 45 | 127.0.0.0/24, so before running it on OS X you'll need to do the 46 | following: 47 | 48 | ``` 49 | for ((i=2;i<256;i++)) 50 | do 51 | sudo ifconfig lo0 alias 127.0.0.$i up 52 | done 53 | ``` 54 | 55 | Understanding the output of the demo 56 | ==================================== 57 | The code in `demo.py` logs any changes to node state, including predecessor 58 | pointers and successor pointers. The checker in `report.py` parses out these 59 | changes from the logs. 60 | 61 | After each logged line, the checker, well, checks. With the new information 62 | from the logged line incorporated into its global node data, the checker prints 63 | out a summary of which of Zave's invariants are currently holding and whether 64 | the ring is ideal. Here's a sample run, with some of the initialization 65 | messages replaced with an ellipse and all of the debug log messages hidden. 66 | 67 | ``` 68 | at_least_one_ring 69 | | at_most_one_ring 70 | | | ordered_ring 71 | | | | connected_appendages 72 | | | | | ordered_successor_lists 73 | | | | | | globally_correct_node_data 74 | | | | | | | ideal_ring 75 | | | | | | | | 76 | | | | | | | | INFO:__main__(21):id := 21 77 | ... 78 | | | | | | | | INFO:__main__(1995):id := 1995 79 | t t t t t f t INFO:__main__(1995):id := 1995 80 | t t t t t f t INFO:__main__(1995):succ_list := [21, 78, 83] 81 | t t t t t t t INFO:__main__(1995):joined := True 82 | t t t t t f t WARNING:root:killing node 105 83 | t t t t t f t WARNING:root:killing node 322 84 | t t t t t f t INFO:__main__(140):succ_list := [416, 478] 85 | t t t t t f t INFO:__main__(83):succ_list := [140, 322] 86 | t t t t t f t INFO:__main__(83):succ_list := [140, 416, 478] 87 | t t t t t f t INFO:__main__(140):succ_list := [416, 478, 515] 88 | t t t t t f t INFO:__main__(83):succ_list := [140, 322] 89 | t t t t t f t INFO:__main__(78):succ_list := [83, 140, 416] 90 | t t t t t f t INFO:__main__(140):succ_list := [416, 478] 91 | t t t t t f t INFO:__main__(21):succ_list := [78, 83, 140] 92 | t t t t t f t INFO:__main__(83):succ_list := [140, 416, 478] 93 | t t t t t f t INFO:__main__(140):pred := None 94 | t t t t t f t INFO:__main__(140):pred := 83 95 | t t t t t f t INFO:__main__(140):succ_list := [416, 478, 515] 96 | t t t t t f t INFO:__main__(416):pred := None 97 | t t t t t t t INFO:__main__(416):pred := 140 98 | t t t t t f t INFO:__main__(83):succ_list := [140, 322] 99 | t t t t t t t INFO:__main__(83):succ_list := [140, 416, 478] 100 | t t t t t f t INFO:__main__(140):succ_list := [416, 478] 101 | t t t t t t t INFO:__main__(140):succ_list := [416, 478, 515] 102 | ``` 103 | 104 | Each line, after the header, consists of a series of `t`s or `f`s (for "true" 105 | or "false") followed by a log message. The first messages will be prefixed with 106 | pipe characters until all of Zave's invariants hold, so as to avoid the 107 | confusion that could result from checking for invariants on half the log 108 | messages from the initialized ring. 109 | 110 | Listed in the header are some properties of the global Chord state. The first 111 | four are actually Zave's invariants. I have omitted Zave's "stable base" 112 | invariant because it would require specifying the stable base ahead of time, 113 | but I'll add it eventually. I have also added `ordered_successor_lists`, one of 114 | Zave's "candidate invariants" that in conjunction with the first four 115 | properties is not actually strong enough to serve as an inductive invariant for 116 | Chord, but is entailed by the "stable base" invariant. For more details on 117 | this, consult [the paper][1]. 118 | 119 | The last two properties, `globally_correct_node_data` and `ideal_ring`, are not 120 | invariant properties of Chord. They only describe ideal network states. If this 121 | implementation is correct, the network should eventually be able to make these 122 | two properties of the ring true given enough time without node failures or new 123 | joins. 124 | 125 | Each line is prefixed with the properties true of the network immediately after 126 | the line was logged. The last two columns can be "f", but if any of the other 127 | ones aren't true then some invariant has been violated and there's something 128 | wrong with the implementation. 129 | 130 | 1: http://arxiv.org/abs/1502.06461v2 131 | -------------------------------------------------------------------------------- /systems/chordpy/data.py: -------------------------------------------------------------------------------- 1 | from collections import namedtuple 2 | from functools import total_ordering 3 | import socket 4 | import struct 5 | import hashlib 6 | 7 | ID_SPACE_SIZE = 2048 8 | SUCC_LIST_LEN = 3 9 | 10 | def hash(string): 11 | h = hashlib.sha256() 12 | h.update(string) 13 | return long(h.hexdigest(), 16) % ID_SPACE_SIZE 14 | 15 | Query = namedtuple("Query", ["dst", "msg", "res_kind", "cb"]) 16 | State = namedtuple("State", [ 17 | "ptr", 18 | "pred", 19 | "succ_list", 20 | "known", 21 | "joined", 22 | "rectify_with", 23 | "query", 24 | "query_sent"]) 25 | 26 | def between(a, x, b): 27 | if a < b: 28 | return a < x < b 29 | else: 30 | return a < x or x < b 31 | 32 | def make_succs(head, rest): 33 | succs = [head] + rest 34 | if len(succs) > SUCC_LIST_LEN: 35 | return succs[:SUCC_LIST_LEN] 36 | else: 37 | return succs 38 | 39 | # this is like closest_preceding_finger in the chord paper 40 | # but I have no finger tables (yet) 41 | def best_predecessor(state, id): 42 | for node in reversed(state.succ_list): 43 | if between(state.ptr.id, node.id, id): 44 | return node 45 | return state.ptr 46 | 47 | @total_ordering 48 | class Pointer(object): 49 | def __init__(self, ip, id=None): 50 | self.ip = ip 51 | self.id = hash(ip) 52 | if id is not None and id != self.id: 53 | raise ValueError("someone hashed something wrong: {} != {}".format( 54 | id, self.id)) 55 | 56 | def __eq__(self, other): 57 | if isinstance(other, Pointer): 58 | return self.id == other.id 59 | else: 60 | return False 61 | 62 | def __lt__(self, other): 63 | return self.id < other.id 64 | 65 | def serialize(self): 66 | return socket.inet_aton(self.ip) + struct.pack(">I", self.id) 67 | 68 | @classmethod 69 | def deserialize(cls, bytestring): 70 | if len(bytestring) != 8: 71 | raise ValueError() 72 | ip = socket.inet_ntoa(bytestring[:4]) 73 | id = struct.unpack(">I", bytestring[4:])[0] 74 | ptr = cls(ip) 75 | if ptr.id != id: 76 | raise ValueError("computed id != provided id :(") 77 | return ptr 78 | 79 | def __repr__(self): 80 | return 'Pointer("{}", {})'.format(self.ip, self.id) 81 | 82 | class MessageIncomplete(ValueError): 83 | pass 84 | 85 | class Signature(object): 86 | def __init__(self, arity, id_first=False, response=False): 87 | self.arity = arity 88 | self.id_first = id_first 89 | self.response = response 90 | 91 | class Message(object): 92 | signatures = { 93 | "get_best_predecessor": Signature(1, True), 94 | "got_best_predecessor": Signature(1, False), 95 | "get_succ_list": Signature(0), 96 | "got_succ_list": Signature(None, False), 97 | "get_pred": Signature(0), 98 | "got_pred": Signature(1), 99 | "get_pred_and_succs": Signature(0), 100 | "got_pred_and_succs": Signature(None, False), 101 | "notify": Signature(0), 102 | "ping": Signature(0), 103 | "pong": Signature(0) 104 | } 105 | kinds = list(signatures.keys()) 106 | 107 | def __init__(self, kind, data=None): 108 | if data is None: 109 | data = [] 110 | if kind not in Message.kinds: 111 | raise ValueError("Unknown message kind {}".format(kind)) 112 | self.kind = kind 113 | arity = Message.signatures[self.kind].arity 114 | if arity is not None and len(data) != arity: 115 | message = "Incorrect arity {} for kind {}".format(len(data), kind) 116 | raise ValueError(message) 117 | self.arity = len(data) 118 | self.data = data 119 | 120 | def __repr__(self): 121 | return "Message({}, {})".format(self.kind, self.data) 122 | 123 | def serialize(self): 124 | kind_idx = Message.kinds.index(self.kind) 125 | byte_string = struct.pack(">II", kind_idx, self.arity) 126 | data = self.data 127 | if Message.signatures[self.kind].id_first: 128 | byte_string += struct.pack(">I", data[0]) 129 | data = data[1:] 130 | for ptr in data: 131 | byte_string += ptr.serialize() 132 | return struct.pack(">I", len(byte_string)) + byte_string 133 | 134 | @classmethod 135 | def deserialize(cls, bytes): 136 | if len(bytes) < 4: 137 | raise MessageIncomplete() 138 | length = struct.unpack(">I", bytes[:4])[0] 139 | bytes = bytes[4:] 140 | if len(bytes) < length: 141 | raise MessageIncomplete() 142 | leftovers = bytes[length:] 143 | bytes = bytes[:length] 144 | header = bytes[:8] 145 | rest = bytes[8:] 146 | kind_idx, arity = struct.unpack(">II", header) 147 | kind = Message.kinds[kind_idx] 148 | data = [] 149 | kind_arity = Message.signatures[kind].arity 150 | if kind_arity is not None and kind_arity != arity: 151 | raise ValueError("wrong arity >:(") 152 | if Message.signatures[kind].id_first: 153 | data = list(struct.unpack(">I", rest[:4])) 154 | rest = rest[4:] 155 | arity = arity - 1 156 | for i in range(0, arity): 157 | ptr = Pointer.deserialize(rest[:8]) 158 | rest = rest[8:] 159 | data.append(ptr) 160 | return cls(kind, data), leftovers 161 | -------------------------------------------------------------------------------- /systems/chordpy/demo.py: -------------------------------------------------------------------------------- 1 | import logging 2 | import multiprocessing 3 | import sys 4 | import time 5 | 6 | from data import Pointer, SUCC_LIST_LEN 7 | from node import Node 8 | 9 | def launch_node(ip, pred, succ_list): 10 | node = Node(ip=ip, pred=pred, succ_list=succ_list) 11 | p = multiprocessing.Process(target=node.start) 12 | p.daemon = True 13 | p.start() 14 | 15 | return node, p 16 | 17 | def launch_ring_of(n): 18 | ptrs = sorted([Pointer(ip="127.0.0.{}".format(i)) for i in range(1, n+1)]) 19 | nodes = [] 20 | procs = [] 21 | for i, p in enumerate(ptrs): 22 | succs = ptrs[i+1:i+1+SUCC_LIST_LEN] 23 | if len(succs) < SUCC_LIST_LEN: 24 | succs += ptrs[:SUCC_LIST_LEN-len(succs)] 25 | node, proc = launch_node(p.ip, ptrs[i - 1], succs) 26 | nodes.append(node) 27 | procs.append(proc) 28 | return nodes, procs 29 | 30 | def kill_demo(): 31 | logging.debug("running kill_demo()") 32 | nodes, procs = launch_ring_of(40) 33 | time.sleep(2) 34 | for kill_idx in [3, 5, 12]: 35 | logging.warn("killing node {}".format(nodes[kill_idx].state.ptr.id)) 36 | procs[kill_idx].terminate() 37 | 38 | known = nodes[0].state.ptr 39 | new_node = Node("127.0.0.100") 40 | time.sleep(0.5) 41 | print "adding new node:", new_node.state.ptr 42 | new_node.start(known) 43 | 44 | procs[0].join() 45 | 46 | if __name__ == "__main__": 47 | logging.basicConfig(level=logging.DEBUG, stream=sys.stdout) 48 | kill_demo() 49 | -------------------------------------------------------------------------------- /verdi-chord-checkproofs.opam: -------------------------------------------------------------------------------- 1 | opam-version: "1.2" 2 | version: "dev" 3 | maintainer: "palmskog@gmail.com" 4 | 5 | homepage: "https://github.com/DistributedComponents/verdi-chord" 6 | dev-repo: "https://github.com/DistributedComponents/verdi-chord.git" 7 | bug-reports: "https://github.com/DistributedComponents/verdi-chord/issues" 8 | license: "BSD" 9 | 10 | build: [ 11 | [ "./configure" ] 12 | [ make "quick" "-j%{jobs}%" ] 13 | [ make "checkproofs" "J=%{jobs}%" ] 14 | ] 15 | depends: [ 16 | "coq" {>= "8.7" & < "8.9~"} 17 | "coq-mathcomp-ssreflect" {>= "1.6" & < "1.8~"} 18 | "verdi" {= "dev"} 19 | "StructTact" {= "dev"} 20 | "cheerios" {= "dev"} 21 | "InfSeqExt" {= "dev"} 22 | ] 23 | 24 | authors: [ 25 | "Ryan Doenges <>" 26 | "Karl Palmskog <>" 27 | "Doug Woos <>" 28 | "Zachary Tatlock <>" 29 | "James Wilcox <>" 30 | "Justin Adsuara <>" 31 | ] 32 | -------------------------------------------------------------------------------- /verdi-chord.opam: -------------------------------------------------------------------------------- 1 | opam-version: "1.2" 2 | version: "dev" 3 | maintainer: "palmskog@gmail.com" 4 | 5 | homepage: "https://github.com/DistributedComponents/verdi-chord" 6 | dev-repo: "https://github.com/DistributedComponents/verdi-chord.git" 7 | bug-reports: "https://github.com/DistributedComponents/verdi-chord/issues" 8 | license: "BSD" 9 | 10 | build: [ 11 | [ "./configure" ] 12 | [ make "-j%{jobs}%" ] 13 | ] 14 | depends: [ 15 | "coq" {>= "8.7" & < "8.9~"} 16 | "coq-mathcomp-ssreflect" {>= "1.6" & < "1.8~"} 17 | "verdi" {= "dev"} 18 | "StructTact" {= "dev"} 19 | "cheerios" {= "dev"} 20 | "InfSeqExt" {= "dev"} 21 | ] 22 | 23 | authors: [ 24 | "Ryan Doenges <>" 25 | "Karl Palmskog <>" 26 | "Doug Woos <>" 27 | "Zachary Tatlock <>" 28 | "James Wilcox <>" 29 | "Justin Adsuara <>" 30 | ] 31 | -------------------------------------------------------------------------------- /words10.txt: -------------------------------------------------------------------------------- 1 | the 2 | of 3 | to 4 | and 5 | a 6 | in 7 | is 8 | it 9 | you 10 | that 11 | -------------------------------------------------------------------------------- /words100.txt: -------------------------------------------------------------------------------- 1 | the 2 | of 3 | to 4 | and 5 | a 6 | in 7 | is 8 | it 9 | you 10 | that 11 | he 12 | was 13 | for 14 | on 15 | are 16 | with 17 | as 18 | I 19 | his 20 | they 21 | be 22 | at 23 | one 24 | have 25 | this 26 | from 27 | or 28 | had 29 | by 30 | hot 31 | word 32 | but 33 | what 34 | some 35 | we 36 | can 37 | out 38 | other 39 | were 40 | all 41 | there 42 | when 43 | up 44 | use 45 | your 46 | how 47 | said 48 | an 49 | each 50 | she 51 | which 52 | do 53 | their 54 | time 55 | if 56 | will 57 | way 58 | about 59 | many 60 | then 61 | them 62 | write 63 | would 64 | like 65 | so 66 | these 67 | her 68 | long 69 | make 70 | thing 71 | see 72 | him 73 | two 74 | has 75 | look 76 | more 77 | day 78 | could 79 | go 80 | come 81 | did 82 | number 83 | sound 84 | no 85 | most 86 | people 87 | my 88 | over 89 | know 90 | water 91 | than 92 | call 93 | first 94 | who 95 | may 96 | down 97 | side 98 | been 99 | now 100 | find 101 | -------------------------------------------------------------------------------- /words50.txt: -------------------------------------------------------------------------------- 1 | the 2 | of 3 | to 4 | and 5 | a 6 | in 7 | is 8 | it 9 | you 10 | that 11 | he 12 | was 13 | for 14 | on 15 | are 16 | with 17 | as 18 | I 19 | his 20 | they 21 | be 22 | at 23 | one 24 | have 25 | this 26 | from 27 | or 28 | had 29 | by 30 | hot 31 | word 32 | but 33 | what 34 | some 35 | we 36 | can 37 | out 38 | other 39 | were 40 | all 41 | there 42 | when 43 | up 44 | use 45 | your 46 | how 47 | said 48 | an 49 | each 50 | she 51 | --------------------------------------------------------------------------------