System object

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

    Informational public methods:

        doing_poll()                    Get doing poll
        new_user_class()                Get the new user class
        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

    Public methods to perform actions:

        new_remote_template(s)          Reserve a new remote verb template
        removed_remote_template(s)      Unreserve remote verb template
        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)
        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

    Connection-object methods:

        connection_starting()           Indicates connection received

    Private methods:

        new_connection()                Make a new connection object

parent root
object sys

var root name 'sys
var sys admins []
var sys new_user_class $admin
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

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.
        catch ~socket, ~bind {
            bind(server_port, $sys);
        } with handler {
            log("Can't bind to server port.");
            shutdown();
        }

        // Initialize variables and log startup message.
        .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();
    bind(server_port, current_receiver);
.

method doing_poll
    return doing_poll;
.

method set_doing_poll
    arg s;

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

method new_user_class
    return new_user_class;
.

method set_new_user_class
    arg obj;

    if (!.is_admin(sender()))
        throw(~perm, "Sender not an admin.");
    if (!obj.has_ancestor($user))
        throw(~type, "Argument is not a user object.");
    new_user_class = obj;
.

method create_user
    arg name, password;
    var user;

    if (caller() != $connection && !.is_admin(sender()))
        throw(~perm, "Caller is not $connection and sender is not an admin.");

    // Create a new user object.
    catch any {
        user = new_user_class.spawn();
        user.set_vr_name(name);
        user.set_password(password);
        user.del_owner(this());
    } with handler {
        if (user) {
            (| user.destroy() |);
            user = 0;
        }
        rethrow(error());
    }
    return user;
.

method connection_starting
    if (caller() != $connection)
        throw(~perm, "Caller is not $connection.");
    .new_connection();
.

method admins
    return admins;
.

method is_admin
    arg obj;

    return (obj == $sys || obj in admins) ? 1 | 0;
.

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() != $root)
        throw(~perm, "Caller is not $root.");
    (> chparents(sender(), parents) <);
.

method spawn_sender
    arg suffix, owner;
    var namestr;

    if (caller() != $root)
        throw(~perm, "Caller is not $root.");
    namestr = tostr(sender().name()) + "_" + suffix;
    return .create_object([sender()], tosym(namestr), owner);
.

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

    if (!.is_admin(sender()))
        throw(~perm, "Sender not an admin");
    new = create(parents);
    catch any {
        new.set_name(name);
        new.initialize();
        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() != $root)
        throw(~perm, "Caller is not $root.");
    del_name(sender().name());
    destroy(sender());
.

method remote_verb_templates
    return dict_keys(remote_templates);
.

method new_remote_template
    arg template;
    var objects;

    if (caller() != $verb)
        throw(~perm, "Caller is not $verb.");
    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() != $verb)
        throw(~perm, "Caller is not $verb.");
    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 user_going_away
    if (caller() != $user)
        throw(~perm, "Caller is not $user.");
    connected_users = setremove(connected_users, 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 (!.is_admin(sender()))
        throw(~perm, "Sender 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 (task_queue && 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");
    log("Doing backup");
    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.");
    if (time < 1)
        throw(~time, "Time is negative.");
    task = [time() + 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])
            min = 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_queue[min]);
        i = min;
    }
    task_queue = sublist(task_queue, 1, len - 1);
.

method ps
    var output, task, line;

    if (!.is_admin(sender()))
        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 (!.is_admin(sender()))
        throw(~perm, "Sender not an admin");
    backup_interval = val;
.

method sender_data
    var output, i;

    if (caller() != $root)
        throw(~perm, "Caller is not $root.");
    return data(sender());
.

method starting_room
    return starting_room;
.

method set_starting_room
    arg obj;

    if (!.is_admin(sender()))
        throw(~perm, "Sender not an admin");
    if (!obj.has_ancestor($room))
        throw(~room, "Object is not a room.");
    starting_room = obj;
.

method exit_starting_room
    return exit_starting_room;
.

method set_exit_starting_room
    arg obj;

    if (!.is_admin(sender()))
        throw(~perm, "Sender not an admin");
    if (!obj.has_ancestor($room))
        throw(~room, "Object is not a room.");
    starting_room = obj;
.

method assign_name
    arg name;

    if (caller() != $root)
        throw(~perm, "Caller is not $root.");
    if ((| get_name(name) |) != ~namenf)
        throw(~perm, "Name already assigned to " + tostr(get_name(name)));
    set_name(name, sender());
.

method deassign_name
    arg name;

    if (caller() != $root)
        throw(~perm, "Caller is not $root.");
    del_name(name);
.

method new_admin
    if (caller() != $admin)
        throw(~perm, "Caller is not $admin.");
    admins = setadd(admins, sender());
.

method admin_going_away
    if (caller != $admin)
        throw(~perm, "Caller is not $admin.");
    admins = setremove(admins, sender());
.

eval
    .initialize();
.