steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

furnace.recaptcha: make it easier to use

db4
Slava Pestov 2010-03-11 21:02:39 +13:00
parent 0d0f1a92a8
commit fd767b7d31
5 changed files with 43 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
basis/furnace/recaptcha/example/example.factor
View File

@ -13,19 +13,15 @@ TUPLE: recaptcha-app < dispatcher recaptcha ;
: <recaptcha-challenge> ( -- obj ) : <recaptcha-challenge> ( -- obj )
<page-action> <page-action>
[ [ validate-recaptcha ] >>validate
begin-conversation [ "?good" >url <redirect> ] >>submit
validate-recaptcha
recaptcha-valid? cget
"?good" "?bad" ? >url <continue-conversation>
] >>submit
{ recaptcha-app "example" } >>template ; { recaptcha-app "example" } >>template ;
: <recaptcha-app> ( -- obj ) : <recaptcha-app> ( -- obj )
\ recaptcha-app new-dispatcher \ recaptcha-app new-dispatcher
<recaptcha-challenge> "" add-responder <recaptcha-challenge> "" add-responder
<recaptcha> <recaptcha>
"concatenative.org" >>domain "concatenative.org" >>domain
"6LeJWQgAAAAAAFlYV7SuBClE9uSpGtV_ZS-qVON7" >>public-key "6LeJWQgAAAAAAFlYV7SuBClE9uSpGtV_ZS-qVON7" >>public-key
"6LeJWQgAAAAAALh-XJgSSQ6xKygRgJ8-029Ip2Xv" >>private-key "6LeJWQgAAAAAALh-XJgSSQ6xKygRgJ8-029Ip2Xv" >>private-key
recaptcha-db <alloy> ; recaptcha-db <alloy> ;

2
basis/furnace/recaptcha/example/example.xml
View File

@ -1,4 +1,4 @@
<?xml version='1.0' ?> <?xml version='1.0' ?>
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0"> <t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
<html><body><form submit="" method="post"><t:recaptcha/></form></body></html> <html><body><t:form t:action=""><t:recaptcha/></t:form></body></html>
</t:chloe> </t:chloe>

37
basis/furnace/recaptcha/recaptcha-docs.factor
View File

