This is the new home of the egghelp.org community forum.
All data has been migrated (including user logins/passwords) to a new phpBB version.


For more information, see this announcement post. Click the X in the top right-corner of this box to dismiss this message.

eggrop with qauth user management

Old posts that have not been replied to for several years.
r
r0t3n
Owner
Posts: 507
Joined: Tue May 31, 2005 6:56 pm
Location: UK

Post by r0t3n »

yep. Well atleast im the only one. Otherwise it will be script mayhem here.
r0t3n @ #r0t3n @ Quakenet
m
metroid
Owner
Posts: 771
Joined: Wed Jun 16, 2004 2:46 am

Post by metroid »

Yeah well i posted this when i was sleepy so don't blame me.
Tosser, this is seriously going too far, if you don't know how to script TCL other than simply copying things, you should really just ask your questions here, but no helping.
i
iamroot
Voice
Posts: 20
Joined: Sat Jul 09, 2005 5:47 am

Post by iamroot »

many thanks to all :-)

only the ban is not working - he kicks only but this should be enough for the moment.

Should i post here the complete script now? Maybe someone else is looking for the same.
D
Dizzle
Op
Posts: 109
Joined: Thu Apr 28, 2005 11:21 am
Contact:

Post by Dizzle »

Well if it works and you think ppl can use it, submit it too the tcl archive
i
iamroot
Voice
Posts: 20
Joined: Sat Jul 09, 2005 5:47 am

Post by iamroot »

