From 0f935dbb098bf88848b8ac164f4ad4153054572e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Anton=20Luka=20=C5=A0ijanec?= Date: Mon, 8 Aug 2022 01:09:48 +0200 Subject: not working, implemented captcha a bit --- discord.tcl | 74 ++++++++++++++++++++++++++++++++++--------------------------- 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 " -
- -
- -
- you sent: [string map html_mapping $in] -
- " - } - } - 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} "

$argv0 captcha

+

please solve the captcha below in order to login.

+

after solving the captcha, press the button under the captcha for submitting the form.

+

you need to have javascript support for captcha rendering

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

failed to obtain captcha response

+

your browser did not send the captcha response token

+

check that javascript is enabled and that the captcha did not show any errors

+

also make sure that no content blockers are interfering with the captcha rendering that that the captcha was solved successfully (green tick)

+

make a decision

+

<== you can try again by clicking here and going back

+

or press here to free resources of the http server

+" } - 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 diff --git a/www.tcl b/www.tcl index e5cd36f..0e20f7a 100755 --- a/www.tcl +++ b/www.tcl @@ -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] } } -- cgit v1.2.3