@create $daemon called Mancala Daemon,MD

;(me:my_match_object("MD")).description=$command_utils:read()
The Mancala game daemon

@prop MD."games" {} ""
@prop MD."players" {} ""
@prop MD."users" {} ""
@prop MD."logins" {} ""
@prop MD."RuleSets" {{"Midgard", 1, 1}} rc
@prop MD."boards" {{{4, 4, 4, 4, 4, 4, 0}, {4, 4, 4, 4, 4, 4, 0}}} rc
@prop MD."server_options" #255 rc
@prop MD."connect_timeout" 0 rc
@prop MD."history" {} ""
@set MD."ListenPort" to 4848
@set MD."service" to "Mancala"
@set MD."version" to "1.1"

@verb MD:"Read" this none this rxd
@program MD:Read
if (caller != this)
  return E_PERM;
endif
if (args && typeof(args[1]) == OBJ)
  player = args[1];
endif
`set_connection_option(player, "hold-input", 1) ! ANY';
line = `read(player) ! ANY';
this:debug("RECV[", player, "]: ", line);
`set_connection_option(player, "hold-input", 0) ! ANY';
if (line == E_INVARG)
  if (!(this.connections = $set_utils:intersection(connected_players(1), setremove(this.connections, player))))
    this.busy = 0;
  endif
  return 0;
endif
return line;
.

@verb MD:"close" this none this rxd
@program MD:close
if (caller != this)
  return E_PERM;
endif
this:send(tostr(@args));
this:logout();
boot_player(player);
if (!(this.connections = $set_utils:intersection(connected_players(1), setremove(this.connections, player))))
  this.busy = 0;
endif
.

@verb MD:"Handle_Request" this none this rxd
@program MD:Handle_Request
if (caller != this)
  return E_PERM;
endif
{verb, Query, @args} = $string_utils:words(QueryString = args[1]);
if (Query == "RULESET")
  if (ruleset = $list_utils:assoc(args[1], this.rulesets))
    this:send("+ ", $string_utils:from_list(ruleset, " "));
    return 1;
  else
    this:send("- Unable to provide ruleset definitions. Sorry.");
    return 0;
  endif
elseif (Query == "BOARD")
  playeri = $list_utils:iassoc(player, this.logins);
  gamei = this.logins[playeri][3];
  game = this.games[gamei];
  {players, ruleset, board, turn} = game;
  if (player in players == 1)
    this:send("! BOARD ", $string_utils:from_list(board[1], " "), " ", $string_utils:from_list(board[2], " "));
  else
    this:send("! BOARD ", $string_utils:from_list(board[2], " "), " ", $string_utils:from_list(board[1], " "));
  endif
elseif (Query == "USERS")
  available = {};
  for who in (this.logins)
    if (!who[3] && who[1] != player)
      available = {@available, who[2]};
    endif
    $command_utils:suspend_if_needed(0);
  endfor
  this:send("! USERS ", $string_utils:from_list(available, " "));
  return 1;
elseif (Query == "PLAY")
  playeri = $list_utils:iassoc(player, this.logins, 1);
  whoi = $list_utils:iassoc(args[1], this.logins, 2);
  if (!whoi)
    this:send("- Player not found.");
    return 0;
  endif
  this:send(who = this.logins[whoi][1], "? PLAY ", this.logins[playeri][2]);
  reply = this:read(who);
  if (reply[1] == "+")
    this:send("+ Game accepted");
    if (ruleset = this:NegotiateRuleset(playeri, whoi))
      this.games = {@this.games, game = {{playeri, whoi}, ruleset, board = this:NewBoard(ruleset), move = random(2)}};
      this:send("! PLAY");
      this:expect("+");
      this:send(who, "! PLAY");
      this:expect(who, "+");
      this:send("! BOARD ", $string_utils:from_list(board[1], " "), " ", $string_utils:from_list(board[2], " "));
      this:expect("+");
      this:send(who, "! BOARD ", $string_utils:from_list(board[2], " "), " ", $string_utils:from_list(board[1], " "));
      this:expect(who, "+");
      this:send({player, who}[move], "! MOVE");
      this:expect({player, who}[move], "+");
      this.logins[playeri][3] = length(this.games);
      this.logins[whoi][3] = length(this.games);
      return 1;
    endif
  else
    this:send("- Game rejected");
  endif
elseif (Query == "RESIGN")
  playeri = $list_utils:iassoc(player, this.logins, 1);
  whoi = $list_utils:iassoc(args[1], this.logins, 2);
  if (!this.logins[playeri][3])
    this:send("- You're not playing at the moment.");
    return 0;
  endif
  this:send(who = this.logins[whoi][1], "? RESIGN");
  reply = this:read(who);
  if (reply[1] == "+")
    this:send("+ Resignation accepted");
    gamei = this.logins[playeri][3];
    this.logins[this.games[gamei][1][1]][3] = 0;
    this.logins[this.games[gamei][1][2]][3] = 0;
    this.games[gamei] = {};
    for i in [0..(l = length(this.games)) - 1]
      if (this.games[l - i] == {})
        this.games = this.games[1..l - (i + 1)];
      else
        break;
      endif
      $command_utils:suspend_if_needed(0);
    endfor
    return 1;
  else
    this:send("- Resignation rejected");
  endif
else
  this:send("- Unknown query");
  return 0;
endif
.

@verb MD:"Handle_Input" this none this rxd
@program MD:Handle_Input
if (caller != this)
  return E_PERM;
endif
{input} = args;
if (!input)
  return 0;
elseif (input[1] == "!")
  return this:handle_command(input);
elseif (input[1] == "?")
  return this:handle_request(input);
else
  return 1;
endif
.

@verb MD:"Handle_Command" this none this rxd
@program MD:Handle_Command
if (caller != this)
  return E_PERM;
endif
{verb, Command, @args} = $string_utils:words(args[1]);
if (Command == "QUIT")
  this:close("+ Closing connection.");
  return E_NONE;
elseif (Command == "LOGIN")
  if (i = $list_utils:assoc(player, this.logins))
    this:send("- You are already logged in as ", i[2]);
    return 0;
  elseif (`{username, password} = args ! E_ARGS' == E_ARGS)
    this:send("- Usage:  ! LOGIN <username> <password>");
    return 0;
  elseif (!(i = $list_utils:iassoc(username, this.users, 1)) || crypt(password, this.users[i][2][1..2]) != this.users[i][2])
    this:send("- Unknown user or invalid password");
    return 0;
  endif
  if (i = $list_utils:iassoc(username = this.users[i][1], this.logins, 2))
    this.logins[i][1] = player;
  else
    this.logins = {@this.logins, {player, username, 0}};
  endif
  this:send("+ Logged in.");
  return 1;