it's currently a little bit in "quick & dirty" style so i'll put it here - maybe someone will find the time to check (eg. the kickban is not working - shouldn't be a big problem).

Code: Select all

### Q TCL 1.0.045 (C) 2003-2005 perpleXa & Zyberdog
### Q/Q9 (C) 1999-2005 Mag, MadHacker, splidge
##
### INSTALLATION
## 1. Copy this script and it's files to your scripts directory
##
## 2. Edit your eggdrop config file and add the following line to it
##    source scripts/qbot.tcl
##
## 3. Edit the dbase/chanlevs file and replace perpleXa in
##    "authname:perpleXa level:1000" with your AUTHNICK
##
## 4. Rehash your bot, the script should work.
##
### PROBLEMS
## Contact us on irc.quakenet.org / #resistless
## or visit http://perplexa.net / http://www.zyberdog.com
##
### INFO
## This script is like Q (QuakeNet)
## Get more info at http://quakenet.org/faq/faq.php?c=1
##
### IMPORTANT
## In concern of your own safety, do not name the eggdrop like something
## that can be mistaken for Q if you connect it to QuakeNet.
## It will almost guarenteed get you glined.
##
### COMMANDS
## CHANLEV          Shows or modifies user access on a channel.
## ADDCHAN          Add a channel to the bot.
## DELCHAN          Removes a channel from the bot.
## INVITE           Invites you to a channel.
## OP               Ops you on channel(s).
## VOICE            Voices you on channel(s).
## REHASH           Rehash the bot (like a regular eggdrop rehash).
## CHANGELEV        Change/view the global auth level of a user.
## HELP             Returns help for a specific command.
## SHOWCOMMANDS     Shows all commands that are available to you.
## WELCOME          Shows or changes the welcome message on a channel.
## CHANTYPE         Change/view a channel type.
##
### DO NOT CHANGE THE FOLLOWING VALUES IF NOT NECESSARY (usually not)
### Changing these might cause the script to stop working

namespace eval qbot {

  # // global variables
  variable version 1.0.045;
  variable helpdb "help/";
  variable chandb "dbase/chanlevs";
  variable server "putserv";

  # // channel specific strings
  setudef str welcome;
  setudef str addedby;
  setudef str founder;
  setudef int chantype;

  variable chantypes;
  array set chantypes {
    "1" "clan"
    "2" "league"
    "3" "private"
    "4" "special"
    "5" "gamesite"
  };

  # // binds
  bind msg  -|- chanlev          [namespace current]::chanlevmsg;
  bind msg  -|- addchan          [namespace current]::addchanmsg;
  bind msg  -|- delchan          [namespace current]::delchanmsg;
  bind msg  -|- invite           [namespace current]::invitemsg;
  bind msg  -|- op               [namespace current]::opmsg;
  bind msg  -|- voice            [namespace current]::voicemsg;
  bind msg  -|- welcome          [namespace current]::welcomemsg;
  bind msg  -|- help             [namespace current]::helpmsg;
  bind msg  -|- showcommands     [namespace current]::showcommandsmsg;
  bind msg  -|- rehash           [namespace current]::rehashmsg;
  bind msg  -|- changelev        [namespace current]::changelevmsg;
  bind msg  -|- chantype         [namespace current]::chantypemsg;

  bind join -|- *                [namespace current]::initjoin;
  bind msgm -|- *                [namespace current]::unknowncommand;
  bind raw  -|- 354              [namespace current]::getinfo;
  bind evnt -|- save             [namespace current]::save;

  # // initialize
  variable cwd [string trimright [file dirname [info script]] /]

  variable users;
  array set users "";

  variable jchans;
  array set jchans "";

  variable authlev;
  array set authlev "";

  namespace export unknowncommand initjoin chanlevmsg getinfo;
}

# // bound events

proc qbot::chanlevmsg {nick host hand args} {
  variable users;
  set arg(0) [lindex $args 0];
  set auth [auth::getname $nick];
  set chan [lindex [clean $arg(0)] 0];
  if {$auth == 0} {
    putserver "NOTICE $nick :chanlev is only available to authed users.";
    return 0;
  }
  if {$chan == ""} {
    putserver "NOTICE $nick :chanlev: Not enough parameters.";
    return 0;
  }
  if {![validchan $chan]} {
    putserver "NOTICE $nick :Channel $chan is unknown.";
    return 0;
  }
  set authlev [getauthlev $auth];
  if {[getaccess $auth amnov $chan] || ($authlev >= 950)} {
    set user [lindex [clean $arg(0)] 1];
    set flags [lindex [clean $arg(0)] 2];
    if {$user == ""} {
      if {($authlev >= 950)} {
        putserver "NOTICE $nick :Added by: [channel get $chan addedby]";
        putserver "NOTICE $nick :Original founder: [channel get $chan founder]";
      }
      putserver "NOTICE $nick :Channel type: [getchantype $chan]";
      putserver "NOTICE $nick :Known users on $chan:";
      putserver "NOTICE $nick :[format {%-15s %s} "Username" "Flags"]";
      spewallusers $chan $nick;
      putserver "NOTICE $nick :End of list.";
      putserver "NOTICE $nick :Total: [totalusers $chan]";
      return 1;
    } elseif {$flags == ""} {
      set uauth [finduser $user];
      if {$uauth == 0} {
        putserver "NOTICE $nick :Can't find that nickname."
        return 0;
      }
      if {[getaccess $uauth abmnov $chan]} {
        putserver "NOTICE $nick :$user modes on channel $chan: +[getflags $uauth $chan]";
      } else {
        putserver "NOTICE $nick :User is not known on that channel.";
      }
    } else {
      set invalidflags "";
      foreach flag [split $flags ""] {
        if {[regexp -- {^[\+\-]$} $flag]} {
          continue;
        }
        if {![string match *[clean $flag]* "abmnov"]} {
          lappend invalidflags $flag;
        }
      }
      set ilength [llength $invalidflags];
      if {$ilength} {
        putserver "NOTICE $nick :chanlev: Invalid flag[expr {($ilength == 1) ? "" : "s" }] specified: [join [
lsort -unique $invalidflags] ""]";
        return 0;
      }
      set uauth [finduser $user];
      if {$uauth == 0} {
        putserver "NOTICE $nick :Can't find that nickname."
        return 0;
      }
      if {[getaccess $auth mn $chan] || ($authlev >= 950)} {
        if {[regexp -nocase -- {[mn]} $flags naflag] && ![getaccess $auth n $chan] && ($authlev < 950)} {
          if {[string equal -nocase $naflag "m"]} {
            putserver "NOTICE $nick :You have to be owner to change a master's flags!"
            return 0;
          } else {
            putserver "NOTICE $nick :You have to be owner to change an owners flags!"
            return 0;
          }
        }
        setaccess $uauth $chan $flags;
        putserver "NOTICE $nick :Done."
      } else {
        putserver "NOTICE $nick :You have to be master to change someone's flags!"
      }
    }
  } else {
    putserver "NOTICE $nick :You do not have sufficient access on $chan to use chanlev.";
  }
}

