From 11eed1fbc8e7a97f81d6e1d706978db7050df75d Mon Sep 17 00:00:00 2001
From: Andy Wingo
Date: Tue, 11 Mar 2008 23:58:12 +0100
Subject: spam spam spam

* tekuti/comment.scm (bad-number?, *new-comment-spec*):
* tekuti/page-helpers.scm (comment-form): Lame spam obfuscation.

* tekuti/util.scm (emailish?): Allow _ in the before-@ part of the url.
  (urlish?): Don't require a slash after the host.

---
 tekuti/comment.scm      | 7 +++++++
 tekuti/page-helpers.scm | 3 +++
 tekuti/util.scm         | 4 ++--
 3 files changed, 12 insertions(+), 2 deletions(-)

diff --git a/tekuti/comment.scm b/tekuti/comment.scm
index f177082..fbcff6b 100644
--- a/tekuti/comment.scm
+++ b/tekuti/comment.scm
@@ -92,11 +92,18 @@
       #f
       `(p "Bad URL. (Only http and https are allowed.)")))
 
+(define (bad-number? x)
+  (if (string->number x)
+      #f
+      '(p "Bad number. Give me something that Scheme's "
+          (tt "string->number") " will like.")))
+
 (define *new-comment-spec*
   `(("author" ,(lambda (x) #f))
     ("email" ,bad-email?)
     ("url" ,bad-url?)
     ("comment" ,bad-user-submitted-xhtml?)
+    ("x" ,bad-number?)
     ("submit" ,(lambda (x) #f))))
 
 (define (bad-new-comment-post? post-data)
diff --git a/tekuti/page-helpers.scm b/tekuti/page-helpers.scm
index bb998d0..b82f0ad 100644
--- a/tekuti/page-helpers.scm
+++ b/tekuti/page-helpers.scm
@@ -120,6 +120,9 @@
     (p (input (@ (type "text") (name "url") (value ,url)
                  (size "22") (tabindex "3")))
        " " (label (@ (for "url")) (small "Website")))
+    (p (input (@ (type "text") (name "x") (value "")
+                 (size "22") (tabindex "3")))
+       " " (label (@ (for "x")) (small "What's your favorite number?")))
     ;(p (small "allowed tags: "))
     (p (textarea (@ (name "comment") (id "comment") (cols "65")
                     (rows "10") (tabindex "4"))
diff --git a/tekuti/util.scm b/tekuti/util.scm
index 81a4d0b..dcef7a2 100644
--- a/tekuti/util.scm
+++ b/tekuti/util.scm
@@ -39,13 +39,13 @@
             list-intersperse with-backtrace with-time-debugging define-memoized))
 
 (define (emailish? x)
-  (match-bind "^([a-zA-Z0-9.+-]+)@([a-zA-Z0-9-]+\\.)+[a-zA-Z]+$"
+  (match-bind "^([a-zA-Z0-9._+-]+)@([a-zA-Z0-9-]+\\.)+[a-zA-Z]+$"
               x (_ . args)
               x
               #f))
 
 (define (urlish? x)
-  (match-bind "^https?://([a-zA-Z0-9-]+\\.)+[a-zA-Z]+/[a-zA-Z0-9$_.+!*'(),;/?:@&=-]*$"
+  (match-bind "^https?://([a-zA-Z0-9-]+\\.)+[a-zA-Z]+(/[a-zA-Z0-9$_.+!*'(),;/?:@&=-]*)?$"
               x (_ . args)
               x
               #f))
-- 
cgit v1.2.3-54-g00ecf