elseif (Command == "CREATE")
  if (i = $list_utils:assoc(player, this.logins))
    this:send("- You are already logged in as ", i[2]);
    return 0;
  elseif (`{username, password} = args ! E_ARGS' == E_ARGS)
    this:send("- Usage:  ! CREATE <username> <password>");
    return 0;
  elseif ($list_utils:iassoc(username, this.users, 1))
    this:send("- User already exists");
    return 0;
  endif
  this.users = {@this.users, {username, crypt(password)}};
  this.logins = {@this.logins, {player, username, 0}};
  this:send("+ Logged in.");
  return 1;
elseif (Command == "MOVE")
  return this:EvaluateMove(@args);
else
  this:send("- Unknown command");
  return 0;
endif
.

@verb MD:"logout" this none this rxd
@program MD:logout
if (caller != this)
  return E_PERM;
endif
if (i = $list_utils:iassoc(player, this.logins))
  login = this.logins[i];
  this.logins = listdelete(this.logins, i);
endif
if (!(this.connections = $set_utils:intersection(connected_players(1), setremove(this.connections, player))))
  this.busy = 0;
endif
.

@verb MD:"NegotiateRuleset" this none this rxd
@program MD:NegotiateRuleset
if (caller != this)
  return E_PERM;
endif
RulesetI = 1;
Ruleset = this.RuleSets[RulesetI];
{a, b} = args;
ao = this.logins[a][1];
bo = this.logins[b][1];
this:send(ao, "! RULESET ", $string_utils:from_list(Ruleset, " "));
if (this:read(ao)[1] != "+")
  return 0;
endif
this:send(bo, "! RULESET ", $string_utils:from_list(Ruleset, " "));
if (this:read(bo)[1] != "+")
  return 0;
endif
return RulesetI;
.

@verb MD:"NewBoard" this none this rxd
@program MD:NewBoard
return this.Boards[args[1]];
.

@verb MD:"EvaluateMove" this none this rxd
@program MD:EvaluateMove
if (caller != this)
  return E_PERM;
endif
playeri = $list_utils:iassoc(player, this.logins);
gamei = this.logins[playeri][3];
game = this.games[gamei];
{players, ruleset, board, turn} = game;
{ruleset, LeftOk, StealMode} = this.rulesets[ruleset];
if (turn != (playeri in players))
  this:send("- It's not your turn.");
  return 0;
endif
players = {this.logins[players[1]][1], this.logins[players[2]][1]};
if (turn == 2)
  board = {board[2], board[1]};
endif
{pit, ?direction = "RIGHT"} = args;
pit = toint(pit);
if (direction != "RIGHT" && !LeftOk)
  this:send("- You can't move that way.");
  return 0;
elseif (!board[1][pit])
  this:send("- There are no stones there.");
  return 0;
endif
this:send("+ Ok. Please wait.");
direction = direction == "LEFT" ? -1 | 1;
circle = {@board[1], @board[2][1..6]};
stones = circle[pit];
circle[pit] = 0;
for i in [1..stones]
  pit = (pit + direction) % 13;
  pit = pit == 0 ? 13 | pit;
  circle[pit] = circle[pit] + 1;
endfor
if (pit != 7 && circle[pit] == 1 && circle[14 - pit])
  if (StealMode == 1)
    if (pit < 7)
      circle[7] = circle[7] + circle[pit] + circle[14 - pit];
      circle[pit] = 0;
      circle[14 - pit] = 0;
    endif
  elseif (StealMode == 1)
    circle[7] = circle[7] + circle[pit] + circle[14 - pit];
    circle[pit] = 0;
    circle[14 - pit] = 0;
  endif
endif
board = {circle[1..7], {@circle[8..13], board[2][7]}};
if (turn == 2)
  board = {board[2], board[1]};
endif
if (pit != 7)
  turn = {2, 1}[turn];
endif
this.games[gamei][3] = board;
this.games[gamei][4] = turn;
this:send(players[1], "! LASTMOVE ", pit, " ", direction);
this:expect(players[1], "+");
this:send(players[2], "! LASTMOVE ", pit, " ", direction);
this:expect(players[2], "+");
this:send(players[1], "! BOARD ", $string_utils:from_list(board[1], " "), " ", $string_utils:from_list(board[2], " "));
this:expect(players[1], "+");
this:send(players[2], "! BOARD ", $string_utils:from_list(board[2], " "), " ", $string_utils:from_list(board[1], " "));
this:expect(players[2], "+");
if (i = {0, 0, 0, 0, 0, 0} in {board[1][1..6], board[2][1..6]})
  turn = 0;
  extra = $math_utils:sum(board[{2, 1}[i]][1..6]);
  board[{2, 1}[i]][1..6] = {0, 0, 0, 0, 0, 0};
  board[{2, 1}[i]][7] = board[{2, 1}[i]][7] + extra;
  this:send(players[1], "! BOARD ", $string_utils:from_list(board[1], " "), " ", $string_utils:from_list(board[2], " "));
  this:expect(players[1], "+");
  this:send(players[2], "! BOARD ", $string_utils:from_list(board[2], " "), " ", $string_utils:from_list(board[1], " "));
  this:expect(players[2], "+");
  winner = 0;
  if (board[1][7] > board[2][7])
    winner = 1;
  elseif (board[1][7] < board[2][7])
    winner = 2;
  endif
  this.history = {@this.history, {{this.logins[this.games[gamei][1][1]][2], this.logins[this.games[gamei][1][2]][2]}, winner, {board[1][7], board[2][7]}, time()}};
  this.logins[this.games[gamei][1][1]][3] = 0;
  this.logins[this.games[gamei][1][2]][3] = 0;
  this.games[gamei] = {};
  for i in [0..(l = length(this.games)) - 1]
    if (this.games[l - i] == {})
      this.games = this.games[1..l - (i + 1)];
    else
      break;
    endif
    $command_utils:suspend_if_needed(0);
  endfor
  this:send(players[1], "! ENDGAME ", {"TIE", "WIN", "LOSE"}[winner + 1]);
  this:expect(players[1], "+");
  this:send(players[2], "! ENDGAME ", {"TIE", "LOSE", "WIN"}[winner + 1]);
  this:expect(players[2], "+");
else
  this:send(players[turn], "! MOVE");
  this:expect(players[turn], "+");
endif
.

@verb MD:"do_login_command" this none this rxd
@program MD:do_login_command
if (callers())
  return E_PERM;
endif
if (typeof(host = `connection_name(player) ! E_INVARG') == ERR)
  boot_player(player);
  if (!(this.connections = $set_utils:intersection(connected_players(1), setremove(this.connections, player))))
    this.busy = 0;
  endif
  return;
endif
host = $string_utils:connection_hostname(host);
if ($login:redlisted(host))
  boot_player(player);
  server_log(tostr("REDLISTED: ", player, " from ", host, " to ", this));
  return 0;
elseif (!host)
  return 0;
endif
this.busy = 1;
this:debug("RECV[", player, "]: ", argstr);
if (!(player in this.connections))
  this.connections = setadd(this.connections, player);
  set_connection_option(player, "hold-input", 1);
  this:send("! SERVER ", $network.site);
  if (!(line = this:read()))
    return;
  endif
  if (line[1] != "+")
    this:send("- Invalid response. Closing connection.");
    return this:close("! QUIT");
  endif
  this:send("? IDENTIFY");
  if (!(line = this:read()))
    return;
  endif
  if (line[1] == "!")
    this:debug("Do client-specific stuff");
    this:send("+ Thank you.");
  endif
  set_connection_option(player, "hold-input", 0);
else
  if ((result = this:handle_input(argstr)) == E_NONE)
    return this:logout();
  endif
endif
.

@verb MD:"expect" this none this rxd
@program MD:expect
if (caller != this)
  return E_PERM;
endif
if (args && typeof(args[1]) == OBJ)
  player = args[1];
  args = args[2..$];
endif
line = this:read(@args);
if (typeof(line) != STR)
  return 0;
endif
if (line == "! QUIT")
  this:logout();
endif
if (index(line, args[1]) != 1)
  return 0;
endif
return 1;
.

@verb MD:"Send" this none this rxd
@program MD:Send
if (caller != this)
  return E_PERM;
endif
if (args && typeof(args[1]) == OBJ)
  player = args[1];
  args = args[2..$];
endif
notify(player, tostr(@args));
this:debug("SEND[", player, "]: ", @args);
.