proc qbot::addchanmsg {nick host hand args} {
  variable users;
  set arg(0) [lindex $args 0];
  set auth [auth::getname $nick];
  if {($auth == 0) || ([getauthlev $auth] < 950)} {
    putserver "NOTICE $nick :You do not have sufficient privileges to use addchan.";
    return 0;
  }
  set chan [lindex [clean $arg(0)] 0];
  set user [lindex [clean $arg(0)] 1];
  if {[validchan $chan]} {
      putserver "NOTICE $nick :addchan: $chan is already added.";
      return 0;
  }
  if {$chan == ""} {
      putserver "NOTICE $nick :addchan: Not enough parameters.";
      return 0;
  }
  if {$user == ""} {
      putserver "NOTICE $nick :addchan: Not enough parameters.";
      return 0;
  }
  set uauth [finduser $user];
  if {$uauth == 0} {
    putserver "NOTICE $nick :Unknown user $user.";
    return 0;
  }
  channel add $chan;
  channel set $chan founder $uauth;
  channel set $chan addedby $auth;
  channel set $chan chantype 0;
  set users($chan,$uauth) ano;
  putserver "NOTICE $nick :Done."
}

proc qbot::delchanmsg {nick host hand args} {
  variable users;
  set arg(0) [lindex $args 0];
  set auth [auth::getname $nick];
  set chan [lindex [clean $arg(0)] 0];
  if {($auth == 0) || ([getauthlev $auth] < 950)} {
    putserver "NOTICE $nick :You do not have sufficient privileges to use delchan.";
    return 0;
  }
  if {$chan == ""} {
    putserver "NOTICE $nick :delchan: Not enough parameters.";
    return 0;
  }
  if {![validchan $chan]} {
    putserver "NOTICE $nick :Channel $chan is unknown.";
    return 0;
  }
  foreach item [array names users] {
    if {[string match -nocase [clean $chan],* $item]} {
      unset users($item);
    }
  }
  channel remove $chan;
  putserver "NOTICE $nick :Done.";
}

proc qbot::invitemsg {nick host hand args} {
  set arg(0) [lindex $args 0];
  set auth [auth::getname $nick];
  set chan [lindex [clean $arg(0)] 0];
  if {$auth == "0"} {
    putserver "NOTICE $nick :invite is only available to authed users.";
    return 0;
  }
  if {$chan == ""} {
    putserver "NOTICE $nick :invite: Not enough parameters.";
    return 0;
  }
  if {![validchan $chan]} {
    putserver "NOTICE $nick :Channel $chan is unknown.";
    return 0;
  }
  if {[getaccess $auth mno $chan] || ($authlev >= 950)} {
    putserver "INVITE $nick $chan";
    putserver "NOTICE $nick :Done.";
  } else {
    putserver "NOTICE $nick :You do not have sufficient access on $chan to use invite.";
  }
}

proc qbot::opmsg {nick host hand args} {
  set arg(0) [lindex $args 0];
  set auth [auth::getname $nick];
  set chan [lindex [clean $arg(0)] 0];
  if {$auth == 0} {
    putserver "NOTICE $nick :op is only available to authed users.";
    return 0;
  }
  set authlev [getauthlev $auth];
  if {$chan == ""} {
    foreach chan [channels] {
      set access [getaccess $auth mno $chan];
      if {[onchan $nick $chan] && ![isop $nick $chan] && ($access || ($authlev >= 950)) && [botisop $chan]} {
        putserver "MODE $chan +o $nick";
      }
    }
    putserver "NOTICE $nick :Done.";
    retutn 1;
  }
  if {![validchan $chan]} {
    putserver "NOTICE $nick :Channel $chan is unknown.";
    return 0;
  }
  if {[getaccess $auth mno $chan] || ($authlev >= 950)} {
    putserver "MODE $chan +o $nick";
    putserver "NOTICE $nick :Done.";
  } else {
    putserver "NOTICE $nick :You do not have sufficient access on $chan to use op.";
  }
}

proc qbot::voicemsg {nick host hand args} {
  set arg(0) [lindex $args 0];
  set auth [auth::getname $nick];
  set chan [lindex [clean $arg(0)] 0];
  if {$auth == 0} {
    putserver "NOTICE $nick :voice is only available to authed users.";
    return 0;
  }
  set authlev [getauthlev $auth];
  if {$chan == ""} {
    foreach chan [channels] {
      set access [getaccess $auth mnv $chan];
      if {[onchan $nick $chan] && ![isvoice $nick $chan] && ($access || ($authlev >= 950)) && [botisop $chan]
} {
        putserver "MODE $chan +v $nick";
      }
    }
    putserver "NOTICE $nick :Done.";
    retutn 1;
  }
  if {![validchan $chan]} {
    putserver "NOTICE $nick :Channel $chan is unknown.";
    return 0;
  }
  if {[getaccess $auth mnv $chan] || ($authlev >= 950)} {
    putserver "MODE $chan +v $nick";
    putserver "NOTICE $nick :Done.";
  } else {
    putserver "NOTICE $nick :You do not have sufficient access on $chan to use voice.";
    return 0;
  }
  return 1;
}

