Page MenuHomeDevCentral

No OneTemporary

diff --git a/Core.tcl b/Core.tcl
index 3c6fc20..121f277 100644
--- a/Core.tcl
+++ b/Core.tcl
@@ -1,29 +1,47 @@
#
# 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
#
#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} {
}
+
+#
+# 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 363844c..3c3a078 100644
--- a/Nasqueron/Server.tcl
+++ b/Nasqueron/Server.tcl
@@ -1,73 +1,100 @@
# ===============================================
# ========= ==== ====== ============
# ============ ====== === === = ==========
# ============ ===== ======== === =========
# ============ ===== ============= ==========
# ============ ===== ============ ===========
# == 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 dcc W phpfpm dcc:phpfpm
+#
+# 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 .phpfpm pub:phpfpm
bind pub W .php-fpm pub:phpfpm
-bind bot - tc2 bot:tc2
-set tc2(bot) TC2
+#
+# Initializes bind and creates procedures for every tc2 commands
+#
-proc dcc:phpfpm {handle idx arg} {
- tc2 dcc $idx $handle phpfpm $arg
- return 1
+proc tc2:initialize {} {
+ global tc2
+ 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]
+ }
}
-proc pub:phpfpm {nick uhost handle chan text} {
- tc2 pub "$chan $nick" $handle phpfpm $text
- return 1
-}
+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"
return
}
putbot $tc2(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 b8b1b02..2889a53 100644
--- a/TC2/Server.tcl
+++ b/TC2/Server.tcl
@@ -1,127 +1,362 @@
# ===============================================
# ========= ==== ====== ============
# ============ ====== === === = ==========
# ============ ===== ======== === =========
# ============ ===== ============= ==========
# ============ ===== ============ ===========
# == 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
+#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"}
}
#Reports result
putbot $sourcebot "tc2 [dict create success [lindex $reply 0] reply [lindex $reply 1] bind $bind who $who]"
return 1
}
-#checks if a username begins by a letter and contains only letters, digits, -, _ or .
+#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
+ #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]
+ }
+
+}
+
+#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]."
+ }
+ }
+
+ "" {
+ 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 "/usr/local/etc/php-fpm/$user.conf"] {
+ if [file exists [set file "/usr/local/etc/php-fpm/$user.conf"]] {
return "0 {there is already a $user pool}"
}
- set port [sql "SELECT MAX(pool_port) FROM tc2_phpfpm_pools]
+ 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
}
- #string map "%REQUESTER% $requester %TIME% [unixtime] %PORT% $port %USER% $user" $template
- return {0 "not yet implemented"}
+ #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]
+ 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/TC2/Time.tcl b/TC2/Time.tcl
index 82570b8..484d244 100644
--- a/TC2/Time.tcl
+++ b/TC2/Time.tcl
@@ -1,33 +1,37 @@
-utimer 90 onload
+#utimer 90 onload
bind cron - "* * * * *" cron:minute
bind cron - "*/5 * * * *" cron:often
bind cron - "0 * * * *" cron:hourly
bind cron - "0 4 * * *" cron:daily
proc onload {} {
+ #This proc, called on startup, causes the eggdrop
+ #to die on "unloadmodule server"
+ #.tcl onload manually will work
+
#Drops IRC support
unloadmodule irc
unloadmodule ctcp
unloadmodule channels
unloadmodule server
#Links to Nasqueron
link Nasqueron
}
#Every minute
proc cron:minute {minute hour day month weekday} {
}
#Every 5 minutes
proc cron:often {minute hour day month weekday} {
sqlrehash
}
#Every hour
proc cron:hourly {minute hour day month weekday} {
}
#Every day, at 4am
proc cron:daily {minute hour day month weekday} {
}
diff --git a/Tech.tcl b/Tech.tcl
index 14e9177..4629cd1 100644
--- a/Tech.tcl
+++ b/Tech.tcl
@@ -1,222 +1,224 @@
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 "*sql*connect*" $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)
}
proc sqlescape {data} {
#\ -> \\
#' -> \'
string map {"\\" "\\\\" "'" "\\'"} $data
}
#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, Sep 15, 07:36 (1 d, 11 h)
Storage Engine
blob
Storage Format
Raw Data
Storage Handle
2983868
Default Alt Text
(22 KB)

Event Timeline