All pastes #760070 Raw Edit

Anonym

public text v1 · immutable
·published 2007-11-03 19:00 UTC
rendered paste body
##################################### 
# 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) "#FP-MAIN" 
# Set the next line as the directory to allow access to 
set get(dir) "/home/sahkureggi/bin/EGGI/fpnfo/scripts/nfo" 
# 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>" } \ 
if {![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" } \ 
if {![file readable $get(dir)]} { putlog "Error: $get(dir) is not readable" } 

putlog "*** Get.tcl 0.3 by KuNgFo0 loaded"