No OneTemporary
Actions

Size

23 KB

Referenced Files

None

Subscribers

None

View Options

This document is not UTF8. It was detected as Shift JIS and converted to UTF8 for display.

	diff --git a/Core.tcl b/Core.tcl
	index 121f277..b63e7dd 100644
	--- a/Core.tcl
	+++ b/Core.tcl
	@@ -1,47 +1,80 @@
	#
	# TCL helpers
	#

	#Determines if $proc exists
	proc proc_exists {proc} {
	expr {[info procs $proc] == $proc}
	}

	#
	# Trivial procs
	#

	#Determines if $v is a number
	proc isnumber {v} {
	return [expr {! [catch {expr {int($v)}}]}]
	}

	#
	-# MySQL
	+# Registry
	#
	-#Gets the value of the key $key from the registry
	-proc registry_get {key} {
	- sql "SELECT value FROM registry WHERE `key` = '$key'"
	-}

	-#Sets the key $key to $value in the registry
	-proc registry_set {key value} {
	+#Gets, sets, deletes or increments a registry value
	+proc registry {command key {value ""}} {
	+ switch -- $command {
	+ "add" {
	+ sqladd registry "data value" [list $key $value]
	+ }
	+
	+ "get" {
	+ sqlscalar "SELECT value FROM registry WHERE `data` = '$key'"
	+ }
	+
	+ "set" {
	+ sqlreplace registry "data value" [list $key $value]
	+ }
	+
	+ "del" {
	+ registry delete $key $value
	+ }
	+
	+ "delete" {
	+ set sql "DELETE FROM registry WHERE `data` = '$key'"
	+ putdebug $sql
	+ sql $sql
	+ }
	+
	+ "incr" {
	+ set current [registy get $key]
	+ if {$value == ""} {set term 1}
	+ if {$current == ""} {
	+ registry set $key $term
	+ } {
	+ registry set $key [incr current $term]
	+ }
	+ }
	+
	+ default {
	+ error "unknown subcommand: must be add, get, set, incr or delete"
	+ }
	+ }
	}

	#
	# Users information
	#
	proc getuserid {data} {
	if {$data == ""} {
	return
	} elseif {![isnumber $data]} {
	#username -> user_id
	sql "SELECT user_id FROM users WHERE username = '[sqlescape $data]'"
	} elseif {$data < 1000} {
	#idx -> user_id
	getuserid [idx2hand $data]
	} else {
	#user_id -> user_id (or "" if not existing)
	sql "SELECT user_id FROM users WHERE user_id = $data"
	}
	}
	diff --git a/Nasqueron/Server.tcl b/Nasqueron/Server.tcl
	index 3c3a078..2cbc9e2 100644
	--- a/Nasqueron/Server.tcl
	+++ b/Nasqueron/Server.tcl
	@@ -1,100 +1,97 @@
	# ===============================================
	# ========= ==== ====== ============
	# ============ ====== === === = ==========
	# ============ ===== ======== === =========
	# ============ ===== ============= ==========
	# ============ ===== ============ ===========
	# == DcK ===== ===== =========== ============
	# ============ ===== ========== =============
	# ============ ====== === === ==============
	# ============ ======= === ==========
	# ===============================================
	# ===============================================
	# == Tau Ceti Central == Server administration ==
	# == This is a very dangerous product to use ==
	# == Don't deploy it in stable environment ==
	# == Or say goodbye to the serv security ==
	# == This warning will not be repeated ==
	# == All your base are belong to us! ==
	# ===============================================
	# ===============================================
	#
	# (c) 2011 Sﾃｩbastien Santoro aka Dereckson.
	# Released under BSD license.

	-#
	-# Configuration
	-#
	-
	-set tc2(bot) TC2
	-set tc2(commands) {account phpfpm}
	-
	#
	# Binds
	#

	bind bot - tc2 bot:tc2

	#Commands aliases only, main commands are handled by tc2:initialize
	bind dcc W php-fpm dcc:phpfpm
	bind pub W .php-fpm pub:phpfpm

	#
	# Initializes bind and creates procedures for every tc2 commands
	#

	-proc tc2:initialize {} {
	- global tc2
	+proc tc2:addcommand {command} {
	set proc_tc2_command_dcc {
	tc2 dcc $idx $handle %COMMAND% $arg
	return 1
	}
	set proc_tc2_command_pub {
	tc2 pub "$chan $nick" $handle %COMMAND% $text
	return 1
	}
	- foreach command $tc2(commands) {
	- bind dcc W $command dcc:$command
	- bind pub W ".$command" pub:$command
	- proc dcc:$command {handle idx arg} [string map "%COMMAND% $command" $proc_tc2_command_dcc]
	- proc pub:$command {nick uhost handle chan text} [string map "%COMMAND% $command" $proc_tc2_command_pub]
	+ bind dcc W $command dcc:$command
	+ bind pub W ".$command" pub:$command
	+ proc dcc:$command {handle idx arg} [string map "%COMMAND% $command" $proc_tc2_command_dcc]
	+ proc pub:$command {nick uhost handle chan text} [string map "%COMMAND% $command" $proc_tc2_command_pub]
	+
	+}
	+
	+proc tc2:initialize {} {
	+ foreach command [registry get tc2.commands] {
	+ tc2:addcommand $command
	}
	}

	tc2:initialize

	#
	# TC2 clients procdures
	#

	proc bot:tc2 {sourcebot command text} {
	if [catch {
	set success [dict get $text success]
	set reply [dict get $text reply]
	set bind [dict get $text bind]
	set who [dict get $text who]
	tc2:reply $bind $who $reply
	}] {
	putdebug $text
	}
	}

	proc tc2 {bind who handle command arg} {
	- global tc2
	- if ![islinked $tc2(bot)] {
	- tc2:reply $bind $who "$tc2(bot) isn't linked"
	+ set bot [registry get tc2.bot]
	+ if ![islinked $bot] {
	+ tc2:reply $bind $who "$bot isn't linked"
	return
	}
	- putbot $tc2(bot) "tc2 [dict create requester $handle command $command arg $arg bind $bind who $who]"
	+ putbot $bot "tc2 [dict create requester $handle command $command arg $arg bind $bind who $who]"
	}

	proc tc2:reply {bind who message} {
	if {$bind == "dcc"} {
	putdcc $who $message
	} elseif {$bind == "pub"} {
	foreach "chan nick" $who {}
	putserv "PRIVMSG $chan :$nick, $message"
	} {
	error "Unknown bind in tc2:reply: $bind (expected: dcc or pub)"
	}
	}
	diff --git a/TC2/Server.tcl b/TC2/Server.tcl
	index 2889a53..33efe66 100644
	--- a/TC2/Server.tcl
	+++ b/TC2/Server.tcl
	@@ -1,362 +1,422 @@
	# ===============================================
	# ========= ==== ====== ============
	# ============ ====== === === = ==========
	# ============ ===== ======== === =========
	# ============ ===== ============= ==========
	# ============ ===== ============ ===========
	# == DcK ===== ===== =========== ============
	# ============ ===== ========== =============
	# ============ ====== === === ==============
	# ============ ======= === ==========
	# ===============================================
	# ===============================================
	# == Tau Ceti Central == Server administration ==
	# == This is a very dangerous product to use ==
	# == Don't deploy it in stable environment ==
	# == Or say goodbye to the serv security ==
	# == This warning will not be repeated ==
	# == All your base are belong to us! ==
	# ===============================================
	# ===============================================
	#
	# (c) 2011 Sﾃｩbastien Santoro aka Dereckson.
	# Released under BSD license.

	bind bot - tc2 bot:tc2

	+#
	+# Eggdrop events
	+#
	+
	#Handles tc2 requests from linked bots
	proc bot:tc2 {sourcebot command text} {
	#Sourcebot: Nasqueron
	#Command: tc2
	#Text: requester Dereckson command phpfpm arg status
	set requester [dict get $text requester]
	set cmd [dict get $text command]
	set arg [dict get $text arg]
	set bind [dict get $text bind]
	set who [dict get $text who]

	#Logs entry
	log tc2 "$requester@$sourcebot" "$cmd $arg"

	#Executes command
	if [proc_exists tc2:command:$cmd] {
	putcmdlog "(tc2) <$requester@$sourcebot> $cmd $arg"
	set reply [tc2:command:$cmd $requester $arg]
	} {
	- set reply {0 "Unknown command: $cmd"}
	+ set reply "0 {Unknown command: $cmd}"
	}

	#Reports result
	putbot $sourcebot "tc2 [dict create success [lindex $reply 0] reply [lindex $reply 1] bind $bind who $who]"
	return 1
	}

	+#
	+# Helper procs
	+#
	+
	#Checks if $username begins by a letter and contains only letters, digits, -, _ or .
	proc tc2:username_isvalid {username} {
	regexp {^[A-Za-z][A-Za-z0-9_\-\.]*$} $username
	}

	#Determines if $username exists on the system
	#SECURITY: to avoid shell injection, call first tc2:username_isvalid $username
	proc tc2:username_exists {username} {
	#TODO: Windows and other OSes (this line has been tested under FreeBSD)
	if {[exec -- logins -oxl $username] == ""} {
	return 0
	} {
	return 1
	}
	}

	#Gets server hostname
	proc tc2:hostname {} {
	exec hostname -s
	}

	#Determines if $username is root
	proc tc2:isroot {username} {
	#Validates input data
	set username [string tolower $username]
	if ![tc2:username_isvalid $username] {
	return 0
	}

	#Check 1 - User has local accreditation
	if ![sql "SELECT count(*) FROM tc2_roots WHERE account_username = '$username' AND server_name = '[sqlescape [tc2:hostname]]'"] {
	return 0
	}

	#Check 2 - User is in the group wheel on the server
	if {[lsearch [exec -- id -Gn $username] wheel] == "-1"} {
	return 0
	} {
	return 1
	}
	}

	#Determines if $requester is EXPLICITELY allowed to allowed to manage the account $user
	#When you invoke this proc, you should also check if the user is root.
	# e.g. if {[tc2:isroot $requester] \|\| [tc2:userallow $requester $user]} { ... }
	proc tc2:userallow {requester user} {
	set sql "SELECT count(*) FROM tc2_users_permissions WHERE server_name = '[sqlescape [tc2:hostname]]' AND account_username = '[sqlescape $user]' AND user_id = [getuserid $user]"
	putdebug $sql
	sql $sql
	}

	#tc2:getpermissions on $username: Gets permissions on the $username account
	#tc2:getpermissions from $username: Gets permissions $username have on server accounts
	proc tc2:getpermissions {keyword username} {
	switch $keyword {
	"from" {
	set sql "SELECT account_username FROM tc2_users_permissions WHERE server_name = '[sqlescape [tc2:hostname]]' AND user_id = '[getuserid $username]'"
	}
	"on" {
	set sql "SELECT u.username FROM tc2_users_permissions p, users u WHERE p.server_name = '[sqlescape [tc2:hostname]]' AND p.account_username = '$username' AND u.user_id = p.user_id"
	}
	default {
	error "from or on expected"
	}
	}
	set accounts ""
	foreach row [sql $sql] {
	lappend accounts [lindex $row 0]
	}
	+}

	+#Creates an account $username froﾃm the $specified group
	+proc tc2:createaccount {username group} {
	+ if {$group == "web"} {
	+ set key "tc2.[tc2:hostname].wwwroot"
	+ if {[set wwwroot [registry get $key]] == ""} {
	+ error "You must define the registry key $key"
	+ }
	+ set homedir $wwwroot/$username
	+ if [catch {
	+ set reply [exec -- pw user add $username -g $group -b $wwwroot -w random]
	+ exec -- mkdir -p -m 0711 $homedir
	+ exec -- chown -R $username:web $homedir
	+ } err] {
	+ append reply " / "
	+ append reply $err
	+ }
	+ return $reply
	+ } {
	+ exec -- pw user add $username -g $group -m -w random
	+ }
	}

	+#
	+# tc2 commands
	+#
	+
	#account permission
	#account isroot
	#account exists
	proc tc2:command:account {requester arg} {
	set command [lindex $arg 0]
	switch -- $command {
	"exists" {
	set username [lindex $arg 1]
	if ![tc2:username_isvalid $username] {
	return {0 "this is not a valid username"}
	}
	if [tc2:username_exists $username] {
	list 1 "$username is a valid account on [tc2:hostname]."
	} {
	list 1 "$username isn't a valid account on [tc2:hostname]."
	}
	}

	"isroot" {
	set username [lindex $arg 1]
	if ![tc2:username_isvalid $username] {
	return {0 "this is not a valid username"}
	}
	if [tc2:isroot $username] {
	list 1 "$username has got root accreditation on [tc2:hostname]."
	} {
	list 1 "$username doesn't seem to have any root accreditation [tc2:hostname]."
	}
	}

	"permission" {
	set username [lindex $arg 1]
	if ![tc2:username_isvalid $username] {
	return {0 "this is not a valid username"}
	}

	switch -- [lindex $arg 2] {
	"" {
	set sentences {}
	set accounts_from [tc2:getpermissions from $username]
	set accounts_on [tc2:getpermissions on $username]
	if {$accounts_on != ""} {
	lappend sentences "has authority upon [join $accounts_on ", "]"
	}
	if {$accounts_from != ""} {
	lappend sentences "account can be managed from IRC by [join $accounts_from ", "]"
	}
	if {[tc2:isroot $username]} {
	lappend sentences "has root access"
	}
	if {$sentences == ""} {
	list 1 nada
	} {
	list 1 "$username [join $sentences " / "]."
	}
	}

	"add" {
	#e.g. .account permission espacewin add dereckson
	# will give access to the espacewin account to dereckson
	if {![tc2:isroot $requester] && ![tc2:userallow $requester $username]} {
	return "0 {you don't have the authority to give access to $username account.}"
	}

	#Asserts mandataire has an account
	set mandataire [lindex $arg 3]
	if {[set mandataire_user_id [getuserid $mandataire]] == ""} {
	return "0 {please create first a bot account for $mandataire.}"
	}

	#Adds the permission
	sqlreplace tc2_users_permissions "server_name account_username user_id" [list [tc2:hostname] $username $mandataire_user_id]

	return "1 {$mandataire has now access to $username account.}"
	}

	"del" {
	#e.g. .account permission espacewin del dereckson
	# will remove access to the espacewin account to dereckson
	if {![tc2:isroot $requester] && ![tc2:userallow $requester $username]} {
	return "0 {you don't have the authority to manage the $username account.}"
	}

	#Asserts mandataire is a valid bot account
	set mandataire [lindex $arg 3]
	if {[set mandataire_user_id [getuserid $mandataire]] == ""} {
	return "0 {$mandataire doesn't have a bot account, and so, no such permission.}"
	}

	#Checks if the permission exists
	if ![tc2:userallow $requester $mandataire] {
	return "0 {$mandataire haven't had an access to $username account.}"
	}

	#Removess the permission
	sql "DELETE FROM tc2_users_permissions WHERE server_name = '[sqlescape [tc2:hostname]]' AND account_username = '$username' AND user_id = '$mandataire_user_id'"

	return "1 {$mandataire doesn't have access to $username account anymore.}"
	}

	"+root" {
	#Checks right and need
	if ![tc2:isroot $requester] {
	return "0 {you don't have root authority yourself.}"
	}
	if [tc2:isroot $username] {
	return "0 {$username have already root authority.}"
	}

	#Declares him as root
	sqlreplace tc2_roots "server_name account_username user_id" [list [tc2:hostname] $username [getuserid $username]]

	#Checks if our intervention is enough
	if [tc2:isroot $username] {
	list 1 "$username have now root authority."
	} {
	list 1 "$username have been added as root and will have root authority once in the wheel group."
	}
	}

	"-root" {
	if ![tc2:isroot $requester] {
	return {0 "you don't have root authority yourself."}
	}
	if ![tc2:isroot $username] {
	list 0 "$username doesn't have root authority."
	} {
	#Removes entry from db
	sql "DELETE FROM tc2_roots WHERE server_name = '[sqlescape [tc2:hostname]]' AND account_username = '[sqlescape $username]'"

	#Checks if our intervention is enough
	list 1 "$username doesn't have root authority on IRC anymore. Check also the wheel group."
	}
	}

	default {
	list 0 "expected: add <username>, del <username>, exists, +root, -root, or nothing"
	}
	}
	}

	"groups" {
	set username [lindex $arg 1]
	if ![tc2:username_isvalid $username] {
	return {0 "this is not a valid username"}
	}
	if [tc2:username_exists $username] {
	list 1 [exec -- id -Gn $username]
	} {
	list 0 "$username isn't a valid account on [tc2:hostname]."
	}
	}

	+ "create" {
	+ #Checks access and need
	+ set username [lindex $arg 1]
	+ if ![tc2:username_isvalid $username] {
	+ return {0 "this is not a valid username"}
	+ }
	+ if [tc2:username_exists $username] {
	+ return "0 {there is already a $username account}"
	+ }
	+ if ![tc2:isroot $requester] {
	+ return "0 {you don't have root authority, which is required to create an account.}"
	+ }
	+
	+ #Checks group
	+ set group [lindex $arg 2]
	+ set validgroups [registry get tc2.grip.usergroups]
	+ if {$group == ""} {
	+ return "0 {In which group? Must be amongst $validgroups.}"
	+ }
	+ if {[lsearch $validgroups $group] == -1} {
	+ return "0 {$group isn't a valid group, must be among $validgroups}"
	+ }
	+
	+ #Create user
	+ list 1 [tc2:createaccount $username $group]
	+ }
	+
	"" {
	return {0 "permission, isroot, exists or groups expected"}
	}

	default {
	set reply 0
	lappend reply "unknown command: $command"
	}
	}
	}

	#phpfpm reload
	#phpfpm status
	#phpfpm create <user>
	proc tc2:command:phpfpm {requester arg} {
	set command [lindex $arg 0]

	switch $command {
	"reload" {
	if [catch {exec /usr/local/etc/rc.d/php-fpm reload} output] {
	return {0 $output}
	} {
	return {1 "ok, php-fpm reloaded"}
	}
	}

	"status" {
	catch {exec /usr/local/etc/rc.d/php-fpm status} output
	set reply 1
	lappend reply [string map {"\n" " "} $output]
	return $reply
	}

	"create" {
	set user [lindex $arg 1]
	if {$user == ""} {
	return {0 "syntax: phpfpm create <user>"}
	}
	if ![tc2:username_isvalid $user] {
	return {0 "not a valid username"}
	}
	if ![tc2:username_exists $user] {
	return "0 {$user isn't a valid [tc2:hostname] user}"
	}
	if [file exists [set file "/usr/local/etc/php-fpm/$user.conf"]] {
	return "0 {there is already a $user pool}"
	}
	if {![tc2:isroot $requester] && ![tc2:userallow $requester $user]} {
	return "0 {you don't have the authority to create a pool under $user user}"
	}
	set port [sql "SELECT MAX(pool_port) FROM tc2_phpfpm_pools"]
	if {$port == ""} {
	set port 9000
	} {
	incr port
	}

	#Adds it in MySQL table
	set time [unixtime]
	sqladd tc2_phpfpm_pools {pool_user pool_port pool_requester pool_time} [list $user $port $requester $time]

	#Write config gile
	global username
	set fd [open /usr/local/etc/php-fpm/pool.tpl r]
	set template [read $fd]
	close $fd
	set fd [open $file w]
	- puts $fd [string map "%REQUESTER% $requester %TIME% $time %PORT% $port %USER% $user %COMMENT% {Autogenerated by $username}" $template]
	+ puts $fd [string map "%REQUESTER% $requester %TIME% $time %PORT% $port %USER% $user %GROUP% [exec -- id -gn $user] %COMMENT% {Autogenerated by $username}" $template]
	close $fd
	exec -- chown root:config $file
	exec -- chmod 644 $file
	return {1 "pool created, use '.phpfpm reload' to enable it"}
	}

	"" {
	return {0 "create, status or reload expected"}
	}

	default {
	set reply 0
	lappend reply "unknown command: $command"
	}
	}
	}
	diff --git a/Tech.tcl b/Tech.tcl
	index 4629cd1..bf5fe86 100644
	--- a/Tech.tcl
	+++ b/Tech.tcl
	@@ -1,224 +1,230 @@
	unbind dcc n rehash *dcc:rehash
	bind dcc T rehash dcc:rehash
	bind dcc T s dcc:source
	unbind dcc n tcl *dcc:tcl
	bind dcc T tcl dcc:tcl

	bind dcc T sql dcc:sql
	bind dcc T sql? dcc:sql?
	bind dcc T sql! dcc:sql!
	bind dcc T sql1 dcc:sql1
	bind dcc T sql1? dcc:sql1?
	bind dcc T sql1! dcc:sql1!
	bind dcc T sqlrehash dcc:sqlrehash

	bind dcc T tcldoc dcc:tcldoc

	#
	# Helpers methods
	#

	#Logs a timestamped message to the specified file
	proc log {logfile handle message} {
	global username
	set fd [open "logs/$username/$logfile.log" a]
	puts $fd "\[[unixtime]\] <$handle> $message"
	close $fd
	}

	#Prints a message to all the techs
	proc putdebug {message} {
	foreach conn [dcclist CHAT] {
	foreach "idx handle uhost type flags idle" $conn {}
	#dccputchan 0 "(debug) $conn"
	if [matchattr $handle T] {
	putdcc $idx "\[DEBUG\] $message"
	}
	}
	}

	#
	# Tech commands
	#

	#Disconnect SQL, then rehash (to prevent sql connect fatal errors)
	proc dcc:rehash {handle idx arg} {
	catch {
	sql disconnect
	sql2 disconnect
	}
	*dcc:rehash $handle $idx $arg
	}

	#Loads a script
	proc dcc:source {handle idx arg} {
	if {$arg == ""} {
	putdcc $idx "Usage: .s <script> [script2 ...]"
	return
	}
	foreach file $arg {
	if ![sourcetry $file] {
	putdcc $idx "Can't find script $file"
	}
	}
	}

	#Tries to load a script
	proc sourcetry {file} {
	global username
	set scriptlist "$file $file.tcl scripts/$file scripts/$file.tcl scripts/$username/$file scripts/$username/$file.tcl"
	foreach script $scriptlist {
	if [file exists $script] {
	source $script
	return 1
	}
	}
	return 0
	}

	#.tcl with tech.log logging
	proc dcc:tcl {handle idx arg} {
	#Logs every .tcl commands, except sql connect
	#You should add here any line with password.
	catch {
	if ![string match "sqlconnect*" $arg] {
	log tech $handle $arg
	}
	}
	*dcc:tcl $handle $idx $arg
	}

	#
	# SQL
	#

	#TODO: move to Core.tcl
	proc sqlrehash {} {
	global sql
	catch {
	sql disconnect
	sql2 disconnect
	}
	sql connect $sql(host) $sql(user) $sql(pass)
	sql2 connect $sql(host) $sql(user) $sql(pass)
	sql selectdb $sql(database)
	sql2 selectdb $sql(database)
	}

	+#Escape a string to use as sql query parameter
	proc sqlescape {data} {
	#\ -> \\
	#' -> \'
	string map {"\\" "\\\\" "'" "\\'"} $data

	}

	+#Gets the first item of the first row of a sql query (scalar results)
	+proc sqlscalar {sql} {
	+ lindex [lindex [sql $sql] 0] 0
	+}
	+
	#Adds specified data to specified SQL table
	proc sqladd {table {data1 ""} {data2 ""}} {
	if {$data1 == ""} {
	set fields ""
	#Prints field to fill
	foreach row [sql "SHOW COLUMNS FROM $table"] {
	lappend fields [lindex $row 0]
	}
	return $fields
	}

	if {$data2 == ""} {
	set sql "INSERT INTO $table VALUES ("
	set data $data1
	} {
	set sql "INSERT INTO $table (`[join $data1 "`, `"]`) VALUES ("
	set data $data2
	}
	set first 1
	foreach value $data {
	if {$first == 1} {set first 0} {append sql ", "}
	append sql "'[sqlescape $value]'"
	}
	append sql ")"
	sql $sql
	}

	#Reconnects to the MySQL main server (sql and sql2)
	proc dcc:sqlrehash {handle idx arg} {
	sqlrehash
	return 1
	}

	#
	# dcc:sql1 dcc:sql1? and dcc:sql1! are the main procedures
	# They will be cloned for the 9 other connections command
	#

	#Executes a query
	proc dcc:sql1 {handle idx arg} {
	if {$arg == ""} {
	putdcc $idx "Usage: .sql1 <query>"
	return
	}

	#Executes the query and prints the query one row per line
	set t1 [clock milliseconds]
	if [catch {
	foreach row [sql1 $arg] {
	putdcc $idx $row
	}
	} err] {
	putdcc $idx $err
	}

	#Warns after a long query
	set delta_t [expr [clock milliseconds] - $t1]
	if {$delta_t > 1999} {
	putcmdlog "Fin de la requﾃｪte SQL ($delta_t ms)."
	}

	#Logs the query
	log sql $handle "sql1\t$arg"
	}

	#Dumps (SELECT * FROM <table>) a table
	proc dcc:sql1! {handle idx arg} {
	if {$arg == ""} {
	putdcc $idx "Usage: .sql1! <table>"
	return
	}
	dcc:sql1 $handle $idx "SELECT * FROM $arg"
	}

	#Without parameters, list the tables (SHOW TABLES)
	#With a parameter, dump tables info (SHOW CREATE TABLE)
	proc dcc:sql1? {handle idx arg} {
	if {$arg == ""} {
	dcc:sql1 $handle $idx "SHOW TABLES"
	}
	foreach table $arg {
	dcc:sql1 $handle $idx "SHOW CREATE TABLE $table"
	}
	}

	#Clones .sql1, .sql1? and .sql1! commands into .sql, .sql? and .sql!
	proc dcc:sql {handle idx arg} [string map "sql1 sql" [info body dcc:sql1]]
	proc dcc:sql? {handle idx arg} [string map "sql1 sql" [info body dcc:sql1?]]
	proc dcc:sql! {handle idx arg} [string map "sql1 sql" [info body dcc:sql1!]]

	proc sqlreplace {table {data1 ""} {data2 ""}} [string map {"INSERT INTO" "REPLACE INTO"} [info body sqladd]]

	#Clones .sql1, .sql1? and .sql1! commands into .sql2, .sql3, ..., .sql10.
	for {set i 2} {$i < 11} {incr i} {
	bind dcc T sql$i dcc:sql$i
	bind dcc T sql$i? dcc:sql$i?
	bind dcc T sql$i! dcc:sql$i!
	proc dcc:sql$i {handle idx arg} [string map "sql1 sql$i" [info body dcc:sql1]]
	proc dcc:sql$i! {handle idx arg} [string map "sql1 sql$i" [info body dcc:sql1!]]
	proc dcc:sql$i? {handle idx arg} [string map "sql1 sql$i" [info body dcc:sql1?]]
	}

	#
	# Reference documentation
	#

	proc dcc:tcldoc {handle idx arg} {
	putdcc $idx [exec -- grep $arg doc/tcl-commands.doc]
	return 1
	}

File Metadata

Mime Type: text/x-diff
Expires: Mon, Nov 25, 16:32 (22 h, 54 m)
Storage Engine: blob
Storage Format: Raw Data
Storage Handle: 2260556
Default Alt Text: (23 KB)

No OneTemporaryActions

View Options

File Metadata

Event Timeline

No OneTemporary
Actions