proc qbot::welcomemsg {nick host hand args} {
  set arg(0) [lindex $args 0];
  set auth [auth::getname $nick];
  set chan [lindex [clean $arg(0)] 0];
  set msg [join [lrange [clean $arg(0)] 1 end] " "];
  if {$auth == 0} {
    putserver "NOTICE $nick :welcome is only available to authed users.";
    return 0;
  }
  set authlev [getauthlev $auth];
  if {$chan == ""} {
    putserver "NOTICE $nick :welcome: Not enough parameters.";
    return 0;
  }
  if {![validchan $chan]} {
    putserver "NOTICE $nick :Channel $chan is unknown.";
    return 0;
  }
  if {[getaccess $auth mn $chan] || ($authlev >= 950)} {
    if {$msg == ""} {
      set welcome [channel get $chan welcome];
      if {$welcome == ""} {
        putserver "NOTICE $nick :No welcome message is set on $chan";
        return 0;
      }
      putserver "NOTICE $nick :Current Welcome message is:";
      putserver "NOTICE $nick :[join $welcome " "]";
      return 1;
    }
    channel set $chan welcome $msg;
    putserver "NOTICE $nick :Done.";
  } else {
    putserver "NOTICE $nick :You do not have sufficient access on $chan to use welcome.";
    return 0;
  }
  return 1;
}

proc qbot::helpmsg {nick host hand args} {
  set arg(1) [lindex $args 0];
  set cmd [lindex [clean $arg(1)] 0];
  set auth [auth::getname $nick];
  if {$cmd == ""} {
    if {![ishelpfile global]} {
      putserver "NOTICE $nick :Sorry, no help available.";
    } else {
      putserver "NOTICE $nick :The following commands are available to you:";
      spewhelp $nick global [getauthlev $auth];
      putserver "NOTICE $nick :End of list.";
    }
  } else {
    if {![iscommand $cmd]} {
      putserver "NOTICE $nick :$cmd: Unknown command.";
    } elseif {![ishelpfile $cmd]} {
      putserver "NOTICE $nick :Sorry, no help available for [string toupper $cmd].";
    } else {
      spewhelp $nick $cmd [getauthlev $auth];
    }
  }
  return 1;
}

proc qbot::showcommandsmsg {nick host handle args} {
  set arg(1) [lindex $args 0];
  set cmd [lindex [clean $arg(1)] 0];
  set auth [auth::getname $nick];
  if {![ishelpfile global]} {
    putserver "NOTICE $nick :Sorry, no help available.";
    return;
  }
  putserver "NOTICE $nick :The following commands are available to you:";
  spewhelp $nick global [getauthlev $auth] $cmd;
  putserver "NOTICE $nick :End of list.";
  return 1;
}

proc qbot::rehashmsg {nick host hand args} {
  set arg(0) [lindex $args 0];
  set auth [auth::getname $nick];
  if {($auth == 0) || ([getauthlev $auth] < 998)} {
    putserver "NOTICE $nick :You do not have sufficient privileges to use rehash.";
    return 0;
  }
  set ccs [clock clicks];
  rehash;
  set cce [clock clicks];
  putserver "NOTICE $nick :Done. ([format "%.2f" [expr ($cce - $ccs) / 1000.0]]ms)";
  return 1;
}

