Wizard Utilities (#26)(an instance of Generic Utilities Package made by The_Mayor)Wizard Utilities ---------------- The following functions are substitutes for various server builtins. Anytime one feel tempted to use one of the expressions on the right, use the corresponding one on the left instead. This will take care of various things that the server (for whatever reason) does not handle. :set_programmer(object) object.programmer = 1; chparent object to $prog send mail to $prog_log :set_player(object[,nochown]) set_player_flag(object,1); set player flag, add name/aliases to $player_db, and maybe do a self chown. :unset_player(object[,newowner]) set_player_flag(object,0); unset player flag, remove name/aliases from $player_db chown to newowner if given :set_owner(object, newowner) object.owner = newowner; change ownership on object change ownership on all +c properties juggle .ownership_quotas :set_property_owner(object, property, newowner) change owner on a given property if this is a -c property, we change the owner on all descendants for which this is also a -c property. Polite protest if property is +c and newowner != object.owner. :set_property_flags(object, property, flags) change the permissions on a given property and propagate these to *all descendants*. property ownership is changed on descendants where necessary. VERB SOURCE CODE: set_programmer:
":set_programmer(victim[,mail from]) => 1 or error.";
"Sets victim.programmer, chparents victim to $prog if necessary, and sends mail to
$new_prog_log, mail is from optional second arg or caller_perms().";
whodunnit = caller_perms();
mailfrom = (length(args) == 2) ? args[2] | whodunnit;
if (!whodunnit.wizard)
return E_PERM;
elseif (!(valid(victim = args[1]) && (is_player(victim) && $object_utils:isa(victim,
$player))))
return E_INVARG;
elseif (victim.programmer)
return E_NONE;
elseif (victim in this.programmer_restricted)
return E_INVARG;
elseif (typeof(e = victim.programmer = 1) == ERR)
return e;
else
$quota_utils:adjust_quota_for_programmer(victim);
if (!$object_utils:isa(victim, $prog))
if (typeof(e = chparent(victim, $prog)) == ERR)
"...this isn't really supposed to happen but it could...";
player:notify(tostr("chparent(", victim, ",", $prog, ") failed: ", e));
player:notify("Check for common properties.");
endif
else
player:notify(tostr(victim.name, " was already a child of ", parent(victim).name,
" (", parent(victim), ")"));
endif
$mail_agent:send_message(mailfrom, {$new_prog_log, victim}, tostr("@programmer
", victim.name, " (", victim, ")"), tostr("I just gave ", victim.name, " a programmer
bit."));
return 1;
endif
.
set_player:
":set_player(victim[,nochown]) => 1 or error";
"Set victim's player flag, (maybe) chown to itself, add name and aliases to $player_db.";
" E_NONE == already a player,";
" E_NACC == player_db is frozen,";
" E_RECMOVE == name is unavailable";
if (!caller_perms().wizard)
return E_PERM;
elseif (!(valid(victim = args[1]) && $object_utils:isa(victim, $player)))
return E_INVARG;
elseif (is_player(victim))
return E_NONE;
elseif ($player_db.frozen)
return E_NACC;
elseif (!$player_db:available(name = victim.name))
return E_RECMOVE;
else
set_player_flag(victim, 1);
if ($object_utils:isa(victim, $prog))
victim.programmer = 1;
else
victim.programmer = $player.programmer;
endif
if (!{@args, 0}[2])
$wiz_utils:set_owner(victim, victim);
endif
$player_db:insert(name, victim);
for a in (setremove(aliases = victim.aliases, name))
if (index(a, " "))
"..ignore ..";
elseif ($player_db:available(a) in {this, 1})
$player_db:insert(a, victim);
else
aliases = setremove(aliases, a);
endif
endfor
victim.aliases = setadd(aliases, name);
return 1;
endif
.
set_owner:
":set_owner(object,newowner[,suspendok]) does object.owner=newowner, taking care
of c properties as well. This should be used anyplace one is contemplating doing
object.owner=newowner, since the latter leaves ownership of c properties unchanged.
(--Rog thinks this is a server bug).";
if (!valid(object = args[1]))
return E_INVIND;
elseif (!caller_perms().wizard)
return E_PERM;
elseif (!(valid(newowner = args[2]) && is_player(newowner)))
return E_INVARG;
endif
suspendok = {@args, 0}[3];
oldowner = object.owner;
object.owner = newowner;
for pname in ($object_utils:all_properties(object))
if (suspendok && ((ticks_left() < 5000) || (seconds_left() < 2)))
suspend(0);
endif
perms = property_info(object, pname)[2];
if (index(perms, "c"))
set_property_info(object, pname, {newowner, perms});
endif
endfor
if ($object_utils:isa(oldowner, $player))
if (is_player(oldowner) && (object != oldowner))
$quota_utils:reimburse_quota(oldowner, object);
endif
if (typeof(oldowner.owned_objects) == LIST)
oldowner.owned_objects = setremove(oldowner.owned_objects, object);
endif
endif
if ($object_utils:isa(newowner, $player))
if (object != newowner)
$quota_utils:charge_quota(newowner, object);
endif
if (typeof(newowner.owned_objects) == LIST)
newowner.owned_objects = setadd(newowner.owned_objects, object);
endif
endif
return 1;
.
set_property_owner:
":set_property_owner(object,prop,newowner[,suspendok]) changes the ownership of
object.prop to newowner. If the property is !c, changes the ownership on all of
the descendents as well. Otherwise, we just chown the property on the object itself
and give a warning if newowner!=object.owner (--Rog thinks this is a server bug that
one is able to do this at all...).";
if (!caller_perms().wizard)
return E_PERM;
elseif (!(info = property_info(object = args[1], pname = args[2])))
"... handles E_PROPNF and invalid object errors...";
return info;
elseif (!is_player(newowner = args[3]))
return E_INVARG;
elseif (index(info[2], "c"))
if ({@args, 0}[4] / 2)
"...(recursive call)...";
"...child property is +c while parent is -c??...RUN AWAY!!";
return E_NONE;
else
set_property_info(object, pname, listset(info, newowner, 1));
return (newowner == object.owner) || E_NONE;
endif
else
set_property_info(object, pname, listset(info, newowner, 1));
if ((suspendok = {@args, 0}[4] % 2) && ((ticks_left() < 10000) || (seconds_left()
< 2)))
suspend(0);
endif
suspendok = 2 + suspendok;
for c in (children(object))
this:set_property_owner(c, pname, newowner, suspendok);
endfor
return 1;
endif
.
unset_player:
":unset_player(victim[,newowner]) => 1 or error";
"Reset victim's player flag, chown victim to newowner (if given), remove all of victim's
names and aliases from $player_db.";
if (!caller_perms().wizard)
return E_PERM;
elseif (!valid(victim = args[1]))
return E_INVARG;
elseif (!is_player(victim))
return E_NONE;
endif
if (length(args) >= 2)
$wiz_utils:set_owner(victim, args[2]);
endif
victim.programmer = 0;
victim.wizard = 0;
set_player_flag(victim, 0);
if ($player_db.frozen)
player:tell("Warning: player_db is in the middle of a :load().");
endif
$player_db:delete2(victim.name, victim);
for a in (victim.aliases)
$player_db:delete2(a, victim);
endfor
return 1;
.
set_property_flags:
":set_property_flags(object,prop,flags[,suspendok]) changes the permissions on object.prop
to flags. Unlike a mere set_property_info, this changes the flags on all descendant
objects as well. We also change the ownership on the descendent properties where
necessary.";
object = args[1];
pname = args[2];
flags = args[3];
suspendok = {@args, 0}[4];
perms = caller_perms();
if (!(info = property_info(object, pname)))
"... handles E_PROPNF and invalid object errors...";
return info;
elseif ($set_utils:difference($string_utils:char_list(flags), {"r", "w", "c"}))
"...not r, w, or c?...";
return E_INVARG;
elseif ((pinfo = property_info(parent(object), pname)) && (flags != pinfo[2]))
"... property doesn't actually live here...";
"... only allowed to correct so that this property matches parent...";
return E_INVARG;
elseif (!(perms.wizard || (info[1] == perms)))
"... you have to own the property...";
return E_PERM;
elseif (!(((!(c = index(flags, "c"))) == (!index(info[2], "c"))) || $perm_utils:controls(perms,
object)))
"... if you're changing the c flag, you have to own the object...";
return E_PERM;
else
if (c)
set_property_info(object, pname, {object.owner, kflags = flags});
else
set_property_info(object, pname, kflags = listset(info, flags, 2));
endif
for kid in (children(object))
this:_set_property_flags(kid, pname, kflags, suspendok);
endfor
return 1;
endif
.
_set_property_flags:
"_set_property_flags(object, pname, {owner, flags} or something+\"c\", suspendok)";
"auxiliary to :set_property_flags... don't call this directly.";
if (caller != this)
return E_PERM;
endif
if (args[4] && $command_utils:running_out_of_time(0))
suspend(0);
endif
object = args[1];
if (typeof(args[3]) != LIST)
set_property_info(object, args[2], {object.owner, args[3]});
else
set_property_info(@args[1..3]);
endif
for kid in (children(object))
this:_set_property_flags(@listset(args, kid, 1));
endfor
.
random_password:
"Generate a random password of length args[1]. Alternates vowels and consonants,
for maximum pronounceability. Uses its own list of consonants which exclude F and
C and K to prevent generating obscene sounding passwords.";
vowels = "aeiouy";
consonants = "bdghjlmnpqrstvwxz";
len = tonum(args[1]);
if (len)
alt = random(2) - 1;
s = "";
for i in [1..len]
s = s + (alt ? vowels[random(6)] | consonants[random(17)]);
alt = !alt;
endfor
return s;
else
return E_INVARG;
endif
.
queued_tasks:
":queued_tasks(player) => list of queued tasks for that player.";
"shouldn't the server builtin should work this way? oh well";
set_task_perms(caller_perms());
if (typeof(e = set_task_perms(who = args[1])) == ERR)
return e;
elseif (who.wizard)
tasks = {};
for t in (queued_tasks())
if (t[5] == who)
tasks = {@tasks, t};
endif
endfor
return tasks;
else
return queued_tasks();
endif
.
isnewt:
"Return 1 if args[1] is a newted player. 0 if not, or if some error. Maybe should
do better in the error case. Feel free :-)";
if (!caller_perms().wizard)
return E_PERM;
else
"return verb_code($wiz_utils, \"newt_confunc\") == verb_code(args[1], \"confunc\")";
return verb_info(args[1], "confunc")[1].wizard && (!args[1].wizard);
endif
.
newt_confunc:
player:notify_lines({"", $login:newt_registration_string(), ""});
set_task_perms(this);
boot_player(player);
.
initialize_owned:
if (!caller_perms().wizard)
return E_PERM;
else
player:tell("Beginning initialize_owned: ", ctime());
for n in [0..tonum(max_object())]
o = toobj(n);
if (valid(o))
if ($object_utils:isa(owner = o.owner, $player) && (typeof(owner.owned_objects)
== LIST))
owner.owned_objects = setadd(owner.owned_objects, o);
endif
endif
$command_utils:suspend_if_needed(0);
endfor
player:tell("Done adding, beginning verification pass.");
this:verify_owned_objects();
player:tell("Finished: ", ctime());
endif
.
verify_owned_objects:
if (!caller_perms().wizard)
return E_PERM;
else
for p in (players())
if (typeof(p.owned_objects) == LIST)
for o in (p.owned_objects)
if (((typeof(o) != OBJ) || (!valid(o))) || (o.owner != p))
p.owned_objects = setremove(p.owned_objects, o);
if (((typeof(o) == OBJ) && valid(o)) && (typeof(o.owner.owned_objects)
== LIST))
o.owner.owned_objects = setadd(o.owner.owned_objects, o);
endif
endif
$command_utils:suspend_if_needed(0);
endfor
endif
endfor
endif
.
connected_wizards:
":connected_wizards() => list of currently connected wizards and players mentioned
in .public_identity properties as being wizard counterparts.";
wizzes = $object_utils:leaves($wiz);
wlist = {};
for w in (wizzes)
if (w.wizard)
if (connected_seconds(w))
wlist = setadd(wlist, w);
endif
if (connected_seconds(w.public_identity))
wlist = setadd(wlist, w.public_identity);
endif
endif
endfor
return wlist;
.
all_wizards:
":all_wizards() => list of all wizards and players mentioned in .public_identity
properties as being wizard counterparts.";
wizzes = $object_utils:leaves($wiz);
wlist = {};
for w in (wizzes)
if (w.wizard)
if (is_player(w))
wlist = setadd(wlist, w);
endif
if (is_player(w.public_identity))
wlist = setadd(wlist, w.public_identity);
endif
endif
endfor
return wlist;
.
rename_all_instances:
":rename_all_instances(object,oldname,newname)";
"Used to rename all instances of an unwanted verb (like recycle or disfunc)";
"if said verb is actually defined on the object itself";
if (caller_perms().wizard)
found = 0;
object = args[1];
objverb = args[1..2];
newname = args[3];
while (info = verb_info(@objverb))
set_verb_info(@objverb, listset(info, newname, 3));
found = 1;
endwhile
return found;
else
return E_PERM;
endif
.
missed_help:
miss = args[1];
if (!(index = miss in this.missed_help_strings))
this.missed_help_strings = {miss, @this.missed_help_strings};
this.missed_help_counters = {{0, 0}, @this.missed_help_counters};
index = 1;
endif
which = args[2] ? 2 | 1;
this.missed_help_counters[index][which] = this.missed_help_counters[index][which]
+ 1;
.
show_missing_help:
mhs = this.missed_help_strings;
cnt = this.missed_help_counters;
"save values first, so subsequent changes during suspends wont affect it";
thresh = args ? args[1] | 5;
strs = {};
for i in [1..length(mhs)]
$command_utils:suspend_if_needed(0);
if ((cnt[i][1] + cnt[i][2]) > thresh)
strs = {@strs, ((($string_utils:right(tostr(cnt[i][1]), 5) + " ") + $string_utils:right(tostr(cnt[i][2]),
5)) + " ") + mhs[i]};
endif
endfor
sorted = $list_utils:sort_suspended(0, strs);
len = length(sorted);
player:tell(" miss ambig word");
for x in [1..len]
$command_utils:suspend_if_needed(0);
player:tell(sorted[(len - x) + 1]);
endfor
player:tell(" - - - - - - - - -");
.
init_for_core:
if (caller_perms().wizard)
pass();
this.missed_help_counters = this.missed_help_strings = {};
endif
.
show_netwho_listing:
":show_netwho_listing(tell,player_list)";
" prints a listing of the indicated players showing connect sites.";
if (!caller_perms().wizard)
return E_PERM;
endif
who = args[1];
if (!(unsorted = args[2]))
return;
endif
su = $string_utils;
alist = {};
footnotes = {};
nwidth = length("Player name");
for u in (unsorted)
$command_utils:suspend_if_needed(0);
if (u.programmer)
pref = "% ";
footnotes = setadd(footnotes, "prog");
else
pref = " ";
endif
if (u in connected_players())
lctime = ctime(time() - connected_seconds(u));
where = connection_name(u);
else
lctime = ctime(u.last_connect_time);
where = u.last_connect_place;
endif
name = u.name;
if (length(name) > 15)
name = name[1..13] + "..";
endif
u3 = {tostr(pref, u.name, " (", u, ")"), lctime[5..10] + lctime[20..24]};
nwidth = max(length(u3[1]), nwidth);
where = $string_utils:connection_hostname(where);
if ($login:blacklisted(where))
where = "(*) " + where;
footnotes = setadd(footnotes, "black");
elseif ($login:graylisted(where))
where = "(+) " + where;
footnotes = setadd(footnotes, "gray");
endif
alist = {@alist, {@u3, where}};
endfor
alist = $list_utils:sort_alist_suspended(0, alist, 3);
$command_utils:suspend_if_needed(0);
headers = {"Player name", "Last Login", "From Where"};
before = {0, nwidth + 3, (nwidth + length(ctime(0))) - 11};
tell1 = " " + headers[1];
tell2 = " " + su:space(headers[1], "-");
for j in [2..3]
tell1 = su:left(tell1, before[j]) + headers[j];
tell2 = su:left(tell2, before[j]) + su:space(headers[j], "-");
endfor
who:notify(tell1);
who:notify(tell2);
for a in (alist)
$command_utils:suspend_if_needed(0);
tell1 = a[1];
for j in [2..3]
tell1 = su:left(tell1, before[j]) + a[j];
endfor
who:notify(tell1[1..min(length(tell1), 79)]);
endfor
if (footnotes)
who:notify("");
if ("prog" in footnotes)
who:notify(" % == programmer.");
endif
if ("black" in footnotes)
who:notify("(*) == blacklisted site.");
endif
if ("gray" in footnotes)
who:notify("(+) == graylisted site.");
endif
endif
.
show_netwho_from_listing:
":show_netwho_from_listing(tell,site)";
"@net-who from hoststring prints all players who have connected from that host or
host substring. Substring can include *'s, e.g. @net-who from *.foo.edu.";
if (!caller_perms().wizard)
return E_PERM;
endif
tellwho = args[1];
su = $string_utils;
if (!index(where = args[2], "*"))
"Oh good... search for users from a site... the fast way. No wild cards.";
nl = 0;
bozos = {};
sites = $site_db:find_all_keys(where);
while (sites)
s = sites;
sites = {};
for domain in (s)
for b in ($site_db:find_exact(domain))
if (typeof(b) == STR)
sites = setadd(sites, (b + ".") + domain);
else
bozos = setadd(bozos, b);
nl = max(length(tostr(b, (valid(b) && is_player(b)) ? b.name
| "*** recreated ***")), nl);
endif
endfor
endfor
endwhile
if (bozos)
tellwho:notify(tostr(su:left(" Player", nl + 7), "From"));
tellwho:notify(tostr(su:left(" ------", nl + 7), "----"));
for who in (bozos)
st = su:left(tostr((valid(who) && is_player(who)) ? (who.programmer ?
"% " | " ") + who.name | "", " (", who, ")"), nl + 7);
comma = 0;
if ($object_utils:isa(who, $player) && is_player(who))
for p in ({who.email_address || "*Unregistered*", @who.all_connect_places})
if (comma && (length(p) >= (78 - length(st))))
tellwho:notify(tostr(st, ","));
st = su:space(nl + 7) + p;
else
st = tostr(st, comma ? ", " | "", p);
endif
comma = 1;
$command_utils:suspend_if_needed(0);
endfor
else
st = st + (valid(who) ? "*** recreated ***" | "*** recycled ***");
endif
tellwho:notify(st);
endfor
tellwho:notify("");
tellwho:notify(tostr(length(bozos), " player", (length(bozos) == 1) ? ""
| "s", " found."));
else
tellwho:notify(tostr("No sites matching `", where, "'"));
endif
else
"User typed 'from'. Go search for users from this site. (SLOW!)";
howmany = 0;
for who in (players())
$command_utils:suspend_if_needed(0);
matches = {};
for name in (who.all_connect_places)
if ((index(where, "*") && su:match_string(name, where)) || ((!index(where,
"*")) && index(name, where)))
matches = {@matches, name};
endif
endfor
if (matches)
howmany = howmany + 1;
tellwho:notify(tostr(who.name, " (", who, "): ", su:english_list(matches)));
endif
endfor
tellwho:notify(tostr(howmany || "No", " matches found."));
endif
.
check_player_request check_reregistration:
":check_player_request(name [,email [,connection]])";
" check if the request for player and email address is valid;";
" return empty string if it valid, or else a string saying why not.";
" The result starts with - if this is a 'send email, don't try again' situation.";
":check_reregistration(who, email, connection)";
" Since name is ignored, only check the 'email' parts and use the first arg";
" for the re-registering player.";
if (!caller_perms().wizard)
return E_PERM;
"accesses registration information -- wiz only";
endif
name = args[1];
if (verb == "check_reregistration")
"don't check player name";
elseif (!name)
return "A blank name isn't allowed.";
elseif (name == "<>")
return "Names with angle brackets aren't allowed.";
elseif (index(name, " "))
return "Names with spaces are not allowed. Use dashes or underscores.";
elseif (match(name, "^<.*>$"))
return tostr("Try using ", name[2..length(name) - 1], " instead of ", name, ".");
elseif ($player_db.frozen)
return "New players cannot be created at the moment, try again later.";
elseif (!$player_db:available(name))
return ("The name '" + name) + "' is not available.";
elseif ($login:_match_player(name) != $failed_match)
return ("The name '" + name) + "' doesn't seem to be available.";
endif
if (length(args) == 1)
"no email address supplied.";
return "";
endif
address = args[2];
addrargs = (verb == "check_reregistration") ? {name} | {};
if ($registration_db:suspicious_address(address, @addrargs))
return "-There has already been a character with that or a similar email address.";
endif
if (reason = $network:invalid_email_address(address))
return reason + ".";
endif
parsed = $network:parse_address(address);
if ($registration_db:suspicious_userid(parsed[1]))
return tostr("-Automatic registration from an account named ", parsed[1], " is
not allowed.");
endif
connection = (length(args) > 2) ? args[3] | parsed[2];
if ((connection[max(length(connection) - 2, 1)..length(connection)] == ".uk") &&
(parsed[2][1..3] == "uk."))
return tostr("Addresses must be in internet form. Try ", parsed[1], "@", $string_utils:from_list($list_utils:reverse($string_utils:explode(parsed[2],
".")), "."), ".");
elseif (match(connection, "^[0-9.]+$"))
return "-The system cannot resolve the name of the system you're connected from.";
elseif ((a = $network:local_domain(connection)) != (b = $network:local_domain(parsed[2])))
return tostr("-The connection is from '", a, "' but the mail address is '", b,
"'; these don't seem to be the same place.");
elseif ($login:spooflisted(parsed[2]))
return tostr("-Automatic registration is not allowed from ", parsed[2], ".");
endif
return "";
.
make_player:
"create a player named NAME with email address ADDRESS; return {object, password}.";
"assumes $wiz_utils:check_player_request() has been called and it passes.";
if (!caller_perms().wizard)
return E_PERM;
endif
name = args[1];
address = args[2];
new = create($player_class, $nothing);
new.name = name;
new.aliases = {name};
new.password = crypt(password = $wiz_utils:random_password(6));
new.last_connect_time = $maxint;
"Last disconnect time is creation time, until they login.";
new.last_disconnect_time = time();
$quota_utils:initialize_quota(new);
if (!(ERR = $wiz_utils:set_player(new)))
return player:tell("An error, ", ERR, " occurred while trying to make ", new,
" a player. The database is probably inconsistent.");
endif
new.email_address = address;
$registration_db:add(new, address, @args[3..length(args)]);
move(new, $player_start);
new.programmer = $player_class.programmer;
if (r = $local.request_board:find_req(name))
$local.request_board:rem_req(r);
endif
return {new, password};
.
osend_new_player_mail:
":send_new_player_mail(preface, name, address, character#, password)";
" used by $wiz:@make-player and $guest:@request";
if (!caller_perms().wizard)
return E_PERM;
endif
preface = args[1];
name = args[2];
address = args[3];
new = args[4];
password = args[5];
msg = {preface};
msg = {@msg, tostr("A character has been created, with name \"", name, "\" and password
\"", password, "\". (Passwords are case sensitive.)")};
msg = {@msg, tostr($network.moo_name, " is at ", $network.site, ", port ", $network.port,
".")};
msg = {@msg, "Read the help if you haven't used MOO before. A tutorial available
through the @tutorial command. Try paging the character HELP if you can't find what
you need in the help system or tutorial."};
msg = {@msg, "A programmer's manual and various other pieces of documentation are
available via ftp from ", " parcftp.xerox.com, directory /pub/MOO"};
msg = {@msg, "Keep your password secure; do not let anyone else connect as you. Remember,
you are responsible for what your character does. If you no longer want your character,
do not give it to anyone else. You can change your password after you connect with
the @password command."};
msg = {@msg, "After you connect, type `help manners' in order to see the policy on
the code of conduct expected."};
msg2 = {};
for x in (msg)
msg2 = {@msg2, "", @$generic_editor:fill_string(x, 75)};
endfor
return $network:sendmail(address, (("Your " + $network.moo_name) + " character, ")
+ name, "Reply-to: " + $login.registration_address, @msg2);
.
do_make_player:
"do_maker_player(name,email,[comment])";
"Common code for @make-player";
"If no password is given, generates a random password for the player.";
"Email-address is stored in $registration_db and on the player object.";
if (!caller_perms().wizard)
return E_PERM;
endif
name = args[1];
email = args[2];
comments = $string_utils:from_list(args[3..length(args)], " ");
reason = $wiz_utils:check_player_request(name, email);
if (others = $registration_db:find_exact(email))
player:notify(email + " is the registered address of the following characters:");
for x in (others)
player:notify(tostr(valid(x[1]) ? x[1].name | "
do_register:
"do_register(name, email_address [,comments])";
"change player's email address.";
if (!caller_perms().wizard)
return E_PERM;
endif
whostr = args[1];
email = args[2];
comments = $string_utils:from_list(args[3..length(args)]);
whostr = args[1];
who = $string_utils:match_player(whostr);
if ($command_utils:player_match_failed(who, whostr))
return;
endif
if (((whostr != who.name) && (!(whostr in who.aliases))) && (whostr != tostr(who)))
player:notify(tostr("Must be a full name or an object number: ", who.name, "(",
who, ")"));
return;
endif
if (reason = $network:invalid_email_address(email))
player:notify(reason);
if (!$command_utils:yes_or_no("Register anyway?"))
return player:notify("re-registration aborted.");
endif
endif
if (comments)
$registration_db:add(who, email, comments);
else
$registration_db:add(who, email);
endif
old = who.email_address;
who.email_address = email;
player:notify(tostr(who.name, " (", who, ") formerly ", old ? old | "unregistered",
", registered at ", email, ". ", comments ? (" [" + comments) + "]" | ""));
.
do_new_password:
"do_new_password(who, [password])";
if (!caller_perms().wizard)
return E_PERM;
endif
whostr = args[1];
who = $string_utils:match_player(whostr);
if ($command_utils:player_match_failed(who, whostr))
return;
endif
if (((whostr != who.name) && (!(whostr in who.aliases))) && (whostr != tostr(who)))
player:notify(tostr("Must be a full name or an object number: ", who.name, "(",
who, ")"));
return;
endif
whostr = $string_utils:nn(who);
player:notify(tostr("About to change password for ", whostr, ". Old encrypted password
is \"", who.password, "\""));
if ((length(args) > 1) && (password = args[2]))
password = args[2];
else
password = $wiz_utils:random_password(6);
endif
who.password = crypt(password);
player:notify(tostr(whostr, " new password is `", password, "'."));
if (!who.email_address)
player:notify(tostr(whostr, " doesn't have a registered email_address, cannot
mail password; tell them some some other way."));
elseif ((who.last_connect_time == $maxint) && $command_utils:yes_or_no(tostr(who.name,
" has never logged in. Send mail with the password as though this were a new player
request?")))
if ((result = $wiz_utils:send_new_player_mail(tostr("From ", player.name, "@",
$network.moo_name, ":"), who.name, who.email_address, who, password)) == 0)
player:tell("Mail sent.");
else
player:tell("Trouble sending mail: ", result);
endif
elseif ($command_utils:yes_or_no(tostr("Email new password to ", whostr, "?")))
player:notify("Sending the password via email.");
if ((result = $network:sendmail(who.email_address, ("Your " + $network.moo_name)
+ " password", ("The password for your " + $network.moo_name) + " character:", "
" + whostr, "has been changed. The new password is:", " " + password, "", "Please
note that passwords are case sensitive.")) == 0)
player:tell("Mail sent.");
else
player:tell("Trouble sending mail: ", result);
endif
else
player:tell("No mail sent.");
endif
.
send_new_player_mail:
":send_new_player_mail(preface, name, address, character#, password)";
" used by $wiz:@make-player and $guest:@request";
if (!caller_perms().wizard)
return E_PERM;
endif
preface = args[1];
name = args[2];
address = args[3];
new = args[4];
password = args[5];
msg = {preface};
msg = {@msg, tostr("A character has been created, with name \"", name, "\" and password
\"", password, "\". (Passwords are case sensitive.)")};
msg = {@msg, tostr($network.moo_name, " can be reached by \"telnet ", $network.site,
" ", $network.port, "\" or with a MUD client.")};
msg = {@msg, "Keep your password secure; do not let anyone else connect as you. Remember,
you are responsible for what your character does. If you no longer want your character,
do not give it to anyone else. You can change your password after you connect with
the @password command."};
msg2 = {};
for x in (msg)
msg2 = {@msg2, "", @$generic_editor:fill_string(x, 75)};
endfor
return $network:sendmail(address, (("Your " + $network.moo_name) + " character, ")
+ name, "Reply-to: " + $login.registration_address, @msg2);
.
PROPERTY DATA: default_programmer_quota default_player_quota missed_help_strings missed_help_counters programmer_restricted |