summaryrefslogblamecommitdiffstats
path: root/discord.tcl
blob: 0548b9b9bdc1b09f28665da633094538a2cf4c58 (plain) (tree)









































                                                                          





                                                                

                                                          
                                    
                                                                                                   




                                                                                                                       






                                                                                                                                                          
                                        
                                                                                          

                                 
                                                                       
                         
                                                   

























                                                                                                                                                                                                                                                                                                                                                               


                                                                                            





                                                   










                                                                                                                      































                                                                                             
                                                      
                                               

                                                                                                 


                                                                                                           
                                                                                  


                                                                                              






















                                                                                                                                                                                                                    
                                                         




                                                                                                                                                                                                    
                                                                                                                               





                                                                                                                                                                         
                                                 

                                                                                                                                                                                                                                                                                                   




                                                                                                                                                


                                                                                                                            
                                                                                     


                                         
                                                                                                                                                            









































                                                                                                                               













                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               
#!/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; }

	proc login {email password callback {captcha {}}} {
		if {$captcha == {}} {
			set capt null
		} else {
			set capt [::json::write string $captcha]
		}
		proc login_command {callback http_token} {
			upvar #0 $http_token state
			if {[catch {
				set discord_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} {
					if {[catch {
						set message [dict get [lindex [dict get [::json::json2dict $state(body)] errors login _errors] 0] message]
					} result] != 0} {
						{*}$callback error $result $state(body)
					} else {
						{*}$callback error_message $message $state(body)
					}
				} else {
					{*}$callback captcha $captcha_sitekey $state(body)
				}
			} else {
				{*}$callback ok $discord_token $user_id
			}
			::http::cleanup $http_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_message {
				puts "the server sent a human-readable error message: $arg1"
			}
			error {
				puts "error: $arg1"
			}
		}
	}

	# links sent in mail are click.discord.com links, I couldn't reverse engineer the upn param
	proc authorize_ip {click_url callback} {
		proc authorize_ip_command {callback http_token} {
			upvar #0 $http_token state
			puts $state(body)
			puts $state(meta)
		}
		puts $click_url
		::http::geturl $click_url -timeout 10000 -command "[namespace which authorize_ip_command] {$callback}"
	}

	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 {captcha {}}} {
			my variable storage log
			proc login_callback {self_discordobj callback type {arg1 ""} {arg2 ""}} {
				my variable 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 captcha.html {sitekey client path arguments headers body uri} {
							global argv0
							$client send {200 ok} {content-type text/html} "<h1><code>$argv0</code> captcha</h1>
							<p>please solve the captcha below in order to login.</p>
							<p>after solving the captcha, press the button under the captcha for submitting the form.</p>
							<p>you need to have javascript support for captcha rendering</p>
							<form method=post action=submit>
								<script src=https://js.hcaptcha.com/1/api.js async defer></script>
								<div class=h-captcha data-sitekey='[string map $::discord::html_mapping $sitekey]'></div>
								<input type=submit />
							</form>
"
						}
						proc submit {discordobj callback server client path arguments headers body uri} {
							if {![dict exists $arguments h-captcha-response]} {
								return $client send {400 bad request} {content-type text/html} "<h1>failed to obtain captcha response</h1>
								<p>your browser did not send the captcha response token</p>
								<p>check that javascript is enabled and that the captcha did not show any errors</p>
								<p>also make sure that no content blockers are interfering with the captcha rendering that that the captcha was solved successfully (green tick)</p>
								<h2>make a decision</h2>
								<p><a href=/captcha.html>&lt;== you can try again by clicking here and going back</a></p>
								<p><a href=/stop.txt>or press here to free resources of the http server</a></p>
"
							}
							global argv0
							$client send {200 ok} {content-type text/plain} "captcha token received. please close this browser tab and proceed to the $argv0 application
"
							# this keeps the client object alive
							$server destroy
							{*}$discordobj login $callback [dict get $arguments h-captcha-response]
						}
						proc stop.txt {server client path arguments headers body uri} {
							# server destroy does not destroy clients
							$server destroy
							$client send {200 ok} {content-type text/plain} "http server resources were freed. please close this browser tab.
"
						}
						::www::server create s 0 [list /captcha.html [list [namespace which captcha.html] $arg1] /submit [list [namespace which submit] $self_discordobj $callback [namespace current]::s] /stop.txt [list [namespace which stop.txt] [namespace which s]]]
						${log}::notice "please solve captcha at http://127.0.0.1:[s ports]/captcha.html"
						{*}$callback captcha "http://127.0.0.1:[s ports]/captcha.html"
					}
					error_message {
						${log}::error "server sent a human-readable error message: $arg1, response from server is $arg2"
						{*}$callback error_message $arg1
					}
					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] $callback" $captcha
		}
		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
		}
	}
}
if [string match *discord.tcl* $argv0] {
	::discord::authorize_ip https://click.discord.com/ls/click?upn=qDOo8cnwIoKzt0aLL1cBeJWc43CAiLlKYSQGUErhKV7fF2lroxEuEaMS14HcVQRWKEsXxCWfVqMYFnAqiyFKlyc60qLVSfrR2BpIhn60wAL4y7X8dEY5UhD7n-2BEIulILGfHWzhi03YqYAqwN1dzNDsL7BrPVj5dWSRz43qNCKZs2Mre7Chd4IbpPox9Y-2F4ktYY4N_PdlvdP47mdorwIWlvGoY-2Fnv9MARx98jl0olgQff-2FSKZtFfa9W0dHpN7isUf-2BBQiGTEplWgkKV5AWO17KWsssOLh7AWnsZoy5YvVHlKWck92RQ5vrqN5LMcYUfucbVfjTrOdjPoOJLpa-2F6uIpp4HgFjgpPQjxA-2B3Mm9UmJJTSAUKfWdzMYiWkDqft72DZnIyAHKkjDaEO8wSn3CcCTqm-2FzMMTi-2BVKGxWIQb2p-2F6LNSxtos3YXgYUOtHh5pLu6WeUIvmdhDYWgvG9534NpmGXELQ-3D-3D {}
	vwait forever
	::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
}