proc qbot::changelevmsg {nick host hand args} {
  set arg(0) [lindex $args 0];
  set auth [auth::getname $nick];
  set lev [getauthlev $auth];
  set user [lindex [clean $arg(0)] 0];
  set newlev [lindex [clean $arg(0)] 1];
  if {($auth == 0) || ($lev < 100)} {
    putserver "NOTICE $nick :You do not have sufficient privileges to use changelev.";
    return 0;
  }
  if {$user == ""} {
    putserver "NOTICE $nick :changelev: Not enough parameters.";
    return 0;
  }
  set uauth [finduser $user];
  if {$uauth == 0} {
    putserver "NOTICE $nick :Can't find that nickname."
    return 0;
  }
  set ulev [getauthlev $uauth];
  if {$newlev == ""} {
    putserver "NOTICE $nick :Current level global auth level of $user is: $ulev"
    return 1;
  } elseif {[regexp {[^0-9]} $newlev]} {
    putserver "NOTICE $nick :Invalid level."
    return 0;
  } elseif {$lev <= $ulev} {
    putserver "NOTICE $nick :You can't change someone with a higher or equal level to your own!";
    return 0;
  } elseif {$lev <= $newlev} {
    putserver "NOTICE $nick :You can't give someone a higher or equal level to your own!";
    return 0;
  }
  setauthlev $uauth $newlev;
  putserver "NOTICE $nick :Done.";
  return 1;
}

proc qbot::chantypemsg {nick host hand args} {
  variable chantypes;
  set arg(0) [lindex $args 0];
  set auth [auth::getname $nick];
  set lev [getauthlev $auth];
  set chan [lindex [clean $arg(0)] 0];
  set chantype [lindex [clean $arg(0)] 1];
  if {($auth == 0) || ($lev < 900)} {
    putserver "NOTICE $nick :You do not have sufficient privileges to use chantype.";
    return 0;
  }
  if {$chan == ""} {
    putserver "NOTICE $nick :chantype: Not enough parameters.";
    return 0;
  }
  if {![validchan $chan]} {
    putserver "NOTICE $nick :Channel $chan is unknown.";
    return 0;
  }
  if {$chantype == ""} {
    if {[channel get $chan chantype] != ""} {
      putserver "NOTICE $nick :Current type is: [channel get $chan chantype] \[[getchantype $chan]\]";
    } else {
      putserver "NOTICE $nick :Current type not set.";
    }
  } else {
    set nr -1;
    if {[string index $chantype 0] == "#"} {
      set nr [string range $chantype 1 end];
      if {![string is digit $nr] || [string equal $nr ""]} {
        putserver "NOTICE $nick :Couldn't find a digit after #";
        return 0;
      }
    }
    if {$nr == 0} {
      channel set $chan chantype 0;
      putserver "NOTICE $nick :Channeltype cleared for channel \[$chan\]";
      return 1;
    }
    foreach item [array names chantypes] {
      if {$nr > 0} {
        if {[info exists chantypes($nr)]} {
          channel set $chan chantype $nr;
          putserver "NOTICE $nick :Channeltype set to $nr \[$chantypes($nr)\]";
          return 1;
        }
      } else {
        if {[string equal -nocase $chantypes($item) $chantype]} {
          channel set $chan chantype $item;
          putserver "NOTICE $nick :Channeltype set to $item \[$chantypes($item)\]";
          return 1;
        }
      }
    }
    putserver "NOTICE $nick :Channeltype not found.";
  }
  return 1;
}



proc qbot::initjoin {nick host hand chan} {

  variable users;
  variable jchans;
  if {![isbotnick $nick] && [botisop $chan]} {
    set welcome [channel get $chan "welcome"];
    if {$welcome != ""} {
      putquick [format {NOTICE %s :[%s] %s} $nick $chan [join $welcome " "]]
    }
    set auth [auth::getname $nick];
    if {$auth == 0} {
      set jchans($nick) $chan;
      utimer 30 [list catch "unset [namespace current]::jchans($nick)"];
      putquick "WHO $nick n%hnuat,69";
    } else {

          if {([channel get $chan "chantype"] == 3)} {
            set auth [auth::getname $nick];
            doprivatcommands $nick $auth $chan;
            } else {
      dojoincommands $nick $auth $chan;
      }
    }
  }
}



proc qbot::getinfo {server rawid content} {
  variable jchans;
  set id [lindex [clean $content] 1]
  set nick [lindex [clean $content] 4]
  set auth [lindex [clean $content] 5]
  if {($id != 69) || ($auth == 0) || ![info exists jchans($nick)]} {
    return 0
  }
  set chan $jchans($nick);
  unset jchans($nick);
  auth::savename $server $rawid "[lindex [clean $content] 0] 666 [string trim [join [lrange [split $content "
 "] 2 end] " "] " "]";

      if {([channel get $chan "chantype"] == 3)} {
#            set auth [auth::getname $nick];
            doprivatcommands $nick $auth $chan;
      } else {
          dojoincommands $nick $auth $chan;
      }

}



