summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--README3
-rwxr-xr-xdiscord.tcl233
-rwxr-xr-xwww.tcl121
3 files changed, 357 insertions, 0 deletions
diff --git a/README b/README
new file mode 100644
index 0000000..7a7251a
--- /dev/null
+++ b/README
@@ -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 { "\"" &quot; ' &apos; & &amp; < &lt; > &gt; }
+
+ # 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
diff --git a/www.tcl b/www.tcl
new file mode 100755
index 0000000..e057844
--- /dev/null
+++ b/www.tcl
@@ -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} {
+ }
+}