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} {
+	}
+}