Merge branch 'master' of git://factorcode.org/git/factor into row-polymorphism
Slava Pestov
commit
f6511eb098
|
|
@ -9,23 +9,19 @@ IN: furnace.recaptcha.example
|
|||
|
||||
TUPLE: recaptcha-app < dispatcher recaptcha ;
|
||||
|
||||
: recaptcha-db ( -- obj ) "recaptcha-example" <sqlite-db> ;
|
||||
: recaptcha-db ( -- obj ) "resource:recaptcha-example" <sqlite-db> ;
|
||||
|
||||
: <recaptcha-challenge> ( -- obj )
|
||||
<page-action>
|
||||
[
|
||||
begin-conversation
|
||||
validate-recaptcha
|
||||
recaptcha-valid? cget
|
||||
"?good" "?bad" ? >url <continue-conversation>
|
||||
] >>submit
|
||||
[ validate-recaptcha ] >>validate
|
||||
[ "?good" >url <redirect> ] >>submit
|
||||
{ recaptcha-app "example" } >>template ;
|
||||
|
||||
: <recaptcha-app> ( -- obj )
|
||||
\ recaptcha-app new-dispatcher
|
||||
<recaptcha-challenge> "" add-responder
|
||||
<recaptcha>
|
||||
"concatenative.org" >>domain
|
||||
"6LeJWQgAAAAAAFlYV7SuBClE9uSpGtV_ZS-qVON7" >>public-key
|
||||
"6LeJWQgAAAAAALh-XJgSSQ6xKygRgJ8-029Ip2Xv" >>private-key
|
||||
"concatenative.org" >>domain
|
||||
"6LeJWQgAAAAAAFlYV7SuBClE9uSpGtV_ZS-qVON7" >>public-key
|
||||
"6LeJWQgAAAAAALh-XJgSSQ6xKygRgJ8-029Ip2Xv" >>private-key
|
||||
recaptcha-db <alloy> ;
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
<?xml version='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>
|
||||
|
|
|
|||
|
|
@ -7,43 +7,41 @@ IN: furnace.recaptcha
|
|||
HELP: <recaptcha>
|
||||
{ $values
|
||||
{ "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
|
||||
{ $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?
|
||||
{ $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
|
||||
{ $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"
|
||||
"There are several steps to using the Recaptcha library."
|
||||
"There are several steps to using the recaptcha library."
|
||||
{ $list
|
||||
{ "Wrap the responder in a " { $link <recaptcha> } }
|
||||
{ "Wrap the responder in a " { $link <conversations> } " if it is not already" }
|
||||
{ "Ensure that there is a database connected, with the " { $link <alloy> } " word" }
|
||||
{ "Start a conversation to move values between requests" }
|
||||
{ "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 } }
|
||||
{ "Wrap the responder in an " { $link <alloy> } " if it is not already, to enable conversations and database access" }
|
||||
{ "Call " { $link validate-recaptcha } " from the " { $slot "validate" } " slot of the " { $link action } }
|
||||
{ "Put the chloe tag " { $snippet "<recaptcha/>" } " inside a form tag in the template served by your " { $link action } }
|
||||
}
|
||||
$nl
|
||||
"Run this example vocabulary:"
|
||||
"There is an example web app using recaptcha support:"
|
||||
{ $code
|
||||
"USE: furnace.recaptcha.example"
|
||||
"USING: furnace.recaptcha.example http.server ;"
|
||||
"<recaptcha-app> main-responder set-global"
|
||||
"8080 httpd"
|
||||
} ;
|
||||
|
||||
ARTICLE: "furnace.recaptcha" "Recaptcha"
|
||||
"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
|
||||
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 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> }
|
||||
"Validating recaptcha:"
|
||||
{ $subsections validate-recaptcha }
|
||||
|
|
@ -51,6 +49,9 @@ ARTICLE: "furnace.recaptcha" "Recaptcha"
|
|||
{ $subsections
|
||||
recaptcha-valid?
|
||||
recaptcha-error
|
||||
}
|
||||
"An example:"
|
||||
{ $subsections
|
||||
"recaptcha-example"
|
||||
} ;
|
||||
|
||||
|
|
|
|||
|
|
@ -9,37 +9,37 @@ IN: furnace.recaptcha
|
|||
|
||||
TUPLE: recaptcha < filter-responder domain public-key private-key ;
|
||||
|
||||
SYMBOLS: recaptcha-valid? recaptcha-error ;
|
||||
SYMBOL: recaptcha-error
|
||||
|
||||
: <recaptcha> ( responder -- obj )
|
||||
: <recaptcha> ( responder -- recaptcha )
|
||||
recaptcha new
|
||||
swap >>responder ;
|
||||
|
||||
M: recaptcha call-responder*
|
||||
dup \ recaptcha set
|
||||
dup recaptcha set
|
||||
responder>> call-responder ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: (render-recaptcha) ( private-key -- xml )
|
||||
dup
|
||||
[XML <script type="text/javascript"
|
||||
src=<->>
|
||||
</script>
|
||||
[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] ;
|
||||
<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" ]
|
||||
[ "http://api.recaptcha.net/challenge" ] if
|
||||
"https://api.recaptcha.net/challenge" "http://api.recaptcha.net/challenge" ?
|
||||
recaptcha-error cget [ "?error=" glue ] when* >url ;
|
||||
|
||||
: render-recaptcha ( -- xml )
|
||||
|
|
@ -60,17 +60,23 @@ XML] ;
|
|||
} 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 ( -- )
|
||||
: validate-recaptcha-params ( -- )
|
||||
{
|
||||
{ "recaptcha_challenge_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_response_field" value
|
||||
\ recaptcha get (validate-recaptcha)
|
||||
[ recaptcha-valid? cset ] [ recaptcha-error cset ] bi* ;
|
||||
recaptcha get
|
||||
(validate-recaptcha)
|
||||
recaptcha-error cset
|
||||
[ validation-failed ] unless ;
|
||||
|
|
|
|||
|
|
@ -11,11 +11,7 @@
|
|||
<tr><th class="field-label">Author: </th><td><t:field t:name="author" /></td></tr>
|
||||
<tr><th class="field-label">Mode: </th><td><t:choice t:name="mode" t:choices="modes" /></td></tr>
|
||||
<tr><th class="field-label big-field-label">Body: </th><td><t:textarea t:name="contents" t:rows="20" t:cols="60" /></td></tr>
|
||||
<tr><th class="field-label">Captcha: </th><td><t:field t:name="captcha" /></td></tr>
|
||||
<tr>
|
||||
<td></td>
|
||||
<td>Leave the captcha blank. Spam-bots will fill it indiscriminantly, so their attempts to register will be blocked.</td>
|
||||
</tr>
|
||||
<tr><td colspan="2"><t:recaptcha /></td></tr>
|
||||
</table>
|
||||
|
||||
<p> <button type="submit">Submit</button> </p>
|
||||
|
|
|
|||
|
|
@ -47,11 +47,7 @@
|
|||
<tr><th class="field-label">Author: </th><td><t:field t:name="author" /></td></tr>
|
||||
<tr><th class="field-label">Mode: </th><td><t:choice t:name="mode" t:choices="modes" /></td></tr>
|
||||
<tr><th class="field-label big-field-label">Body: </th><td><t:textarea t:name="contents" t:rows="20" t:cols="60" /></td></tr>
|
||||
<tr><th class="field-label">Captcha: </th><td><t:field t:name="captcha" /></td></tr>
|
||||
<tr>
|
||||
<td></td>
|
||||
<td>Leave the captcha blank. Spam-bots will fill it indiscriminantly, so their attempts to register will be blocked.</td>
|
||||
</tr>
|
||||
<tr><td colspan="2"><t:recaptcha /></td></tr>
|
||||
</table>
|
||||
|
||||
<p> <button type="submit">Done</button> </p>
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
! Copyright (C) 2007, 2008 Slava Pestov
|
||||
! Copyright (C) 2007, 2010 Slava Pestov
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: namespaces assocs sorting sequences kernel accessors
|
||||
hashtables db.types db.tuples db combinators
|
||||
|
|
@ -17,7 +17,9 @@ furnace.redirection
|
|||
furnace.auth
|
||||
furnace.auth.login
|
||||
furnace.boilerplate
|
||||
furnace.syndication ;
|
||||
furnace.recaptcha
|
||||
furnace.syndication
|
||||
furnace.conversations ;
|
||||
IN: webapps.pastebin
|
||||
|
||||
TUPLE: pastebin < dispatcher ;
|
||||
|
|
@ -156,8 +158,8 @@ M: annotation entity-url
|
|||
{ "author" [ v-one-line ] }
|
||||
{ "mode" [ v-mode ] }
|
||||
{ "contents" [ v-required ] }
|
||||
{ "captcha" [ v-captcha ] }
|
||||
} validate-params ;
|
||||
} validate-params
|
||||
validate-recaptcha ;
|
||||
|
||||
: deposit-entity-slots ( tuple -- )
|
||||
now >>date
|
||||
|
|
|
|||
|
|
@ -19,6 +19,7 @@ furnace.auth.features.registration
|
|||
furnace.auth.features.deactivate-user
|
||||
furnace.boilerplate
|
||||
furnace.redirection
|
||||
furnace.recaptcha
|
||||
webapps.pastebin
|
||||
webapps.planet
|
||||
webapps.wiki
|
||||
|
|
@ -54,6 +55,12 @@ TUPLE: factor-website < dispatcher ;
|
|||
allow-edit-profile
|
||||
allow-deactivation ;
|
||||
|
||||
: <factor-recaptcha> ( responder -- responder' )
|
||||
<recaptcha>
|
||||
"concatenative.org" >>domain
|
||||
"6LeJWQgAAAAAAFlYV7SuBClE9uSpGtV_ZS-qVON7" >>public-key
|
||||
"6LeJWQgAAAAAALh-XJgSSQ6xKygRgJ8-029Ip2Xv" >>private-key ;
|
||||
|
||||
: <factor-website> ( -- responder )
|
||||
factor-website new-dispatcher
|
||||
URL" /wiki/view/Front Page" <redirect-responder> "" add-responder ;
|
||||
|
|
@ -77,7 +84,7 @@ SYMBOL: dh-file
|
|||
<factor-website>
|
||||
<wiki> <login-config> <factor-boilerplate> "wiki" add-responder
|
||||
<user-admin> <login-config> <factor-boilerplate> "user-admin" add-responder
|
||||
<pastebin> <login-config> <factor-boilerplate> "pastebin" add-responder
|
||||
<pastebin> <factor-recaptcha> <login-config> <factor-boilerplate> "pastebin" add-responder
|
||||
<planet> <login-config> <factor-boilerplate> "planet" add-responder
|
||||
<mason-app> <login-config> "mason" add-responder
|
||||
"/tmp/docs/" <help-webapp> "docs" add-responder
|
||||
|
|
@ -96,7 +103,7 @@ SYMBOL: dh-file
|
|||
<wiki> "wiki" add-responder
|
||||
<user-admin> "user-admin" add-responder
|
||||
<login-config> <factor-boilerplate> test-db <alloy> "concatenative.org" add-responder
|
||||
<pastebin> <login-config> <factor-boilerplate> test-db <alloy> "paste.factorcode.org" add-responder
|
||||
<pastebin> <factor-recaptcha> <login-config> <factor-boilerplate> test-db <alloy> "paste.factorcode.org" add-responder
|
||||
<planet> <login-config> <factor-boilerplate> test-db <alloy> "planet.factorcode.org" add-responder
|
||||
<mason-app> <login-config> test-db <alloy> "builds.factorcode.org" add-responder
|
||||
home "docs" append-path <help-webapp> "docs.factorcode.org" add-responder
|
||||
|
|
|
|||
Loading…
Reference in New Issue