├── .gitignore ├── .travis-ci.sh ├── .travis.yml ├── LICENSE ├── Makefile ├── Makefile.detect-coq-version ├── README.md ├── build.sh ├── configure ├── doc └── PSEUDOCODE.md ├── extraction ├── lockserv-seqnum │ ├── .gitignore │ ├── .merlin │ ├── Makefile │ ├── coq │ │ └── ExtractLockServSeqNum.v │ ├── ocaml │ │ ├── LockServSeqNumArrangement.ml │ │ ├── LockServSeqNumMain.ml │ │ ├── LockServSeqNumOpts.ml │ │ └── LockServSeqNumSerialization.ml │ └── script │ │ └── run.sh ├── lockserv-serialized │ ├── .gitignore │ ├── .merlin │ ├── Makefile │ ├── coq │ │ └── ExtractLockServSerialized.v │ ├── ocaml │ │ ├── LockServSerializedArrangement.ml │ │ ├── LockServSerializedMain.ml │ │ ├── LockServSerializedOpts.ml │ │ └── LockServSerializedSerialization.ml │ └── script │ │ ├── remove_module.pl │ │ └── run.sh └── lockserv │ ├── .gitignore │ ├── .merlin │ ├── Makefile │ ├── coq │ └── ExtractLockServ.v │ ├── ocaml │ ├── LockServArrangement.ml │ ├── LockServMain.ml │ ├── LockServOpts.ml │ └── LockServSerialization.ml │ ├── script │ ├── client.py │ └── run.sh │ └── test │ ├── LockServTest.ml │ ├── OptsTest.ml │ └── SerializationTest.ml ├── lockserv-seqnum.opam ├── lockserv-serialized.opam ├── lockserv.opam ├── script ├── checkpaths.sh └── coqproject.sh ├── systems ├── LockServ.v ├── LockServSeqNum.v └── LockServSerialized.v └── verdi-lockserv.opam /.gitignore: -------------------------------------------------------------------------------- 1 | *.vo 2 | *.glob 3 | *.v.d 4 | *.buildtime 5 | _CoqProject 6 | Makefile.coq 7 | Makefile.coq.bak 8 | Makefile.coq.conf 9 | *~ 10 | .coq-native/ 11 | *.aux 12 | *.vio 13 | *.pyc 14 | lia.cache 15 | -------------------------------------------------------------------------------- /.travis-ci.sh: -------------------------------------------------------------------------------- 1 | set -ev 2 | 3 | opam init --yes --no-setup 4 | eval $(opam config env) 5 | 6 | opam repo add coq-released https://coq.inria.fr/opam/released 7 | opam repo add distributedcomponents-dev http://opam-dev.distributedcomponents.net 8 | 9 | opam pin add coq $COQ_VERSION --yes --verbose 10 | 11 | case $MODE in 12 | lockserv) 13 | opam pin add lockserv . --yes --verbose 14 | ;; 15 | lockserv-seqnum) 16 | opam pin add lockserv-seqnum . --yes --verbose 17 | ;; 18 | lockserv-serialized) 19 | opam pin add lockserv-serialized . --yes --verbose 20 | ;; 21 | *) 22 | opam pin add verdi-lockserv . --yes --verbose 23 | ;; 24 | esac 25 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: c 2 | addons: 3 | apt: 4 | sources: 5 | - avsm 6 | packages: 7 | - ocaml 8 | - opam 9 | - aspcud 10 | env: 11 | matrix: 12 | - MODE=build COQ_VERSION=8.6.1 13 | - MODE=build COQ_VERSION=8.7.0 14 | - MODE=lockserv COQ_VERSION=8.6.1 OPAMBUILDTEST=1 15 | - MODE=lockserv-seqnum COQ_VERSION=8.6.1 16 | - MODE=lockserv-serialized COQ_VERSION=8.6.1 17 | script: bash -ex .travis-ci.sh 18 | sudo: false 19 | notifications: 20 | email: false 21 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2014-2017, 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. 26 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | include Makefile.detect-coq-version 2 | 3 | ifeq (,$(filter $(COQVERSION),8.6 8.7 trunk)) 4 | $(error "Verdi Lockserv is only compatible with Coq version 8.6.1 or later") 5 | endif 6 | 7 | COQPROJECT_EXISTS := $(wildcard _CoqProject) 8 | 9 | ifeq "$(COQPROJECT_EXISTS)" "" 10 | $(error "Run ./configure before running make") 11 | endif 12 | 13 | CHECKPATH := $(shell ./script/checkpaths.sh) 14 | 15 | ifneq ("$(CHECKPATH)","") 16 | $(info $(CHECKPATH)) 17 | $(warning checkpath reported an error) 18 | endif 19 | 20 | default: Makefile.coq 21 | $(MAKE) -f Makefile.coq 22 | 23 | LOCKSERV_MLFILES = extraction/lockserv/ocaml/LockServ.ml extraction/lockserv/ocaml/LockServ.mli 24 | LOCKSERV_SEQNUM_MLFILES = extraction/lockserv-seqnum/ocaml/LockServSeqNum.ml extraction/lockserv-seqnum/ocaml/LockServSeqNum.mli 25 | LOCKSERV_SER_MLFILES = extraction/lockserv-serialized/ocaml/LockServSerialized.ml extraction/lockserv-serialized/ocaml/LockServSerialized.mli 26 | 27 | Makefile.coq: _CoqProject 28 | coq_makefile -f _CoqProject -o Makefile.coq -install none \ 29 | -extra '$(LOCKSERV_MLFILES)' \ 30 | 'extraction/lockserv/coq/ExtractLockServ.v systems/LockServ.vo' \ 31 | '$$(COQC) $$(COQDEBUG) $$(COQFLAGS) extraction/lockserv/coq/ExtractLockServ.v' \ 32 | -extra '$(LOCKSERV_SEQNUM_MLFILES)' \ 33 | 'extraction/lockserv-seqnum/coq/ExtractLockServSeqNum.v systems/LockServSeqNum.vo' \ 34 | '$$(COQC) $$(COQDEBUG) $$(COQFLAGS) extraction/lockserv-seqnum/coq/ExtractLockServSeqNum.v' \ 35 | -extra '$(LOCKSERV_SER_MLFILES)' \ 36 | 'extraction/lockserv-serialized/coq/ExtractLockServSerialized.v systems/LockServSerialized.vo' \ 37 | '$$(COQC) $$(COQDEBUG) $$(COQFLAGS) extraction/lockserv-serialized/coq/ExtractLockServSerialized.v' 38 | 39 | $(LOCKSERV_MLFILES) $(LOCKSERV_SEQNUM_MLFILES) $(LOCKSERV_SER_MLFILES): Makefile.coq 40 | $(MAKE) -f Makefile.coq $@ 41 | 42 | lockserv: 43 | +$(MAKE) -C extraction/lockserv 44 | 45 | lockserv-test: 46 | +$(MAKE) -C extraction/lockserv test 47 | 48 | lockserv-seqnum: 49 | +$(MAKE) -C extraction/lockserv-seqnum 50 | 51 | lockserv-serialized: 52 | +$(MAKE) -C extraction/lockserv-serialized 53 | 54 | clean: 55 | if [ -f Makefile.coq ]; then \ 56 | $(MAKE) -f Makefile.coq cleanall; fi 57 | rm -f Makefile.coq 58 | $(MAKE) -C extraction/lockserv clean 59 | $(MAKE) -C extraction/lockserv-seqnum clean 60 | $(MAKE) -C extraction/lockserv-serialized clean 61 | 62 | lint: 63 | @echo "Possible use of hypothesis names:" 64 | find . -name '*.v' -exec grep -Hn 'H[0-9][0-9]*' {} \; 65 | 66 | distclean: clean 67 | rm -f _CoqProject 68 | 69 | .PHONY: default clean lint $(LOCKSERV_MLFILES) $(LOCKSERV_SEQNUM_MLFILES) $(LOCKSERV_SER_MLFILES) lockserv lockserv-test lockserv-seqnum lockserv-serialized 70 | -------------------------------------------------------------------------------- /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 LockServ 2 | ============== 3 | 4 | [![Build Status](https://api.travis-ci.org/DistributedComponents/verdi-lockserv.svg?branch=master)](https://travis-ci.org/DistributedComponents/verdi-lockserv) 5 | 6 | An implementation of a simple asynchronous message-passing lock server, verified to achieve mutual exclusion in the Coq proof assistant using the Verdi framework. By extracting Coq code to OCaml and linking the results to a trusted shim that handles network communication, the certified system can run on real hardware. 7 | 8 | Requirements 9 | ------------ 10 | 11 | Definitions and proofs: 12 | 13 | - [`Coq 8.6.1`](https://coq.inria.fr/coq-86) or [`Coq 8.7`](https://coq.inria.fr/coq-87) 14 | - [`Verdi`](https://github.com/uwplse/verdi) 15 | - [`StructTact`](https://github.com/uwplse/StructTact) 16 | - [`Cheerios`](https://github.com/uwplse/cheerios) 17 | 18 | Executable programs: 19 | 20 | - [`OCaml 4.02.3`](https://ocaml.org) (or later) 21 | - [`OCamlbuild`](https://github.com/ocaml/ocamlbuild) 22 | - [`ocamlfind`](http://projects.camlcity.org/projects/findlib.html) 23 | - [`verdi-runtime`](https://github.com/DistributedComponents/verdi-runtime) 24 | - [`cheerios-runtime`](https://github.com/uwplse/cheerios) 25 | 26 | Client to interface with program: 27 | 28 | - [`Python 2.7`](https://www.python.org/download/releases/2.7/) 29 | 30 | Testing of unverified code: 31 | 32 | - [`OUnit 2.0.0`](http://ounit.forge.ocamlcore.org) 33 | 34 | Building 35 | -------- 36 | 37 | The recommended way to install the OCaml and Coq dependencies of Verdi LockServ is via [OPAM](https://coq.inria.fr/opam/www/using.html): 38 | 39 | ``` 40 | opam repo add coq-released https://coq.inria.fr/opam/released 41 | opam repo add distributedcomponents-dev http://opam-dev.distributedcomponents.net 42 | opam install verdi StructTact cheerios verdi-runtime cheerios-runtime ocamlbuild ocamlfind 43 | ``` 44 | 45 | Then, run `./configure` in the root directory. This will check for the appropriate version of Coq and ensure all necessary dependencies can be located. 46 | 47 | By default, the script assumes that `Verdi`, `StructTact`, and `Cheerios` are installed in Coq's `user-contrib` directory, but this can be overridden by setting the `Verdi_PATH`, `StructTact_PATH`, and `Cheerios_PATH` environment variables. 48 | 49 | Finally, run `make` in the root directory. This will compile the lock server definitions, check the proofs of mutual exclusion, and extract OCaml event handler code. 50 | 51 | To build an OCaml program from the extracted code called `LockServMain.native` in the `extraction/lockserv` directory, run `make lockserv` in the root directory. 52 | 53 | Running LockServ on a Cluster 54 | ----------------------------- 55 | 56 | `LockServMain` accepts the following command-line options: 57 | 58 | ``` 59 | -me NAME name for this node 60 | -port PORT port for inputs 61 | -node NAME,IP:PORT node in the cluster 62 | -debug run in debug mode 63 | ``` 64 | 65 | Possible node names are `Server`, `Client-0`, `Client-1`, etc. 66 | 67 | For example, to run `LockServMain` on a cluster with IP addresses 68 | `192.168.0.1`, `192.168.0.2`, `192.168.0.3`, input port 8000, 69 | and port 9000 for inter-node communication, use the following: 70 | 71 | # on 192.168.0.1 72 | $ ./LockServMain.native -port 8000 -me Server -node Server,192.168.0.1:9000 \ 73 | -node Client-0,192.168.0.2:9000 -node Client-1,192.168.0.3:9000 74 | 75 | # on 192.168.0.2 76 | $ ./LockServMain.native -port 8000 -me Client-0 -node Server,192.168.0.1:9000 \ 77 | -node Client-0,192.168.0.2:9000 -node Client-1,192.168.0.3:9000 78 | 79 | # on 192.168.0.3 80 | $ ./LockServMain.native -port 8000 -me Client-1 -node Server,192.168.0.1:9000 \ 81 | -node Client-0,192.168.0.2:9000 -node Client-1,192.168.0.3:9000 82 | 83 | Client Program for LockServ 84 | --------------------------- 85 | 86 | There is a simple client written in Python in the directory `extraction/lockserv/script` that can be used as follows: 87 | 88 | $ python -i client.py 89 | >>> c=Client('192.168.0.2', 8000) 90 | >>> c.send_lock() 91 | 'Locked' 92 | >>> c.send_unlock() 93 | 94 | Tests for Unverified Code 95 | ------------------------- 96 | 97 | Some example unit tests for unverified OCaml code are included in `extraction/lockserv/test`. To execute these tests, first install the OUnit library via OPAM: 98 | 99 | ``` 100 | opam install ounit 101 | ``` 102 | 103 | Then, go to `extraction/lockserv` and run `make test`. 104 | 105 | LockServ with Sequence Numbering 106 | -------------------------------- 107 | 108 | As originally defined, the lock server does not tolerate duplicate messages, which means that `LockServMain` can potentially give unexpected results when the underlying UDP-based runtime system generates duplicates. However, the Verdi framework defines a sequence numbering verified system transformer that when applied allows the lock server to ignore duplicate messages, while still guaranteeing mutual exclusion. 109 | 110 | The directory `extraction/lockserv-seqnum` contains the files needed to produce an OCaml program called `LockServSeqNumMain` which uses sequence numbering. After running `./configure` in the root directory, simply run `make` in `extraction/lockserv-seqnum` to compile the program. `LockServSeqNumMain` has the same command-line options as `LockServMain`, and the Python client can be used to interface with nodes in both kinds of clusters. 111 | 112 | LockServ with Verified Serialization 113 | ------------------------------------ 114 | 115 | The standard lock server serializes messages over the network via OCaml's `Marshal` module, which must be trusted to trust the whole system. However, using the Cheerios serialization library and a Verdi verified system transformer for Cheerios, the use of `Marshal` can be eliminated while upholding the same mutual exclusion guarantees. 116 | 117 | The directory `extraction/lockserv-serialized` contains the files needed to produce an OCaml program called `LockServSerializedMain` which uses Cheerios and its runtime library. After running `./configure` in the root directory, simply run `make` in `extraction/lockserv-serialized` to compile the program. `LockServSerializedMain` has the same command-line options as `LockServMain`, and the Python client can be used to interface with nodes in both kinds of clusters. 118 | -------------------------------------------------------------------------------- /build.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | ./configure 3 | time make -k -j 3 "$@" 4 | -------------------------------------------------------------------------------- /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=(Verdi StructTact Cheerios) 7 | DIRS=(systems extraction/lockserv/coq extraction/lockserv-seqnum/coq extraction/lockserv-serialized/coq) 8 | CANARIES=("StructTact.StructTactics" "Build StructTact before building Verdi LockServ" "Verdi.Verdi" "Build Verdi before building Verdi LockServ" "Cheerios.Cheerios" "Build Cheerios before building Verdi LockServ") 9 | Verdi_DIRS=(core lib systems extraction) 10 | Cheerios_DIRS=(core extraction) 11 | source script/coqproject.sh 12 | -------------------------------------------------------------------------------- /doc/PSEUDOCODE.md: -------------------------------------------------------------------------------- 1 | Pseudocode for the Lock Server Protocol 2 | ======================================= 3 | 4 | Nodes 5 | ----- 6 | 7 | ```ocaml 8 | Name := Server | Agent(int) 9 | ``` 10 | 11 | API 12 | --- 13 | 14 | ```ocaml 15 | Input := Lock | Unlock 16 | Out := Granted 17 | ``` 18 | 19 | Internal Messages 20 | ---------------- 21 | 22 | ```ocaml 23 | Msg := LockMsg | UnlockMsg | GrantedMsg 24 | ``` 25 | 26 | State 27 | ----- 28 | 29 | ```ocaml 30 | State Server := list Name (* head agent holds lock, tail agents wait *) 31 | State (Agent _) := bool (* true iff client holds lock *) 32 | 33 | InitState Server := [] 34 | InitState (Agent _) := false 35 | ``` 36 | 37 | API Handlers 38 | ------------ 39 | 40 | ```ocaml 41 | HandleInp (n: Name) (s: State n) (inp: Inp) := 42 | match n with 43 | | Server => nop (* server performs no external IO *) 44 | | Agent _ => 45 | match inp with 46 | | Lock => 47 | send (Server, LockMsg) 48 | | Unlock => 49 | if s == true then s := false ; send (Server, UnlockMsg) 50 | ``` 51 | 52 | Internal Message Handlers 53 | ------------------------- 54 | 55 | ```ocaml 56 | HandleMsg (n: Name) (s: State n) (src: Name) (msg: Msg) := 57 | match n with 58 | | Server => 59 | match msg with 60 | | LockMsg => 61 | (* if lock not held, immediately grant *) 62 | if s == [] then send (src, GrantedMsg) ; 63 | (* add requestor to end of queue *) 64 | s := s ++ [src] 65 | | UnlockMsg => 66 | (* head of queue no longer holds lock *) 67 | s := tail s ; 68 | (* grant lock to next waiting agent, if any *) 69 | if s != [] then send (head s, GrantedMsg) 70 | | _ => nop (* never happens *) 71 | | Agent _ => 72 | match msg with 73 | | GrantedMsg => 74 | s := true ; 75 | output Granted 76 | | _ => nop (* never happens *) 77 | ``` 78 | -------------------------------------------------------------------------------- /extraction/lockserv-seqnum/.gitignore: -------------------------------------------------------------------------------- 1 | ocaml/LockServSeqNum.ml 2 | ocaml/LockServSeqNum.mli 3 | _build 4 | LockServSeqNumMain.native 5 | -------------------------------------------------------------------------------- /extraction/lockserv-seqnum/.merlin: -------------------------------------------------------------------------------- 1 | S ocaml 2 | B _build/** 3 | PKG verdi-runtime 4 | -------------------------------------------------------------------------------- /extraction/lockserv-seqnum/Makefile: -------------------------------------------------------------------------------- 1 | OCAMLBUILD = ocamlbuild -use-ocamlfind -tags safe_string,thread -package verdi-runtime -I ocaml -cflag -g 2 | 3 | MLEXTRACTED = ocaml/LockServSeqNum.ml ocaml/LockServSeqNum.mli 4 | 5 | MLFILES = ocaml/LockServSeqNumArrangement.ml ocaml/LockServSeqNumSerialization.ml \ 6 | ocaml/LockServSeqNumMain.ml ocaml/LockServSeqNumOpts.ml 7 | 8 | default: LockServSeqNumMain.native 9 | 10 | $(MLEXTRACTED): 11 | +$(MAKE) -C ../.. extraction/lockserv-seqnum/$@ 12 | 13 | LockServSeqNumMain.native: $(MLEXTRACTED) $(MLFILES) 14 | $(OCAMLBUILD) LockServSeqNumMain.native 15 | 16 | clean: 17 | ocamlbuild -clean 18 | 19 | .PHONY: default clean $(MLEXTRACTED) 20 | 21 | .NOTPARALLEL: $(MLEXTRACTED) 22 | -------------------------------------------------------------------------------- /extraction/lockserv-seqnum/coq/ExtractLockServSeqNum.v: -------------------------------------------------------------------------------- 1 | Require Import Verdi.Verdi. 2 | 3 | Require Import LockServSeqNum. 4 | 5 | Require Import ExtrOcamlBasic. 6 | Require Import ExtrOcamlNatInt. 7 | 8 | Require Import Verdi.ExtrOcamlBasicExt. 9 | Require Import Verdi.ExtrOcamlList. 10 | Require Import Verdi.ExtrOcamlFinInt. 11 | 12 | Extraction "extraction/lockserv-seqnum/ocaml/LockServSeqNum.ml" seq transformed_base_params transformed_multi_params. 13 | -------------------------------------------------------------------------------- /extraction/lockserv-seqnum/ocaml/LockServSeqNumArrangement.ml: -------------------------------------------------------------------------------- 1 | module type IntValue = sig 2 | val v : int 3 | end 4 | 5 | module type Params = sig 6 | val debug : bool 7 | val num_clients : int 8 | end 9 | 10 | module LockServSeqNumArrangement (P : Params) = struct 11 | type name = LockServSeqNum.name0 12 | type state = LockServSeqNum.seq_num_data 13 | type input = LockServSeqNum.msg0 14 | type output = LockServSeqNum.msg0 15 | type msg = LockServSeqNum.seq_num_msg 16 | type client_id = int 17 | type res = (output list * state) * ((name * msg) list) 18 | type task_handler = name -> state -> res 19 | type timeout_setter = name -> state -> float option 20 | 21 | let system_name = "Lock Server with Sequence Numbering" 22 | 23 | let init = fun n -> 24 | let open LockServSeqNum in 25 | Obj.magic ((transformed_multi_params P.num_clients).init_handlers (Obj.magic n)) 26 | 27 | let handle_input = fun n i s -> 28 | let open LockServSeqNum in 29 | Obj.magic ((transformed_multi_params P.num_clients).input_handlers (Obj.magic n) (Obj.magic i) (Obj.magic s)) 30 | 31 | let handle_msg = fun dst src m s -> 32 | let open LockServSeqNum in 33 | Obj.magic ((transformed_multi_params P.num_clients).net_handlers (Obj.magic dst) (Obj.magic src) (Obj.magic m) (Obj.magic s)) 34 | 35 | let deserialize_msg = LockServSeqNumSerialization.deserialize_msg 36 | 37 | let serialize_msg = LockServSeqNumSerialization.serialize_msg 38 | 39 | let deserialize_input = LockServSeqNumSerialization.deserialize_input 40 | 41 | let serialize_output = LockServSeqNumSerialization.serialize_output 42 | 43 | let debug = P.debug 44 | 45 | let debug_input = fun _ inp -> 46 | Printf.printf 47 | "[%s] got input %s" 48 | (Util.timestamp ()) 49 | (LockServSeqNumSerialization.debug_input inp); 50 | print_newline () 51 | 52 | let debug_recv_msg = fun _ (nm, msg) -> 53 | Printf.printf 54 | "[%s] receiving message %s from %s" 55 | (Util.timestamp ()) 56 | (LockServSeqNumSerialization.debug_msg msg) 57 | (LockServSeqNumSerialization.serialize_name nm); 58 | print_newline () 59 | 60 | let debug_send_msg = fun _ (nm, msg) -> 61 | Printf.printf 62 | "[%s] sending message %s to %s" 63 | (Util.timestamp ()) 64 | (LockServSeqNumSerialization.debug_msg msg) 65 | (LockServSeqNumSerialization.serialize_name nm); 66 | print_newline () 67 | 68 | let create_client_id () = 69 | let upper_bound = 1073741823 in 70 | Random.int upper_bound 71 | 72 | let string_of_client_id = string_of_int 73 | 74 | let timeout_tasks = [] 75 | end 76 | -------------------------------------------------------------------------------- /extraction/lockserv-seqnum/ocaml/LockServSeqNumMain.ml: -------------------------------------------------------------------------------- 1 | open LockServSeqNumOpts 2 | open LockServSeqNumArrangement 3 | 4 | let () = 5 | let () = 6 | try 7 | parse Sys.argv 8 | with 9 | | Arg.Help msg -> 10 | Printf.printf "%s: %s" Sys.argv.(0) msg; 11 | exit 2 12 | | Arg.Bad msg -> 13 | Printf.eprintf "%s" msg; 14 | exit 2 15 | in 16 | let () = 17 | try 18 | validate () 19 | with Arg.Bad msg -> 20 | Printf.eprintf "%s: %s." Sys.argv.(0) msg; 21 | prerr_newline (); 22 | exit 2 23 | in 24 | let module Pms = struct 25 | let debug = !debug 26 | let num_clients = List.length !cluster - 1 27 | end in 28 | let module Arrangement = LockServSeqNumArrangement (Pms) in 29 | let module Shim = UnorderedShim.Shim (Arrangement) in 30 | let open Shim in 31 | main { cluster = !cluster 32 | ; me = !me 33 | ; port = !port 34 | } 35 | -------------------------------------------------------------------------------- /extraction/lockserv-seqnum/ocaml/LockServSeqNumOpts.ml: -------------------------------------------------------------------------------- 1 | open List 2 | open Printf 3 | open Str 4 | 5 | let cluster_default : (LockServSeqNum.name0 * (string * int)) list = [] 6 | let me_default : LockServSeqNum.name0 = LockServSeqNum.Server 7 | let port_default : int = 8351 8 | let debug_default : bool = false 9 | 10 | let cluster = ref cluster_default 11 | let me = ref me_default 12 | let port = ref port_default 13 | let debug = ref debug_default 14 | 15 | let node_spec arg nodes_ref doc = 16 | let parse opt = 17 | (* name,ip:port *) 18 | if string_match (regexp "\\([^,]+\\),\\(.+\\):\\([0-9]+\\)") opt 0 then 19 | match LockServSeqNumSerialization.deserialize_name (matched_group 1 opt) with 20 | | Some nm -> (nm, (matched_group 2 opt, int_of_string (matched_group 3 opt))) 21 | | None -> raise (Arg.Bad (sprintf "wrong argument: '%s'; option '%s' expects a proper name" arg opt)) 22 | else 23 | raise (Arg.Bad (sprintf "wrong argument: '%s'; option '%s' expects an entry in the form 'name,host:port'" arg opt)) 24 | in (arg, Arg.String (fun opt -> nodes_ref := !nodes_ref @ [parse opt]), doc) 25 | 26 | let parse inp = 27 | let opts = 28 | [ node_spec "-node" cluster "{name,host:port} one node in the cluster" 29 | ; ("-me", Arg.String (fun opt -> 30 | match LockServSeqNumSerialization.deserialize_name opt with 31 | | Some nm -> me := nm 32 | | None -> raise (Arg.Bad (sprintf "wrong argument: '-me' expects a proper name"))), "{name} name for this node") 33 | ; ("-port", Arg.Set_int port, "{port} port for client commands") 34 | ; ("-debug", Arg.Set debug, "run in debug mode") 35 | ] in 36 | Arg.parse_argv ?current:(Some (ref 0)) inp 37 | opts 38 | (fun x -> raise (Arg.Bad (sprintf "%s does not take position arguments" inp.(0)))) 39 | "Try -help for help or one of the following." 40 | 41 | let rec assoc_unique = function 42 | | [] -> true 43 | | (k, _) :: l -> if mem_assoc k l then false else assoc_unique l 44 | 45 | let validate () = 46 | if length !cluster = 0 then 47 | raise (Arg.Bad "Please specify at least one -node"); 48 | if not (mem_assoc !me !cluster) then 49 | raise (Arg.Bad (sprintf "%s is not a member of this cluster" (LockServSeqNumSerialization.serialize_name !me))); 50 | if not (assoc_unique !cluster) then 51 | raise (Arg.Bad "Please remove duplicate -node name entries"); 52 | if !port = snd (List.assoc !me !cluster) then 53 | raise (Arg.Bad "Can't use same port for client commands and messages") 54 | -------------------------------------------------------------------------------- /extraction/lockserv-seqnum/ocaml/LockServSeqNumSerialization.ml: -------------------------------------------------------------------------------- 1 | let serialize_name : LockServSeqNum.name0 -> string = function 2 | | LockServSeqNum.Server -> "Server" 3 | | LockServSeqNum.Client i -> Printf.sprintf "Client-%d" i 4 | 5 | let deserialize_name (s : string) : LockServSeqNum.name0 option = 6 | match s with 7 | | "Server" -> Some LockServSeqNum.Server 8 | | _ -> 9 | try Scanf.sscanf s "Client-%d" (fun x -> Some (LockServSeqNum.Client (Obj.magic x))) 10 | with _ -> None 11 | 12 | let deserialize_msg : bytes -> LockServSeqNum.seq_num_msg = fun s -> 13 | Marshal.from_bytes s 0 14 | 15 | let serialize_msg : LockServSeqNum.seq_num_msg -> bytes = fun m -> 16 | Marshal.to_bytes m [] 17 | 18 | let deserialize_input inp c : LockServSeqNum.msg0 option = 19 | match Bytes.to_string inp with 20 | | "Unlock" -> Some LockServSeqNum.Unlock 21 | | "Lock" -> Some (LockServSeqNum.Lock c) 22 | | "Locked" -> Some (LockServSeqNum.Locked c) 23 | | _ -> None 24 | 25 | let serialize_output : LockServSeqNum.msg0 -> int * bytes = function 26 | | LockServSeqNum.Locked c -> (c, Bytes.of_string "Locked") 27 | | _ -> failwith "wrong output" 28 | 29 | let debug_input : LockServSeqNum.msg0 -> string = function 30 | | LockServSeqNum.Lock c -> Printf.sprintf "Lock %d" c 31 | | LockServSeqNum.Unlock -> "Unlock" 32 | | LockServSeqNum.Locked c -> Printf.sprintf "Locked %d" c 33 | 34 | let debug_msg : LockServSeqNum.seq_num_msg -> string = function 35 | | { LockServSeqNum.tmNum = n ; LockServSeqNum.tmMsg = m } -> 36 | Printf.sprintf "%d: %s" n (debug_input (Obj.magic m)) 37 | -------------------------------------------------------------------------------- /extraction/lockserv-seqnum/script/run.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | ./LockServSeqNumMain.native -debug -me $1 -port $2 -node Server,localhost:9000 -node Client-0,localhost:9001 -node Client-1,localhost:9002 3 | -------------------------------------------------------------------------------- /extraction/lockserv-serialized/.gitignore: -------------------------------------------------------------------------------- 1 | ocaml/LockServSerialized.ml 2 | ocaml/LockServSerialized.mli 3 | _build 4 | LockServSerializedMain.native 5 | LockServSerializedMain.byte 6 | -------------------------------------------------------------------------------- /extraction/lockserv-serialized/.merlin: -------------------------------------------------------------------------------- 1 | S ocaml 2 | B _build/** 3 | PKG verdi-runtime cheerios-runtime 4 | -------------------------------------------------------------------------------- /extraction/lockserv-serialized/Makefile: -------------------------------------------------------------------------------- 1 | OCAMLBUILD = ocamlbuild -use-ocamlfind -tags 'safe_string thread' -pkgs 'verdi-runtime cheerios-runtime' -I ocaml -cflag -g 2 | 3 | MLEXTRACTED = ocaml/LockServSerialized.ml ocaml/LockServSerialized.mli 4 | 5 | MLFILES = ocaml/LockServSerializedArrangement.ml ocaml/LockServSerializedMain.ml \ 6 | ocaml/LockServSerializedOpts.ml ocaml/LockServSerializedSerialization.ml 7 | 8 | default: LockServSerializedMain.native 9 | 10 | $(MLEXTRACTED): 11 | +$(MAKE) -C ../.. extraction/lockserv-serialized/$@ 12 | 13 | LockServSerializedMain.native: $(MLEXTRACTED) $(MLFILES) script/remove_module.pl 14 | perl script/remove_module.pl ocaml/LockServSerialized 15 | $(OCAMLBUILD) LockServSerializedMain.native 16 | 17 | LockServSerializedMain.byte: $(MLEXTRACTED) $(MLFILES) script/remove_module.pl 18 | perl script/remove_module.pl ocaml/LockServSerialized 19 | $(OCAMLBUILD) -tag debug LockServSerializedMain.byte 20 | 21 | clean: 22 | ocamlbuild -clean 23 | 24 | .PHONY: default clean $(MLEXTRACTED) 25 | 26 | .NOTPARALLEL: $(MLEXTRACTED) 27 | -------------------------------------------------------------------------------- /extraction/lockserv-serialized/coq/ExtractLockServSerialized.v: -------------------------------------------------------------------------------- 1 | Require Import Verdi.Verdi. 2 | 3 | Require Import Cheerios.Cheerios. 4 | 5 | Require Import LockServSerialized. 6 | 7 | Require Import ExtrOcamlBasic. 8 | Require Import ExtrOcamlNatInt. 9 | Require Import ExtrOcamlString. 10 | 11 | Require Import Verdi.ExtrOcamlBasicExt. 12 | Require Import Verdi.ExtrOcamlList. 13 | Require Import Verdi.ExtrOcamlFinInt. 14 | 15 | Require Import Cheerios.ExtrOcamlCheeriosBasic. 16 | Require Import Cheerios.ExtrOcamlCheeriosNatInt. 17 | Require Import Cheerios.ExtrOcamlCheeriosFinInt. 18 | 19 | Extraction "extraction/lockserv-serialized/ocaml/LockServSerialized.ml" seq transformed_base_params transformed_multi_params. 20 | -------------------------------------------------------------------------------- /extraction/lockserv-serialized/ocaml/LockServSerializedArrangement.ml: -------------------------------------------------------------------------------- 1 | module type IntValue = sig 2 | val v : int 3 | end 4 | 5 | module type Params = sig 6 | val debug : bool 7 | val num_clients : int 8 | end 9 | 10 | module LockServSerializedArrangement (P : Params) = struct 11 | type name = LockServSerialized.name0 12 | type state = LockServSerialized.data0 13 | type input = LockServSerialized.msg0 14 | type output = LockServSerialized.msg0 15 | type msg = Serializer_primitives.wire 16 | type client_id = int 17 | type res = (output list * state) * ((name * msg) list) 18 | type task_handler = name -> state -> res 19 | type timeout_setter = name -> state -> float option 20 | 21 | let system_name = "Lock Server with serialization" 22 | 23 | let init = fun n -> 24 | let open LockServSerialized in 25 | Obj.magic ((transformed_multi_params P.num_clients).init_handlers (Obj.magic n)) 26 | 27 | let handle_input = fun n i s -> 28 | let open LockServSerialized in 29 | Obj.magic ((transformed_multi_params P.num_clients).input_handlers (Obj.magic n) (Obj.magic i) (Obj.magic s)) 30 | 31 | let handle_msg = fun dst src m s -> 32 | let open LockServSerialized in 33 | Obj.magic ((transformed_multi_params P.num_clients).net_handlers (Obj.magic dst) (Obj.magic src) (Obj.magic m) (Obj.magic s)) 34 | 35 | let deserialize_msg = fun s -> s 36 | 37 | let serialize_msg = fun s -> s 38 | 39 | let deserialize_input = LockServSerializedSerialization.deserialize_input 40 | 41 | let serialize_output = LockServSerializedSerialization.serialize_output 42 | 43 | let debug = P.debug 44 | 45 | let debug_input = fun _ inp -> 46 | Printf.printf 47 | "[%s] got input %s" 48 | (Util.timestamp ()) 49 | (LockServSerializedSerialization.debug_input inp); 50 | print_newline () 51 | 52 | let debug_recv_msg = fun _ (nm, msg) -> 53 | Printf.printf 54 | "[%s] receiving message from %s" 55 | (Util.timestamp ()) 56 | (LockServSerializedSerialization.serialize_name nm); 57 | print_newline () 58 | 59 | let debug_send_msg = fun _ (nm, msg) -> 60 | Printf.printf 61 | "[%s] sending message to %s" 62 | (Util.timestamp ()) 63 | (LockServSerializedSerialization.serialize_name nm); 64 | print_newline () 65 | 66 | let create_client_id () = 67 | let upper_bound = 1073741823 in 68 | Random.int upper_bound 69 | 70 | let string_of_client_id = string_of_int 71 | 72 | let timeout_tasks = [] 73 | end 74 | -------------------------------------------------------------------------------- /extraction/lockserv-serialized/ocaml/LockServSerializedMain.ml: -------------------------------------------------------------------------------- 1 | open LockServSerializedOpts 2 | open LockServSerializedArrangement 3 | 4 | let () = 5 | let () = 6 | try 7 | parse Sys.argv 8 | with 9 | | Arg.Help msg -> 10 | Printf.printf "%s: %s" Sys.argv.(0) msg; 11 | exit 2 12 | | Arg.Bad msg -> 13 | Printf.eprintf "%s" msg; 14 | exit 2 15 | in 16 | let () = 17 | try 18 | validate () 19 | with Arg.Bad msg -> 20 | Printf.eprintf "%s: %s." Sys.argv.(0) msg; 21 | prerr_newline (); 22 | exit 2 23 | in 24 | let module Pms = struct 25 | let debug = !debug 26 | let num_clients = List.length !cluster - 1 27 | end in 28 | let module Arrangement = LockServSerializedArrangement (Pms) in 29 | let module Shim = UnorderedShim.Shim (Arrangement) in 30 | let open Shim in 31 | main { cluster = !cluster 32 | ; me = !me 33 | ; port = !port 34 | } 35 | -------------------------------------------------------------------------------- /extraction/lockserv-serialized/ocaml/LockServSerializedOpts.ml: -------------------------------------------------------------------------------- 1 | open List 2 | open Printf 3 | open Str 4 | 5 | let cluster_default : (LockServSerialized.name0 * (string * int)) list = [] 6 | let me_default : LockServSerialized.name0 = LockServSerialized.Server 7 | let port_default : int = 8351 8 | let debug_default : bool = false 9 | 10 | let cluster = ref cluster_default 11 | let me = ref me_default 12 | let port = ref port_default 13 | let debug = ref debug_default 14 | 15 | let node_spec arg nodes_ref doc = 16 | let parse opt = 17 | (* name,ip:port *) 18 | if string_match (regexp "\\([^,]+\\),\\(.+\\):\\([0-9]+\\)") opt 0 then 19 | match LockServSerializedSerialization.deserialize_name (matched_group 1 opt) with 20 | | Some nm -> (nm, (matched_group 2 opt, int_of_string (matched_group 3 opt))) 21 | | None -> raise (Arg.Bad (sprintf "wrong argument: '%s'; option '%s' expects a proper name" arg opt)) 22 | else 23 | raise (Arg.Bad (sprintf "wrong argument: '%s'; option '%s' expects an entry in the form 'name,host:port'" arg opt)) 24 | in (arg, Arg.String (fun opt -> nodes_ref := !nodes_ref @ [parse opt]), doc) 25 | 26 | let parse inp = 27 | let opts = 28 | [ node_spec "-node" cluster "{name,host:port} one node in the cluster" 29 | ; ("-me", Arg.String (fun opt -> 30 | match LockServSerializedSerialization.deserialize_name opt with 31 | | Some nm -> me := nm 32 | | None -> raise (Arg.Bad (sprintf "wrong argument: '-me' expects a proper name"))), "{name} name for this node") 33 | ; ("-port", Arg.Set_int port, "{port} port for client commands") 34 | ; ("-debug", Arg.Set debug, "run in debug mode") 35 | ] in 36 | Arg.parse_argv ?current:(Some (ref 0)) inp 37 | opts 38 | (fun x -> raise (Arg.Bad (sprintf "%s does not take position arguments" inp.(0)))) 39 | "Try -help for help or one of the following." 40 | 41 | let rec assoc_unique = function 42 | | [] -> true 43 | | (k, _) :: l -> if mem_assoc k l then false else assoc_unique l 44 | 45 | let validate () = 46 | if length !cluster = 0 then 47 | raise (Arg.Bad "Please specify at least one -node"); 48 | if not (mem_assoc !me !cluster) then 49 | raise (Arg.Bad (sprintf "%s is not a member of this cluster" (LockServSerializedSerialization.serialize_name !me))); 50 | if not (assoc_unique !cluster) then 51 | raise (Arg.Bad "Please remove duplicate -node name entries"); 52 | if !port = snd (List.assoc !me !cluster) then 53 | raise (Arg.Bad "Can't use same port for client commands and messages") 54 | -------------------------------------------------------------------------------- /extraction/lockserv-serialized/ocaml/LockServSerializedSerialization.ml: -------------------------------------------------------------------------------- 1 | let serialize_name : LockServSerialized.name0 -> string = function 2 | | LockServSerialized.Server -> "Server" 3 | | LockServSerialized.Client i -> Printf.sprintf "Client-%d" i 4 | 5 | let deserialize_name (s : string) : LockServSerialized.name0 option = 6 | match s with 7 | | "Server" -> Some LockServSerialized.Server 8 | | _ -> 9 | try Scanf.sscanf s "Client-%d" (fun x -> Some (LockServSerialized.Client (Obj.magic x))) 10 | with _ -> None 11 | 12 | let deserialize_input inp c : LockServSerialized.msg0 option = 13 | match Bytes.to_string inp with 14 | | "Unlock" -> Some LockServSerialized.Unlock 15 | | "Lock" -> Some (LockServSerialized.Lock c) 16 | | "Locked" -> Some (LockServSerialized.Locked c) 17 | | _ -> None 18 | 19 | let serialize_output : LockServSerialized.msg0 -> int * bytes = function 20 | | LockServSerialized.Locked c -> (c, Bytes.of_string "Locked") 21 | | _ -> failwith "invalid output" 22 | 23 | let debug_input : LockServSerialized.msg0 -> string = function 24 | | LockServSerialized.Lock c -> Printf.sprintf "Lock %d" c 25 | | LockServSerialized.Unlock -> "Unlock" 26 | | LockServSerialized.Locked c -> Printf.sprintf "Locked %d" c 27 | -------------------------------------------------------------------------------- /extraction/lockserv-serialized/script/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/lockserv-serialized/script/run.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | ./LockServSerializedMain.native -debug -me $1 -port $2 -node Server,localhost:9000 -node Client-0,localhost:9001 -node Client-1,localhost:9002 3 | -------------------------------------------------------------------------------- /extraction/lockserv/.gitignore: -------------------------------------------------------------------------------- 1 | ocaml/LockServ.ml 2 | ocaml/LockServ.mli 3 | _build 4 | LockServMain.native 5 | LockServTest.native 6 | -------------------------------------------------------------------------------- /extraction/lockserv/.merlin: -------------------------------------------------------------------------------- 1 | S ocaml 2 | S test 3 | B _build/** 4 | PKG verdi-runtime 5 | -------------------------------------------------------------------------------- /extraction/lockserv/Makefile: -------------------------------------------------------------------------------- 1 | OCAMLBUILD = ocamlbuild -use-ocamlfind -tags thread,safe_string -package verdi-runtime -I ocaml -cflag -g 2 | OCAMLBUILD_TEST = $(OCAMLBUILD) -package oUnit -I test 3 | 4 | MLEXTRACTED = ocaml/LockServ.ml ocaml/LockServ.mli 5 | 6 | MLFILES = ocaml/LockServArrangement.ml ocaml/LockServSerialization.ml \ 7 | ocaml/LockServMain.ml ocaml/LockServOpts.ml 8 | 9 | MLFILES_TEST = test/LockServTest.ml test/OptsTest.ml test/SerializationTest.ml 10 | 11 | default: LockServMain.native 12 | 13 | $(MLEXTRACTED): 14 | +$(MAKE) -C ../.. extraction/lockserv/$@ 15 | 16 | LockServMain.native: $(MLEXTRACTED) $(MLFILES) 17 | $(OCAMLBUILD) LockServMain.native 18 | 19 | LockServTest.native: $(MLEXTRACTED) $(MLFILES) $(MLFILES_TEST) 20 | $(OCAMLBUILD_TEST) LockServTest.native 21 | 22 | test: LockServTest.native 23 | ./LockServTest.native 24 | 25 | clean: 26 | ocamlbuild -clean 27 | 28 | .PHONY: default clean test $(MLEXTRACTED) 29 | 30 | .NOTPARALLEL: LockServMain.native LockServTest.native 31 | .NOTPARALLEL: $(MLEXTRACTED) 32 | -------------------------------------------------------------------------------- /extraction/lockserv/coq/ExtractLockServ.v: -------------------------------------------------------------------------------- 1 | Require Import Verdi.Verdi. 2 | 3 | Require Import LockServ. 4 | 5 | Require Import ExtrOcamlBasic. 6 | Require Import ExtrOcamlNatInt. 7 | 8 | Require Import Verdi.ExtrOcamlBasicExt. 9 | Require Import Verdi.ExtrOcamlList. 10 | Require Import Verdi.ExtrOcamlFinInt. 11 | 12 | Extraction "extraction/lockserv/ocaml/LockServ.ml" seq LockServ_BaseParams LockServ_MultiParams. 13 | -------------------------------------------------------------------------------- /extraction/lockserv/ocaml/LockServArrangement.ml: -------------------------------------------------------------------------------- 1 | module type IntValue = sig 2 | val v : int 3 | end 4 | 5 | module type Params = sig 6 | val debug : bool 7 | val num_clients : int 8 | end 9 | 10 | module LockServArrangement (P : Params) = struct 11 | type name = LockServ.name 12 | type state = LockServ.data0 13 | type input = LockServ.msg 14 | type output = LockServ.msg 15 | type msg = LockServ.msg 16 | type client_id = int 17 | type res = (output list * state) * ((name * msg) list) 18 | type task_handler = name -> state -> res 19 | type timeout_setter = name -> state -> float option 20 | 21 | let system_name = "Lock Server" 22 | 23 | let init = fun n -> 24 | let open LockServ in 25 | Obj.magic ((lockServ_MultiParams P.num_clients).init_handlers (Obj.magic n)) 26 | 27 | let handle_input = fun n i s -> 28 | let open LockServ in 29 | Obj.magic ((lockServ_MultiParams P.num_clients).input_handlers (Obj.magic n) (Obj.magic i) (Obj.magic s)) 30 | 31 | let handle_msg = fun dst src m s -> 32 | let open LockServ in 33 | Obj.magic ((lockServ_MultiParams P.num_clients).net_handlers (Obj.magic dst) (Obj.magic src) (Obj.magic m) (Obj.magic s)) 34 | 35 | let deserialize_msg = LockServSerialization.deserialize_msg 36 | 37 | let serialize_msg = LockServSerialization.serialize_msg 38 | 39 | let deserialize_input = LockServSerialization.deserialize_input 40 | 41 | let serialize_output = LockServSerialization.serialize_output 42 | 43 | let debug = P.debug 44 | 45 | let debug_input = fun _ inp -> 46 | Printf.printf 47 | "[%s] got input %s" 48 | (Util.timestamp ()) 49 | (LockServSerialization.debug_input inp); 50 | print_newline () 51 | 52 | let debug_recv_msg = fun _ (nm, msg) -> 53 | Printf.printf 54 | "[%s] receiving message %s from %s" 55 | (Util.timestamp ()) 56 | (LockServSerialization.debug_msg msg) 57 | (LockServSerialization.serialize_name nm); 58 | print_newline () 59 | 60 | let debug_send_msg = fun _ (nm, msg) -> 61 | Printf.printf 62 | "[%s] sending message %s to %s" 63 | (Util.timestamp ()) 64 | (LockServSerialization.debug_msg msg) 65 | (LockServSerialization.serialize_name nm); 66 | print_newline () 67 | 68 | let create_client_id () = 69 | let upper_bound = 1073741823 in 70 | Random.int upper_bound 71 | 72 | let string_of_client_id = string_of_int 73 | 74 | let timeout_tasks = [] 75 | end 76 | -------------------------------------------------------------------------------- /extraction/lockserv/ocaml/LockServMain.ml: -------------------------------------------------------------------------------- 1 | open LockServOpts 2 | open LockServArrangement 3 | 4 | let () = 5 | let () = 6 | try 7 | parse Sys.argv 8 | with 9 | | Arg.Help msg -> 10 | Printf.printf "%s: %s" Sys.argv.(0) msg; 11 | exit 2 12 | | Arg.Bad msg -> 13 | Printf.eprintf "%s" msg; 14 | exit 2 15 | in 16 | let () = 17 | try 18 | validate () 19 | with Arg.Bad msg -> 20 | Printf.eprintf "%s: %s." Sys.argv.(0) msg; 21 | prerr_newline (); 22 | exit 2 23 | in 24 | let module Pms = struct 25 | let debug = !debug 26 | let num_clients = List.length !cluster - 1 27 | end in 28 | let module Arrangement = LockServArrangement (Pms) in 29 | let module Shim = UnorderedShim.Shim (Arrangement) in 30 | let open Shim in 31 | main { cluster = !cluster 32 | ; me = !me 33 | ; port = !port 34 | } 35 | -------------------------------------------------------------------------------- /extraction/lockserv/ocaml/LockServOpts.ml: -------------------------------------------------------------------------------- 1 | open List 2 | open Printf 3 | open Str 4 | 5 | let cluster_default : (LockServ.name * (string * int)) list = [] 6 | let me_default : LockServ.name = LockServ.Server 7 | let port_default : int = 8351 8 | let debug_default : bool = false 9 | 10 | let cluster = ref cluster_default 11 | let me = ref me_default 12 | let port = ref port_default 13 | let debug = ref debug_default 14 | 15 | let node_spec arg nodes_ref doc = 16 | let parse opt = 17 | (* name,ip:port *) 18 | if string_match (regexp "\\([^,]+\\),\\(.+\\):\\([0-9]+\\)") opt 0 then 19 | match LockServSerialization.deserialize_name (matched_group 1 opt) with 20 | | Some nm -> (nm, (matched_group 2 opt, int_of_string (matched_group 3 opt))) 21 | | None -> raise (Arg.Bad (sprintf "wrong argument: '%s'; option '%s' expects a proper name" arg opt)) 22 | else 23 | raise (Arg.Bad (sprintf "wrong argument: '%s'; option '%s' expects an entry in the form 'name,host:port'" arg opt)) 24 | in (arg, Arg.String (fun opt -> nodes_ref := !nodes_ref @ [parse opt]), doc) 25 | 26 | let parse inp = 27 | let opts = 28 | [ node_spec "-node" cluster "{name,host:port} one node in the cluster" 29 | ; ("-me", Arg.String (fun opt -> 30 | match LockServSerialization.deserialize_name opt with 31 | | Some nm -> me := nm 32 | | None -> raise (Arg.Bad (sprintf "wrong argument: '-me' expects a proper name"))), "{name} name for this node") 33 | ; ("-port", Arg.Set_int port, "{port} port for client commands") 34 | ; ("-debug", Arg.Set debug, "run in debug mode") 35 | ] in 36 | Arg.parse_argv ?current:(Some (ref 0)) inp 37 | opts 38 | (fun x -> raise (Arg.Bad (sprintf "%s does not take position arguments" inp.(0)))) 39 | "Try -help for help or one of the following." 40 | 41 | let rec assoc_unique = function 42 | | [] -> true 43 | | (k, _) :: l -> if mem_assoc k l then false else assoc_unique l 44 | 45 | let validate () = 46 | if length !cluster = 0 then 47 | raise (Arg.Bad "Please specify at least one -node"); 48 | if not (mem_assoc !me !cluster) then 49 | raise (Arg.Bad (sprintf "%s is not a member of this cluster" (LockServSerialization.serialize_name !me))); 50 | if not (assoc_unique !cluster) then 51 | raise (Arg.Bad "Please remove duplicate -node name entries"); 52 | if !port = snd (List.assoc !me !cluster) then 53 | raise (Arg.Bad "Can't use same port for client commands and messages") 54 | -------------------------------------------------------------------------------- /extraction/lockserv/ocaml/LockServSerialization.ml: -------------------------------------------------------------------------------- 1 | let serialize_name : LockServ.name -> string = function 2 | | LockServ.Server -> "Server" 3 | | LockServ.Client i -> Printf.sprintf "Client-%d" i 4 | 5 | let deserialize_name (s : string) : LockServ.name option = 6 | match s with 7 | | "Server" -> Some LockServ.Server 8 | | _ -> 9 | try Scanf.sscanf s "Client-%d" (fun x -> Some (LockServ.Client (Obj.magic x))) 10 | with _ -> None 11 | 12 | let deserialize_msg : bytes -> LockServ.msg = fun s -> 13 | Marshal.from_bytes s 0 14 | 15 | let serialize_msg : LockServ.msg -> bytes = fun m -> 16 | Marshal.to_bytes m [] 17 | 18 | let deserialize_input inp c : LockServ.msg option = 19 | match Bytes.to_string inp with 20 | | "Unlock" -> Some LockServ.Unlock 21 | | "Lock" -> Some (LockServ.Lock c) 22 | | "Locked" -> Some (LockServ.Locked c) 23 | | _ -> None 24 | 25 | let serialize_output : LockServ.msg -> int * bytes = function 26 | | LockServ.Locked c -> (c, Bytes.of_string "Locked") 27 | | _ -> failwith "wrong output" 28 | 29 | let debug_msg : LockServ.msg -> string = function 30 | | LockServ.Lock c -> Printf.sprintf "Lock %d" c 31 | | LockServ.Unlock -> "Unlock" 32 | | LockServ.Locked c -> Printf.sprintf "Locked %d" c 33 | 34 | let debug_input = debug_msg 35 | -------------------------------------------------------------------------------- /extraction/lockserv/script/client.py: -------------------------------------------------------------------------------- 1 | import socket 2 | import re 3 | from struct import pack, unpack 4 | 5 | class SendError(Exception): 6 | pass 7 | 8 | class ReceiveError(Exception): 9 | pass 10 | 11 | class Client(object): 12 | re_locked = re.compile(r'Locked') 13 | 14 | def __init__(self, host, port, sock=None): 15 | if not sock: 16 | self.sock = socket.socket(socket.AF_INET, socket.SOCK_STREAM) 17 | self.sock.connect((host, port)) 18 | else: 19 | self.sock = sock 20 | 21 | def send_msg(self, msg): 22 | n = self.sock.send(pack("::: 7 | [ 8 | SerializationTest.tests; 9 | OptsTest.tests 10 | ]) 11 | -------------------------------------------------------------------------------- /extraction/lockserv/test/OptsTest.ml: -------------------------------------------------------------------------------- 1 | open OUnit2 2 | open ListLabels 3 | open Util 4 | 5 | let tear_down () test_ctxt = 6 | LockServOpts.cluster := LockServOpts.cluster_default; 7 | LockServOpts.me := LockServOpts.me_default; 8 | LockServOpts.port := LockServOpts.port_default; 9 | LockServOpts.debug := LockServOpts.debug_default 10 | 11 | let test_parse_correct_line test_ctxt = 12 | LockServOpts.parse (arr_of_string "./LockServMain.native -me Server -port 8000 -node Server,localhost:9000 -node Client-0,localhost:9001 -node Client-1,localhost:9002"); 13 | assert_equal LockServ.Server !LockServOpts.me; 14 | assert_equal 8000 !LockServOpts.port; 15 | assert_equal [(LockServ.Server, ("localhost", 9000)); (LockServ.Client 0, ("localhost", 9001)); (LockServ.Client 1, ("localhost", 9002))] !LockServOpts.cluster; 16 | assert_equal false !LockServOpts.debug 17 | 18 | let test_parse_correct_line_with_debug test_ctxt = 19 | LockServOpts.parse (arr_of_string "./LockServMain.native -debug -me Client-0 -port 8000 -node Server,localhost:9000 -node Client-0,localhost:9001"); 20 | assert_equal (LockServ.Client 0) !LockServOpts.me; 21 | assert_equal 8000 !LockServOpts.port; 22 | assert_equal [(LockServ.Server, ("localhost", 9000)); (LockServ.Client 0, ("localhost", 9001))] !LockServOpts.cluster; 23 | assert_equal true !LockServOpts.debug 24 | 25 | let test_validate_correct_line test_ctxt = 26 | LockServOpts.parse (arr_of_string "./LockServMain.native -me Server -port 8000 -node Server,localhost:9000 -node Client-0,localhost:9001 -node Client-1,localhost:9002"); 27 | assert_equal () (LockServOpts.validate ()) 28 | 29 | let test_validate_empty_cluster test_ctxt = 30 | LockServOpts.parse (arr_of_string "./LockServMain.native -me Server -port 8000"); 31 | assert_raises (Arg.Bad "Please specify at least one -node") LockServOpts.validate 32 | 33 | let test_validate_me_not_cluster_member test_ctxt = 34 | LockServOpts.parse (arr_of_string "./LockServMain.native -me Server -port 8000 -node Client-0,localhost:9001 -node Client-1,localhost:9002"); 35 | assert_raises (Arg.Bad "Server is not a member of this cluster") LockServOpts.validate 36 | 37 | let test_validate_duplicate_node_entry test_ctxt = 38 | LockServOpts.parse (arr_of_string "./LockServMain.native -me Server -port 8000 -node Server,localhost:9000 -node Server,localhost:9001"); 39 | assert_raises (Arg.Bad "Please remove duplicate -node name entries") LockServOpts.validate 40 | 41 | let test_validate_same_client_msg_port test_ctxt = 42 | LockServOpts.parse (arr_of_string "./LockServMain.native -me Server -port 8000 -node Server,localhost:8000 -node Client-0,localhost:9001"); 43 | assert_raises (Arg.Bad "Can't use same port for client commands and messages") LockServOpts.validate 44 | 45 | let test_list = 46 | ["parse correct line", test_parse_correct_line; 47 | "parse correct line with debug", test_parse_correct_line_with_debug; 48 | "validate correct line", test_validate_correct_line; 49 | "validate empty cluster", test_validate_empty_cluster; 50 | "validate me not member of cluster", test_validate_me_not_cluster_member; 51 | "validate duplicate node entry", test_validate_duplicate_node_entry; 52 | "validate same client/msg port", test_validate_same_client_msg_port; 53 | ] 54 | 55 | let tests = 56 | "Opts" >::: 57 | (map test_list ~f:(fun (name, test_fn) -> 58 | name >:: (fun test_ctxt -> 59 | bracket ignore tear_down test_ctxt; 60 | test_fn test_ctxt) 61 | )) 62 | -------------------------------------------------------------------------------- /extraction/lockserv/test/SerializationTest.ml: -------------------------------------------------------------------------------- 1 | open OUnit2 2 | open ListLabels 3 | 4 | let tear_down () test_ctxt = () 5 | 6 | let test_deserialize_server_name test_ctxt = 7 | assert_equal (Some LockServ.Server) (LockServSerialization.deserialize_name "Server") 8 | 9 | let test_deserialize_client_name test_ctxt = 10 | assert_equal (Some (LockServ.Client 5)) (LockServSerialization.deserialize_name "Client-5") 11 | 12 | let test_serialize_server_name test_ctxt = 13 | assert_equal "Server" (LockServSerialization.serialize_name LockServ.Server) 14 | 15 | let test_serialize_client_name test_ctxt = 16 | assert_equal "Client-0" (LockServSerialization.serialize_name (LockServ.Client 0)) 17 | 18 | let test_list = 19 | [ 20 | "deserialize server name", test_deserialize_server_name; 21 | "deserialize client name", test_deserialize_client_name; 22 | "serialize server name", test_serialize_server_name; 23 | "serialize client name", test_serialize_client_name; 24 | ] 25 | 26 | let tests = 27 | "Serialization" >::: 28 | (map test_list ~f:(fun (name, test_fn) -> 29 | name >:: (fun test_ctxt -> 30 | bracket ignore tear_down test_ctxt; 31 | test_fn test_ctxt) 32 | )) 33 | -------------------------------------------------------------------------------- /lockserv-seqnum.opam: -------------------------------------------------------------------------------- 1 | opam-version: "1.2" 2 | version: "dev" 3 | maintainer: "palmskog@gmail.com" 4 | 5 | homepage: "https://github.com/DistributedComponents/verdi-lockserv" 6 | dev-repo: "https://github.com/DistributedComponents/verdi-lockserv.git" 7 | bug-reports: "https://github.com/DistributedComponents/verdi-lockserv/issues" 8 | license: "BSD" 9 | 10 | build: [ 11 | [ "./configure" ] 12 | [ make "-j%{jobs}%" "lockserv-seqnum" ] 13 | ] 14 | available: [ ocaml-version >= "4.02.3" ] 15 | depends: [ 16 | "coq" {((>= "8.6.1" & < "8.7~") | (>= "8.7" & < "8.8~"))} 17 | "verdi" {= "dev"} 18 | "StructTact" {= "dev"} 19 | "cheerios" {= "dev"} 20 | "verdi-runtime" {= "dev"} 21 | "ocamlfind" {build} 22 | "ocamlbuild" {build} 23 | ] 24 | 25 | authors: [ 26 | "James Wilcox <>" 27 | "Doug Woos <>" 28 | "Pavel Panchekha <>" 29 | "Zachary Tatlock <>" 30 | "Steve Anton <>" 31 | "Karl Palmskog <>" 32 | "Ryan Doenges <>" 33 | ] 34 | -------------------------------------------------------------------------------- /lockserv-serialized.opam: -------------------------------------------------------------------------------- 1 | opam-version: "1.2" 2 | version: "dev" 3 | maintainer: "palmskog@gmail.com" 4 | 5 | homepage: "https://github.com/DistributedComponents/verdi-lockserv" 6 | dev-repo: "https://github.com/DistributedComponents/verdi-lockserv.git" 7 | bug-reports: "https://github.com/DistributedComponents/verdi-lockserv/issues" 8 | license: "BSD" 9 | 10 | build: [ 11 | [ "./configure" ] 12 | [ make "-j%{jobs}%" "lockserv-serialized" ] 13 | ] 14 | available: [ ocaml-version >= "4.02.3" ] 15 | depends: [ 16 | "coq" {((>= "8.6.1" & < "8.7~") | (>= "8.7" & < "8.8~"))} 17 | "verdi" {= "dev"} 18 | "StructTact" {= "dev"} 19 | "cheerios" {= "dev"} 20 | "verdi-runtime" {= "dev"} 21 | "cheerios-runtime" {= "dev"} 22 | "ocamlfind" {build} 23 | "ocamlbuild" {build} 24 | ] 25 | 26 | authors: [ 27 | "James Wilcox <>" 28 | "Doug Woos <>" 29 | "Pavel Panchekha <>" 30 | "Zachary Tatlock <>" 31 | "Steve Anton <>" 32 | "Karl Palmskog <>" 33 | "Ryan Doenges <>" 34 | ] 35 | -------------------------------------------------------------------------------- /lockserv.opam: -------------------------------------------------------------------------------- 1 | opam-version: "1.2" 2 | version: "dev" 3 | maintainer: "palmskog@gmail.com" 4 | 5 | homepage: "https://github.com/DistributedComponents/verdi-lockserv" 6 | dev-repo: "https://github.com/DistributedComponents/verdi-lockserv.git" 7 | bug-reports: "https://github.com/DistributedComponents/verdi-lockserv/issues" 8 | license: "BSD" 9 | 10 | build: [ 11 | [ "./configure" ] 12 | [ make "-j%{jobs}%" "lockserv" ] 13 | ] 14 | build-test: [make "lockserv-test"] 15 | available: [ ocaml-version >= "4.02.3" ] 16 | depends: [ 17 | "coq" {((>= "8.6.1" & < "8.7~") | (>= "8.7" & < "8.8~"))} 18 | "verdi" {= "dev"} 19 | "StructTact" {= "dev"} 20 | "cheerios" {= "dev"} 21 | "verdi-runtime" {= "dev"} 22 | "ocamlfind" {build} 23 | "ocamlbuild" {build} 24 | "ounit" {test & >= "2.0.0"} 25 | ] 26 | 27 | authors: [ 28 | "James Wilcox <>" 29 | "Doug Woos <>" 30 | "Pavel Panchekha <>" 31 | "Zachary Tatlock <>" 32 | "Steve Anton <>" 33 | "Karl Palmskog <>" 34 | "Ryan Doenges <>" 35 | ] 36 | -------------------------------------------------------------------------------- /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 are missing from _CoqProject.' 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 _CoqProject but do 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 README.md 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 | 90 | mv $COQPROJECT_TMP _CoqProject 91 | -------------------------------------------------------------------------------- /systems/LockServ.v: -------------------------------------------------------------------------------- 1 | Require Import Verdi.Verdi. 2 | Require Import Verdi.HandlerMonad. 3 | Require Import StructTact.Fin. 4 | 5 | Local Arguments update {_} {_} _ _ _ _ _ : simpl never. 6 | 7 | Require Import Verdi.StatePacketPacketDecomposition. 8 | 9 | Set Implicit Arguments. 10 | 11 | Section LockServ. 12 | 13 | Variable num_Clients : nat. 14 | 15 | Definition Client_index := (fin num_Clients). 16 | 17 | Inductive Name := 18 | | Client : Client_index -> Name 19 | | Server : Name. 20 | 21 | Definition list_Clients := map Client (all_fin num_Clients). 22 | 23 | Definition Name_eq_dec : forall a b : Name, {a = b} + {a <> b}. 24 | decide equality. apply fin_eq_dec. 25 | Defined. 26 | 27 | Definition Request_index := nat. 28 | 29 | Inductive Msg := 30 | | Lock : Request_index -> Msg 31 | | Unlock : Msg 32 | | Locked : Request_index -> Msg. 33 | 34 | Definition Msg_eq_dec : forall a b : Msg, {a = b} + {a <> b}. 35 | decide equality; auto using Nat.eq_dec. 36 | Defined. 37 | 38 | Definition Input := Msg. 39 | Definition Output := Msg. 40 | 41 | Record Data := mkData { queue : list (Client_index * Request_index) ; held : bool }. 42 | 43 | Definition set_Data_queue d q := mkData q (held d). 44 | Definition set_Data_held d b := mkData (queue d) b. 45 | 46 | Notation "{[ d 'with' 'queue' := q ]}" := (set_Data_queue d q). 47 | Notation "{[ d 'with' 'held' := b ]}" := (set_Data_held d b). 48 | 49 | Definition init_data (n : Name) : Data := mkData [] false. 50 | 51 | Definition Handler (S : Type) := GenHandler (Name * Msg) S Output unit. 52 | 53 | Definition ClientNetHandler (i : Client_index) (m : Msg) : Handler Data := 54 | d <- get ;; 55 | match m with 56 | | Locked id => 57 | put {[ d with held := true ]} ;; 58 | write_output (Locked id) 59 | | _ => nop 60 | end. 61 | 62 | Definition ClientIOHandler (i : Client_index) (m : Msg) : Handler Data := 63 | d <- get ;; 64 | match m with 65 | | Lock id => send (Server, Lock id) 66 | | Unlock => 67 | when (held d) (put {[ d with held := false ]} ;; send (Server, Unlock)) 68 | | _ => nop 69 | end. 70 | 71 | Definition ServerNetHandler (src : Name) (m : Msg) : Handler Data := 72 | d <- get ;; 73 | match m with 74 | | Lock id => 75 | match src with 76 | | Server => nop 77 | | Client c => 78 | when (null (queue d)) (send (src, Locked id)) ;; 79 | put {[ d with queue := queue d ++ [(c, id)] ]} 80 | end 81 | | Unlock => 82 | match queue d with 83 | | _ :: (c, id) :: xs => 84 | put {[ d with queue := (c, id) :: xs ]} ;; 85 | send (Client c, Locked id) 86 | | _ => 87 | put {[ d with queue := [] ]} 88 | end 89 | | _ => nop 90 | end. 91 | 92 | Definition ServerIOHandler (m : Msg) : Handler Data := nop. 93 | 94 | Definition NetHandler (nm src : Name) (m : Msg) : Handler Data := 95 | match nm with 96 | | Client c => ClientNetHandler c m 97 | | Server => ServerNetHandler src m 98 | end. 99 | 100 | Definition InputHandler (nm : Name) (m : Msg) : Handler Data := 101 | match nm with 102 | | Client c => ClientIOHandler c m 103 | | Server => ServerIOHandler m 104 | end. 105 | 106 | Ltac handler_unfold := 107 | repeat (monad_unfold; unfold NetHandler, 108 | InputHandler, 109 | ServerNetHandler, 110 | ClientNetHandler, 111 | ClientIOHandler, 112 | ServerIOHandler in *). 113 | 114 | Definition Nodes := Server :: list_Clients. 115 | 116 | Theorem In_n_Nodes : 117 | forall n : Name, In n Nodes. 118 | Proof using. 119 | intros. 120 | unfold Nodes, list_Clients. 121 | simpl. 122 | destruct n. 123 | - right. 124 | apply in_map. 125 | apply all_fin_all. 126 | - left. 127 | reflexivity. 128 | Qed. 129 | 130 | Theorem nodup : 131 | NoDup Nodes. 132 | Proof using. 133 | unfold Nodes, list_Clients. 134 | apply NoDup_cons. 135 | - in_crush. discriminate. 136 | - apply NoDup_map_injective. 137 | + intros. congruence. 138 | + apply all_fin_NoDup. 139 | Qed. 140 | 141 | Global Instance LockServ_BaseParams : BaseParams := 142 | { 143 | data := Data ; 144 | input := Input ; 145 | output := Output 146 | }. 147 | 148 | Global Instance LockServ_MultiParams : MultiParams LockServ_BaseParams := 149 | { 150 | name := Name ; 151 | msg := Msg ; 152 | msg_eq_dec := Msg_eq_dec ; 153 | name_eq_dec := Name_eq_dec ; 154 | nodes := Nodes ; 155 | all_names_nodes := In_n_Nodes ; 156 | no_dup_nodes := nodup ; 157 | init_handlers := init_data ; 158 | net_handlers := fun dst src msg s => 159 | runGenHandler_ignore s (NetHandler dst src msg) ; 160 | input_handlers := fun nm msg s => 161 | runGenHandler_ignore s (InputHandler nm msg) 162 | }. 163 | 164 | (* This is the fundamental safety property of the system: 165 | No two different clients can (think they) hold 166 | the lock at once. 167 | *) 168 | Definition mutual_exclusion (sigma : name -> data) : Prop := 169 | forall m n, 170 | held (sigma (Client m)) = true -> 171 | held (sigma (Client n)) = true -> 172 | m = n. 173 | 174 | (* The system enforces mutual exclusion at the server. Whenever a 175 | client believs it holds the lock, that client is at the head of the 176 | server's queue. *) 177 | Definition locks_correct (sigma : name -> data) : Prop := 178 | forall n, 179 | held (sigma (Client n)) = true -> 180 | exists id t, 181 | queue (sigma Server) = (n, id) :: t. 182 | 183 | (* We first show that this actually implies mutual exclusion. *) 184 | Lemma locks_correct_implies_mutex : 185 | forall sigma, 186 | locks_correct sigma -> 187 | mutual_exclusion sigma. 188 | Proof using. 189 | unfold locks_correct, mutual_exclusion. 190 | intros. 191 | repeat find_apply_hyp_hyp. 192 | break_exists. 193 | find_rewrite. find_inversion. 194 | auto. 195 | Qed. 196 | 197 | Definition valid_unlock q h c p := 198 | pSrc p = Client c /\ 199 | (exists (id : Request_index) t, q = (c, id) :: t) /\ 200 | h = false. 201 | 202 | Definition locks_correct_unlock (sigma : name -> data) (p : packet) : Prop := 203 | pBody p = Unlock -> 204 | exists c, valid_unlock (queue (sigma Server)) (held (sigma (Client c))) c p. 205 | 206 | Definition valid_locked q h c p := 207 | pDst p = Client c /\ 208 | (exists (id : Request_index) t, q = (c, id) :: t) /\ 209 | h = false. 210 | 211 | Definition locks_correct_locked (sigma : name -> data) (p : packet) : Prop := 212 | forall id, pBody p = Locked id -> 213 | exists c, valid_locked (queue (sigma Server)) (held (sigma (Client c))) c p. 214 | 215 | Definition LockServ_network_invariant (sigma : name -> data) (p : packet) : Prop := 216 | locks_correct_unlock sigma p /\ 217 | locks_correct_locked sigma p. 218 | 219 | Definition LockServ_network_network_invariant (p q : packet) : Prop := 220 | (pBody p = Unlock -> pBody q = Unlock -> False) /\ 221 | (forall id, pBody p = Locked id -> pBody q = Unlock -> False) /\ 222 | (forall id, pBody p = Unlock -> pBody q = Locked id -> False) /\ 223 | (forall id id', pBody p = Locked id -> pBody q = Locked id' -> False). 224 | 225 | Lemma nwnw_sym : 226 | forall p q, 227 | LockServ_network_network_invariant p q -> 228 | LockServ_network_network_invariant q p. 229 | Proof using. 230 | unfold LockServ_network_network_invariant. 231 | intuition eauto. 232 | Qed. 233 | 234 | Lemma locks_correct_init : 235 | locks_correct init_handlers. 236 | Proof using. 237 | unfold locks_correct. simpl. discriminate. 238 | Qed. 239 | 240 | Lemma InputHandler_cases : 241 | forall h i st u out st' ms, 242 | InputHandler h i st = (u, out, st', ms) -> 243 | (exists c, h = Client c /\ 244 | ((exists id, i = Lock id /\ out = [] /\ st' = st /\ ms = [(Server, Lock id)]) \/ 245 | (i = Unlock /\ out = [] /\ held st' = false /\ 246 | ((held st = true /\ ms = [(Server, Unlock)]) \/ 247 | (st' = st /\ ms = []))))) \/ 248 | (out = [] /\ st' = st /\ ms = []). 249 | Proof using. 250 | handler_unfold. 251 | intros. 252 | repeat break_match; repeat tuple_inversion; 253 | subst; simpl in *; subst; simpl in *. 254 | - left. eexists. intuition eauto. 255 | - left. eexists. intuition. 256 | - left. eexists. intuition. 257 | - auto. 258 | - auto. 259 | Qed. 260 | 261 | Lemma locks_correct_update_false : 262 | forall sigma st' x, 263 | locks_correct sigma -> 264 | held st' = false -> 265 | locks_correct (update name_eq_dec sigma (Client x) st'). 266 | Proof using. 267 | unfold locks_correct. 268 | intuition. 269 | destruct (Name_eq_dec (Client x) (Client n)). 270 | - find_inversion. exfalso. 271 | rewrite_update. 272 | congruence. 273 | - rewrite_update. 274 | auto. 275 | Qed. 276 | 277 | Ltac set_up_input_handlers := 278 | intros; 279 | find_apply_lem_hyp InputHandler_cases; 280 | intuition idtac; try break_exists; intuition idtac; subst; 281 | repeat find_rewrite; 282 | simpl in *; intuition idtac; repeat find_inversion; 283 | try now rewrite update_nop_ext. 284 | 285 | Lemma locks_correct_input_handlers : 286 | forall h i sigma u st' out ms, 287 | InputHandler h i (sigma h) = (u, out, st', ms) -> 288 | locks_correct sigma -> 289 | locks_correct (update name_eq_dec sigma h st'). 290 | Proof using. 291 | set_up_input_handlers; break_exists; repeat break_and; 292 | eauto using locks_correct_update_false. 293 | subst. 294 | unfold locks_correct in *. 295 | intuition. 296 | find_rewrite_lem update_nop_ext. 297 | pose proof (H0 n H). 298 | break_exists. 299 | exists x1, x2. 300 | rewrite update_nop_ext. 301 | assumption. 302 | Qed. 303 | 304 | Lemma ClientNetHandler_cases : 305 | forall c m st u out st' ms, 306 | ClientNetHandler c m st = (u, out, st', ms) -> 307 | ms = [] /\ 308 | ((st' = st /\ out = [] ) \/ 309 | (exists id, m = Locked id /\ out = [Locked id] /\ held st' = true)). 310 | Proof using. 311 | handler_unfold. 312 | intros. 313 | repeat break_match; repeat tuple_inversion; subst; intuition eauto. 314 | Qed. 315 | 316 | Lemma ServerNetHandler_cases : 317 | forall src m st u out st' ms, 318 | ServerNetHandler src m st = (u, out, st', ms) -> 319 | out = [] /\ 320 | ((exists c, src = Client c /\ 321 | (exists id, m = Lock id /\ queue st' = queue st ++ [(c, id)] /\ 322 | ((exists id, queue st = [] /\ ms = [(Client c, Locked id)]) \/ 323 | (queue st <> [] /\ ms = [])))) \/ 324 | ((m = Unlock /\ 325 | queue st' = tail (queue st) /\ 326 | ((queue st' = [] /\ ms = []) \/ 327 | (exists c' id t, queue st' = (c', id) :: t /\ ms = [(Client c', Locked id)])))) \/ 328 | ms = [] /\ st' = st). 329 | Proof using. 330 | handler_unfold. 331 | intros. 332 | repeat break_match; repeat tuple_inversion; subst. 333 | - find_apply_lem_hyp null_sound. find_rewrite. simpl. 334 | intuition. left. eexists. intuition. eexists. intuition. 335 | left. eexists. intuition. 336 | - simpl. find_apply_lem_hyp null_false_neq_nil. 337 | intuition. left. eexists. intuition. eexists. intuition. 338 | - simpl. auto. 339 | - simpl. destruct st; simpl in *; subst; auto. 340 | - simpl in *. intuition. 341 | - simpl in *. intuition eauto. 342 | - simpl. intuition. 343 | Qed. 344 | 345 | Definition at_head_of_queue sigma c := (exists id t, queue (sigma Server) = (c, id) :: t). 346 | 347 | Lemma at_head_of_queue_intro : 348 | forall sigma c id t, 349 | queue (sigma Server) = (c, id) :: t -> 350 | at_head_of_queue sigma c. 351 | Proof using. 352 | unfold at_head_of_queue. 353 | firstorder. 354 | Qed. 355 | 356 | Lemma locks_correct_update_true : 357 | forall sigma c st', 358 | held st' = true -> 359 | at_head_of_queue sigma c -> 360 | locks_correct sigma -> 361 | locks_correct (update name_eq_dec sigma (Client c) st'). 362 | Proof using. 363 | unfold locks_correct. 364 | intros. 365 | destruct (Name_eq_dec (Client c) (Client n)); rewrite_update; try find_inversion; auto. 366 | Qed. 367 | 368 | Lemma locks_correct_locked_at_head : 369 | forall sigma p c id, 370 | pDst p = Client c -> 371 | pBody p = Locked id -> 372 | locks_correct_locked sigma p -> 373 | at_head_of_queue sigma c. 374 | Proof using. 375 | unfold locks_correct_locked. 376 | firstorder. 377 | repeat find_rewrite. pose proof (H1 id). concludes. break_exists. unfold valid_locked in *. break_and. break_exists. 378 | find_rewrite. find_injection. 379 | eauto using at_head_of_queue_intro. 380 | Qed. 381 | 382 | Lemma all_clients_false_locks_correct_server_update : 383 | forall sigma st, 384 | (forall c, held (sigma (Client c)) = false) -> 385 | locks_correct (update name_eq_dec sigma Server st). 386 | Proof using. 387 | unfold locks_correct. 388 | intros. 389 | rewrite_update. 390 | now find_higher_order_rewrite. 391 | Qed. 392 | 393 | Lemma locks_correct_true_at_head_of_queue : 394 | forall sigma x, 395 | locks_correct sigma -> 396 | held (sigma (Client x)) = true -> 397 | at_head_of_queue sigma x. 398 | Proof using. 399 | unfold locks_correct. 400 | intros. 401 | find_apply_hyp_hyp. break_exists. 402 | eauto using at_head_of_queue_intro. 403 | Qed. 404 | 405 | Lemma at_head_of_nil : 406 | forall sigma c, 407 | at_head_of_queue sigma c -> 408 | queue (sigma Server) = [] -> 409 | False. 410 | Proof using. 411 | unfold at_head_of_queue. 412 | firstorder. 413 | congruence. 414 | Qed. 415 | 416 | Lemma empty_queue_all_clients_false : 417 | forall sigma, 418 | locks_correct sigma -> 419 | queue (sigma Server) = [] -> 420 | (forall c, held (sigma (Client c)) = false). 421 | Proof using. 422 | intuition. 423 | destruct (held (sigma (Client c))) eqn:?; auto. 424 | exfalso. eauto using at_head_of_nil, locks_correct_true_at_head_of_queue. 425 | Qed. 426 | 427 | Lemma unlock_in_flight_all_clients_false : 428 | forall sigma p, 429 | pBody p = Unlock -> 430 | locks_correct_unlock sigma p -> 431 | locks_correct sigma -> 432 | (forall c, held (sigma (Client c)) = false). 433 | Proof using. 434 | intros. 435 | destruct (held (sigma (Client c))) eqn:?; auto. 436 | firstorder. 437 | find_copy_apply_lem_hyp locks_correct_true_at_head_of_queue; auto. 438 | unfold at_head_of_queue in *. break_exists. 439 | congruence. 440 | Qed. 441 | 442 | Lemma locks_correct_at_head_preserved : 443 | forall sigma st', 444 | locks_correct sigma -> 445 | (forall c, at_head_of_queue sigma c -> at_head_of_queue (update name_eq_dec sigma Server st') c) -> 446 | locks_correct (update name_eq_dec sigma Server st'). 447 | Proof using. 448 | unfold locks_correct, at_head_of_queue. 449 | firstorder. 450 | Qed. 451 | 452 | Lemma snoc_at_head_of_queue_preserved : 453 | forall sigma st' x, 454 | queue st' = queue (sigma Server) ++ [x] -> 455 | (forall c, at_head_of_queue sigma c -> at_head_of_queue (update name_eq_dec sigma Server st') c). 456 | Proof using. 457 | unfold at_head_of_queue. 458 | intuition. break_exists. 459 | rewrite_update. 460 | find_rewrite. 461 | eauto. 462 | Qed. 463 | 464 | Ltac set_up_net_handlers := 465 | intros; 466 | match goal with 467 | | [ H : context [ NetHandler (pDst ?p) _ _ _ ] |- _ ] => 468 | destruct (pDst p) eqn:? 469 | end; simpl in *; 470 | [find_apply_lem_hyp ClientNetHandler_cases | 471 | find_apply_lem_hyp ServerNetHandler_cases; intuition; try break_exists ]; 472 | intuition; subst; 473 | simpl in *; intuition; 474 | repeat find_rewrite; 475 | repeat find_inversion; 476 | simpl in *; 477 | try now rewrite update_nop_ext. 478 | 479 | 480 | Lemma locks_correct_net_handlers : 481 | forall p sigma u st' out ms, 482 | NetHandler (pDst p) (pSrc p) (pBody p) (sigma (pDst p)) = (u, out, st', ms) -> 483 | locks_correct sigma -> 484 | locks_correct_unlock sigma p -> 485 | locks_correct_locked sigma p -> 486 | locks_correct (update name_eq_dec sigma (pDst p) st'). 487 | Proof using. 488 | set_up_net_handlers; break_exists; break_and; 489 | eauto using 490 | locks_correct_update_true, locks_correct_locked_at_head, 491 | all_clients_false_locks_correct_server_update, empty_queue_all_clients_false, 492 | locks_correct_at_head_preserved, snoc_at_head_of_queue_preserved, 493 | all_clients_false_locks_correct_server_update, unlock_in_flight_all_clients_false. 494 | Qed. 495 | 496 | Lemma locks_correct_unlock_sent_lock : 497 | forall sigma p id, 498 | pBody p = Lock id -> 499 | locks_correct_unlock sigma p. 500 | Proof using. 501 | unfold locks_correct_unlock. 502 | intuition. congruence. 503 | Qed. 504 | 505 | Lemma locks_correct_unlock_sent_locked : 506 | forall sigma p id, 507 | pBody p = Locked id -> 508 | locks_correct_unlock sigma p. 509 | Proof using. 510 | unfold locks_correct_unlock. 511 | intuition. congruence. 512 | Qed. 513 | 514 | Lemma locks_correct_unlock_input_handlers_old : 515 | forall h i sigma u st' out ms p, 516 | InputHandler h i (sigma h) = (u, out, st', ms) -> 517 | locks_correct sigma -> 518 | locks_correct_unlock sigma p -> 519 | locks_correct_unlock (update name_eq_dec sigma h st') p. 520 | Proof using. 521 | set_up_input_handlers; break_exists; break_and; subst; try rewrite update_nop_ext; auto. 522 | destruct (pBody p) eqn:?. 523 | - eauto using locks_correct_unlock_sent_lock. 524 | - now erewrite unlock_in_flight_all_clients_false in * by eauto. 525 | - eauto using locks_correct_unlock_sent_locked. 526 | Qed. 527 | 528 | Lemma locked_in_flight_all_clients_false : 529 | forall sigma p id, 530 | pBody p = Locked id -> 531 | locks_correct_locked sigma p -> 532 | locks_correct sigma -> 533 | (forall c, held (sigma (Client c)) = false). 534 | Proof using. 535 | intros. 536 | destruct (held (sigma (Client c))) eqn:?; auto. 537 | find_copy_apply_lem_hyp locks_correct_true_at_head_of_queue; auto. 538 | unfold at_head_of_queue in *. break_exists. 539 | unfold locks_correct_locked in *. 540 | pose proof (H0 id). 541 | concludes. 542 | break_exists. 543 | unfold valid_locked in H3. 544 | break_and. 545 | break_exists. 546 | find_rewrite. 547 | find_injection. 548 | congruence. 549 | Qed. 550 | 551 | Lemma locks_correct_locked_sent_lock : 552 | forall sigma p id, 553 | pBody p = Lock id -> 554 | locks_correct_locked sigma p. 555 | Proof using. 556 | unfold locks_correct_locked. 557 | intuition. congruence. 558 | Qed. 559 | 560 | Lemma locks_correct_locked_sent_unlock : 561 | forall sigma p, 562 | pBody p = Unlock -> 563 | locks_correct_locked sigma p. 564 | Proof using. 565 | unfold locks_correct_locked. 566 | intuition. congruence. 567 | Qed. 568 | 569 | Lemma locks_correct_locked_input_handlers_old : 570 | forall h i sigma u st' out ms p, 571 | InputHandler h i (sigma h) = (u, out, st', ms) -> 572 | locks_correct sigma -> 573 | locks_correct_locked sigma p -> 574 | locks_correct_locked (update name_eq_dec sigma h st') p. 575 | Proof using. 576 | set_up_input_handlers; break_exists; break_and; subst; try rewrite update_nop_ext; auto. 577 | destruct (pBody p) eqn:?. 578 | - eauto using locks_correct_locked_sent_lock. 579 | - eauto using locks_correct_locked_sent_unlock. 580 | - now erewrite locked_in_flight_all_clients_false in * by eauto. 581 | Qed. 582 | 583 | Lemma locks_correct_unlock_true_to_false : 584 | forall sigma p x st', 585 | at_head_of_queue sigma x -> 586 | held st' = false -> 587 | pSrc p = Client x -> 588 | locks_correct_unlock (update name_eq_dec sigma (Client x) st') p. 589 | Proof using. 590 | unfold locks_correct_unlock, valid_unlock. 591 | intros. 592 | exists x. 593 | intuition; now rewrite_update. 594 | Qed. 595 | 596 | Lemma locks_correct_unlock_input_handlers_new : 597 | forall h i sigma u st' out ms p, 598 | InputHandler h i (sigma h) = (u, out, st', ms) -> 599 | locks_correct sigma -> 600 | In (pDst p, pBody p) ms -> 601 | pSrc p = h -> 602 | locks_correct_unlock (update name_eq_dec sigma h st') p. 603 | Proof using. 604 | set_up_input_handlers; break_exists; break_and; subst; try rewrite update_nop_ext; 605 | 606 | eauto using locks_correct_unlock_sent_lock, 607 | locks_correct_unlock_true_to_false, 608 | locks_correct_true_at_head_of_queue. 609 | unfold locks_correct_unlock. 610 | intro. 611 | exists x. 612 | unfold valid_unlock. 613 | split; auto. 614 | simpl in *. 615 | break_or_hyp; intuition. 616 | - find_injection. 617 | congruence. 618 | - find_injection. 619 | congruence. 620 | Qed. 621 | 622 | Lemma locks_correct_locked_input_handlers_new : 623 | forall h i sigma u st' out ms p, 624 | InputHandler h i (sigma h) = (u, out, st', ms) -> 625 | In (pDst p, pBody p) ms -> 626 | locks_correct_locked (update name_eq_dec sigma h st') p. 627 | Proof using. 628 | set_up_input_handlers; break_exists; break_and; subst; try rewrite update_nop_ext; auto. 629 | - simpl in *. 630 | intuition. 631 | find_injection. 632 | congruence. 633 | - eauto using locks_correct_locked_sent_lock, locks_correct_locked_sent_unlock. 634 | Qed. 635 | 636 | Lemma nwnw_locked_lock : 637 | forall p q id, 638 | LockServ_network_network_invariant p q -> 639 | pBody p = Locked id -> 640 | exists id', pBody q = Lock id'. 641 | Proof using. 642 | unfold LockServ_network_network_invariant. 643 | intros. 644 | destruct (pBody q); intuition; try discriminate. 645 | - exists r; auto. 646 | - pose proof (H _ H0). 647 | intuition. 648 | - pose proof (H4 _ r H0). 649 | congruence. 650 | Qed. 651 | 652 | Lemma nwnw_unlock_lock : 653 | forall p q, 654 | LockServ_network_network_invariant p q -> 655 | pBody p = Unlock -> 656 | exists id, pBody q = Lock id. 657 | Proof using. 658 | unfold LockServ_network_network_invariant. 659 | intros. 660 | destruct (pBody q); intuition; try discriminate. 661 | - exists r; auto. 662 | - pose proof (H2 r H0). 663 | congruence. 664 | Qed. 665 | 666 | Lemma locks_correct_unlock_at_head : 667 | forall sigma p c, 668 | pSrc p = Client c -> 669 | pBody p = Unlock -> 670 | locks_correct_unlock sigma p -> 671 | at_head_of_queue sigma c. 672 | Proof using. 673 | unfold locks_correct_unlock. 674 | intros. 675 | find_apply_hyp_hyp. clear H1. 676 | break_exists. 677 | unfold valid_unlock in *. intuition. 678 | break_exists. 679 | repeat find_rewrite. repeat find_inversion. 680 | eauto using at_head_of_queue_intro. 681 | Qed. 682 | 683 | Lemma locks_correct_unlock_at_head_preserved : 684 | forall sigma st' p, 685 | locks_correct_unlock sigma p -> 686 | (forall c, at_head_of_queue sigma c -> at_head_of_queue (update name_eq_dec sigma Server st') c) -> 687 | locks_correct_unlock (update name_eq_dec sigma Server st') p. 688 | Proof using. 689 | unfold locks_correct_unlock, valid_unlock. 690 | intuition. 691 | break_exists. 692 | exists x. 693 | intuition. 694 | firstorder. 695 | Qed. 696 | 697 | Lemma nil_at_head_of_queue_preserved : 698 | forall c sigma sigma', 699 | queue (sigma Server) = [] -> 700 | at_head_of_queue sigma c -> 701 | at_head_of_queue sigma' c. 702 | Proof using. 703 | unfold at_head_of_queue. 704 | firstorder. 705 | congruence. 706 | Qed. 707 | 708 | Lemma locks_correct_unlock_net_handlers_old : 709 | forall p sigma u st' out ms q, 710 | NetHandler (pDst p) (pSrc p) (pBody p) (sigma (pDst p)) = (u, out, st', ms) -> 711 | locks_correct sigma -> 712 | locks_correct_unlock sigma q -> 713 | LockServ_network_network_invariant p q -> 714 | locks_correct_unlock (update name_eq_dec sigma (pDst p) st') q. 715 | Proof using. 716 | set_up_net_handlers; break_exists; break_and; subst; eauto using locks_correct_unlock_sent_lock, nwnw_locked_lock, 717 | locks_correct_unlock_at_head_preserved, snoc_at_head_of_queue_preserved, 718 | nwnw_unlock_lock, nil_at_head_of_queue_preserved. 719 | - unfold locks_correct_unlock in *. 720 | intros. 721 | concludes. 722 | break_exists. 723 | pose proof (nwnw_locked_lock H2 H). 724 | break_exists. 725 | congruence. 726 | - unfold locks_correct_unlock in *. 727 | intros. 728 | concludes. 729 | break_exists. 730 | pose proof (nwnw_unlock_lock H2 H). 731 | break_exists. 732 | congruence. 733 | - unfold locks_correct_unlock in *. 734 | intros. 735 | concludes. 736 | break_exists. 737 | pose proof (nwnw_unlock_lock H2 H). 738 | break_exists. 739 | congruence. 740 | Qed. 741 | 742 | Lemma locks_correct_locked_at_head_preserved : 743 | forall sigma st' p, 744 | locks_correct_locked sigma p -> 745 | (forall c, at_head_of_queue sigma c -> at_head_of_queue (update name_eq_dec sigma Server st') c) -> 746 | locks_correct_locked (update name_eq_dec sigma Server st') p. 747 | Proof using. 748 | unfold locks_correct_locked, valid_locked. 749 | intuition. 750 | pose proof (H id H1). 751 | break_exists. 752 | break_and. 753 | break_exists. 754 | exists x. 755 | intuition. 756 | firstorder. 757 | Qed. 758 | 759 | Lemma locks_correct_locked_net_handlers_old : 760 | forall p sigma u st' out ms q, 761 | NetHandler (pDst p) (pSrc p) (pBody p) (sigma (pDst p)) = (u, out, st', ms) -> 762 | locks_correct sigma -> 763 | locks_correct_locked sigma q -> 764 | LockServ_network_network_invariant p q -> 765 | locks_correct_locked (update name_eq_dec sigma (pDst p) st') q. 766 | Proof using. 767 | set_up_net_handlers; break_exists; break_and; subst; 768 | eauto using locks_correct_locked_sent_lock, nwnw_locked_lock, 769 | locks_correct_locked_at_head_preserved, snoc_at_head_of_queue_preserved, 770 | nwnw_unlock_lock, nil_at_head_of_queue_preserved. 771 | - unfold locks_correct_locked in *. 772 | intros. 773 | pose proof (H1 _ H3). 774 | break_exists. 775 | pose proof (nwnw_locked_lock H2 H). 776 | break_exists. 777 | congruence. 778 | - unfold locks_correct_locked in *. 779 | intros. 780 | pose proof (H1 id H3). 781 | break_exists. 782 | pose proof (nwnw_unlock_lock H2 H). 783 | break_exists. 784 | congruence. 785 | - unfold locks_correct_locked in *. 786 | intros. 787 | pose proof (H1 id H3). 788 | break_exists. 789 | pose proof (nwnw_unlock_lock H2 H). 790 | break_exists. 791 | congruence. 792 | Qed. 793 | 794 | Lemma locks_correct_unlock_net_handlers_new : 795 | forall p sigma u st' out ms q, 796 | NetHandler (pDst p) (pSrc p) (pBody p) (sigma (pDst p)) = (u, out, st', ms) -> 797 | locks_correct sigma -> 798 | In (pDst q, pBody q) ms -> 799 | locks_correct_unlock (update name_eq_dec sigma (pDst p) st') q. 800 | Proof using. 801 | set_up_net_handlers; break_exists; break_and; subst; intuition; break_exists; break_and; subst; simpl in *; intuition; try find_injection; try congruence. 802 | Qed. 803 | 804 | Lemma locks_correct_locked_intro : 805 | forall sigma p c id t st', 806 | pDst p = Client c -> 807 | held (sigma (Client c)) = false -> 808 | queue st' = (c, id) :: t -> 809 | locks_correct_locked (update name_eq_dec sigma Server st') p. 810 | Proof using. 811 | unfold locks_correct_locked, valid_locked. 812 | intros. 813 | exists c. 814 | intuition. 815 | exists id, t. now rewrite_update. 816 | Qed. 817 | 818 | Lemma locks_correct_locked_net_handlers_new : 819 | forall p sigma u st' out ms q, 820 | NetHandler (pDst p) (pSrc p) (pBody p) (sigma (pDst p)) = (u, out, st', ms) -> 821 | locks_correct sigma -> 822 | locks_correct_unlock sigma p -> 823 | In (pDst q, pBody q) ms -> 824 | locks_correct_locked (update name_eq_dec sigma (pDst p) st') q. 825 | Proof using. 826 | set_up_net_handlers; break_exists; break_and; intuition; break_exists; break_and; subst; simpl in *; intuition; try find_injection; try congruence. 827 | - eapply locks_correct_locked_intro; eauto. 828 | eauto using locks_correct_locked_intro, 829 | empty_queue_all_clients_false, 830 | unlock_in_flight_all_clients_false. 831 | rewrite H3. 832 | rewrite H5. 833 | simpl. 834 | eauto. 835 | - eapply locks_correct_locked_intro; eauto. 836 | eauto using locks_correct_locked_intro, 837 | empty_queue_all_clients_false, 838 | unlock_in_flight_all_clients_false. 839 | Qed. 840 | 841 | Lemma nwnw_lock : 842 | forall p p' id, 843 | pBody p = Lock id -> 844 | LockServ_network_network_invariant p p'. 845 | Proof using. 846 | unfold LockServ_network_network_invariant. 847 | intuition; simpl in *; congruence. 848 | Qed. 849 | 850 | Lemma LockServ_nwnw_input_handlers_old_new : 851 | forall h i sigma u st' out ms p p', 852 | InputHandler h i (sigma h) = (u, out, st', ms) -> 853 | locks_correct sigma -> 854 | LockServ_network_invariant sigma p -> 855 | In (pDst p', pBody p') ms -> 856 | pSrc p' = h -> 857 | LockServ_network_network_invariant p p'. 858 | Proof using. 859 | unfold LockServ_network_invariant. 860 | set_up_input_handlers. 861 | - break_exists; break_and; subst. 862 | simpl in *. 863 | intuition. 864 | find_injection. 865 | eauto using nwnw_sym, nwnw_lock. 866 | - destruct (pBody p) eqn:?. 867 | + eauto using nwnw_lock. 868 | + now erewrite unlock_in_flight_all_clients_false in * by eauto. 869 | + now erewrite locked_in_flight_all_clients_false in * by eauto. 870 | Qed. 871 | 872 | Lemma LockServ_nwnw_input_handlers_new_new : 873 | forall h i sigma u st' out ms, 874 | InputHandler h i (sigma h) = (u, out, st', ms) -> 875 | distinct_pairs_and LockServ_network_network_invariant 876 | (map (fun m => mkPacket h (fst m) (snd m)) ms). 877 | Proof using. 878 | set_up_input_handlers; break_exists; break_and; subst; simpl; split; intuition. 879 | Qed. 880 | 881 | Lemma nw_empty_queue_lock : 882 | forall sigma p, 883 | LockServ_network_invariant sigma p -> 884 | queue (sigma Server) = [] -> 885 | exists i, pBody p = Lock i. 886 | Proof using. 887 | unfold LockServ_network_invariant, 888 | locks_correct_unlock, locks_correct_locked, 889 | valid_unlock, valid_locked. 890 | intuition. 891 | destruct (pBody p) eqn:?; intuition; break_exists; intuition; break_exists; 892 | try congruence. 893 | - exists r; auto. 894 | - pose proof (H2 r (eq_refl _)). 895 | break_exists; break_and; break_exists. 896 | congruence. 897 | Qed. 898 | 899 | Lemma LockServ_nwnw_net_handlers_old_new : 900 | forall p sigma u st' out ms q p', 901 | NetHandler (pDst p) (pSrc p) (pBody p) (sigma (pDst p)) = (u, out, st', ms) -> 902 | locks_correct sigma -> 903 | LockServ_network_invariant sigma p -> 904 | LockServ_network_invariant sigma q -> 905 | LockServ_network_network_invariant p q -> 906 | In (pDst p', pBody p') ms -> 907 | LockServ_network_network_invariant p' q. 908 | Proof using. 909 | set_up_net_handlers; break_exists; break_and; subst; intuition; break_exists; break_and; subst; simpl in *; intuition; try find_injection. 910 | - pose proof (nw_empty_queue_lock H2 H7). 911 | break_exists. 912 | pose proof (nwnw_lock _ p' H9). 913 | apply nwnw_sym. 914 | assumption. 915 | - pose proof (nwnw_unlock_lock H3 H). 916 | break_exists. 917 | pose proof (nwnw_lock _ p' H4). 918 | apply nwnw_sym. 919 | assumption. 920 | Qed. 921 | 922 | Lemma LockServ_nwnw_net_handlers_new_new : 923 | forall p sigma u st' out ms, 924 | NetHandler (pDst p) (pSrc p) (pBody p) (sigma (pDst p)) = (u, out, st', ms) -> 925 | locks_correct sigma -> 926 | LockServ_network_invariant sigma p -> 927 | distinct_pairs_and LockServ_network_network_invariant 928 | (map (fun m => mkPacket (pDst p) (fst m) (snd m)) ms). 929 | Proof using. 930 | set_up_net_handlers; break_exists; break_and; intuition; break_exists; break_and; subst; simpl; intuition. 931 | Qed. 932 | 933 | Instance LockServ_Decompositition : Decomposition _ LockServ_MultiParams. 934 | apply Build_Decomposition with (state_invariant := locks_correct) 935 | (network_invariant := LockServ_network_invariant) 936 | (network_network_invariant := LockServ_network_network_invariant); 937 | simpl; intros; monad_unfold; repeat break_let; repeat find_inversion. 938 | - auto using nwnw_sym. 939 | - auto using locks_correct_init. 940 | - eauto using locks_correct_input_handlers. 941 | - unfold LockServ_network_invariant in *. intuition. 942 | eauto using locks_correct_net_handlers. 943 | - unfold LockServ_network_invariant in *. 944 | intuition eauto using locks_correct_unlock_input_handlers_old, 945 | locks_correct_locked_input_handlers_old. 946 | - unfold LockServ_network_invariant in *. 947 | intuition eauto using locks_correct_unlock_input_handlers_new, 948 | locks_correct_locked_input_handlers_new. 949 | - unfold LockServ_network_invariant in *. 950 | intuition eauto using locks_correct_unlock_net_handlers_old, 951 | locks_correct_locked_net_handlers_old. 952 | - unfold LockServ_network_invariant in *. 953 | intuition eauto using locks_correct_unlock_net_handlers_new, 954 | locks_correct_locked_net_handlers_new. 955 | - eauto using LockServ_nwnw_input_handlers_old_new. 956 | - eauto using LockServ_nwnw_input_handlers_new_new. 957 | - eauto using LockServ_nwnw_net_handlers_old_new. 958 | - eauto using LockServ_nwnw_net_handlers_new_new. 959 | Defined. 960 | 961 | Theorem true_in_reachable_mutual_exclusion : 962 | true_in_reachable step_async step_async_init (fun net => mutual_exclusion (nwState net)). 963 | Proof using. 964 | pose proof decomposition_invariant. 965 | find_apply_lem_hyp inductive_invariant_true_in_reachable. 966 | unfold true_in_reachable in *. 967 | intros. 968 | apply locks_correct_implies_mutex. 969 | match goal with 970 | | [ H : _ |- _ ] => apply H 971 | end. 972 | auto. 973 | Qed. 974 | 975 | Fixpoint last_holder' (holder : option Client_index) (trace : list (name * (input + list output))) : option Client_index := 976 | match trace with 977 | | [] => holder 978 | | (Client n, inl Unlock) :: tr => match holder with 979 | | None => last_holder' holder tr 980 | | Some m => if fin_eq_dec _ n m 981 | then last_holder' None tr 982 | else last_holder' holder tr 983 | end 984 | 985 | | (Client n, inr [Locked id]) :: tr => last_holder' (Some n) tr 986 | | (n, _) :: tr => last_holder' holder tr 987 | end. 988 | 989 | Fixpoint trace_mutual_exclusion' (holder : option Client_index) (trace : list (name * (input + list output))) : Prop := 990 | match trace with 991 | | [] => True 992 | | (Client n, (inl Unlock)) :: tr' => match holder with 993 | | Some m => if fin_eq_dec _ n m 994 | then trace_mutual_exclusion' None tr' 995 | else trace_mutual_exclusion' holder tr' 996 | | _ => trace_mutual_exclusion' holder tr' 997 | end 998 | | (n, (inl _)) :: tr' => trace_mutual_exclusion' holder tr' 999 | | (Client n, (inr [Locked id])) :: tr' => match holder with 1000 | | None => trace_mutual_exclusion' (Some n) tr' 1001 | | Some _ => False 1002 | end 1003 | | (_, (inr [])) :: tr' => trace_mutual_exclusion' holder tr' 1004 | | (_, (inr _)) :: tr' => False 1005 | end. 1006 | 1007 | Definition trace_mutual_exclusion (trace : list (name * (input + list output))) : Prop := 1008 | trace_mutual_exclusion' None trace. 1009 | 1010 | Definition last_holder (trace : list (name * (input + list output))) : option Client_index := 1011 | last_holder' None trace. 1012 | 1013 | Lemma cross_relation : 1014 | forall (P : network -> list (name * (input + list output)) -> Prop), 1015 | P step_async_init [] -> 1016 | (forall st st' tr ev, 1017 | step_async_star step_async_init st tr -> 1018 | P st tr -> 1019 | step_async st st' ev -> 1020 | P st' (tr ++ ev)) -> 1021 | forall st tr, 1022 | step_async_star step_async_init st tr -> 1023 | P st tr. 1024 | Proof using. 1025 | intros. 1026 | find_apply_lem_hyp refl_trans_1n_n1_trace. 1027 | prep_induction H1. 1028 | induction H1; intros; subst; eauto. 1029 | eapply H3; eauto. 1030 | - apply refl_trans_n1_1n_trace. auto. 1031 | - apply IHrefl_trans_n1_trace; auto. 1032 | Qed. 1033 | 1034 | Lemma trace_mutex'_no_out_extend : 1035 | forall tr n h, 1036 | trace_mutual_exclusion' h tr -> 1037 | trace_mutual_exclusion' h (tr ++ [(n, inr [])]). 1038 | Proof using. 1039 | induction tr; intuition; unfold trace_mutual_exclusion in *; simpl in *; 1040 | repeat break_match; subst; intuition. 1041 | Qed. 1042 | 1043 | Lemma last_holder'_no_out_inv : 1044 | forall tr h c n, 1045 | last_holder' h (tr ++ [(c, inr [])]) = Some n -> 1046 | last_holder' h tr = Some n. 1047 | Proof using. 1048 | induction tr; intros; simpl in *; repeat break_match; subst; intuition; eauto. 1049 | Qed. 1050 | 1051 | Lemma last_holder'_no_out_extend : 1052 | forall tr h c n, 1053 | last_holder' h tr = Some n -> 1054 | last_holder' h (tr ++ [(c, inr [])]) = Some n. 1055 | Proof using. 1056 | induction tr; intros; simpl in *; repeat break_match; subst; intuition. 1057 | Qed. 1058 | 1059 | Lemma decomposition_reachable_nw_invariant : 1060 | forall st tr p, 1061 | step_async_star step_async_init st tr -> 1062 | In p (nwPackets st) -> 1063 | network_invariant (nwState st) p. 1064 | Proof using. 1065 | pose proof decomposition_invariant. 1066 | find_apply_lem_hyp inductive_invariant_true_in_reachable. 1067 | unfold true_in_reachable, reachable in *. 1068 | intuition. 1069 | unfold composed_invariant in *. 1070 | apply H; eauto. 1071 | Qed. 1072 | 1073 | Lemma trace_mutex'_locked_extend : 1074 | forall tr h n id, 1075 | trace_mutual_exclusion' h tr -> 1076 | last_holder' h tr = None -> 1077 | trace_mutual_exclusion' h (tr ++ [(Client n, inr [Locked id])]). 1078 | Proof using. 1079 | induction tr; intros; simpl in *. 1080 | - subst; auto. 1081 | - simpl in *; repeat break_match; subst; intuition. 1082 | Qed. 1083 | 1084 | Lemma reachable_intro : 1085 | forall a tr, 1086 | step_async_star step_async_init a tr -> 1087 | reachable step_async step_async_init a. 1088 | Proof using. 1089 | unfold reachable. 1090 | intros. eauto. 1091 | Qed. 1092 | 1093 | Lemma locks_correct_locked_invariant : 1094 | forall st p, 1095 | reachable step_async step_async_init st -> 1096 | In p (nwPackets st) -> 1097 | locks_correct_locked (nwState st) p. 1098 | Proof using. 1099 | intros. 1100 | pose proof decomposition_invariant. 1101 | find_apply_lem_hyp inductive_invariant_true_in_reachable. 1102 | unfold true_in_reachable in *. apply H1; auto. 1103 | Qed. 1104 | 1105 | Lemma locks_correct_invariant : 1106 | forall st, 1107 | reachable step_async step_async_init st -> 1108 | locks_correct (nwState st). 1109 | Proof using. 1110 | intros. 1111 | pose proof decomposition_invariant. 1112 | find_apply_lem_hyp inductive_invariant_true_in_reachable. 1113 | unfold true_in_reachable in *. apply H0; auto. 1114 | Qed. 1115 | 1116 | Lemma mutual_exclusion_invariant : 1117 | forall st, 1118 | reachable step_async step_async_init st -> 1119 | mutual_exclusion (nwState st). 1120 | Proof using. 1121 | intros. 1122 | apply locks_correct_implies_mutex. 1123 | auto using locks_correct_invariant. 1124 | Qed. 1125 | 1126 | Lemma last_holder'_locked_some_eq : 1127 | forall tr h c n id, 1128 | last_holder' h (tr ++ [(Client c, inr [Locked id])]) = Some n -> 1129 | c = n. 1130 | Proof using. 1131 | induction tr; intros; simpl in *; repeat break_match; subst; eauto. 1132 | congruence. 1133 | Qed. 1134 | 1135 | Ltac my_update_destruct := 1136 | match goal with 1137 | | [H : context [ update _ _ ?x _ ?y ] |- _ ] => destruct (Name_eq_dec x y) 1138 | | [ |- context [ update _ _ ?x _ ?y ] ] => destruct (Name_eq_dec x y) 1139 | end. 1140 | 1141 | Lemma last_holder'_server_extend : 1142 | forall tr h i, 1143 | last_holder' h (tr ++ [(Server, inl i)]) = last_holder' h tr. 1144 | Proof using. 1145 | induction tr; intros; simpl in *; repeat break_match; auto. 1146 | Qed. 1147 | 1148 | Lemma last_holder'_locked_extend : 1149 | forall tr h n id, 1150 | last_holder' h (tr ++ [(Client n, inr [Locked id])]) = Some n. 1151 | Proof using. 1152 | induction tr; intros; simpl in *; repeat break_match; auto. 1153 | Qed. 1154 | 1155 | Lemma trace_mutual_exclusion'_extend_input : 1156 | forall tr h c i, 1157 | i <> Unlock -> 1158 | trace_mutual_exclusion' h tr -> 1159 | trace_mutual_exclusion' h (tr ++ [(Client c, inl i)]). 1160 | Proof using. 1161 | induction tr; intros; simpl in *; repeat break_match; intuition. 1162 | Qed. 1163 | 1164 | Lemma trace_mutual_exclusion'_extend_input_server : 1165 | forall tr h i, 1166 | trace_mutual_exclusion' h tr -> 1167 | trace_mutual_exclusion' h (tr ++ [(Server, inl i)]). 1168 | Proof using. 1169 | induction tr; intros; simpl in *; repeat break_match; intuition. 1170 | Qed. 1171 | 1172 | Lemma last_holder'_input_inv : 1173 | forall tr h c i n, 1174 | i <> Unlock -> 1175 | last_holder' h (tr ++ [(Client c, inl i)]) = Some n -> 1176 | last_holder' h tr = Some n. 1177 | Proof using. 1178 | induction tr; intros; simpl in *; repeat break_match; auto; try congruence; subst; eauto. 1179 | Qed. 1180 | 1181 | Lemma last_holder'_input_inv_server : 1182 | forall tr h i n, 1183 | last_holder' h (tr ++ [(Server, inl i)]) = Some n -> 1184 | last_holder' h tr = Some n. 1185 | Proof using. 1186 | induction tr; intros; simpl in *; repeat break_match; auto; try congruence; subst; eauto. 1187 | Qed. 1188 | 1189 | Lemma last_holder'_input_extend : 1190 | forall tr h c i n, 1191 | i <> Unlock -> 1192 | last_holder' h tr = Some n -> 1193 | last_holder' h (tr ++ [(Client c, inl i)]) = Some n. 1194 | Proof using. 1195 | induction tr; intros; simpl in *; repeat break_match; auto. 1196 | congruence. 1197 | Qed. 1198 | 1199 | Lemma trace_mutex'_unlock_extend : 1200 | forall tr h c, 1201 | trace_mutual_exclusion' h tr -> 1202 | trace_mutual_exclusion' h (tr ++ [(Client c, inl Unlock)]). 1203 | Proof using. 1204 | induction tr; intros; simpl in *; repeat break_match; intuition (auto; try congruence). 1205 | Qed. 1206 | 1207 | Lemma last_holder'_unlock_none : 1208 | forall tr h c, 1209 | last_holder' h tr = Some c -> 1210 | last_holder' h (tr ++ [(Client c, inl Unlock)]) = None. 1211 | Proof using. 1212 | induction tr; intros; simpl in *; repeat break_match; intuition. 1213 | congruence. 1214 | Qed. 1215 | 1216 | Lemma last_holder_unlock_none : 1217 | forall tr c, 1218 | last_holder tr = Some c -> 1219 | last_holder (tr ++ [(Client c, inl Unlock)]) = None. 1220 | Proof using. 1221 | intros. 1222 | apply last_holder'_unlock_none. auto. 1223 | Qed. 1224 | 1225 | Lemma last_holder_some_unlock_inv : 1226 | forall tr h c n, 1227 | last_holder' h (tr ++ [(Client c, inl Unlock)]) = Some n -> 1228 | last_holder' h tr = Some n. 1229 | Proof using. 1230 | induction tr; intros; simpl in *; repeat break_match; subst; 1231 | intuition; try congruence; eauto. 1232 | Qed. 1233 | 1234 | Lemma last_holder'_neq_unlock_extend : 1235 | forall tr h n c, 1236 | last_holder' h tr = Some n -> 1237 | n <> c -> 1238 | last_holder' h (tr ++ [(Client c, inl Unlock)]) = Some n. 1239 | Proof using. 1240 | induction tr; intros; simpl in *; repeat break_match; subst; try congruence; intuition. 1241 | Qed. 1242 | 1243 | Lemma LockServ_mutual_exclusion_trace : 1244 | forall st tr, 1245 | step_async_star step_async_init st tr -> 1246 | trace_mutual_exclusion tr /\ 1247 | (forall n, last_holder tr = Some n -> held (nwState st (Client n)) = true) /\ 1248 | (forall n, held (nwState st (Client n)) = true -> last_holder tr = Some n). 1249 | Proof using. 1250 | apply cross_relation; intros. 1251 | - intuition. 1252 | + red. red. auto. 1253 | + unfold last_holder in *. simpl in *. discriminate. 1254 | + unfold last_holder in *. simpl in *. discriminate. 1255 | - match goal with 1256 | | [ H : step_async _ _ _ |- _ ] => invcs H 1257 | end; monad_unfold; repeat break_let; repeat find_inversion. 1258 | + unfold NetHandler in *. break_match. 1259 | * find_apply_lem_hyp ClientNetHandler_cases. 1260 | break_and. 1261 | { break_or_hyp. 1262 | - intuition; subst. 1263 | + apply trace_mutex'_no_out_extend; auto. 1264 | + rewrite update_nop_ext. 1265 | find_apply_lem_hyp last_holder'_no_out_inv. 1266 | auto. 1267 | + match goal with 1268 | | [ H : _ |- _ ] => rewrite update_nop in H 1269 | end. 1270 | find_apply_hyp_hyp. 1271 | apply last_holder'_no_out_extend. auto. 1272 | - intuition; subst; break_exists; break_and; subst. 1273 | + apply trace_mutex'_locked_extend. auto. 1274 | destruct (last_holder' None tr) eqn:?; auto. 1275 | find_apply_hyp_hyp. 1276 | erewrite locked_in_flight_all_clients_false in * by 1277 | eauto using locks_correct_locked_invariant, reachable_intro, 1278 | locks_correct_invariant. 1279 | discriminate. 1280 | + my_update_destruct; try find_inversion; rewrite_update; auto. 1281 | find_apply_lem_hyp last_holder'_locked_some_eq. congruence. 1282 | + my_update_destruct; try find_inversion; rewrite_update. 1283 | * apply last_holder'_locked_extend. 1284 | * erewrite locked_in_flight_all_clients_false in * by 1285 | eauto using locks_correct_locked_invariant, reachable_intro, 1286 | locks_correct_invariant. 1287 | discriminate. 1288 | } 1289 | * { find_apply_lem_hyp ServerNetHandler_cases. break_and. subst. 1290 | repeat split. 1291 | - apply trace_mutex'_no_out_extend. auto. 1292 | - intros. my_update_destruct; try discriminate. 1293 | rewrite_update. 1294 | find_apply_lem_hyp last_holder'_no_out_inv. 1295 | auto. 1296 | - intros. my_update_destruct; try discriminate; rewrite_update. 1297 | apply last_holder'_no_out_extend. auto. 1298 | } 1299 | + unfold InputHandler in *. break_match. 1300 | * unfold ClientIOHandler in *. 1301 | { monad_unfold. 1302 | repeat break_match; repeat find_inversion; intuition; 1303 | repeat rewrite snoc_assoc in *; 1304 | try apply trace_mutex'_no_out_extend; 1305 | try find_apply_lem_hyp last_holder'_no_out_inv; 1306 | try (apply last_holder'_no_out_extend; auto). 1307 | - apply trace_mutual_exclusion'_extend_input; auto. congruence. 1308 | - rewrite update_nop_ext. 1309 | find_apply_lem_hyp last_holder'_input_inv; try congruence. 1310 | auto. 1311 | - match goal with 1312 | | [ H : _ |- _ ] => rewrite update_nop in H 1313 | end. 1314 | apply last_holder'_input_extend; auto. congruence. 1315 | - apply trace_mutex'_unlock_extend; auto. 1316 | - rewrite last_holder_unlock_none in *; auto. discriminate. 1317 | - my_update_destruct; try find_inversion; rewrite_update. 1318 | + discriminate. 1319 | + assert (mutual_exclusion (nwState st)) 1320 | by eauto using mutual_exclusion_invariant, reachable_intro. 1321 | unfold mutual_exclusion in *. 1322 | assert (c = n) by eauto. congruence. 1323 | - apply trace_mutex'_unlock_extend. auto. 1324 | - rewrite update_nop. 1325 | find_apply_lem_hyp last_holder_some_unlock_inv. 1326 | auto. 1327 | - match goal with 1328 | | [ H : _ |- _ ] => rewrite update_nop in H 1329 | end. 1330 | assert (n <> c) by congruence. 1331 | find_apply_hyp_hyp. 1332 | apply last_holder'_neq_unlock_extend; auto. 1333 | - apply trace_mutual_exclusion'_extend_input; auto. congruence. 1334 | - rewrite update_nop_ext. find_apply_lem_hyp last_holder'_input_inv; try congruence. 1335 | auto. 1336 | - match goal with 1337 | | [ H : _ |- _ ] => rewrite update_nop in H 1338 | end. 1339 | apply last_holder'_input_extend; auto. congruence. 1340 | } 1341 | * unfold ServerIOHandler in *. 1342 | monad_unfold. find_inversion. 1343 | { intuition; 1344 | repeat rewrite snoc_assoc in *. 1345 | - apply trace_mutex'_no_out_extend. 1346 | apply trace_mutual_exclusion'_extend_input_server. auto. 1347 | - find_apply_lem_hyp last_holder'_no_out_inv. 1348 | rewrite update_nop. find_apply_lem_hyp last_holder'_input_inv_server. auto. 1349 | - apply last_holder'_no_out_extend; auto. 1350 | rewrite_update. unfold last_holder. rewrite last_holder'_server_extend. 1351 | auto. 1352 | } 1353 | Qed. 1354 | End LockServ. 1355 | -------------------------------------------------------------------------------- /systems/LockServSeqNum.v: -------------------------------------------------------------------------------- 1 | Require Import Verdi.Verdi. 2 | 3 | Require Import LockServ. 4 | Require Verdi.SeqNum. 5 | Require Import Verdi.SeqNumCorrect. 6 | 7 | Section LockServSeqNum. 8 | Variable num_Clients : nat. 9 | 10 | Instance transformed_base_params : BaseParams := 11 | @SeqNum.base_params (LockServ_BaseParams num_Clients) (LockServ_MultiParams num_Clients). 12 | 13 | Instance transformed_multi_params : MultiParams _ := 14 | @SeqNum.multi_params (LockServ_BaseParams num_Clients) (LockServ_MultiParams num_Clients). 15 | 16 | Theorem transformed_correctness : 17 | forall net tr, 18 | step_dup_star step_async_init net tr -> 19 | @mutual_exclusion num_Clients (nwState (revertNetwork net)). 20 | Proof using. 21 | intros. 22 | pose proof @true_in_reachable_transform _ (LockServ_MultiParams num_Clients) 23 | (fun net : network => mutual_exclusion (nwState net)) 24 | (@true_in_reachable_mutual_exclusion num_Clients). 25 | unfold true_in_reachable in *. 26 | apply H0. 27 | unfold reachable. 28 | eauto. 29 | Qed. 30 | End LockServSeqNum. 31 | -------------------------------------------------------------------------------- /systems/LockServSerialized.v: -------------------------------------------------------------------------------- 1 | Require Import Verdi.Verdi. 2 | 3 | Require Import Cheerios.Cheerios. 4 | Require Import Verdi.SerializedMsgParams. 5 | Require Import Verdi.SerializedMsgParamsCorrect. 6 | 7 | Require Import LockServ. 8 | 9 | Import DeserializerNotations. 10 | 11 | Definition Msg_serialize (m : Msg) : IOStreamWriter.t := 12 | match m with 13 | | Lock i => serialize x00 +$+ serialize i 14 | | Unlock => serialize x01 15 | | Locked i => serialize x02 +$+ serialize i 16 | end. 17 | 18 | Definition Msg_deserialize : ByteListReader.t Msg := 19 | tag <- deserialize ;; 20 | match tag with 21 | | x00 => Lock <$> deserialize 22 | | x01 => ByteListReader.ret Unlock 23 | | x02 => Locked <$> deserialize 24 | | _ => ByteListReader.error 25 | end. 26 | 27 | Lemma Msg_serialize_deserialize_id : 28 | serialize_deserialize_id_spec Msg_serialize Msg_deserialize. 29 | Proof. 30 | intros. 31 | unfold Msg_serialize, Msg_deserialize. 32 | destruct a; 33 | repeat (cheerios_crush; simpl); 34 | rewrite nat_serialize_deserialize_id; reflexivity. 35 | Qed. 36 | 37 | Instance Msg_Serializer : Serializer Msg := 38 | {| serialize := Msg_serialize; 39 | deserialize := Msg_deserialize; 40 | serialize_deserialize_id := Msg_serialize_deserialize_id 41 | |}. 42 | 43 | Section Serialized. 44 | Variable num_Clients : nat. 45 | 46 | Definition orig_base_params := LockServ_BaseParams num_Clients. 47 | Definition orig_multi_params := LockServ_MultiParams num_Clients. 48 | 49 | Instance transformed_base_params : BaseParams := 50 | @serialized_base_params orig_base_params. 51 | 52 | Instance transformed_multi_params : MultiParams _ := 53 | @serialized_multi_params orig_base_params orig_multi_params Msg_Serializer. 54 | 55 | Theorem transformed_correctness : 56 | forall net tr, 57 | step_async_star step_async_init net tr -> 58 | @mutual_exclusion num_Clients (nwState (deserialize_net net)). 59 | Proof using. 60 | intros. 61 | apply step_async_deserialized_simulation_star in H. 62 | break_exists. 63 | break_and. 64 | apply (@true_in_reachable_mutual_exclusion num_Clients). 65 | exists x; apply H. 66 | Qed. 67 | End Serialized. 68 | -------------------------------------------------------------------------------- /verdi-lockserv.opam: -------------------------------------------------------------------------------- 1 | opam-version: "1.2" 2 | version: "dev" 3 | maintainer: "palmskog@gmail.com" 4 | 5 | homepage: "https://github.com/DistributedComponents/verdi-lockserv" 6 | dev-repo: "https://github.com/DistributedComponents/verdi-lockserv.git" 7 | bug-reports: "https://github.com/DistributedComponents/verdi-lockserv/issues" 8 | license: "BSD" 9 | 10 | build: [ 11 | [ "./configure" ] 12 | [ make "-j%{jobs}%" ] 13 | ] 14 | depends: [ 15 | "coq" {((>= "8.6.1" & < "8.7~") | (>= "8.7" & < "8.8~"))} 16 | "verdi" {= "dev"} 17 | "StructTact" {= "dev"} 18 | "cheerios" {= "dev"} 19 | ] 20 | 21 | authors: [ 22 | "James Wilcox <>" 23 | "Doug Woos <>" 24 | "Pavel Panchekha <>" 25 | "Zachary Tatlock <>" 26 | "Steve Anton <>" 27 | "Karl Palmskog <>" 28 | "Ryan Doenges <>" 29 | ] 30 | --------------------------------------------------------------------------------