proc qbot::unknowncommand {nick host hand args} {
  set arg(1) [lindex $args 0];
  set cmd [lindex [split [string trim $arg(1) "\x20"] "\x20"] 0];
  set text [clean $args];
  set auth [auth::getname $nick];
  if {![iscommand $cmd]} {
    putserver "NOTICE $nick :$cmd: Unknown command.";
  }
  return;
}

# // misceleanous

proc qbot::spewallusers {chan nick} {
  variable users;
  foreach item [array names users] {
    if {[string match -nocase [clean $chan],* $item]} {
      set user [getrealuser $item];
      putserver "NOTICE $nick :[format { %-15s +%s} $user $users($item)]"
    }
  }
}

proc qbot::getchantype {chan} {
  variable chantypes;
  set chantype [channel get $chan chantype];
  if {[info exists chantypes($chantype)]} {
    return $chantypes($chantype);
  }
  return "(unspecified)";
}

proc qbot::getflags {auth chan} {
  variable users;
  foreach item [array names users] {
    if {[string equal -nocase $chan,$auth $item]} {
      return $users($item);
    }
  }
  return;
}

proc qbot::getrealuser {item} {
  return [lindex [split $item ","] end];
}

proc qbot::finduser {user} {
  set auth [expr {([string index $user 0] == "#") ? [string range $user 1 end] : [auth::getname $user]}];
  return [expr {([string length $auth] <= 15) ? $auth : 0}];
}

proc qbot::totalusers {chan} {
  variable users;
  set total 0; set owner 0; set master 0;
  set op 0; set voice 0; set ban 0;
  foreach item [array names users] {
    if {[string match -nocase [clean $chan],* $item]} {
      set flag $users($item);
      incr total
      if {[string match "*b*" $flag]} {incr ban}
      if {[string match "*n*" $flag]} {incr owner}
      if {[string match "*m*" $flag] && ![string match "*n*" $flag]} {incr master}
      if {[string match "*o*" $flag] && ![regexp -- "\[mn\]" $flag]} {incr op}
      if {[string match "*v*" $flag] && ![regexp -- "\[mno\]" $flag]} {incr voice}
    }
  }
  return "$total (owner: $owner, master: $master, op: $op, voice: $voice, ban: $ban)."
}

proc qbot::setauthlev {auth lev} {
  variable authlev;
  set x $auth;
  foreach item [array names authlev] {
    if {[string equal -nocase $auth $item]} {
      set x $item;
      break;
    }
  }
  if {$lev <= 1} {
    catch {unset authlev($x);}
    return 1;
  }
  set authlev($x) $lev;
  return $lev;
}

proc qbot::setaccess {auth chan flags} {
  variable users;
  set x $chan,$auth;
  set oflags "";
  foreach item [array names users] {
    if {[string equal -nocase $chan,$auth $item]} {
      set x $item;
      set oflags $users($x);
      break;
    }
  }
  set nflags [string trimleft [lindex [msplit $flags] 0] "-"];
  set pflags [string trimleft [lindex [msplit $flags] 1] "+"];
  set tmp ""; foreach flag [split $nflags ""] {lappend tmp "$flag \"\"";}; set tmp [join $tmp " "];
  set newflags [string trimleft [lindex [msplit "[string map $tmp $oflags]$pflags"] 1] "+"];
  set newflags [join [lsort -dictionary -unique [split $newflags ""]] ""];
  if {$newflags == ""} {
    unset users($x);
  } else {
    set users($x) $newflags;
  }
  return 1;
}

proc qbot::msplit {str} {
  for {set p {}; set n {}; set t p; set x 0; set y [expr [string length $str]-1]} {$x <= $y} {incr x 1} {
    set i [string index $str $x];
    if {$i == "-"} {
      set t n;
      continue;
    } elseif {$i == "+"} {
      set t p;
      continue;
    } elseif {[regexp -- {\s|\000} $i]} {
      continue;
    } else {
      regsub -all -- {([\(\)\[\]\{\}\!\*\?\|\.\$\^\\])} $i {\\\1} j;
    }
    if {![regexp -- $j [subst $$t]]} {
      append $t $i;
    }
  }
  return [list -$n +$p];
}

proc qbot::getauthlev {auth} {
  variable authlev;
  if {$auth == 0} {
    return 0;
  }
  foreach item [array names authlev] {
    if {[string equal -nocase $auth $item]} {
      return $authlev($item);
    }
  }
  return 1;
}

