1/*  File:    paxos/udp_broadcast.pl
    2    Author:  Roy Ratcliffe
    3    WWW:     https://github.com/royratcliffe
    4    Created: Jun 12 2021
    5    Purpose: Paxos UDP Broadcast
    6
    7Copyright (c) 2021, Roy Ratcliffe, Northumberland, United Kingdom
    8
    9Permission is hereby granted, free of charge,  to any person obtaining a
   10copy  of  this  software  and    associated   documentation  files  (the
   11"Software"), to deal in  the   Software  without  restriction, including
   12without limitation the rights to  use,   copy,  modify,  merge, publish,
   13distribute, sublicense, and/or sell  copies  of   the  Software,  and to
   14permit persons to whom the Software is   furnished  to do so, subject to
   15the following conditions:
   16
   17    The above copyright notice and this permission notice shall be
   18    included in all copies or substantial portions of the Software.
   19
   20THE SOFTWARE IS PROVIDED "AS IS", WITHOUT  WARRANTY OF ANY KIND, EXPRESS
   21OR  IMPLIED,  INCLUDING  BUT  NOT   LIMITED    TO   THE   WARRANTIES  OF
   22MERCHANTABILITY, FITNESS FOR A PARTICULAR   PURPOSE AND NONINFRINGEMENT.
   23IN NO EVENT SHALL THE AUTHORS  OR   COPYRIGHT  HOLDERS BE LIABLE FOR ANY
   24CLAIM, DAMAGES OR OTHER LIABILITY,  WHETHER   IN  AN ACTION OF CONTRACT,
   25TORT OR OTHERWISE, ARISING FROM,  OUT  OF   OR  IN  CONNECTION  WITH THE
   26SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
   27
   28*/
   29
   30:- module(paxos_udp_broadcast,
   31          [ paxos_udp_broadcast_initialise/0
   32          ]).   33:- autoload(library(paxos), [paxos_initialize/1]).   34:- autoload(library(udp_broadcast), [udp_broadcast_initialize/2]).   35:- autoload(library(socket), [tcp_host_to_address/2]).   36:- use_module(library(settings), [setting/4, setting/2]).

Paxos on UDP

Sets up Paxos over UDP broadcast on port 20005. Hooks up Paxos messaging to UDP broadcast bridging using the paxos scope.

Initialisation order affects success. First initialises UDP broadcasting then initialises Paxos. The result is two additional threads: the UDP inbound proxy and the Paxos replicator.

You can override the UDP host, port and broadcast scope. Load settings first if you want to override using file-based settings. Back-up defaults derive from the environment and finally fall on hard-wired values of 0.0.0.0, port 20005 via paxos scope. You can also override the automatic Paxos node ordinal; it defaults to -1 meaning automatic discovering of unique node number. Numbers start at 0 and increase by one, translating to binary power indices for the quorum bit mask.

Note that environment defaults require upper-case variable names for Linux. Variable names match case-sensitively on Unix platforms.

Docker Stack

For Docker in production mode, your nodes want to interact using the UDP broadcast port. This port is not automatically available unless you publish it. See example snippet below. The ports setting lists port 20005 for UDP broadcasts across the stack.

version: "3"

services:

  my-service:
    image: my/image
    ports:
      - 20005:20005/udp
      - 8080:8080/tcp

*/

   79:- setting(host, atom, env('PAXOS_UDP_BROADCAST_HOST', '0.0.0.0'),
   80           'UDP broadcast host for Paxos').   81:- setting(port, nonneg, env('PAXOS_UDP_BROADCAST_PORT', 20005),
   82           'UDP broadcast port for Paxos').   83:- setting(node, integer, env('PAXOS_UDP_BROADCAST_NODE', -1),
   84           'UDP broadcast node for Paxos').   85:- setting(scope, atom, env('PAXOS_UDP_BROADCAST_SCOPE', paxos),
   86           'UDP broadcast scope for Paxos').   87
   88:- multifile paxos:paxos_message_hook/3.   89
   90paxos:paxos_message_hook(A, -, udp(Scope, A)) :- !, setting(scope, Scope).
   91paxos:paxos_message_hook(A, B, udp(Scope, A, B)) :- setting(scope, Scope).
   92
   93paxos_udp_broadcast_initialise :-
   94    setting(host, Host),
   95    setting(port, Port),
   96    setting(scope, Scope),
   97    tcp_host_to_address(Host, Address),
   98    udp_broadcast_initialize(Address, [port(Port), scope(Scope)]),
   99    findall(PaxosOption, paxos_option(PaxosOption), PaxosOptions),
  100    paxos_initialize(PaxosOptions).
  101
  102paxos_option(node(Node)) :- setting(node, Node), Node >= 0