--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax http.server.filters kernel
+multiline furnace.actions ;
+IN: furnace.chloe-tags.recaptcha
+
+HELP: <recaptcha>
+{ $values
+ { "responder" "a responder" }
+ { "obj" object }
+}
+{ $description "A " { $link filter-responder } " wrapping another responder. Set the domain, public, and private keys using the key you get by registering with Recaptcha." } ;
+
+HELP: recaptcha-error
+{ $var-description "Set to the error string returned by the Recaptcha server." } ;
+
+HELP: recaptcha-valid?
+{ $var-description "Set to " { $link t } " if the user solved the last Recaptcha correctly." } ;
+
+HELP: validate-recaptcha
+{ $description "Validates a Recaptcha using the Recaptcha web service API." } ;
+
+ARTICLE: "recaptcha-example" "Recaptcha example"
+"There are several steps to using the Recaptcha library."
+{ $list
+ { "Wrap the responder in a " { $link <recaptcha> } }
+ { "Add a handler calling " { $link validate-recaptcha } " in the " { $slot "submit" } " of the " { $link page-action } }
+ { "Put the chloe tag " { $snippet "<recaptcha/>" } " in the template for your " { $link action } }
+}
+"An example follows:"
+{ $code
+HEREDOC: RECAPTCHA-TUTORIAL
+TUPLE: recaptcha-app < dispatcher recaptcha ;
+
+: <recaptcha-challenge> ( -- obj )
+ <action>
+ [
+ validate-recaptcha
+ recaptcha-valid? get "?good" "?bad" ? <redirect>
+ ] >>submit
+ [
+ <response>
+{" <?xml version='1.0' ?>
+<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
+<html><body><t:recaptcha/></body></html>
+</t:chloe>"} >>body
+ ] >>display ;
+
+: <recaptcha-app> ( -- obj )
+ \ recaptcha-app new-dispatcher
+ <recaptcha-challenge> "" add-responder
+ <recaptcha>
+ "concatenative.org" >>domain
+ "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" >>public-key
+ "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" >>private-key ;
+
+<recaptcha-app> main-responder set-global
+RECAPTCHA-TUTORIAL
+}
+
+;
+
+ARTICLE: "furnace.chloe-tags.recaptcha" "Recaptcha chloe tag"
+"The " { $vocab-link "furnace.chloe-tags.recaptcha" } " vocabulary implements support for the Recaptcha. Recaptcha is a web service that provides the user with a captcha, a test that is easy to solve by visual inspection, but hard to solve by writing a computer program. Use a captcha to protect forms from abusive users." $nl
+
+"The recaptcha responder is a " { $link filter-responder } " that wraps another responder. Set the " { $slot "domain" } ", " { $slot "public-key" } ", and " { $slot "private-key" } " slots of this responder to your Recaptcha account information." $nl
+
+"Wrapping a responder with Recaptcha:"
+{ $subsection <recaptcha> }
+"Validating recaptcha:"
+{ $subsection validate-recaptcha }
+"Symbols set after validation:"
+{ $subsection recaptcha-valid? }
+{ $subsection recaptcha-error }
+{ $subsection "recaptcha-example" } ;
+
+ABOUT: "furnace.chloe-tags.recaptcha"
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors furnace.actions furnace.redirection html.forms
+html.templates.chloe.compiler html.templates.chloe.syntax
+http.client http.server http.server.filters io.sockets kernel
+locals namespaces sequences splitting urls validators
+xml.syntax ;
+IN: furnace.chloe-tags.recaptcha
+
+TUPLE: recaptcha < filter-responder domain public-key private-key ;
+
+SYMBOLS: recaptcha-valid? recaptcha-error ;
+
+: <recaptcha> ( responder -- obj )
+ recaptcha new
+ swap >>responder ;
+
+M: recaptcha call-responder*
+ dup \ recaptcha set
+ responder>> call-responder ;
+
+<PRIVATE
+
+: (render-recaptcha) ( private-key -- xml )
+ dup
+[XML <script type="text/javascript"
+ src=<->>
+</script>
+
+<noscript>
+ <iframe src=<->
+ height="300" width="500" frameborder="0"></iframe><br/>
+ <textarea name="recaptcha_challenge_field" rows="3" cols="40">
+ </textarea>
+ <input type="hidden" name="recaptcha_response_field"
+ value="manual_challenge"/>
+</noscript>
+XML] ;
+
+: recaptcha-url ( secure? -- ? )
+ [ "https://api.recaptcha.net/challenge" >url ]
+ [ "http://api.recaptcha.net/challenge" >url ] if ;
+
+: render-recaptcha ( -- xml )
+ secure-connection? recaptcha-url
+ recaptcha get public-key>> "k" set-query-param (render-recaptcha) ;
+
+: parse-recaptcha-response ( string -- valid? error )
+ "\n" split first2 [ "true" = ] dip ;
+
+:: (validate-recaptcha) ( challenge response recaptcha -- valid? error )
+ recaptcha private-key>> :> private-key
+ remote-address get host>> :> remote-ip
+ H{
+ { "challenge" challenge }
+ { "response" response }
+ { "privatekey" private-key }
+ { "remoteip" remote-ip }
+ } URL" http://api-verify.recaptcha.net/verify"
+ <post-request> http-request nip parse-recaptcha-response ;
+
+CHLOE: recaptcha
+ drop [ render-recaptcha ] [xml-code] ;
+
+PRIVATE>
+
+: validate-recaptcha ( -- )
+ {
+ { "recaptcha_challenge_field" [ v-required ] }
+ { "recaptcha_response_field" [ v-required ] }
+ } validate-params
+ "recaptcha_challenge_field" value
+ "recaptcha_response_field" value
+ \ recaptcha get (validate-recaptcha)
+ [ recaptcha-valid? set ] [ recaptcha-error set ] bi* ;
projects / factor.git / commitdiff