proc qbot::dojoincommands {nick auth chan} {


  if {[getaccess $auth b $chan]} {
    putquick "MODE $chan +b *!*@$auth.users.quakenet.org"
    putquick "KICK $chan $nick :You are BANNED from this channel."
  } elseif {[getaccess $auth o $chan] && [getaccess $auth a $chan]} {
    putquick "MODE $chan +o $nick"
  } elseif {[getaccess $auth v $chan] && [getaccess $auth a $chan]} {
    putquick "MODE $chan +v $nick"
  }
}

proc qbot::doprivatcommands {nick auth chan} {
#    variable bhost;

  if {[getaccess $auth o $chan] && [getaccess $auth a $chan]} {
      putquick "MODE $chan +o $nick"
    } elseif {[getaccess $auth v $chan] && [getaccess $auth a $chan]} {
            putquick "MODE $chan +v $nick"
      } else {
#        set bhost [*!*@[lindex [split [getchanhost $nick $chan] @] 1]];
#        putquick "MODE $chan +b *!*$bhost"
        putquick "KICK $chan $nick :You are not AUTHORIZED to access this Channel."
      }
  }


proc qbot::iscommand {cmd} {
  foreach bind [binds msg] {
    regexp -- {^\S+\s\S+\s(\S+)\s\S+\s\S+$} $bind -> result;
    set result [join $result "\x20"];
    if {[string equal -nocase $cmd $result]} {
      return 1;
    }
  }
  return 0;
}

proc qbot::getaccess {auth flags chan} {
  variable users;
  foreach item [array names users] {
    if {[string equal -nocase $chan,$auth $item]} {
      foreach flag [split $flags ""] {
        if {[string match *$flag* $users($item)]} {
          return 1;
        }
      }
    }
  }
  return 0;
}

proc qbot::ishelpfile {file} {
  variable helpdb;
  variable cwd;
  set file [string tolower $file.help];
  if {[file exists $cwd/$helpdb$file]} {
    return 1;
  }
  return 0;
}

proc qbot::spewhelp {nick file lvl args} {
  variable helpdb;
  variable cwd;
  global botnick;
  set file [string tolower $file.help];
  set fd [open $cwd/$helpdb$file r+];
  set pt [lindex [clean [lindex $args 0]] 0];
  regsub -all -- {(&)} $botnick {\\\1} mynick;
  while {![eof $fd]} {
    gets $fd line;
    if {![regexp -- {\S} $line]} {
      continue;
    }
    set nlvl [lindex [clean $line] 0];
    set kwrd [lindex [clean $line] 1];
    set output [string trim [join [lrange [split $line " "] 1 end] " "] " "];
    if {([string match -nocase [clean $pt] $kwrd] || ($pt == "")) && ($lvl >= $nlvl)} {
      regsub -all -- {:botnick:} $output $mynick output;
      putserver "NOTICE $nick :$output";
    }
  }
  close $fd;
  return;
}

proc qbot::load {} {
  variable chandb;
  variable users;
  variable authlev;
  variable cwd;
  if {![file isdirectory [file dirname $cwd/$chandb]]} {
    file mkdir [file dirname $cwd/$directory]
  }
  if {![file exists $cwd/$chandb]} {return 0;}
  if {[array exists users]} {array unset users;}
  if {[array exists authlev]} {array unset authlev;}
  set file [open $cwd/$chandb r+];
  set count 0;
  while {![eof $file]} {
    gets $file line;
    if {[regexp -nocase -- {^channel:(\S+)\sid:(\S+)\sflags:(\S+)$} $line -> chan auth flags]} {
      set users($chan,$auth) $flags;
      incr count;
    } elseif {[regexp -nocase -- {^authname:(\S+)\slevel:(\S+)$} $line -> auth level]} {
      set authlev($auth) $level;
      incr count;
    }
  }
  close $file;
  return $count;
}

proc qbot::save {args} {
  variable chandb;
  variable users;
  variable authlev;
  variable cwd;
  if {![file isdirectory [file dirname $cwd/$chandb]]} {
    file mkdir [file dirname $cwd/$chandb]
  }
  set file [open $cwd/$chandb w+];
  set count 0;
  foreach chanlev [array names users] {
    regexp {^(\S+),(\S+)$} $chanlev -> chan user;
    if {[validchan $chan]} {
      puts $file "channel:$chan id:$user flags:$users($chanlev)";
      incr count;
    }
  }
  foreach user [array names authlev] {
    puts $file "authname:$user level:$authlev($user)";
    incr count;
  }
  close $file
  return $count;
}

