System object

    The system object has access to administrative functions and
    receives messages from the server.

    Informational public methods:

        doing_poll()                    Get doing poll
        users()                         Get a list of all users
        connected_users()               Get a list of connected users
        new_user_class()                Get the new user class
        find_user(name)                 Search for a user by name
        admins()                        Get a list of admins
        is_admin(obj)                   True if obj is an admin
        remote_verb_templates()         Get remote verb templates
        backup_interval()               The backup interval, in seconds
        followers(protocol)             Objects which follow a protocol
        agents(protocol)                Agents of a protocol

    Public methods to perform actions:

        new_remote_template(s)          Reserve a new remote verb template
        removed_remote_template(s)      Unreserve remote verb template
        register_new_user_name()        Registers name of new user
        user_changed_name(old_name)     Indicates user changed name
        user_has_disconnected()         Indicates user disconnected

    Methods called from the root object:

        change_sender_parents(parents)  Change parents of sender
        spawn_sender(num)               Create a child of sender numbered num
        destroy_sender()                Destroy the sender

    Server methods:

        startup(args)                   Received from server

    Admin methods:

        set_doing_poll(s)               Set doing poll
        set_new_user_class(obj)         Set the new user class
        create_user(name, password)     Create a new user (also for logins)
        add_admin(obj)                  Add an admin
        binary_dump()                   Do a binary dump
        text_dump()                     Do a text dump
        shutdown()                      Shut down the server
        set_heartbeat_freq()            Set the heartbeat frequency, in seconds
        set_backup_interval()           Set the backup interval, in seconds

    Login methods:

        login_starting()                Indicates login is starting
        login_gone()                    Indicates login is going away
        login(obj)                      Indicates login successfully occurred

    Private methods:

        new_connection()                Make a new connection object

parent root
object sys

var sys connected_users []
var sys users [$user, $builder, $programmer]
var sys user_names #[]
var sys admins [$sys, $programmer1]
var sys new_user_class $programmer
var sys starting_room $nowhere
var sys exit_starting_room $void
var sys doing_poll "Doing"
var sys remote_templates #[]
var sys server_port 0
var sys current_receiver 0
var sys task_queue []
var sys backup_interval 3600
var sys last_backup 0
var sys followers #[]
var sys agents #[]

eval
    .initialize();
    .set_name("System object");
.

method startup
    arg args;
    var ind, str, obj;

    catch any {
        if (sender() != 0)
            throw(~perm, "Sender is not the server.");

        // Get rid of any lingering connection objects.
        for obj in ($connection.children())
            obj.destroy();

        // Look for a port specification.
        ind = "-p" in sublist(args, 1, listlen(args) - 1);
        server_port = ind ? toint(args[ind + 1]) | 6666;

        // Bind to the port, or something close to it.
        catch ~socket, ~bind {
            bind(server_port, $sys);
        } with handler {
            log("Can't bind to server port.");
            shutdown();
        }

        // Initialize variables and log startup message.
        connected_users = [];
        .new_connection();
        log("Server starting on port " + tostr(server_port) + ".");

        // Set up five-second heartbeat.
        set_heartbeat_freq(5);
    } with handler {
        for str in (traceback())
            log("STARTUP: " + str);
    }
.

method new_connection
    if (sender() != this() || caller() != definer())
        throw(~perm, "Invalid call to private method.");
    current_receiver = $connection.spawn("(A login object)");
    bind(server_port, current_receiver);
.

method doing_poll
    return doing_poll;
.

