diff options
| -rwxr-xr-x | discord.tcl | 74 | ||||
| -rwxr-xr-x | www.tcl | 4 |
2 files changed, 43 insertions, 35 deletions
diff --git a/discord.tcl b/discord.tcl index 85da7f0..e664a2c 100755 --- a/discord.tcl +++ b/discord.tcl @@ -40,23 +40,6 @@ namespace eval discord { 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 @@ -144,9 +127,9 @@ namespace eval discord { dict set storage token } # handles captcha interactively - method login {callback} { + method login {callback {captcha {}}} { my variable storage log - proc login_callback {that callback type {arg1 ""} {arg2 ""}} { + proc login_callback {self_discordobj that callback type {arg1 ""} {arg2 ""}} { namespace upvar $that log log sockets sockets switch $type { ok { @@ -155,21 +138,46 @@ namespace eval discord { } 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 + 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><== 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> +" } - chan event $chan readable [list [namespace which readable] [self namespace]] - ${log}::notice "new connection to httpd from $addr:$port" + 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. +" } - 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"] + ::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 { ${log}::error "login error: message is $arg1, response from server is $arg2" @@ -177,7 +185,7 @@ namespace eval discord { } } } - ::discord::login [dict get $storage login] [dict get $storage password] "[namespace which login_callback] [self namespace] $callback" + ::discord::login [dict get $storage login] [dict get $storage password] "[namespace which login_callback] [self] [self namespace] $callback" $captcha } method connect {} { my variable sock log storage @@ -103,7 +103,7 @@ namespace eval www { my destroy } if {[string length $to_parse] == [dict get $headers content-length]} { - lappend arguments {*}[split $to_parse "%=;"] + lappend arguments {*}[split $to_parse "&=;"] set body $to_parse set stage read my request_complete @@ -117,7 +117,7 @@ namespace eval www { method request_complete {} { my variable actions headers arguments uri body path dict for {key value} $actions { - if [string match -nocase $key $uri] { + if [string match -nocase $key $path] { return [{*}$value [self] $path $arguments $headers $body $uri] } } |