scripts/tarpit.ml

   1 (* COCANWIKI - a wiki written in Objective CAML.
   2  * Written by Richard W.M. Jones <rich@merjis.com>.
   3  * Copyright (C) 2004 Merjis Ltd.
   4  * $Id: tarpit.ml,v 1.1 2006/08/09 15:35:47 rich Exp $
   5  *
   6  * This program is free software; you can redistribute it and/or modify
   7  * it under the terms of the GNU General Public License as published by
   8  * the Free Software Foundation; either version 2 of the License, or
   9  * (at your option) any later version.
  10  *
  11  * This program is distributed in the hope that it will be useful,
  12  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  13  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14  * GNU General Public License for more details.
  15  *
  16  * You should have received a copy of the GNU General Public License
  17  * along with this program; see the file COPYING.  If not, write to
  18  * the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  19  * Boston, MA 02111-1307, USA.
  20  *)
  21
  22 open Apache
  23 open Registry
  24 open Cgi
  25 open Printf
  26
  27 open ExtString
  28 open ExtList
  29
  30 open Cocanwiki
  31
  32 (* See note for tarpit_form.ml. *)
  33
  34 let reserved = [
  35   "0.";
  36   "10.";
  37   "127.";
  38   "169.254.";
  39   "172.16."; (* XXX *)
  40   "192.0.2.";
  41   "192.168.";
  42   "224."; (* XXX *)
  43 ]
  44
  45 let tlds = [ "com"; "org"; "net"; "co.uk" ]
  46
  47 (* Return n random dictionary words.  n should be a small number. *)
  48 let random_word =
  49   let dictfile = "/usr/share/dict/words" in
  50   try
  51     let size = (Unix.stat dictfile).Unix.st_size in
  52     let chan = open_in dictfile in
  53     fun state ->
  54       (* Seek to a random place in the file, then move backwards until
  55        * we find a \n character or beginning of file.
  56        *)
  57       let rec loop r =
  58         seek_in chan r;
  59         if r > 0 && input_char chan <> '\n' then loop (r-1)
  60       in
  61       let r = Random.State.int state size in
  62       loop r;
  63
  64       (* Read the next word (= line). *)
  65       let word = input_line chan in
  66       word
  67   with
  68     Unix.Unix_error _ | Sys_error _ ->
  69       (* No dictionary file found, so return some random strings. *)
  70       let random_char state =
  71         Char.chr (Char.code 'a' + Random.State.int state 26)
  72       in
  73       fun state ->
  74         let n = Random.State.int state 10 in
  75         let s = String.create n in
  76         for i = 0 to n-1 do
  77           s.[i] <- random_char state
  78         done;
  79         s
  80
  81 let rec random_words state = function
  82   | n when n <= 0 -> []
  83   | n -> random_word state :: random_words state (n-1)
  84
  85 let run r (q : cgi) _ hostid _ _ =
  86   (try
  87      let ip = Connection.remote_ip (Request.connection r) in
  88
  89      (* Make sure the IP address isn't a reserved one. *)
  90      if List.exists (String.starts_with ip) reserved then
  91        raise Not_found;
  92
  93      prerr_endline ("tarpit: Block spambot at IP address " ^ ip)
  94    with Not_found -> ()
  95   );
  96
  97   (* Print a header. *)
  98   let header = "<html><body>\r\n" in
  99   q#header ~content_type:"text/html" ();
 100   print_string r header;
 101
 102   let seed = q#param_all "t" in
 103   let seed = List.take 10 seed in
 104   let seed = List.map int_of_string seed in
 105   let seed = if seed = [] then [0] else seed in
 106   let seed = Array.of_list seed in
 107   let state = Random.State.make seed in
 108
 109   (* Feed some random email addresses and links. *)
 110   for i = 1 to 100_000 do
 111     (match Random.State.int state 3 with
 112      | 0 ->
 113          let i = 1 + Random.State.int state 10 in
 114          let words = String.concat " " (random_words state i) in
 115          let seed = Random.State.int state 999_999_999 in
 116          let link =
 117            sprintf "<a href=\"/_bin/tarpit.cmo?t=%d\">%s</a>\n" seed words in
 118          print_string r link
 119      | 1 ->
 120          (* Generate an email address, but try hard not to make it
 121           * a real email address ...
 122           *)
 123          let w1,w2,w3,w4 =
 124            match random_words state 4 with
 125            | [a;b;c;d] -> a,b,c,d
 126            | _ -> assert false in
 127          let tld =
 128            List.nth tlds (Random.State.int state (List.length tlds-1)) in
 129          let i = Random.State.int state 2000 in
 130          let email = sprintf "%s%s%d@%s%s.%s" w1 w2 i w3 w4 tld in
 131          let link =
 132            sprintf "<a href=\"mailto:%s\">%s</a>\n" email email in
 133          print_string r link
 134      | 2 ->
 135          let i = 1 + Random.State.int state 10 in
 136          let words = String.concat " " (random_words state i) in
 137          let words = words ^ "\n" in
 138          print_string r words
 139      | _ -> assert false);
 140
 141     (* Our aim is also to consume as much of the spambot's time and
 142      * resources.
 143      *)
 144     ignore (Request.rflush r);
 145     let r = Random.State.int state 2 in
 146     Unix.sleep r
 147   done
 148
 149 let () =
 150   register_script run