basis/furnace/recaptcha/recaptcha.factor

   1 ! Copyright (C) 2009 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors furnace.actions furnace.redirection html.forms
   4 html.templates.chloe.compiler html.templates.chloe.syntax
   5 http.client http.server http.server.filters io.sockets kernel
   6 locals namespaces sequences splitting urls validators
   7 xml.syntax furnace.conversations ;
   8 IN: furnace.recaptcha
   9
  10 TUPLE: recaptcha < filter-responder domain public-key private-key ;
  11
  12 SYMBOL: recaptcha-error
  13
  14 : <recaptcha> ( responder -- recaptcha )
  15     recaptcha new
  16         swap >>responder ;
  17
  18 M: recaptcha call-responder*
  19     dup recaptcha set
  20     responder>> call-responder ;
  21
  22 <PRIVATE
  23
  24 : (render-recaptcha) ( url -- xml )
  25     dup
  26     [XML
  27         <script type="text/javascript"
  28            src=<->>
  29         </script>
  30
  31         <noscript>
  32            <iframe src=<->
  33                height="300" width="500" frameborder="0"></iframe><br/>
  34            <textarea name="recaptcha_challenge_field" rows="3" cols="40">
  35            </textarea>
  36            <input type="hidden" name="recaptcha_response_field"
  37                value="manual_challenge"/>
  38         </noscript>
  39     XML] ;
  40
  41 : recaptcha-url ( secure? -- ? )
  42     "https" "http" ? "://www.google.com/recaptcha/api/challenge" append
  43     recaptcha-error cget [ "?error=" glue ] when* >url ;
  44
  45 : render-recaptcha ( -- xml )
  46     secure-connection? recaptcha-url
  47     recaptcha get public-key>> "k" set-query-param (render-recaptcha) ;
  48
  49 : parse-recaptcha-response ( string -- valid? error )
  50     "\n" split first2 [ "true" = ] dip ;
  51
  52 :: (validate-recaptcha) ( challenge response recaptcha -- valid? error )
  53     recaptcha private-key>> :> private-key
  54     remote-address get host>> :> remote-ip
  55     H{
  56         { "challenge" challenge }
  57         { "response" response }
  58         { "privatekey" private-key }
  59         { "remoteip" remote-ip }
  60     } URL" http://api-verify.recaptcha.net/verify"
  61     http-post nip parse-recaptcha-response ;
  62
  63 : validate-recaptcha-params ( -- )
  64     {
  65         { "recaptcha_challenge_field" [ v-required ] }
  66         { "recaptcha_response_field" [ v-required ] }
  67     } validate-params ;
  68
  69 PRIVATE>
  70
  71 CHLOE: recaptcha drop [ render-recaptcha ] [xml-code] ;
  72
  73 : validate-recaptcha ( -- )
  74     begin-conversation
  75     validate-recaptcha-params
  76
  77     "recaptcha_challenge_field" value
  78     "recaptcha_response_field" value
  79     recaptcha get
  80     (validate-recaptcha)
  81     recaptcha-error cset
  82     [ validation-failed ] unless ;