@prog cmd-@banguest
1 9999 d
1 i
( cmd-@banguest   v1.0    Jessy@FurryMUCK     7/01
  
  This modified version of cmd-@bansite only applies to guests.
  
  INSTALLATION:
  
  Set the program Wizard. Create a global action, with a name such as
  @banguest, and link it to the program.
  
  cmd-@banguest uses a property to identify guest chars. To ensure 
  proper use, edit the $def GUEST_PROP statement below this header comment
  to match a property that is set on each of the Guest chars on your MUCK.
  Set a property on the Guest chars if needed.
  
  Set the program Link_OK, and set a property in the global _connect/
  queue to call the program at logon:
  
    @propset #0=dbref:_connect/banguest:<#dbref of program>
  
  USAGE:
  
  Same as the conventional @bansite command, but the results will be
  ignored for non-guest players.
  
  This program may be freely ported.
)
  
$def GUEST_PROP "@guest/player?"
  
$def BannedPropdir "@banned/"
$def BannedPropdirLoc #0
  
: site-is-banned? (iDescr -- iTrue?)
    conhost BannedPropdir swap strcat
    BannedPropdirLoc BannedPropdir
    begin
        over swap nextprop dup
    while
        3 pick over smatch if
            pop pop pop 1 exit
        then
    repeat
    pop pop pop 0
;
  
: boot-banned-connects ( -- )
    me @ descriptors
    begin
        dup
    while
        1 - swap descrcon dup
        site-is-banned? if
            dup "Sorry, but connections from that site are not allowed."
            connotify conboot
        else pop
        then
    repeat
;
  
: list-banned-sites ( -- )
    me @ "Banned sites:" notify
    BannedPropdirLoc BannedPropdir
    begin
        over swap nextprop dup
    while
        "  " over strcat
        me @ swap notify
    repeat
    pop pop
    me @ "Done." notify
;
  
$def .tell me @ swap notify
: show-help ( -- )
    "@bansite v1.0  Written 11/11/93 by Foxen" .tell
    "----------------------------------------------------------------" .tell
    "@bansite SITENAME    Prevents logins from the given site." .tell
    "@bansite !SITENAME   Re-allows logins from the given site." .tell
    "@bansite #list       Lists all the sites that are banned." .tell
    "@bansite #help       Displays this screen." .tell
    "----------------------------------------------------------------" .tell
    "NOTE: Sitenames can be wildcard patterns.  ie: *.uloser.edu" .tell
;
  
: main
    "me" match me !
    me @ GUEST_PROP getprop not if exit then
    preempt
    command @ "Queued event." stringcmp not if
        pop boot-banned-connects exit
    then
    me @ "wizard" flag? not if
        me @ "Permission denied." notify
        pop exit
    then
    strip
    dup "#list" stringcmp not if
        pop list-banned-sites exit
    then
    dup "#help" stringcmp not if
        pop show-help exit
    then
    dup "!" 1 strncmp not if
        1 strcut swap pop
        BannedPropdirLoc BannedPropdir rot strcat
        over over getpropstr if
            remove_prop "Site unbanned."
        else
            pop pop "That site was not banned."
        then
        me @ swap notify
    else
        BannedPropdirLoc BannedPropdir rot strcat
        over over getpropstr if
            pop pop "That site is already banned."
        else
            "banned" 0 addprop "Site banned."
        then
        me @ swap notify
    then
;
.
c
q
@register #me cmd-@bansite=tmp/prog1
@register #prop #0:_connect/ cmd-@bansite=bansite
@set $tmp/prog1=W
@set $tmp/prog1=L
@set $tmp/prog1=3
@action @bansite=#0=tmp/exit1
@link $tmp/exit1=$tmp/prog1