IRC guest list allowing users to invite themselves

# guestlist.tcl
#
# Copyright (c) 2004 Jochen "Y0Gi" Kupperschmidt <http://homework.nwsnet.de/>
# Version: 19-Aug-2004
# Released under the terms of the MIT License.
#
# Manages a list of users who may be invited to a channel
# and provides a trigger for them to allow inviting
# themselves.  Out of the box, the script is adjusted to
# be used on Quakenet (http://www.quakenet.org/) and
# examines the host of registered users.
#
# Usage:
#   (end user) invite:      /msg YourBotNick invitemeplease
#   (admin) list users:     /msg YourBotNick guestlist list
#   (admin) add a user:     /msg YourBotNick guestlist add SomeUsername
#   (admin) remove a user:  /msg YourBotNick guestlist del SomeUsername

# configuration
set channel "#somechannel"
set suffix ".users.quakenet.org"
set userfile "guestlist.$channel.users"
set logfile  "guestlist.$channel.log"

# triggers
bind msg - "invitemeplease" gl:msg:invite
bind msg -|m "guestlist" gl:msg:guestlist

proc gl:msg:invite { nick host hand text } {
    global suffix botnick channel logfile
    set reply ""
    set authed [regexp ".+@(.+)$suffix" $host tmp qnetauth]
    if { !$authed } {
        set reply "You did not mask your hostname on Quakenet (+x)."
        set result "not authed/masked."
    } elseif { [lsearch -exact [gl:load_users] $qnetauth] == -1 } {
        set reply "You are not allowed to get invited."
        set result "denied."
    } elseif { ![onchan $botnick $channel] } {
        set reply "Sorry, I'm not on the channel."
        set result "bot not on channel."
    } elseif { ![botisop $channel] } {
        set reply "Sorry, I'm not operator on the channel."
        set result "bot not opped."
    } else {
        set reply "Welcome! You have been invited."
        puthelp "INVITE $nick $channel"
        putserv "PRIVMSG $channel :\001ACTION invited $nick ($host) by his/her request.\001"
        set result "invited."
    }
    if { $reply != "" } {
        puthelp "PRIVMSG $nick :$reply"
    }
    set time [clock format [clock seconds] -format "%Y-%m-%d %H:%M:%S"]
    set log [open $logfile a]
    puts $log "$time: $nick ($host) - $result"
    close $log
    return 0
}

proc gl:msg:guestlist { nick host hand text } {
    global datafile
    set msgs [list]
    set action [lindex $text 0]
    set user [lindex $text 1]
    if { [file exists $datafile] } {
        set users [gl:load_users]
    } else {
        lappend msgs "Data file not found, it will be created."
        set users [list]
    }
    if { $action == "list" } {
        lappend msgs "Users:\n"
        foreach user $users {
            lappend msgs "- $user\n"
        }
        lappend msgs "End of list."
    } elseif { $action == "add" } {
        if { $user == "" } {
            lappend msgs "No username given."
        } elseif { [lsearch -exact $users $user] == -1 } {
            lappend users $user
            gl:save_users $users
            lappend msgs "User added."
            putlog "guestlist: user \"$user\" added."
        } else {
            lappend msgs "User already listed."
        }
    } elseif { $action == "del" } {
        if { $user == "" } {
            lappend msgs "No username given."
        } else {
            set found [lsearch -exact $users $user]
            if { $found == -1 } {
                lappend msgs "User not found."
            } else {
                gl:save_users [lreplace $users $found $found]
                lappend msgs "User deleted."
                putlog "guestlist: user \"$user\" deleted."
            }
        }
    }
    foreach msg $msgs {
        puthelp "NOTICE $nick :$msg"
    }
    return 0
}

proc gl:load_users { } {
    global datafile
    set users [list]
    if { [file exists $datafile] } {
        set fs [open $datafile r]
        while { ![eof $fs] } {
            gets $fs line
            if { $line != "" } {
                lappend users $line
            }
        }
        close $fs
    }
    return $users
}

proc gl:save_users { users } {
    global datafile
    set fs [open $datafile w]
    foreach user $users {
        if { $user != "" } {
            puts $fs "$user"
        }
    }
    close $fs
}

putlog "guestlist.tcl loaded."