diff options
| -rw-r--r-- | README | 3 | ||||
| -rwxr-xr-x | discord.tcl | 233 | ||||
| -rwxr-xr-x | www.tcl | 121 |
3 files changed, 357 insertions, 0 deletions
@@ -0,0 +1,3 @@ +ya odjemalec za discord.com, Tcl/Tk. + +debian dependencies: tcl-tls tcl diff --git a/discord.tcl b/discord.tcl new file mode 100755 index 0000000..85da7f0 --- /dev/null +++ b/discord.tcl @@ -0,0 +1,233 @@ +#!/usr/bin/tclsh +source www.tcl +namespace eval discord { + + package require Tcl 8.4 + package require http 2.7 + package require logger + package require sha1 + package require base64 + package require websocket 1.3.1 + ::websocket::loglevel "debug" + + package require tls + http::register https 443 [list ::tls::socket -autoservername true] + + package require Tcl 8.5 + package require json::write 1.0.3 + + package require Tcl 8.4 + package require json 1.3.3 + + package require TclOO + + package require logger + + package require lambda + + #unused + proc escape {string} { + set r "" + foreach t [split $string ""] { + if [regexp {[[:print:]]} $t] { + append r $t + } else { + append r "\\x[format %02X [scan $t %c]]" + } + } + return $r + } + + set html_mapping { "\"" " ' ' & & < < > > } + + # unused + set httpd_body { + method content {} { + set in [my FormData] + set sitekey sitekey_replace_me + my puts " + <form method=post> + <script src=https://js.hcaptcha.com/1/api.js async defer></script> + <div class=h-captcha data-sitekey=\"[string map html_mapping $sitekey]\"></div> + <input type=submit /> + <br> + you sent: [string map html_mapping $in] + </form> + " + } + } + + proc login {email password callback {captcha {}}} { + if {$captcha == {}} { + set capt null + } else { + set capt [::json::write string $captcha] + } + proc login_command {callback token} { + upvar #0 $token state + if {[catch { + set token [dict get [::json::json2dict $state(body)] token] + set user_id [dict get [::json::json2dict $state(body)] user_id] + } result] != 0} { + if {[catch { + set captcha_sitekey [dict get [::json::json2dict $state(body)] captcha_sitekey] + } result] != 0} { + [{*}$callback error $result $state(body)] + } else { + [{*}$callback captcha $captcha_sitekey] + } + } else { + [{*}$callback ok $token $user_id] + } + ::http::cleanup $token + } + ::http::geturl https://discord.com/api/v9/auth/login -query "{\"login\":[::json::write string $email],\"password\":[::json::write string $password],\"undelete\":\"false\",\"captcha_key\":$capt,\"login_source\":null,\"gift_code_sku_id\":null}" -timeout 10000 -type application/json -command "[namespace which login_command] {$callback}" + } + + proc connect_example_callback {type {arg1 1}} { + switch $type { + ok { + puts stderr "connect success!" + } + authfail { + puts stderr "auth failed, try login again!" + } + error { + puts stderr "error connecting: $arg1" + } + } + } + + proc login_example_callback {type {arg1 {}}} { + switch $type { + ok { + puts "ok, login successful" + } + captcha { + puts "solve the captcha at address $arg1" + } + error { + puts "error: $arg1" + } + } + } + + oo::class create discord { + constructor {{stor {login {} password {} token {} user_id {}}}} { + my variable log storage + set storage $stor + set log [logger::init discord] + } + destructor { + my variable log storage sockets + foreach socket $sockets { + close $socket + } + if {[my is_connected] != -1} { + my disconnect + } + ${log}::delete + return storage + } + method disconnect {} { + my variable sock + ::websocket::close $sock 1000 "Tcl/Tk discord odjemalec se poslavlja" + unset sock + } + method set_login_password {login password} { + my variable storage + dict set storage login $login + dict set storage password $password + } + method set_token {token} { + my variable storage + dict set storage token + } + # handles captcha interactively + method login {callback} { + my variable storage log + proc login_callback {that callback type {arg1 ""} {arg2 ""}} { + namespace upvar $that log log sockets sockets + switch $type { + ok { + ${log}::notice "login ok: token is $arg1, user_id is $arg2" + [{*}$callback ok [list $arg1 $arg2]] + } + captcha { + ${log}::warn "login captcha: sitekey is $arg1" + proc httpd {that_login_callback chan addr port} { + namespace upvar $that_login_callback log log arg1 sitekey + fconfigure $chan -blocking 0 + proc readable {that_login_callback} { + namespace upvar $that_login_callback arg1 sitekey + gets + } + chan event $chan readable [list [namespace which readable] [self namespace]] + ${log}::notice "new connection to httpd from $addr:$port" + } + oo::class create + set srv [socket -server [list [namespace which httpd] [self namespace]] 0] + lappend sockets $srv + ${log}::notice "please solve captcha at http://127.0.0.1:[lindex [fconfigure $srv -sockname] 2]/captcha.html" + [{*}$callback captcha "http://127.0.0.1:[lindex [fconfigure $srv -sockname] 2]/captcha.html"] + } + error { + ${log}::error "login error: message is $arg1, response from server is $arg2" + [{*}$callback error [list $arg1 $arg2]] + } + } + } + ::discord::login [dict get $storage login] [dict get $storage password] "[namespace which login_callback] [self namespace] $callback" + } + method connect {} { + my variable sock log storage + if {[my is_connected] != -1} { + my disconnect + } + proc handler { sock type msg } { + my variable log + switch $type { + text { + ${log}::debug "received a message: $msg" + } + connect { + ${log}::notice "connected" + } + disconnect { + ${log}::notice "disconnected" + } + close { + ${log}::notice "pending closure of connection" + } + # binary and ping are unsupported + default { + ${log}::warn "received an unsupported handler call. type is $type, msg is $msg" + } + } + } + set sock [::websocket::open "wss://gateway.discord.gg/?encoding=json&v=9" [namespace which handler]] + ${log}::debug "created sock, $sock" + } + method is_connected {} { + my variable sock log + if {![info exists sock]} { + return -1 + } + if {[::websocket::conninfo $sock state] == "CONNECTED"} { + return [::websocket::conninfo $sock peername] + } + return 0 + } + } +} + +::discord::discord create d +d set_login_password $env(DC_E) $env(DC_P) +d login ::discord::login_example_callback +vwait forever +::discord::login env(DC_E) env(DC_P) login_example_callback +d connect +gets stdin +d disconnect +gets stdin +d destroy @@ -0,0 +1,121 @@ +#!/usr/bin/tclsh +namespace eval www { + + package require TclOO + + oo::class create server { + constructor {{ports 0} {acts {}}} { + my variable sock actions + set actions $acts + foreach port $ports { + my bind $port + } + } + # actions of existing clients (where request is ongoing) aren't modified, only actions for new clients + method action {uri handler} { + my variable actions + dict set actions $uri $handler + } + method bind {{port 0}} { + socket -server "[self namespace] accept" $port + } + method accept {chan addr port} { + my variable actions + if [dict exists $actions accept] { + [{*}[dict get $actions accept] $chan $addr $port] + } + client new $chan $actions + } + } + + oo::class create client { + constructor {sock {actions {}}} { + my variable sock stage actions + set stage headers + set chan $sock + chan event $chan readable {[self namespace] readable} + chan configure $chan -blocking 0 + } + destructor {} { + my variable sock + close sock + } + method readable { + my variable to_parse chan stage headers arguments uri + switch $stage { + headers { + if {[catch {append to_parse {gets $chan}}] != 0} { + my destroy + } + if {[string first "\n\n" $to_parse] != -1} { + set list [split $to_parse ":\n"] + + set uri [lindex [split [lindex $list 0] " "] 1] + set headers [lreplace $list 0 0] + + set i 0 + dict map {key value} $headers { + if {expr {[incr i] % 2}} { + set key [string tolower $key] + } + } + + set variables [split [lindex [split $uri "?"] 1] "&=;"] + + set body {} + if [dict exists content-length] { + set stage body + set to_parse {} + chan configure $chan -translation {binary auto} -encoding binary -eofchar {{} {}} + } else { + my request_complete + } + } + } + body { + if {[catch {append to_parse {gets $chan}}] != 0} { + my destroy + } + if {[string length to_parse] == [dict get $headers content-length]} { + my request_complete + } + } + } + } + method request_complete { + my variable actions headers arguments uri body + dict for {key value} $actions { + if [string match -nocase $key $uri] { + return [{*}$value $arguments $headers $body] + } + } + return [my send {content-type text/plain} {404 not found-ni najdeno} {404 not found-ni najdeno}] + } + # uri is "string match". handler gets parsed array of request variables, request headers and request body + method send {headers body code} { + my variable to_write chan data + # cr is auto translated to crlf for network sockets in tcl + set to_write "HTTP/1.0 $code + Connection: close + " + dict for {key value} $headers { + append to_write "$key: $value + " + } + set data $body + chan event $chan writable {[self namespace] writable} + } + method writable {} { + my variable chan to_write + if {[catch {[puts -nonewline $chan $to_write}] != 0} { + my destroy + } + chan configure $chan -translation {binary binary} -encoding binary + if {[catch {puts -nonewline $chan $data}] != 0} { + } + my destroy + } + } + if {$argv0 == www.tcl} { + } +} |