@ -7,43 +7,41 @@ IN: furnace.recaptcha
HELP: <recaptcha> HELP: <recaptcha>
{ $values { $values
{ "responder" "a responder" } { "responder" "a responder" }
{ "obj" object } { "recaptcha" recaptcha }
} }
{ $description "A " { $link filter-responder } " wrapping another responder. Set the domain, public, and private keys using the key you get by registering with Recaptcha." } ; { $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 HELP: recaptcha-error
{ $var-description "Set to the error string returned by the Recaptcha server." } ; { $var-description "Set to the error string returned by the recaptcha server." } ;
HELP: recaptcha-valid? HELP: recaptcha-valid?
{ $var-description "Set to " { $link t } " if the user solved the last Recaptcha correctly." } ; { $var-description "Set to " { $link t } " if the user solved the last recaptcha correctly." } ;
HELP: validate-recaptcha HELP: validate-recaptcha
{ $description "Validates a Recaptcha using the Recaptcha web service API." } ; { $description "Validates a recaptcha using the recaptcha web service API." } ;
ARTICLE: "recaptcha-example" "Recaptcha example" ARTICLE: "recaptcha-example" "Recaptcha example"
"There are several steps to using the Recaptcha library." "There are several steps to using the recaptcha library."
{ $list { $list
{ "Wrap the responder in a " { $link <recaptcha> } } { "Wrap the responder in a " { $link <recaptcha> } }
{ "Wrap the responder in a " { $link <conversations> } " if it is not already" } { "Wrap the responder in an " { $link <alloy> } " if it is not already, to enable conversations and database access" }
{ "Ensure that there is a database connected, with the " { $link <alloy> } " word" } { "Call " { $link validate-recaptcha } " from the " { $slot "validate" } " slot of the " { $link action } }
{ "Start a conversation with " { $link begin-conversation } " to move values between requests" } { "Put the chloe tag " { $snippet "<recaptcha/>" } " inside a form tag in the template served by your " { $link action } }
{ "Add a handler calling " { $link validate-recaptcha } " in the " { $slot "submit" } " of the " { $link page-action } }
{ "Pass the conversation from your submit action using " { $link <continue-conversation> } }
{ "Put the chloe tag " { $snippet "<recaptcha/>" } " inside a form tag in the template for your " { $link page-action } }
} }
$nl $nl
"Run this example vocabulary:" "There is an example web app using recaptcha support:"
{ $code { $code
"USE: furnace.recaptcha.example" "USING: furnace.recaptcha.example http.server ;"
"<recaptcha-app> main-responder set-global" "<recaptcha-app> main-responder set-global"
"8080 httpd"
} ; } ;
ARTICLE: "furnace.recaptcha" "Recaptcha" ARTICLE: "furnace.recaptcha" "Recaptcha support for Furnace"
"The " { $vocab-link "furnace.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 " { $vocab-link "furnace.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 "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:" "Wrapping a responder with recaptcha support:"
{ $subsections <recaptcha> } { $subsections <recaptcha> }
"Validating recaptcha:" "Validating recaptcha:"
{ $subsections validate-recaptcha } { $subsections validate-recaptcha }
@ -51,6 +49,9 @@ ARTICLE: "furnace.recaptcha" "Recaptcha"
{ $subsections { $subsections
recaptcha-valid? recaptcha-valid?
recaptcha-error recaptcha-error
}
"An example:"
{ $subsections
"recaptcha-example" "recaptcha-example"
} ; } ;

28
basis/furnace/recaptcha/recaptcha.factor
View File

@ -11,12 +11,12 @@ TUPLE: recaptcha < filter-responder domain public-key private-key ;
SYMBOLS: recaptcha-valid? recaptcha-error ; SYMBOLS: recaptcha-valid? recaptcha-error ;
: <recaptcha> ( responder -- obj ) : <recaptcha> ( responder -- recaptcha )
recaptcha new recaptcha new
swap >>responder ; swap >>responder ;
M: recaptcha call-responder* M: recaptcha call-responder*
dup \ recaptcha set dup recaptcha set
responder>> call-responder ; responder>> call-responder ;
<PRIVATE <PRIVATE
@ -60,17 +60,23 @@ M: recaptcha call-responder*
} URL" http://api-verify.recaptcha.net/verify" } URL" http://api-verify.recaptcha.net/verify"
<post-request> http-request nip parse-recaptcha-response ; <post-request> http-request nip parse-recaptcha-response ;
CHLOE: recaptcha : validate-recaptcha-params ( -- )
drop [ render-recaptcha ] [xml-code] ;
PRIVATE>
: validate-recaptcha ( -- )
{ {
{ "recaptcha_challenge_field" [ v-required ] } { "recaptcha_challenge_field" [ v-required ] }
{ "recaptcha_response_field" [ v-required ] } { "recaptcha_response_field" [ v-required ] }
} validate-params } validate-params ;
PRIVATE>
CHLOE: recaptcha drop [ render-recaptcha ] [xml-code] ;
: validate-recaptcha ( -- )
begin-conversation
validate-recaptcha-params
"recaptcha_challenge_field" value "recaptcha_challenge_field" value
"recaptcha_response_field" value "recaptcha_response_field" value
\ recaptcha get (validate-recaptcha) recaptcha get
[ recaptcha-valid? cset ] [ recaptcha-error cset ] bi* ; (validate-recaptcha)
recaptcha-error cset
[ validation-failed ] unless ;

5
extra/webapps/pastebin/pastebin.factor
View File

@ -159,10 +159,7 @@ M: annotation entity-url
{ "mode" [ v-mode ] } { "mode" [ v-mode ] }
{ "contents" [ v-required ] } { "contents" [ v-required ] }
} validate-params } validate-params
validate-recaptcha ;
begin-conversation
validate-recaptcha
recaptcha-valid? cget [ validation-failed ] unless ;
: deposit-entity-slots ( tuple -- ) : deposit-entity-slots ( tuple -- )
now >>date now >>date