Registration Database (#18)

return ((caller == this) || caller_perms().wizard) ? pass(@args) | E_PERM;
.

":add(player,email[,comment])";
if (!caller_perms().wizard)
    return E_PERM;
endif
who = args[1];
email = args[2];
comment = args[3..length(args)];
l = this:find_exact(email);
if (l == $failed_match)
    this:insert(email, {{who, @comment}});
elseif (i = $list_utils:iassoc(who, l))
    this:insert(email, listset(l, {who, @comment}, i));
else
    this:insert(email, {@l, {who, @comment}});
endif
.

if (caller_perms().wizard)
    pass();
    this:clearall();
    this.registrar = #2;
endif
.

"suspicious(address [,who])";
"Determine whether an address appears to be another player in disguise.";
"returns a list of similar addresses.";
"If second argument given, then if all similar addresses are held by that";
"person, let it pass---they're just switching departments at the same school";
"or something.";
"";
"at the moment,";
"  foo@bar.baz.bing.boo";
"is considered 'similar' to anything matching";
"  foo@*.bing.boo";
if (!caller_perms().wizard)
    return E_PERM;
endif
allowed = (length(args) > 1) ? args[2] | #-1;
parsed = $network:parse_address(address = args[1]);
userid = parsed[1];
site = parsed[2];
exact = (!site) && this:find_exact(address);
if (!site)
    site = $network.site;
endif
site = $network:local_domain(site);
sitelen = length(site);
others = this:find_all_keys(userid + "@");
for other in (others)
    if (other[max(1, (length(other) - sitelen) + 1)..length(other)] != site)
        others = setremove(others, other);
    endif
endfor
if (exact)
    others = listinsert(others, address);
endif
for x in (others)
    allzapped = 1;
    for y in (this:find_exact(x))
        if ((((length(y) == 2) && ((y[2] == "zapped due to inactivity") || (y[2] 
== "toaded due to inactivity"))) || (y[1] == allowed)) || (($object_utils:has_property($local, 
"second_char_registry") && (typeof(them = $local.second_char_registry:other_chars(y[1])) 
== LIST)) && (allowed in them)))
            "let them change to the address if it is them, or if it is a registered 
char of theirs.";
            "Hrm. Need typeof==LIST check because returns E_INVARG for shared characters. 
bleah Ho_Yan 5/8/95";
        else
            allzapped = 0;
        endif
    endfor
    if (allzapped)
        others = setremove(others, x);
    endif
endfor
return others;
.

"suspicious_userid(userid)";
"Return yes if userid is root or postmaster or something like that.";
return args[1] in {"", "sysadmin", "root", "postmaster", "bin", "SYSTEM", "OPERATOR"};
"Thinking about ruling out hyphenated names, on the grounds that they're probably 
mailing lists.";
.

"Returns a list of strings describing the registration data for an email address. 
 Args[1] should be the result of this:find.";
result = {};
for x in (args[1])
    name = (valid(x[1]) && is_player(x[1])) ? x[1].name | "";
    email = (valid(x[1]) && is_player(x[1])) ? x[1].email_address | "";
    result = {@result, tostr("  ", name, " (", x[1], ") current email: ", email, 
(length(x) > 1) ? (" [" + x[2]) + "]" | "")};
endfor
return result;
.

"My attempt at some housekeeping, Dredful 2/17/94";
"Useful for finding dual occurences of a player object. For finding 2nd chars as 
$registration_db thinks of them. Probably when we begin reaping, this will help too";
":get_player(OBJ)=>{{STR email, LIST players & comments}, {...}...}";
if (!caller_perms().wizard)
    return E_PERM;
endif
who = args[1];
found = {};
for prop in ({" ", @setremove(properties(this), "registrar")})
    for datum in [1..length((l = this.(prop))[4])]
        if ($list_utils:iassoc(who, l[4][datum]))
            found = {@found, {l[3][datum], l[4][datum]}};
        endif
    endfor
endfor
return found;
.