proc qbot::putserver {args} {
  variable server;
  set rawstr [lindex $args 0];
  $server $rawstr;
  return;
}

proc qbot::clean {i} {
  return [regsub -all -- {([\(\)\[\]\{\}\$\"\\])} $i {\\\1}];
}

if {[info commands rputquick] != "rputquick"} {
  rename putquick rputquick;
  proc putquick {args} {
    if {[llength $args]<1} {
      error "wrong $ args: should be \"putquick string ?options?\"";
    }
    set str [lindex $args 0];
    set strlen [expr [string length $str]-1];
    if {![string equal [string range $str [expr $strlen-1] $strlen] "\r\n"]} {
      append str "\r\n";
    }
    putdccraw 0 [string length $str] $str;
    return;
  }
}

bind flud -|- * flood;
proc flood {nick host hand type chan args} {
  if {[matchattr $hand fmno|fmno $chan]} {
    return 1;
  }
  return 0;
}

qbot::load;

# // (C)

putlog "Script loaded: The Q Bot by perpleXa & Zyberdog"
m
metroid
Owner
Posts: 771
Joined: Wed Jun 16, 2004 2:46 am

Post by metroid »

Dizzle wrote:Well if it works and you think ppl can use it, submit it too the tcl archive
Seeing as it's not his script but just a minor modification i don't think that's a god idea.
i
iamroot
Voice
Posts: 20
Joined: Sat Jul 09, 2005 5:47 am

Post by iamroot »

MeTroiD wrote:
Dizzle wrote:Well if it works and you think ppl can use it, submit it too the tcl archive
Seeing as it's not his script but just a minor modification i don't think that's a god idea.
This was my though - it's not my script and not my modification (only idea for modification).

I think the post here in the board should be ok - if anyone looks for the same funktion, he could see the modification here and apply it to his own script.

The website from Original Author is no longer available and the IRC Chan is no longer used so it's not realy easy to contact Author.
m
metroid
Owner
Posts: 771
Joined: Wed Jun 16, 2004 2:46 am

Post by metroid »

The channel is still being used, just not alot from what i know
i
iamroot
Voice
Posts: 20
Joined: Sat Jul 09, 2005 5:47 am

Post by iamroot »

i saw now a problem with the script - it works perfect for users with qauth but if someone joins channel without qauth, the bot doesn't kick?!?

i'm not realy able to see why this is not working - i though he checks all users on join :roll:

quakenet is so silly - you could set a chan to +r (registered users with qauths only) but if you invite someone manually he's able to join a +r channel also without qauth :(

EDIT: found solution ;)

Code: Select all

proc qbot::initjoin {nick host hand chan} {

  variable users;
  variable jchans;
  if {![isbotnick $nick] && [botisop $chan]} {
    set welcome [channel get $chan "welcome"];
    if {$welcome != ""} {
      putquick [format {NOTICE %s :[%s] %s} $nick $chan [join $welcome " "]]
    }
    set auth [auth::getname $nick];
    if {$auth == 0} {

      set jchans($nick) $chan;
      utimer 30 [list catch "unset [namespace current]::jchans($nick)"];
      putquick "WHO $nick n%hnuat,69";
          if {([channel get $chan "chantype"] == 3)} {
            set auth [auth::getname $nick];
            doprivatcommands $nick $auth $chan;
  }
    } else {

          if {([channel get $chan "chantype"] == 3)} {
            set auth [auth::getname $nick];
            doprivatcommands $nick $auth $chan;
            } else {
      dojoincommands $nick $auth $chan;
      }
     }
    }
}
i
iamroot
Voice
Posts: 20
Joined: Sat Jul 09, 2005 5:47 am

Post by iamroot »

my fix was solving the problem but now the bot kicks several users which are correct authenticated - i think there is not enough time to get qauth and put it in the var and so he thinks there is no qauth and kicks the user.

the "wait" command is not supported in my tcl - could someone help me with an alternative solution? :)
m
metroid
Owner
Posts: 771
Joined: Wed Jun 16, 2004 2:46 am

Post by metroid »

That who calls a proc called qbot::getinfo.

Put your doprivate stuff there but remember to modify the proc so it doesn't stop on unauthed users.
Locked