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 { "\"" &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
@@ -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>&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>
+"
 							}
-							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]
 				}
 			}