From 0c3062c18aedb80664147bfe0fa33b7c1b0b3c7b Mon Sep 17 00:00:00 2001
From: Asumu Takikawa <asumu@ccs.neu.edu>
Date: Wed, 16 Sep 2015 17:08:45 -0400
Subject: [PATCH] Add some more spam detection

---
 pasterack.rkt |  7 +++++--
 spam.rkt      | 30 ++++++++++++++++++++++++++++++
 2 files changed, 35 insertions(+), 2 deletions(-)
 create mode 100644 spam.rkt

diff --git a/pasterack.rkt b/pasterack.rkt
index 36b807d..65ce69f 100644
--- a/pasterack.rkt
+++ b/pasterack.rkt
@@ -2,7 +2,8 @@
 
 (require web-server/servlet web-server/dispatch
          web-server/http/request-structs)
-(require xml xml/path net/url net/uri-codec json "recaptcha.rkt")
+(require xml xml/path net/url net/uri-codec json "recaptcha.rkt"
+         "spam.rkt")
 (require racket/system racket/runtime-path)
 (require redis data/ring-buffer)
 (require "pasterack-utils.rkt" "pasterack-parsing-utils.rkt"
@@ -441,7 +442,9 @@
       #:headers '("Content-Type: application/x-www-form-urlencoded")))
   (define as-text? (hash-ref (read-json captcha-success-in) 'success #f))
   ;; very basic spam filter TODO: move check to client-side?
-  (if (and (not as-text?) ; probably spam
+  (if (and ;; probably spam
+           (or (not as-text?)
+               (check-ip (request-client-ip request)))
            (not (has-hashlang? paste-content)))
       (serve-home request 
                   #:title name
diff --git a/spam.rkt b/spam.rkt
new file mode 100644
index 0000000..428670d
--- /dev/null
+++ b/spam.rkt
@@ -0,0 +1,30 @@
+#lang racket/base
+
+;; Rudimentary spam detection
+
+(require racket/contract
+         racket/port
+         memoize
+         net/http-client
+         xml
+         xml/path)
+
+(provide (contract-out [check-ip (-> string? any)]))
+
+(define blacklist-host "api.stopforumspam.org")
+
+;; Returns #f if the lookup failed, if the response is malformed, or
+;; if the IP doesn't appear. Return #t if the IP does appear.
+;;
+;; The result is memoized to avoid querying the server too often.
+(define/memo (check-ip ip)
+  (define-values (status headers contents)
+    (http-sendrecv blacklist-host
+                   (format "/api?ip=~a" ip)))
+  (cond ;; only accept 200 OK
+        [(regexp-match #"200 OK" status)
+         (define response
+           (string->xexpr (port->string contents)))
+         (and response
+              (equal? "yes" (se-path* '(response appears) response)))]
+        [else #f]))