/[cvs]/eggdrop1.6/scripts/klined.tcl
ViewVC logotype

Contents of /eggdrop1.6/scripts/klined.tcl

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.1 - (show annotations) (download) (as text)
Mon Sep 13 14:36:18 1999 UTC (19 years, 10 months ago) by segfault
Branch: MAIN
File MIME type: application/x-tcl
Initial commit based off of .29 cvs

1 #
2 # KLined.TCL - Version 1.0
3 # By Ian Kaney - ikaney@uk.defiant.org
4 #
5 # Even at the best of times, your bot will get k-lined by one operator or
6 # another on a server you're running your bot on. This script will 'hopefully'
7 # handle this by removing it from your bot's server list when it detects
8 # you've been k-lined there. Thus, stopping IRC server admins getting
9 # rather peeved at the constant connects from your host.
10 #
11 # USAGE:
12 # The actual handling of removing the server from your server list
13 # and writing it to the 'klines' file is handled automatically when
14 # your bot receives the k-line signal, but there are some DCC commands
15 # that have been added, these are:
16 #
17 # .klines - Lists the 'klines' file showing servers that your bot
18 # has registered as being k-lined on.
19 # .unkline <server> - Removes the k-line from the server *joke* ;)
20 # Actually, this removes the server from the list
21 # of servers to remove.
22 #
23
24 # Bindings
25 # ---
26 bind load - server remove_kservers
27 bind raw - 465 woah_klined
28 bind dcc n klines list_kservers
29 bind dcc n unkline unkline_server
30
31 # Variables
32 # ---
33 # Change this to suite your tastes - if you can't be bothered, or
34 # don't know how, leave it.
35 set kfile "klines"
36
37 proc list_kservers {handle idx args} {
38 global kfile
39
40 putcmdlog "#$handle# klines"
41 set fd [open $kfile r]
42 set kservers { }
43
44 while {![eof $fd]} {
45 set tmp [gets $fd]
46 if {[eof $fd]} {break}
47 set kservers [lappend kservers [string trim $tmp]]
48 }
49 close $fd
50 if {[llength $kservers] == 0} {
51 putdcc $idx "No k-lined servers."
52 return 0
53 }
54 putdcc $idx "My k-lined server list:\n"
55 foreach tmp $kservers {
56 putdcc $idx $tmp
57 }
58 }
59
60 proc unkline_server {handle idx args} {
61 global kfile
62
63 set kservers {}
64
65 set fd [open $kfile r]
66 set rem [lindex $args 0]
67
68 putcmdlog "#$handle# unkline $rem"
69
70 while {![eof $fd]} {
71 set tmp [gets $fd]
72 if {[eof $fd]} {break}
73 set kservers [lappend kservers [string trim $tmp]]
74 }
75 close $fd
76
77 set fd [open $kfile w]
78 set flag "0"
79
80 foreach tmp $kservers {
81 if {$tmp == $rem} {
82 set flag "1"
83 }
84 if {$tmp != $rem} {
85 puts $fd $tmp
86 }
87 }
88 close $fd
89 if {$flag == "0"} {
90 putdcc $idx "Could not find $rem in the k-lined server list."
91 }
92 if {$flag == "1"} {
93 putdcc $idx "Removed server $rem from k-lined server list."
94 }
95 }
96
97 proc remove_kservers {module} {
98 global kfile
99 global server servers
100
101 if {[catch {set fd [open $kfile r]}] != 0} {
102 set fd [open $kfile w]
103 close $fd
104 set fd [open $kfile r]
105 }
106
107 while {![eof $fd]} {
108 set from [string trim [gets $fd]]
109 set name "*$from*"
110 if {[eof $fd]} {break}
111
112 for {set j 0} {$j >= 0} {incr j} {
113 set x [lsearch $servers $name]
114 if {$x >= 0} {
115 set servers [lreplace $servers $x $x]
116 }
117 if {$x < 0} {
118 if {$j >= 0} {
119 putlog "Removed server: $from"
120 }
121 break
122 }
123 }
124 }
125 close $fd
126 return 1
127 }
128
129 proc woah_klined {from keyword arg} {
130
131 global kfile
132 global server servers
133
134 set kservers {}
135
136 set fd [open $kfile r]
137
138 while {![eof $fd]} {
139 set tmp [gets $fd]
140 if {[eof $fd]} {break}
141 set kservers [lappend kservers [string trim $tmp]]
142 }
143 close $fd
144
145 set flag "0"
146
147 foreach tmp $kservers {
148 if {$tmp == $from} {
149 set flag "1"
150 }
151 }
152
153 if {$flag != "1"} {
154 set fd [open $kfile a]
155 puts $fd $from
156 close $fd
157 }
158
159 set name "*$from*"
160
161 for {set j 0} {$j >= 0} {incr j} {
162 set x [lsearch $servers $name]
163 if {$x >= 0} {
164 set servers [lreplace $servers $x $x]
165 }
166 if {$x <= 0} {
167 if {$j >= 0} {
168 putlog "Removed server: $from"
169 }
170 break
171 }
172 }
173 return 1
174 }
175
176 putlog "TCL loaded: k-lined"
177 remove_kservers server

webmaster@eggheads.org
ViewVC Help
Powered by ViewVC 1.1.23