spamchampuru.scm

gistfile1.scm

;; Copyright (c) Iwata <iwata@quasiquote.org>
;;
;; Permission is hereby granted, free of charge, to any person obtaining
;; a copy of this software and associated documentation files (the
;; "Software"), to deal in the Software without restriction, including
;; without limitation the rights to use, copy, modify, merge, publish,
;; distribute, sublicense, and/or sell copies of the Software, and to
;; permit persons to whom the Software is furnished to do so, subject to
;; the following conditions:
;;
;; The above copyright notice and this permission notice shall be included
;; in all copies or substantial portions of the Software.
;;
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

;;
;; antispam ip filter using "spam-champuru DNSBL" service
;;  http://spam-champuru.livedoor.com/dnsbl/
;;

(declare
 (unit spam-champuru)
 (export
  spam-champuru?))

(use srfi-1 srfi-26 dns)

(define-constant champuru-server "dnsbl.spam-champuru.livedoor.com")

(define (spam-champuru? target #!key (resolver "localhost"))
  (let* ((ips (filter-map
               (lambda (r)
                 (or (and (= 1 (length r))
                          target)
                     (and (eq? (list-ref r 1) 'A)
                          (list-ref r 2))))
               (dns:resolve resolver target 'recurse?)))
         (query (map (lambda (r)
                       (string-intersperse
                        (reverse (string-split r "."))
                        "."))
                     ips)))
    (any (lambda (q)
            (let ((r (car (dns:resolve resolver
                                       (string-append q "." champuru-server)))))
              (and (= 3 (length r))
                   (string=? "127.0.0.2" (list-ref r 2)))))
          query)))

;; (print (spam-champuru? "192.0.2.1")) => #t
;; (print (spam-champuru? "127.0.0.1")) => #f