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 $
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.
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.
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.
32 (* See note for tarpit_form.ml. *)
45 let tlds = [ "com"; "org"; "net"; "co.uk" ]
47 (* Return n random dictionary words. n should be a small number. *)
49 let dictfile = "/usr/share/dict/words" in
51 let size = (Unix.stat dictfile).Unix.st_size in
52 let chan = open_in dictfile in
54 (* Seek to a random place in the file, then move backwards until
55 * we find a \n character or beginning of file.
59 if r > 0 && input_char chan <> '\n' then loop (r-1)
61 let r = Random.State.int state size in
64 (* Read the next word (= line). *)
65 let word = input_line chan in
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)
74 let n = Random.State.int state 10 in
75 let s = String.create n in
77 s.[i] <- random_char state
81 let rec random_words state = function
83 | n -> random_word state :: random_words state (n-1)
85 let run r (q : cgi) _ hostid _ _ =
87 let ip = Connection.remote_ip (Request.connection r) in
89 (* Make sure the IP address isn't a reserved one. *)
90 if List.exists (String.starts_with ip) reserved then
93 prerr_endline ("tarpit: Block spambot at IP address " ^ ip)
98 let header = "<html><body>\r\n" in
99 q#header ~content_type:"text/html" ();
100 print_string r header;
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
109 (* Feed some random email addresses and links. *)
110 for i = 1 to 100_000 do
111 (match Random.State.int state 3 with
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
117 sprintf "<a href=\"/_bin/tarpit.cmo?t=%d\">%s</a>\n" seed words in
120 (* Generate an email address, but try hard not to make it
121 * a real email address ...
124 match random_words state 4 with
125 | [a;b;c;d] -> a,b,c,d
126 | _ -> assert false in
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
132 sprintf "<a href=\"mailto:%s\">%s</a>\n" email email in
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
139 | _ -> assert false);
141 (* Our aim is also to consume as much of the spambot's time and
144 ignore (Request.rflush r);
145 let r = Random.State.int state 2 in