Code: Select all
#####################################
# Get.tcl by KuNgFo0 (www.eggfaq.com)
#VERSION 0.3
#DESCRIPTION Lets people access a specific directory and all its subdirectories to download files from.
# Set the next line as the channels you want to run in
set get(chans) "#channel"
# Set the next line as the directory to allow access to
set get(dir) "/home/blabla/public_html/stuff"
# Set the next line as the command you want
set get(command) "!get"
# Set the next line as the temp file to use to send the dir listing
set get(file) "dirlisting.txt"
proc xrange {xr xr1 xr2} {
return [join [lrange [split $xr] $xr1 $xr2]]
}
proc xindex {xr xr1} {
return [join [lrange [split $xr] $xr1 $xr1]]
}
proc pub_get {nick uhost hand chan arg} {
global get botnick
if {(([lsearch -exact [string tolower $get(chans)] [string tolower $chan]] != -1) || ($get(chans) == "*")) && (![matchattr $hand b]) && ($nick != $botnick)} {
msg_get $nick $uhost $hand $arg
}
}
proc msg_get {nick uhost hand arg} {
global get
switch -exact -- [set command [string tolower [xindex $arg 0]]] {
"find" - "search" {
if {[set str [xrange $arg 1 end]] == ""} { puthelp "NOTICE $nick :Usage: $get(command) find <file>" } \
elseif {![get_valid $str]} { puthelp "NOTICE $nick :Error: Invalid filename" } \
else {
if {[file isdirectory [set tmp [file join $get(dir) $str]]]} {
set get(tdir) $tmp
set file "*"
} elseif {([string match */* $str]) && ([file isdirectory [set tmp2 [file dirname $tmp]]])} {
set get(tdir) $tmp2
set file [file tail $tmp]
} else {
set get(tdir) $get(dir)
set file $str
}
set filelist ""
foreach {file1 file2} [get_list $get(tdir)] {
if {([string match *[string tolower $file]* [string tolower [file tail $file2]]])} {
if {[file isdirectory $file1]} { lappend filelist \002$file2/\002 } \
else { lappend filelist $file2 }
}
}
if {$filelist == ""} { set filelist "None" }
while {$filelist != ""} {
puthelp "NOTICE $nick :Matches found (\002$str\002) - [join [lrange $filelist 0 19] ", "]"
set filelist [lreplace $filelist 0 19]
}
}
}
"list" {
if {[catch {open $get(file) w} fileid]} { puthelp "NOTICE $nick :Error: Could not open temp file" } \
else {
fconfigure $fileid -translation "crlf" ; # Most people are probably using windows
puts $fileid "*** Listing contents of $get(dir) (* = new in last day)"
foreach i "dirs links files bytes" { set get($i) 0 }
get_write $fileid $get(dir)
puts $fileid "*** $get(dirs) dirs, $get(links) links, $get(files) files, $get(bytes) bytes"
close $fileid
get_send $nick $get(file)
}
}
"help" - "" {
puthelp "NOTICE $nick :Available commands:"
puthelp "NOTICE $nick :$get(command) find <file>"
puthelp "NOTICE $nick :$get(command) <file>"
puthelp "NOTICE $nick :$get(command) list"
}
default {
if {![get_valid [set file $arg]]} { puthelp "NOTICE $nick :Error: Invalid filename" } \
elseif {![file exists [set tmp [file join $get(dir) $file]]]} { puthelp "NOTICE $nick :Error: File '$tmp' does not exist" } \
else { get_send $nick $tmp }
}
}
}
proc get_valid {file} {
return [expr {(![string match *..* $file]) && (![string equal [string index $file 0] "/"])}]
}
proc get_send {nick file} {
switch -exact -- [dccsend $file $nick] {
0 { puthelp "NOTICE $nick :Sending [file tail $file]." }
1 { puthelp "NOTICE $nick :Error: Too many pending file requests. Try again later, thank you." }
2 { puthelp "NOTICE $nick :Error: Could not open socket. Please notify my admin, thank you." }
3 { puthelp "NOTICE $nick :Error: File does not exist. Please notify my admin, thank you." }
4 { puthelp "NOTICE $nick :Error: Too many file sends already in progress. Your request has been added to the queue, please wait." }
5 { puthelp "NOTICE $nick :Error: Could not move file to temporary directory. Please notify my admin, thank you." }
}
}
proc get_list {what {pre ""}} {
if {$pre == ""} { set pre $what }
set files ""
foreach file [lsort [glob -nocomplain [file join $what *]]] {
set file2 [string trimleft [string range $file [string length $pre] end] "./\\"] ; # the filename we actually show to the user
if {![file readable $file]} {
continue ; # ignore unreadable files
} elseif {[file isdirectory $file]} {
set files [concat $files $file $file2 [join [get_list $file $pre]]]
} else {
lappend files $file $file2
}
}
return $files
}
proc get_write {fileid what} {
global get
puts $fileid "/"
foreach {file1 file2} [get_list $what] {
if {![catch {file type $file1} type]} {
switch -exact -- $type {
directory {
incr get(dirs)
set temp $file2/
}
link {
incr get(links)
if {[catch {file readlink $file1} temp]} { set temp "Could not eval symlink" }
set temp [format "%-60s %s" $file2 "--> $temp"]
}
file {
incr get(files)
incr get(bytes) [set size [file size $file1]]
set temp [format "%-50s %10s" $file2 $size]
}
default {
incr get(files)
set temp $file2
}
}
if {[expr [clock seconds] - [file mtime $file1]] < 86400} {
puts $fileid "* $temp"
} else {
puts $fileid " $temp"
}
}
}
}
set copy-to-tmp 1
bind pub - $get(command) pub_get
bind msg - $get(command) msg_get
if {![file exists $get(dir)]} {
if {[catch {file mkdir $get(dir)}]} { putlog "Error: Could not create directory $get(dir)" }
} elseif {![file isdirectory $get(dir)]} { putlog "Error: $get(dir) is not a directory" } \
elseif {![file readable $get(dir)]} { putlog "Error: $get(dir) is not readable" }
putlog "*** Get.tcl 0.3 by KuNgFo0 loaded"This script sounds pretty usefull but I get
Code: Select all
Tcl error [pub_get]: invalid command name "dccsend"
Thanks and greetz
