├── Makefile ├── README.md ├── erlang.mk ├── rel ├── sys.config └── vm.args ├── relx.config ├── scripts ├── damocles_external ├── start.sh └── stop.sh └── src ├── damocles.app.src ├── damocles.erl ├── damocles_app.erl ├── damocles_lib.erl ├── damocles_server.erl └── damocles_sup.erl /Makefile: -------------------------------------------------------------------------------- 1 | PROJECT = damocles 2 | include erlang.mk 3 | DIALYZER_OPTS = -Wunmatched_returns -Werror_handling -Wrace_conditions -Wunderspecs -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Damocles 2 | 3 | Damocles is an Erlang library intended to make writing and running distributed application tests easier. In this first release, it does this by creating local interfaces on a single machine and controlling the flow of packets between those interfaces, allowing it to run an entire distributed system on any Linux (currently) machine without affecting other apps/traffic/etc (albeit with caps on the load it can handle). By doing so it allows for distributed tests to be run easily in a continuous integration environment, without the need to spin up or allocate separate VMs for each application instance. 4 | 5 | ## Requirements 6 | Damocles requires: 7 | - Running on a Linux (developed on Mint 17) that: 8 | - uses 'ip' if available, else 'ifconfig' to add/remove interfaces, and 'lo' is the local interface 9 | - has tc and netem. 10 | - has make 11 | - has sudo permissions for running the above for whatever user you run Damocles as. 12 | 13 | - Erlang installed and on your path (tested on R17; but no use of R17 features means it can likely run on earlier versions with minimal tweaking. Specs do rely on some R17 stuff). 14 | 15 | ## Installation 16 | If using Damocles from an Erlang application, you can just add it to your test dependencies. 17 | 18 | For those wishing to treat Damocles as a command line utility, you'll need to build the code and run it as a release. 19 | 20 | Get the code 21 | ```sh 22 | git clone https://github.com/lostcolony/damocles [location] 23 | ``` 24 | 25 | Build the code 26 | ```sh 27 | cd [location] 28 | make 29 | ``` 30 | 31 | ## Usage 32 | 33 | ##### Starting Damocles 34 | From Erlang, you can start Damocles as an application, or call damocles:start() or damocles:start_link() as appropriate. 35 | 36 | For those wishing to use Damocles as a command line app, execute 37 | ``` 38 | [location]/scripts/start.sh 39 | ``` 40 | Note that this executes ifconfig and tc commands with sudo; you may need to run it with sudo if it fails. 41 | 42 | ##### Using Damocles 43 | From Erlang, all commands exist in damocles.erl. A listing is below with examples 44 | 45 | From the command line, you can execute any function using scripts/damocles_external, where the first argument is the function from damocles.erl you want to execute, and successive parameters are the arguments you wish to pass in. Lists can be expressed as comma separated strings (see examples). 46 | ``` 47 | [location]/scripts/damocles_external add_interface "10.10.10.10" 48 | ``` 49 | 50 | ###### MISC: Things to keep in mind 51 | - Rules may only be applied between IPs that have been added/registered with Damocles. 52 | - Both drop and delay rules may be applied separately and will persist until you have restored the node connection. 53 | - Setting a new drop value to a connection will overwrite an existing drop value; same with delay overwriting an existing value. 54 | - All functions that make changes return one of two things. Either ok, 'error' (which depending on the function called may mean nothing occurred, or, if it was a function that affected multiple connections, it means all the connections you referenced in the call have been reset), or they may throw. If an exception is thrown from within Damocles (as opposed to the RPC interface), and the process has restarted (if started as a command line application the supervisor is used), all interfaces and such we knew about have been torn down so that we're in a 'known' state; you will need to recreate/reregister them. Call get_known_ips to check and see if this has occurred, in the event of getting something other than ok or error. 55 | - Things can go wrong! 56 | - First, since this requires sudo, you may have to get permissions set up properly. 57 | - If you execute Damocles with sudo (easiest thing for the command line), some log folders get created, which get in the way of running make again. If you need to run make again, sudo rm -rf _rel should set you right. 58 | - Since there is implicit OS state, and I'm not clearing interfaces on startup (and clearing traffic control only on initial startup, not on supervisor restoarts), relying instead on a clean shutdown, it may be you end up with interfaces or traffic control settings left behind if a run ends abruptly (kill -9 or machine restart or something). damocles_lib:teardown* functions are callable for the Erlang users; the command line users can run sudo erl -pa ebin from the Damocles folder to start up the Erlang shell, and from there run the teardown commands. 59 | 60 | ##### Stopping 61 | From Erlang, stop the application if it was started that way, or call damocles:stop(). 62 | 63 | From the command line, execute the stop script 64 | ``` 65 | [location]/scripts/stop.sh 66 | ``` 67 | 68 | ## Examples 69 | ##### Creating new local adapters 70 | Use an IP from a reserved range for internal network IPs. These adapters will be torn down when Damocles is stopped. 71 | 72 | From Erlang: 73 | ``` 74 | damocles:add_interface("10.10.10.10"). 75 | damocles:add_interface("10.10.10.11"). 76 | damocles:add_interface("10.10.10.12"). 77 | damocles:add_interface("10.10.10.13"). 78 | damocles:add_interface("10.10.10.14"). 79 | ``` 80 | 81 | From the command line: 82 | ``` 83 | [location]/scripts/damocles_external add_interface "10.10.10.10" 84 | [location]/scripts/damocles_external add_interface "10.10.10.11" 85 | [location]/scripts/damocles_external add_interface "10.10.10.12" 86 | [location]/scripts/damocles_external add_interface "10.10.10.13" 87 | [location]/scripts/damocles_external add_interface "10.10.10.14" 88 | ``` 89 | 90 | ##### Registering an existing local adapter with its IP (10.10.10.15) 91 | Use an IP from an existing local adapter. These adapters will not be torn down when Damocles is stopped, but will have any rules you have applied to them torn down. 92 | 93 | From Erlang: 94 | ``` 95 | damocles:register_interface("10.10.10.15"). 96 | ``` 97 | 98 | From the command line: 99 | ``` 100 | [location]/scripts/damocles_external register_interface "10.10.10.15" 101 | ``` 102 | 103 | 104 | ##### Prevent traffic from a source IP (10.10.10.10) to a destination IP (10.10.10.11) 105 | Prevent all traffic flowing out from source to destination, but not traffic flowing the other direction. 106 | 107 | From Erlang: 108 | ``` 109 | damocles:isolate_one_way("10.10.10.10", "10.10.10.11"). 110 | ``` 111 | 112 | From the command line: 113 | ``` 114 | [location]/scripts/damocles_external isolate_one_way 10.10.10.10 10.10.10.11 115 | ``` 116 | 117 | ##### Prevent all traffic to and from an interface 118 | Will prevent all traffic to and from the specified interface from those other interfaces Damocles knows about (and no others; i.e., it will still be reachable from 127.0.0.1) 119 | 120 | From Erlang: 121 | ``` 122 | damocles:isolate_interface("10.10.10.10"). 123 | ``` 124 | 125 | From the command line: 126 | ``` 127 | [location]/scripts/damocles_external isolate_interface 10.10.10.10 128 | ``` 129 | 130 | ##### Create node partitions 131 | Used to isolate two sets of nodes from each other. Note that any nodes not included in either set retain any pre-existing rules (or lack thereof). That is, if you have nodes running on (prefix).10, .11, .12, .13, and .14, and call this with [.10, .11], and [.13, .14], as per the example below, .10 and .11 can still talk, but neither can reach .13 or .14. Similarly, .13 and .14 can talk, but neither can reach .10 or .11. And .12 can still talk to everyone. 132 | 133 | From Erlang: 134 | ``` 135 | damocles:isolate_between_interfaces(["10.10.10.10", "10.10.10.11"], ["10.10.10.13", "10.10.10.14"]) 136 | ``` 137 | 138 | From the command line: 139 | ``` 140 | [location]/scripts/damocles_external isolate_between_interfaces "10.10.10.10,10.10.10.11" "10.10.10.13,10.10.10.14" 141 | ``` 142 | 143 | ##### Induce packet loss between a src IP and dst IP 144 | Similar to preventing traffic between the two (and overwrites it), this causes only a percentage of packets to be dropped between the src IP and dst IP, but not from the dst IP to the src IP. The third argument is 145 | the percent chance of a packet being dropped; this can either be a whole integer percentage (20 = 20%), or a 146 | float value between 0.0 and 1.0 (0.2 = 20%). 147 | 148 | From Erlang: 149 | ``` 150 | damocles:packet_loss_one_way("10.10.10.10", "10.10.10.11", 0.05). 151 | ``` 152 | 153 | From the command line: 154 | ``` 155 | [location]/scripts/damocles_external packet_loss_one_way 10.10.10.10 10.10.10.11 .05 156 | ``` 157 | 158 | ##### Induce packet loss for all traffic flowing into or out of an interface 159 | Causes a percentage of packets to be dropped for all traffic flowing in or out of this interface. Note that this applies both in and out, so a 10% chance to drop means that a send and acknowledgement will have a 10% chance to fail on the send, -and- a 10% chance to fail on the acknowledgement. 160 | 161 | From Erlang: 162 | ``` 163 | damocles:packet_loss_interface("10.10.10.10", 0.05). 164 | ``` 165 | 166 | From the command line: 167 | ``` 168 | [location]/scripts/damocles_external packet_loss_interface 10.10.10.10 .05 169 | ``` 170 | 171 | ##### Induce packet loss for all traffic between sets of interfaces 172 | Similar to creating node partitions, this causes a percentage of packets to be dropped for all traffic flowing between a node in the first set, to a node in the second set. Note that this applies both in and out, so a 10% chance to drop means that a send and acknowledgement will have a 10% chance to fail on the send, -and- a 10% chance to fail on the acknowledgement. 173 | 174 | From Erlang: 175 | ``` 176 | damocles:packet_loss_between_interfaces(["10.10.10.10", "10.10.10.11], ["10.10.10.13", "10.10.10.14"], 0.05). 177 | ``` 178 | 179 | From the command line: 180 | ``` 181 | [location]/scripts/damocles_external packet_loss_between_interfaces "10.10.10.10,10.10.10.11" "10.10.10.13,10.10.10.14" .05 182 | ``` 183 | 184 | ##### Induce packet loss for all communication between known nodes 185 | This causes a percentage of packets to be dropped for all traffic flowing between two nodes that Damocles knows about. Note that this applies both in and out, so a 10% chance to drop means that a send and acknowledgement will have a 10% chance to fail on the send, -and- a 10% chance to fail on the acknowledgement. 186 | 187 | From Erlang: 188 | ``` 189 | damocles:packet_loss_global(0.05). 190 | ``` 191 | 192 | From the command line: 193 | ``` 194 | [location]/scripts/damocles_external packet_loss_global .05 195 | ``` 196 | 197 | ##### Induce packet delay between a src IP and dst IP 198 | Similar to preventing traffic between the two, this causes a fixed delay to be imposed on packets between the src IP and the dst IP, and not the reverse. The delay is an integer in milliseconds. 199 | 200 | From Erlang: 201 | ``` 202 | damocles:delay_one_way("10.10.10.10", "10.10.10.11", 100). 203 | ``` 204 | 205 | From the command line: 206 | ``` 207 | [location]/scripts/damocles_external delay_one_way 10.10.10.10 10.10.10.11 100 208 | ``` 209 | 210 | ##### Induce packet delay for all traffic flowing into or out of an interface 211 | Causes all packets to and from the specified IP to be delayed by the specified amount. Note that this applies both in and out, so a 100ms delay will affect both a sent packet, and an acknowledgement, so that things like pings will take 200ms. 212 | 213 | From Erlang: 214 | ``` 215 | damocles:delay_interface("10.10.10.10", 100). 216 | ``` 217 | 218 | From the command line: 219 | ``` 220 | [location]/scripts/damocles_external delay_interface 10.10.10.10 100 221 | ``` 222 | 223 | ##### Induce packet delay for all traffic between sets of interfaces 224 | Similar to creating node partitions, this causes a delay for all traffic flowing between a node in the first set, to a node in the second set. Note that this applies both in and out, so a 100ms delay means that a send and acknowledgement will have a 100ms delay on the send, -and- a 100ms delay on the acknowledgement, for a total ping time of 200ms. 225 | 226 | From Erlang: 227 | ``` 228 | damocles:delay_between_interfaces(["10.10.10.10", "10.10.10.11], ["10.10.10.13", "10.10.10.14"], 100). 229 | ``` 230 | 231 | From the command line: 232 | ``` 233 | [location]/scripts/damocles_external delay_between_interfaces "10.10.10.10,10.10.10.11" "10.10.10.13,10.10.10.14" 100 234 | ``` 235 | 236 | ##### Induce packet delays for all packets sent between known interfaces 237 | This causes a delay on all packets flowing between two nodes that Damocles knows about. Note that this applies both in and out, so a 100 ms delay means that a send and acknowledgement will have a 100ms dekay on the send, -and- a 100ms delay on the acknowledgement. 238 | 239 | From Erlang: 240 | ``` 241 | damocles:delay_global(100). 242 | ``` 243 | 244 | From the command line: 245 | ``` 246 | [location]/scripts/damocles_external delay_global 100 247 | ``` 248 | 249 | ##### Restore a connection between a src IP and dst IP 250 | Will undo any delay/drop you've imposed on traffic flowing from src, to dst (but not the other way). 251 | 252 | From Erlang: 253 | ``` 254 | damocles:restore_one_way("10.10.10.10", "10.10.10.11"). 255 | ``` 256 | 257 | From the command line: 258 | ``` 259 | [location]/scripts/damocles_external restore_one_way 10.10.10.10 10.10.10.11 260 | ``` 261 | 262 | 263 | ##### Restore all connections to and from an interface 264 | Will undo any delay/drop you've imposed on the traffic flowing into or out of an interface. 265 | 266 | From Erlang: 267 | ``` 268 | damocles:restore_interface("10.10.10.10"). 269 | ``` 270 | 271 | From the command line: 272 | ``` 273 | [location]/scripts/damocles_external restore_interface 10.10.10.10 274 | ``` 275 | 276 | 277 | ##### Restore the entire network 278 | Will undo any delay/drop you've imposed on the traffic flowing between interfaces that Damocles knows about. 279 | 280 | From Erlang: 281 | ``` 282 | damocles:restore_all_interfaces(). 283 | ``` 284 | 285 | From the command line: 286 | ``` 287 | [location]/scripts/damocles_external restore_all_interfaces 288 | ``` 289 | 290 | ##### See what IPs Damocles currently is aware of 291 | Returns a list of all IPs Damocles is aware of and can configure. 292 | 293 | From Erlang: 294 | ``` 295 | damocles:get_known_ips(). 296 | ``` 297 | 298 | From the command line: 299 | ``` 300 | [location]/scripts/damocles_external get_known_ips 301 | ``` 302 | 303 | 304 | ##### See what rules Damocles is applying to a given connection 305 | Returns a proplist of the rules Damocles is applying between a src and dst IP. Note that it only 306 | tells you what packets going from src -> dst have applied; you need to query separately to get 307 | dst -> src (by calling it with the arguments in the reverse order). 308 | 309 | From Erlang: 310 | ``` 311 | damocles:get_rules_for_connection("10.10.10.10", "10.10.10.11"). 312 | ``` 313 | 314 | From the command line: 315 | ``` 316 | [location]/scripts/damocles_external get_rules_for_connection 10.10.10.10 10.10.10.11 317 | ``` 318 | #TODO 319 | - Bugfixes. Highest priority. 320 | - Examples of using this library to test distributed code. Second highest priority. 321 | - Allow for the registering of and manipulation of external IPs rather than local ones. Harder, but useful for load testing, so a higher priority when I next have free time. 322 | - Add bandwidth limitations. Possibly some difficulty, but low priority. 323 | - Add additional mechanisms for delaying/dropping in different patterns. Easy but low priority. 324 | - Refactor some things. Very low priority, but a cause of enough joy it might happen. 325 | - Add OSX support. Probably very hard (not sure the domain mapping for traffic control is the same, nor what utilities OSX comes with), moderate priority. 326 | 327 | ## License 328 | ---- 329 | 330 | MIT 331 | -------------------------------------------------------------------------------- /erlang.mk: -------------------------------------------------------------------------------- 1 | # Copyright (c) 2013-2014, Loïc Hoguin 2 | # 3 | # Permission to use, copy, modify, and/or distribute this software for any 4 | # purpose with or without fee is hereby granted, provided that the above 5 | # copyright notice and this permission notice appear in all copies. 6 | # 7 | # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 8 | # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 9 | # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 10 | # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 11 | # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 12 | # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 13 | # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 14 | 15 | .PHONY: all deps app rel docs tests clean distclean help erlang-mk 16 | 17 | ERLANG_MK_VERSION = 1 18 | 19 | # Core configuration. 20 | 21 | PROJECT ?= $(notdir $(CURDIR)) 22 | PROJECT := $(strip $(PROJECT)) 23 | 24 | # Verbosity. 25 | 26 | V ?= 0 27 | 28 | gen_verbose_0 = @echo " GEN " $@; 29 | gen_verbose = $(gen_verbose_$(V)) 30 | 31 | # Core targets. 32 | 33 | all:: deps app rel 34 | 35 | clean:: 36 | $(gen_verbose) rm -f erl_crash.dump 37 | 38 | distclean:: clean 39 | 40 | help:: 41 | @printf "%s\n" \ 42 | "erlang.mk (version $(ERLANG_MK_VERSION)) is distributed under the terms of the ISC License." \ 43 | "Copyright (c) 2013-2014 Loïc Hoguin " \ 44 | "" \ 45 | "Usage: [V=1] make [target]" \ 46 | "" \ 47 | "Core targets:" \ 48 | " all Run deps, app and rel targets in that order" \ 49 | " deps Fetch dependencies (if needed) and compile them" \ 50 | " app Compile the project" \ 51 | " rel Build a release for this project, if applicable" \ 52 | " docs Build the documentation for this project" \ 53 | " tests Run the tests for this project" \ 54 | " clean Delete temporary and output files from most targets" \ 55 | " distclean Delete all temporary and output files" \ 56 | " help Display this help and exit" \ 57 | "" \ 58 | "The target clean only removes files that are commonly removed." \ 59 | "Dependencies and releases are left untouched." \ 60 | "" \ 61 | "Setting V=1 when calling make enables verbose mode." 62 | 63 | # Core functions. 64 | 65 | ifeq ($(shell which wget 2>/dev/null | wc -l), 1) 66 | define core_http_get 67 | wget --no-check-certificate -O $(1) $(2)|| rm $(1) 68 | endef 69 | else 70 | define core_http_get 71 | erl -noshell -eval 'ssl:start(), inets:start(), case httpc:request(get, {"$(2)", []}, [{autoredirect, true}], []) of {ok, {{_, 200, _}, _, Body}} -> case file:write_file("$(1)", Body) of ok -> ok; {error, R1} -> halt(R1) end; {error, R2} -> halt(R2) end, halt(0).' 72 | endef 73 | endif 74 | 75 | # Automated update. 76 | 77 | ERLANG_MK_BUILD_CONFIG ?= build.config 78 | ERLANG_MK_BUILD_DIR ?= .erlang.mk.build 79 | 80 | erlang-mk: 81 | git clone https://github.com/ninenines/erlang.mk $(ERLANG_MK_BUILD_DIR) 82 | if [ -f $(ERLANG_MK_BUILD_CONFIG) ]; then cp $(ERLANG_MK_BUILD_CONFIG) $(ERLANG_MK_BUILD_DIR); fi 83 | cd $(ERLANG_MK_BUILD_DIR) && make 84 | cp $(ERLANG_MK_BUILD_DIR)/erlang.mk ./erlang.mk 85 | rm -rf $(ERLANG_MK_BUILD_DIR) 86 | 87 | # Copyright (c) 2013-2014, Loïc Hoguin 88 | # This file is part of erlang.mk and subject to the terms of the ISC License. 89 | 90 | .PHONY: distclean-deps distclean-pkg pkg-list pkg-search 91 | 92 | # Configuration. 93 | 94 | DEPS_DIR ?= $(CURDIR)/deps 95 | export DEPS_DIR 96 | 97 | REBAR_DEPS_DIR = $(DEPS_DIR) 98 | export REBAR_DEPS_DIR 99 | 100 | ALL_DEPS_DIRS = $(addprefix $(DEPS_DIR)/,$(DEPS)) 101 | 102 | ifeq ($(filter $(DEPS_DIR),$(subst :, ,$(ERL_LIBS))),) 103 | ifeq ($(ERL_LIBS),) 104 | ERL_LIBS = $(DEPS_DIR) 105 | else 106 | ERL_LIBS := $(ERL_LIBS):$(DEPS_DIR) 107 | endif 108 | endif 109 | export ERL_LIBS 110 | 111 | PKG_FILE2 ?= $(CURDIR)/.erlang.mk.packages.v2 112 | export PKG_FILE2 113 | 114 | PKG_FILE_URL ?= https://raw.githubusercontent.com/ninenines/erlang.mk/master/packages.v2.tsv 115 | 116 | # Core targets. 117 | 118 | deps:: $(ALL_DEPS_DIRS) 119 | @for dep in $(ALL_DEPS_DIRS) ; do \ 120 | if [ -f $$dep/GNUmakefile ] || [ -f $$dep/makefile ] || [ -f $$dep/Makefile ] ; then \ 121 | $(MAKE) -C $$dep ; \ 122 | else \ 123 | echo "include $(CURDIR)/erlang.mk" | ERLC_OPTS=+debug_info $(MAKE) -f - -C $$dep ; \ 124 | fi ; \ 125 | done 126 | 127 | distclean:: distclean-deps distclean-pkg 128 | 129 | # Deps related targets. 130 | 131 | define dep_fetch 132 | if [ "$$$$VS" = "git" ]; then \ 133 | git clone -n -- $$$$REPO $(DEPS_DIR)/$(1); \ 134 | cd $(DEPS_DIR)/$(1) && git checkout -q $$$$COMMIT; \ 135 | elif [ "$$$$VS" = "hg" ]; then \ 136 | hg clone -U $$$$REPO $(DEPS_DIR)/$(1); \ 137 | cd $(DEPS_DIR)/$(1) && hg update -q $$$$COMMIT; \ 138 | else \ 139 | echo "Unknown or invalid dependency: $(1). Please consult the erlang.mk README for instructions." >&2; \ 140 | exit 78; \ 141 | fi 142 | endef 143 | 144 | define dep_target 145 | $(DEPS_DIR)/$(1): 146 | @mkdir -p $(DEPS_DIR) 147 | ifeq (,$(dep_$(1))) 148 | @if [ ! -f $(PKG_FILE2) ]; then $(call core_http_get,$(PKG_FILE2),$(PKG_FILE_URL)); fi 149 | @DEPPKG=$$$$(awk 'BEGIN { FS = "\t" }; $$$$1 == "$(1)" { print $$$$2 " " $$$$3 " " $$$$4 }' $(PKG_FILE2);); \ 150 | VS=$$$$(echo $$$$DEPPKG | cut -d " " -f1); \ 151 | REPO=$$$$(echo $$$$DEPPKG | cut -d " " -f2); \ 152 | COMMIT=$$$$(echo $$$$DEPPKG | cut -d " " -f3); \ 153 | $(call dep_fetch,$(1)) 154 | else 155 | @VS=$(word 1,$(dep_$(1))); \ 156 | REPO=$(word 2,$(dep_$(1))); \ 157 | COMMIT=$(word 3,$(dep_$(1))); \ 158 | $(call dep_fetch,$(1)) 159 | endif 160 | endef 161 | 162 | $(foreach dep,$(DEPS),$(eval $(call dep_target,$(dep)))) 163 | 164 | distclean-deps: 165 | $(gen_verbose) rm -rf $(DEPS_DIR) 166 | 167 | # Packages related targets. 168 | 169 | $(PKG_FILE2): 170 | @$(call core_http_get,$(PKG_FILE2),$(PKG_FILE_URL)) 171 | 172 | pkg-list: $(PKG_FILE2) 173 | @cat $(PKG_FILE2) | awk 'BEGIN { FS = "\t" }; { print \ 174 | "Name:\t\t" $$1 "\n" \ 175 | "Repository:\t" $$3 "\n" \ 176 | "Website:\t" $$5 "\n" \ 177 | "Description:\t" $$6 "\n" }' 178 | 179 | ifdef q 180 | pkg-search: $(PKG_FILE2) 181 | @cat $(PKG_FILE2) | grep -i ${q} | awk 'BEGIN { FS = "\t" }; { print \ 182 | "Name:\t\t" $$1 "\n" \ 183 | "Repository:\t" $$3 "\n" \ 184 | "Website:\t" $$5 "\n" \ 185 | "Description:\t" $$6 "\n" }' 186 | else 187 | pkg-search: 188 | $(error Usage: make pkg-search q=STRING) 189 | endif 190 | 191 | ifeq ($(PKG_FILE2),$(CURDIR)/.erlang.mk.packages.v2) 192 | distclean-pkg: 193 | $(gen_verbose) rm -f $(PKG_FILE2) 194 | endif 195 | 196 | help:: 197 | @printf "%s\n" "" \ 198 | "Package-related targets:" \ 199 | " pkg-list List all known packages" \ 200 | " pkg-search q=STRING Search for STRING in the package index" 201 | 202 | # Copyright (c) 2013-2014, Loïc Hoguin 203 | # This file is part of erlang.mk and subject to the terms of the ISC License. 204 | 205 | .PHONY: clean-app 206 | 207 | # Configuration. 208 | 209 | ERLC_OPTS ?= -Werror +debug_info +warn_export_vars +warn_shadow_vars \ 210 | +warn_obsolete_guard # +bin_opt_info +warn_export_all +warn_missing_spec 211 | COMPILE_FIRST ?= 212 | COMPILE_FIRST_PATHS = $(addprefix src/,$(addsuffix .erl,$(COMPILE_FIRST))) 213 | ERLC_EXCLUDE ?= 214 | ERLC_EXCLUDE_PATHS = $(addprefix src/,$(addsuffix .erl,$(ERLC_EXCLUDE))) 215 | 216 | ERLC_MIB_OPTS ?= 217 | COMPILE_MIB_FIRST ?= 218 | COMPILE_MIB_FIRST_PATHS = $(addprefix mibs/,$(addsuffix .mib,$(COMPILE_MIB_FIRST))) 219 | 220 | # Verbosity. 221 | 222 | appsrc_verbose_0 = @echo " APP " $(PROJECT).app.src; 223 | appsrc_verbose = $(appsrc_verbose_$(V)) 224 | 225 | erlc_verbose_0 = @echo " ERLC " $(filter-out $(patsubst %,%.erl,$(ERLC_EXCLUDE)),\ 226 | $(filter %.erl %.core,$(?F))); 227 | erlc_verbose = $(erlc_verbose_$(V)) 228 | 229 | xyrl_verbose_0 = @echo " XYRL " $(filter %.xrl %.yrl,$(?F)); 230 | xyrl_verbose = $(xyrl_verbose_$(V)) 231 | 232 | mib_verbose_0 = @echo " MIB " $(filter %.bin %.mib,$(?F)); 233 | mib_verbose = $(mib_verbose_$(V)) 234 | 235 | # Core targets. 236 | 237 | app:: erlc-include ebin/$(PROJECT).app 238 | $(eval MODULES := $(shell find ebin -type f -name \*.beam \ 239 | | sed "s/ebin\//'/;s/\.beam/',/" | sed '$$s/.$$//')) 240 | @if [ -z "$$(grep -E '^[^%]*{modules,' src/$(PROJECT).app.src)" ]; then \ 241 | echo "Empty modules entry not found in $(PROJECT).app.src. Please consult the erlang.mk README for instructions." >&2; \ 242 | exit 1; \ 243 | fi 244 | $(eval GITDESCRIBE := $(shell git describe --dirty --abbrev=7 --tags --always --first-parent 2>/dev/null || true)) 245 | $(appsrc_verbose) cat src/$(PROJECT).app.src \ 246 | | sed "s/{modules,[[:space:]]*\[\]}/{modules, \[$(MODULES)\]}/" \ 247 | | sed "s/{id,[[:space:]]*\"git\"}/{id, \"$(GITDESCRIBE)\"}/" \ 248 | > ebin/$(PROJECT).app 249 | 250 | define compile_erl 251 | $(erlc_verbose) erlc -v $(ERLC_OPTS) -o ebin/ \ 252 | -pa ebin/ -I include/ $(filter-out $(ERLC_EXCLUDE_PATHS),\ 253 | $(COMPILE_FIRST_PATHS) $(1)) 254 | endef 255 | 256 | define compile_xyrl 257 | $(xyrl_verbose) erlc -v -o ebin/ $(1) 258 | $(xyrl_verbose) erlc $(ERLC_OPTS) -o ebin/ ebin/*.erl 259 | @rm ebin/*.erl 260 | endef 261 | 262 | define compile_mib 263 | $(mib_verbose) erlc -v $(ERLC_MIB_OPTS) -o priv/mibs/ \ 264 | -I priv/mibs/ $(COMPILE_MIB_FIRST_PATHS) $(1) 265 | $(mib_verbose) erlc -o include/ -- priv/mibs/*.bin 266 | endef 267 | 268 | ifneq ($(wildcard src/),) 269 | ebin/$(PROJECT).app:: 270 | @mkdir -p ebin/ 271 | 272 | ifneq ($(wildcard mibs/),) 273 | ebin/$(PROJECT).app:: $(shell find mibs -type f -name \*.mib) 274 | @mkdir -p priv/mibs/ include 275 | $(if $(strip $?),$(call compile_mib,$?)) 276 | endif 277 | 278 | ebin/$(PROJECT).app:: $(shell find src -type f -name \*.erl) \ 279 | $(shell find src -type f -name \*.core) 280 | $(if $(strip $?),$(call compile_erl,$?)) 281 | 282 | ebin/$(PROJECT).app:: $(shell find src -type f -name \*.xrl) \ 283 | $(shell find src -type f -name \*.yrl) 284 | $(if $(strip $?),$(call compile_xyrl,$?)) 285 | endif 286 | 287 | clean:: clean-app 288 | 289 | # Extra targets. 290 | 291 | erlc-include: 292 | -@if [ -d ebin/ ]; then \ 293 | find include/ src/ -type f -name \*.hrl -newer ebin -exec touch $(shell find src/ -type f -name "*.erl") \; 2>/dev/null || printf ''; \ 294 | fi 295 | 296 | clean-app: 297 | $(gen_verbose) rm -rf ebin/ priv/mibs/ \ 298 | $(addprefix include/,$(addsuffix .hrl,$(notdir $(basename $(wildcard mibs/*.mib))))) 299 | 300 | # Copyright (c) 2014, Loïc Hoguin 301 | # This file is part of erlang.mk and subject to the terms of the ISC License. 302 | 303 | .PHONY: bootstrap bootstrap-lib bootstrap-rel new list-templates 304 | 305 | # Core targets. 306 | 307 | help:: 308 | @printf "%s\n" "" \ 309 | "Bootstrap targets:" \ 310 | " bootstrap Generate a skeleton of an OTP application" \ 311 | " bootstrap-lib Generate a skeleton of an OTP library" \ 312 | " bootstrap-rel Generate the files needed to build a release" \ 313 | " new t=TPL n=NAME Generate a module NAME based on the template TPL" \ 314 | " list-templates List available templates" 315 | 316 | # Bootstrap templates. 317 | 318 | bs_appsrc = "{application, $(PROJECT), [" \ 319 | " {description, \"\"}," \ 320 | " {vsn, \"0.1.0\"}," \ 321 | " {id, \"git\"}," \ 322 | " {modules, []}," \ 323 | " {registered, []}," \ 324 | " {applications, [" \ 325 | " kernel," \ 326 | " stdlib" \ 327 | " ]}," \ 328 | " {mod, {$(PROJECT)_app, []}}," \ 329 | " {env, []}" \ 330 | "]}." 331 | bs_appsrc_lib = "{application, $(PROJECT), [" \ 332 | " {description, \"\"}," \ 333 | " {vsn, \"0.1.0\"}," \ 334 | " {id, \"git\"}," \ 335 | " {modules, []}," \ 336 | " {registered, []}," \ 337 | " {applications, [" \ 338 | " kernel," \ 339 | " stdlib" \ 340 | " ]}" \ 341 | "]}." 342 | bs_Makefile = "PROJECT = $(PROJECT)" \ 343 | "include erlang.mk" 344 | bs_app = "-module($(PROJECT)_app)." \ 345 | "-behaviour(application)." \ 346 | "" \ 347 | "-export([start/2])." \ 348 | "-export([stop/1])." \ 349 | "" \ 350 | "start(_Type, _Args) ->" \ 351 | " $(PROJECT)_sup:start_link()." \ 352 | "" \ 353 | "stop(_State) ->" \ 354 | " ok." 355 | bs_relx_config = "{release, {$(PROJECT)_release, \"1\"}, [$(PROJECT)]}." \ 356 | "{extended_start_script, true}." \ 357 | "{sys_config, \"rel/sys.config\"}." \ 358 | "{vm_args, \"rel/vm.args\"}." 359 | bs_sys_config = "[" \ 360 | "]." 361 | bs_vm_args = "-name $(PROJECT)@127.0.0.1" \ 362 | "-setcookie $(PROJECT)" \ 363 | "-heart" 364 | # Normal templates. 365 | tpl_supervisor = "-module($(n))." \ 366 | "-behaviour(supervisor)." \ 367 | "" \ 368 | "-export([start_link/0])." \ 369 | "-export([init/1])." \ 370 | "" \ 371 | "start_link() ->" \ 372 | " supervisor:start_link({local, ?MODULE}, ?MODULE, [])." \ 373 | "" \ 374 | "init([]) ->" \ 375 | " Procs = []," \ 376 | " {ok, {{one_for_one, 1, 5}, Procs}}." 377 | tpl_gen_server = "-module($(n))." \ 378 | "-behaviour(gen_server)." \ 379 | "" \ 380 | "%% API." \ 381 | "-export([start_link/0])." \ 382 | "" \ 383 | "%% gen_server." \ 384 | "-export([init/1])." \ 385 | "-export([handle_call/3])." \ 386 | "-export([handle_cast/2])." \ 387 | "-export([handle_info/2])." \ 388 | "-export([terminate/2])." \ 389 | "-export([code_change/3])." \ 390 | "" \ 391 | "-record(state, {" \ 392 | "})." \ 393 | "" \ 394 | "%% API." \ 395 | "" \ 396 | "-spec start_link() -> {ok, pid()}." \ 397 | "start_link() ->" \ 398 | " gen_server:start_link(?MODULE, [], [])." \ 399 | "" \ 400 | "%% gen_server." \ 401 | "" \ 402 | "init([]) ->" \ 403 | " {ok, \#state{}}." \ 404 | "" \ 405 | "handle_call(_Request, _From, State) ->" \ 406 | " {reply, ignored, State}." \ 407 | "" \ 408 | "handle_cast(_Msg, State) ->" \ 409 | " {noreply, State}." \ 410 | "" \ 411 | "handle_info(_Info, State) ->" \ 412 | " {noreply, State}." \ 413 | "" \ 414 | "terminate(_Reason, _State) ->" \ 415 | " ok." \ 416 | "" \ 417 | "code_change(_OldVsn, State, _Extra) ->" \ 418 | " {ok, State}." 419 | tpl_cowboy_http = "-module($(n))." \ 420 | "-behaviour(cowboy_http_handler)." \ 421 | "" \ 422 | "-export([init/3])." \ 423 | "-export([handle/2])." \ 424 | "-export([terminate/3])." \ 425 | "" \ 426 | "-record(state, {" \ 427 | "})." \ 428 | "" \ 429 | "init(_, Req, _Opts) ->" \ 430 | " {ok, Req, \#state{}}." \ 431 | "" \ 432 | "handle(Req, State=\#state{}) ->" \ 433 | " {ok, Req2} = cowboy_req:reply(200, Req)," \ 434 | " {ok, Req2, State}." \ 435 | "" \ 436 | "terminate(_Reason, _Req, _State) ->" \ 437 | " ok." 438 | tpl_cowboy_loop = "-module($(n))." \ 439 | "-behaviour(cowboy_loop_handler)." \ 440 | "" \ 441 | "-export([init/3])." \ 442 | "-export([info/3])." \ 443 | "-export([terminate/3])." \ 444 | "" \ 445 | "-record(state, {" \ 446 | "})." \ 447 | "" \ 448 | "init(_, Req, _Opts) ->" \ 449 | " {loop, Req, \#state{}, 5000, hibernate}." \ 450 | "" \ 451 | "info(_Info, Req, State) ->" \ 452 | " {loop, Req, State, hibernate}." \ 453 | "" \ 454 | "terminate(_Reason, _Req, _State) ->" \ 455 | " ok." 456 | tpl_cowboy_rest = "-module($(n))." \ 457 | "" \ 458 | "-export([init/3])." \ 459 | "-export([content_types_provided/2])." \ 460 | "-export([get_html/2])." \ 461 | "" \ 462 | "init(_, _Req, _Opts) ->" \ 463 | " {upgrade, protocol, cowboy_rest}." \ 464 | "" \ 465 | "content_types_provided(Req, State) ->" \ 466 | " {[{{<<\"text\">>, <<\"html\">>, '*'}, get_html}], Req, State}." \ 467 | "" \ 468 | "get_html(Req, State) ->" \ 469 | " {<<\"This is REST!\">>, Req, State}." 470 | tpl_cowboy_ws = "-module($(n))." \ 471 | "-behaviour(cowboy_websocket_handler)." \ 472 | "" \ 473 | "-export([init/3])." \ 474 | "-export([websocket_init/3])." \ 475 | "-export([websocket_handle/3])." \ 476 | "-export([websocket_info/3])." \ 477 | "-export([websocket_terminate/3])." \ 478 | "" \ 479 | "-record(state, {" \ 480 | "})." \ 481 | "" \ 482 | "init(_, _, _) ->" \ 483 | " {upgrade, protocol, cowboy_websocket}." \ 484 | "" \ 485 | "websocket_init(_, Req, _Opts) ->" \ 486 | " Req2 = cowboy_req:compact(Req)," \ 487 | " {ok, Req2, \#state{}}." \ 488 | "" \ 489 | "websocket_handle({text, Data}, Req, State) ->" \ 490 | " {reply, {text, Data}, Req, State};" \ 491 | "websocket_handle({binary, Data}, Req, State) ->" \ 492 | " {reply, {binary, Data}, Req, State};" \ 493 | "websocket_handle(_Frame, Req, State) ->" \ 494 | " {ok, Req, State}." \ 495 | "" \ 496 | "websocket_info(_Info, Req, State) ->" \ 497 | " {ok, Req, State}." \ 498 | "" \ 499 | "websocket_terminate(_Reason, _Req, _State) ->" \ 500 | " ok." 501 | tpl_ranch_protocol = "-module($(n))." \ 502 | "-behaviour(ranch_protocol)." \ 503 | "" \ 504 | "-export([start_link/4])." \ 505 | "-export([init/4])." \ 506 | "" \ 507 | "-type opts() :: []." \ 508 | "-export_type([opts/0])." \ 509 | "" \ 510 | "-record(state, {" \ 511 | " socket :: inet:socket()," \ 512 | " transport :: module()" \ 513 | "})." \ 514 | "" \ 515 | "start_link(Ref, Socket, Transport, Opts) ->" \ 516 | " Pid = spawn_link(?MODULE, init, [Ref, Socket, Transport, Opts])," \ 517 | " {ok, Pid}." \ 518 | "" \ 519 | "-spec init(ranch:ref(), inet:socket(), module(), opts()) -> ok." \ 520 | "init(Ref, Socket, Transport, _Opts) ->" \ 521 | " ok = ranch:accept_ack(Ref)," \ 522 | " loop(\#state{socket=Socket, transport=Transport})." \ 523 | "" \ 524 | "loop(State) ->" \ 525 | " loop(State)." 526 | 527 | # Plugin-specific targets. 528 | 529 | bootstrap: 530 | ifneq ($(wildcard src/),) 531 | $(error Error: src/ directory already exists) 532 | endif 533 | @printf "%s\n" $(bs_Makefile) > Makefile 534 | @mkdir src/ 535 | @printf "%s\n" $(bs_appsrc) > src/$(PROJECT).app.src 536 | @printf "%s\n" $(bs_app) > src/$(PROJECT)_app.erl 537 | $(eval n := $(PROJECT)_sup) 538 | @printf "%s\n" $(tpl_supervisor) > src/$(PROJECT)_sup.erl 539 | 540 | bootstrap-lib: 541 | ifneq ($(wildcard src/),) 542 | $(error Error: src/ directory already exists) 543 | endif 544 | @printf "%s\n" $(bs_Makefile) > Makefile 545 | @mkdir src/ 546 | @printf "%s\n" $(bs_appsrc_lib) > src/$(PROJECT).app.src 547 | 548 | bootstrap-rel: 549 | ifneq ($(wildcard relx.config),) 550 | $(error Error: relx.config already exists) 551 | endif 552 | ifneq ($(wildcard rel/),) 553 | $(error Error: rel/ directory already exists) 554 | endif 555 | @printf "%s\n" $(bs_relx_config) > relx.config 556 | @mkdir rel/ 557 | @printf "%s\n" $(bs_sys_config) > rel/sys.config 558 | @printf "%s\n" $(bs_vm_args) > rel/vm.args 559 | 560 | new: 561 | ifeq ($(wildcard src/),) 562 | $(error Error: src/ directory does not exist) 563 | endif 564 | ifndef t 565 | $(error Usage: make new t=TEMPLATE n=NAME) 566 | endif 567 | ifndef tpl_$(t) 568 | $(error Unknown template) 569 | endif 570 | ifndef n 571 | $(error Usage: make new t=TEMPLATE n=NAME) 572 | endif 573 | @printf "%s\n" $(tpl_$(t)) > src/$(n).erl 574 | 575 | list-templates: 576 | @echo Available templates: $(sort $(patsubst tpl_%,%,$(filter tpl_%,$(.VARIABLES)))) 577 | 578 | # Copyright (c) 2014, Loïc Hoguin 579 | # This file is part of erlang.mk and subject to the terms of the ISC License. 580 | 581 | .PHONY: clean-c_src distclean-c_src-env 582 | # todo 583 | 584 | # Configuration. 585 | 586 | C_SRC_DIR = $(CURDIR)/c_src 587 | C_SRC_ENV ?= $(C_SRC_DIR)/env.mk 588 | C_SRC_OUTPUT ?= $(CURDIR)/priv/$(PROJECT).so 589 | 590 | # System type and C compiler/flags. 591 | 592 | UNAME_SYS := $(shell uname -s) 593 | ifeq ($(UNAME_SYS), Darwin) 594 | CC ?= cc 595 | CFLAGS ?= -O3 -std=c99 -arch x86_64 -finline-functions -Wall -Wmissing-prototypes 596 | CXXFLAGS ?= -O3 -arch x86_64 -finline-functions -Wall 597 | LDFLAGS ?= -arch x86_64 -flat_namespace -undefined suppress 598 | else ifeq ($(UNAME_SYS), FreeBSD) 599 | CC ?= cc 600 | CFLAGS ?= -O3 -std=c99 -finline-functions -Wall -Wmissing-prototypes 601 | CXXFLAGS ?= -O3 -finline-functions -Wall 602 | else ifeq ($(UNAME_SYS), Linux) 603 | CC ?= gcc 604 | CFLAGS ?= -O3 -std=c99 -finline-functions -Wall -Wmissing-prototypes 605 | CXXFLAGS ?= -O3 -finline-functions -Wall 606 | endif 607 | 608 | CFLAGS += -fPIC -I $(ERTS_INCLUDE_DIR) -I $(ERL_INTERFACE_INCLUDE_DIR) 609 | CXXFLAGS += -fPIC -I $(ERTS_INCLUDE_DIR) -I $(ERL_INTERFACE_INCLUDE_DIR) 610 | 611 | LDLIBS += -L $(ERL_INTERFACE_LIB_DIR) -lerl_interface -lei 612 | LDFLAGS += -shared 613 | 614 | # Verbosity. 615 | 616 | c_verbose_0 = @echo " C " $(?F); 617 | c_verbose = $(c_verbose_$(V)) 618 | 619 | cpp_verbose_0 = @echo " CPP " $(?F); 620 | cpp_verbose = $(cpp_verbose_$(V)) 621 | 622 | link_verbose_0 = @echo " LD " $(@F); 623 | link_verbose = $(link_verbose_$(V)) 624 | 625 | # Targets. 626 | 627 | ifeq ($(wildcard $(C_SRC_DIR)),) 628 | else ifneq ($(wildcard $(C_SRC_DIR)/Makefile),) 629 | app:: 630 | $(MAKE) -C $(C_SRC_DIR) 631 | 632 | clean:: 633 | $(MAKE) -C $(C_SRC_DIR) clean 634 | 635 | else 636 | SOURCES := $(shell find $(C_SRC_DIR) -type f \( -name "*.c" -o -name "*.C" -o -name "*.cc" -o -name "*.cpp" \)) 637 | OBJECTS = $(addsuffix .o, $(basename $(SOURCES))) 638 | 639 | COMPILE_C = $(c_verbose) $(CC) $(CFLAGS) $(CPPFLAGS) -c 640 | COMPILE_CPP = $(cpp_verbose) $(CXX) $(CXXFLAGS) $(CPPFLAGS) -c 641 | 642 | app:: $(C_SRC_ENV) $(C_SRC_OUTPUT) 643 | 644 | $(C_SRC_OUTPUT): $(OBJECTS) 645 | @mkdir -p priv/ 646 | $(link_verbose) $(CC) $(OBJECTS) $(LDFLAGS) $(LDLIBS) -o $(C_SRC_OUTPUT) 647 | 648 | %.o: %.c 649 | $(COMPILE_C) $(OUTPUT_OPTION) $< 650 | 651 | %.o: %.cc 652 | $(COMPILE_CPP) $(OUTPUT_OPTION) $< 653 | 654 | %.o: %.C 655 | $(COMPILE_CPP) $(OUTPUT_OPTION) $< 656 | 657 | %.o: %.cpp 658 | $(COMPILE_CPP) $(OUTPUT_OPTION) $< 659 | 660 | $(C_SRC_ENV): 661 | @erl -noshell -noinput -eval "file:write_file(\"$(C_SRC_ENV)\", \ 662 | io_lib:format( \ 663 | \"ERTS_INCLUDE_DIR ?= ~s/erts-~s/include/~n\" \ 664 | \"ERL_INTERFACE_INCLUDE_DIR ?= ~s~n\" \ 665 | \"ERL_INTERFACE_LIB_DIR ?= ~s~n\", \ 666 | [code:root_dir(), erlang:system_info(version), \ 667 | code:lib_dir(erl_interface, include), \ 668 | code:lib_dir(erl_interface, lib)])), \ 669 | erlang:halt()." 670 | 671 | clean:: clean-c_src 672 | 673 | clean-c_src: 674 | $(gen_verbose) rm -f $(C_SRC_OUTPUT) $(OBJECTS) 675 | 676 | distclean:: distclean-c_src-env 677 | 678 | distclean-c_src-env: 679 | $(gen_verbose) rm -f $(C_SRC_ENV) 680 | 681 | -include $(C_SRC_ENV) 682 | endif 683 | 684 | # Copyright (c) 2013-2014, Loïc Hoguin 685 | # This file is part of erlang.mk and subject to the terms of the ISC License. 686 | 687 | .PHONY: build-ct-deps build-ct-suites tests-ct clean-ct distclean-ct 688 | 689 | # Configuration. 690 | 691 | CT_OPTS ?= 692 | ifneq ($(wildcard test/),) 693 | CT_SUITES ?= $(sort $(subst _SUITE.erl,,$(shell find test -type f -name \*_SUITE.erl -exec basename {} \;))) 694 | else 695 | CT_SUITES ?= 696 | endif 697 | 698 | TEST_ERLC_OPTS ?= +debug_info +warn_export_vars +warn_shadow_vars +warn_obsolete_guard 699 | TEST_ERLC_OPTS += -DTEST=1 -DEXTRA=1 +'{parse_transform, eunit_autoexport}' 700 | 701 | # Core targets. 702 | 703 | tests:: tests-ct 704 | 705 | clean:: clean-ct 706 | 707 | distclean:: distclean-ct 708 | 709 | help:: 710 | @printf "%s\n" "" \ 711 | "All your common_test suites have their associated targets." \ 712 | "A suite named http_SUITE can be ran using the ct-http target." 713 | 714 | # Plugin-specific targets. 715 | 716 | ALL_TEST_DEPS_DIRS = $(addprefix $(DEPS_DIR)/,$(TEST_DEPS)) 717 | 718 | CT_RUN = ct_run \ 719 | -no_auto_compile \ 720 | -noshell \ 721 | -pa $(realpath ebin) $(DEPS_DIR)/*/ebin \ 722 | -dir test \ 723 | -logdir logs 724 | 725 | $(foreach dep,$(TEST_DEPS),$(eval $(call dep_target,$(dep)))) 726 | 727 | build-ct-deps: $(ALL_TEST_DEPS_DIRS) 728 | @for dep in $(ALL_TEST_DEPS_DIRS) ; do $(MAKE) -C $$dep; done 729 | 730 | build-ct-suites: build-ct-deps 731 | $(gen_verbose) erlc -v $(TEST_ERLC_OPTS) -I include/ -o test/ \ 732 | $(wildcard test/*.erl test/*/*.erl) -pa ebin/ 733 | 734 | tests-ct: ERLC_OPTS = $(TEST_ERLC_OPTS) 735 | tests-ct: clean deps app build-ct-suites 736 | @if [ -d "test" ] ; \ 737 | then \ 738 | mkdir -p logs/ ; \ 739 | $(CT_RUN) -suite $(addsuffix _SUITE,$(CT_SUITES)) $(CT_OPTS) ; \ 740 | fi 741 | $(gen_verbose) rm -f test/*.beam 742 | 743 | define ct_suite_target 744 | ct-$(1): ERLC_OPTS = $(TEST_ERLC_OPTS) 745 | ct-$(1): clean deps app build-ct-suites 746 | @if [ -d "test" ] ; \ 747 | then \ 748 | mkdir -p logs/ ; \ 749 | $(CT_RUN) -suite $(addsuffix _SUITE,$(1)) $(CT_OPTS) ; \ 750 | fi 751 | $(gen_verbose) rm -f test/*.beam 752 | endef 753 | 754 | $(foreach test,$(CT_SUITES),$(eval $(call ct_suite_target,$(test)))) 755 | 756 | clean-ct: 757 | $(gen_verbose) rm -rf test/*.beam 758 | 759 | distclean-ct: 760 | $(gen_verbose) rm -rf logs/ 761 | 762 | # Copyright (c) 2013-2014, Loïc Hoguin 763 | # This file is part of erlang.mk and subject to the terms of the ISC License. 764 | 765 | .PHONY: plt distclean-plt dialyze 766 | 767 | # Configuration. 768 | 769 | DIALYZER_PLT ?= $(CURDIR)/.$(PROJECT).plt 770 | export DIALYZER_PLT 771 | 772 | PLT_APPS ?= 773 | DIALYZER_DIRS ?= --src -r src 774 | DIALYZER_OPTS ?= -Werror_handling -Wrace_conditions \ 775 | -Wunmatched_returns # -Wunderspecs 776 | 777 | # Core targets. 778 | 779 | distclean:: distclean-plt 780 | 781 | help:: 782 | @printf "%s\n" "" \ 783 | "Dialyzer targets:" \ 784 | " plt Build a PLT file for this project" \ 785 | " dialyze Analyze the project using Dialyzer" 786 | 787 | # Plugin-specific targets. 788 | 789 | $(DIALYZER_PLT): deps app 790 | @dialyzer --build_plt --apps erts kernel stdlib $(PLT_APPS) $(ALL_DEPS_DIRS) 791 | 792 | plt: $(DIALYZER_PLT) 793 | 794 | distclean-plt: 795 | $(gen_verbose) rm -f $(DIALYZER_PLT) 796 | 797 | ifneq ($(wildcard $(DIALYZER_PLT)),) 798 | dialyze: 799 | else 800 | dialyze: $(DIALYZER_PLT) 801 | endif 802 | @dialyzer --no_native $(DIALYZER_DIRS) $(DIALYZER_OPTS) 803 | 804 | # Copyright (c) 2013-2014, Loïc Hoguin 805 | # This file is part of erlang.mk and subject to the terms of the ISC License. 806 | 807 | .PHONY: distclean-edoc 808 | 809 | # Configuration. 810 | 811 | EDOC_OPTS ?= 812 | 813 | # Core targets. 814 | 815 | docs:: distclean-edoc 816 | $(gen_verbose) erl -noshell \ 817 | -eval 'edoc:application($(PROJECT), ".", [$(EDOC_OPTS)]), init:stop().' 818 | 819 | distclean:: distclean-edoc 820 | 821 | # Plugin-specific targets. 822 | 823 | distclean-edoc: 824 | $(gen_verbose) rm -f doc/*.css doc/*.html doc/*.png doc/edoc-info 825 | 826 | # Copyright (c) 2014, Juan Facorro 827 | # This file is part of erlang.mk and subject to the terms of the ISC License. 828 | 829 | .PHONY: elvis distclean-elvis 830 | 831 | # Configuration. 832 | 833 | ELVIS_CONFIG ?= $(CURDIR)/elvis.config 834 | 835 | ELVIS ?= $(CURDIR)/elvis 836 | export ELVIS 837 | 838 | ELVIS_URL ?= https://github.com/inaka/elvis/releases/download/0.2.3/elvis 839 | ELVIS_CONFIG_URL ?= https://github.com/inaka/elvis/releases/download/0.2.3/elvis.config 840 | ELVIS_OPTS ?= 841 | 842 | # Core targets. 843 | 844 | help:: 845 | @printf "%s\n" "" \ 846 | "Elvis targets:" \ 847 | " elvis Run Elvis using the local elvis.config or download the default otherwise" 848 | 849 | ifneq ($(wildcard $(ELVIS_CONFIG)),) 850 | rel:: distclean-elvis 851 | endif 852 | 853 | distclean:: distclean-elvis 854 | 855 | # Plugin-specific targets. 856 | 857 | $(ELVIS): 858 | @$(call core_http_get,$(ELVIS_CONFIG),$(ELVIS_CONFIG_URL)) 859 | @$(call core_http_get,$(ELVIS),$(ELVIS_URL)) 860 | @chmod +x $(ELVIS) 861 | 862 | elvis: $(ELVIS) 863 | @$(ELVIS) rock -c $(ELVIS_CONFIG) $(ELVIS_OPTS) 864 | 865 | distclean-elvis: 866 | $(gen_verbose) rm -rf $(ELVIS) 867 | 868 | # Copyright (c) 2013-2014, Loïc Hoguin 869 | # This file is part of erlang.mk and subject to the terms of the ISC License. 870 | 871 | # Verbosity. 872 | 873 | dtl_verbose_0 = @echo " DTL " $(filter %.dtl,$(?F)); 874 | dtl_verbose = $(dtl_verbose_$(V)) 875 | 876 | # Core targets. 877 | 878 | define compile_erlydtl 879 | $(dtl_verbose) erl -noshell -pa ebin/ $(DEPS_DIR)/erlydtl/ebin/ -eval ' \ 880 | Compile = fun(F) -> \ 881 | Module = list_to_atom( \ 882 | string:to_lower(filename:basename(F, ".dtl")) ++ "_dtl"), \ 883 | erlydtl:compile(F, Module, [{out_dir, "ebin/"}]) \ 884 | end, \ 885 | _ = [Compile(F) || F <- string:tokens("$(1)", " ")], \ 886 | init:stop()' 887 | endef 888 | 889 | ifneq ($(wildcard src/),) 890 | ebin/$(PROJECT).app:: $(shell find templates -type f -name \*.dtl 2>/dev/null) 891 | $(if $(strip $?),$(call compile_erlydtl,$?)) 892 | endif 893 | 894 | # Copyright (c) 2014 Dave Cottlehuber 895 | # This file is part of erlang.mk and subject to the terms of the ISC License. 896 | 897 | .PHONY: distclean-escript escript 898 | 899 | # Configuration. 900 | 901 | ESCRIPT_NAME ?= $(PROJECT) 902 | ESCRIPT_COMMENT ?= This is an -*- erlang -*- file 903 | 904 | ESCRIPT_BEAMS ?= "ebin/*", "deps/*/ebin/*" 905 | ESCRIPT_SYS_CONFIG ?= "rel/sys.config" 906 | ESCRIPT_EMU_ARGS ?= -pa . \ 907 | -noshell -noinput \ 908 | -sasl errlog_type error \ 909 | -escript main $(ESCRIPT_NAME) 910 | ESCRIPT_SHEBANG ?= /usr/bin/env escript 911 | ESCRIPT_STATIC ?= "deps/*/priv/**", "priv/**" 912 | 913 | # Core targets. 914 | 915 | distclean:: distclean-escript 916 | 917 | help:: 918 | @printf "%s\n" "" \ 919 | "Escript targets:" \ 920 | " escript Build an executable escript archive" \ 921 | 922 | # Plugin-specific targets. 923 | 924 | # Based on https://github.com/synrc/mad/blob/master/src/mad_bundle.erl 925 | # Copyright (c) 2013 Maxim Sokhatsky, Synrc Research Center 926 | # Modified MIT License, https://github.com/synrc/mad/blob/master/LICENSE : 927 | # Software may only be used for the great good and the true happiness of all 928 | # sentient beings. 929 | define ESCRIPT_RAW 930 | 'Read = fun(F) -> {ok, B} = file:read_file(filename:absname(F)), B end,'\ 931 | 'Files = fun(L) -> A = lists:concat([filelib:wildcard(X)||X<- L ]),'\ 932 | ' [F || F <- A, not filelib:is_dir(F) ] end,'\ 933 | 'Squash = fun(L) -> [{filename:basename(F), Read(F) } || F <- L ] end,'\ 934 | 'Zip = fun(A, L) -> {ok,{_,Z}} = zip:create(A, L, [{compress,all},memory]), Z end,'\ 935 | 'Ez = fun(Escript) ->'\ 936 | ' Static = Files([$(ESCRIPT_STATIC)]),'\ 937 | ' Beams = Squash(Files([$(ESCRIPT_BEAMS), $(ESCRIPT_SYS_CONFIG)])),'\ 938 | ' Archive = Beams ++ [{ "static.gz", Zip("static.gz", Static)}],'\ 939 | ' escript:create(Escript, [ $(ESCRIPT_OPTIONS)'\ 940 | ' {archive, Archive, [memory]},'\ 941 | ' {shebang, "$(ESCRIPT_SHEBANG)"},'\ 942 | ' {comment, "$(ESCRIPT_COMMENT)"},'\ 943 | ' {emu_args, " $(ESCRIPT_EMU_ARGS)"}'\ 944 | ' ]),'\ 945 | ' file:change_mode(Escript, 8#755)'\ 946 | 'end,'\ 947 | 'Ez("$(ESCRIPT_NAME)").' 948 | endef 949 | ESCRIPT_COMMAND = $(subst ' ',,$(ESCRIPT_RAW)) 950 | 951 | escript:: distclean-escript deps app 952 | $(gen_verbose) erl -noshell -eval $(ESCRIPT_COMMAND) -s init stop 953 | 954 | distclean-escript: 955 | $(gen_verbose) rm -f $(ESCRIPT_NAME) 956 | 957 | # Copyright (c) 2013-2014, Loïc Hoguin 958 | # This file is part of erlang.mk and subject to the terms of the ISC License. 959 | 960 | .PHONY: relx-rel distclean-relx-rel distclean-relx 961 | 962 | # Configuration. 963 | 964 | RELX_CONFIG ?= $(CURDIR)/relx.config 965 | 966 | RELX ?= $(CURDIR)/relx 967 | export RELX 968 | 969 | RELX_URL ?= https://github.com/erlware/relx/releases/download/v1.0.2/relx 970 | RELX_OPTS ?= 971 | RELX_OUTPUT_DIR ?= _rel 972 | 973 | ifeq ($(firstword $(RELX_OPTS)),-o) 974 | RELX_OUTPUT_DIR = $(word 2,$(RELX_OPTS)) 975 | else 976 | RELX_OPTS += -o $(RELX_OUTPUT_DIR) 977 | endif 978 | 979 | # Core targets. 980 | 981 | ifneq ($(wildcard $(RELX_CONFIG)),) 982 | rel:: distclean-relx-rel relx-rel 983 | endif 984 | 985 | distclean:: distclean-relx-rel distclean-relx 986 | 987 | # Plugin-specific targets. 988 | 989 | define relx_fetch 990 | $(call core_http_get,$(RELX),$(RELX_URL)) 991 | chmod +x $(RELX) 992 | endef 993 | 994 | $(RELX): 995 | @$(call relx_fetch) 996 | 997 | relx-rel: $(RELX) 998 | @$(RELX) -c $(RELX_CONFIG) $(RELX_OPTS) 999 | 1000 | distclean-relx-rel: 1001 | $(gen_verbose) rm -rf $(RELX_OUTPUT_DIR) 1002 | 1003 | distclean-relx: 1004 | $(gen_verbose) rm -rf $(RELX) 1005 | 1006 | # Copyright (c) 2014, M Robert Martin 1007 | # This file is contributed to erlang.mk and subject to the terms of the ISC License. 1008 | 1009 | .PHONY: shell 1010 | 1011 | # Configuration. 1012 | 1013 | SHELL_PATH ?= -pa ../$(PROJECT)/ebin $(DEPS_DIR)/*/ebin 1014 | SHELL_OPTS ?= 1015 | 1016 | ALL_SHELL_DEPS_DIRS = $(addprefix $(DEPS_DIR)/,$(SHELL_DEPS)) 1017 | 1018 | # Core targets 1019 | 1020 | help:: 1021 | @printf "%s\n" "" \ 1022 | "Shell targets:" \ 1023 | " shell Run an erlang shell with SHELL_OPTS or reasonable default" 1024 | 1025 | # Plugin-specific targets. 1026 | 1027 | $(foreach dep,$(SHELL_DEPS),$(eval $(call dep_target,$(dep)))) 1028 | 1029 | build-shell-deps: $(ALL_SHELL_DEPS_DIRS) 1030 | @for dep in $(ALL_SHELL_DEPS_DIRS) ; do $(MAKE) -C $$dep ; done 1031 | 1032 | shell: build-shell-deps 1033 | $(gen_verbose) erl $(SHELL_PATH) $(SHELL_OPTS) 1034 | -------------------------------------------------------------------------------- /rel/sys.config: -------------------------------------------------------------------------------- 1 | [ 2 | ]. 3 | -------------------------------------------------------------------------------- /rel/vm.args: -------------------------------------------------------------------------------- 1 | -name damocles@127.0.0.1 2 | -setcookie damocles 3 | -heart 4 | -------------------------------------------------------------------------------- /relx.config: -------------------------------------------------------------------------------- 1 | {release, {damocles_release, "1"}, [damocles]}. 2 | {extended_start_script, true}. 3 | {sys_config, "rel/sys.config"}. 4 | {vm_args, "rel/vm.args"}. 5 | -------------------------------------------------------------------------------- /scripts/damocles_external: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env escript 2 | %%! -name damocles_script@127.0.0.1 -setcookie damocles 3 | main([Fun | Args]) -> 4 | try 5 | pong = net_adm:ping('damocles@127.0.0.1'), 6 | io:format("~p~n", [rpc:call('damocles@127.0.0.1', damocles, list_to_atom(Fun), process_args(Args))]) 7 | catch _:Reason -> 8 | io:format("~p~n", [erlang:get_stacktrace()]), 9 | io:format("~p~n", [Reason]), 10 | exit(Reason) 11 | end. 12 | 13 | process_args([]) -> []; 14 | process_args([Arg | Args]) -> 15 | case [string:strip(X) || X <- string:tokens(Arg, ",")] of 16 | [A] -> [to_num_if_needed(A)] ++ process_args(Args); 17 | List -> [List] ++ process_args(Args) 18 | end. 19 | 20 | to_num_if_needed(A) -> to_integer_or_list(to_float_or_list(A)). 21 | 22 | 23 | to_integer_or_list(A) -> 24 | case catch(list_to_integer(A)) of 25 | {'EXIT', _} -> A; 26 | B when is_integer(B) -> B 27 | end. 28 | 29 | to_float_or_list([$. | _] = Val) -> 30 | to_float_or_list("0" ++ Val); 31 | to_float_or_list(A) -> 32 | case catch(list_to_float(A)) of 33 | {'EXIT', _} -> A; 34 | B when is_float(B) -> B 35 | end. -------------------------------------------------------------------------------- /scripts/start.sh: -------------------------------------------------------------------------------- 1 | SCRIPT=$(readlink -f "$0") 2 | SCRIPTPATH=$(dirname "$SCRIPT") 3 | $SCRIPTPATH/../_rel/damocles_release/bin/damocles_release start 4 | 5 | -------------------------------------------------------------------------------- /scripts/stop.sh: -------------------------------------------------------------------------------- 1 | SCRIPT=$(readlink -f "$0") 2 | SCRIPTPATH=$(dirname "$SCRIPT") 3 | $SCRIPTPATH/../_rel/damocles_release/bin/damocles_release stop 4 | 5 | -------------------------------------------------------------------------------- /src/damocles.app.src: -------------------------------------------------------------------------------- 1 | {application, damocles, [ 2 | {description, ""}, 3 | {vsn, "0.1.0"}, 4 | {id, "git"}, 5 | {modules, []}, 6 | {registered, []}, 7 | {applications, [ 8 | kernel, 9 | stdlib 10 | ]}, 11 | {mod, {damocles_app, []}}, 12 | {env, []} 13 | ]}. 14 | -------------------------------------------------------------------------------- /src/damocles.erl: -------------------------------------------------------------------------------- 1 | -module(damocles). 2 | 3 | -export([ 4 | start/0, 5 | start_link/0, 6 | get_known_ips/0, 7 | add_interface/1, 8 | register_interface/1, 9 | isolate_one_way/2, 10 | isolate_interface/1, 11 | isolate_between_interfaces/2, 12 | packet_loss_one_way/3, 13 | packet_loss_interface/2, 14 | packet_loss_between_interfaces/3, 15 | packet_loss_global/1, 16 | delay_one_way/3, 17 | delay_interface/2, 18 | delay_between_interfaces/3, 19 | delay_global/1, 20 | restore_one_way/2, 21 | restore_interface/1, 22 | restore_all_interfaces/0, 23 | get_rules_for_connection/2, 24 | stop/0]). 25 | 26 | 27 | 28 | start() -> gen_server:start({local, damocles_server}, damocles_server, [], []). 29 | 30 | start_link() -> gen_server:start_link({local, damocles_server}, damocles_server, [], []). 31 | 32 | get_known_ips() -> gen_server:call(damocles_server, get_known_ips). 33 | 34 | %Creates an interface that will be torn down when Damocles is stopped. 35 | -spec add_interface(nonempty_string()) -> nonempty_string() | error. 36 | add_interface(Ip) -> gen_server:call(damocles_server, {add_interface, Ip}, infinity). 37 | 38 | %Adds knowledge of an interface so that its traffic may be controlled, but will not be torn down when Damocles is stopped. 39 | -spec register_interface(nonempty_string()) -> nonempty_string() | error. 40 | register_interface(IpOrAdapter) -> gen_server:call(damocles_server, {register_interface, IpOrAdapter}). 41 | 42 | %Returns a proplist of all rules that have been applied to packets between Src -> Dst. 43 | -spec get_rules_for_connection(nonempty_string(), nonempty_string()) -> damocles_lib:tc_rules(). 44 | get_rules_for_connection(IpOrAdapterSrc, IpOrAdapterDst) -> gen_server:call(damocles_server, {get_rules_for_connection, IpOrAdapterSrc, IpOrAdapterDst}). 45 | 46 | %Isolates src from being able to communicate with dst, but not vice versa (dst can still send packets to src). 47 | -spec isolate_one_way(nonempty_string(), nonempty_string()) -> ok | error. 48 | isolate_one_way(Src, Dst) -> gen_server:call(damocles_server, {isolate_one_way, Src, Dst}). 49 | 50 | %Prevents all traffic from other interfaces Damocles knows about to and from the interface specified. 51 | -spec isolate_interface(nonempty_string()) -> ok | error. 52 | isolate_interface(IpOrAdapter) -> gen_server:call(damocles_server, {isolate_interface, IpOrAdapter}). 53 | 54 | %All nodes from setA will be unable to talk to nodes in setB (and vice versa). 55 | -spec isolate_between_interfaces([nonempty_string()] | nonempty_string(), [nonempty_string()] | nonempty_string()) -> ok | error. 56 | isolate_between_interfaces(IpSetA, IpSetB) -> gen_server:call(damocles_server, {isolate_between_interfaces, IpSetA, IpSetB}). 57 | 58 | %Induces one way packet loss between src -> dst (so not dst -> src) at the rate specified. Rate is either an integer percentage 59 | % (i.e., 50 = 50%), or a float between 0.0 and 1.0 (so 0.5 = 50%). 60 | -spec packet_loss_one_way(nonempty_string(), nonempty_string(), number()) -> ok | error. 61 | packet_loss_one_way(Src, Dst, Rate) -> gen_server:call(damocles_server, {packet_loss_one_way, Src, Dst, Rate}). 62 | 63 | %Induces packet loss at the specified rate for all connections between specified interface, and all others known about. 64 | %NOTE THAT THIS IS APPLIED TO BOTH SENDING, AND RECEIVING. 65 | %i.e, if you apply a packet loss of 10% you have a 10% chance of losing any sent packet, and any received packet, thus a round 66 | %trip send and ack can be expected to succeed only 81% (90% success send * 90% success ack) of the time. 67 | -spec packet_loss_interface(nonempty_string(), number()) -> ok | error. 68 | packet_loss_interface(IpOrAdapter, Rate) -> gen_server:call(damocles_server, {packet_loss_interface, IpOrAdapter, Rate}). 69 | 70 | %Induces packet loss at the specified rate between all connections running between interfaces in set A, to interfaces in set B 71 | -spec packet_loss_between_interfaces([nonempty_string()] | nonempty_string(), [nonempty_string()] | nonempty_string(), number()) -> ok | error. 72 | packet_loss_between_interfaces(SetA, SetB, Rate) -> gen_server:call(damocles_server, {packet_loss_between_interfaces, SetA, SetB, Rate}). 73 | 74 | %Induces packet loss across the entire network. 75 | %NOTE THAT THIS IS APPLIED TO BOTH SENDING, AND RECEIVING. 76 | %i.e, if you apply a packet loss of 10% you have a 10% chance of losing any sent packet, and any received packet, thus a round 77 | %trip send and ack can be expected to succeed only 81% (90% success send * 90% success ack) of the time. 78 | -spec packet_loss_global(pos_integer()) -> ok | error. 79 | packet_loss_global(Rate) -> gen_server:call(damocles_server, {packet_loss_global, Rate}). 80 | 81 | %Applies the specified integer amount of delay, in millis, to packets between Src -> Dst 82 | -spec delay_one_way(nonempty_string(), nonempty_string(), pos_integer()) -> ok | error. 83 | delay_one_way(Src, Dst, Amount) -> gen_server:call(damocles_server, {delay_one_way, Src, Dst, Amount}). 84 | 85 | %Applies the specified integer amount of delay, in millis, to all packets to and from the specified interface. 86 | -spec delay_interface(nonempty_string(), pos_integer()) -> ok | error. 87 | delay_interface(IpOrAdapter, Amount) -> gen_server:call(damocles_server, {delay_interface, IpOrAdapter, Amount}). 88 | 89 | %Applies the specified integer amount of delay, in millis, to all packets sent from an interface in SetA, to an interface in SetB 90 | -spec delay_between_interfaces([nonempty_string()] | nonempty_string(), [nonempty_string()] | nonempty_string(), pos_integer()) -> ok | error. 91 | delay_between_interfaces(SetA, SetB, Amount) -> gen_server:call(damocles_server, {delay_between_interfaces, SetA, SetB, Amount}). 92 | 93 | %Applies the specified integer amount of delay, in millis, to all packets sent between two interfaces Damocles knows about. 94 | -spec delay_global(pos_integer()) -> ok | error. 95 | delay_global(Amount) -> gen_server:call(damocles_server, {delay_global, Amount}). 96 | 97 | %Restores the specified connection from src -> dst (but not vice versa). 98 | -spec restore_one_way(nonempty_string(), nonempty_string()) -> ok | error. 99 | restore_one_way(Src, Dst) -> gen_server:call(damocles_server, {restore_one_way, Src, Dst}). 100 | 101 | %Restores all connections for the given interface 102 | -spec restore_interface(nonempty_string()) -> ok | error. 103 | restore_interface(IpOrAdapter) -> gen_server:call(damocles_server, {restore_interface, IpOrAdapter}). 104 | 105 | %Restores all connections across all known interfaces. 106 | -spec restore_all_interfaces() -> ok | error. 107 | restore_all_interfaces() -> gen_server:call(damocles_server, restore_all_interfaces). 108 | 109 | stop() -> gen_server:cast(damocles_server, stop). -------------------------------------------------------------------------------- /src/damocles_app.erl: -------------------------------------------------------------------------------- 1 | -module(damocles_app). 2 | -behaviour(application). 3 | 4 | -export([start/2]). 5 | -export([stop/1]). 6 | 7 | start(_Type, _Args) -> 8 | damocles_sup:start_link(). 9 | 10 | stop(_State) -> 11 | ok. 12 | -------------------------------------------------------------------------------- /src/damocles_lib.erl: -------------------------------------------------------------------------------- 1 | -module(damocles_lib). 2 | 3 | -export([ 4 | get_interface_func_type/0, 5 | initialize_traffic_control/0, 6 | add_local_interface_ip4/2, 7 | register_local_interface_ip4/1, 8 | teardown_local_interface_ip4/2, 9 | teardown_all_local_interface/0, 10 | teardown_traffic_control/0, 11 | add_class_filter_for_ips/3, 12 | delete_class_filter/1, 13 | build_packet_rules/1, 14 | set_packet_rules/2, 15 | delete_packet_rules/1, 16 | show_all_local_filters/0, 17 | show_all_local_rules/0, 18 | ping/2, 19 | log/1, 20 | log/2]). 21 | 22 | -type tc_rules() :: [{drop, integer() | float()} | {delay, integer()}]. 23 | -export_type([tc_rules/0]). 24 | 25 | -spec get_interface_func_type() -> ip | ifconfig. 26 | get_interface_func_type() -> 27 | case os:cmd("sudo ip -V") of 28 | "ip utility" ++ _ -> ip; 29 | _ -> ifconfig 30 | end. 31 | 32 | 33 | -spec add_local_interface_ip4([byte(), ...], ip | ifconfig) -> nonempty_string() | {error, _}. 34 | add_local_interface_ip4(Ip, IfCommand) -> 35 | case ip4_is_in_use(Ip) of 36 | {true, _} -> {error, ip_already_in_use}; 37 | false -> 38 | Interface = get_unused_local_adapter(IfCommand), 39 | CreateResults = 40 | case IfCommand of 41 | ip -> 42 | os:cmd("sudo ip link add " ++ Interface ++ " type dummy; 43 | sudo ip link set dev " ++ Interface ++ " up; 44 | sudo ip addr add dev " ++ Interface ++ " " ++ Ip ++ "/32"); 45 | ifconfig -> 46 | os:cmd("sudo ifconfig " ++ Interface ++ " " ++ Ip ++ " netmask 255.255.255.255") 47 | end, 48 | case CreateResults of 49 | [] -> Interface; 50 | Error -> {error, Error} 51 | end 52 | end. 53 | 54 | -spec register_local_interface_ip4(nonempty_string()) -> {nonempty_string(), nonempty_string()} | false. 55 | register_local_interface_ip4(IpOrAdapter) -> 56 | case catch(ip4_is_in_use(IpOrAdapter)) of 57 | {true, Adapter} -> 58 | {IpOrAdapter, Adapter}; 59 | _ -> 60 | case interface_exists(IpOrAdapter) of 61 | true -> 62 | Ips = proplists:get_value(IpOrAdapter, get_adapters_and_ips()), 63 | {hd(Ips), IpOrAdapter}; 64 | false -> false 65 | end 66 | end. 67 | 68 | %There is probably a better queue to use, but htb seems the most straightforward that gives me the options I want. 69 | -spec initialize_traffic_control() -> ok | {error, _}. 70 | initialize_traffic_control() -> 71 | try 72 | [] = os:cmd("sudo tc qdisc add dev lo handle 1: root htb"), 73 | [] = os:cmd("sudo tc class add dev lo parent 1: classid 1:1 htb rate 1000Mbps"), 74 | [] = os:cmd("sudo tc filter add dev lo parent 1: protocol ip pref 1 u32"), 75 | ok 76 | catch _:Reason -> 77 | log(<<"Unable to create root qdisc and add class. Ensure running with sudo privs, and that no root qdisc exists on lo (run damocles_lib:teardown_traffic_control().)">>), 78 | {error, Reason} 79 | end. 80 | 81 | -spec teardown_local_interface_ip4(nonempty_string(), ip | ifconfig) -> ok | {error, string()}. 82 | teardown_local_interface_ip4(Interface, IfCommand) -> 83 | 84 | Resp = 85 | case IfCommand of 86 | ip -> 87 | os:cmd("sudo ip link del dev " ++ Interface); 88 | ifconfig -> 89 | os:cmd("sudo ifconfig " ++ Interface ++ " down") 90 | end, 91 | %The response doesn't matter in the success case; so long as it's gone all is well. 92 | case interface_exists(Interface) of 93 | true -> {error, Resp}; 94 | false -> ok 95 | end. 96 | 97 | teardown_all_local_interface() -> 98 | Ids = [{"lo" ++ [Char | Rest], Char} || {"lo" ++ [Char | Rest], _} <- get_adapters_and_ips(), Rest /= "" andalso (Char == $: orelse Char == $-)], 99 | lists:foreach( 100 | fun 101 | ({Id, $:}) -> teardown_local_interface_ip4(Id, ifconfig); 102 | ({Id, $-}) -> teardown_local_interface_ip4(Id, ip) 103 | end, Ids). 104 | 105 | -spec teardown_traffic_control() -> ok | {error, _}. 106 | teardown_traffic_control() -> 107 | try 108 | [] = os:cmd("sudo tc qdisc del dev lo root"), 109 | ok 110 | catch _:Reason -> {error, Reason} 111 | end. 112 | 113 | -spec ping(nonempty_string(), nonempty_string()) -> string(). 114 | ping(From, To) -> 115 | os:cmd("ping -w 1 -I " ++ From ++ " " ++ To). 116 | 117 | -spec add_class_filter_for_ips(nonempty_string(), nonempty_string(), integer()) -> ok | error. 118 | add_class_filter_for_ips(Src, Dst, Handle) -> 119 | try 120 | Ex1 = "sudo tc class add dev lo parent 1:1 classid 1:" ++ integer_to_list(Handle) ++ " htb rate 10Mbps ", 121 | [] = os:cmd(Ex1), 122 | Ex2 = "sudo tc filter add dev lo parent 1: handle ::" ++ integer_to_list(Handle) ++ " protocol ip prior 1 u32 match ip src " ++ Src ++ 123 | " match ip dst " ++ Dst ++ " flowid 1:" ++ integer_to_list(Handle), 124 | [] = os:cmd(Ex2), 125 | ok 126 | catch _:_ -> 127 | log("Failed to create class and filter for ~p to ~p on handle ~p", [Src, Dst, Handle]), 128 | error 129 | end. 130 | 131 | -spec delete_class_filter(integer()) -> ok | {error, nonempty_string()}. 132 | delete_class_filter(Handle) -> 133 | RespOdd = os:cmd("sudo tc filter del dev lo parent 1: handle 800::" ++ integer_to_list(Handle) ++ " prior 1 protocol ip u32"), 134 | Resp = os:cmd("sudo tc class del dev lo parent 1:1 classid 1:" ++ integer_to_list(Handle) ++ " htb rate 100Mbps "), 135 | case Resp of 136 | [] -> ok; 137 | Resp -> log(RespOdd), log(Resp), {error, Resp} 138 | end. 139 | 140 | -spec build_packet_rules(tc_rules()) -> string(). 141 | build_packet_rules(List) -> 142 | "netem " ++ 143 | lists:flatten(lists:map( 144 | fun 145 | ({drop, Percentage}) -> 146 | " drop " ++ percentage_to_list(Percentage) ++ "% "; 147 | ({delay, MS}) -> 148 | " delay " ++ integer_to_list(MS) ++ "ms " 149 | end, List)). 150 | 151 | percentage_to_list(Percentage) when is_integer(Percentage) -> integer_to_list(Percentage); 152 | percentage_to_list(Percentage) when is_float(Percentage) -> io_lib:format("~.2f", [Percentage*100]). 153 | 154 | -spec set_packet_rules(integer(), string() | tc_rules()) -> ok | {error, any()}. 155 | set_packet_rules(Handle, [H | _] = Rules) when is_tuple(H) -> set_packet_rules(Handle, build_packet_rules(Rules)); 156 | set_packet_rules(Handle, Rules) -> 157 | BaseCommand = "sudo tc qdisc ~s dev lo parent 1:" ++ integer_to_list(Handle) ++ " handle " ++ integer_to_list(Handle) ++ ": " ++ Rules, 158 | try 159 | case os:cmd(io_lib:format(BaseCommand, ["add"])) of 160 | [] -> ok; 161 | Error -> 162 | case os:cmd(io_lib:format(BaseCommand, ["change"])) of 163 | [] -> ok; 164 | "RTNETLINK answers: No such file or directory" -> {error, Error}; 165 | Error2 -> {error, Error2} % 166 | end 167 | end 168 | catch _:Reason -> 169 | log("Failed to add packet rules for ~p~n", [Handle]), 170 | {error, Reason} 171 | end. 172 | 173 | delete_packet_rules(Handle) -> 174 | case catch(os:cmd("sudo tc qdisc del dev lo parent 1:" ++ integer_to_list(Handle) ++ " handle " ++ integer_to_list(Handle))) of 175 | [] -> ok; 176 | "RTNETLINK answers: Invalid argument" -> ok; %Already gone/never existed. 177 | Error -> {error, Error} 178 | end. 179 | 180 | show_all_local_filters() -> os:cmd("sudo tc filter show dev lo"). 181 | 182 | show_all_local_rules() -> os:cmd("sudo tc qdisc show dev lo"). 183 | 184 | -spec get_unused_local_adapter(ip | ifconfig) -> nonempty_string(). 185 | get_unused_local_adapter(IfCommand) -> 186 | Used = 187 | case IfCommand of 188 | ip -> [list_to_integer(Rest) || {"lo-" ++ Rest, _} <- get_adapters_and_ips(), Rest /= ""]; 189 | ifconfig -> [list_to_integer(Rest) || {"lo:" ++ Rest, _} <- get_adapters_and_ips(), Rest /= ""] 190 | end, 191 | Number = 192 | case length(Used) of 193 | 0 -> 0; 194 | _ -> lists:max(Used) + 1 195 | end, 196 | "lo-" ++ integer_to_list(Number). 197 | 198 | -spec ip4_is_in_use(nonempty_string()) -> false | {true, nonempty_string()}. 199 | ip4_is_in_use(Ip) -> 200 | Adapter = proplists:get_value(Ip, lists:flatten([ [{X, Adapter} || X <- Ips] || {Adapter, Ips} <- get_adapters_and_ips()])), 201 | case Adapter of 202 | undefined -> false; 203 | _ -> {true, Adapter} 204 | end. 205 | 206 | -spec interface_exists(nonempty_string()) -> boolean(). 207 | interface_exists(Interface) -> 208 | lists:member(Interface, [Name || {Name, _}<- get_adapters_and_ips()]). 209 | 210 | -spec get_adapters_and_ips() -> [{nonempty_string(), [nonempty_string()]}]. 211 | get_adapters_and_ips() -> 212 | {ok, Items} = inet:getifaddrs(), 213 | [{Name, get_ip4s_from_props(Props)} || {Name, Props} <- Items]. 214 | 215 | -spec get_ip4s_from_props([{_, _}]) -> [nonempty_string()]. 216 | get_ip4s_from_props(Props) -> [ip4_tuple_as_list(Ip) || {addr, Ip} <- Props, size(Ip) == 4]. 217 | 218 | ip4_tuple_as_list({A, B, C, D}) -> 219 | integer_to_list(A) ++ "." ++ 220 | integer_to_list(B) ++ "." ++ 221 | integer_to_list(C) ++ "." ++ 222 | integer_to_list(D). 223 | 224 | 225 | log(Data) -> 226 | log("~p~n", [Data]). 227 | 228 | log(F, Data) -> 229 | io:fwrite(F, Data). 230 | -------------------------------------------------------------------------------- /src/damocles_server.erl: -------------------------------------------------------------------------------- 1 | -module(damocles_server). 2 | 3 | -behavior(gen_server). 4 | 5 | -export([init/1, handle_call/3, handle_cast/2, handle_info/2, code_change/3, terminate/2]). 6 | 7 | 8 | -record(handle, {id :: integer(), rules = [] :: damocles_lib:tc_rules()}). 9 | -record(state, {ifcommand = undefined, interfaces = ordsets:new(), currentHandle=10, ipsToHandles = dict:new() :: ip_to_handle_dict()}). 10 | -record(interface, {name :: string(), ip :: string(), transient=true}). 11 | 12 | -type ip_to_handle_dict() :: dict:dict({nonempty_string(), nonempty_string()}, #handle{}). 13 | 14 | init(_) -> 15 | %If we can't create traffic control, die. Die hard. With a vengeance. 16 | ok = damocles_lib:initialize_traffic_control(), 17 | 18 | %At this point make sure if we're exiting due to a shutdown we trap it, so terminate is called, and we (attempt to) undo our system manipulations. 19 | process_flag(trap_exit, true), 20 | {ok, #state{ifcommand = damocles_lib:get_interface_func_type()}}. 21 | 22 | -spec handle_call(_, _, #state{}) -> {reply, _, #state{}}. 23 | handle_call(get_known_ips, _, State) -> 24 | {reply, [X#interface.ip || X <- ordsets:to_list(State#state.interfaces)], State}; 25 | handle_call({add_interface, Ip}, _, State) -> 26 | case damocles_lib:add_local_interface_ip4(Ip, State#state.ifcommand) of 27 | {error, Reason} -> {reply, {error, Reason}, State}; 28 | Interface -> 29 | OldInterfaces = State#state.interfaces, 30 | case add_handles_for_interface(Ip, State) of 31 | error -> 32 | ok = damocles_lib:teardown_local_interface_ip4(Interface, State#state.ifcommand), 33 | {reply, error, State}; 34 | {NewHandle, NewDict} -> 35 | {reply, Interface, State#state{interfaces = ordsets:add_element(#interface{name = Interface, ip = Ip}, OldInterfaces), currentHandle = NewHandle, ipsToHandles = NewDict}} 36 | end 37 | end; 38 | handle_call({register_interface, IpOrAdapter}, _, State) -> 39 | case damocles_lib:register_local_interface_ip4(IpOrAdapter) of 40 | false -> 41 | {reply, false, State}; 42 | {Ip, Interface} -> 43 | OldInterfaces = State#state.interfaces, 44 | case add_handles_for_interface(Ip, State) of 45 | error -> 46 | ok = damocles_lib:teardown_local_interface_ip4(Interface, State#state.ifcommand), 47 | {reply, error, State}; 48 | {NewHandle, NewDict} -> 49 | {reply, Interface, State#state{interfaces = ordsets:add_element(#interface{name = Interface, ip = Ip, transient=false}, OldInterfaces), currentHandle = NewHandle, ipsToHandles = NewDict}} 50 | end 51 | end; 52 | handle_call({get_rules_for_connection, IpOrAdapter1, IpOrAdapter2}, _, State = #state{interfaces = Interfaces, ipsToHandles = HandleDict}) -> 53 | Ip1 = (get_interface_for_ip_or_adapter(IpOrAdapter1, Interfaces))#interface.ip, 54 | Ip2 = (get_interface_for_ip_or_adapter(IpOrAdapter2, Interfaces))#interface.ip, 55 | case dict:find({Ip1, Ip2}, HandleDict) of 56 | {ok, #handle{rules = Rules}} -> {reply, Rules, State}; 57 | _ -> {reply, undefined, State} 58 | end; 59 | handle_call({isolate_between_interfaces, SetA, SetB}, _, State) -> 60 | server_apply_rule_between_nodesets(SetA, SetB, [{drop, 100}], State); 61 | handle_call({isolate_interface, IpOrAdapter}, _, State) -> 62 | server_apply_rule_to_all_connections_to_interface(IpOrAdapter, [{drop, 100}], State); 63 | handle_call({isolate_one_way, Src, Dst}, _, State) -> 64 | server_apply_rule_one_way(Src, Dst, [{drop, 100}], State); 65 | handle_call({packet_loss_one_way, Src, Dst, DropRate}, _, State) -> 66 | case check_drop_rate(DropRate) of 67 | ok -> server_apply_rule_one_way(Src, Dst, [{drop, DropRate}], State); 68 | A -> {reply, A, State} 69 | end; 70 | handle_call({packet_loss_interface, IpOrAdapter, DropRate}, _, State) -> 71 | case check_drop_rate(DropRate) of 72 | ok -> server_apply_rule_to_all_connections_to_interface(IpOrAdapter, [{drop, DropRate}], State); 73 | A -> {reply, A, State} 74 | end; 75 | handle_call({packet_loss_between_interfaces, SetA, SetB, DropRate}, _, State) -> 76 | case check_drop_rate(DropRate) of 77 | ok -> server_apply_rule_between_nodesets(SetA, SetB, [{drop, DropRate}], State); 78 | A -> {reply, A, State} 79 | end; 80 | handle_call({packet_loss_global, DropRate}, _, State) -> 81 | case check_drop_rate(DropRate) of 82 | ok -> server_apply_rule_globally([{drop, DropRate}], State); 83 | A -> {reply, A, State} 84 | end; 85 | handle_call({delay_one_way, Src, Dst, Amount}, _, State) -> 86 | server_apply_rule_one_way(Src, Dst, [{delay, Amount}], State); 87 | handle_call({delay_interface, IpOrAdapter, Amount}, _, State) -> 88 | server_apply_rule_to_all_connections_to_interface(IpOrAdapter, [{delay, Amount}], State); 89 | handle_call({delay_between_interfaces, SetA, SetB, Amount}, _, State) -> 90 | server_apply_rule_between_nodesets(SetA, SetB, [{delay, Amount}], State); 91 | handle_call({delay_global, Amount}, _, State) -> 92 | server_apply_rule_globally([{delay, Amount}], State); 93 | handle_call({restore_one_way, Src, Dst}, _, State = #state{interfaces = Interfaces, ipsToHandles = Dict}) -> 94 | SrcIp = (get_interface_for_ip_or_adapter(Src, Interfaces))#interface.ip, 95 | DstIp = (get_interface_for_ip_or_adapter(Dst, Interfaces))#interface.ip, 96 | Handle = dict:fetch({SrcIp, DstIp},Dict), 97 | case damocles_lib:delete_packet_rules(Handle#handle.id) of 98 | ok -> 99 | NewState = State#state{ipsToHandles = dict:store({SrcIp, DstIp}, Handle#handle{rules = []}, Dict)}, 100 | {reply, ok, NewState}; 101 | {error, Reason} -> 102 | damocles_lib:log("Failed to remove rules for ~p -> ~p: ~p", [SrcIp, DstIp, Reason]), 103 | {reply, error, State} 104 | end; 105 | handle_call({restore_interface, IpOrAdapter}, _, State) -> 106 | {[MatchingInterface], Others} = partition_interfaces(IpOrAdapter, State#state.interfaces), 107 | Ip = MatchingInterface#interface.ip, 108 | OtherIps = [X#interface.ip || X <- Others], 109 | case remove_all_rules_between_node_and_nodesets(Ip, OtherIps, State#state.ipsToHandles) of 110 | {ok, NewDict} -> 111 | {reply, ok, State#state{ipsToHandles = NewDict}}; 112 | {error, Failed, NewDict} -> 113 | {reply, {error, Failed}, State#state{ipsToHandles = NewDict}} 114 | end; 115 | handle_call(restore_all_interfaces, _, State) -> 116 | InterfaceSets = interface_sets([X#interface.ip || X <- ordsets:to_list(State#state.interfaces)]), 117 | {Failed, NewIpHandleDict} = 118 | lists:foldl( 119 | fun({Ip, OtherIps}, {FailedAcc, Dict}) -> 120 | case remove_all_rules_between_node_and_nodesets(Ip, OtherIps, Dict) of 121 | {ok, NewDict} -> {FailedAcc, NewDict}; 122 | {error, NewFails, NewDict} -> {NewFails ++ FailedAcc, NewDict} 123 | end 124 | end, {[], State#state.ipsToHandles}, InterfaceSets), 125 | case Failed of 126 | [] -> {reply, ok, State#state{ipsToHandles = NewIpHandleDict}}; 127 | _ -> {reply, {error, Failed}, State#state{ipsToHandles = NewIpHandleDict}} 128 | end; 129 | handle_call(_,_, State) -> {reply, ok, State}. 130 | 131 | handle_cast(stop, State) -> {stop, normal, State}; 132 | handle_cast(_, State) -> {noreply, State}. 133 | 134 | handle_info(_, State) -> {noreply, State}. 135 | 136 | code_change(_, _, State) -> {ok, State}. 137 | 138 | terminate(_Reason, State) -> 139 | %Attempts to tear down each interface we've created, in parallel 140 | _ = rpc:pmap({damocles_lib, teardown_local_interface_ip4}, [State#state.ifcommand], [Name || #interface{name = Name, transient = true}<- ordsets:to_list(State#state.interfaces)]), 141 | case damocles_lib:teardown_traffic_control() of 142 | ok -> ok; 143 | {error, _} -> damocles_lib:log("Failed to tear down root qdisc on interface lo; exiting, but user intervention may be required for future startup") 144 | end, 145 | {ok, []}. 146 | 147 | check_drop_rate(DropRate) when is_integer(DropRate) andalso (DropRate < 0 orelse DropRate > 100) -> {error, invalid_drop_rate}; 148 | check_drop_rate(DropRate) when is_float(DropRate) andalso (DropRate < 0.0 orelse DropRate > 1.0) -> {error, invalid_drop_rate}; 149 | check_drop_rate(_) -> ok. 150 | 151 | get_interface_for_ip_or_adapter(IpOrAdapter, Interfaces) -> 152 | List = ordsets:to_list(Interfaces), 153 | case [X || X <- List, X#interface.ip == IpOrAdapter orelse X#interface.name == IpOrAdapter] of 154 | [] -> undefined; 155 | [A] -> A 156 | end. 157 | 158 | partition_interfaces(IpOrAdapter, Interfaces) -> 159 | List = ordsets:to_list(Interfaces), 160 | lists:partition( 161 | fun(Interface) -> 162 | Interface#interface.ip == IpOrAdapter orelse Interface#interface.name == IpOrAdapter 163 | end, List). 164 | 165 | 166 | -spec add_handles_for_interface(nonempty_string(), #state{}) -> {integer(), dict:dict({nonempty_string(), nonempty_string()}, #handle{})} | error. 167 | add_handles_for_interface(Ip, #state{currentHandle = CurrentHandle, ipsToHandles = HandleDict, interfaces = Interfaces}) -> 168 | OtherIps = [ X#interface.ip || X <- Interfaces], 169 | case lists:member(Ip, OtherIps) of 170 | true -> {CurrentHandle, HandleDict}; 171 | false -> 172 | lists:foldl( 173 | fun 174 | (_, error) -> error; 175 | (OtherIp, {Handle, Dict}) -> 176 | try 177 | ok = damocles_lib:add_class_filter_for_ips(Ip, OtherIp, Handle), 178 | ok = damocles_lib:add_class_filter_for_ips(OtherIp, Ip, Handle+1), 179 | NewDict = dict:store({Ip, OtherIp}, #handle{id=Handle}, dict:store({OtherIp, Ip}, #handle{id=Handle+1}, Dict)), 180 | {Handle+2, NewDict} 181 | catch _:Reason -> 182 | damocles_lib:log("Failed to create class filters between ~p and ~p because ~p", [Ip, OtherIp, Reason]), 183 | lists:foreach( 184 | fun(H) -> 185 | damocles_lib:delete_class_filter(H) %Just delete every item we created in this fold. 186 | end, lists:seq(CurrentHandle, Handle+1)), 187 | error 188 | end 189 | end, {CurrentHandle, HandleDict}, OtherIps) 190 | end. 191 | 192 | %Will either apply the stated rules to all connections between known interfaces, clear all rules on 193 | %connections between known interfaces, or throw due to being in an inconsistent state. 194 | server_apply_rule_globally(Rules, State) -> 195 | InterfaceSets = interface_sets([X#interface.ip || X <- ordsets:to_list(State#state.interfaces)]), 196 | {Failed, NewIpHandleDict} = 197 | lists:foldl( 198 | fun 199 | (_, {error, NewDict}) -> {error, NewDict}; 200 | ({Ip, OtherIps}, {ok, Dict}) -> 201 | case apply_rule_between_node_and_nodesets(Ip, OtherIps, Rules, Dict) of 202 | {ok, NewDict} -> {ok, NewDict}; 203 | {error, NewDict} -> {error, NewDict} 204 | end 205 | end, {ok, State#state.ipsToHandles}, InterfaceSets), 206 | case Failed of 207 | ok -> {reply, ok, State#state{ipsToHandles = NewIpHandleDict}}; 208 | error -> 209 | {_, ok, NewState} = handle_call(restore_all_interfaces, undefined, State), 210 | {reply, error, NewState} 211 | end. 212 | 213 | server_apply_rule_one_way(Src, Dst, Rules, State = #state{interfaces = Interfaces, ipsToHandles = HandleDict}) -> 214 | SrcIp = (get_interface_for_ip_or_adapter(Src, Interfaces))#interface.ip, 215 | DstIp = (get_interface_for_ip_or_adapter(Dst, Interfaces))#interface.ip, 216 | {ok, Handle} = dict:find({SrcIp, DstIp}, HandleDict), 217 | case add_rules_to_handle(SrcIp, DstIp, Handle, Rules, HandleDict) of 218 | error -> {reply, error, State}; 219 | {ok, NewDict} -> {reply, ok, State#state{ipsToHandles = NewDict}} 220 | end. 221 | 222 | server_apply_rule_to_all_connections_to_interface(IpOrAdapter, Rules, State) -> 223 | {[MatchingInterface], Others} = partition_interfaces(IpOrAdapter, State#state.interfaces), 224 | Ip = MatchingInterface#interface.ip, 225 | OtherIps = [X#interface.ip || X <- Others], 226 | {SuccessOrFailure, NewDict} = apply_rule_between_node_and_nodesets(Ip, OtherIps, Rules, State#state.ipsToHandles), 227 | {reply, SuccessOrFailure, State#state{ipsToHandles = NewDict}}. 228 | 229 | % Handles both nodesets, and individual interfaces. 230 | server_apply_rule_between_nodesets(SetA = [H | _], SetB, Rules, State) when is_integer(H) -> 231 | server_apply_rule_between_nodesets([SetA], SetB, Rules, State); 232 | server_apply_rule_between_nodesets(SetA, SetB = [H | _], Rules, State) when is_integer(H) -> 233 | server_apply_rule_between_nodesets(SetA, [SetB], Rules, State); 234 | server_apply_rule_between_nodesets(SetARaw, SetBRaw, Rules, State) -> 235 | SetA = [(get_interface_for_ip_or_adapter(X, State#state.interfaces))#interface.ip || X <- SetARaw], 236 | SetB = [(get_interface_for_ip_or_adapter(X, State#state.interfaces))#interface.ip || X <- SetBRaw], 237 | {SuccessOrFailure, NewDict} = apply_rule_between_nodeset_and_nodeset(SetA, SetB, Rules, State#state.ipsToHandles), 238 | {reply, SuccessOrFailure, State#state{ipsToHandles = NewDict}}. 239 | 240 | % Either all connections between the two nodesets have the rule applied, or all connections 241 | % are restored to normal, or, it throws, process dies. 242 | apply_rule_between_nodeset_and_nodeset(NodesA, NodesB, Rules, HandleDict) -> 243 | Result = 244 | lists:foldl( 245 | fun 246 | (_, error) -> error; 247 | (Node, {ok, Dict}) -> 248 | case apply_rule_between_node_and_nodesets(Node, NodesB, Rules, Dict) of 249 | {ok, NewDict} -> {ok, NewDict}; 250 | {error, _} -> error 251 | end 252 | end, {ok, HandleDict}, NodesA), 253 | case Result of 254 | {ok, NewDict} -> {ok, NewDict}; 255 | error -> 256 | NewDict = 257 | lists:foldl( 258 | fun(Node, Dict) -> 259 | {ok, NewDict} = remove_all_rules_between_node_and_nodesets(Node, NodesA, Dict), 260 | NewDict 261 | end, HandleDict, NodesA), 262 | {error, NewDict} 263 | end. 264 | 265 | %Calling this should guarantee one of three things about the connections to/from the specified IP. 266 | % 1. In the event of success, all connections have successfully had the rule applied. 267 | % 2. In the event of failure, all connections have had their rules removed; no packet drops/delays are being applied. 268 | % 3. In the event of failing to guarantee one of the prior two, we are in an indeterminate state where some interfaces 269 | % may have had the rule applied, and others have whatever they had prior to this function being called. This is bad. 270 | % An exception will be thrown in such a case, causing the process to restart, and in doing so attempt to tear down and 271 | % replace all interface configuration. 272 | apply_rule_between_node_and_nodesets(NodeIp, NodeIpSet, Rules, HandleDict) -> 273 | IpHandleSets = lists:flatten([ [{NodeIp, X, dict:fetch({NodeIp, X}, HandleDict) }, {X, NodeIp, dict:fetch({X, NodeIp}, HandleDict)}] || X <-NodeIpSet, X /= NodeIp ]), 274 | Result = 275 | lists:foldl( 276 | fun 277 | (_, error) -> error; 278 | ({Ip1, Ip2, Handle}, {ok, Dict}) -> add_rules_to_handle(Ip1, Ip2, Handle, Rules, Dict) 279 | end, {ok, HandleDict}, IpHandleSets), 280 | case Result of 281 | error -> 282 | {ok, NewDict} = remove_all_rules_between_node_and_nodesets(NodeIp, NodeIpSet, HandleDict), 283 | {error, NewDict}; %We return error to indicate we failed, and the new dictionary shows there are no rules being applied to the connections. 284 | {ok, NewDict} -> 285 | {ok, NewDict} 286 | end. 287 | 288 | add_rules_to_handle(Ip1, Ip2, Handle, Rules, Dict) -> 289 | NewRuleTypes = [element(1, Rule) || Rule <- Rules], 290 | CurrentRules = 291 | lists:foldl( 292 | fun(Type, List) -> 293 | lists:keydelete(Type, 1, List) 294 | end, Handle#handle.rules, NewRuleTypes), 295 | case damocles_lib:set_packet_rules(Handle#handle.id, Rules ++ CurrentRules) of 296 | ok -> {ok, dict:store({Ip1, Ip2}, Handle#handle{rules = (Rules ++ CurrentRules)}, Dict)}; 297 | {error, Reason} -> 298 | damocles_lib:log("Failed to apply rule for ~p -> ~p: ~p", [Ip1, Ip2, Reason]), 299 | error 300 | end. 301 | 302 | remove_all_rules_between_node_and_nodesets(NodeIp, NodeIpSet, HandleDict) -> 303 | IpHandleSets = lists:flatten([ [{NodeIp, X, dict:fetch({NodeIp, X}, HandleDict) }, {X, NodeIp, dict:fetch({X, NodeIp}, HandleDict)}] || X <-NodeIpSet ]), 304 | Result = 305 | lists:foldl( 306 | fun 307 | ({Ip1, Ip2, Handle}, {Acc, AccDict}) -> 308 | case Handle#handle.rules of 309 | [] -> {Acc, AccDict}; 310 | _ -> 311 | case damocles_lib:delete_packet_rules(Handle#handle.id) of 312 | ok -> {Acc, dict:store({Ip1, Ip2}, Handle#handle{rules = []}, AccDict)}; 313 | {error, Reason} -> damocles_lib:log("Failed to remove rules for ~p -> ~p: ~p", [Ip1, Ip2, Reason]), {[{Ip1, Ip2} | Acc], AccDict} 314 | end 315 | end 316 | end, {[], HandleDict}, IpHandleSets), 317 | case Result of 318 | {[], NewDict} -> {ok, NewDict}; 319 | {Failed, NewDict} -> {error, Failed, NewDict} 320 | end. 321 | 322 | 323 | 324 | interface_sets([_]) -> []; 325 | interface_sets([H | T]) when T /= []-> 326 | [{H, T}] ++ interface_sets(T). -------------------------------------------------------------------------------- /src/damocles_sup.erl: -------------------------------------------------------------------------------- 1 | -module(damocles_sup). 2 | -behaviour(supervisor). 3 | 4 | -export([start_link/0]). 5 | -export([init/1]). 6 | 7 | start_link() -> 8 | _ = damocles_lib:teardown_traffic_control(), 9 | supervisor:start_link({local, ?MODULE}, ?MODULE, []). 10 | 11 | init([]) -> 12 | Procs = [{damocles, {damocles, start_link, []}, transient, 5000, worker, [damocles_server]}], 13 | {ok, {{one_for_one, 1, 5}, Procs}}. 14 | --------------------------------------------------------------------------------