00README0000644000076500007650000000614710113034757012313 0ustar jmidgleyjmidgleyCrazyEddys Epic Tool Kit. OK, the plot here is that everything was originally in BitchX.sav, and it was a much bigger mess than it is now, so over time I have been trying to export everything to individual standalone scripts which are cetk.* . There are some interdependancies between these scripts, but they should all load and do what they do independantly of other loaded scripts. Requirements: You need EPIC4 1.2 and if you want to use the "historical" stuff, you will need perl compiled in to make ~/.BitchX.pl work. Some of the scripts _may_ work on EPIC4 1.0.1. Here is a brief description of the cetk.* scripts: cetk.functions contains many things used by the other scripts. In particular, it contains the alias.t command which does some basic error checking and reformatting of the alias before entering it. It contains functions that are generally useful, and don't fit into the other scripts. *undocumented* cetk.opme is my pride and joy. I wish more people would use it. :-) It is rather excessively documented so I won't write about it here. cetk.ceop.pl and cetk.ceop.tcl are companion scripts for Irssi and Eggdrop respectively. cetk.fserve is a fully functioning XDCC and OMEN compatible "file server" sans certain small things like the advertising messages which, sadly, may be necessary in some environments. cetk.chanmgmt contains channel management aliases such as /op, /voice, /ban, etc. The key features are 1) that it attempts to stick to the maximum number of mode changes a server will allow on one line, and 2) that it has a half decent method of avoiding flooding for "mass" operations. *undocumented* cetk.userlist is a userlist script that is heavily optimised for performance. It is modeled on BX's userlist, but unfortunately it's incompatible and it is only really useful to scripters. cetk.opme makes use of it, and BitchX.sav makes extensive use of it. cetk.clonecheck will do certain things with the clones it finds in a channel. It has a few key features that avoid banning or killing people we like. cetk.proxycheck is an rbl proxy tester. It will do a host lookup of a hostname or address at certain rbls and call a hook for every hit. cetk.httpd is a http server. It's not very useful at all right now, but it it's a good example of epics capabilities and it's fun. :-) *undocumented* Miscelaneous notes: Some of the cetk.* files are documented internally. Others aren't documented at all. The files under the historical directory are everything else I use to make this work in my environment, except ~/.BitchX/BitchX.priv, which contains private things. You don't have to have a ~/wrk directory for the entire script to load, so you can ignore the error, or remove the "cd .." line from .epicrc. To load everything as it is on my system, put the BitchX files in ~/.BitchX/, and .epicrc in your home directory, after making backups of the files that are already there. Then put the cetk.* files in your load path, and run epic. The BitchX.sav file will _crash_ BitchX. I started writing this script for BX, and intended for it to work under both, but I have lost interest in keeping it that way. epic-scripting-00-Administrivia.txt0000644000076500007650000000072410120276133017757 0ustar jmidgleyjmidgley Epic Scripting. Abstract. This is a tutorial about the scripting language in the Enhanced Programmable IRC Client, EPIC being being a source code derivative of ircII, and ircII being the original client portion of the IRC system. The author believes that after ten years, this language remains largely undocumented despite various honorable attempts, and so this document will also tend to have greater breadth than depth. Epic Scripting. Introduction. XXX epic-scripting-01-Basics.txt0000644000076500007650000000047310147406462016373 0ustar jmidgleyjmidgley Epic Scripting. The Interface. Arguably, one of the best things about ircII is the way its inbuilt language is bound to the user interface. From the command line, it is possible to use all the constructs of the language interactively or in a script, from loops to function/alias definition to function calls. epic-scripting-Alias.txt0000644000076500007650000000004510134566361015776 0ustar jmidgleyjmidgley Epic Scripting. Aliasing /alias. epic-scripting-Parsers.txt0000644000076500007650000000471010147406672016371 0ustar jmidgleyjmidgley Epic Scripting. The Parsers. The Parsing involved in ircII scripting is a very major difference between ircII and more mainstream scripting languages. The single most shocking difference is that there are at least two parsers actively interpreting the average script. A demonstration follows. /eval echo $variable;echo $variable It is not obvious from reading this command, but what is happening here is that the "command parser" will break this line up into two commands, and then the "expression parser" will translate $variable into values for each of the two commands. After this, the command is executed. This is not a particularly useful piece of code, but understanding it helps us understand the following. /eval $variable The same thing is happening here, but since there is no echo command, the value of the variable itself will be interpreted and executed as a command. If the value of $variable is a valid command, then this will work. /eval $shift(variable) The same thing is happening here, but the variable is actually a call to the shift function, the return value of which will be executed as a command. This is a much more useful thing to do because it means commands can be given at one point in a script and executed later at a more appropriate time. This is a good example of how the parsers can collide. Fortunately, accidental collisions can generally be avoided because the lines between the parsers are so well defined that they appear to be a single language. Making them collide deliberately can be a good source of fun and profit, and it is a bit of an art in itself. Consider the following alias: alias getopts (var, pref, string, ...) { while (:option = getopt(:optopt :optarg "$string" $*)) { switch ($option) { (!) {echo * option "$optopt" is an invalid option} (-) {echo * option "$optopt" is missing an argument} (*) { push :optopts , push\($pref$optopt ${optarg?optarg:[ ]}\) } } } return @ $var = [$optarg]$optopts } This alias will return a @ expression, and is useful as a single line version of $getopt(), as in the following example. alias foo (args) { $getopts(:args :opt_ a:b $args) if (opt_b) { echo -b was used. } elsif (opt_a) { echo -a $opt_a was used. } echo Remaining arguments: $args } Note that this method only seems to work well for single commands, such as @, if, while, eval, etc. epic-scripting-Performance.txt0000644000076500007650000000230510120263540017173 0ustar jmidgleyjmidgley Epic Scripting. Performance. Coding for performance in any language always requires rethinking even the most basic assumptions. Numerical Assumptions and the String Trap. One assumption a coder often makes is that mathematical operations are faster than operations on other data types. This is untrue in epic because all data is passed back and forth between the major parts as character strings. When a mathematical operation is performed, the input is taken as a numerical value of a string, and the output is printed back to a string. This has effects on performance and on the accuracy of the math. Data Storage. Epics variable implementations are based on an alist. Adding and removing a variable involves moving every variable after it aside. Performance will draw to a standstill as the number of variables increases unless care is taken to address this. The best way to deal with this is for epic to stop using alists. :-) This is still in the works at this point. When dealing with variables with fixed names that are frequently added and removed, it's usually best to assign an empty value to them rather than deleting them, since changing a variable doesn't have this performance impact. historical/0000755000076500007650000000000010743134230013420 5ustar jmidgleyjmidgleyhistorical/.epicrc0000640000076500007650000000163010700640131014655 0ustar jmidgleyjmidgleyif (J!~[bitchx*]){ dump on xdebug old_math alias -evalserver alias getset return \$($*) alias getset return \$::getset($toupper($*)) set load_path $unsplit(: $filter(*/help/ $uniq($globi($W/script ~/.BitchX $split(: $getset(load_path)) /usr/share/epic?/*)))) alias load.perl fe (${#?[$*]:[\$ENV{HOME}/.BitchX/BitchX.pl]}) foo {if (!perl(do \"$foo\")){xecho -banner -nolog -- Failed to load $foo!}} load.perl load builtins load history #alias unload {} switch (1) { (1) {alias reload.bx {//load BitchX.sav $*};reload.bx} (2) {load lice.irc;tog qx;mtog q;} (3) {load thirdeye.irc} (4) {load splitfire.irc} (5) {load light.irc} (6) {load hienoa.irc} (7) {load ~/.odelay/odelay.irc} (8) {load ~/.epic/Intrepid/modules/init} } if (fexist(~/src/epic-help/)){set help_path $getenv(HOME)/src/epic-help} alias ehelp @:old_help_path=getset(help_path)\;^set help_path $getset(help_path)\;help \$*\;^set help_path \$old_help_path } historical/BitchX.sav0000640000076500007650000013347411412056504015325 0ustar jmidgleyjmidgleyxecho -banner -nolog -- Loading. # NOTES: # * No timer refs begining with A. # Reload command sequences: # eval dump all;load ~/.ircrc;allvwins reinitstat # eval dump alias on;load ~/.ircrc;allvwins reinitstat # Initialisation. cd ~/wrk/ xdebug dword # Config maintenance. unload creddyscript package creddyscript fe ($getsets(load_path status*)) foo { stack push set $foo } on ^unload creddyscript** { fe ($getsets(load_path status*)) foo { stack pop set $foo } } if (J!~[bitchx*]){ load cetk.functions load cetk.commands load cetk.userlist load cetk.connmgmt load cetk.chanmgmt load cetk.clonecheck load cetk.opme load cetk.fserve load cetk.proxycheck load cetk.httpd load cetk.topicmgmt load cetk.entertainment load autoget load commandqueues load data_struct load data_array load debug.irc load files load functions load guh load history load mudirc load pipe load tabkey.ce load dcc_spacefix load help bind ^N quote_character bind ^X switch_channels bind ^W NOTHING bind ^Wb parse_command window balance bind ^Wh parse_command window hide bind ^Wk parse_command window kill bind ^Wl parse_command window list bind ^Wm parse_command window move } # Ident server. alias.t serve.ident (args) if (2>#args){xecho -banner -- Requires: [port] [user]}{@:port=shift(args);on ^dcc_raw "% % N $port" \{on ^dcc_raw "\$0 % *" \{switch ($2)\{(c)\{on ^dcc_raw -"\$0 % *"\}(d)\{msg =\$0 \$strip("$chr(13 10)" $3-) : USERID : UNIX : $args\}\}\}\};@listen($port)} # Aliases. Macros. alias.t recursew if (functioncall()){@:args=[$*];@:fn=shift(args);@:var=shift(args);return return \$${fn}\(\$splice\($var 0 \$\{#${var}/2\}\)\) \$${fn}\($var\)} # Aliases. Functions. fe (perl tcl) foo {alias.t ${foo}f @:quote=attr.bold(\")\;unless (functioncall())\{xecho -banner -nolog -- \$quote\$*\$quote RETURNED \$quote\$${foo}($*)\$quote\}} fe (sin cos tan) foo {alias.t ${foo}d @:of=setset(floating_point_math on)\;@function_return=${foo}(${(atan(1)*[$*])/45})\;set \$of;alias.t a${foo}d @:of=setset(floating_point_math on)\;@function_return=\{45*a${foo}($*)/atan(1)\}\;set \$of} fe (bold 2 inv 22 ul 31) foo bar {alias.t attr.$foo return \$\{@?chr\($bar\)##[\$*]##chr\($bar\):[]\}} fe (lc 97 122 uc 65 90) foo bar baz {alias.t count.$foo @:count=0\;fe ($ascii($*)) foo \{if \($bar<=foo&&foo<=$baz\){@count++}\}\;return \$count} fe (writeb write) foo {fe (.0 "") bar {alias.t ${foo}to${bar} ${[]==bar?[]:[@unlink($0)\;]}@:foo=open($0 W)\;\@${foo}($foo $1-)\;@close($foo)}} fe (beforr before after beforrw beforew afterw) foo bar baz {alias.t $foo @:ret=${bar}($*)\;return \$\{strlen\(\$ret\$${baz}($*)\)?ret:isnumber($0)?[\$2-]:[\$1-]\}} fe (convert iptoname nametoip hostnorm) foo {alias.t ${foo}nuh (ret) fe ret foo \{@foo=[\$before(-1 @ $foo)@\$${foo}($after(-1 @ @$foo))]\}\;return \$ret} fe (convert iptoname nametoip hostnorm) foo {alias.t ${foo}spec (ret) fe ret foo \{@foo=[\$${foo}($before(: $foo)):\$after(: $foo)]\}\;return \$ret} fe (x ^ a + s -) func op {alias.t mod$func (ret) @:baz=ascii($shift(ret))\;@:ret=ascii($ret)\;fe ret foo \{unless (#bar){@:bar=baz}\;@foo${op}=shift(bar)\}\;if (functioncall()){return $chr($ret)}{xecho -banner -nolog -- $chr($ret)}} fe (r "") foo {alias.t u$foo users$foo} stack push alias alias.tt alias.t alias.tt (args) { alias.t $args @ sar(gr/encrypt/decrypt/args) @ sar(gr/KEY2/KEY1/args) alias.t $args } alias.tt encrypt.fd (args) { @ :bar = [], :fd = shift(args), :key1 = :key2 = jotc($shift(args)), :len = @KEY2 fec args foo { @ bar = asciiq($read($fd 1)) % len @ KEY2 = rest($bar $KEY2)##left($bar $KEY1) @ foo = tr($chr(1)$key1$chr(1)$key2$chr(1)$foo) } return $args } stack pop alias alias.tt #fe (decrypt.fd key1 encrypt.fd key2) cmd foo {alias.t $cmd (args) @:bar=[]\;@:fd=shift(args),:key1=:key2=jotc($shift(args)),:len=@$foo\;fec args foo \{@bar=asciiq($read($fd 1))%len\;@$foo=rest\(\$bar \$$foo\)##left\(\$bar \$$foo\)\;@foo=tr\($chr(1)\$key1$chr(1)\$key2$chr(1)\$foo\)\}\;return \$args} eval alias ui $sar(g/userhost/userip/$aliasctl(alias get uh)) alias.t argorchan return ${0>index(#&+ $*)?C:[$*]} alias.t bdepth @:cnt=:ret=0;@:lf=[$0];@:rt=[$1];fec ($2-) foo {switch ($foo){($rt){@--cnt}($lf){@++cnt;if (cnt>ret){@ret=cnt}}}};return $ret alias.t canonise.fn (args) { } alias.t chananuhs @:ret=myservers(.);fe ret serv {xeval -s $serv {@serv=pattern("\\[$*\\]" $nickuserhost($chanusersa()))}};return $sort($uniq($ret)) alias.t colorhash return ${chr(3)##(31+modhash(6 $tolower($foo)))} alias.t colorise fe ($*) foo {@:bar#=chr(3)##(hash_32bit("$tolower($foo)")%6+31)##foo};return $:bar$chr(15) alias.t cooler (args) { fec args foo { if (isalpha($foo) && !rand(2)) { @ foo = chr(${32 ^ ascii($foo)}) } } if (functioncall()) { return $args } else { echo $args } } alias.t coolest (args) { fe args foo { @ :foo = ascii($foo) @ splice(foo 1 0 $shuffles($splice(foo 1 ${#foo-2}))) @ :foo = chr($foo) } if (functioncall()) { return $args } else { echo $args } } alias.t count.en @:count=0;fe ($ascii($*)) foo {if (2==foo||3==foo||22==foo||31==foo||15==foo){@count++}};return $count alias.t expand.brace { @ :reg = regcomp([\{]\([^\{\}]*\)[\}]) @ :matches = regmatches($reg 2 $*) @ regfree($reg) unless (#matches) { return $* } @ :left = left($word(0 $matches) $*) @ :right = rest(${shift(matches) + shift(matches)} $*) @ :mid = mid($matches $*) @ :cnt = count(, $mid) + 1 @ :cnt = repeat($cnt . ) fe cnt cnt { @ cnt = ${t}($left$beforr(, $mid)$right)) @ mid = after(, $mid) } if (functioncall()) { return $cnt } else { echo $uniq($cnt) } } alias.t fcount @:ret=[];fe ($*) foo {@:fd=open($foo r);@push(ret $fskip($fd 999999999));@close($fd)};if (functioncall()){return $ret}{xecho -banner -nolog -- $ret} alias.t hash @:bit=0;@:ret=0;fe ($ascii($*)) foo {@ret^=foo<<(bit++&15)};return ${ret&65535^(ret>>16)} alias.t hostnorm (args) fe args arg {@arg=isip4($arg)?arg:unsplit(. $revw($split(. $arg)))};return $args alias.t interesting.show { if (4 & checkshit(. $2)) {return} @ :bl = chr(2), :lt = bl##[\(]##bl, :rt = bl##[\)]##bl @ :wd = uniq($perl("@foo")) @ :sg = serversgroup($servernum()) @ :fm = colorise($before(! $0)) @ :to = colorise($2) @ :msg = stripcrap(all $3-) setuniqitem interesting $1-2 -$servernum()/$0 $3- 1cmd 3600 xecho -banner -nolog -window crap -level user1 -- Found $lt$wd$rt on $lt$sg$rt in $fm $1 $to $msg if (msg == [$3-]) {1cmd 3600,3600 beep $servernum() $after(@ $0) $to} } alias.t keysto @:ret=[];foreach list.chan foo {if (rmatch($decode($foo) $*)){@push(ret $list[chan][$foo][keys])}};return $decodew($uniq($encodew($ret))) alias.t lastlog.lines { @ :matches = lastlog($winnum() "\\[$*\\]" all) fe matches foo { @ foo = line($foo) } return $matches } alias.t mode.split @:on=:off=[];@:mode=[];fe ($*) bar {fec (+$bar) foo {switch ($foo){(+){@mode=[on]}(-){@mode=[off]}(*){@$mode#=foo}}}};return $on $off alias.t modhash return ${hash_32bit($1-)%[$0]} alias.t mychflags if (#){return $strip(. $mid(0 2 $pattern(??$servernick() $channel($0))))$0 $${t}($1-)} alias.t mynicks (args) @:args=#args?args:myservers(.);fe args arg {xeval -s $arg {@arg=servernick()}};return $args alias.t net @:ret=[];@:rand=[];@:fh=open(~/.ircservers R T);while (!eof($fh)){@:foo=read($fh);if (foo=~[*:*:*:*:$0]&&(!strlen($ret)||(match($before(: $foo) $myservers())&&!++rand($rand)))){@ret=foo}};@close($fh);return $ret fe (anuhs nickuserhost($*) canuhs "pattern('\\[$*\\]' $nickuserhost($chanusersa()))" anotify "pattern('\\[$*\\]' $nickuserhost($notify(on)))") foo bar {alias.t nickuserhost.$foo @:ret=myservers(.)\;fe ret serv \{xeval -s \$serv \{@serv=$tr(/'/"/$bar)\}\}\;return \$sort($uniq($ret))} eval alias.t nickuserip $sar(g/uh1=uh1/uh2=uh1?ui($uh1):[],uh1=!uh2/$aliasctl(alias get nickuserhost)) alias.t nuhnorm @:ret=hostnormnuh($*);fe ret foo {@foo=[$after(@ $foo)@$swap(! $before(@ $foo))]};return $ret alias.t numbers (args) fe args arg {@:arg=isnumber(b10 $arg)?arg:[]};return $args alias.t purge struct.purge alias.t randcnf (num,filt) { @ :ret = [] eval @ :foo = tr\(/./ /$repeat(${num-#ret} \$longtoip($rand(0)) )\) fe ($filt) bar { @ foo = filter($bar $foo) } @ ret #= foo return $ret } alias.t regexsubst return \\b\($unsplit(| $sar(g/%/\\S\*/$sar(g/*/.*/$sar(g/./\\./$*))))\)\\b alias.t regtmatches @:foo=regmatches($*);@:str=[$2-];fe foo bg en {@bg=mid($bg $en $str),en=[]};return $foo alias.t replace.split @:args=[$*];@:num=#;if (3==num){return $sar(g/$1/$2/$0)} elsif (3winvisible(all)){^window new number 999 double off name all};^window swap all noserv bind ^[[25~ parse_command fe ($revw($winrefs())) foo {if (match($foo 10 48)){^window swap $foo;break}} bind ^[[26~ parse_command ^window swap 2 fe ($jot(1 8)) win {bind $getcap(TERM key_f$win 0 1) parse_command ^window swap \$word\($win \$winrefs()\)} bind ^[[20~ parse_command winorder bind ^[[21~ parse_command ^set beep toggle;beep fe (set format_ fset) cmd bar { fe ($getfsets(${bar}action* ${bar}ctcp* ${bar}dcc_* ${bar}encrypted* ${bar}msg ${bar}msg_group ${bar}notice* ${bar}public* ${bar}send*)) foo {fe (\$1 \$2) baz {$cmd $foo $sar(/qwerasdfzxcv/$baz-/$sar(/$baz/\$colorise\($baz\)/$sar(/$baz-/qwerasdfzxcv/$($foo))))};$cmd $foo $sar(g/%b/\${checkuser($last[$serversrefe()][from] $2)?chr(2):}\$seta(${hash_32bit($1$2)%7+31})/$sar(g/%K:/%b\$seta(${hash_32bit($2$1)%7+31}):%n/$($foo)))} $cmd ${bar}action $(${bar}action_other) $cmd ${bar}action_ar $(${bar}action_other_ar) $cmd ${bar}away \$3- \$attr.bold([)last kb activity > \$tdiff2\(\$E\) ago\$attr.bold(] [)/ctcp \$servernick($servernum()) page\$attr.bold(]) $cmd ${bar}channel_signoff $sar(g/\$1 /\$1!\$2 /$(${bar}signoff))%n $cmd ${bar}dcc_chat $sar(g/ %n/%n /$(${bar}dcc_chat)) $cmd ${bar}links $sar(g/13/24/$(${bar}links)) $cmd ${bar}nick_comp \$0\${rmatch($C,$n $my.noattr)?[\:]:attr.bold(\:)}\$1- $cmd ${bar}public $(${bar}public_other) $cmd ${bar}public_ar $(${bar}public_other_ar) $cmd ${bar}send_action $(${bar}send_action_other) $cmd ${bar}send_public $(${bar}send_public_other) $cmd ${bar}signoff $(${bar}signoff)%n ($2) $cmd ${bar}whois_idle $sar(/signon/\$stime(${time()-3600*[$0]-60*[$1]-[$2]}) signon/$(${bar}whois_idle)) } eval set status_lag $sar(^%L^%L:\$status.lw()^$status_lag) eval set status_format1 $sar(^%F^%{1}F^$status_format1) eval set status_format1 $sar(^%S^%{2}S^$status_format1) eval set status_format2 $sar(^%2^%2:\$status.lw()^$status_format2) eval set status_format2 $getset(status_format2)$replace(%{1}xxx xxx $jot(0 9)) %{1}K %{1}D %P %. fe (1 2 "") foo {set status_format$foo %9$getset(status_format$foo)} fe (action \$1 \$0 \$2 -> < send_action \$0 \$servernick() \$1 -> < dcc_chat * \$0 \$1 = = send_dcc_chat \$0 * \$1 = = msg \$servernick() \$0 \$1 * * msg_group \$1 \$0 \$2 * * send_msg \$0 \$servernick() \$1 * * notice \$servernick() \$0 \$1 - - send_notice \$0 \$servernick() \$1 - - public \$1 \$0 \$2 < > public_msg \$1 \$0 \$2 < > public_notice \$1 \$0 \$2 - - public_other \$1 \$0 \$2 < > send_public \$0 \$servernick() \$1 < >) hook foo bar baz open close {on ?$hook * ${hook==[notice]?[if (!last[$last[eserv]][from]){return 0};]:[]}@:key=encode\($hook $foo${0>index(0123 $foo)||0>index(0123 $bar)?[ $bar]:[ ]##bar}\)\;@:echo=colorise[\$key]\;unless (echo)\{@:b=${hook=~[send_*]||[\$servernick()]==foo||[*]==bar?51:[checkuser\(. $bar\)?51:31]}\;@:c1=chr(3)##\(b+hash_32bit\($foo$bar\)%7\)\;@:c2=chr(3)##\(b+hash_32bit\($bar$foo\)%7\)\;@colorise[\$key]=echo=[\$c1$open\$colorise\(${hook=~[send_*]||[\$servernick()]!=foo?foo:[\$servernick()]}\)\$c2:\$colorise\(${hook=~[send_*]||[\$servernick()]!=bar?bar:[\$servernick()]}\)\$c1$close${hook=~[send_*]||[\$servernick()]==foo||[*]==bar?chr(15):[\$\{2&word\(0 \$checkshit\(. $bar\)\)?chr(3)##[1,1]:chr(15)\}]}]\}\;xecho -- \$echo $baz-\;if (0<=winvisible(all))\{xecho -nolog -window all -- $attr.bold([)\$[8]servergroup\(${[*]==foo||[*]==bar?[]:hook=~[send_*]?[\$servernum()]:[\$lastserver()]}\)$attr.bold(]) \$echo \$stripcrap\(all $baz-\)\}\;return 1} # Internal Variables. eval set logfile IrcLog.D${time()/86400} #eval set output_rewrite \$strip\("$chr(18 27)" \$1-\) set aop on set auto_away off set auto_reconnect off #set auto_rejoin 5 set auto_rejoin_delay 5 set auto_response 1 #set auto_unmark_away on set auto_whowas off ##set beep_on_msg ctcp,dcc set beep_when_away 0 #set bot_mode on set change_nick_on_kill on set chanmode +spnt set channel_name_width 0 set cloak 2 defer ^assign.ifnul cloak 2 set clock_24hour on set clock_format %d%a-%R #set connect_timeout 3 set continued_line set cpu_saver_after 300 set cpu_saver_every 10 #set dcc_auto_send_rejects off set dcc_long_pathnames off set dcc_sliding_window 32 set dcc_store_path ~/dl/irc-incomplete set detach_on_hup off #set do_notify_immediately off set exec_protection off set fake_split_patterns * set floating_point_math off #set floating_point_precision 16 set flood_maskuser 1 set flood_users 50 set flood_rate_per 3 set ftp_grab on set hack_ops on set help_prompt off set help_window off set history 1000 set history_circleq off set history_remove_dupes on set hold_slider 0 set http_grab on set ident_hack .fakeid set ignore_time 1 #set input_aliases on set insert_mode on set kick_if_banned off set lastlog 1000 set mail 0 #set mangle_logfiles all set mirc_broken_dcc_resume on set mircs on set mode_stripper on set msglog off set msglog_level msgs send_msg set new_server_lastlog_level none set next_server_on_local_kill on #set no_fail_disconnect on #set notify_handler noisy set notify_level all -crap -joins -parts -quits -nicks -modes set num_of_whowas 0 set quit_message Holy shit... I found the universes emergency exit. set quit_message How Now Brown Bureaucrat. defer set -quit_message set same_window_only on set scrollback_ratio 100 set send_away_msg off set show_away_once off set show_end_of_msgs on set show_server_crap on set show_status_all on set show_unauths on set show_who_hopcount on #set status_does_expandos on eval set status_user0 $pid() $afterw(on $info(c)) eval set status_user9 $seta(44) set switch_channels_between_windows off set verbose_ctcp on bantype host if (21==getenv(WINDOW)||[on]==getset(LOG)){set log on}{set log off} # Graffiti Wall. addctcp wall "Graffiti Wall. A public access bulletin board." { if (4 > cloak && [] == checkshit(. $1)) { if ([wall.$3] == aliasctl(alias match wall.$3)) { wall.$3 $0-1 $4- @ :nolist++ } unless (nolist) { @ :list = aliasctl(alias match wall.) fe list list { @ :list = aliasctl(alias get $list) ? after(. $list) : [] } q1cmd 120 8 notice $0 $2 commands: $list wall.list $0-1 $3- } } } alias.t wall.add (nick,dest,msg) { @ :utu = utimeu() @ wall[$utu] = [$attr.bold(<)$nick$attr.bold(>) $msg] writeto ~/.BitchX/BitchX.wall @ wall[$utu] = decode\($encode($attr.bold(<)$nick$attr.bold(>) $msg)\) qcmd 8 ctcp.notice $userhost() $nick Message Added to the wall. } alias.t wall.list (nick,dest,mask) { @ :list = aliasctl(assign match wall.) @ :start = isnumber(b10 $mask) ? shift(mask) : 0 @ :count = isnumber(b10 $mask) ? shift(mask) : 5 @ :mask = mask ? mask : [*] fe list list { @ list = [$($list)] && [$($list)] =~ mask ? list : [] } @ :list = numsort($list) @ :rest = revw($list) @ :list = splice(rest 0 $start) @ :list = splice(rest 0 $count) fe list list { q1cmd 0 8 ctcp.notice $userhost() $nick $stime($cut(1 . $list)) $attr.bold(:) $($list) } if (rest) { q1cmd 0 8 ctcp.notice $userhost() $nick $#rest more messages match "$mask": /ctcp $dest wall list ${start+count} $count $mask } else { q1cmd 0 8 ctcp.notice $userhost() $nick No more messages match "$mask". q1cmd 0 8 ctcp.notice $userhost() $nick /ctcp $servernick() wall add [your message here] } } # CTCP SOUND # addctcp mp3,sound "plays a sound." { if (checkshit(. $1)) { } elsif (0 > fexist("" $dcc_store_path/$3-)) { @ :foo = encodel($userhost()) if (time() < sound[$foo][time]) { } elsif (rmatch($serversgroup($lastserver()),$C $my.sounds)) { @ sound[$foo][deny]++ @ sound[$foo][time] = time() + 3600 * 2**sound[$foo][deny] push sound[$foo][files] $urlencode($3-) echo Accept $2 $0-1 $3- qcmd 999 msg $0 !$0 $3- } } else { echo Play $2 $0-1 $3- exec play "$dcc_store_path/$3-" } } on #-dcc_request 1 "% SEND *" { @ :foo = encodel($userhost()) if (match($5 $sound[$foo][files])) { @ sound[$foo][time] = 0 @ sound[$foo][deny] = -3 @ sound[$foo][files] = rfilter($5 $sound[$foo][files]) } } # CTCP/2 #on #^raw_irc 0 '% PRIVMSG % :**$chr(6)**' pretend :$0-2 $sar(g/$chr(6)//$sar(g/$chr(6)N/$chr(15)/$sar(g/$chr(6)B/$chr(2)/$sar(g/$chr(6)V/$chr(22)/$sar(g/$chr(6)U/$chr(31)/$3-))))) # SSL on #?send_to_server 0 '% % \\[PRIVMSG NOTICE\\] % :**' { @:edst=encodel($3) if (my.sslsending||!SSL[$edst]) { @my.sslsending=0 } else { @my.sslsending=1 @:proto=SSL[$edest][proto]?SSL[$edest][proto]:[twofish] @:seed=rand(0) quote $2-3 :$chr(1)SSL $seed $perlcall(splitcall encryptcode 3 $proto ${SSL[$edst]##seed} $after(: $4-))$chr(1) return 1 } } on #^ctcp 0 "% % SSL **" SSL.read PRIVMSG $1- on #^ctcp_reply 0 "% SSL **" SSL.read NOTICE $servernick() $1- alias.t SSL { switch ($0) { (e) { foreach ssl dst { xecho -banner -- $decode($dst)$chr(9)$SSL[$dst] foreach ssl[$dst] src { if (!ssl[$dst][$src]||rmatch($decode($src) $*)) { @SSL[$dst][$src]=urlencode($"Key for $decode($src) to $decode($dst) \(was $SSL[$dst][$src]\): ") } else { xecho -banner -- $decode($src)$chr(9)$SSL[$dst][$src] } } } } (a) { @SSL[$encodel($1)]=urlencode($2-) } (*) { xecho -banner -nolog -- [e|a {dest} {key}] } } } alias.t SSL.read { @:src=last[$last[eserv]][from] @:esrc=last[$last[eserv]][efrom] @:edst=encodel($1) if (SSL[$edst][$esrc]) { pretend :$src $0-1 :$perlcall(splitcall decrypttext 3 . $SSL[$edst][$esrc]$3-) } else { @SSL[$edst][$esrc]=0 xecho -banner -nolog -- SSL message from $src to $1 } } # More crypto. fe (ctcp shift(args) msg shift(args) ping shift(args) say T) food baz {fe (e$food "\$shift(args) epic-crypt-gpg-aa" n$food) foo bar {alias.t $foo @:args=[\$*]\;@:dest=$baz\;@:foo=encryptparm($dest)\;encrypt \$dest $bar\;${food==[say]?[msg]:food} \$dest \$args\;encrypt \${foo?foo:dest}}} # Hooks. Combinations. fe (channel_sync connect disconnect server_lost) foo {on #-$foo + * ^timer -ref winser0 5 ^winservchans} fe (401 402 437) foo {on #-$foo 203 * if (3>cloak&&rmatch($1 $my.nicks)&&!rmatch($servernick() $my.nicks)){qcmd 99 if \([$1]==servernick()\)\{qcmd\}\{nick $rpattern($1 $my.nicks)\}}\;if \([\$1]\)\{wwq \$1\}} fe (nickname notify_signoff signoff) foo {on #-$foo 203 * if (3>cloak&&X!=userhost()&&rmatch($0 $my.nicks)&&!rmatch($servernick() $my.nicks)){nick $rpattern($0 $my.nicks)}} fe (367 * \$2 \$3 mode_stripped "% % +b *" \$3 \$0) hook hookmask mask hooker {on #-$hook 204 "$hookmask" if \([\$servernick()!\$X]=~[$mask]\)\{xecho -banner -window crap -level crap -- \$attr.bold\($hooker\) on \$attr.bold\(\$1\) \\\(\$attr.bold\(\$serversgroup\(\$servernum\(\)\)\)\\\) has banned you \\\(\$attr.bold\($mask\)\\\)\}\;@:nicks=pattern\(\$beforr\(! $mask\) \$chanusers($1)\)\;@:foo=userhost($nicks)\;@:nicks=copattern\(\$after\(-1 ! !$mask\) foo nicks\)\;@:foo=pattern\($mask \$nickuserhost($nicks)\)\;if (#foo) \{xecho -banner -- \$attr.bold\($hooker\) on \$attr.bold\(\$1\) has banned \$attr.bold\(\$#foo $mask\) \$foo\}} #fe (send_msg send_public send_action) foo {on #-$foo + * {@list[sentmsg][$encodel($0)]=time()}} # CTCPs. on #?ctcp_request 0 * { if (!cloak&&match($1 $servernick() $mychannels())) { return 0 } else { xecho -banner -window crap -level crap Ignoring CTCP $attr.bold(\($attr.bold($serversgroup($lastserver()))\)): $* return 1 } } fe (ctcp ctcp_request) foo {fe (action dcc sed utc) bar {on #-$foo 0 "% % $bar **"}} on #-ctcp_request 0 "% % DCC CHAT **" { unless (2 servernum()) { } elsif (encryptparm($1,$0!userhost())) { } else { xecho -banner -level crap -window crap -- CTCP $2 from $0 to $1 setnextitem SED,$1,$0 $asciiq($3-) } } on #?ctcp_request 0 "% % FINGER **" { if (cloak||strlen($checkshit(. $1))) { return 1 } else { exec -direct -window -line \{scmd $lastserver() qcmd 999 ctcp.reply $0 $2 \$*\} w -fh } } on #?ctcp_request 0 "% % PING **" { if ([$0]==[$1]) { xecho -banner -- CTCP $2 request from $0: $tdiffu($3-) } else if (2 my.paged+120) { @ my.paged = time() @ :foo = [Now] exec beeper beeper $* } else { @ :foo = [Already] } if (!cloak && [$1]==servernick()) { if (checkshit(. $1)) { q1cmd 300 999 ctcp.reply $0 ERRMSG $2 You wish to talk to me after all that? Heh. } else { qcmd 999 ctcp.reply $0 $2 ${foo} Paging $servernick(), who was last seen $tdiff($E) ago. } } } addctcp calc "returns mathematical result of args." { if (4>cloak) { qcmd 999 ctcp.reply $0 $2 $bcalc($3-) } } addctcp dict "returns the dictionary definition of args." { if (4>cloak) { exec -direct -window -name dict -line \{qcmd 999 ^ctcp.notice $userhost() $0 \$*\} xargs -r dict exec -in %dict $3- exec -closein %dict exec -name dict$rand(1000000) %dict } } addctcp fortune "Fortune Cookie. May have formatting problems." { if (4>cloak) { exec -direct -window -name fortune$rand(1000000) -line \{qcmd 999 ctcp.notice $userhost() $0 \$*\} fortune -a } } addctcp keysto "returns known keys to a channel." { if (3>cloak&&checkuser(. $1)) { if (2&checkuser(. $3 ${[$4]?[$4]:[.]})&&!checkshit(. $3)) { xecho -banner -level crap -window crap -- Replying to $* ctcp.reply $0 $2 $uniq($revw($keysto($3) $key($3))) } else { if (!cloak) { ctcp.reply $0 ERRMSG Please ask someone living. } } } } addctcp seen "Returns info on the last seen nick!user@host matching any of the arguments." { if (4>cloak && []==checkshit(. $1)) { @ :nuhs = 0 @ :list = [$3-] fe list foo { @ foo = 0>index(*!@ $foo) ? [$foo!*] : foo } foreach list.nuh nuh { if (rmatch($decode($nuh) $list) && ++nuhs <= 10) { qcmd 999 ctcp.notice $userhost() $0 $2 $stime($list[nuh][$nuh]) $decode($nuh) } } qcmd 999 ctcp.notice $userhost() $0 $2 $nuhs matches for $list (max 10). } } on #^ctcp_reply 0 '$servernick() $servernick() PING $last[$last[eserv]][cping]' @last[$last[eserv]][cpingreply]=[$3-] on #-ctcp_reply 1 "% % TIME *" { @ :diff = time() - perlcall(str2time $3-) xecho -banner -- You are $[-6]diff \($tdiff2($diff)\) ahead of $0 } # Hooks. on #-221 1 ** @:old=mode.split($1);@:new=mode.split($getenv(IRCUMODE) $last[$serversrefe()][umode]);@:newon=strip(+$shift(old) $shift(new));@:newoff=strip(-$newon$shift(old) $shift(new));if (strlen($newon$newoff)){qcmd 9 umode +$getenv(IRCUMODE)+$last[$serversrefe()][umode]} fe (251 252 255 265 266) foo {on #-$foo 1 * @last[\$serversrefe()][$foo]=numbers($*)} on #-317 1 * if (isnumber(b10 $3)){xecho -banner -- $1 has been idle since $stime(${time()-[$2]}) \($tdiff2(${(time()-[$3])-[$2]}) after login $tdiff2(${time()-[$3]}) ago\)} on #-324 1 * pretend :$0 MODE $1- #on #-353 + ** { # @ :chan = [\$decode\($encode($2)\)] # @ :users = [\$decode\($encode($strip(@%+ $3-))\)] # qcmd names.end eval wiq "" \$remws\(\$chanusers\($chan\) / $users\) #} on #?306 0 ** if (isaway()) {return 1} #on #-366 + ** timer -update -ref names.$servernum() 20 while (foo = qcmd(names.end)) {$foo} on #-364 2 ** if ([]!=servping){qcmd 99 sping $1} on #-365 2 ** purge servping.delay on #-364 3 ** if ([]!=servtr){qcmd 99 traceroute $1} on #-365 3 ** purge servtr.delay on #-366 - * { @ :mc = serverctl(get $servernum() maxcache) if (0 <= mc && mc < numonchannel($1)) { } elsif (numonchannel($1)) { widle $1 } } on #-391 1 ** if (isnumber($2)&&isnumber($3)){xecho -banner -- Server says that it/you are $3/${time()-[$2]-[$3]} seconds ahead of UTC.} on #^401 0 "% 0 *" on #-451 1 ** fake #on #-463 + "% *" ircuser.dict on #-439 + "% #% *" qcmd 9 join $1 on #-465 + "% *" if (3>cloak){ircuser.dict} on #^470 0 * mode $N +Q on #-474 + "% *" if (3>cloak){ircuser.dict};if (!rmatch($1 $my.ignorebans)){q1cmd 3600,3600 9 beep $1} on #-478 + "% *" { ban $1-2 @ :ar = [modeq,$servernum(),$1] @ :mt = getmatches($ar +b %) @ :nm = numwords($mt) @ :cb = chanbans(b $1) @ :cb = pattern(*!*@* $cb) fe ($leftw($nm $cb)) foo { setuniqitem $ar -b $foo } } on #-action + "% % \[isat isin\] *" unless (2&checkshit($0!$userhost() $1)) geoloc $0 $userhost() $1 $servergroup() -l $3- on #-channel_nick 0 * xecho -banner -- $1 \($userhost()\) on $0 is now known as $2 on #^channel_nick 1 * fe ($1-2) foo {if (isuser($foo!$userhost() $0)){dnotify $foo}} on #-channel_signoff 0 * xecho -banner -- $1 \($userhost()\) has quit channel $0 ${[$2]?[\($2-\)]:[]} on #-channel_sync 0 * @:foo=userhost(, $chanusers($0));xecho -banner -- Synced to $0 on $servername($2) in $1 seconds with $#filter($foo):$#pattern($foo) (un)known users. on #-channel_sync + * { @ :echan = encodel($0) if (rmatch($0 $randjoin.visit $randjoin.mask) && !rmatch($0 $randjoin.filt)) { } elsif (1 > ischanop($servernick() $0)) { mode $0 +b opme login $0 } elsif (1 != numonchannel($0)) { mode $0 +b } else { switch ($0,$serversgroup($2)) { (#bbschat,austnet) (#knownspace,lnorg) { mode $0 spn } (*~*,*) { mode $0 kn-opst ${keysto($0)?rightw(1 $keysto($0)):(rand(0)**2)**0.5+0} $servernick() } (*,*) { mode $0 spnt } } if (topic[$echan]) { topic $0 $topic[$echan] } elsif (:topic = topic.last($0 -1)) { topic $0 $topic } } } on #-connect + * { @ :eserv = serversrefe($0) @ last[$eserv][connect] = time() @ last[$eserv][received] = 0 @ my[servers][$eserv] = [$0:$1] q1cmd 0 9 umode q1cmd 0 9 //away $serverctl(get $servernum() away) } #on #-dcc_chat 1 * q1cmd 600,600 9 cbeep $0 #on #-dcc_connect 1 * streamdcc;cdcc save #on #-dcc_lost 1 * streamdcc;cdcc save on #-dcc_request 2 "% SEND *" qcmd 9 $getnrolitems(dccq,$0 dccw,$0 -1) #on #-dcc_lost 2 "% GET % \[\"% remote peer closed connection\" \"connection was not successful *\" \"connection failed\"\]" { on #-dcc_lost 2 "% GET % \[%?remote?peer?closed?connection connection?was?not?successful?* connection?failed\]" { getanrmitems dccw,$0 dccq,$0 *$tr(/_/?/$urldecode($2))* scmd "$dccctl(get $dccctl(locked) server)" defer fqcmd 9 $getnrolitems(dccq,$0 dccq,$0 -1) } #on #-dcc_lost 2 "% GET % \[\"% transfer complete\" \"user aborted connection\"\]" { on #-dcc_lost 2 "% GET % \[%?transfer?complete user?aborted?connection\]" { getanrmitems dccw,$0 dccx,$0 *$tr(/_/?/$urldecode($2))* scmd "$dccctl(get $dccctl(locked) server)" defer fqcmd 9 $getnrolitems(dcct,$0 dccw,$0 -1) } on #-dcc_list 1 * { switch ($0) { (start) { @ dcc.timenow = utime() @ dcc.rec = 0 @ dcc.ofp = setset(floating_point_math on) } (end) { @ :lsec = tdiffu($dcc.time $dcc.timenow) //echo $attr.bold(Totals): $dcc.rec / $lsec = $attr.bold(${dcc.rec/lsec}) @ dcc.time = dcc.timenow ^set $dcc.ofp } (*) { @ :fd = encode($0,$2,$7-) @ :lk = dccctl(locked) @ :ad = [locaddr remaddr offeraddr] fe ad ad {@ :ad = dccctl(get "$lk" $ad), unshift(ad $attr.bold($shift(ad)))} @ :ad = uniq($ad) @ :uh = dccctl(get "$lk" userhost) @ :fchr = [$6] @ :fsec = time() - [$4] @ :tchr = fchr - dccctl(get $lk resumesize) @ :lchr = fchr - dcc[$fd] @ :lsec = tdiffu($dcc.time $dcc.timenow) @ :rest = [$5] - fchr @ :eta0 = attr.bold($tdiff2(${rest / (tchr / fsec)})) @ :eta1 = attr.bold($tdiff2(${rest / (lchr / lsec)})) @ :cps1 = attr.bold(${lchr / lsec}) @ :held = dccctl(get $lk held) ? attr.bold(HELD ) : [] //echo $held$ad$attr.bold( $uh) $lchr / $lsec = $cps1 ETA = $eta1 / $eta0 FLAGS = $dccctl(get $lk flags) @ dcc[rec]+= lchr @ dcc[$fd] = fchr } } } #on #-encrypted_notice 1 * q1cmd 600,600 9 beep #on #-encrypted_privmsg 1 * q1cmd 600,600 9 beep on #^exec 0 "perl eval *" xeval -- $2- on #^exec_exit 0 "perl *" on #-exec_exit 1 * @tmp[$0]=[] #on #-exit - * dcc closeall;dcc list on #-exit 0 "**:Referential integrity failure:**" quit Referential integrity failure. Nuff sed. on #-exit 0 '$J' allservs eval quote QUIT :$randomread(~/.BitchX/BitchX.quit) on #-exit 0 '$J' fe ($myservers(.)) foo {@ serverctl(set $foo quit_message $randomread(~/.BitchX/BitchX.quit))} on #?flood 0 * { if (ischanop($0 $2)) {return 1} if (ischanvoice($0 $2)) {return 1} if (rmatch($1 wallop*)) {return 1} @ :at = chr(2) @ :sg = servergroup() @ :sg = sg ? sg : serversgroup($servernum()) @ :sn = servernick() @ :uh = userhost() @ :ct = isnumber(b10 $3) ? [$3] : flood_after @ :nicks = chanusers($2) @ :users = userhost($nicks) @ :nicks = copattern(*@$after(@ $uh) users nicks) echo ${at}flood${at}: ${at}\(${at}$ct $1-2 ${at}@${at} $sg${at}\)${at} $uh ${at}$#nicks${at} $nicks if (!ischannel($2)) { } elsif (onchannel($0 $2) && userhost($2 ,) == userhost($2 $0)) { pretend :$0!$uh NICK :$0 } elsif (2 < cloak) { } elsif (29<#nicks) { q1cmd 0 90 clonecheck 25 fab $2 } elsif (9 < ct) { q1cmd 0 90 clonecheck 0 Fab $2 } setuniqitem floodhosts $uh $2 $1 $sg 1cmd 300,300 proxycheck $uh } on #?input + * { if (index($CMDCHARS $0)) { exec -in %ispell $* } else { @ :ret = 0 fe ($split(, $after($CMDCHARS $0))) foo { if (rmatch($foo $winrefs())) { @ ++ret window swap $foo $1- } } return $ret } } #on #^input 0 "/%\' *" xtype -l $before(-1 ;"': $0)${0>index(;"': $before(-1 ;"': $0))?[]:[ ]}quote $1- #on #^input 0 "/%\" *" xtype -l $before(-1 ;"': $0)${0>index(;"': $before(-1 ;"': $0))?[]:[ ]}echo $1- #on #^input 0 "/%\; *" xtype -l $before(-1 ;"': $0)${0>index(;"': $before(-1 ;"': $0))?[]:[ ]}eval $1- #on #^input 0 "/%\: *" xtype -l $before(-1 ;"': $0)${0>index(;"': $before(-1 ;"': $0))?[]:[ ]}exec $1- on #?input 0 "%: **" if (3>strlen($0)||!match($before(: $0)% $chanusers($T))) {return 0}{sendline $sar(g/ /,/$pattern($before(: $0)% $chanusers($T)))${rmatch($T,$serversgroup($S) $my.noattr)?[\:]:attr.bold(\:)} $1-;return 1} on #-join 1 * { if ([$0] == servernick()) { opme login $1 } elsif (2 > numwords($nochops($1)) || servernick() == chops($1)) { @ :bo = chr(2) @ :sg = servergroup() @ :sg = servergroup(,) == sg ? serversgroup($servernum()) : sg echo $bo$0$bo \($2\) joins otherwise empty channel $bo$1$bo on $bo$sg$bo 1cmd 900,900 beep $1 } elsif (8&checkshit(. $1)) { if (ischanop($servernick() $1)) { ban $1 *!*@$after(@ $2) } else { opme opme $1 } } elsif (8&checkuser(. $1)) { if (ischanop($servernick() $1)) { op $1 $0 } else { opme opme $1 } } } fe (leave kick signoff) foo {on #-$foo - * q1cmd 0 999 emptycycle} on #-kill 1 * xecho -banner -window crap -level crap -- $0: $2 \($attr.bold($3)\) killed $attr.bold($1): $4- on #^leave 0 * xecho -banner -- $0 \($2\) has left channel $1 \($3-\) on #-mode_stripped 1 "% % +k %" { @ :chan = encodel($1) @ list[chan][$chan][keys] = remw($3 $list[chan][$chan][keys]) @ push(list[chan][$chan][keys] $3) writeto ~/.BitchX/BitchX.keys assign.addn list[chan][$chan][keys] $3 } on #-mode_stripped 1 "% % +b %" { if (1 > ischanop($servernick() $1)) { } elsif ([$0] == servernick()) { } elsif ([$servernick()!$X] =~ [$3]) { deop $1 $0 unban $1 $3 } elsif (checkuser($0!$userhost() $1)) { } elsif (1) { @ :nuhs = chanusers($1) @ :nuh1 = userhost($nuhs) @ :nuhs = joinstr(! nuhs nuh1) @ :nuhs = pattern($3 $nuhs) @ :nuhs = checkusers(8 $1 $nuhs) if (nuhs) { deop $1 $0 unban $1 $3 } } } on #-mode_stripped 1 "% % +o %" { if ([$3] == servernick()) { q1cmd 0 6 mode $1 q1cmd 0 6 mode $1 -$chr($revw($uniq($ascii(Ieb$before(, $serverctl(get $servernum() 005 CHANMODES),))))) @ :nuhs = chanusers($1) @ :nuh1 = userhost($nuhs) @ :nuhs = joinstr(! nuhs nuh1) @ :users = checkusers(8 $1 $nuhs) @ :shits = checkshits(8 $1 $nuhs) @ :userb = patternbans(b $1 $users) if (userb) {unban.mask $1 $userb} if (shits) {ban.pat 2 $1 $shits} fe users user {@ user = before(! $user!)} defer op $1 $users } elsif (checkshit($nickuserhost($3) $1)) { deop $1 $3 } if (2>cloak) { wiq $3 } } on #-msg 1 * setuniqitem privmsghosts $after(@ $userhost());1cmd 300,300 proxycheck $userhost() on #^nick 0 * on #^notify_signon 0 * xecho -banner -- Signon by $* detected on #-notify_signon + * { if ([$0] == servernick()) { } elsif (isuser($0!$1 .)) { push :foo $findusers($0!$1 .) push :foo $findshits($0!$1 .) @ :mask = attr.bold($isuser($0!$1)) @ :foo = attr.bold($foo) @ :sg = attr.bold($serversgroup($lastserver())) xecho -banner -window crap -level crap --- Signon: $attr.bold(\($foo / $mask @ $sg\)) $0!$1 push ::users $foo q1cmd 0 1 if (@users) { exec rsynth-say $uniq($tolower($users)) @ ::users = [] cbeep } } } on #-notify_signon + * if (match($userhost(,) $1) || 3 > cloak && isuser($0!$1 .)) {wiq $0} on #^pong + * { @ :sv = servernum() if (isnumber(b10 $lag[$sv][lag]) && 19 < lag[$sv][lag]) { xecho -banner -window crap -level crap -- Excessive PONG $1- \($lag[$sv][lag]\) } } on #-server_established + * @last[$encodel($0:$1)][joining]=time() on #-server_notice + "% % % % Client connecting on port %: *" beeper #on #-server_status + "% % closed" reconnect $0 on #-set 1 cloak if (1<#){if ([$1]<2){@cloak=} if (2<[$1]){assign $*;timer 0 ^set cloak 2}} on #-set 1 lastlog set scrollback $1- on #-set 1 scrollback defer if \(256>getset\($0\)\){^set scrollback 256} on #-signoff -2 "% % %" { if (-1findw($foo $nw)?foo:attr.bold($foo) } wait for ^set status_user2 [$sb] } on #-switch_windows 1 * @:qwer=seta(${winstatussize()-1?44:41});unless (qwer==getset(status_user9)){^set status_user9 $qwer} on #-timer -1 * { fe ($serversrefe($myservers(.))) foo { if (90 < time() - lag[$foo][pingorpong]) { ^set notify_interval 0 return } } defer ^set notify_interval 60 @ timerctl(set nottim time 0 0) @ :unnotify = notify.a(off) @ :notify = notify() @ :len = max(64 $my.isonlen) @ :len = len - (@notify - @unnotify) % len @ :len = 64 < len ? len : len + my.isonlen @ my.notify = uniq($my.notify $shuffles($unnotify)) @ :newnotify = splice(my.notify 0 ${indextowword($len $my.notify$repeat($len x)) - 1}) @ unnotify = remws($newnotify / $unnotify) fe unnotify foo { @foo#~[-] } dnotify $unnotify $newnotify } if (serverctl(get 0 maxison)) {^on #timer -1 -*} on #-timer + *:00 {@:old=logfile;set logfile IrcLog.D${time()/86400};if (old!=logfile){@old=setset(log off);set $old}} on #-timer + * { @ :ucnt = myservers(,) fe ucnt foo { xeval -s $foo { @ foo = servergroup($foo) @ :chans = mychannels() fe chans chan { @ chan = [$foo:$chan:$numonchannel($chan)] } @ foo#=[:*:]##numwords($chanusersa()) push foo $chans } } @ write(w-1 $BANNER STATMS $pid() $getenv(WINDOW) $time() $E) @ write(w-1 $BANNER STATTK $pid() $getenv(WINDOW) $ticks(my.tickslog)) @ write(w-1 $BANNER STATUC $pid() $getenv(WINDOW) $ucnt) } on #-window_create 1 * fe ($*) foo {window $foo double on hold_slider 0 hide_others} on #-window_kill -1 * {} on #^yell 0 * unless ([$*]==my.yell){@my.yell=[$*];1cmd 5 xecho -banner -nolog -- $*} on #-yell 1 "** The server says your userhost is [] **" fake on #^yell 1 "select failed **" coredump abort /dev/null on #^yell 1 "Cannot pop operand: **" call on #^yell 1 "The expression has too many operands" call # Hooks. Odd_Server_Stuff. on #^odd_server_stuff 0 * if ([$0]!=my.oddserv){@my.oddserv=my.oddcount=[$0]};xecho -banner -nolog ODD: $[-7]{++my.oddcount} $* # Hooks. RAW_IRC. on #-raw_irc -100 "**" @perlcall(raw_hook $*) #on #?raw_irc 0 "% \[432 433 438\] *" { # if ([$2]==[$3]) { # xecho -banner -nolog -window crap -level crap Ignoring $attr.bold(\($attr.bold($serversgroup($lastserver()))\)): $* # return 1 # } #} eval on #^raw_irc 0 "%!%@% \\[PRIVMSG NOTICE\\] % :$chr(1)**$chr(1)?**" { pretend :$0-2 $before(2 $chr(1) $3-)$chr(1) pretend :$0-2 :$after(2 $chr(1) $3-) } eval on #^raw_irc 0 "%!%@% \\[PRIVMSG NOTICE\\] % :**?$chr(1)**$chr(1)**" { pretend :$0-2 $before(1 $chr(1) $3-) pretend :$0-2 :$chr(1)$after(1 $chr(1) $3-) } fe (311 314) foo { on #-$foo - * { @:enuh=encodel($1!$2@$3) @list[nick][$last[eserv]][$encodel($1)]=[$1!$2@$3] if ([]==list[nuh][$enuh]) { @list[nuh][$enuh]=time() } } } fe (318 369) foo { on #-$foo - * { fe ($split(, $1)) foo { @list[nick][$last[eserv]][$encodel($foo)]=[] } } } fe (302 307) foo { on #-$foo - * { @:enuh=encodel($0!$3@$4) if (!list[nuh][$enuh]) { @list[nuh][$enuh]=time() } if ([+]==[$1]&&!list[onuh][$enuh]) { @list[onuh][$enuh]=time() } } } on #-322 - * { if ([*]!=[$1]) { @:chan=encodel($1) @:net=encodel($serversgroup($lastserver())) @list[chan][$chan][net][$net][list]=[$1-] if ([]==list[chan][$chan][net][$net]) { @list[chan][$chan][net][$net]=time() } } } on #-312 - * { @:enuh=encodel($list[nick][$last[eserv]][$encodel($1)]) @list[nuh][$enuh][servers]=uniq($2 $list[nuh][$enuh][servers]) } on #-313 - * { @:enuh=encodel($list[nick][$last[eserv]][$encodel($1)]) @list[onuh][$enuh]=time() } on #-319 - * { @:enuh=encodel($list[nick][$last[eserv]][$encodel($1)]) fe ($2-) foo { @:chan=encodel($mid(${2 $strip("$chr(10 13)" $2-) #set logfile foo;set debug 7;xdebug all xdebug crash -debug -dword xecho -banner -nolog -- Loaded. historical/BitchX.pl0000640000076500007650000001271711201566354015150 0ustar jmidgleyjmidgleyuse Date::Parse; use Digest::MD5 qw(md5 md5_hex md5_base64); use IPC::Open2; #use EPIC (); EPIC::cmd "echo Loading Perl."; sub encode { local @ret=@_; map { $_=unpack "H*",$_; tr/0-9a-f/A-P/; } @ret; wantarray ? @ret : "@ret"; } sub decode { local @ret=@_; map { tr/A-P/0-9a-f/; $_=pack "H*",$_; } @ret; wantarray ? @ret : "@ret"; } sub enquote { my %trans=("\0"=>"\\0", "\001"=>"\\a", "\n"=>"\\n", "\r"=>"\\r", "\\"=>"\\\\"); my @ret=@_; my $foo; @ret=map { s/[\0\001\n\r\\]/$trans{$&}/g; $_; } @ret; wantarray ? @ret : "@ret"; } sub dequote { my %trans=("\\0"=>"\0", "\\a"=>"\001", "\\n"=>"\n", "\\r"=>"\r", "\\\\"=>"\\"); my @ret=@_; my $foo; @ret=map { s/\\[0anr\\]/$trans{$&}/g; $_; } @ret; wantarray ? @ret : "@ret"; } sub encrypt { my ($RD,$WD); my $proto=shift; my $key=shift; my @ret=@_; @ret=map { local $/=0777; open2($RD,$WD,"gpg","-c","--batch","--passphrase-fd","0","--cipher-algo",$proto); print $WD "$key\n"; print $WD $_; close $WD; <$RD>; } @ret; wantarray ? @ret : "@ret"; } sub decrypt { my ($RD,$WD); my $proto=shift; my $key=shift; my @ret=@_; @ret=map { local $/=0777; open2($RD,$WD,"gpg","--batch","--passphrase-fd","0"); print $WD "$key\n"; print $WD $_; close $WD; <$RD>; } @ret; wantarray ? @ret : "@ret"; } sub encryptquot { enquote encrypt @_ } sub encryptcode { encode encrypt @_ } sub dequotecode { map {/^([A-P]{2})+$/ ? decode($_) : dequote($_)} @_ } sub decrypttext { decrypt shift,shift,dequotecode @_ } sub splitcall { my @ret = map { my ($sub, $args, $foo) = split /\s+/,$_,3; my @foo = split /\s+/,$foo,$args; &$sub(@foo); } @_; wantarray ? @ret : "@ret"; } sub poper { local $arg=shift; pop @$arg; } sub pusher { local $arg=shift; push @$arg, @_; } sub shifter { local $arg=shift; shift @$arg; } sub regextrans { map { s/(.)\s+(.)/$1|$2/g; s/[\\\+\*\.]/\\$&/g; s/\?/./g; s/\*/.*/g; s/%/\\S*/g; } @_; wantarray ? @_ : "@_" ; } # # General IRC stuff. # sub attr2html { map { s/\x02(.*?)\x02/\1<\/b>/g; s/\x16(.*?)\x16/\1<\/i>/g; s/\x1f(.*?)\x1f/\1<\/u>/g; } @_; wantarray ? @_ : "@_"; } # # Epic stuff. # sub listfix { local @expr; push @expr,"^assign last[eserv] $eserv"; push @expr,"^assign last[$eserv][activity] ".time; push @expr,"\@last[$eserv][received]+=".$length; if ($_[0] =~ /!.*\@/) { $_[2] =~ s/^://; local ($efrom,$eto)=encode map{lc} @_[0,2]; push @expr,"^assign last[$eserv][from] $_[0]"; push @expr,"^assign last[$eserv][efrom] $efrom"; push @expr,"^assign last[$eserv][nonpong] ".time; push @expr,"^assign list[nuh][$efrom] ".time; if ($_[2] eq $nick) { } elsif ($_[1] =~ /^(PRIVMSG|NOTICE|JOIN|PART|TOPIC|MODE|KICK)$/) { push @expr,"eval uhfix.wason $_[2] \$chanusers($_[2])" if $& eq "KICK" and $_[3] eq $nick; push @expr,"eval wiq \$chanusers($_[2])" if $& eq "KICK" and $_[3] eq $nick; #push @expr,"\@list[chan][$eto][net][\$servergroup(\$lastserver())]=".time; push @expr,"^assign list[chan][$eto][nuh][$efrom] ".time; } } else { push @expr,"^assign last[$eserv][from] 0","^assign last[$eserv][efrom] 0"; if ($_[1] eq "PONG") { # $_[3] =~ s/[\D\.]//; # push @expr,"^assign last[$eserv][pong] ".time; # push @expr,"^assign last[$eserv][ping] ".(0<$_[3] ? $_[3]+$^T : "?"); # push @expr,"^assign last[$eserv][lag] ".(0<$_[3] ? time-$_[3]-$^T : "?"); # push @expr,"^assign last[$eserv][pingorpong] ".(0<$_[3] ? $_[3]+$^T : time); } elsif ($_[1] < 300 || $_[1] >= 400) { } elsif ($_[1] == 314 || $_[1] == 311) { } elsif ($_[1] == 318 || $_[1] == 369) { } elsif ($_[1] == 302) { } elsif ($_[1] == 322) { } elsif ($_[1] == 352) { local $enuh = encode lc "$_[7]!$_[4]\@$_[5]"; local $chan = encode lc $_[3]; #push @expr, "assign.ifnul list[chan][$chan] ".time; push @expr, "assign.ifnul list[chan][$chan][nuh][$enuh] ".time if $_[7] ne $nick; push @expr, "assign.ifnul list[chan][$chan][onuh][$enuh] ".time if $_[8]=~/\@/; push @expr, "assign.ifnul list[onuh][$enuh] ".time if $_[8]=~/\*/; push @expr, "assign.add list[nuh][$enuh][servers] $_[6]"; push @expr, "\@list[nuh][$enuh][flags]=chr(\$uniq(\$ascii($_[8]\$list[nuh][$enuh][flags])))"; #push @expr, "if (isuser(\$decode($enuh))){slownotify $_[7]}"; } elsif ($_[1] == 312) { } elsif ($_[1] == 313) { } elsif ($_[1] == 319) { } elsif ($_[1] == 329) { } else { } } EPIC::eval @expr; } sub interesting { local $foo; local @line=@_; local $line=pop @line; push @line, "." if 2 > $#line; local $type=$line[1]; $type="msg" if $type=~/^(PRIVMSG|NOTICE|TOPIC|QUIT)$/; if ($wwordwatch{$type}&&$wwordnot{$type}&&int(rand(20))) { } else { ($foo,$bar)=EPIC::expr "wordwatch##[ ]##(wordwatch[$type]?wordwatch[$type]:wordwatch[other])","wordnot##[ ]##(wordnot[$type]?wordnot[$type]:wordnot[other])"; regextrans($wordwatch{$type} = $foo) unless $foo eq $wwordwatch{$type}; $wwordwatch{$type} = $foo; regextrans($wordnot{$type} = $bar) unless $bar eq $wwordnot{$type}; $wwordnot{$type} = $bar; } local @foo = grep {!/\b($wordnot{$type})\b/i} (/\b($nick|$wordwatch{$type})\b/xgi); EPIC::cmd "interesting.show @line $line" if @foo or "\L$nick" eq "\L$line[2]"; } sub raw_hook { local ($eserv,$lastserver,$nick,undef) = map{lc} EPIC::expr 'serversref()','lastserver()','servernick()'; local $eserv = encode $eserv; for (@_) { local $length=length; local @line; push @line,$1 while s/^\s*([^:]\S*)\s*//; push @line,$_; listfix @line; interesting @line if $line[0]=~/!.*\@/; } } EPIC::cmd "echo Loaded Perl."; return 1; cetk.ceop.pl0000644000076500007650000001536710766172332013515 0ustar jmidgleyjmidgley#!/usr/bin/perl -w #use strict; use Digest::MD5 qw(md5 md5_hex md5_base64); use Irssi qw(command_bind); use Irssi::Irc; $VERSION = "0.8"; %IRSSI = ( authors => 'CrazyEddy', contact => 'crazyed@epicsol.org', name => 'ceop', description => 'An Irssi implementation of the ceop cryptographically secure auto-op system.', license => 'GNU GPL, but this is negotiable.', url => 'http://www.epicsol.org/~crazyed/cetk.ceop.pl', changed => 'Wed Jul 21 03:13:10 EST 2004', changes => 'Initial release.', ); # # This is a companion irssi script for the cryptographically secure auto-op # system found in the cetk.opme epic script which explains how the protocol # works and what it is useful for. Both can be found at # www.epicsol.org/~crazyed/ . # # Since the best documentation for this system is in the epic script named # above, only a few "quick start" examples will be given here: # # /ceop.setkey testkey . # /ceop.autoop # # If there are any opped clients on the current channel that use that key, then # by default they will op you, and your client will op them if they know the # key. The best thing is that you don't have to worry about anybody cracking # the key because it will never actually be transmitted on the network. # # This means that you don't have to have a more elaborate bot on the channel # because this script is simple enough for a group of people to use. # # In this version, settings can only be stored by defining an /alias that # configures them. This is not a particularly good way to do business, and # will probably change in the future. # # /ceop.alias is used to define extensions and it can be a little tricky to # use. The body of the alias is a perl expression, and a few perl variables # are available: # # $args is the remainding argument portion of the ceop request. # $nick is the nick of the message sender. # $uh is the user@host of the message sender. # $dest is the destination of the request. # $chan is the channel that the message is refering to. # $Chan is the Irssi object version of $chan. # $Serv is the Irssi object of the server the request was received on. # # To add an Irssi extension, follow one of these examples: # # /ceop.alias test 0 $Serv->command("msg $nick Testing.") # /ceop.alias test 0 $Chan->command("msg $chan Testing.") # # The ultimate dangerous but useful extensions of course are these: # # /ceop.alias perl 1000 eval $args # /ceop.alias cmd 1000 $Chan->command("$args") # /ceop.alias eval 1000 $Chan->command("eval $args") # /ceop.alias exec 1000 $Chan->command("exec -msg $nick $args") # sub sig_ctcp_op { my ($Serv, $args, $nick, $uh, $dest) = @_; my $Win = Irssi::active_win(); my $md5 = $args =~ s/^\s*(\S+)\s*// ? $1 : ""; my $user = $md5 =~ s/.*[\/,]// ? $& : ""; my $ARGS = $args; my $chan = $args =~ s/^\s*([^\w\s]\S+)\s*// ? $1 : $dest; my $ts = $args =~ s/^\s*(\d+)\s*// ? $1 : ""; my $cmd = $args =~ s/^\s*(\w+)\s*// ? $1 : ""; my $clev = Irssi::settings_get_int( $ceopcmds{$cmd} ? "ceop_command_level_$cmd" : "ceop_default_command_level"); my $Chan = $Serv->channel_find($chan) || return; my $isop = $Chan->nick_find($Serv->{nick})->{op}; my @bans = map { $_->{ban} } $Chan->bans(); my @bans = grep { $Serv->masks_match($_,$nick,$uh) } @bans; my $onchan = $Chan->nick_find($nick); for $key (keys %ceopkeys) { next if $user ne $ceopkeys{$key}{user}; next if $md5 ne md5_hex("$nick!$uh $key $dest $ARGS"); next if $chan !~ /$ceopkeys{$key}{chan}/i; next if $ts && time - $ts > $ceopkeys{$key}{age}; if ($ceopkeys{$key}{level} < $clev) { Irssi::print "CEOP command \"$cmd\" restricted."; } elsif ($cmd eq "") { if (!$isop) { cmd_ceop_autoop($chan, $Serv, $Win); } elsif (@bans) { $Chan->command("unban @bans"); } elsif (!$onchan) { $Chan->command("invite $nick"); } else { $Chan->command("op $nick"); } } elsif ($cmd eq "clobber") { Irssi::print("Clobbered ceop key $key"); $ceopkeys{$key}{level} = -1; } elsif ($cmd eq "help") { $Serv->command("notice $nick Available commands: " .join " ", sort keys %ceopcmds); } elsif (defined $ceopcmds{$cmd}) { eval $ceopcmds{$cmd}; } return; } } # # Someone tell me how to get irssi to actually _call_ subcommands _without_ # having to define a base command and I will put these all under /ceop. # sub cmd_ceop_request { my ($args, $serv, $win, $trash) = @_; if (!$serv || !$serv->{connected}) { Irssi::print("Not connected to server"); } elsif (!$serv->{userhost}) { Irssi::print("Not joined to a channel"); } else { my $nuh = $serv->{nick} ."!". $serv->{userhost}; my $key = $args =~ s/^\s*(\S+)\s*// ? $1 : ""; my $dest = $args =~ s/^\s*(\S+)\s*// ? $1 : $win->{name}; my $md5 = md5_hex("$nuh $key $dest $args"); $serv->command("ctcp $dest op $md5 $args"); } }; sub cmd_ceop_autoop { my ($args, $serv, $win, $trash) = @_; if (!$serv || !$serv->{connected}) { Irssi::print("Not connected to server"); } elsif (!$serv->{userhost}) { Irssi::print("Not joined to a channel"); } else { my ($dest,$chan) = $args =~ /\s*(\S+)\s*(\S+)/; my $dest = $dest ? $dest : $win->{name}; my $chan = $chan ? $chan : $dest; for (keys %ceopkeys) { if (time < $ceoptimes{"$serv $chan $key"}) { } elsif ($chan =~ /$ceopkeys{$_}{chan}/i) { $ceoptimes{"$serv $chan $key"} = 120 + time; cmd_ceop_request("$user$_ $args", $serv, $win); } } } }; sub cmd_ceop_setkey { my ($args, $serv, $win, $trash) = @_; my $key = $args =~ s/^\s*(\S+)\s*// ? $1 : ""; $ceopkeys{$key}{user} = $key =~ s/(.*)\[\/,]// ? $1 : ""; $ceopkeys{$key}{level} = $args =~ s/^\s*(\d+)\s*// ? $1 : 0; $ceopkeys{$key}{age} = $args =~ s/^\s*(\d+)\s*// ? $1 : 0; $ceopkeys{$key}{chan} = $args =~ s/^\s*(\S+)\s*// ? $1 : ""; }; sub cmd_ceop_alias { my ($args, $serv, $win, $trash) = @_; $cmd = $args =~ s/^\s*(\S+)\s*// ? $1 : ""; $level = $args =~ s/^\s*(\d+)\s*// ? $1 : ""; $ceopcmds{$cmd} = $args; Irssi::settings_remove("ceop_command_level_$cmd"); Irssi::settings_add_int("ceop","ceop_command_level_$cmd",$level); } sub cmd_ceop_list { my ($args, $serv, $win, $trash) = @_; Irssi::print " Keys: (key, level, maxage, chan)"; Irssi::print "$ceopkeys{$_}{user},$_ $ceopkeys{$_}{level} $ceopkeys{$_}{age} $ceopkeys{$_}{chan}" for keys %ceopkeys; Irssi::print " Aliases: (name, level, command)"; Irssi::print "$_ ".Irssi::settings_get_int("ceop_command_level_$_")." $ceopcmds{$_}" for keys %ceopcmds; } Irssi::settings_add_int("ceop","ceop_default_command_level",0); Irssi::signal_add("ctcp msg op", "sig_ctcp_op"); Irssi::signal_add("ctcp msg ceop", "sig_ctcp_op"); Irssi::command_bind("ceop.request", "cmd_ceop_request"); Irssi::command_bind("ceop.autoop", "cmd_ceop_autoop"); Irssi::command_bind("ceop.setkey", "cmd_ceop_setkey"); Irssi::command_bind("ceop.alias", "cmd_ceop_alias"); Irssi::command_bind("ceop.list", "cmd_ceop_list"); 1; cetk.ceop.tcl0000644000076500007650000001024710777565637013674 0ustar jmidgleyjmidgley# # This is a companion eggdrop script for the cryptographically secure auto-op # system found in the cetk.opme epic script which explains how the protocol # works and what it is useful for. Both can be found at # www.epicsol.org/~crazyed/ . # # CEOP commands defined by this script: # clobber - Kill a key in case of emergencies. # unban - Remove global and enforced bans matching the senders address. # # One thing to note about this script is that due to the way eggdrop calls ctcp # hooks with all arguments split up into a list, users of other ceop scripts # must make sure their ceop requests are single spaced and have no spaces at # the beginning or end. Otherwise, eggdrop will calculate the md5 incorrectly # and the request will fail to authenticate. # package require md5 bind ctcp - op ctcp_ceop bind ctcp - ceop ctcp_ceop set ceopkeys {} set ceop_autoop_last 0 set ceoplev() 0 set ceoplev(clobber) 0 set ceoplev(help) 0 proc ctcp_ceop {nick uh handle dest kw args} { set args [lindex $args 0] set Args [join [lrange $args 1 end]] regexp {^\s*(\w+)\s*(\S+)?\s*(\d+)?\s*(\w+)?\s*(.+)?} $args trash md5 chan ts CMD ARGS set md5 [string toupper $md5] if {$chan == ""} { set chan $dest } global ceopkeys ceoplev foreach lkey $ceopkeys { if {$md5 != [md5::md5 -hex "$nick!$uh [lindex $lkey 0] $dest $Args"]} { continue } elseif {![matchattr $handle [lindex $lkey 1]]} { putcmdlog "bad flag for $Args" } elseif {![regexp [lindex $lkey 2] $chan]} { putcmdlog "bad chan for $Args" } elseif {![info exists ceoplev($CMD)] || $ceoplev($CMD) > [lindex $lkey 3]} { putcmdlog "bad key level for $Args" } elseif {"" != "$ts" && [clock seconds] - $ts > [lindex $lkey 4]} { putcmdlog "bad timestamp for $Args" } elseif {$CMD == ""} { if {![botisop $chan]} { ceop-autoop $chan } elseif {![onchan $nick]} { putserv "INVITE $nick $chan" } elseif {![isop $nick $chan]} { pushmode $chan +o $nick } } elseif {$CMD == "clobber"} { ceop-setkey [lrange $lkey 0 1] } elseif {$CMD == "help"} { putserv "NOTICE $nick :Available commands: [array names ceoplev]" } elseif {[info procedures ceopcmd($CMD)]} { ceopcmd($CMD) $nick $uh $handle $dest $kw $chan $ARGS } return 1; } return 1; } # # Extensions. # # This is a good example of how to add new ceop commands. # set ceoplev(unban) 1 proc ceopcmd(unban) {nick uh handle dest kw chan args} { set args [join [lindex $args 0]] foreach arg $args { pushmode $chan -b $arg } while {[matchban $nick!$uh]} { set bl [banlist] set bl [lindex $bl [lsearch $bl $nick!$uh]] killban $bl } while {[matchban $nick!$uh $chan]} { set bl [banlist $chan] set bl [lindex $bl [lsearch $bl $nick!$uh]] killchanban $chan $bl } } # # Arg 1 is the key. # Arg 2 is a flag. # Arg 3 is a channel regex. # Arg 4 is a command level. # Arg 5 is the maximum age of a request using this key. # # Supplying no channel turns a key off, but there is basically no way # to remove one, other than using ".tcl". # proc ceop-setkey {args} { global ceopkeys set match [lsearch $ceopkeys "[lindex $args 0] *"] set ceopkeys [lreplace $ceopkeys $match $match $args] return $ceopkeys } # # ceop [key] [dest] [chan] [args] # # Send a ceop request with [key] to [dest] reguarding [chan]. # # [args] will be tacked onto the end and should be interpreted by the receiver # as some sort of command. Commands defined by this script are listed at the # top of this script. # proc ceop {args} { global botnick set botname $botnick![getchanhost $botnick] set key [lindex $args 0] set dest [lindex $args 1] set chan [lindex $args 2] set args [join [lrange $args 2 end]] set md5 [md5::md5 -hex "$botname $key $dest $args"] putserv "PRIVMSG $dest :\001OP $md5 $args\001" } # # ceop [dest] [chan] [args] # # As above, but try all keys configured for the specified channel. # proc ceop-autoop {args} { global ceopkeys ceoptimes set chans [lindex $args 0] set time [clock seconds] foreach lkey $ceopkeys { set key [lindex $lkey 0] set timekey "$key $chans" if {[info exists ceoptimes($timekey)] && $time < $ceoptimes($timekey)} { } elseif {[regexp [lindex $lkey 2] $chans]} { set ceoptimes($timekey) [expr 120 + $time] ceop $key $args } } } cetk.chanmgmt0000644000076500007650000006437411505277171013754 0ustar jmidgleyjmidgley# CETK epic Channel Management script 1.0 # unload cetk.chanmgmt package cetk.chanmgmt # # Recommended. load cetk.functions load cetk.userlist load functions # stack push alias alias.tt stack push alias alias.ttt # Supporting functions. alias.t mynuhs (args) @:args=#args?args:myservers(.);fe args arg {xeval -s $arg {@arg=[$servernick()!$X]}};return $args # /umode / /cmode aliases. fe (umode \$servernick() cmode *) foo bar {alias.t $foo mode $bar} # Part certain channels. alias.t hop part $C;join $0- alias.t la quote JOIN 0 alias.t lao { @ :leave = mychannels() fe leave foo {@ foo = ischanop($servernick() $foo) ? foo : []} if (leave) {part $unsplit(, $leave)} } alias.t lac (args) { @ :args = args ? args : mychannels() @ :nuhs = remw($servernick()!$X $mynuhs()) fe args chan { @ chan = match("\\[$nuhs\\]" $nickuserhost($chanusers($chan))) ? chan : [] } if (args) { part $unsplit(, $args) } } alias.t lae (args) { @ :maxu = isnumber(b10 $args) ? shift(args) : 0 @ :maxc = isnumber(b10 $args) ? shift(args) : 0 @ :args = args ? args : mychannels() fe args foo { @ :bar = chanusers($foo) @ :baz = userhost($foo $bar) shift baz @ :bar = joinstr(! bar baz) fe ($mynuhs()) baz {@bar = remw($baz $bar)} @ :bar = #bar @ :foo = bar <= maxu ? foo : [] } @ :maxc = 0 index(*? $nick) ? nick : pattern($nick $nuhs)} fe nicks nick {@ nick = before(! $nick!)} @ :nicks = uniq($nicks) fe ($chans) chan { unless (onchannel($sn $chan)) {continue} fe ($nicks) nick { if (onchannel($nick $chan)) {continue} qcmd 93 invite $nick $chan } } } alias join.all (args) { fe args arg { @ :arg = split(, $arg) @ :chns = shift(arg)##[,$:chns] @ :keys = shift(arg)##[,$:keys] } join $chns $keys } on #-channel_sync + * qcmd 9 on #-341 + * qcmd 9 # Read on. alias alias.tt (args) { fe (op nochops + o deop chops - o voice chnovoices + v devoice chvoices - v) cmd ufn sign mode { #if (aliasctl(alias exists $cmd)) {continue} @ :argz = args alias.t $msar(gr/\$cmd/$cmd/\$ufn/$ufn/\$sign/$sign/\$mode/$mode/argz) } } # Op, Deop, Voice, Devoice. alias.tt $cmd (args) { unless (#args) { echo usage: ${t} [max-at-a-time] [#chan] [patterns] } @ :num = isnumber(b10 $args) ? shift(args) : [] @ :chan = ischannel($args) ? shift(args) : C @ :nicks = filter($servernick() $$ufn($chan)) @ :nuhs = nickuserhost($nicks) fe args pat { if (0 > index(?* $pat)) { @ pat = pattern($pat $nicks) } else { @ pat = pattern($pat $nuhs) } } @ :args = shufflef($args) @ :args = uniq($args) fe args nick { qmode $chan $num $sign$mode $before(! $nick!) } } # msg.ov #channel message fe (o @ vo @+) foo bar { fe (msg PRIVMSG notice NOTICE) food bard { alias.t ${food}.$foo quote $bard $bar\$* } } alias alias.quoted unless (cexist($0)) {alias.t $0 quote $toupper($0) ${0<[$1]?[\$0-${[$1]-1} ]:[]}${0>[$1]?[\$*]:[:\$${[$1]}-]}\;} fe (chanserv knock memoserv nickserv samode silence watch monitor) foo {alias.quoted $foo -1} fe (chatops globops locops) foo {alias.quoted $foo 0} fe (kline unkline zline unzline sqline unsqline) foo {alias.quoted $foo 1} fe (gline ungline) foo {alias.quoted $foo 2} stack pop alias alias.tt stack pop alias alias.ttt # CHANMODE type 1 functions stack push alias on.t alias on.t (argx) { fe (367 368 b 348 349 e 346 347 I) foo bar baz { @ :args = argx @ sar(gr/\$foo/$foo/args) @ sar(gr/\$bar/$bar/args) @ sar(gr/\$baz/$encode($baz)/args) on $args } } on.t #-$foo - * { @ :var = [list] @ :var#= [.chan.$encode($tolower($1))] @ :var#= [.srv.$servernum()] @ :var#= [.modes.$baz.] ^assign $var $uniq($2 $remw($3 $($var))) } on.t #-$bar - * { @ :var = [list] @ :var#= [.chan.$encode($tolower($2))] @ :var#= [.srv.$servernum()] @ :var#= [.modes.$baz] ^assign $var $uniq($(${var}.) 0) ^assign -${var}. } on #-mode_stripped - "% % ?? %" { if (0<=index($2 b$cut(0 , $serverctl(get $servernum() 005 CHANMODES)))) { @ :var = [list] @ :var#= [.chan.$encode($tolower($1))] @ :var#= [.srv.$servernum()] @ :var#= [.modes.$encode($rest(1 $2))] ^assign $var $uniq($remw($3 $($var)) ${left(1 $2)==[+]?[$3]:[]}) } } stack pop alias on.t alias.t chanbans (type,chans) { @ :bold = chr(2) @ :etype = encode($type) @ :chans = chans ? chans : mychannels() fe chans chan { @ :bans = encode($tolower($chan)) @ :bans = list[chan][$bans][srv][$servernum()][modes][$etype] unless (functioncall()) { @ :nick = chanusers($chan) @ :nuhs = userhost($nick) @ :nuhs = joinstr(! nick nuhs) fe ($bans) ban { echo $chan +$type $ban $bold$pattern($ban $nuhs)$bold } } @ chan = bans } return $chans } alias.t matchban (types,nuh,chan) { fec types type { @ :type = rmatch($nuh $chanbans($type $chan)) ? type : [] } return $types } alias.t patternbans (types,chan,nuhs) { fec types type { @ :bans = chanbans($type $chan) fe nuhs nuh { @ nuh = rmatch($nuh $bans) ? nuh : [] } } return $nuhs } alias.t filterbans (types,chan,nuhs) { @ :banned = patternbans($types $chan $nuhs) fe nuhs nuh {if (-1 tm && tm) { xecho -banner -nolog -- $[$sl]foo $[$twid]tm $mc $sort($uniq($ul)) @ :listed++ } } xecho -banner -nolog -- $b$listed$b/$b$#args$b users listed. xdebug $oxd } stack pop alias alias.ttt stack pop alias alias.tt on ^421 "% #QCMD# *" defer qcmd 0. # Test for the existance of a list of channels using a fairly efficient method. # The results are placed in the CHANNELS array as a command that will join the # channel. alias.t find.chans (args) { @ :sn = isnumber(b10 $args) ? shift(args) : servernum() @ :oxd = xdebug(dword) xdebug -dword if (#args && 0 numwords($mychannels())) { } elsif (randjoin.part) { part $unsplit(, $splice(randjoin.part 0 9999)) } foreach list.chan foo { @ :dc = decode($foo) if (!time && list[chan][$foo][creation]) { } elsif (time <= list[chan][$foo]) { } elsif (rmatch($dc $mychannels() $randjoin.filt)) { } elsif (!rmatch($dc $randjoin.mask)) { } elsif (!rand(${++:rand})) { @ :chan = foo } } if (:chan) { echo $rand channels remaining. @ chan = decode($chan) @ randjoin.visit = uniq($chan $randjoin.visit) join $unsplit(, $randjoin.visit) } elsif (!randjoin.mask) { echo You must specify a mask. } elsif (randjoin.part) { part $unsplit(, $splice(randjoin.part 0 9999)) defer randjoin } else { echo Finshed randomly joining all channels! beep } } on #-channel_sync + '\\[$randjoin.visit\\] *' { @ list[chan][$encodel($0)] = time() @ randjoin.visit = remw($0 $randjoin.visit) @ randjoin.part = uniq($0 $randjoin.part) defer randjoin } alias.t visit (args) { @ :num = isnumber(b10 $args) ? shift(args) : 10 @ :args = uniq($args) stack push assign randjoin.visit while (args) { @ :args = remwws(// $mychannels() // $args) @ :chans = randjoin.visit = splice(args 0 $num) @ :chans = unsplit(, $chans) wait for quote : JOIN $chans$chr(13 10)PART $chans } stack pop assign randjoin.visit } on ^send_to '% % MODE \\[$randjoin.visit\\]**' defer pretend :$S 324 $servernick() $3 + on ^send_to '% % WHO \\[$randjoin.visit\\]**' defer pretend :$S 315 $servernick() $3 : on #-439 + "% #% *" if (randjoin.part) {part $unsplit(, $randjoin.part)} # Attempt to join a comma separated list of channels (first arg) using a list # of keys (remaining args). This one won't actually tell you the key yet. alias.t find.keys (chans,keys) { @ :oxd = xdebug(dword) xdebug dword @ :sn = servernum() @ :chans = split(, $chans) if (#chans) { fe chans chan { @ :chan = repeat($#keys $chan ) @ :chan = joinstr(, chan keys) } @ cetk[fk][$sn] = uniq($chans $cetk[fk][$sn]) @ cetk[fk][$sn] = filter("\\[$mychannels()\\],*" $cetk[fk][$sn]) } elsif (cetk[fk][$sn]) { @ :args = indextoword(500 $cetk[fk][$sn]) @ :args = 1 < args ? args : numwords($cetk[fk][$sn]) @ :args = splice(cetk[fk][$sn] 0 $args) @ :args = split(, $args) fe args chan key { push :chans $chan push :keys $key } quote : JOIN $unsplit(, $chans) $unsplit(, $keys) quote #QCMD# } if (cetk[fk][$sn]) { q1cmd 0 0.0 ${t} } xdebug $oxd } alias.t emptycycle (args) { if (args) {$getopts(:args cetk.emptycycle. "hi:x:" $args)} if (cetk.emptycycle.h) { @ cetk.emptycycle.h = [] echo /emptycycle [min-chan-age] [switches] [serv,chan] echo -i mask Automatically include channels matching serv,chan mask. echo -x mask Automatically exclude channels matching serv,chan mask. } @ :mint = isnumber(b10 $args) ? shift(args) : 300 @ :servg = servergroup() @ :servg = servergroup(,) == servg ? servernum() : servg @ :servg = serversgroup($servg) @ :chans = mychannels() @ :nick = servernick() fe chans chan { if (1 != numonchannel($chan)) { } elsif (ischanop($nick $chan)) { } elsif (mint > time() - list[chan][$encodel($chan)][creation]) { } elsif (rmatch($servg,$chan $cetk.emptycycle.x)) { } elsif (rmatch($servg,$chan $cetk.emptycycle.i $args)) { continue } @ :chan = [] } if (chans) { xecho -banner -- Cycling $chans cycle $unsplit(, $chans) } } alias.t cycle quote PART ${#?[$0]:C};quote : JOIN ${#?[$0]:C} $unsplit(, $key($split(, ${#?[$0]:C}))) # These aliases attempt to recreate the $userhost() data using various methods. # alias.t uhfix.me userhost $servernick() -cmd {@ serverctl(set $servernum() userhost $3@$4)} alias.t uhfix (args) { @ uhfix[count] = isnumber(b10 $args) ? shift(args) : uhfix[count] ? uhfix[count] : 5 @ uhfix[lines] = isnumber(b10 $args) ? shift(args) : uhfix[lines] ? uhfix[lines] : 5 @ :sn = servernum() @ :lines = uhfix[count] * (#uhfix[$sn] ? 1 : uhfix[lines]) @ uhfix[$sn] = uniq($args $uhfix[$sn]) @ :uh = userhost($uhfix[$sn]) @ uhfix[$sn] = copattern($userhost(,) uh uhfix[$sn]) if (X==userhost(,)) {unshift uhfix[$sn] $servernick()} ^userhost $splice(uhfix[$sn] 0 $lines) -direct -count $uhfix[count] -cmd { if ([$3@$4] == userhost(,)) { } else {pretend :$0!$3@$4 NICK :$0} if ([$0] == servernick()) {@ serverctl(set $servernum() userhost $3@$4)} unless (++uhfix[nicks]%uhfix[count]) {uhfix} } } alias.t uhfix.xw (args) { @ uhfix[len] = isnumber(b10 $args) ? shift(args) : uhfix[len] ? uhfix[len] : 480 @ :sn = servernum() @ uhfix[$sn] = uniq($args $uhfix[$sn]) @ :uh = userhost($uhfix[$sn]) @ uhfix[$sn] = copattern($userhost(,) uh uhfix[$sn]) @ :i2w = indextoword($uhfix[len] $uhfix[$sn]) @ :i2w = i2w ? i2w : numwords($uhfix[$sn]) if (serverctl(get $sn 005 WHOX)) { ^who -line { unless ([$0] || rmatch($1@$2 $userhost(, $3))) { pretend :$3!$1@$2 NICK :$3 } } -end { if (uhfix[$servernum()]) {q1cmd 0 9 uhfix.xw} } -ux $servernick() nuhsir%tnuh $unsplit(, $splice(uhfix[$sn] 0 $i2w)) } else { ^who -line { if (ischannel($0) && !rmatch($3@$4 $userhost(, $1))) { pretend :$1!$3@$4 NICK :$1 } } -end { if (uhfix[$servernum()]) {q1cmd 0 9 uhfix.xw} } $unsplit(, $splice(uhfix[$sn] 0 $i2w)) } } alias.t uhfix.cache { @ :unk = userhost(,) @ :users = mychannels() fe users users { push users $chanusers($users) @ :hosts = userhost($users) @ :users = copattern($unk hosts users) shift users } @ :users = uniq($users) @ :users = sort($users) @ :hosts = userhost($users) @ :users = cofilter($unk hosts users) fe ($users) user { pretend :$user!$userhost($user) NICK :$user } } alias.t uhfix.wason (chan,args) { @ :nuhs = userhost(, $args), :unk = shift(nuhs) userhost $cofilter($unk nuhs args) -cmd \{pretend :\$0!\$3@\$4 NOTICE $chan :\} userhost $copattern($unk nuhs args) -cmd \{pretend :\$0!\$3@\$4 NOTICE $chan :\} } # Relay public messages between channels. # alias.t relaychan (chan,chans) { unless (chans) { echo Usage: ${t} sourcechan destination ... return } @ chan = chan =~ [-*/*] ? chan : [-$servernum()/$chan] @ relay.chans = uniq($relay.chans $after(/ $chan)) unless (numwords($relay.src) == numwords($relay.dst)) { echo Warning: Relay variables are inconsistent. Purging. purge relay } echo Relaying $chan to $chans fe ($chans) chans { @ chans = chans =~ [-*/*] ? chans : [-$servernum()/$chans] push relay.src $chan push relay.dst $chans } } # alias.t relayall (masks) { @ :svs = myservers(,) if (masks == [*]) { echo Warning: It is dangerous to use "/${t} *". echo Warning: If you need this, try "/${t} **" instead. return } fe svs sv { @ :chans = mychannels($sv) fe chans chan { @ :chan = [-$sv/$chan] } @ :sv = pattern("\\[$masks\\]" $chans) } fe ($svs) chan { relaychan $uniq($chan $svs) } } # alias.t relaylist (masks default *) { fe ($pattern("\\[$masks\\]" $uniq($relay.src))) src { echo $src -> $pattern("\\[$masks\\]" $uniq($copattern($src relay.src relay.dst))) } } # fe (public public_msg public_other) hook { break on #^$hook + '% \\\\[\$relay.chans\\\\] *' { unless (numwords($relay.src) == numwords($relay.dst)) {return} @ :chans = copattern(-$servernum()/$1 relay.src relay.dst))) @ :chans = unsplit(, $uniq($chans)) if (chans) {1cmd 10,30 notice $chans <$1:$0> $2-} } } cetk.clonecheck0000644000076500007650000002247611412644015014241 0ustar jmidgleyjmidgley# CETK clone/flood detection/removal script 0.9 unload cetk.clonecheck package cetk.clonecheck load functions load cetk.functions load cetk.chanmgmt alias cka.help (count,...) { echo ===== switch ($count) { (1) { echo /clonecheck [min-clones [max-bans [max-banned]]] [char-flags] chan-masks [switches] echo echo With no args, find and display all clones on all channels in which none are echo opped or voiced or "me" or in our userlist. This is the same as saying echo "/eval clonecheck 1 0 0 w \$mychannels()". Note that if _any_ of the echo clones are "special", then _none_ of them will be acted upon. } (2) { echo min-clones is optional and specifies the number of clones required echo for action. 1 clone meaning 2 clients, 9 meaning 10, etc. echo echo max-bans and max-banned are also optional and specify the maximum number echo of ban masks and banned users that will be performed in a single run. echo This is useful as a safety feature. } (3) { echo char-flags is a collection of single character "flags" meaning: echo * w - Display all clones. Default without b, k, K or G. echo * W - Whois all clones. echo * B - kickban all clones. echo * i - Ignore all clones. XXX echo * b - ban all clones. echo * k - kick all clones. echo * K - K-line all clones. echo * G - G-line all clones. echo * m - Don't filter out everyone with "my" address. echo * o - Don't filter out everyone with an opped address. echo * v - Don't filter out everyone with a voiced address. echo * u - Don't filter out everyone with a userlisted address. echo * f - Don't filter non-flooders out. echo * F - Filter everyone out if flood checking isn't available. echo * A - Drop all filters. echo * a - *@host based clone counting, not user@host. echo echo Remaining args are channels to perform the clone check on. } (4) { echo Switches: echo -a 30 Minimum action flood count. echo -m 30 Minimum msg flood count. echo -n 30 Minimum notice flood count. echo -p 30 Minimum public flood count. echo -c 10 Minimum ctcp flood count. echo -j 5 Minimum join/part flood count. echo -i 5 Minimum nick flood count. echo -z 50 Minimum flood count of all types. echo These specify _default_ values. } (5) { echo Examples: echo /cka Aa Find all clones (more than one) on all channels. echo /cka 4 fb # Ban unflagged users with more than 4 clones on channel # . echo /cka 4 fk # Kick unflagged users with more than 4 clones on channel # . echo /cka 0 FaB # Kickban all who exceed the flood limits from # . return } (*) { echo No more help for you! return } } type /clonecheck -h$repeat($count h) } alias clonecheck (chans) { $getopts(:chans cetk.cka. ha:c:i:j:m:n:p:z: $chans) if (cetk.cka.h) { cka.help $#cetk.cka.h @ cetk.cka.h = [] return } @ :oxd = xdebug(dword) xdebug dword @ :num = isnumber(b10 $chans) ? shift(chans) : 1 @ :maxm = isnumber(b10 $chans) ? shift(chans) : 0 @ :maxu = isnumber(b10 $chans) ? shift(chans) : 0 @ :flags = ischannel($chans) ? [w] : shift(chans) @ :chans = #chans ? chans : mychannels() @ :bold = chr(2) @ :msg = [$num or more clones possibly combined with flooding. Ident and/or +v might help.] fe ($chans) chan { @ :users = chanusers($chan) @ :clones = userhost($users) @ :users = joinstr(! users clones) @ :clones = clonecount($num "$flags" $clones) foreach -clonecheck foo { @ clones = clonecheck[$foo]("$flags" $chan $clones) } @ :clones = replace(*!. . $clones) @ :clones = shufflef($clones) @ :users = pattern("\\[$clones\\]" $users) if (maxm && maxm<#clones) { echo Refusing to act on more than $maxm masks: $#clones $clones } elsif (maxu && maxu<#users) { echo Refusing to act on more than $maxu users: $#users $users } elsif (0 <= index(K $flags) && usermode() =~ [*o*]) { pkline $chan $clones / $msg } elsif (0 <= index(G $flags) && usermode() =~ [*o*]) { pgline $chan $clones / $msg } elsif (0 <= index(b $flags) && ischanop($servernick() $chan)) { ban $chan $filter("\\[$chanbans(b $chan)\\]" $clones) } elsif (0 <= index(k $flags) && ischanop($servernick() $chan)) { kick.all $chan $clones / $msg } elsif (0 <= index(B $flags) && ischanop($servernick() $chan)) { ban $chan $filter("\\[$chanbans(b $chan)\\]" $clones) kick.all $chan $clones / $msg } elsif (0 <= index(W $flags)) { fe users users {@ users = before(! $users)} wiq $users } else { fe ($clones) clone { @ :match = pattern($clone $users) fe match match {@ match = before(! $match)} echo clonechecker: $[-3]#match $chan $bold$clone$bold $match } } } xdebug $oxd qcmd 9 } alias cka clonecheck $*; # # Filtering functions. You can add your own and they will run automatically. # A good one might discard clones that have been on the channel a long enough # time or clones that have been active recently enough. # # Note that you will probably have to switch flood checking off with the "f" # flag if your flood /sets aren't configured correctly. # alias clonecheck.mefilt (f,c,a) if (0>index(Am $f)) {@ :x = [$X $userhost($servernick())];fe a a {@ a = match($a $x) ? [] : a}};return $a alias clonecheck.ofilt (f,c,a) if (0>index(Ao $f)) {@ :x = userhost($chops($c));fe a a {@ a = match($a $x) ? [] : a}};return $a alias clonecheck.vfilt (f,c,a) if (0>index(Av $f)) {@ :x = userhost($chvoices($c));fe a a {@ a = match($a $x) ? [] : a}};return $a alias clonecheck.ufilt (f,c,a) if (0>index(Au $f)) {fe a a {@ a = checkuser(*!$foo $c) ? [] : a}};return $a alias clonecheck.zzfloodfilt (flags,chan,args) { unless (floodinfo("% %")) {return ${0 > index(F $flags) ? args : []}} ^alias clonecheck.zzfloodfilt (flags,chan,args) { unless (0>index(Af $flags)) {return $args} @ :oxd = xdebug(dword) xdebug dword @ :sn = servernum() fe args args {@ args = floodinfo("$args $chan * $sn 4")} @ :ma = cetk[cka][z] ? cetk[cka][z] : 50 @ :mj = cetk[cka][j] ? cetk[cka][j] : 5 @ :m[actions] = cetk[cka][a] ? cetk[cka][a] : 30 @ :m[msgs] = cetk[cka][m] ? cetk[cka][m] : 30 @ :m[notices] = cetk[cka][n] ? cetk[cka][n] : 30 @ :m[publics] = cetk[cka][p] ? cetk[cka][p] : 30 @ :m[ctcps] = cetk[cka][c] ? cetk[cka][c] : 10 @ :m[nicks] = cetk[cka][i] ? cetk[cka][i] : 5 fe args args { fe args nuh xx type xx count {break} @ :enuh = encode($nuh) @ :u[$enuh] += count @ :u[$enuh][$type] += count @ :args = mj < u[$enuh][joins] && mj < u[$enuh][parts] ? nuh : [] @ :args = m[$type] && m[$type] < u[$enuh][$type] ? nuh : args @ :args = ma < u[$enuh] ? nuh : [] } @ :args = uniq($args) xdebug $oxd return $args } return $clonecheck.zzfloodfilt($flags $chan $args) } # # Count the clones, return u@h masks for all those above the limits. Clones # are counted based on their hosts if the "a" flag has been given. Otherwise, # the ident values are also used, and all users with an ident starting with a # non-alphanumeric char are considered to be one user. # # This function has been modified to exclude usernames with an upper-case # starting characters. From memory, it was to deal with Freenode's N=/U= # leading characters, but it seemed to work well enough, so it's still in here. # alias clonecount (num,flags,args) { @ :honly = 0 <= index(a $flags) @ :chars = jotc(az09) if (honly) { fe args foo { @ foo = [*@$after(@ $foo)] } } else { fe args foo { @ foo = index($chars $foo) ? [$left(1 $foo)*@$after(@ $foo)] : foo } } @ :args = sort($args) fe args args { @ :count = last == args ? count + 1 : 0 @ :last = args @ :args = count == num ? args : [] } return $args } alias fe.flooders (args) { unless (args) { echo Run /command for all known flooders in the built in flood detection system. echo /fe.flooders -options /command echo echo Options : echo -n nuh -- Limit detection to a particular u@h mask. echo -c chan -- Limit detection to a particular channel. echo -t type -- Limit detection to a particular flood type. echo -s serv -- Limit detection to a particular server. echo -m mask -- Specify all the \$floodinfo() values at once. echo -r rest -- Specify remaining \$floodinfo() args. echo -a -- Act on all flooders. echo An option using a capital will cause /command to be run. echo echo \$flooder will contain the \$floodinfo() argument, and \$uh, \$chn, \$type, echo \$serv, \$count and \$time will contain the individual args from \$flooder. return } @ :nuhm = [*] @ :chan = C @ :type = [*] @ :serv = servernum() @ :rest = getset(flood_after) while (:option = getopt(:optopt :optarg N:C:T:S:R:M:n:c:t:s:r:m:a $args)) { switch ($option) { (!) {echo * option "$optopt" is an invalid option;return} (-) {echo * option "$optopt" is missing an argument;return} (n) {@ :nuhm = optarg} (c) {@ :chan = optarg} (t) {@ :type = optarg} (s) {@ :serv = 0 > servernum($optarg) ? optarg : servernum($optarg)} (r) {@ :rest = split(, $optarg)} (m) { @ optarg = split(, $optarg) @ :nuhm = optarg ? shift(optarg) : nuhm @ :chan = optarg ? shift(optarg) : chan @ :type = optarg ? shift(optarg) : type @ :serv = optarg ? shift(optarg) : serv @ :rest = optarg ? optarg : rest } (a) {fe (* * * -1 0) nuhm chan type serv rest {break}} } } @ :cmd = optarg ? [eval $optarg] : [eval echo \$flooder] @ :mask = unsplit(" " $nuhm $chan $type $serv $rest) fe ($floodinfo("$mask")) flooder { fe ($flooder) uh chan type serv count time {$cmd;break} } } cetk.commands0000640000076500007650000005744411476545444013763 0ustar jmidgleyjmidgley# Aliases. Server end extended IRC commands. unload cetk.commands package cetk.commands # Tabkey deltas. load tabkey.ce @aliasctl(alias set tabkey.main $sar(g/echo/xecho -banner -nolog --/$aliasctl(alias get tabkey.main))) alias.t tabkey.default return $tabkey.method.nickchannotify($*) alias.t tabkey.cmd.allservs tabkey.recurse 1 alias.t tabkey.cmd.allwins tabkey.recurse 1 alias.t tabkey.cmd.allvwins tabkey.recurse 1 alias.t tabkey.cmd.rdelay tabkey.recurse 2 alias.t tabkey.cmd.array.read tabkey.method.filei alias.t tabkey.cmd.load tabkey.method.filei alias.t tabkey.cmd.eval tabkey.recurse 1 alias.t tabkey.cmd.call tabkey.recurse 1 alias.t tabkey.cmd.call.trace tabkey.recurse 2 alias.t tabkey.cmd.call.xtrace tabkey.recurse 2 alias.t tabkey.cmd.1cmd tabkey.recurse 2 alias.t tabkey.cmd.q1cmd tabkey.recurse 3 alias.t tabkey.cmd.qcmd tabkey.recurse 2 alias.t tabkey.cmd.scmd tabkey.recurse 2 alias.t tabkey.cmd.setm tabkey.cmd.set alias -tabkey.cmd.m alias -tabkey.cmd.msg assign tabkey_max_msg_history 0 purge tabkey.index purge tabkey_nickcomp_suffix alias.tt scan.list (chans) { @ :min = isnumber(b10 $chans) ? shift(chans) : 0 @ :max = isnumber(b10 $chans) ? shift(chans) : 0 @ :bold = chr(2) @ :echo = [xecho -banner --] @ :chans = chans ? chans : [*] foreach list.chan chan { @ :nchan = decode($chan) unless (rmatch($nchan $chans)) {continue} foreach list[chan][$chan][nuh] user { @ :nuser = decode($user) unless (isuser($nuser $nchan)) {continue} @ :cl = my[cl] = rightw(1 $numsort($my[cl] $strlen($nchan))) @ :nl = my[nl] = rightw(1 $numsort($my[nl] $strlen($nuser))) $echo $[$cl]nchan $[$nl]nuser [$checkuser($nuser $nchan) $findusers($nuser $nchan)] [$checkshit($nuser $nchan) $findshits($nuser $nchan)] } } foreach list.nuh user { @ :nuser = decode($user) if (isuser($nuser .)) { @ :nl = my[nl] = rightw(1 $numsort($my[nl] $strlen($nuser))) $echo $[$nl]nuser [$checkuser($nuser .) $findusers($nuser .)] [$checkshit($nuser .) $findshits($nuser .)] } } } #fe (scan.chan "fe ($mychannels())" "@:nchan=chan" "fe ($nickuserhost($filter($servernick() $chanusers($chan))))" "@:nuser=user" "fe ($nickuserhost($notify(on)))" "@:nuser=nuh" scan.list "foreach list.chan" "@:nchan=decode($chan)" "foreach list[chan][\$chan][nuh]" "@:nuser=decode($user)" "foreach list.nuh" "@:nuser=decode($nuh)") cmd foo food fook fool bar bard {alias.t $cmd (chans) @:min=isnumber(b10 $chans)?shift(chans):0,:max=isnumber(b10 $chans)?shift(chans):0\;@:chans=#chans?chans:[*]\;$foo chan \{$food\;unless (rmatch($nchan $chans)){continue}\;@:mask=remw($word(0 $rpattern($nchan $chans)) $chans)\;$fook user \{$fool\;unless (matchuser($nuser $nchan $mask)||matchshit($nuser $nchan $mask)){continue}\;xecho -banner -- \$[2]pattern(??$beforr(! $nuser) $channel($nchan))\$[20]nchan \$nuser \$attr.bold([$attr.bold($checkuser($nuser $nchan) $findusers($nuser $nchan))] [$attr.bold($checkshit($nuser $nchan) $findshits($nuser $nchan))])\}\}\;$bar nuh \{$bard\;if (checkuser($nuser .)||checkshit($nuser .)){xecho -banner -- $nuser $attr.bold([$attr.bold($checkuser($nuser .) $findusers($nuser .))] [$attr.bold($checkshit($nuser .) $findshits($nuser .))])}\}} fe (me describe notice notice say msg) foo bar { alias.t a$foo m$foo * alias.t m$foo (dest, ...) $bar \$unsplit(, $pattern("\\[$dest\\]" $mychannels())) \$* } alias.t c mode $C alias.t m msg alias.t nick unless (rmatch($0 $my.nickfilter)) {@ my.nicks = uniq($* $my.nicks)};//nick $* alias.t uhfix.list (args) { @ :time = isnumber(b10 $args) ? shift(args) : 0 @ :time = 0 > time ? time() + time : time @ :args = args ? args : [*] @ :args = pattern("\\[$args\\]" $mychannels()) fe ($tolower($args)) chan { @ :echan = encode($chan) foreach list[chan][$echan][nuh] enuh { @ :nuh = decode($enuh) @ :nick = before(! $nuh) if (time > list[chan][$echan][nuh][$enuh]) { } elsif (!onchannel($nick $chan)) { } elsif (match($userhost($chan , $nick))) { pretend :$nuh NICK :$nick } } } } alias.t whittle (args) wit $shift(args) $shift(args) $shift(args) $args;widle $args alias.t wilca (args) { @ :age = time() @ :age-= isnumber(b10 $args) ? shift(args) : 60 @ :cnt = isnumber(b10 $args) ? shift(args) : 0 @ :args = #args ? args : mychannels() unless (args) { echo Usage: ${t} {time} {max-at-a-time} #channel ... } fe ($args) chan { @ :echan = encodel($chan) foreach list[chan][$echan][nuh] nuh { if (age < list[chan][$echan][nuh][$nuh]) { wiq $cnt $before(! $decode($nuh)) } } } } alias.t wilf wi $before(! $last[$serversrefe()][from]) alias.t wilj wi $: alias.t wilm wi $, alias.t wils wi $D alias.t widle (args) who -line {xecho -- $0$chr(9)$[$max(9 $@1)]1 $[4]2 $[-6]{time()-list[chan][$encodel($0)][nuh][$encodel($1!$3@$4)]} $[-6]{time()-list[nuh][$encodel($1!$3@$4)]} $3@$4 $attr.bold(\($attr.bold($checkuser($1!$3@$4 $0))\)\($attr.bold($checkshit($1!$3@$4 $0))\))\($6 $7-\)} $unsplit(, ${args ? shift(args) : mychannels()}) $args alias.t wit (a0,a1,a2,a3) who -line \{if \(${!strlen($strip(- $a0))?1:[0<=index\($a0 \$2\)]}&&${!strlen($strip(- $a1))?1:[0>index\($a1 \$2\)]}\) \{wiq $a2 \$1\}\} $unsplit(, ${a3 ? shift(a3) : mychannels()}) $a3 alias.t wit.joiners (args) { fe ($args) arg { on #-join - "$arg" { if ([$0] == servernick()) { ^wit - d 40 $1 } else { ^wiq $0 } } } } # Aliases. CTCP extended commands. fe (x c e) foo {alias.t ${foo}offers (args) ctcp \${#args?shift(args):T} ${foo}dcc \${#args?shift(args):[list]} \$args} fe (ver version) cmd ctcp {alias.t $cmd ctcp \${[$*]?[$*]:T} $ctcp} alias.t chat dcc chat # Client end extended IRC debugging stuff. alias.t call.ticks { @:t1=ticks.read() $* @:t2=ticks.read() @:run=shift(t2)-shift(t1) @:up=shift(t2)-shift(t1) if (functioncall()) { return $run $up } else { @:ofp=setset(floating_point_math on) @:pc=trunc(8 ${run/up}) ^set $ofp xecho -banner -nolog -- $run / $up = ${1>=pc?pc:attr.bold($pc)}: $* } } alias.t coredump @:onoff=[$0]==[off]?0:1;if (perl(require "syscall.ph";local \$foo="x"x16;syscall &SYS_getrlimit, 4, \$foo;(undef,$foo)=unpack "II",\$foo;syscall&SYS_setrlimit, 4, pack "II",\(\$foo*$onoff\),\$foo)) {echo System call failed: $perl(\$!)} elsif ([$0]==[abort]){abort $1-} elsif ([$0]==[perl]){@perl(dump)} alias.t debughook fe (10000 pop -10000 push) foo bar \{on #$1 \$foo ${[$0]?[]:[-]}"${2<#?[$2-]:[*]}" stack \$bar set debug\\\;\${0>foo?[^set debug $0]:}\} # Aliases. Variable handling functions. alias.t assign.rem if (strlen(${:foo=remws($1- / $($0))})){assign $0 $foo}{assign -$0} alias.t 005.dump { fe ($myservers()) sv { @ :sn = servernum($sv) @ :sg = servergroup($sn) fe ($serverctl(get $sn 005s)) five { @ :v5 = serverctl(get $sn 005 $five) unless (rmatch("$sn $sv $sg $five $v5" $*)) {continue} xecho -banner -nolog -- $[-4]sn $[-40]sv $[10]sg $[20]five $v5 } } } # Aliases. Client end extended IRC commands. fe (nick \$servernick() ircuser "\$beforr(! $X)") bard bark {fe (rand \$word.rand() dict \$word.dict() shuffle "\$shufflec\($bark\)" rev "\$reverse\($bark\)" roll "\$rollc\(\${#?[$*]:1} $bark\)" rot13 "\$rot13\($bark\)" unroll "\$after(-1 _ $servernick())\$before(_ $servernick())") foo bar {alias.t ${bard}.${foo} ${bard} ${bar}}} alias.t ircuser ircinfo $* alias.t irchost ircinfo "" $* alias.t ircserv ircinfo "" "" $* alias.t ircname ircinfo "" "" "" $* alias.t ircinfo (args) { @ :nuser = [] @ :sv = isnumber(b10 $args) ? shift(args) : servernum() @ :sv = serversrefe($sv) @ :user = last[$sv][user] ? last[$sv][user] : my.user repeat 3 { @ :x1 = shift(args) @ :x2 = shift(user) @ :x3 = x1 ? x1 : x2 ? x2 : [.] @ push(nuser $x3) } @ :x3 = args ? [\:]##args : user ? user : [\:.] @ push(nuser $x3) @ last[$sv][user] = nuser } alias.t allmodes redirect 0 mode ${[]==[$1]?servernick():[$1]} $0$jotc(AZaz09)$serverctl(get $servernum() umodes) alias.t allservs fe ($myservers(,)) serv {xeval -server $serv -window $serverwin($serv) {$*}} alias.t allvwins fe ($revw($winrefs())) win {window swap $win;$*} alias.t allwins fe ($revw($winrefs())) win {xeval -window $win -server $winserv($win) {$*}} alias.t rdelay timer $rand($0) $1- alias.t beeper cbeep $repeat(59 0.1 0.1 10 ) 0.1 0.1 alias.t blast (args) { @ :rep = isnumber(b10 $args) ? shift(args) : 1 @ :targ = unsplit(, $shift(args)) repeat $rep {^msg $targ ${args ? args : chr($randcnf(128 0 10 13))}} } alias.t channums (mode) fe ($mychannels()) foo {xecho -banner -nolog -- $[-4]winchan($foo $servernum()) $[-4]numwords($chops($foo)) / $[-4]{numwords($filter(${:cuh=userhost($foo $chanusers($foo))}))} + $[-4]{numwords($pattern($cuh))} =$[-3]{(100*numwords($chops($foo)))/(:nicks+=:bar=numonchannel($foo),bar)}% $left(2 $pattern(??$servernick() $channel($foo)))$colorise($foo) \($chanmode($foo)\) \(b:$#filter(0 $chanbans(b $foo))\)};xecho -banner -nolog -- $#mychannels():$#chanusersa():$nicks chans:users:nicks. Known: $numwords($filter(${:cuh=userhost(, $chanusersa())})) Unknown: $numwords($pattern($cuh)) alias.t chart.ascii fe ($jot(0 15)) foo {@:baz=[];@foo*=16;fe ($jot(0 15)) bar {@baz#=chr(${foo+bar})};xecho -banner -nolog -- $[20]baz$chr(5)$[20]baz} alias.t chart.color { fe (epic mirc) foo bar { xecho -banner -nolog -- $[33]foo$[33]bar } fe ($jot(0 15)) back { @:mirc=[] @:epic=[] fe ($jot(0 15)) fore { @epic#=[$chr(3)${~7&fore?5:3}${7&fore},4${7&back}${~7&back?chr(6):[]}${7&fore}${7&back}] @mirc#=[$chr(3)$fore,$tr(/ /0/$[-2]back)${7&fore}${7&back}] } xecho -banner -nolog -- $epic$chr(15) $mirc } } alias.t checkdoc @:funcs=tolower($getfunctions());fe funcs func {@func=word(7 $stat($globi($getset(help_path)/6*/$func)))?[]:func};if (#funcs){echo $funcs} alias.t cloak set auto_away off;set auto_rejoin 0;cset * auto_rejoin 1;if (0==cloak||[]!=[$0]){set cloak ${[]==[$0]?2:[$0]}};set command_mode on;set dcc_autoget off;notify -;cdcc doffer *;timer -d all alias.t cps { @ :totalreceived = :totalconnect = :connected = :totalcps = totnicks = [] allservs eval xecho -banner -nolog -window crap -level crap -- \$[10]{serv##servergroup($serv)} \$[-30]servername($serv) \$[-40]X \$[10]servernick()\$[-5]{totnicks+=:nicks=numwords($chanusersa()),nicks}/\$[2]#mychannels() \$mychflags($mychannels()) fe ($myservers(.)) serv { push :mychans $mychannels($serv) @:eserv=serversrefe($serv) @totalreceived+=last[$eserv][received] @totalconnect+=time()-lag[$serv][connected] @connected++ @totalcps+=last[$eserv][received]/(time()-lag[$serv][connected]) xecho -banner -nolog -window crap -level crap $[10]{serv##servergroup($serv)} $status.lag($serv) =$[-10]last[$eserv][received] /$[-10]{time()-lag[$serv][connected]} $serverctl(get $serv $*) } xecho -banner -nolog -window crap -level crap AvCPS:${totalcps/connected} CuCPS:${totalreceived/totalconnect} TtCPS:$totalcps AvRec:${totalreceived/connected} TtRec:$totalreceived AvCon:${totalconnect/connected} TtCon:$totalconnect TtServs:$connected TtChans:$#mychans TtNicks:$totnicks @totnicks=[] } alias.t ctcp.clone ^on ctcp_reply "*" if ([]==ctcpreply[all][$1])\{@ctcpreply[all][\$1]=[\$1-]\};if ([]!=[$1-]){ctcp $*} if ([]==ctcpreply.all.clientinfo){ctcp $0 clientinfo}{@:replies=before(: $ctcpreply.all.clientinfo);@:wanted=[];fe ($replies) reply {if ([]==ctcpreply[all][$reply]){@:wanted#=[ $reply]}};if ([]==wanted){xecho -banner -nolog -- Complete;^on ctcp_reply -"*"}{xecho -banner -- Remaining: $wanted;ctcp $0 $word($rand($numwords($wanted)) $wanted)}} alias.t ctcp.clone { stack push on ctcp_reply ^on ctcp_reply "% % ping 1" { stack pop on ctcp_reply stack push on ctcp_reply ^on ctcp_reply "% % ping 2" { stack pop on ctcp_reply } ^on ctcp_reply "*" { @ :req = shift(ctcpreply[$encodel($0)]) @ ctcpreply[$encodel($0)][$encodel($2)] = [$3-] } } push ctcpreply[$encodel($0)] $1- ctcp $0 ping 1 ctcp $* ctcp $0 ping 2 } alias.t dcc.flood (args) { fe ($common($dccctl(typematch raw) / $dccctl(writables))) id { @ :count = 0 @ :fd = dccctl(get $id user) while (args && ++count && dccctl(get $id writable)) { msg =$fd $args } echo $id =$fd $count $dccctl(get $id sent) } } alias.t dnotify @:on=setset(do_notify_immediately off);//notify $*;^set $on alias.t dopme (msk default *) { @ :sn = servernick() @ :chans = pattern("\\[$msk\\]" $mychannels()) fe ($chans) chan { if (ischanop($sn $chan)) { qmode $chan -o $sn } } } alias.t echo xecho -banner -nolog -window crap -- alias.t fake foreach -fake foo {fake.${foo} $*} fe (names 366 who 315) bar baz {alias.t fake.$bar fe (${[$1]?[$1-]:mychannels()}) foo \{timer -rep \${#?[$0]:0} 0 ^pretend :\$S $baz \$servernick() \$foo :End of /$toupper($bar) list.\;repeat ${!![$0]} who -flush\}} fe (whois 318 whowas 369) bar baz {alias.t fake.$bar timer -rep \${#?[$0]:0} 0 ^pretend :\$S $baz \$servernick() \$foo :End of /$toupper($bar)} alias.t fake.ison timer -rep ${#?[$0]:1} 0 ^pretend :$S 303 $servernick() :$1-;allservs ^dnotify $notify() alias.t fake.pong timer -rep ${#?[$0]:1} 0 ^pretend :$S PONG $S :\${[]==[$1]?time():[$1-]} alias.t fake.uh timer -rep ${#?[$0]:1} 0 ^pretend :$S 302 $servernick() :$1- alias.t fake.wait timer -rep ${#?[$0]:1} 0 ^pretend :$S 421 $servernick() ***LW*** :Unknown command alias.t guardchan if ([$0]>999999||[$0]<10){xecho -banner -nolog -- ${t}: A number greater than 10 is needed}{join $1 $3;timer -rep -1 $0 {if (!match($1 $mychannels())){^timer -ref gcqb 0 {^timer -ref gcqb 1800 {};quote PART $1,$2};timer 1 join $1 $3;if ([$2]!=[-]&&[$2]!=[]){ctcp $2 invite $1 $4}} if (!match($N $chops($1))]){if ([$2]!=[-]&&[$2]!=[]){ctcp $2 op $1 $4};opme 0 $1 $4;opme 0 $1} if ([$2]!=[-]&&[$2]!=[]){join $2 $3}} \# ${t} $*} alias.t huncit (args) { @ :fd = open("$shift(args)" w) fe (onuh " *" nuh "") sp pr { foreach list[$sp] nuh { @ write($fd $nuhnorm($decode($nuh))$pr) foreach list[$sp][$nuh] foo { @ write($fd $nuhnorm($decode($nuh)) $list[$sp][$nuh][$foo]) } } } foreach list.chan chan { fe (onuh @ nuh "") sp pr { @ :echan = decode($chan) foreach list[chan][$chan][$sp] nuh { @ write($fd $nuhnorm($decode($nuh)) $pr$echan) } } } @ close($fd) } alias.t icb { ^exec -window -name icb -line { echo $strip("$chr(10 13)" $*) } -error { echo $attr.bold(ICB): $strip("$chr(10 13)" $*) } icb -color -nick $N -group $N ^exec -in %icb $* } alias.t lc lastlog $C $* alias.t list.chan.list (args) { @ :min = isnumber(b10 $args) ? shift(args) : 0 @ :max = isnumber(b10 $args) ? shift(args) : 999999 @ :total = 0 @ :counted = 0 unless (#args) { echo ${t} [min] [max] netmask chanmask ... return } foreach list[chan] chan { foreach list[chan][$chan][net] net { @ total++ @ :num = word(1 $list[chan][$chan][net][$net][list]) if (min > num || num > max) { continue } elsif ([$decode($net) $list[chan][$chan][net][$net][list]] !~ args) { continue } @ counted++ xecho -banner -nolog -- $[10]decode($net) $list[chan][$chan][net][$net][list] } } xecho -banner -nolog -- $counted/$total $after(. ${t})s for $args listed. } alias.t list.chan.stat (args) { @ :min = isnumber($args) ? shift(args) : 0 @ :max = isnumber($args) ? shift(args) : 999999 unless (#args) { echo ${t} [min] [max] chanmask ... return } foreach list.chan chan { @ :stat = [] if (rmatch($decode($chan) $args)) { @ :total = 0 fe (onuh nuh) foo { @ :count = 0 foreach list[chan][$chan][$foo] nuh {@count++} @ :stat #= [$[-6]count ${foo}s] @ :total = count } @ :stat #= [$chr(9)$attr.bold(\($attr.bold($decode($chan))\))] if (min <= total && total <= max) { xecho -banner -level crap -window crap $stat } } } } stack push alias alias.tt alias alias.tt { fe (nuh onuh) type { alias.t $sar(g/\$type/$type/$*) } } alias.tt list.chan.$type (args) { @ :age = isnumber(b10 $args) ? time() - shift(args) : [] @ :rng = isnumber(b10 $args) ? shift(args) + age : [] @ :cmask = args fe cmask foo {@ foo = before(, $foo,)} foreach list[chan] chan { @ :chn = decode($chan) @ :ctotal++ unless (rmatch($chn $cmask)) {continue} @ :ccounted++ foreach list[chan][$chan][$type] nuh { @ :utotal++ unless (rmatch($chn,$decode($nuh) $args)) {continue} @ :ucounted++ @ :baz = list[chan][$chan][$type][$nuh] if (age && age > baz) { } elsif (rng && rng < baz) { } elsif (functioncall()) { push :ret $chn,$decode($nuh) } else { @ nuh = decode($nuh) @ my.cl = rightw(1 $numsort($my.cl $strlen($chn))) @ my.nl = rightw(1 $numsort($my.nl $strlen($nuh))) xecho -banner -nolog -- $[$my.cl]chn $[$my.nl]nuh ${isnumber($baz)?stime($baz):baz} } } } if (functioncall()) { return $ret } else { xecho -banner -nolog -- $ccounted/$ctotal chans scanned and $ucounted/$utotal nuhs listed. } } fe (chan nick nuh onuh) type {alias.t list.$type @:ret=[]\;@:total=0\;@:counted=0\;foreach \${t} foo \{@total++\;if (rmatch($decode($foo) $*))\{@counted++\;@:baz=[\$(${t}.${foo})]\;if (functioncall()){@push(ret $decode($foo))}\{xecho -banner -nolog -- \$decode($foo)$chr(9)\${isnumber($baz)?stime($baz):baz}$chr(9)\$list[${type=~[*nuh]?[nuh]:type}][\$foo][${type=~[chan*]?[keys]:[servers]}]\}\}\}\;if (functioncall()){return $ret}\{xecho -banner -nolog -- \$counted/\$total \$after(. ${t})s listed.\}} stack pop alias alias.tt alias.t list.reap { @:win=winnum() @:args=[$*] @:time=isnumber($args)?time()-shift(args):time() @:count=0 @:total=0 @:utime=utime() foreach list[nuh] nuh { if (++total&&time>list[nuh][$nuh]&&rmatch($decode($nuh) $args)&&++count) { purge list[nuh][$nuh] } } xecho -banner -nolog -window $win $count/$total ${(100*count)/total}% nuhs purged in $tdiffu($utime) seconds. @:count=0 @:total=0 @:utime=utime() foreach list[chan] chan { foreach list[chan][$chan][nuh] nuh { if (++total&&time>list[chan][$chan][nuh][$nuh]&&rmatch($decode($chan),$decode($nuh) $args)&&++count) { purge list[chan][$chan][nuh][$nuh] } } } xecho -banner -nolog -window $win $count/$total ${(100*count)/total}% chan nuhs purged in $tdiffu($utime) seconds. } alias.t list.comchan (echans) { @ :max = isnumber(b10 $echans) ? shift(echans) : numwords($echans) fe echans chan {@ chan = encode($tolower($chan))} foreach list[chan] echan { if (match($echan $echans)) {continue} @ :chan = decode($echan) foreach list[chan][$echan][nuh] enuh { @ :matches = 0 fe ($echans) snach { @ :matches += list[chan][$snach][nuh][$enuh] ? 1 : 0 } if (max <= matches) { @ enuh = decode($enuh) @ my.cl = rightw(1 $numsort($my.cl $strlen($chan))) @ my.nl = rightw(1 $numsort($my.nl $strlen($enuh))) xecho -banner -nolog -- $[-2]matches $[$my.cl]chan $[$my.nl]enuh ${isnumber($baz)?stime($baz):baz} } } } } alias.t load.grep (args) @:ln=[];@:fd=open($shift(args) r);@:reg=regcomp($args);while ((ln=read($fd))||!eof($fd)){unless (regexec($reg $ln)){^$ln}};@regfree($reg) alias.t load.servs { @ :oxd = xdebug() xdebug dword @ :fh = open(${[] == [$0] || [.] == [$0] ? [~/.ircservers] : [$0]} R) while (!eof($fh)) { @ :serv = read($fh) @ :host = cut(0 : $serv) @ :port = cut(1 : $serv) @ :port = port ? port : 6667 if (@serv && rmatch($serv ${# ? [$1-] : [*]})) { @ :eserv = encodel($host:$port) @ my[serversgroup][$eserv] = after(4 : $serv) push my[servergroups][$cut(4 : $serv)] $serv } } @ close($fh) xdebug $oxd } alias.t load.mircservs { @ :pass = jotc(azAZ09__) @ :fh = open(${[] == [$0] || [.] == [$0] ? [servers.ini] : [$0]} R) while (read($fh) != [\[servers\]]) {} while (:serv = read($fh)) { @ :host = cut(2 : $serv) @ :port = cut(3 : $serv) @ :port = port ? port : 6667 @ :port = split(, $port) fe port port { if (port =~ [*-*]) { @ port = split(- $port) @ port = jot($port) } else { @ port += 0 } } if (rmatch($serv ${# ? [$1-] : [*]})) { @ :group = cut(4 : $serv) @ :group = pass($pass $group) fe port port { @ :eserv = encodel($host:$port) @ my[serversgroup][$eserv] = after(4 : $serv) @ :port = [$host:$port:::$group] } ^assign.add my[servergroups][$group] $port } } @ close($fh) } alias.t notify.files (args) {@ time = isnumber(b10 $args) ? shift(args) : 600;ison -oncmd {^notify : $*} -end \{timer -update -ref ${t} $time ${t} $time $args\} $readlineall($args)} alias.t on.1 (args) @:hook=splice(args 0 ${word(0 $args)=~[*#*]?2:1});@:mask=["$shift(args)"];on $hook $mask on $hook -$mask\;$args alias.t ping //ping ${#?unsplit(, $*):servernick()} alias.t ping.me ^ctcp.reply ${#?unsplit(, $*):servernick()} PING $utime() alias.t pppip @:fh=open(~/.ppp.ip R T);@pppip=read($fh);@close($fh) alias.t pubfilt on ^public \"% % *$0-*\" {} alias.t qchat query =$word(${#-1} $*);chat $* alias.t quit.pingtimeout eval quote QUIT :${[]!=quiterror.ping?quiterror.ping:[Ping timeout for $servernick()\[${after(@ $userhost($servernick()))}\]]} alias.t resync fe (${strlen($*)?[$*]:mychannels()}) foo {qcmd 9 mode $foo;qcmd 9 mode $foo b;qcmd 9 who $foo} alias.t roll @:args=[$*];@:num=isnumber($args)?shift(args):1;@:len=#args;if (0num){@unshift(args $splice(args ${len+num} ${0-num}))};if (functioncall()){return $args}{xecho -banner -- $args} alias.t rollc @:args=[$*];@:num=isnumber($args)?shift(args):1;@:function_return=chr($roll($num $ascii($1-))) alias.t rot13 @:rot=tr(/$jotc(azAZ)/$jotc(nzamNZAM)/$*);if (functioncall()){return $rot}{xecho -banner -- $rot} alias.t serv.lock timer -ref ${t} -rep -1 $0 {if ((S!=[$1])&&([\[$serversgroup($S)\]]!=[$1])){^server $1}} \# ${t} $0- alias.t serv.watch timer -ref ${t} -rep -1 $0 {if ([$0]*3index(\{\(\[ $VAR)&&[]!=[$($VAR)]) { xecho -banner -nolog -- \$$VAR==$($VAR) } } } alias.t winall fe ($revw($winrefs())) foo {window $foo $*} alias.t winstable @:wins;fe ($winrefs()) foo {if (winchan($foo)){@push(wins $foo chan $winchan($foo))}};window $* $wins # Aliases. Miscelaneous extended commands. alias.t nwi nwhois alias.t nww nwhowas alias.t perftest.servproc { on #-raw_irc ${1<<31} $0* { @ :cookie = rand(0) queue perf$cookie { @ :ut = utime() @ :lf = setset(floating_point_math on) @ :cnt = ++debug[perf][cnt][$debug.perf.serv][$debug.perf.cmd] @ :ttl = debug[perf][ttl][$debug.perf.serv][$debug.perf.cmd] += tdiffu($debug.perf.start $ut) @ debug[perf][avg][$debug.perf.serv][$debug.perf.cmd] = ttl / cnt ^set $lf } defer queue -do perf$cookie @ debug.perf.cmd = [$1] @ debug.perf.serv = lastserver() @ debug.perf.start = utime() } } alias.t perftest.msg (args) { @:a0=#args?shift(args):250 @:a1=#args?shift(args):0 call.time call.ticks repeat $a0 pretend :foo\$rand(10000)!\$rand\($a1\)@bar.com PRIVMSG ${C?C:N} :Testing. } alias.t perftest.fillstruct (arg,dep,wid,args) { if (0 > --dep) { return } for foo from 0 to $wid { ^assign ${arg}.${foo} $args ${t} ${arg}.${foo} $dep $wid $args } } alias.t remlog ^//${t};^set msgcount 0;reinitstat alias.t plm ping $, alias.t pm ping.me alias.t raw quote alias.t trace.route userhost $* -cmd {exec -window -line \{xecho -banner -- $0$attr.bold(:) \$*\} traceroute-nanog -q 1 -m 255 $4 2>&1 | perl -lpe 'BEGIN{$|=1}'} alias.t winorder { @:winnum=winnum() stack push set beep ^set beep off ^parsekey unstop_all_windows fe ($revw($numsort($filter($winnum $winrefs())))) foo { if (foo!=winnum()) { ^window swap $foo parsekey scroll_end } } window swap $winnum stack pop set beep } alias.t wn window new cetk.connmgmt0000644000076500007650000003763711404224135013770 0ustar jmidgleyjmidgley# CETK epic Server Connection Management script 0.0 # unload cetk.connmgmt package cetk.connmgmt load functions load cetk.functions load commandqueues # Away management. fe (send_msg send_public send_action) foo {on #-$foo + * {if (isaway()){q1cmd 0 999 back}}} on #-idle + * { if (!A && 2 < cloak) {return} @ :int = cetk.away.int ? cetk.away.int : 20 @ :min = cetk.away.min ? cetk.away.min : 20 if ([$0] < min) {return} if ([$0] % int) {return} allservs q1cmd 0 9 away } alias away (args) { if (rmatch($servergroup($serv) $my.cloaknets)) {return} @ :sn = servernum() @ cetk[away][int] = isnumber(b10 $args) ? shift(args) : cetk[away][int] @ cetk[away][min] = isnumber(b10 $args) ? shift(args) : cetk[away][min] @ cetk[away][$sn] = args = args ? args : cetk[away][$sn] @ args = args ? args : [Sideways to the Sun.] //away -- $args :: /ctcp $servernick() clientinfo * :: gone for $tdiff2($E) as of $Z } alias back //away # Disconnect disconnected servers. # alias.t discdisc (args) { $getopts(:args :opt_ "acdehrg:i:n:o:x:y:" $args) @ :lagtime = isnumber(b10 $args) ? shift(args) : 0 @ :contime = isnumber(b10 $args) ? shift(args) : 60 if (opt_h) { echo Disconnect disconnected servers (do nothing) echo usage: ${t} [minlag] [minconn] -options [message] echo -g * Match servergroups *. echo -i * Match itsnames *. echo -o * Match ournames *. echo -a Act on all matching servers. echo -c Act only on connected servers. echo -d delete after /disconnect. echo -e ignore channeled servers. echo -r /reconnect, not /disconnect. echo -n N Act only on N matching servers. echo -y * Include userhost. echo -x * Exclude userhost. return } fe (g i o) foo { fe ($(opt_$foo)) bar { push :matches $serverctl(${foo}match $bar) } } @ :matches = #matches ? matches : serverctl(omatch *) @ :matches = filter(<*> $matches) @ :opt_a = !opt_a, :opt_c = !!opt_c @ :cmd = opt_r ? [reconnect] : [disconnect] fe ($shufflef($uniq($matches))) serv { @ :eserv = serversrefe($serv) if (opt_a && opt_c ^ isconnected($serv)) { } elsif (contime > time()-lag[$serv][connected]) { } elsif (lagtime > time()-lag[$serv][pingorpong]) { } elsif (opt_e && mychannels($serv)) { #} elsif (opt_r && serverwin($serv)) { } elsif (rmatch($serverctl(get $serv userhost) $opt_x)) { } elsif (rmatch($serverctl(get $serv userhost) $opt_y) || !opt_y) { $cmd $serv ${args?args:randomread(~/.BitchX/BitchX.quit)} if (opt_d) {server -d $serv} unless (--:opt_n) {break} } } } # Delete servers with no excuses. # alias.t server.del fe ($*) serv {disconnect $serv;server -d $serv} # Add/duplicate servers with no excuses. # alias.t server.fadd (ret) { @ :ret = #ret ? ret : servernum() fe ret foo { if (isnumber(b10 $foo)) { @ :spec = [name port pass nick group] fe spec spec {@ :bar#= serverctl(get $foo $spec)#[:]} @ :foo = bar } do { @ :sv = rand(0) } until (0 > servernum($sv)) @ :sv = 2**31 @ :sv = -1 - rand($sv) server -a $sv:$cut(1.9 : $foo) @ serverctl(set $servernum() name $cut(0 : $foo)) @ foo = servernum() } return $ret } # Translate servernames into IPs to avoid non-blocking dns issues. # alias.t server.ipfix { fe ($serverctl(omatch $*)) sn { @ :sn = isnumber(b10 $sn) ? sn : servernum($sn) @ :ht = serverctl(get $sn name) @ :ip = nametoip($ht) @ :lo = iptolong($ip) @ serverctl(set $sn name ${lo?ip:ht}) } } # Lag measurement system. # alias.t sping if (isconnected($servernum())) {quote PING ${(lag[$servernum()][sping] = time()) - F} ${[.]==[$0]?S:[$*]}} # on #^pong 0 '\\[$S $servernick()\\] % \\[$S $servernick() ${lag[$servernum()][sping]-F}\\]' # on #-pong + * { @ :sv = servernum() @ lag[$sv][pong] = time() @ lag[$sv][ping] = isnumber(b10 $2) ? [$2] + F : lag[$sv][sping] @ lag[$sv][lag] = lag[$sv][ping] ? lag[$sv][pong] - lag[$sv][ping] : [?] @ lag[$sv][pingorpong] = lag[$sv][ping] ? lag[$sv][ping] : lag[$sv][pong] timer -up -ref sping.$sv 60 sping } # on #-connect + * { @ lag[$servernum()][connected] = time() @ lag[$servernum()][joining] = 0 userhost $servernick() -cmd {sping} } # fe (471 473 474 475 379 channel_sync) foo { on #?$foo ${isnumber($foo) ? 0 : [+]} * { @ lag[$servernum()][joining] = 0 ^timer -ref winser1 20 ^winservchans return $rmatch($1 $my.ignorebans) } } # on #?send_to_server 0 "% % JOIN *" { @ :serv = [$0] if (![$3]) { return 0 } elsif (count(, $3)) { } elsif (lag[$serv][joining] > lag[$serv][pingorpong]) { } elsif (60 < time()-lag[$serv][pingorpong]) { } else { @ lag[$serv][joining] = time() return 0 } qcmd @ :chans = [$3] @ :ckeys = [$4] while (@chans) { @ :chan = beforr(, $chans) @ :ckey = beforr(, $ckeys) unless (@ckey) { @ :echan = encodel($chan) @ :ckey = pop(list[chan][$echan][keys]) unshift list[chan][$echan][keys] $ckey } fq1cmd 0 9 quote $2 $chan $ckey @ :chans = after(, $chans) @ :ckeys = after(, $ckeys) } return 1 } # Ping self at regular intervals. # alias.t deidle (args) { @ :min = isnumber(b10 $args) ? shift(args) : 60 @ :max = isnumber(b10 $args) ? shift(args) : 60 * min @ :srv = isnumber(b10 $args) ? shift(args) : servernum() @ :targs = [-ref ${t}.$srv] unless (isconnected($srv)) {return} while (args =~ [-*]) {push targs $shift(args)} @ :rnd = max - min @ :rnd = min + rand($rnd) @ :args = args ? args : [ping] @ :args = [\\\$urldecode\($urlencode($args)\)] scmd $srv defer timer $targs $rnd ${t} $min $max $srv $args\\\;$args } # HTTP connect proxy navigation. # on #-server_status + "% % delet*" purge serv[$0][proxy] on #-server_established + * { #fe ($last[$encodel($0:$1)][proxy]) foo { fe ($serv[$servernum()][proxy]) foo { repeat ${isnumber(b10 ${:bar=cut(6 : $foo)})?bar:1} { pause ${!(:bar=cut(7 : $foo))?0:isnumber(b10 $bar)?bar:[]} switch (${0+iptolong($cut(0 : $foo))} $:proto) { (0 socks%) {xquote -u %04%01%$after(-2 % $int2url($cut(1 : $foo)))$int2url(1)%00$cut(0 : $foo)%00} (% socks%) {xquote -u %04%01%$after(-2 % $int2url($cut(1 : $foo)))$int2url($iptolong($cut(0 : $foo)))%00} (*) {quote CONNECT $cut(0.1 : $foo) HTTP/1.0$chr(13 10)} } @ :proto = cut(5 : $foo) } @ :proto = cut(5 : $foo) } } # alias.t server.proxy (px) { $getopts(:px :opt_ r $px) if (:opt_r) { fe px px { @ :ht = before(: $px:) @ :ht = isnumber(b10 $ht) ? ht : nametoip($ht) @ :px = ht ? unsplit(\: $ht $after(\: $px)) : px } } @ :sv = shift(px) until (index(+ $sv)) { @ :plus++ @ :sv = rest(1 $sv) } server.fadd ${isnumber(b10 $sv) ? serversref($sv) : sv} #@ last[$serversrefe()][proxy] = [$cut(0.5 : $sv):${cut(6 : $sv)-1} $px] @ serv[$servernum()][proxy] = [$cut(0.5 : $sv):${cut(6 : $sv)-1} $px] if (1 winvisible($win) ? [-] : [+] @ :con = isconnected($serv) ? [+] : [-] @ my[sw] = leftw(1 $numsort($my[sw] -$@serv)) @ my[ww] = leftw(1 $numsort($my[ww] -$@win)) if (chan == [.] && 0 <= winserv($win)) { } elsif (0 <= findw($chan $mychannels(#$win))) { } elsif (rmatch($win,$serv,$vis$con,$chan $*)) { xecho -banner -nolog -- $[$my[ww]]win $[$my[sw]]serv $chan } } } alias wsc.movenul (args) { $getopts(:args :opt_ m:r:sj $args) unless (#args) { echo Requires: -js [-r randfactor] [-m maxmoves] towin toserv wscmask ... return } @ :newwin = isnumber(b10 $args) ? shift(args) : winnum() @ :newserv = isnumber(b10 $args) ? shift(args) : winserv($newwin) @ :newserv = servergroups($newserv) @ :opt_m = opt_m ? opt_m : serverctl(get $servernum() 005 MAXCHANNELS) @ :opt_m = opt_m ? opt_m : 10 @ :opt_r = opt_r ? opt_r : 1 fe my.winservchans win serv chan { @ :spec++ @ :vis = 0 > winvisible($win) ? [-] : [+] @ :con = isconnected($serv) ? [+] : [-] if (!rmatch($win,$serv,$vis$con,$chan $args)) { } elsif (0 <= findw($chan $mychannels(#$win))) { } elsif (opt_s && win!=newwin && serv!=newserv) { @ :select++ @ :rand = rand($select) ? rand : spec } elsif (!rand($opt_r) && 0 <= --opt_m) { @ win = newwin @ serv = newserv if (opt_j) {xeval -w $win -s $serv join $chan} } } if (rand) { fe my.winservchans win serv chan { unless (--rand) { @ win = newwin @ serv = newserv if (opt_j) {xeval -w $win -s $serv join $chan} } } } } alias.t wsc.spread (args) { $getopts(:args :opt_ hm:s: $args) if (:opt_h) { echo /${t} -s [wscmask] -m [maxmoves] [destwindowlist] # Spread all unjoined channels amongst all servers in current servergroup. } @ :wins = serverctl(get $servernum() name) @ :wins = serverctl(omatch $wins) fe wins wins {@ wins = serverwin($wins)} @ :args = args ? args : uniq($wins) if (opt_s) { @ :opt_m = opt_m ? opt_m : #args while (opt_m && args) { wsc.movenul -m ${2**31} -r ${opt_m--} $shift(args) $opt_s } } else { @ :opt_s = replace(n,* n $wins) fe args arg { wsc.movenul -m ${2**31} -r ${++:foo} $arg $opt_s unless (--:opt_m) {break} } } } alias wsc.save (fn, args) { @ :fd=open($fn w) @ struct.savefd($fd cloak last my) @ write($fd set LOG $getset(LOG)) @ write($fd dnotify $notify()) fe ($revw($winrefs())) ref { @ write($fd if \(0 > winvisible\($ref\)\) \{window new number $ref\}) @ write($fd if \([$winnam($ref)] != winnam\($ref\)\) \{window $ref name "$winnam($ref)"\}) } @ write($fd while \($serverctl(max) > serverctl(max)\) {server -a $rand(0)}) fe ($myservers(.)) ref { @ :args = [name port nick] #fe args foo {@ foo = [serverctl\(set $ref $foo \$decode\($encode($serverctl(get $ref $foo))\)\),]} fe args foo {@ foo = [serverctl\(set $ref $foo $serverctl(get $ref $foo)\),]} @ write($fd @ $args) } @ close($fd) } alias wsc.add { @ :owsc = my.winservchans winservchans $* push my.winservchans $owsc } alias wsc.del { fe my.winservchans win serv chan { if (rmatch($win,$serv,$chan $*)) { @ win = serv = chan = [] } } } alias winservchans { @:utime=utime() @:myservers=[] @:fix=[] @:fixchan=[] @:fixserv=[] ^local zcmd. if (debug.winservchans) {echo $tdiffu($utime) start} if ((#)%3) { echo Your line is incorrectly formatted. } elsif (#) { @ :newwins = [] @ :nextnew = 2 @ my.winservchans = [] load.servs fe ($*) win serv chans { if (0==win) { @win=nextnew++ } elsif (0findw($win $winrefs())) {continue} @:winserv=winserv($win) @:open=!rmatch("$serverctl(get $winserv status)" "" clos* *connect*) @:ews=encode($winserv) @:servok=open&&(0<=winserv)&&(0<=findw($before(: $serv:) $winserv $serverourname($winserv) $servername($winserv))) @:chanok=match($chan . $mychannels(#$win)) if (servok&&chanok) { if ([.]!=chan&&win!=chanwin($chan $winserv)) { @splice(fixchan ${2*rand(${1+numwords($fixchan)/2})} 0 $win $chan) } } elsif (!servok&&(match($serv $myservers))) { @splice(fixserv ${2*rand(${1+numwords($fixserv)/2})} 0 $win $serv) } elsif (E/60>=getset(cpu_saver_after)) { if (!rand(${++zrand[0]})) {^local zcmd[0] $win $serv .} } else { #echo $win $winvisible($win) $ews $zrand[$ews] @:eserv=serversrefe($winserv) if (open&&0<=winserv&&90time()-lag[$winserv][joining]) { #echo fail 2 } elsif (isnumber(b10 $lag[$winserv][lag])&&90=winnum($crapwin)?win:(winserv($win)==winserv($winnum($crapwin)))?crapwin:[$win server $serv $crapwin]} server $serv ${#key?[rejoin]:[channel]} $chan $key)) } ^assign -zrand[$foo] #echo $foo $win $serv $chan } if (debug.winservchans) {echo $tdiffu($utime) choose2} if (fix) { if (debug.winservchans) { xecho -banner -window crap -- $fixserv xecho -banner -window crap -- $fixchan xecho -banner -window crap -- $fix } unless (2&debug.winservchans) { window $fix } } if (debug.winservchans) {echo $chr(2)$tdiffu($utime)$chr(2) fix} } # alias.t wininit (fns,args) { @ :fns = #fns ? fns : [*] @ :fns = unsplit(, $fns) fe fns foo { ^assign foo $aliasctl(alias pmatch ${t}.$foo) } @ :fns = uniq($fns) fe fns foo { ^assign foo $(${foo}()) if (#foo%3) {echo Incorrectly formatted: $foo} } wsc.add $fns $args } # Swap to the windows with the named channels or servers. # alias.t wswap (args) { @ :sw = :wr = winrefs() fe sw sw {@ sw = winserv($sw)} fe args arg {@ arg = ischannel($arg) ? chanwin($arg) : revw($copattern($arg sw wr))} fe args arg {unshift arg swap} window $args } # Links mapper. on #-364 1 ** { unless (links.reap[$encode($0)]) { @ links.reap[$encode($0)] = 1 links.reap $0 } @ links.back[$encode($1)] = [$2] fe ($encode($2) $1 $encode($1) $2) bar baz { fe (all now) foo { ^assign.add links[$foo][$bar] $baz } } } on #-365 1 ** { @ links.reap[$encode($0)] = [] links.map $0 } alias.t links.map (serv default $S, bits, args) { @ :pipes = bits @ :pipes = msar(gr/1/ |/0/ /pipes) @ :eserv = encode($serv) @ :lserv = args ? rightw(1 . $args) : serv @ :link = -1 < findw($lserv $links[now][$eserv]) || !args @ :loop = -1 < findw($serv $args) @ :back = links[back][$eserv] @ :pipe = link ? [\\_] : [$chr(2) _$chr(2)] @ :flag = back ? [-] : [+] @ :flag = link ? [] : flag @ :flag = loop ? [*] : flag @ :alt = links[alt][$eserv] xecho -- * $pipes$pipe$serv $chr(2)$remws(/$flag ${#alt?#alt:[]})$chr(2) $alt @ links[alt][$eserv] = [] fe ($uniq($links[all][$eserv] $links[now][$eserv])) xserv { if ((link || !back) && 0 > findw($xserv $serv $args)) { if (:lastserv && !loop) { ${t} $lastserv ${bits}1 $args $serv } @ :lastserv = xserv } } if (:lastserv && !loop) { ${t} $lastserv ${bits}0 $args $serv } } alias.t links.reap { @ :serv = encode($0) fe ($links[now][$serv]) foo { if (0 > findw($foo $*)) { ${t} $foo $* @ links[now][$serv] = links[back][$serv] = [] } } } alias.t wimap (args) { who -line { push links[alt][$encode($5)] $strip(GH $2)$1 } -end { links.map $S } $unsplit(, ${args ? args : mychannels()}) } # Slow Paste # alias.t slowpaste (file, dest default $T, rep default 3) { @ :fh = open($file R) if (0 > fh) { echo usage: /${t} [filename] [dest] [waits] } else { @ :utime = utime() echo ${t} $* while ((:read = read($fh)) || !eof($fh)) { msg $dest ${#read?read:[ ]} unless (++:wait % rep) {wait} } echo ${t} $* \(Finished: $tdiff($tdiffu($utime))\) } @ close($fh) } cetk.entertainment0000644000076500007650000002341011177560127015016 0ustar jmidgleyjmidgley# CETK epic miscelaneous fun script 0.9 unload cetk.entertainment package cetk.entertainment load cetk.functions alias.pipel1 factor.e factor alias.t factor.s { @ :num = [$0] if (num==(1&num)) { @ num = [] } elsif (num%2) { for foo from ${1<#?(1|[$1]):3} to ${(num**2)**0.25} step 2 { unless (num % foo) { @ num = [$foo $${t}(${num/foo} $foo)] break } } } else { @ num = [2 $${t}(${num/2} 2)] } if (functioncall()) { return $num } else { echo $0$chr(9)$num } } alias.t factor.f { @ :num = [$0] @ :root = (num**2)**0.25 @ :factors = [] for foo in ($primes.walk($root)) { if (root#factors) { push factors $num } if (functioncall()) { return $factors } else { echo $0$chr(9)$factors } } alias.t factor.gcf (args) { @ :factors = factor.e($shift(args)) fe ($args) arg { @ :factors = common($factors / $factor.e($arg)) } if (functioncall()) { return $uniq($factors) } else { echo $0$chr(9)$uniq($factors) } } alias.t primes.exec (top,bot default 0,...) { fe ($exec(primes $bot $top)) in out err {break} @ close($in) @ close($err) @ :ret = readfdlineall($out) @ close($out) if (functioncall()) { return $ret } else { echo $ret } } alias.t primes.sieve { @ :nn = :non = :ret = [] @ :top = [$0] @ :root = top**0.5 for foo from 3 to $root step 2 { if (0 > findw($foo $nn)) { @ nn#= remws($nn / $jot(${2*foo} $root $foo))##[ ] @ non#= remws($non / $jot(${2*foo} $top $foo))##[ ] } } @ :ret = remws($non / 2 $jot(3 $top 2)) if (functioncall()) { return $ret } else { echo $ret } } alias.t primes.walk { @ :bottom = my.primes?pop(my.primes):2 @ :top = [$0]?[$0]:bottom+1000 push my.primes $bottom @ :foo=:food = (1|++bottom) until (foo>top) { @ foo = food @ :baz = foo**0.5 fe ($my.primes) bar { if (bar>baz) {break} unless (foo%bar) { @ foo = 0 break } } if (foo) { push my.primes $foo } @ food += 2 } if (functioncall()) { return $my.primes } else { echo $my.primes } } # Aliases stuff which shouldn't be in a client. alias.t games.numpadtest (mx default 1000, ...) { #stack push bind key_plus #bind -symbolic key_plus erase_line @ :pass = :fail = 0 @ :num = chr($jot($ascii(09))) @ :ut = utime() while (1) { @ :rn = rand($mx) @ :rd = [$"$rn "] if (rd == []) { break } elsif (strip($num $rd)) { @ :null++ } elsif (rn == rd) { @ :pass++ } else { @ :fail++ beep } } @ :ut = tdiffu($ut) @ :fp = setset(floating_point_math on) echo $pass+$fail / $ut = ${pass/ut} + ${fail/ut} ^set floating_point_math $fp #stack pop bind key_plus } alias.t games.acrogrep (word,files default /usr/share/dict/words) { @ :wd = :lt = word fec wd wd {@ wd = [\[$word\]]} fec lt lt {@ lt = [ | grep -i $lt]} exec grep -i '^$wd\$' $files $lt } alias.t plot.text (args) { @ :code = getcap(term cup 1 0) until (code == sar(r/%i//code)) {@ ++:add} xecho -r $sar(/%p2%d/${shift(args)+add}/$sar(/%p1%d/${shift(args)+add}/$code))$args } alias.t screen.fill (args) { @ :xx = getcap(term lines 1 1) @ :yy = getcap(term cols 1 1) @ :code = getcap(term cup 1 0) until (code == sar(r/%i//code)) {@ ++:add} fec ($args) arg { @ :xxx = rand($xx) + add @ :yyy = rand($yy) + add xecho -r $sar(/%p1%d/$xxx/$sar(/%p2%d/$yyy/$code))$arg } } alias.t screen.snake { @ :xx = getcap(term lines 1 1) @ :yy = getcap(term cols 1 1) @ :xxx = rand($xx) @ :yyy = rand($yy) @ :code = getcap(term cup 1 0) until (code == sar(r/%i//code)) {@ ++:add} fec ($*) arg { switch ($rand(4)) { (0) {@ :xxx++} (1) {@ :xxx--} (2) {@ :yyy++} (3) {@ :yyy--} } @ xxx = xxx < 0 ? xx : xxx > xx ? 0 : xxx @ yyy = yyy < 0 ? yy : yyy > yy ? 0 : yyy xecho -r $sar(/%p1%d/${xxx+add}/$sar(/%p2%d/${yyy+add}/$code))$arg } } alias.t screen.termcap { fe ($*) cap { echo $cap = "$getcap(term $cap 0 1)" = "$getcap(term $cap 1 1)" = "$getcap(term $cap 2 1)" } } alias.t pong (chan default *,list,args) { @ :list = shuffles($uniq($split(, $list))) fe list list {@ list = onchannel($list $chan) ? list : []} @ :chus = chanmode($chan) =~ [*m*] ? chops($chan) : chanusers($chan) @ :list = 1<#list ? unsplit(, $list) : word.randsel($remw($servernick() $chus)) @ :diff = isnumber(b10 $args) ? shift(args) : 0 ctcp $chan PONG $list $utimen() $diff $args } addctcp pong "plays a game of channel pingpong. '/ctcp #channel pingpong $servernick()' starts a game. The game is to roll your own code to work with this." { @ :sn = servernick() if (2>=1}} if (functioncall()) { @ function_return = joinstr(" " args logs bits) } else { fe ($joinstr(" " args uhts logs bits)) foo {echo $foo} } xdebug $oxd } # Geolocation. # alias geoloc (nick,userhost,chan,net,args) { $getopts(:args :opt_ haclpuf: $args) if (opt_h) { echo -p Reply privately. echo -a Return info from all networks. echo -c Return info from only this channel. echo -u Key from user@host rather than nick. echo -f file File to store user geolocation data. echo -l Lock config switches (-f) switch off. } if (opt_f && !opt_l) { @ cetk.geoloc.file = opt_f return } setuniqitem geoloc ${opt_a?1:0} ${opt_c?1:0} ${opt_p?1:0} ${opt_u?1:0} $nick $userhost $chan $net $args echo => ${args} ^exec -direct -window -name geoloc$servernum() -line { echo $* #@ :args = getandmitem(geoloc % % % % % % % % $beforew(# $2-)*) @ :args = getandmitem(geoloc % % % % % % % % $2-) echo <= $args @ :opt_a = shift(args) @ :opt_c = shift(args) @ :opt_p = shift(args) @ :opt_u = shift(args) writeto $cetk.geoloc.file $0-1 $args @ :nick = shift(args) @ :chan = shift(args) @ :chan = shift(args) @ :net = shift(args) @ :pid = urlencode(geoloc $args) @ :opt_c = opt_c ? [\$F[4] =~ /^$chan\$/i] : 1 @ :opt_a = opt_a ? 1 : [\$F[5] =~ /^$net\$/i] @ :grep = [| perl -lane 'print if $opt_a && $opt_c'] @ :uopt = opt_u ? [-i -f3] : [-i -f2] @ :dest = opt_p || N == chan ? nick : chan @ :awk = [perl -lane 'END {print "$nick, you are @f."}\; if ($nick) {push @f,((int $F[2]*1000)/1000)." km from $F[3]"} else {$nick = $F[3]}'] ^exec -window -m $dest tac $cetk.geoloc.file $grep| uniqo $uopt | latlong2distdeg | sort -nk3 | $awk } loc2latlong exec -in %geoloc$servernum() $args } geoloc . . . . -f ~/.epic/geoloc.dat # Search the scrollback for urls and open them. First arg, if numeric, opens the n'th url found. # alias.t viewlasturl (args) { @ :which = isnumber(b10 $args) ? shift(args) : 1 @ :pattern = args ? args : [%://% www.% ftp.%] @ :oxd = xdebug(dword extractw) xdebug dword extractw fe ($jot(1 $winscrollbacksize())) foo { if ((:urls = pattern("\\[$pattern\\]" $line($foo))) && ++:found == which) {viewurl $urls} } xdebug $oxd } alias.t viewurl fe ($*) foo {exec -direct -name viewurl$rand(${2**31}) x-www-browser $foo} on #^exec_exit 0 "viewurl% *" cetk.fserve0000640000076500007650000005725310766172332013443 0ustar jmidgleyjmidgley# CETK epic4 FServe 0.9 # http://www.epicsol.org/~crazyed/cetk.fserve # # Required (epic4 dist). load commandqueues # unload cetk.fserve package cetk.fserve @ fserve.serial = 0 + getserial(hook + 1) assign fserve.version CETK FServe 0.0 for epic4 w/ xdcc/cdcc/omen triggers # # This won't work with epic4 1.0.1 and it won't work _entirely_ for # anything below 1.1.11. # # It also requires these shell commands: # rm mv find sort file md5sum test join cut sed. # # # This is the simplest way to get this going: # # /fserve.serve * * * # # This will turn on all available server types and serve # all tags to all channels. You only need do this once. # # /fserve.addpath [tag] [dir] [mask] // [tag-description] # # This will make a new tag and serve all files matching [mask] in # [dir]. Any number of dirs can be added with additional fserve.addpath # commands or by using masks. The tags don't need to be unique, however # if they aren't unique, then the two directories will appear to be # unified. # # You can serve just some files in a directory by specifying any number # of [masks] at the end of the addpath command before the double slash. If # a file matches any mask, then the file appears in the find and list # requests, but are not filtered from the stat and send requests, so # technically, it is possible to serve hidden files. # # Configuration Examples. This is what I have in my .epicrc: # # fserve.serve xdcc * * # fserve.serve omen *mp3*,*book* mm,text # fserve.addpath code ~/bin/ *tcp* *proxy* *port* # fserve.addpath epicstuff ~/.epic/ cetk.* // This script is served from here. # fserve.addpath epicstuff ~/epic/ * // More Epic scripts and sources. # fserve.addpath mm {/home/*/*{dl,mp3}/,/mnt/*{,/}cd{rom,}/} // Multimedia. # fserve.addpath pub /pub * // /pub # # Queueing: # # There are two layers of queueing. The first is traditional where only one # dcc send is open at once. When the current one finishes, it allows the next # one to start. This queueing system relies on an external command queueing # system. This makes it possible to provide each user with at least one # transfer asap, but makes it difficult to add queue status commands and such. # Another side effect of this underlying queueing method is that requests will # be addressed in a vaguely random order, rather than the sequential order that # omen users are used to. In addition, there is nothing to limit the maximum # number of queued requests. # # The second queueing system is in effect after the first one is passed and the # transfer starts. It relies on the epic "dcc hold" feature, where if a dcc is # "held", the transfer will stop sending data until it is "unheld". This # queueing system leaves just one dcc unheld at any one time. When one dcc # finishes, the next dcc is unheld. The next dcc to be unheld is the one with # the least remaining data in the transfer. The purpose of this is to clear # off as many dccs as possible as quickly as possible. This queueing method # does have problems. Some clients will automatically close dccs that they # perceive to be not transfering data, and this normally covers these held # dccs. For this reason, the feature has been turned off by default. If you # wish to turn it on again, you should put "set fserve.maxusersends 0" in your # ~/.epicrc. # # There is no feature in this script that permits file list dccs to have an # explicitly higher priority, however, the first dcc will always receive the # highest priority, and that nearly always includes the file list dcc. # # Before each dcc is initiated, the userhost of the requesting nick is compared # with the current userhost of that nick. This means that if someone requests # a file, then disconnects, then another user uses the same nick, they will not # receive the send request, but the request will be silently discarded instead. # The userhost of the dcc will then become the feature that distinguishes each # user for the purpose of controlling both of these queueing mechanisms. # # Security notes: # * It should not be possible to escape the directory structure you set # up unless you have a file system link pointing outside of it. # * /exec is used. It is designed to be secure, but that can't be # guaranteed. Where possible, -direct has been used to pre-empt any # potential shell expansion exploits. Where -direct cannot be used, # no input from the network is fed to the /exec. # * One last remaining worry is that the find shell command has an # -exec flag. The script prevents external use of this flag, but there # may be ways around this that I don't yet know about. # * Any difference between these security notes and reality should be # reported to the current maintainer. # * It is possible to abuse the client via the chat interface by # flooding it. # # Other notes: # * Server types are xdcc (which does cdcc) and omen, but I cheated # with omen by giving it @find and @[nick] and making it return # xdcc commands instead of real omen commands. # # Remaining issues: # * Omen SLOTS ctcps aren't used in this script. It may not be added. # If you want it, it should be fairly easy to script. # * The queueing system needs to be tuned and given extra features. # * The omen script can be configured to give greater priority to opped and # voiced users on a channel. The theory is that since servers get opped or # voiced, the catch cry "serve and you shall receive" comes true. This # script gives equal priority to everybody, but it may be "fixed" in # future. # # # Settings. Change as desired. # # maxsends is the number of omen style "slots". # maxusers is the maximum number of users that can be sent to at a time. # maxusersends is the maximum number of dcc sends open to any one user at a time. # # These settings may not make sense until you consider the dcc streaming system # which will place all but the smallest dcc to a user on hold, meaning that # each user will always have up to one active dcc at any one time, in effect. # # Setting maxusersends to 1 will turn this streaming behaviour off. # assign fserve.set.maxqueue 0 assign fserve.set.maxsends 0 assign fserve.set.maxusers 0 assign fserve.set.maxusersends 0 # Supporting functions. # alias cdexec (args) { @ :owd = W cd $shift(args) exec $args cd $owd } # List maintenance commands. # # A tag is a synonym for a directory. # alias fserve.addpath (tag,path,masks) { @ :tp = encode($tag $path) @ :desc = afterw(// $masks) @ :time = isnumber(b10 $desc) ? shift(desc) : 0 @ :cmasks = :fmasks = beforew(// $masks //) fe cmasks mask {@ mask = ischannel($mask) ? mask : []} fe fmasks mask {@ mask = ischannel($mask) ? [] : mask} fe (cmasks fmasks desc time) ar { @ fserve[tp][$tp][$ar] = [$($ar)] } } # alias fserve.delpath (mask) { foreach fserve[tp] tp { if (decode($tp) =~ mask) { purge fserve.tp.$tp } } } # Basic infrastructure. # # Find: Find the files matching [mask] under the relevant paths [tags] # and message them to [nick] preceded by [prefix]. # alias fserve.find (me,nick,tagm,pftag,mask) { @ :oxd = xdebug(dword) xdebug dword @ :tagm = split(, $tagm) @ :cmd = shift(mask) @ :prefix = shift(mask) @ :lprefix = shift(mask) @ :fprefix = shift(mask) @ :hprefix = shift(mask) @ :count = 0 fe mask mask { @ :type = mask =~ [*/*] ? [-ipath] : [-iname] @ :star = 0 > index(?* $mask) ? [*] : [] @ sar(gr/\\/\\\\/mask) @ sar(gr/"/\\"/mask) @ mask = [$type "$star$mask$star"] } foreach fserve.tp tp { @ :pid = [fsfind_$rand(1000000)] @ :path = decode($tp) @ :tag = shift(path) @ :path = globi($path) @ :masks = fserve[tp][$tp][fmasks] @ :or = [] unless (rmatch($tag $tagm)) {continue} fe path path {@ path = ["$path"]} fe masks masks { @ masks = [$or -iname $masks] @ or = [-o] } @ fserve[pids][$pid][lprefix] = [$lprefix $tag] @ fserve[pids][$pid][hprefix] = [$cmd $nick $hprefix] exec -window -direct -name $pid -end {purge fserve[pids][$0]} -line { if (:hprefix = fserve[pids][$0][hprefix]) { @ fserve[pids][$0][hprefix] = [] if (nick =~ [=*]) { $hprefix } else { q1cmd 30 9 $hprefix } } if ([$2] =~ [=*]) { $1- } elsif (10 >= ++fserve[pids][$0][count]) { q1cmd 1 9 $1- } else { exec -close %$0 q1cmd 1 9 $1-2 Too many matches. Refine search or request list with this command: $fserve[pids][$0][lprefix] unless ([$2] =~ [=*]) {q1cmd 5 9 wait} } } find $path -type f \( $masks \) $mask ! -type d -printf "$pid $cmd $nick $prefix $tag/%P\\n" } xdebug $oxd } # # List: Find all files under all [tags], add [prefix], zip the lists and send to [nick]. # alias fserve.list (me,nick,tagm,pftag,args) { @ :oxd = xdebug(dword) xdebug dword @ :sn = servernum() @ :tmp = [/tmp/] @ :tagm = split(, $tagm) @ :ftime = strftime(%F) @ :cmd = shift(args) @ :prefix = shift(args) @ :lprefix = shift(args) @ :fprefix = shift(args) @ :hprefix = shift(args) @ :matches = 0 @ :userhost = userhost() @ :tags = [] foreach fserve.tp tp { @ :path = decode($tp) @ :tag = shift(path) @ :path = globi($path) @ :fn = [$tmp/$me-${ftime}-${tag}-${pftag}.txt] if (!rmatch("$tag" $args)) { continue } elsif (!rmatch("$tag" $tagm)) { continue } if (0 < fsize("$fn") || 0 < fsize("" $fn)) { push :oldfiles $fn continue } else { push :newfiles $fn } @ :masks = fserve[tp][$tp][fmasks] @ :or = [] fe masks mask { @ mask = [$or -iname '$mask'] @ or = [-o] } exec -window -direct -name fslist_$fn sh exec -in %fslist_$fn find $path \\\( $masks \\\) ! -type d -printf '%p:$prefix $tag/%P\\t# %5kk \\n' >> $fn~1 exec -in %fslist_$fn find $path \\\( $masks \\\) ! -type d -print | file -k -L -f - | sed -e 's/: */: /' >> $fn~2 } fe ($uniq($oldfiles)) fn { if (nick =~ [=*]) { fserve.dcc $userhost send $nick $fn } else { scmd $sn q1cmd 1 97,98,99 fserve.dcc $userhost send $nick $fn scmd $sn q1cmd 1 97,98,99 wait } } fe ($uniq($newfiles)) fn { @ :enc = encode($userhost send $nick $fn) if (nick =~ [=*]) { wait %fslist_$fn -cmd \{fserve.dcc \$decode\($enc\)\} } else { wait %fslist_$fn -cmd \{scmd $sn q1cmd 1 97,98,99 fserve.dcc \$decode\($enc\)\} wait %fslist_$fn -cmd \{scmd $sn q1cmd 1 97,98,99 wait\} } exec -in %fslist_$fn sort -u $fn~1 > $fn~ && mv $fn~ $fn~1 exec -in %fslist_$fn sort -u $fn~2 > $fn~ && mv $fn~ $fn~2 exec -in %fslist_$fn join -t: $fn~1 $fn~2 | cut -f2- -d: > $fn exec -in %fslist_$fn rm $fn~1 $fn~2 exec -in %fslist_$fn test -s $fn || rm $fn exec -in %fslist_$fn exit } if (uniq($newfiles $oldfiles)) { @ :msg = uniq($newfiles $oldfiles) fe msg msg { @ :msg = after(-1 / $msg) } @ :msg = [Queued the following file lists to you: $msg] if (nick =~ [=*]) { $cmd $nick $msg } else { scmd $sn q1cmd 5 9 $cmd $nick $msg } } else { @ :msg = [Please request my lists \('$lprefix *'\) or perform a search \('$fprefix [mask]'\). For help, try '$hprefix'. \[$fserve.version\]] if (nick =~ [=*]) { $cmd $nick $msg } else { scmd $sn q1cmd 5 9 $cmd $nick $msg } foreach fserve.tp tp { @ :path = decode($tp) @ :tag = shift(path) if (!rmatch("$tag" $tagm)) { continue } elsif (nick =~ [=*]) { $cmd $nick $lprefix $tag : $fserve[tp][$tp][desc] } else { scmd $sn q1cmd 5 9 $cmd $nick $lprefix $tag : $fserve[tp][$tp][desc] } } } xdebug $oxd } # # Sendto: Decode [file] given into the tag/path which find (above) # encoded, and then dcc the file to [nick]. # # flag & 1 == files for this user should not be sent concurrently. # flag & 2 == use of a priority slot is permitted. # alias fserve.send (flag,nick,cmd,file) { @ :tags = before(/ $file/) @ :file = after(/ $file) @ :matches = 0 @ :uh = userhost() @ :oew = xdebug(extractw) xdebug extractw if (flag & 1) { @ fserve.unisends = uniq($uh $fserve.unisends) } else { @ fserve.unisends = remw($uh $fserve.unisends) } if (flag & 2) { @ fserve.priority = uniq($uh $fserve.priority) } else { @ fserve.priority = remw($uh $fserve.priority) } foreach fserve.tp tp { @ :path = decode($tp) @ :tag = shift(path) fe ($globi($path)) path { if (tag != tags) { continue } elsif (rmatch("$file" ../* */../*)) { # Please don't break out of our directory. continue } elsif (0 >= fexist("$path/$file") && 0 >= fexist("" $path/$file)) { continue } @ :queued = [97 98 99] fe queued queued {@ :queued = qcmd[$servernum()][$queued]} fe ($queued) foo {@ :queued += foo =~ [fserve.dcc $uh send $nick *]} if (++queued > fserve.set.maxqueue && fserve.set.maxqueue) { q1cmd 5 9 notice $nick Your maximum of $fserve.set.maxqueue queued files has been reached. } else { @ :msg = [$tags/$file has been queued. \[$fserve.version\]] q1cmd 1 97,98,99 fserve.dcc $uh send $nick "$path/$file" q1cmd 5 9 notice $nick For a total of $queued file/s, $msg } @ :matches++ } } unless (matches) { q1cmd 10 9 notice $nick No such file. A valid filename has at least one slash, may have spaces, is case sensitive and is not a number. Please try again. } xdebug $oew } # # fileinfo: send output of md5sum/file/etc of [file] to [nick]. # # The idea is that the user can cut'n'paste lines directly back to us # so we don't include file stats etc which might confuse the situation. # # flag info is the same for fserve.send. # alias fserve.stat (flag,nick,file) { @ :cmd = shift(file) @ :tags = before(/ $file/) @ :file = after(/ $file) @ :matches = 0 foreach fserve.tp tp { @ :path = decode($tp) @ :tag = shift(path) fe ($globi($path)) path { if (tag != tags) { continue } elsif (rmatch("$file" ../* */../*)) { # Please don't break out of our directory. continue } elsif (0 >= fexist("$path/$file") && 0 >= fexist("" $path/$file)) { continue } q1cmd 5 9 cdexec $path -window -direct -line \{$cmd $nick \$decode\($encode($file)\): \$*\} file -k -b -- "$file" q1cmd 5 9 cdexec $path -window -direct -line \{$cmd $nick md5: \$0 size: \$fsize\("\$sar\(, ,$path/,\$1-\)"\) \$1-\} md5sum -- "$file" @ :matches++ } } if (matches) { q1cmd 5 9 $cmd $nick $matches matches for $tags/${file}. Stats follow. \[$fserve.version\] } else { q1cmd 5 9 $cmd $nick No such file $tags/$file } } # # Block the exit messages without having to turn notify_on_termination off. # fe (fslist_% fsfind_% fsfile fsfind) foo { on ^exec_exit "$foo *" } # # DCC: Substitute for "dcc $1-". # # The purpose is to set the userhost of the DCC to $0 and to queue # the request if _any_ limit is reached. # # The queueing order is not preserved, but it will try not to punish # people for things they can't control. People with no transfers get # highest priority and people at their limits get lowest. # # The DCC will also be discarded if the userhost of the current nick # doesn't match $0. A userhost request will be made if the user and the # fserve aren't on a common channel to obtain this information. # # flag info is the same for fserve.send. # # The qcmd queues are like this: # 97 is for people with no open dccs and are blocked for other reasons. # 98 is for people with some, and have been blocked for other reasons. # 99 is for people who have used up all their allowed slots. # alias fserve.dcc (args) { @ :userhost = shift(args) @ :index = chr($jot($ascii(az))) @ :usermask = index($index $userhost) ? [*@]##after(@ $userhost) : userhost @ :usermask = common($dccctl(typematch send) / $dccctl(userhostmatch $usermask)) @ :userhosts = dccctl(typematch send) fe userhosts foo { @ foo = dccctl(get $foo userhost) @ foo = index($index $foo) ? [*@]##after(@ $foo) : foo } @ :fail0 = 0 < #usermask && 0 <= findw("$userhost" $fserve.unisends) @ :fail1 = 0 < fserve.set.maxusersends && fserve.set.maxusersends <= #usermask @ :fail2 = 0 < fserve.set.maxsends && fserve.set.maxsends <= #userhosts @ :fail3 = 0 < fserve.set.maxusers && fserve.set.maxusers <= #uniq($userhosts) if ([send] != word(0 $args)) { @ fserve.userhost = userhost dcc $args @ fserve.userhost = [ ] } elsif (fail0 || fail1) { timer.ue 10 q1cmd 1 99,98,97 fserve.dcc $userhost $args } elsif (fail2 || fail3) { if (rmatch($userhost $userhosts)) { timer.ue 10 q1cmd 1 98,97,99 fserve.dcc $userhost $args } else { timer.ue 10 q1cmd 1 97,98,99 fserve.dcc $userhost $args } } else { qcmd fserve.dccs $userhost dcc $args userhost $word(1 $args) -cmd { @ :cmd = qcmd(fserve.dccs) @ fserve.userhost = shift(cmd) if ([$3@$4] == fserve.userhost) { $cmd } else { echo Discarded $cmd } @ fserve.userhost = [ ] } } } eval on #-dcc_offer $fserve.serial * { @ :ref = dccctl(locked) if (#ref != 1) { } elsif (#fserve.userhost < 1) { echo no userhost given } elsif (#fserve.userhost > 1) { echo userhost with spaces given } elsif (fserve.userhost !~ [*@*]) { echo invalid userhost given: $fserve.userhost } elsif (fserve.userhost != dccctl(get $ref userhost)) { @ dccctl(set $ref userhost $fserve.userhost) } if (0 && [$1] == [chat]) { ^on -dcc_connect "$0 chat *" { ^msg =$0 Experimental chat interface. ^msg =$0 This is still being developed. ^msg =$0 Please use the /xdcc interface. } ^on -dcc_chat "$0" fserve.chatif \$* ^on -dcc_lost "$0-1" { ^on dcc_connect -"$0 chat *" ^on dcc_chat -"$0" ^on dcc_lost -"$0-1" } } } # # The chat interface handler. # alias fserve.chatif { shook ctcp =$0 $N XDCC $1- while (:cmd = qcmd()) {$cmd} } # This is where the rubber meets the road. The infrastructure # above is bound to protocol commands here. # # The fserve.serve protocols are modeled on certain other fserves. # alias fserve.serve (type,args) { @ :matches = 0 if (#args < 2) { echo Requires: [typemask] [chanmask] [tagmask] } else { foreach -fserve.serve fn { if (fn =~ type) { @ matches++ fserve.serve.$fn $args } } echo $matches trigger sets loaded. } } # alias fserve.serve.xdcc (dest,tags,args) { stack push alias on.t ^alias on.t {on $*;on $sar(g/XDCC/CDCC/$*)} @ :dest = split(, $dest) ^on.t -ctcp_request "% \\[$dest\\] XDCC *" \ @ :tags = [$tags]\;{ @ :nick = servernick() =~ [* *] ? N : servernick() @ :tome = nick =~ [=*] || [$0] =~ [=*] || nick == servernick() @ :send = [/ctcp $nick XDCC send] @ :list = [/ctcp $nick XDCC list] @ :find = [/ctcp $nick XDCC find] @ :help = [/ctcp $nick XDCC help] switch ($3) { (chat) { q1cmd 5 9 fserve.dcc $userhost() chat $0 } (find) { fserve.find $nick $0 $tags XDCC notice "$send" "$list" "$find" "$help" $4- } (list) { fserve.list $nick $0 $tags XDCC notice "$send" "$list" "$find" "$help" $4- } (send) { if (tome) {fserve.send 1 $0 notice $4-} } (sndm) { if (tome) {fserve.send 0 $0 notice $4-} } (stat) { if (tome) {fserve.stat 0 $0 notice $4-} } (*) () { if (!tome) { break } elsif (!rmatch("$3" "" help)) { q1cmd 5 9 notice $0 No such function: $3- } q1cmd 5 9 notice $0 XDCC commands: CHAT FIND LIST SEND SNDM STAT q1cmd 5 9 notice $0 XDCC CHAT # Unrestricted interface. (same commands) q1cmd 5 9 notice $0 XDCC FIND [pattern] # Return files matching all patterns. q1cmd 5 9 notice $0 XDCC LIST [pattern] # Send file lists for all matching tags. q1cmd 5 9 notice $0 XDCC SEND [file] # Queue a served file for send. q1cmd 5 9 notice $0 XDCC SNDM [file] # Send multiple requests concurrently. q1cmd 5 9 notice $0 XDCC STAT [file] # Info about a served file. } } } stack pop alias on.t } # alias fserve.serve.omen (dest,tags,args) { stack push alias on.t ^alias on.t {on $*;on $sar(g/public_other/public/$*)} @ :dest = split(, $dest) ^on.t #-public_other $fserve.serial "% \\[$dest\\] @find *" \ @ :tags = [$tags]\;{ @ :nick = servernick() ? servernick() : [$1] fserve.find $nick $0 $tags OMEN notice "!$nick" "@$nick" "@find" "/ctcp $nick XDCC help" $3- } ^on.t #-public_other $fserve.serial '% \\\\[$dest\\\\] @\$servernick()' shook public_other \$* ^on.t #-public_other $fserve.serial '% \\\\[$dest\\\\] @\$servernick() *' \ @ :tags = [$tags]\;{ @ :nick = servernick() ? servernick() : [$1] fserve.list $nick $0 $tags OMEN notice "!$nick" "@$nick" "@find" "/ctcp $nick XDCC help" $3- } ^on.t #-public_other $fserve.serial '% \\\\[$dest\\\\] !\$servernick() *' {fserve.send 1 $0 notice $3-} stack pop alias on.t } # DCC streamliner. Call at appropriate intervals to re-evaluate the SEND hold # modes. The policy is to have one send to any given IP unheld at any one time, # leaving just one download per user. The one chosen is the one that has the # smallest remaining data and therefore completes fastest. # # This is valuable at so many levels: It is good as a dynamic queueing system; # It doesn't require either client to remain connected to the irc server; It is # resume friendly since resuming a failed transfer will automatically bring it # back to the front of the queue; It has a zero turnaround time between sends; # It is a good "backup" queueing system for those that manage to get past the # userhost based restrictions; And most importantly, it doesn't belt your # uplink since the VJ header compression buffers aren't being flushed, and for # other reasons. # # The assumption for the bandwidth concerns is that we don't have an excessive # number of users being uploaded to. If this happens we end up with too many # active sends and the same basic problem. To solve this problem, it may be # best to place all sends on hold for a short while periodically. I may change # this to unhold only a certain number of users with the oldest transfers at # some point, although I dislike this idea because then it will be necessary to # check that all those users aren't Damn Slow. # # The assumption for the performance concerns is that we don't have way too # many dcc sends going, period. If this happens, not only does it take us ever # increasing times to walk the list, but epics select call processing time will # increase beyond our control. There's not much to be done about this except to # cap the number of transfers. 100 to 1000 transfers would probably be a # (barely) comfortable maximum. # alias dcc.stream { ^local refs. ^local rems. @ :refs = dccctl(typematch SEND) fe ($refs) ref { @ :eref = dccctl(get $ref remaddr) @ :eref = encode($shift(eref)) @ :rem = dccctl(get $ref filesize) - dccctl(get $ref sentbytes) if (!#eref || 0>=rem) { @ dccctl(set $ref held 0) } elsif (32 & ~dccctl(get $ref flags)) { @ dccctl(set $ref held 0) } elsif (rems[$eref] <= 0 || rem < rems[$eref]) { fe ($refs[$eref]) oref { @ dccctl(set $oref held 1) } @ dccctl(set $ref held 0) @ refs[$eref] = ref @ rems[$eref] = rem } else { @ dccctl(set $ref held 1) } } } eval on #-dcc_connect $fserve.serial * dcc.stream eval on #-dcc_lost $fserve.serial * dcc.stream # # These stop and start all open DCCs without closing their connections. This # is useful if your bandwidth is being clobbered by DCC and you need time to # fix it. Note that /dcc.stream is called periodically in other places in this # script, which will undo these hold modes for all outgoing file sends. # # /dcc.hold # /dcc.unhold # # You can specify a wildcard mask which will be matched against the specified # variables of all dccs. # stack push alias alias.tt alias alias.tt (mode,val,pref dwords 1,args) { @ sar(gr/\${pref}/$pref/args) @ sar(gr/\${mode}/$mode/args) @ sar(gr/\${val}/$val/args) alias $args } fe ("" held 1 un held 0) pref mode val { alias.tt $mode $val "$pref" dcc.${pref}hold (args default *) { @ :matches = :fixes = 0 @ :hdr = [type user userhost remaddr description filename othername] if (#args) { fe ($dccctl(ref)) ref { @ :refs = hdr fe refs refs { @ refs = dccctl(get $ref $refs) } if (refs =~ args) { @ :fixes += !dccctl(set $ref ${mode} ${val}) @ :matches++ } } echo $fixes/$matches matching DCCs ${pref}${mode} } else { echo Please specify a mask matching: $hdr } } } stack pop alias alias.tt cetk.functions0000644000076500007650000003242711330001265014141 0ustar jmidgleyjmidgley# CETK epic function/support script 0.9 unload cetk.functions package cetk.functions # General alias management. # alias alias.t { if ([$0] == aliasctl(alias match $0)) { @ :foo = loadinfo() xecho -banner -nolog -- WARNING: line $[-5]shift(foo) of $shift(foo) clobbers $0 from package $aliasctl(alias getpackage $0) } @ :alias = [$1-] @ :alias = [$0] && (J =~ [bitchx*] || [$1-] !~ [*\${t}*]) ? alias : sar(g/\${t}/$0/$alias) @ :rand = rand(0) @ :saila = sar(g/\$/${rand}/$sar(g/*/_/$alias)) @ :alias#= (saila =~ [*\;*] || saila =~ [*${rand}\\[$jot(0 9) _\\]*] || [$1] =~ [\(*]) ? [] : [ \$*\;] alias $0 $alias } alias alias.e alias.t $0 if (functioncall())\{return \$$1\($2- \$*\)\}\{$1-\ \$*\} alias alias.pipel1 (args) alias.pipeln $shift(args) 0,1 $args alias alias.pipeln (args) @:fn=shift(args),:ln=split(, $shift(args));alias.t $fn (args) @:fd=exec\($args\),:fdw=shift(fd),:fdr=shift(fd),:x=close($shift(fd)),:x=write($fdw $args),:x=close($fdw),:ret=readfdline\(\$fdr $ln\),close($fdr)\;if (functioncall()){return $ret}{xecho -banner -nolog -- $ret} alias alias.pipew1 (args) alias.pipewn $shift(args) 0,1 $args alias alias.pipewf (args) alias.t $shift(args) (args) @:fdr=exec\($args\),:x=close($pop(fdr)),:fdw=shift(fdr)\;fe args arg {@write($fdw $arg),arg=read($fdr)}\;@:x=close($fdw),:x=close($fdr)\;if (functioncall()){return $args}{xecho -banner -nolog -- $args} alias alias.pipewn (args) @:fn=shift(args),:ln=split(, $shift(args));alias.t $fn (args) @:fdr=exec\($args\),:fdw=shift(fdr),:x=close($pop(fdr))\;fe args arg {@write($fdw $arg)}\;@:x=close($fdw),:ret=readfdline\(\$fdr $ln\),:x=close($fdr)\;if (functioncall()){return $ret}{xecho -banner -nolog -- $ret} alias set if (getsets($0)) {//set $*} {xecho -banner -nolog -- WARNING: No such set $0} # More general script management. # alias load { fe ($*) file { if (file =~ [-*]) { push :args $file continue } @ :path = which($file $getset(load_path)) @ :time = stat($path) @ :time = word(11 $time) @ :path = encode($path) @ :args = args ? args : loaded[$path][a] if (time == loaded[$path][t] && args == loaded[$path][a]) { xecho -banner $repeat($loaded )| $file $args } else { @ loaded[$path][t] = time @ loaded[$path][a] = args @ aliasctl(assign setpackage loaded.${path}.t -) @ aliasctl(assign setpackage loaded.${path}.a -) @ aliasctl(assign setpackage loaded -) xecho -banner $repeat(${loaded++} )\\ $file $args //load $args $file xecho -banner $repeat(${--loaded} )/ $file $args @ aliasctl(assign setpackage loaded -) } } } alias reload {foreach loaded file {load $decode($file)}} alias addctcp (ctcp uwords 1, desc dwords 1, code) { fe ($split(, $ctcp)) ctcp { on -ctcp_request "% % $ctcp *" $code @ clientinfo[$encode($toupper($ctcp))] = desc } } on ?ctcp_request "% % clientinfo *" { if (2 $@nums \($nums\) } } alias.t datetime { fe ($exec(date $*)) fd { push function_return $read($fd) @ close($fd) } } alias.t nickuserhost (nicks) { if (30<#nicks) { return $${t}($splice(nicks 0 ${#nicks / 2})) $${t}($nicks) } @ :sn = servernum() @ :omu = serverctl(get $sn maxuserhost), serverctl(set $sn maxuserhost 0) @ :unk = userhost(,) @ :uh = userhost($nicks) @ :uh1 = copattern($unk uh nicks) @ :uh1 = uh1 ? uh($uh1) : [] @ serverctl(set $sn maxuserhost $omu) fe uh foo { @ foo = [$shift(nicks)!${foo == unk ? shift(uh1) : foo}] } return $uh } stack push alias alias.tt alias.t alias.tt { fe (chanusers chops nochops chhops nochhops chvoices chnovoices) foo { alias.t $sar(g/FUNC/$foo/$*) } } alias.tt FUNCa eval return \$sort\(\$uniq\($replace(\$FUNC(xxx) xxx ${numwords($*)?pattern("\\[$*\\]" $mychannels()):mychannels()})\)\) stack pop alias alias.tt #alias.t isip4 (args) fe args foo {@foo=foo=~[*?.*?.*?.*?]&&foo!~[*.*.*.*.*]&&[]==strip(.0123456789 $foo)};return $args alias.t isip6 (args) fe args foo {@foo=foo=~[*?:*?:*?:*?]&&foo!~[*:*:*:*:*:*:*:*:*]&&[]==strip(.:0123456789abcdef $foo)};return $args alias.t isip4 (args) { @ :reg = regcomp(^[0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\$) fe args arg { @ :arg = !regexec($reg $arg) } @ regfree($reg) return $args } stack push alias alias.jot2expand alias.t alias.jot2expand (args) { alias.t $args @ sar(gr/jot./expand./args) @ sar(gr/jot($base $mask)/[\$base \$mask]/args) alias.t $args } alias.jot2expand jot.cidr (args) { @ :oxd = xdebug(new_math) xdebug new_math fe args arg { @ arg = split(/ $arg/32) @ :base = iptolong($shift(arg)) @ :mask = 0+0xffffffff >> shift(arg) #@ :mask |= mask+1 @ :base &=~mask @ :mask |= base @ arg = jot($base $mask) } fe args arg {@ arg = longtoip($arg)} xdebug $oxd if (functioncall()) { return $args } else { echo $args } } stack pop alias alias.jot2expand alias.t jot.ip (args) { fe args arg { @ arg = iptolong($arg) } fe args arg0 arg1 { @ arg0 = jot($arg0 $arg1), arg1 = [] } fe args arg { @ arg = longtoip($arg) } if (functioncall()) { return $args } else { echo $args } } alias.t nuhmask (nm,um,hm,args) { while (isnumber(b10 $args)) {shift $args} @ :uc = jotc(azAZ09) @ :ip4 = [([0-9]+\.[0-9]+\.[0-9]+\.[0-9]+)] @ :ip6 = [\($ip4|[0-9a-f]?[0-9a-f]?[0-9a-f]?[0-9a-f]?\)] @ :ip6 = [$ip6:$ip6:$ip6:$ip6\(:$ip6\(:$ip6\(:$ip6\(:$ip6\)?\)?\)?\)?] @ :reg4 = regcomp(^$ip4\$) @ :reg6 = regcomp(^$ip6\$) fe args arg { @ :nick = before(1 ! $arg) @ :user = after(1 ! $arg) @ :user = before(-1 @ $user) @ :host = after(-1 @ $arg) @ :nick = 0 == nm ? nick : [*] @ :user = 0 == um ? user : 1 == um && index($uc $user) ? left(1 $user)##[*] : [*] if (!hm) { } elsif (!regexec($reg4 $host)) { @ :host = abs($hm) > count(. $host) ? [*] : [$before(${0-hm} . $host).*] } elsif (!regexec($reg6 $host)) { @ :host = abs($hm) > count(: $host) ? [*] : [$before(${0-hm} : $host):*] } else { @ :host = abs($hm) > count(. $host) ? [*] : [*.$after($hm . $host)] } @ :arg = [$nick!$user@$host] } @ regfree($reg6) @ regfree($reg4) return $args } alias.t readfdlineall (fd, ar default "readfdlineall", sep, ...) { @ delarray($ar) until (eof($fd)) { @setitem($ar $numitems($ar) $read($fd)) } @ function_return = listarray($ar $sep) @ delarray($ar) } alias.t readfdall (fd,...) { until (eof($fd)) { @function_return#=read($fd ${2**++:max}) } } alias.t readfdline (fd,args) { fe args foo bar { if (eof($fd)) { @ foo = bar = [] break } else { @ fskip($fd $foo), bar = repeat($bar . ), foo = [] fe bar bar { unless ((bar = read($fd)) || !eof($fd)) {break} } } } return $args } alias.t readline (args) { unless (#args%2) { push args 1 } @ :files = glob($shift(args)) fe files file { @ :reading = 0 @ :fd = open($file r) if (functioncall()) { @ file = readfdline($fd $args) } else { while (!eof($fd)&&#args) { @ :line = 1 + shift(args) while (--line) { @ :read = read($fd) if (eof($fd)) { break } elsif (reading) { xecho -banner -nolog -- $read } } @ reading = !reading } } @ close($fd) } return $files } alias.t readlineall (files) { fe files files {@ :files = glob($files)} fe files file { @ :fd = open($file r) if (functioncall()) { @ file = readfdlineall($fd $args) } else { while (!eof($fd)) { @ :read = read($fd) xecho -banner -nolog -- $read } } @ close($fd) } return $files } alias.t getopts (var, pref, string, ...) { while (:option = getopt(:optopt :optarg "$string" $*)) { switch ($option) { (-) {echo * option "$optopt" is missing an argument} (!) {push :unknown -$optopt} (*) { ^assign -$pref$optopt push :optopts $encode(push $pref$optopt ${optarg?optarg:1}) } } } push :optarg $:unknown return fe \($optopts $encode(eval @$var=decode\($encode($optarg)\))\) cmd {$decode($cmd)} } alias.t remwws (args) { @ :oxd = xdebug(dword) xdebug dword @ :mk = shift(args) @ :bef = beforew($mk $args) @ :args = afterw($mk $args) fe ($bef) foo { until (0 > findw("$foo" $args)) { @ :args = remw("$foo" $args) } } xdebug $oxd return $args } # Timer extensions. # alias.t timer.r {timer -rep -1 $*} alias.t timer.date (date qwords 1, args) {timer ${datetime(+%s -d $date) - time()} $args} alias.t timer.dump { echo $strftime(%F %T) $attr.bold($timerctl(refnums)) fe ($timerctl(refnums)) ref { @ :print = [repeats interval server window command subargs] fe print print { @ :print = [$attr.bold($print) $timerctl(get $ref $print)] } echo $strftime($word(0 $timerctl(get $ref timeout)) %F %T) $ref $print } } # Word generation. # alias.t word.dict (args) { @ :n = isnumber(b10 $args) ? shift(args) : 1 @ :ret = repeat($n .) @ :dict = args ? shift(args) : [/usr/share/dict/words] fe ret foo { @ foo = randread($dict) } if (functioncall()) { return $ret } else { xecho -banner -- $ret } } alias.t word.permute (args) { @ :len = isnumber(b10 $args) ? shift(args) : numwords($args) @ :chars = args ? shift(args) : chr($jot($ascii(az))) if (0 < --len) { @ :args = args ? args : chars @ :wordl = ${t}($len $args) fec chars char { @ :words = wordl fe words word { @ word = [$char$word] } @ char = [$words ] } } else { @ chars = chr($unsplit(" 32 " $ascii($chars))) } if (functioncall()) { return $chars } else { echo $chars } } alias.t word.rand (args) { @ :num = isnumber(b10 $args) ? shift(args) : 1 @ :len = isnumber(b10 $args) ? shift(args) : rand(9) @ :chars = args ? shift(args) : jotc(az) @ :clen = strlen($chars) @ :ret = repeat($num $repeat($len ,) ) fe ret word { fec word chr { @ chr = mid($rand($clen) 1 $chars) } } if (functioncall()) { return $ret } else { echo $ret } } alias.t word.randsel { if (functioncall()) { return $word($rand($#) $*) } else { echo $word($rand($#) $*) } } alias.t word.gen (args) { @ :num = isnumber(b10 $args) ? shift(args) : 1 @ :ret = repeat($num .) fe ret ret { @ :last = ret = [] do { @ :rn=[] @ :rand = 1 + rand($wordgen[$last]) foreach wordgen[$last] this { if (rand<=(rn+=wordgen[$last][$this])) {break} } @ ret#= last = this } while (last != []) @ ret = decode($ret) } if (functioncall()) { return $ret } else { xecho -banner -- $ret } } alias.t word.gen.seed { fe ($*) word { @ :last = [] fec ($encode($word)) foo0 foo1 { @ ++wordgen[$last][$foo0$foo1] @ ++wordgen[$last] @ last = foo0##foo1 } @ ++wordgen[$last][] @ ++wordgen[$last] } } # who.c related stuff. # # $notify() which gathers data from all servers. # alias.t notify.a { @ :ret = myservers(.) fe ret ret { push :all $notify(serv $ret) @ ret = notify(on serv $ret) } @ :all = uniq($all) return $sort(${[$*] == [on] ? ret : [$*] == [off] ? remws($ret / $all) : all}) } # Server stuff. # alias.t serverwins (args) { @ :args = #args ? args : servernum() @ :sw = :sv = winrefs() fe sv sv {@ :sv = winserv($sv)} fe args args {@ args = copattern($args sv sw)} return $args } cetk.httpd0000644000076500007650000001347610766172332013277 0ustar jmidgleyjmidgley# CETK epic HTTP server script 0.0 load cetk.functions # Erase something from 2.8script which just gets in the way. on ^dcc_raw -"% % D %" alias.t serve.http (port default 8080, root default "serve.http.root", ...) { if (!isnumber(b10 $port)) { xecho -banner -- $port is not a number. xecho -banner -- Requires [] [] } elsif (0 > port) { ^on -dcc_raw -"% % N ${0-port}" ^dcc close raw_listen ${0-port} xecho -banner -- HTTP service on port ${0-port} closed } elsif (!aliasctl(alias pmatch ${root}*)) { xecho -banner -- No such alias structure ${root} xecho -banner -- Requires [] [] } elsif (!listen($port)) { xecho -banner -- Error: Port $port already in use? } else { ^on -dcc_raw "% % N $port" serve.http.connect $root \$* xecho -banner -- HTTP service on port $port serving alias structure $root } } alias.t serve.http.connect (root, ...) { ^on +dcc_raw "$0 % *" serve.http.connection $root \$* } alias.t serve.http.connection (root, ...) { switch ($2) { (e)(n)(c) { defer purge http[$0] defer ^dcc close raw $0 defer ^on dcc_raw -"$0 % *" } (d) { @:line=strip("$chr(13 10)" $3-) switch ($line) { (get % http/?.?) { @ http[$0][req] = before(? $word(1 $line)?) @ http[$0][alias] = unsplit(. $root $remws(/ $split(/ $http[$0][req]))) @ http[$0][args] = after(? $word(1 $line)) fe ($split(& $http[$0][args])) arg { @ http[$0][args][$before(= $arg=)] = urldecode($split(+ $after(= $arg))) } } (%:*) { push http[$0][head][$encode($before(: $line))] $after(: $line) } () { if (findw($http[$0][alias] $aliasctl(alias match $http[$0][alias]))) { serve.http.index $0-1 } else { $http[$0][alias] $0-1 } shook dcc_raw $0-1 c } (*) { echo Bad HTTP message? $line shook dcc_raw $0-1 c } } } } } alias.t serve.http.resphead (fd, hdrs default "\"Content-Type: text/html\"") { msg =$fd HTTP/1.0 200 OK$chr(13) fe ($hdrs) hdr { msg =$fd $hdr$chr(13) } msg =$fd $chr(13 10) } alias.t serve.http.page (fd,args) { serve.http.resphead $fd msg =$fd $html.head($shift(args)) $args msg =$fd } alias.t serve.http.prepage (fd,args) { serve.http.page $fd "$shift(args)" eval msg =$fd 
\;$args\;msg =$fd
} alias.t serve.http.index (fd,...) { serve.http.prepage $fd $http[$fd][req] foreach -$http[$fd][alias] foo { msg =$fd $foo } } alias.t serve.http.captureredirect { @ :redir = [cmdredir]##rand(${10**9}) ^alias $redir @setitem\($redir \$numitems\($redir\) \$*\) redirect /$redir $* @ function_return = listarray($redir "$chr(13 10)") ## chr(13 10) @ delarray($redir) ^alias -$redir } alias.t serve.http.dumparray (dcc,arrays) fe arrays array {@array=getarrays($array)};fe arrays array {for foo from 0 to ${numitems($array)-1} {msg =$dcc $getitem($array $foo)}} alias.t serve.http.dumpfd (dcc,fds) fe fds fd {until (eof($fd)){msg =$dcc $read($fd)}} alias.t serve.http.dumpfile (dcc,files) fe files file {@file=glob($file)};fe files file {@fd=open($file r),serve.http.dumpfd($dcc $fd),close($fd)} alias.t html.html return $* alias.t html.head return $* alias.t html.body return $* alias.t html.form (args) return
$args
alias.t html.input.submit return alias.t html.input.text (args) return alias.t html.pre return 
$*
alias.t html.page (args) return $html.html($html.head($shift(args))$html.body($args)) alias.t serve.http.rediralias (cmd,...) alias serve.http.root.$cmd serve.http.prepage \$0 \$http[\$0][req] redirect =\$0 \{msg =\$fd \$html.form\(GET "\$http[\$fd][req]" \$html.input.text\(in \$http[\$fd][args][in]\)\$html.input.submit(rerun)\)\;$*\} serve.http.rediralias history.chan.chan list.chan $http[$fd][args][in] serve.http.rediralias history.chan.list list.chan.list $http[$fd][args][in] serve.http.rediralias history.chan.nuh list.chan.nuh $http[$fd][args][in] serve.http.rediralias history.chan.onuh list.chan.onuh $http[$fd][args][in] serve.http.rediralias history.nuh list.nuh $http[$fd][args][in] serve.http.rediralias history.onuh list.onuh $http[$fd][args][in] serve.http.rediralias queries.links allservs wait for links $http[$fd][args][in] serve.http.rediralias queries.list allservs wait for list $http[$fd][args][in] serve.http.rediralias queries.map allservs wait for map $http[$fd][args][in] serve.http.rediralias queries.motd allservs wait for motd $http[$fd][args][in] serve.http.rediralias queries.names allservs wait for names $http[$fd][args][in] serve.http.rediralias queries.stats allservs wait for stats $http[$fd][args][in] serve.http.rediralias queries.time allservs wait for time $http[$fd][args][in] serve.http.rediralias queries.trace allservs wait for trace $http[$fd][args][in] serve.http.rediralias queries.who allservs wait for who $http[$fd][args][in] serve.http.rediralias queries.whois allservs wait for whois $http[$fd][args][in] serve.http.rediralias queries.whowas allservs wait for whowas $http[$fd][args][in] serve.http.rediralias status.channel channel serve.http.rediralias status.cps cps $http[$fd][args][in] serve.http.rediralias status.dcc dcc $http[$fd][args][in] serve.http.rediralias status.screendump @:foo=[htsd.$fd];snapw $foo $http[$fd][args][in];@perlxcall(attr2html $foo $foo 0);serve.http.dumparray $fd $foo;@delarray($foo) serve.http.rediralias status.scrolldump @:foo=[htsd.$fd];snapl $foo $http[$fd][args][in];@perlxcall(attr2html $foo $foo 0);serve.http.dumparray $fd $foo;@delarray($foo) serve.http.rediralias test0.test1.test echo $*;assign.dump http.$fd.* #serve.http.rediralias test0.test1.file serve.http.dumpfile $fd $http[$fd][args][in] #serve.http 4444 cetk.ircd0000644000076500007650000000242310766172332013063 0ustar jmidgleyjmidgley# CETK epic IRC server script 0.0 (inoperable) load cetk.functions # Erase something from 2.8script which just gets in the way. on ^dcc_raw -"% % D %" alias.t serve.irc (port default 6667, ...) { if (!isnumber(b10 $port)) { xecho -banner -- $port is not a number. xecho -banner -- Requires [] } elsif (0 > port) { ^on -dcc_raw -"% % N ${0-port}" ^dcc close raw_listen ${0-port} xecho -banner -- IRC service on port ${0-port} closed } elsif (!listen($port)) { xecho -banner -- Error: Port $port already in use? } else { ^on -dcc_raw "% % N $port" serve.irc.connect $root \$* xecho -banner -- IRC service on port $port serving alias structure $root } } alias.t serve.irc.connect (root, ...) { ^on +dcc_raw "$0 % *" ^serve.irc.connection $root \$* } alias.t serve.irc.connection (root, ...) { switch ($2) { (e)(n)(c) { defer purge ircd[$0] defer ^dcc close raw $0 defer ^on dcc_raw -"$0 % *" return } (d) { @ :line = strip("$chr(13 10)" $3-) @ :from = line =~ [:*] ? shift(line) : [:] @ :cmd = shift(line) @ ircd[$0][cmd] = [serve.irc.cmd.$cmd] if (findw($ircd[$0][cmd] $aliasctl(alias match $ircd[$0][cmd]))) { serve.irc.msg $0 $from 421 } else { $ircd[$0][cmd] $0 $from $cmd $line } @ ircd[$0][cmd] = [ ] } } } cetk.opme0000644000076500007650000007263011506044330013076 0ustar jmidgleyjmidgley# CETK epic cryptographically secure auto-op script 1.0 # http://www.epicsol.org/~crazyed/cetk.opme # unload cetk.opme package cetk.opme # # Required (epic dist). load functions load commandqueues load data_array load guh # # Required (CETK) load cetk.functions load cetk.chanmgmt # # Suggested. # userlist for n!u@h authentication. load cetk.userlist load cetk.clonecheck # # # Please note that the ceop system has companion scripts for eggdrop and irssi, # which can be found along with this one in the full CETK collection at # www.epicsol.org/~crazyed/ . # # This script implements two different systems. # # The first system is /opme, which is an extensible system for automatically # finding and interacting with bots and services for which it has been # configured to do so. The primary purpose is for requesting ops in a channel, # but it can be used for other bot functions like "ghost" on services and # "identify" on eggdrops. # # The second system (ceop) implements a client and server for an extensible # auto-op system. It uses a cryptographic password system designed to be # secure enough for the average IRC network and is explained further down. Its # primary purpose is to allow anybody that knows a single easily configured # secret key on any opped server to be granted ops in a channel. It can, # however, be extended to perform other functions securely. It also comes with # the tools necessary (/ceop and /ceop.autoop) to make these requests. # # A few example extensions have been provided with both systems, and some of # them are far too dangerous for the average user to run, so it is necessary to # permit their use for each key and it is possible to remove the extensions # from the system entirely without too much difficulty. # # Both of these systems are completely independant, but they can be used # together. Some good reasons to do this stem from the fact that ceop can only # work automatically on its own by sending a request directly to a channel, # which will probably annoy a lot of people and won't work anyway if nobody # else is using this system. # # # The interfaces for this system are these: # # /opme.setop - Add and configure a bot or service. # /opme - Request ops or other features from a configured bot/service. # /ceop.setkey - Configure a ceop key for use with this and other clients. # /ceop.autoop - Make a ceop request to all channels for all configured keys. # /ceop - Make a ceop request, but specify key, destination, etc. # /ceop.opme - A stub which is called internally when ops is required. # /ceop.cmdstrip - A security feature for removing ceop extensions. # # All of these with the exception of /ceop.opme display information about what # they do or what they're doing if run with no arguments. # # /ceop.opme being a stub, is intended to be a configuration variable and by # default, simply calls "/opme opme #chan". You can redefine it to use # ceop.autoop or any other system you might require. Note that the first # argument given is the channel for which ops is required. # alias ceop.opme ceop.autoop $*; alias ceop.opme opme opme $*; # # Example CEOP usage: # # Set a key for use in the next examples. The default level is 0. # /ceop.setkey testkey * # # Join a test channel. # /join #qwer # # Launch a second client and follow these instructions up to this point for it # too. Then continue these instructions on the un opped one. # # Ask for ops from any server on the channel. # /ceop testkey #qwer # # Ask for ops from a particular server on the channel. # /ceop testkey opsnick #qwer # # Autoop does the same thing for every matching configured key automatically. # /ceop.autoop opsnick #qwer # # Distributed mass voice requires a higher key level. Run this on the server. # /ceop.setkey testkey 1 * # # Distributed mass voice everyone on a channel. This works best when there are # many servers configured with the same key on the channel. # /ceop.autoop #qwer voice * # # Exec requires yet a higher key level. Run this on the server. # /ceop.setkey testkey 1000 * # # Ask other clients to execute an irc command. # /ceop.autoop #qwer cmd msg #qwer My pid is not $pid(). # # Ask other clients to evaluate an irc command. # /ceop.autoop #qwer eval msg #qwer My pid is $pid(). # # Ask other clients to execute a program and send back the output. # /ceop.autoop #qwer exec id # # Echo a ctcp command that another user can use to trigger the mass voice # behaviour above. This is good for friends who can't or won't load this # script, but would like to make use of it anyway. This works particularly # well for static addresses. # /ceop.autoop #qwer #qwer voice * -f othernick # # Add a timestamp to the last example that causes it to expire after one day. # The ctcp will continue to work until the expiry date, or the n!u@h of the # user changes. # /ceop.autoop #qwer #qwer voice * -f othernick -T 86400 # # Kill the key in all clients on #qwer that know about it except yours. # /ceop testkey #qwer clobber # # These will both kill your copy of the key. # /ceop.setkey testkey -1 * # /ceop.setkey testkey # # This will clobber keys on other clients that are clobbered on yours. # /ceop.autoop #qwer #qwer clobber -l -1 # # The clobber command will make the key unusable on servers that receive it, # but autoop will still use clobbered keys. # # Remove the cmd, eval and exec commands so that they can't be used through # misconfigured keys. This is useful for putting in ~/.epicrc after the line # that loads this script. # /ceop.cmdstrip 1000 * # # Remove a particular command. # /ceop.cmdstrip 0 op # # # Example OPME usage: # # Configure details for X on Undernet. Replace "nick" and "pass" with yours. # /OPME.SETOP X X x *!cservice@undernet.org "nick pass" undernet * service # # Configure an eggdrop bot. You need to fill in your own details here. # /OPME.SETOP bot eggdrop botnick *!botuser@bothost.com mypass somenet #chan "" # # Configure details for another ceop client. CEOP _can_ be useful from outside # the channel, so we can sometimes give it a services flag. # /OPME.SETOP chankey ceop_priv nick *!user@host ceopkey somenet #chan "" # # Configure details for a channel in which ceop is used. The services flag can # be used here so long as the channel is not +n . The nick and userhost fields # are *'s here, but it may be worth setting them to someone you know to be on # the channel to use it from outside and to prevent it misfiring. # /OPME.SETOP chankey ceop_pub * * key somenet #chan "" # # Configuring a bot interactively involves running /OPME.SETOP with no # arguments, then re-entering the command with the detail it asks for. The up # arrow is useful here. When /ceop.setop accepts the command, up arrow again, # and cut'n'paste the command onto the end of ~/.epicrc . # # Beg ops on the current channel from all configured ops. "opme" will be the # default argument if none are supplied. Not all bots/services require the # login command. # /opme login # /opme opme # # Ask ceop_priv and ceop_pub clients to execute a ceop command. This is taken # from a ceop example above. The channel is purely arbitrary here. If the # "service" flag has been given and its nick has been configured, ceop_priv # bots don't even have to be on common channels, although, it will take 5 # seconds to message each bot. # /opme opme # exec id # # ceop_pub is roughly as useful as ceop.autoop, but doesn't require the key to # be available for others to use on your end of the client, and it doesn't # require you to change the ceop.opme stub just for the purpose of using the # autoop feature. # # # Technical Details. # # The "crypto" in this script is based on a hash based challenge handshake # protocol, where a "client" requests authentication from a "server", which # sends back a "challenge". The client then "encrypts" the challenge and key # using a hash algorithm such as md5, and sends the hash back to the server, # which performs the same encryption and compares the hashes. This method is # useful because the password is never handed to anybody that may want to use # it unscrupulously, and because so long as the challenge is not reused, nobody # else will be able to use the same hash for authentication. Neat, huh? # # On IRC, doing a challenge handshake with all individual ops in a channel is # not so easy, because this protocol cannot be implemented without at least one # initial public message and two private messages for each op. It would be # completely unworkable. What we do here is reduce it to one public message to # the channel by faking the challenge. # # This particular implementation cheats by using your nick!user@host as the # challenge, meaning that on the average irc network, the request is only valid # when it's coming from you, but also, since this isn't a true challenge # handshake protocol, that anybody on the network that can change their own # nick!user@host to exactly what yours is, is able to reuse any request you # make and fool this protocol. Typically the only people on an irc network # that can do this are people that can hack ops using other means anyway, and # in any case, there is no way to find the original key by reusing a request, # and there is no way to change the request without making the hash invalid, so # this flaw in the protocol _probably_ isn't much of an issue. # # miscelaneous notes: # # There are no limits to the key length since it doesn't even pass through the # server to get the opportunity to meet the 512 char limit. # # No global channel configuration is required. As long as there are two # clients on a channel using a common key for that channel, this script can be # useful. This is particularly true since a valid request received by an # unopped client will cause it to attempt to op itself recursively using # methods the sender may not know about or have access to. # # This is not a typical authentication mechanism in that the shared password is # not bound to a username. This is a weakness because anybody fishing for # passwords gets to try everybody on a channel at once. You can however embed # the identity of key users into the key itself by specifying user/key (note # the slash) as a key, or by reserving part of the key as a "username". This # also means that multiple keys can be configured for a channel representing # different groups and that universal keys can be set for groups that cover # multiple channels. # # This script doesn't implement a key exchange protocol. You need to figure # out your own secure ways to do that. I suggest using dcc, email, the phone # or face to face meetings, perhaps with pgp or gnupg encryption, depending on # your security requirements. # # This script doesn't implement a feature that allows a key to be changed, but # it does permit any keyholder to have it "clobbered" in case of emergencies. # # # The script itself starts here. # # # Supporting functions. Note that the perl and tcl calls to md5 will not work # unless the following epic statements are run. It may be necessary to comment # these out. # alias ceop.md5 (args) { if (perl(use Digest::MD5 qw(md5 md5_hex md5_base64);defined &md5_hex)) { ^alias ceop.md5 (args) return \$perlcall(md5_hex $args) } elsif (0 <= tcl(package require md5;lsearch -exact [package names] md5)) { ^alias ceop.md5 (args) return \$tcl(md5::md5 -hex [join [epic expr args]]) } else { ^alias ceop.md5 (args) { @ :exe = glob(\{$sar(g/:/,/$PATH)\}/md5\{sum,\}) fe ($exec($shift(exe))) in out err {break} @ close($err) @ writeb($in $args) @ close($in) @ function_return = read($out) @ function_return = shift(function_return) @ close($out) } } return $ceop.md5($args) } # # Send a ceop request. [key] is required but [dest] will be the current # channel and [#channel] is extrapolated by the receiver if not supplied. If # the key contains a slash (/), whatever is before it is taken for a user name, # and the rest is the key. # # [dest] is where the request will be sent to, and [#channel] is the one the # request is in reguards to. These arguments are handy if you can't or don't # want to send the request to the channel. # alias ceop (args) { @ :cmd = [q1cmd 0 9 ] while (:option = getopt(:optopt :optarg d:f:L:l:m:T:t $args)) { @ ++:opts switch ($option) { (d) {@ :dest = uniq($dest $split(, $optarg))} (f) { @ :nick = uniq($:nick $split(, $optarg)) @ :cmd = [echo \$nick: /] } (l) { unless (index(L $option)) {@ :minlev = optarg} unless (index(l $option)) {@ :maxlev = optarg} } (m) {push :mask $optarg} (t) {@ :ts = optarg + time()} (!) (-) { echo usage: echo ceop {[user]/}[key] {[dest] {[#channel] {[additional-protocol-commands]}}} {[options]} echo ceop.autoop {[dest] {[#channel] {[additional-protocol-commands]}}} {[options]} echo Invalid arg or option: -$optopt $optarg echo -d nick Specify an explicit destination here instead. echo -f nick Echo a ctcp command for a friend to use. echo -m mask Key must match mask. For use with autoop. echo -l level Key must have at most this level. (autoop) echo -L level Key must have at least this level. (autoop) echo -t Add an expiry timestamp to the request. echo -T number Add a particular timestamp to the request. return } } } @ :args = opts ? optarg : args @ :nick = nick ? nick : servernick() @ :uh = nick == servernick() && userhost($nick) == userhost(,) ? X : userhost($nick) @ :key = shift(args) @ :id = index(,/ $key) + 1 @ :user = left($id $key) @ :key = rest($id $key) @ :euser = encode($chop(1 $user)) @ :ekey = encode($key) @ :dest = dest ? dest : #args ? split(, $shift(args)) : C if (1>#key) { echo /ceop requires a key. ceop -h } elsif (!cmd && ischanop($nick $dest) && !#args) { } elsif (!cmd && ischanop($nick $args) && 1==#args) { } elsif (maxlev && maxlev < ceop[uk][$euser][$ekey][cmdlevel]) { } elsif (minlev && minlev > ceop[uk][$euser][$ekey][cmdlevel]) { } elsif (mask && !rmatch($user$key $mask)) { } else { unshift args $unsplit(" " ${ts && ischannel($args) ? shift(args) : []} $ts) fe ($joinstr(! nick uh)) nuh { @ :nick = before(! $nuh) eval ^local ecmd $cmd if (nuh == [$nick!$userhost(,)]) { echo Cannot find userhost for $nick . } else { fe ($dest) dst { ${ecmd}ctcp $dst op $user$ceop.md5($nuh $key $dst $args) $args } } } if (isdisplaying() && !mychannels()) { echo It may be necessary to join a channel for ceop to work. } } } # # Send a template ceop request to all matching channels for all defined keys. # This is really a "wrapper" alias. All options processing is done by /ceop. # # It will surely bother people if you use this with keys with badly chosen # channel masks. # alias ceop.autoop (args) { @ :w0 = word(0 $args) @ :mc = ischannel($args) @ :mc|= 0 <= index(*%? $w0) @ :mc|= w0 && userhost(,) != userhost($w0) @ :mc = mc ? shift(args) : C @ :mc = split(, $mc) @ :mc = 0 > index(?*% $mc) ? mc : pattern("\\[$mc\\]" $mychannels())) foreach ceop[uk] user { foreach ceop[uk][$user] ekey { @ :chans = pattern("\\[$ceop[uk][$user][$ekey][chans]\\]" $mc) @ :user#= user ? [CM] : [] fe chans chan { if (args || !ischanop($servernick() $chan)) { @ :requests++ ceop $decode($user$ekey) $chan $args } else { @ chan = [] } } push :requested $chans } } qcmd 9 if (requests && isdisplaying()) { echo sending $requests ceop requests to $uniq($requested) } } # # Define or undefine a key, and its parameters. # # [cmdlevel] is numeric and not mandatory. It defines which of the ceop # commands are available for this key. If set to -1, the key is "clobbered" # and invalid. Setting this value above 999 basically makes epic a botnet # client, and setting it above 899 makes it an X style service. Don't set it # above 0 without a good reason. # # [expiry] is the maximum permitted expiry time for time stamped requests and # [grace] is the grace period. If the senders clock is out of sync with the # receivers, the test is more likely to fail. If these args are specified, # they should be set to a reasonably high value. # # [usermask] and [shitmask] are also numeric and not mandatory. They are # references to the cetk.userlist script and default to 0 which turn these # features off. If any of the given usermask bits match any of the nuhs # usermask bits and none of the given shitmask bits match the nuhs shitmask # bits, the request is accepted. # # The remaining args are channel masks for which the key applies. Undefine a # key by supplying no args. # alias ceop.setkey (args) { if (1>#args) { echo requires: {[user]/}[key] {[cmdlevel] {[expiry] {[grace] {[usermask] {[shitmask]}}}}} {[chanmask]} ... } else { @ :key = shift(args) @ :ind = index(,/ $key) @ :user = left($ind $key) @ :user = encode($user) @ :key = rest(${++ind} $key) @ :ekey = encode($key) @ ceop[uk][$user][$ekey][cmdlevel] = isnumber(b10 $args) ? shift(args) : [] @ ceop[uk][$user][$ekey][expiry] = :expiry = isnumber(b10 $args) ? shift(args) : [] @ ceop[uk][$user][$ekey][grace] = isnumber(b10 $args) ? shift(args) : expiry @ ceop[uk][$user][$ekey][user] = isnumber(b10 $args) ? shift(args) : [] @ ceop[uk][$user][$ekey][shit] = isnumber(b10 $args) ? shift(args) : [] @ ceop[uk][$user][$ekey][chans] = args } } # # List all configured ceop data. At the moment this is just keys. Do it in # such a way that we can cut and paste it back into the configuration command. # alias ceop.list (args default *) { echo /$chr(2)ceop.setkey$chr(2) keys matching: $args foreach ceop[uk] user { foreach ceop[uk][$user] ekey { @ :key = decode(${user}CM${ekey}) @ :echo = [cmdlevel expiry grace user shit chans] fe echo echo { @ :echo = ceop[uk][$user][$ekey][$echo] } if (rmatch("$key $echo" $args)) { echo $key $echo } } } } # # Process an incoming ceop request. # # The first arg to the request is an md5 hash. If the hash matches the md5 of # the entire request including the users nick!user@host and any secret key we # have, but excluding the hash, the request is valid. # # The second is an optional channel that the request is to be in reguards to. # If not supplied, it is the destination of the request. # # The third is an optional unix timestamp. If this is supplied and older than # the maximum age of the key, the request is discarded. # # Remaining args if any are the request. The default action is to unban, # invite or op the user on the channel requested if there are no additional # args. # # [commands] can be given after the channel, but the command level for the key # (the first arg in setkey) must be above the commands level. The source code # of this hook is authoritative reguarding the commands and levels, but here's # a brief explanation of how the levels have been defined: # # -1: Reserved for invalid keys. # 0: Channel management level. Allows a user to be opped, keys to be # clobbered and modes to be set. # 200: join, part. # 600: quit, pretend. # 800: Allows use of any oper commands available to the client. # 1000: Allows use of eval and exec commands. Whoever knows a key set to this # level can be assumed to 0wn the shell account this client is running # on. # # Note that the inbuilt commands (no command and "clobber") in this hook do # respect the command level, however, there is no command to define these # levels, which might be necessary if you want to add commands that say, voice # a user without giving them ops. The clobber command should _probably_ be set # at a very low level though, because it represents the least amount of damage # that can possibly be done with a comprimised key. # # I also want to add true challenge handshaking. It's probably best to add it # here, after the point where the far end has shown that it knows the key. # This should save time and bandwidth by bypassing unnecessary handshakes with # other clients that don't share a key. # # What would also be cool is if ctcps could be "wrapped" in recursive fashion, # to give "authenticated" ctcp. This is what the pretend command is for at # this point, but this will probably change. # on #^ctcp_request 0 "% % \[ceop op\] % *" { @ :nick = [$0] @ :args = [$3-] @ :md5 = shift(args) @ :chan = ischannel($args) ? shift(args) : [$1] @ :utim = isnumber(b10 $args) ? shift(args) : 0 @ :cmd = shift(args) @ :cmd = pass($jotc(09azAZ)._ $cmd) @ :ind = index(,/ $md5) + 1 @ :duser = chop(1 $left($ind $md5)) @ :euser = encode($duser) @ :md5 = rest($ind $md5) foreach ceop[uk][$euser] ekey { @ :key = decode($ekey) if (!rmatch($chan $ceop[uk][$euser][$ekey][chans])) { continue } elsif (md5 != ceop.md5($0!$userhost() $key $1 $4-)) { continue } elsif (ceop[uk][$euser][$ekey][cmdlevel] && ceop[uk][$euser][$ekey][cmdlevel] < 0) { echo attempted use of clobbered ceop key: $key : $0-1 $3- } elsif (ceop[uk][$euser][$ekey][cmdlevel] < ceop[cmdlev][$cmd]) { echo valid ceop request without required key command level: $0-1 $3- } elsif (ceop[uk][$euser][$ekey][expiry] < (utim - time()) && utim && ceop[uk][$euser][$ekey][expiry]) { echo valid ceop request, but dated at $strftime($utim %F %T): $0-1 $3- } elsif (ceop[uk][$euser][$ekey][grace] < (time() - utim) && utim && ceop[uk][$euser][$ekey][grace]) { echo valid ceop request, but dated at $strftime($utim %F %T): $0-1 $3- } elsif (ceop[uk][$euser][$ekey][user] && !(ceop[uk][$euser][$ekey][user] & checkuser($0!$userhost() $chan))) { echo valid ceop request from non-user: $0-1 $3- } elsif (ceop[uk][$euser][$ekey][shit] && (ceop[uk][$euser][$ekey][shit] & checkshit($0!$userhost() $chan))) { echo valid ceop request from shit: $0-1 $3- } elsif (cmd == []) { if (!ischanop($servernick() $chan)) { 1cmd 120 ceop.opme $chan } if ([b] == matchban(beI $0!$userhost() $chan)) { unban $chan $rpattern($0!$userhost() $chanbans(b $chan)) } elsif (!onchannel($0 $chan)) { invite.all $0 $chan } elsif (!ischanop($0 $chan)) { qmode $chan +o $0 } else { echo valid (unrequired) ceop request: $0-1 $3- } } elsif (cmd == [clobber]) { @ ceop[uk][$euser][$ekey][cmdlevel] = -1 echo clobbered comprimised ceop key: $duser,$key : $0-1 $3- echo you must manually edit this key from your configuration files. } elsif (cmd == [help]) { @ :cmds = aliasctl(alias match ceopcmd.) fe cmds cmds {@ cmds = after(. $cmds)} notice $0 Available commands: $cmds } elsif (aliasctl(alias exists ceopcmd.$cmd)) { wait for ceopcmd.\$cmd \$* } if (rmatch("$cmd" $ceop.cmdlog)) { echo Processed valid ceop request: $0-1 $3- } return } } alias ceop.cmdstrip (args) { @ :lev = isnumber($args) ? shift(args) : 0 unless (args) { echo required: [level] [command-masks] echo remove all matching ceop command extensions not below a certain level. } foreach -ceopcmd cmd { if (lev <= ceop[cmdlev][$cmd] && rmatch($cmd $args)) { alias.ceopcmd 0 - $cmd } } } alias alias.ceopcmd (enable,level,cmd,alias) { if (enable) { @ ceop[cmdlev][$cmd] = level alias ceopcmd.$cmd $alias } else { @ ceop[cmdlev][$cmd] = [] alias -ceopcmd.$cmd } } # # These are defined or undefined ceop commands and their levels. The op and # voice commands come from cetk.chanmgmt, and cka is from cetk.clonecheck. # alias.ceopcmd 1 1 declone {bless;cka b $chan;} alias.ceopcmd 1 1 devoice {bless;devoice $chan $args;} alias.ceopcmd 1 1 voice {bless;voice $chan $args;} alias.ceopcmd 1 50 cka {bless;fe args arg {@arg = ischannel($arg) ? [] : arg};cka $args $chan;} alias.ceopcmd 1 50 deop {bless;deop $chan $args;} alias.ceopcmd 1 50 op {bless;op $chan $args;} alias.ceopcmd 1 200 join {bless;qcmd 9 join $chan $args;} alias.ceopcmd 0 200 mode {bless;qmode $chan $args;} alias.ceopcmd 1 200 part {bless;qcmd 9 part $chan $args;} alias.ceopcmd 1 200 say {bless;qcmd 9 msg $chan $args;} alias.ceopcmd 1 200 chat {bless;qcmd 9 dcc chat $nick;} alias.ceopcmd 0 600 pretend {bless;pretend $args;} alias.ceopcmd 1 600 quit {bless;qcmd 9 quit $args;} alias.ceopcmd 1 800 quote {bless;qcmd 9 quote $args;} alias.ceopcmd 1 800 samode {bless;qcmd 9 quote samode $args;} alias.ceopcmd 1 800 svsmode {bless;qcmd 9 quote svsmode $args;} alias.ceopcmd 1 1000 cmd {bless;$args;} alias.ceopcmd 1 1000 eval {bless;eval $args;} alias.ceopcmd 1 1000 exec {bless;exec -window -line \{qcmd 9 notice $0 \$*\} $args;} # # This is a more generic auto-op system. With no args it will search for ops # and services that have been configured with opme.setop and send the commands # needed to gain ops. Note that although this has been designed to work easily # with the ceop stuff above, it is a different system, based on different # principles. # alias opme (args) { @ :oxd = xdebug(dword extractw) xdebug dword -extractw @ :servergroup = servergroup() @ :cmd = !args || ischannel($args) ? [opme] : shift(args) @ :chan = ischannel($args) ? shift(args) : C @ :unkuh = userhost(,) foreach oplist op { if (!match("service" $oplist[$op][flags])) { } elsif (!rmatch("$chan" $oplist[$op][chans])) { } elsif (!rmatch("$servergroup" $oplist[$op][nets])) { } else { xdebug -dword {push :nicks $oplist[$op][nicks]} } } @ :notify = ::notify() @ :notify = notify ? notify : notify() @ :notifyon = ::notify(on) @ :notifyon = notifyon ? notifyon : notify(on) ^notify $rfilter("\\[$notify\\]" $nicks) @ :nicks = pattern("\\[$nicks\\]" $notifyon) @ :nicks = uniq($chops($chan) $nicks $nochops($chan)) @ :userhosts = userhost($nicks) unless (onchannel($N $chan) || nicks) {qcmd 9 join $chan} opme.nuhcheck $cmd $chan "$joinstr(! nicks userhosts)" $args @ :chan = [\$decode\($encode($chan)\)] @ :args = [\$decode\($encode($args)\)] ^userhost $copattern($unkuh userhosts nicks) -cmd \{opme.nuhcheck $cmd $chan \$0!\$3@\$4 $args\} xdebug $oxd } # alias opme.nuhcheck (cmd,chan,nuhs dwords,args) { @ :oxd = xdebug(dword) xdebug dword @ :nuhs = filter(*!$userhost(,) $nuhs) @ :servergroup = servergroup() foreach oplist op { if (!rmatch("$chan" $oplist[$op][chans])) {continue} if (!rmatch("$servergroup" $oplist[$op][nets])) {continue} fe ($pattern("$oplist[$op][nuhs]" $nuhs)) nuh { @ :nick = before(! $nuh!) @ :type = oplist[$op][type] @ :pass = oplist[$op][pass] if (!ischanop($nick $chan) && !match(service $oplist[$op][flags])) { } elsif (aliasctl(alias exists oplist.${op}.${cmd})) { wait for oplist.\${op}.\${cmd} \$nick \$chan \$args if (isdisplaying()) { echo $cmd request for $chan sent to $op at $nuh } } elsif (aliasctl(alias exists oplist.${type}.${cmd})) { wait for oplist.\${type}.\${cmd} \$nick \$chan \$args if (isdisplaying()) { echo $cmd request for $chan sent to $op at $nuh } } else { echo no such command $cmd for $op } } } xdebug $oxd } alias opme.setop { @ :args = [$*] @ :oxd = xdebug(extractw dword) xdebug extractw dword switch ($#args) { (1) {echo Required: "{server-type}" - Codebase being run. Determines commands used. "/alias oplist.".} (2) {echo Required: "{nickmasks}" - Nicks this op is using. Required when you or it aren't on the channel.} (3) {echo Required: "{nick!user@host masks}" - Userhosts this client is using, for authentication.} (4) {echo Required: "{password}" - Password to use when authenticating with this op.} (5) {echo Required: "{nets}" - Networks this op is using. Matched against the 5'th field of the server spec.} (6) {echo Required: "{channel-masks}" - Channels this op is callable for.} (7) { echo Required: "{flags}" - Features of this service. echo "service" - This op can be used when not opped or on common channels. } (8) { @ :op = shift(args) echo Configuring "$op" for use with /opme. @ oplist[$op][type] = shift(args) @ oplist[$op][nicks] = shift(args) @ oplist[$op][nuhs] = shift(args) @ oplist[$op][pass] = shift(args) @ oplist[$op][nets] = shift(args) @ oplist[$op][chans] = shift(args) @ oplist[$op][flags] = shift(args) } (*) { echo requires: "{op-name}" "{server-type}" "{nickmasks}" "{nick!user@host masks}" "{password}" "{nets}" "{channel-masks}" "{flags}" echo All arguments may have any number of words, but must be double quoted if not a single word. echo Required: "{op-name}" - Name you want to give this server. } } xdebug $oxd } alias oplist.newservices.ghost {bless;q1cmd 300 9 quote nickserv ghost $2 $pass;} alias oplist.newservices.login {bless;q1cmd 300 9 quote nickserv identify $pass;} alias oplist.newservices.opme {bless;q1cmd 300 9 quote chanserv op $1 $servernick();} alias oplist.oldservices.ghost {bless;q1cmd 300 9 msg nickserv ghost $2 $pass;} alias oplist.oldservices.login {bless;q1cmd 300 9 msg nickserv identify $pass;} alias oplist.oldservices.opme {bless;q1cmd 300 9 msg chanserv op $1 $servernick();} alias oplist.eggdrop.login {bless;if ([$0]=~[=*]){msg $0 $pass}{q1cmd 5 9 msg $0 ident $pass $2-}} alias oplist.eggdrop.opme {bless;q1cmd 5 9 msg $0 op $pass $1;} alias oplist.ceop_priv.login {bless;q1cmd 5 9 ceop $pass -d $*;} alias oplist.ceop_priv.opme {bless;q1cmd 5 9 ceop $pass -d $*;} alias oplist.ceop_pub.opme {bless;q1cmd 5 9 ceop $pass -d $1-;} alias oplist.austnet.login {bless;q1cmd 300 9 msg nickop@austnet.org identify $pass;} alias oplist.austnet.opme {bless;q1cmd 300 9 msg chanop op $1 ${args ? args : servernick()};} alias oplist.X.opme {bless;q1cmd 300 9 msg $0 op $1;} alias oplist.X.login {bless;q1cmd 300 9 msg x@channels.undernet.org login $pass;} alias oplist.z.login {bless;q1cmd 300 9 msg z@channels.oz.org login ${args ? args : servernick()} $pass;} alias oplist.q.login {bless;q1cmd 300 9 msg Q@CServe.quakenet.org AUTH ${args ? args : servernick()} $pass;} # Services login on connect # on #-connect - * qcmd 1 opme login cetk.proxycheck0000644000076500007650000002175711230224356014323 0ustar jmidgleyjmidgley# CETK epic proxy checker 0.8 # unload cetk.proxycheck package cetk.proxycheck # # Required (epic dist). # load functions load data_array # # This script does not depend on the channel management script, but it or # something similar to it is probably necessary if you intend to kick/ban/kill # based on the information it returns. # # # This script is an interface to DNS and RHS block lists. It is similar to the # Blitzed Open Proxy Monitor which can be found at http://www.blitzed.org/bopm/ # # The one liner documentation is this: The input is "/proxycheck [n!u@h]", the # output is an "/on hook" hook, and you need the "host" shell command to make # it work. # # It is not strictly necessary for the input to be in n!u@h form. A hostname # will do. Anything before a @ is stripped, and you can give it more than one. # # The output of this script can be collected by an "/on hook" hook where user # supplied code can do what it wants with it. Note that it only outputs hits # rather than misses, No particularly useful examples are supplied here right # now except the following which just displays hits. # # /on -hook proxy* echo $* # # The host shell program this script was developed for can be found at the # following urls. The one that comes with (some versions of) bind is # incompatible since it doesn't have the -x switch or an equivalent. Its # output is also different, and this makes it difficult to make the script # compatible with both. # # ftp://ftp.weird.com/pub/local/host.tar.gz # http://www.weird.com/ftp/pub/local/host.tar.gz # # XXX Proper effective use issues. # # Bugs and issues: # # * The host command turned out to be a bad choice. This needs to be fixed. # * If you try to use dnsbl.dom and x.dnsbl.dom, everything starts to fail. # * It is possible to screw this script up by using spoofed hostnames. # * It is not easy to remove unwanted blocklists once they're set. # # # Settings. # @ proxy.checkersmax = 1 # # Initialise the blockers list by testing which ones respond. # defer proxycheck 2.0.0.127.opm.blitzed.org defer proxycheck 2.0.0.127.dnsbl.dronebl.org defer proxycheck 2.0.0.127.cbl.abuseat.org defer proxycheck 2.0.0.127.sbl-xbl.spamhaus.org defer proxycheck 2.0.0.127.all.rbl.kropka.net #defer proxycheck 2.0.0.127.ircbl.ahbl.org defer proxycheck 2.0.0.127.dnsbl.ahbl.org defer proxycheck 2.0.0.127.dnsbl.njabl.org defer proxycheck 2.0.0.127.dnsbl.sorbs.net defer proxycheck 2.0.0.127.unconfirmed.dsbl.org defer proxycheck 2.0.0.127.proxies.relays.monkeys.com defer proxycheck 2.0.0.127.proxy.bl.gweep.ca defer proxycheck 2.0.0.127.blackholes.easynet.nl defer proxycheck 2.0.0.127.no-more-funn.moensted.dk defer proxycheck 2.0.0.127.relays.osirusoft.com #defer proxycheck 2.0.0.127.bl.reynolds.net.au defer proxycheck 2.0.0.127.t1.bl.reynolds.net.au defer proxycheck 2.0.0.127.t2.bl.reynolds.net.au defer proxycheck 2.0.0.127.t3.bl.reynolds.net.au defer proxycheck 2.0.0.127.proxies.exsilia.net defer proxycheck . defer proxycheck 2.0.0.127.tor.ahbl.org defer proxycheck 2.0.0.127.tor.dnsbl.sectoor.de defer proxycheck 2.0.0.127.tor-irc.dnsbl.oftc.net defer proxycheck example.net.in.dnsbl.org defer proxycheck example.com.rhsbl.ahbl.org defer proxycheck example.tld.rhsbl.sorbs.net defer proxycheck example.tld.dsn.rfc-ignorant.org defer proxycheck example.tld.whois.rfc-ignorant.org defer proxycheck example.tld.abuse.rfc-ignorant.org defer proxycheck example.tld.ipwhois.rfc-ignorant.org defer proxycheck example.tld.bogusmx.rfc-ignorant.org defer proxycheck example.tld.postmaster.rfc-ignorant.org defer proxycheck . alias proxycheck { @ :sn = servernum() @ :sn = 0 > sn ? [_] : sn @ :pid = [hpt$sn] if (debug.proxycheck&1) {echo pt1: $*} ^exec -direct -window -name $pid -end { if (debug.proxycheck&8) {echo pt8: ed: $*} } -errorpart { if (debug.proxycheck&8) {echo pt8: ep: $*} if ([$*]=~[:! *does*not*exist*]) {@ --proxy.checks.$servernum()} } -error { if (debug.proxycheck&4) {echo pt4: $*} if ([$*]=~[:! *does*not*exist*]) {@ --proxy.checks.$servernum()} } -linepart { if (debug.proxycheck&8) {echo pt8: lp: $*} } -line { @ :pid = [hpt$servernum()] switch ($0 $1 $2) { (example.\\[tld com net org\\].% % %) { @ proxy.blrhs = uniq($proxy.blrhs $after(2 . $0)) } (2.0.0.127.% % %) { @ proxy.bldns = uniq($proxy.bldns $after(4 . $0)) } (% CNAME %) { setuniqitem proxyback $2 $0 } (% A 127.0.0.1) { fe ($bl.ipfix($0)) sv ip { unless (sv && ip) {continue} proxyhook 16 proxyodd $ip $sv $2 } } (% A 127.%) { fe ($bl.ipfix($0)) sv ip { unless (sv && ip) {continue} proxyhook 16 proxybl $ip $sv $2 } } (% A %) { setuniqitem proxyback $2 $0 defer proxycheck $2 } (% % *) { fe ($bl.ipfix($0)) sv ip { unless (sv && ip) {continue} proxyhook 16 proxymisc $ip $sv $1- } } } if (debug.proxycheck&2) {echo pt2: $nohighlight($*)} if (proxy.checkersmax && proxy.checkersmax < proxy.checkers) { } elsif (proxy.checkersmax && proxy.checkersmax <= proxy.checkers && proxy.checks.$servernum()) { } elsif (numitems($pid)) { defer proxycheck $getndelitems($pid $jot(-1 1)) } } host -xas 3 --retry=1 fe ($unsplit(" " ${ match(. $*) ? [] : getndelitems($pid -1)} $*)) foo { @ foo = after(-1 @ @$foo), :req = [] if (proxy.checks.$sn && proxy.checkersmax && proxy.checkersmax < proxy.checkers) { setuniqitem $pid $foo } elsif (rmatch($foo 2.0.0.127.* "example.\\[tld com net org\\].*")) { @ :req = foo } elsif (foo=~[*?.*?.*?.*?] && foo!~[*.*.*.*.*] && []==strip(.0123456789 $foo)) { @ :req = replace($cut(3.0 . $foo).xxx xxx $proxy.bldns) } elsif (foo =~ [*?.?*]) { @ :req = replace(${foo}.xxx xxx $proxy.blrhs) @ push(:req $foo) } elsif (foo == [.]) { @ proxy.checks.$sn = 0 @ proxy.checkers++ wait %$pid -cmd { @ --proxy.checkers < 0 ? (proxy.checkers = 0) : [] if (numitems($pid)) { defer proxycheck $getndelitems($pid $jot(-3 3)) } } ^exec -error { if ([$0] =~ [2.0.0.127.\\\[$proxy.bldns\\\]]) { @ proxy.bldns = remw($after(4 . $0) $proxy.bldns) } elsif ([$0] =~ [example.\\\[tld com net org\\\].\\\[$proxy.blrhs\\\]]) { @ proxy.blrhs = remw($after(2 . $0) $proxy.blrhs) } elsif (debug.proxycheck&4) { echo PT4: $* } } -errorpart { if (debug.proxycheck&8) {echo PT8: ep: $*} } %$pid ^exec -closein %$pid ^exec -name hostpt${proxy.checkerpid++} %$pid } fe ($req) foo { ^exec -in %$pid $foo :!. if (++proxy.checks.$sn > 99) { proxycheck . proxycheck } } } } # alias bl.ipfix (args) { fe args arg { fe ($proxy.bldns $proxy.blrhs) bl { if (match(*.$bl $arg)) { @ :ct = count(. .$bl) @ arg = unsplit(. $revw($split(. $arg))) @ arg = ["$before($ct . $arg)" "$after($ct . $arg)"] break } } } return $args } alias bl.ipfix (args) { @ :bldns = proxy.bldns @ :blrhs = proxy.blrhs fe bldns bl { @ :ct = count(. .$bl) @ :bl = pattern(*.$bl $args) fe bl arg { @ arg = unsplit(. $revw($split(. $arg))) @ arg = ["$before($ct . $arg)" "$after($ct . $arg)"] } } fe blrhs bl { @ :ct = count(. .$bl) @ :bl = pattern(*.$bl $args) fe bl arg { @ arg = ["$unsplit(. $revw($split(. $after(-$ct . $arg))))" "$before(-$ct . $arg)"] } } return $bldns $blrhs } # alias proxyhook (max,hook,ad,args) { hook $hook $ad $args fe ($getmaskitems(proxyback $ad *)) ip host { if (0 > --max) {return} proxyhook $max $hook $host $args } } alias proxywatch (args) { fe ($args) arg { on #-join - "$arg" { if ([$0] == servernick()) { ^who $1 -line { setuniqitem hpt$servernum() $4 } -end { proxycheck $getndelitems(hpt$servernum() $jot(-3 3)) } } else { ^proxycheck $userhost() } } } } # These are a different system and work in a different way. # alias.e bl.srv.bopm bl.type.dns opm.blitzed.org alias.e bl.srv.dsbl1 bl.type.dns list.dsbl.org alias.e bl.srv.dsbl2 bl.type.dns multihop.dsbl.org alias.e bl.srv.dsbl3 bl.type.dns unconfirmed.dsbl.org alias.e bl.srv.reynolds bl.type.dns bl.reynolds.net.au alias.e bl.srv.reynolds1 bl.type.dns t1.bl.reynolds.net.au alias.e bl.srv.reynolds2 bl.type.dns t2.bl.reynolds.net.au alias.e bl.srv.reynolds3 bl.type.dns t3.bl.reynolds.net.au alias.e bl.srv.sorbs bl.type.dns dnsbl.sorbs.net alias.e bl.srv.njabl bl.type.dns dnsbl.njabl.org alias.t bl.type.dns (host,args) { if (functioncall()) { fe args arg { @ arg = nametoip($after(-1 @ @$arg)) @ arg = arg ? nametoip($cut(3.0 . $arg).$host) : [?] @ arg = arg ? arg : 0 } } else { fe args arg { @ :foo = bl.type.dns($host $arg) echo $host$chr(9)$foo$chr(9)$arg @ :arg = foo } } return $args } alias hexuid (args) { @ :hex = jotc(09afAF) @ :unk = userhost(,) fe args arg { @ :arg = ischannel($arg) ? chanusers($arg) : arg } fe args arg { @ :arg = unk == userhost($arg) ? arg : userhost($arg) @ :arg = before(@ $arg@) } fe args arg { @ :arg = pass($hex $arg) unless (8 == strlen($arg)) { @ :arg = [] continue } @ :arg = 0 + [0x$arg] @ :arg = iptolong($arg) @ :arg = convert($arg) } if (functioncall()) { return $args } else { echo $args } } cetk.topicmgmt0000644000076500007650000001072410766172332014150 0ustar jmidgleyjmidgley# CETK epic Topic Management script 0.0 # unload cetk.topicmgmt package cetk.topicmgmt load cetk.functions # Configurator. # alias.t topic.cfg (args) { $getopts(:args cetk.topic. "hs:f:" $args) if (cetk.topic.h) { @ cetk.topic.h = [] echo -s sep Specify a topic separator for joined topics. echo -f file Specify a file for storing topics. } elsif (isdisplaying()) { foreach cetk.topic var { echo -$tolower($var) $cetk[topic][$var] } } } # Save all topics so the other functions can work. # fe (332 topic) foo { on #-$foo 202 * { @ :utime = unsplit(_ $utime()) @ :echan = [$encodel($1)] @ topic[$echan] = [$2-] @ topic[$echan][$utime] = [$2-] fe ($cetk.topic.f) file { ^assign.esave $file topic.${echan}.${utime} } } } # Add/del/insert topics. # alias.t topic.replace (topic) { @ :sep = cetk[topic][s] ? cetk[topic][s] : [||] @ :chan = ischannel($topic) ? shift(topic) : C @ :oldtopic = topic[$encodel($chan)] if (!#topic) { echo ${t}: [chan] deletion-points [insertion-point] [topic-to-insert] } elsif (strlen($oldtopic)) { @ :del = shift(topic) @ :del = split(, $del) fe del del {@ del = del =~ [*.*] ? jot($split(. $del)) : del} @ :ins = isnumber(b10 $topic) ? shift(topic) : 0 @ :newtopic = [] for (@ :foo = 0, strlen($oldtopic), @ ++foo) { if (foo == ins && topic) { push newtopic $sep $topic } if (!match($foo $del)) { push newtopic $sep $beforrw($sep $oldtopic) } @ oldtopic = afterw($sep $oldtopic) } if (foo <= ins && topic) { push newtopic $sep $topic } shift newtopic topic $chan $newtopic } else { topic $chan echo Fetching topic (try again). } } # Set a previous topic. # alias.t topic.last (args) { if (args) { @ :chan = ischannel($args) ? shift(args) : C @ :foo = aliasctl(assign match topic.$encodel($chan).) @ :num = isnumber(b10 $args) ? shift(args) : 0 @ :num += 0 > num ? numwords($foo) : 0 @ :var = word($num $foo) if (functioncall()) { return $($var) } elsif (ischanop($servernick() $chan)) { topic $chan $($var) purge $var } } else { echo ${t}: [chan] [number] } } # Search and display saved topics. # alias.t topic.list (mask) { @ :num = isnumber(b10 $mask) ? shift(mask) : 0 @ :chans = shift(mask) foreach topic foo { if (rmatch($decode($foo) $chans)) { @ :count = 0 @ :this = 0 foreach topic.$foo bar { @ count++ } foreach topic.$foo bar { if (topic[$foo][$bar] !~ mask) { } elsif (0 > num && num > bar - time()) { } elsif (0 < num && num < count - this) { } else { echo $stime($bar) [$decode($foo)] [$this]$chr(9)$topic[$foo][$bar] } @ this++ } } } if (!chans) { echo ${t}: [num] chanmask topicmasks } } # Saved topic stats. # alias.t topic.stat (chans) { @ :min = isnumber(b10 $chans) ? shift(chans) : 0 @ :max = isnumber(b10 $chans) ? shift(chans) : 0 foreach topic foo { if (rmatch($decode($foo) $chans)) { @ :count = :mint = :maxt = 0 foreach topic.$foo bar { @ :count++ @ mint ? (maxt = bar) : (maxt = mint = bar) } if (min && count < min) { } elsif (max && count > max) { } else { echo $stime($mint) - $stime($maxt) - $[-18]tdiff2(${maxt-mint}) $[-5]count $decode($foo) } } } if (!chans) { echo ${t}: [min] [max] chanmask } } # Purge saved topics by count. # alias.t topic.reap (args) { @ :count = :total = 0 @ :num = isnumber(b10 $args) ? shift(args) : 1 @ :time = isnumber(b10 $args) ? shift(args) : -86400 @ :time = time < 0 ? time() + time : time foreach topic chan { @ :list = aliasctl(assign match topic.${chan}.) @ :list = revw($list) @ :total += numwords($list) @ :chan = decode($chan) @ splice(list 0 $num) fe list list { @ list = after(2 . $list) < time && [$chan $($list)] =~ args ? list : [] } @ :count += numwords($list) purge $list } if (args) { echo $count / $total = ${(100*count)/total}% topics purged. } else { echo ${t}: [count] [time|-age] mask } } # Purge duplicate saved topics. # alias.t topic.uniq (args) { @ :max = isnumber(b10 $args) ? shift(args) : 4 foreach topic chan { if (rmatch($decode($chan) $args)) { @ :not = 0 @ delarray(${t}) foreach topic[$chan] ctime { if (0 > finditem(${t} $topic[$chan][$ctime])) { @ setitem(${t} ${not++%max} $topic[$chan][$ctime]) @ ++:kept } else { purge topic[$chan][$ctime] @ ++:purged } } } } @ delarray(${t}) if (args) { echo $purged : $kept = ${(100*purged)/(purged+kept)}% topics purged. } else { echo ${t}: [num] chanmask } } cetk.userlist0000644000076500007650000001067010774574127014026 0ustar jmidgleyjmidgley# CETK epic Userlist script 0.0 # unload cetk.userlist package cetk.userlist # # External dependancies: /purge is required to be defined elsewhere in the # script that calls this one if /userdel is to work. "load commandqueues" can # also be run to get rid of the /builduser requirement. # # # For each alias definition, define two. One each for userlist and shitlist. # stack push alias alias.tt alias alias.tt fe (user shit) foo { alias $sar(g/\${foo}/$foo/$*) } # # $findusers() and $findshits(). Find the name of matching users or shits from # the appropriate list given a n!u@h and a channel. # # These functions are the primary back end for most of the other functions, but # they have their uses in other scripts too. # alias.tt find${foo}s { xdebug dword { fe ($*) nuh chan pass { @ :nuh = [.] == nuh ? last[$last[eserv]][from] : nuh return $corpattern("$nuh,$chan" ulcache[${foo}][mask] ulcache[${foo}][user]) } } } # # $checkusers(), $checkshits(). Given a decimal bitwise mask, a channel and a # list of n!u@h's, return the n!u@h's that match at least one bit of the mask. # # These functions are scripting interfaces. # alias.tt check${foo}s (args) { @ :mask = shift(args) @ :chan = shift(args) fe args arg { @ arg = mask & check${foo}($arg $chan) ? arg : [] } return $args } # # $matchuser() and $matchshit() act just like $find*s() for two arguments. # Additional arguments are usernames and shitnames and cause a decimal bitmask # to be returned indicating which names matched. This is a very esoteric # function. # alias.tt match${foo} { @ :masks = [$2-] @ :users = find${foo}s($0-1) unless (2<#) {return $users} fe ($uniq($users)) foo { @ :ret |= 1 << rmatch($foo $masks) } return ${(ret & -2) >> 1} } # # Works on the same principle as alias.tt defined above. # alias alias.tt fe (user -1 &= shit -0 |=) cmd lev func { @ :args = [$*] alias $msar(gr/\${cmd}/$cmd/\${lev}/$lev/\${func}/$func/args) } # # $checkuser(): Given the same information as $findusers(), return the # userlevel of all matching users bitwise _anded_ together. # # $checkshit(): Given the same information as $findshits(), return the # shitlevel of all matching users bitwise _ored_ together. # # These functions are the primary scripting interfaces. # alias.tt check${cmd} { @ :users = find${cmd}s($*) @ :levels = #users ? ${lev}:[] fe ($users) user { @ levels ${func} userlist[$user][${cmd}level] } return $levels } # # This is a simple one. Return non-zero or zero depending on whether a given # n!u@h and channel pair are found in the combined userlist and shitlist. # alias isuser xdebug dword {return $rpattern($0,$1 $ulcache.shit.mask $ulcache.user.mask)} # # /useradd, /userdel. Add and remove users, their user/shit levels, and # nuh/chan masks used to find them. # alias useradd { xdebug -dword extractw { if ((5!=#) || !isnumber($1) || !isnumber($2)) { echo \($unsplit(" " $0-2)\): usage: /useradd {user} {userlevel} {shitlevel} {nick!user@host[,...]} {chan[,...]} } else { @ userlist[$0][userlevel] = 0+[$1] @ userlist[$0][shitlevel] = 0+[$2] @ userlist[$0][nuhs] = split(|, $3)) @ userlist[$0][chans] = split(|, $4)) } } 1cmd 1 defer builduser } alias userdel foreach userlist foo {if (foo =~ [$*]) {purge userlist[$foo]}};purge ulcache;1cmd 1 defer builduser # # Maintainance. Once all the /useradd commands have been run, /builduser is # used to "compile" the list into something that works much faster. # # This command _must_ be run before /useradd and /userdel will take effect. # alias builduser { xdebug dword extractw { fe (user shit) map { @ ::ulcache[$map][mask] = ::ulcache[$map][user] = [] foreach userlist user { fe ($userlist[$user][nuhs]) nuh { fe ($userlist[$user][chans]) chan { if (userlist[$user][${map}level]) { @ push(ulcache[$map][mask] $nuh,$chan) @ push(ulcache[$map][user] $user) } } } } } } } alias userlist { @ :oxd = xdebug(dword) xdebug dword foreach userlist user { if (match("\\[$*\\]" $user $userlist[$user][nuhs] $userlist[$user][chans])) { echo USER: $user LEVELS: $userlist[$user][userlevel] $userlist[$user][shitlevel] echo NUHS: $userlist[$user][nuhs] echo CHANS: $userlist[$user][chans] if (userlist[$user][userlevel]) { push :users $user } if (userlist[$user][shitlevel]) { push :shits $user } } } if (users) { echo Users: $users } if (shits) { echo Shits: $shits } xdebug $oxd } stack pop alias alias.tt