method set_doing_poll
    arg s;

    if (!(sender() in admins))
        throw(~perm, "Sender not an admin.");
    if (type(s) != 'string)
        throw(~type, "Argument not a string.");
    doing_poll = s;
.

method users
    return users;
.

method connected_users
    return connected_users;
.

method new_user_class
    return new_user_class;
.

method set_new_user_class
    arg obj;

    if (!(sender() in admins))
        throw(~perm, "Sender not an admin.");
    if (type(obj) != 'dbref)
        throw(~type, "First argument (" + toliteral(obj) + ") not a dbref.");
    new_user_class = obj;
.

method find_user
    arg name;

    catch ~keynf {
        return user_names[name];
    } with handler {
        throw(~usernf, "User not found.");
    }
.

method create_user
    arg name, password;
    var user;

    if (!(caller().is_agent('connection) || sender() in admins))
        throw(~perm, "Sender is not a connection object or admin.");
    user = new_user_class.spawn(name);
    user.set_password(password);
    user.del_owner(this());
    user.move($nowhere);
    users = setadd(users, user);
    return user;
.

method connection_starting
    if (!caller().is_agent('connection))
        throw(~perm, "Caller is not an agent of connection protocol.");
    .new_connection();
.

method user_logged_in
    if (!caller().is_agent('user))
        throw(~perm, "Sender is not an agent of user protocol.");
    connected_users = setadd(connected_users, sender());
.

method user_logged_out
    if (!caller().is_agent('user))
        throw(~perm, "Caller is not an agent of user protocol.");
    connected_users = setremove(connected_users, sender());
.

method admins
    return admins;
.

method is_admin
    arg obj;

    return obj in admins ? 1 | 0;
.

method add_admin
    arg user;

    if (!$sys.is_admin(sender()))
        throw(~perm, "Sender is not an admin.");
    admins = [@admins, user];
.

method binary_dump
    if (!$sys.is_admin(sender()))
        throw(~perm, "Sender is not an admin.");
    return binary_dump();
.

method text_dump
    if (!$sys.is_admin(sender()))
        throw(~perm, "Sender is not an admin.");
    return text_dump();
.

method shutdown
    if (!$sys.is_admin(sender()))
        throw(~perm, "Sender is not an admin.");
    return shutdown();
.

method change_sender_parents
    arg parents;
    var p;

    if (!caller().is_agent('hierarchy))
        throw(~perm, "Caller not the root object.");

    // Check if objects want to be parents.
    for p in (parents) {
        if (!p.ok_to_inherit(sender()))
            throw(~perm, toliteral(p) + " refused to be a parent.");
    }
    (> chparents(sender(), parents) <);
.

method change_sender_parents_back
    arg parents;

    // If an init after a chparents fails, we want to be able to go back to the
    // old parents without checking if they want to be parents.
    if (!caller().is_agent('hierarchy))
        throw(~perm, "Caller not the root object.");
    (> chparents(sender(), parents) <);
.

method spawn_sender
    arg num, owner, name;
    var last, dbref;

    if (!caller().is_agent('hierarchy))
        throw(~perm, "Caller not not an agent of hierarchy prototocol.");
    if (type(num) != 'integer)
        throw(~type, "First argument is not an integer.");
    dbref = tostr(sender());
    last = substr(dbref, strlen(dbref));
    if (last >= "0" && last <= "9")
        dbref = dbref + "_";
    dbref = dbref + tostr(num);
    return .create_object(todbref(dbref), [sender()], name, owner);
.

method create_object
    arg dbref, parents, name, owner;
    var new;

    if (!(sender() in admins))
        throw(~perm, "Sender not an admin");
    new = create(dbref, parents);
    catch any {
        new.initialize();
        new.set_name(name);
        new.del_owner(this());
        new.add_owner(owner);
    } with handler {
        // Failed to initialize the child; destroy it.
        (| new.uninit() |);
        destroy(new);
        rethrow(error());
    }
    return new;
.

method destroy_sender
    if (!caller().is_agent('hierarchy))
        throw(~perm, "Caller not an agent of hierarchy protocol");
    destroy(sender());
.

method remote_verb_templates
    return dict_keys(remote_templates);
.

method new_remote_template
    arg template;
    var objects;

    if (!caller().is_agent('verb))
        throw(~perm, "Caller not an agent of verb protocol");
    if (type(template) != 'string)
        throw(~type, "Template not a string");
    if (dict_contains(remote_templates, template))
        objects = remote_templates[template];
    else
        objects = [];
    objects = setadd(objects, sender());
    remote_templates = dict_add(remote_templates, template, objects);
.

method removed_remote_template
    arg template;
    var objects;

    if (!caller().is_agent('verb))
        throw(~perm, "Caller not an agent of verb protocol");
    if (!dict_contains(remote_templates, template))
        return;
    objects = remote_templates[template];
    objects = setremove(ojects, sender());
    if (objects)
        remote_templates = dict_add(remote_templates, template, objects);
    else
        remote_templates = dict_del(remote_templates, template);
.

method register_new_user_name
    if (!caller().is_agent('user_names))
        throw(~perm, "Caller not an agent of user names protocol.");
    user_names = dict_add(user_names, sender().name(), sender());
.

method user_changed_name
    arg old_name;

    if ((| user_names[old_name] |) != sender())
        throw(~perm, "Old name doesn't belong to sender.");
    user_names = dict_del(user_names, old_name);
    user_names = dict_add(user_names, sender().name(), sender());
.

method log
    arg str;

    log(str);
.

method log_traceback
    arg traceback;
    var s;

    for s in (traceback)
        log(s);
.

method connect
    arg [args];

    if (!(caller() in admins))
        throw(~perm, "Caller not an admin");
    return (> connect(@args) <);
.

method heartbeat
    var task;

    if (sender() != 0)
        throw(~perm, "Sender not the server");
    if (time() / backup_interval > last_backup / backup_interval)
        .do_backup();
    while (listlen(task_queue) > 0 && time() > task_queue[1][1]) {
        task = task_queue[1];
        (| task[2].(task[3])(@task[4]) |);
        .remove_first_task();
    }
.

method do_backup
    if (sender() != this() || caller() != definer())
        throw(~perm, "Invalid call to private method");
    text_dump();
    last_backup = time();
.

method schedule_task
    arg time, method, args;
    var task, i;

    if (type(time) != 'integer || type(method) != 'symbol || type(args) != 'list)
        throw(~type, "Arguments are not an integer, symbol, and list.");
    task = [time, sender(), method, args];
    task_queue = task_queue + [task];
    i = listlen(task_queue);
    while (i > 1 && task[1] < task_queue[i / 2][1]) {
        task_queue = replace(task_queue, i, task_queue[i / 2]);
        i = i / 2;
    }
    task_queue = replace(task_queue, i, task);
.

method remove_first_task
    var len, i, min;

    if (sender() != this() || caller() != definer())
        throw(~perm, "Invalid call to private method");
    len = listlen(task_queue);
    i = 1;
    while (i != len) {
        min = len;
        if (i * 2 < len && task_queue[i * 2][1] < task_queue[min][1])
            max = i * 2;
        if (i * 2 + 1 < len && task_queue[i * 2 + 1][1] < task_queue[min][1])
            min = i * 2 + 1;
        task_queue = replace(task_queue, i, task[min]);
        i = min;
    }
    task_queue = sublist(task_queue, 1, len - 1);
.

method ps
    var output, task, line;

    if (!(sender() in admins))
        throw(~perm, "Sender not an admin.");
    output = [pad("Seconds", 20) + pad("Object", 20) + "Method"];
    output = output + [pad("-------", 20) + pad("------", 20) + "------"];
    for task in (task_queue) {
        line = pad(tostr(task[1] - time()), 18) + "  ";
        line = line + pad(toliteral(task[2]), 18) + "  ";
        line = line + tostr(task[3]);
        output = output + [line];
    }
    return output;
.

method backup_interval
    return backup_interval;
.

method set_backup_interval
    arg val;

    if (!(sender() in admins))
        throw(~perm, "Sender not an admin");
    backup_interval = val;
.

method followers
    arg protocol;

    return dict_contains(followers, protocol) ? followers[protocol] | [];
.

method agents
    arg protocol;

    return dict_contains(agents, protocol) ? agents[protocol] | [];
.

method trust
    arg obj, protocol, type;
    var l;

    if (!(sender() in admins))
        throw(~perm, "Sender not an admin");
    if (type(obj) != 'dbref || type(protocol) != 'symbol)
        throw(~type, "Object and protocol are not a dbref and a symbol.");
    if (type == 'follow) {
        l = setadd(.followers(protocol), obj);
        followers = dict_add(followers, protocol, l);
    } else if (type == 'agent) {
        l = setadd(.agents(protocol), obj);
        agents = dict_add(agents, protocol, l);
    } else {
        throw(~type, "Type is not 'agent or 'follow.");
    }
.

method untrust
    arg obj, protocol;

    if (!(sender() in admins))
        throw(~perm, "Sender not an admin");
    if (obj in .followers(protocol)) {
        l = setremove(followers[protocol], obj);
        if (l)
            followers = dict_add(followers, protocol, l);
        else
            followers = dict_del(followers, protocol);
    }
    if (obj in .agents(protocol)) {
        l = setremove(agents[protocol], obj);
        if (l)
            agents = dict_add(agents, protocol, l);
        else
            agents = dict_del(agents, protocol);
    }
.

method sender_data
    var output, i;

    if (!caller().is_agent('hierarchy))
        throw(~perm, "Caller not an agent of hierarchy protocol");
    return data(sender());
.

method starting_room
    return starting_room;
.

method set_starting_room
    arg obj;

    if (!(sender() in admins))
        throw(~perm, "Sender not an admin");
    if (!obj.follows('starting_room))
        throw(~protocol, "Sender doesn't follow starting room protocol");
    starting_room = obj;
.

method exit_starting_room
    return exit_starting_room;
.

method set_exit_starting_room
    arg obj;

    if (!(sender() in admins))
        throw(~perm, "Sender not an admin");
    if (!obj.follows('exit_starting_room))
        throw(~protocol, "Sender doesn't follow starting room protocol");
    starting_room = obj;
.

eval
    .trust($user, 'user, 'agent);
    .trust($root, 'hierarchy, 'agent);
    .trust($sys, 'hierarchy, 'agent);
    .trust($verbs, 'verb, 'agent);
    .trust($container, 'container, 'follow);
    .trust($room, 'room, 'follow);
    .trust($located, 'located, 'follow);
    .trust($located, 'movement, 'agent);
    .trust($user, 'user_names, 'agent);
    .trust($nowhere, 'starting_room, 'follow);
    .trust($void, 'exit_starting_room, 'follow);
    .trust($exit, 'exit, 'agent);
    .trust($connection, 'connection, 'agent);
.