dcc/dcc.ml

   1 open Unix
   2
   3 let usage prefix progname =
   4   String.concat "\n"
   5     (List.map (fun x -> (Printf.sprintf "%s: %s %s" prefix progname x))
   6        [ "send <port> <filename>";
   7          "receive <host> <port> <size> <filename>";
   8          "chat listen <port>";
   9          "chat connect <host> <port>" ])
  10
  11 let buff = String.create 1024
  12
  13 let print_exc exc =
  14   match exc with
  15     Unix_error (err, fun_name, arg) ->
  16       prerr_string "\"";
  17       prerr_string fun_name;
  18       prerr_string "\" failed";
  19       if String.length arg > 0 then
  20         begin
  21           prerr_string " on \""; prerr_string arg; prerr_string "\""; ()
  22         end;
  23       prerr_string ": ";
  24       prerr_endline (error_message err);
  25       flush Pervasives.stderr; ()
  26   | _ ->
  27       try Printexc.print raise exc with
  28         _ -> ()
  29
  30 let accept_connection f s =
  31   let (t, addr) = accept s in
  32   f t; close t; ()
  33
  34 let write_file filename size t =
  35   let fd =
  36     try openfile filename [ O_RDONLY ] 0 with
  37       _ -> Printf.eprintf "Open failed.\n"; flush Pervasives.stderr; exit 1
  38   in
  39   let (len, rlen) = ref 0, ref 0 in
  40   while len := read fd buff 0 (String.length buff); !len <> 0
  41   do
  42     let rec loop i =
  43       let j = i + write t buff i (!len - i) in
  44       if j == !len then () else loop j
  45     in
  46     loop 0;
  47     flush (out_channel_of_descr t);
  48     rlen := !rlen + !len;
  49     Printf.printf "DCC %s %d%% (%d/%d bytes) sent.\n"
  50       filename (100 * !rlen / size) !rlen size;
  51     flush Pervasives.stdout
  52   done;
  53   close fd; close t; ()
  54
  55 let send_file port filename =
  56   try
  57     let host = gethostbyname (gethostname ()) in
  58     let haddr = string_of_inet_addr host.h_addr_list.(0) in
  59     let s = socket PF_INET SOCK_STREAM 0 in
  60     setsockopt s SO_REUSEADDR true;
  61     bind s (ADDR_INET (inet_addr_any, port));
  62     let port =
  63       match (getsockname s) with
  64         ADDR_INET (addr, port) -> port
  65       | _ -> port
  66     in
  67     listen s 1;
  68     let fd =
  69       try openfile filename [ O_RDONLY ] 0 with
  70         _ -> Printf.eprintf "Open failed.\n"; flush Pervasives.stderr; exit 1
  71     in
  72     let size = (fstat fd).st_size in
  73     let hl = (Hostlong.of_address_string haddr) in
  74     close fd;
  75     Printf.printf "DCC send %s %d %s %d\n"
  76       (Filename.basename filename) port (Hostlong.to_string hl) size;
  77     flush Pervasives.stdout;
  78     accept_connection (fun t -> write_file filename size t) s;
  79   with
  80     exc -> print_exc exc
  81
  82 let read_file filename size t =
  83   let fd =
  84     try openfile filename [ O_WRONLY; O_CREAT ] 0o600 with
  85       _ -> Printf.eprintf "Open failed.\n"; flush Pervasives.stderr; exit 1
  86   in
  87   let (len, rlen) = ref 0, ref 0 in
  88   while len := read t buff 0 (String.length buff); !len <> 0
  89   do
  90     let _ = write fd buff 0 !len in
  91     flush (out_channel_of_descr fd);
  92     rlen := !rlen + !len;
  93     Printf.printf "DCC %s %d%% (%d/%d bytes) received.\n"
  94       filename (100 * !rlen / size) !rlen size;
  95     flush Pervasives.stdout
  96   done;
  97   close fd; close t
  98
  99 let receive_file host port size filename =
 100   let s = socket PF_INET SOCK_STREAM 0 in
 101   let hl = Hostlong.of_string host in
 102   let inet_addr =
 103     inet_addr_of_string (Hostlong.to_address_string hl)
 104   in
 105   connect s (ADDR_INET (inet_addr, port));
 106   read_file filename size s; ()
 107
 108 let chat_loop s =
 109   let sel = ref [s; stdin] in
 110   while !sel <> [] do
 111     let (l, _, _) =
 112     try
 113       select !sel [] [] (-1.0)
 114     with
 115       _ -> exit 0
 116     in
 117     List.iter
 118       (fun x ->
 119         let (rfd, wfd) =
 120           if x == s then
 121             (s, stdout)
 122           else if x == stdin then
 123             (stdin, s)
 124           else
 125             (stdin, stdout)
 126         in
 127         let len = ref 0
 128         in
 129         len := read rfd buff 0 (String.length buff);
 130         if !len == 0 then
 131           begin try shutdown wfd SHUTDOWN_SEND; () with
 132             _ -> exit 0
 133           end
 134         else
 135           begin
 136             let rec loop i =
 137               let j = i + write wfd buff i (!len - i) in
 138               if j == !len then () else loop j
 139             in
 140             loop 0;
 141             flush (out_channel_of_descr wfd)
 142           end;
 143         ())
 144       l
 145   done
 146
 147 let chat_listen port =
 148   let host = gethostbyname (gethostname ()) in
 149   let haddr = string_of_inet_addr host.h_addr_list.(0) in
 150   let s = socket PF_INET SOCK_STREAM 0 in
 151   setsockopt s SO_REUSEADDR true;
 152   bind s (ADDR_INET (inet_addr_any, port));
 153   let port =
 154     match (getsockname s) with
 155       ADDR_INET (addr, port) -> port
 156     | _ -> port
 157   in
 158   let hl = Hostlong.of_address_string haddr in
 159   listen s 1;
 160   Printf.printf "DCC chat %s %d\n" (Hostlong.to_string hl) port;
 161   flush Pervasives.stdout;
 162   accept_connection
 163     (fun t ->
 164       Printf.printf "DCC chat established\n";
 165       flush Pervasives.stdout;
 166       chat_loop t) s; ()
 167
 168 let chat_connect host port =
 169   let s = socket PF_INET SOCK_STREAM 0 in
 170   let hl = Hostlong.of_string host in
 171   let inet_addr =
 172     inet_addr_of_string (Hostlong.to_address_string hl)
 173   in
 174   connect s (ADDR_INET (inet_addr, port));
 175   Printf.printf "DCC chat established\n";
 176   flush Pervasives.stdout;
 177   chat_loop s; ()
 178
 179 let getaddr_ext server =
 180   let addr =
 181     try (gethostbyname server).h_addr_list.(0) with
 182       _ -> inet_addr_of_string "198.41.0.4"
 183   and port = 7 in
 184   let s = socket PF_INET SOCK_DGRAM 0 in
 185   connect s (ADDR_INET (addr, port));
 186   match (getsockname s) with
 187     ADDR_INET (addr, port) -> addr
 188   | _ -> raise Not_found
 189
 190 let main () =
 191   let a = ref [] in
 192   let usage = usage "Usage" (Filename.basename Sys.argv.(0)) in
 193   let speclist = [] in
 194   Arg.parse speclist (fun x -> a := !a @ [x]) usage;
 195   begin match !a with
 196     "send" :: [ port; filename ] ->
 197       let port =
 198         try int_of_string port with
 199           _ -> Arg.usage speclist usage; exit 1
 200       in
 201       send_file port filename;
 202       exit 0; ()
 203   | "receive" :: [ host; port; size; filename ] ->
 204       let (port, size) =
 205         try
 206           int_of_string port,
 207           int_of_string size
 208         with
 209           _ -> Arg.usage speclist usage; exit 1
 210       in
 211       receive_file host port size filename;
 212       exit 0; ()
 213   | "chat" :: [ "listen"; port ] ->
 214       let port =
 215         try
 216           int_of_string port
 217         with
 218           _ -> Arg.usage speclist usage; exit 1
 219       in
 220       chat_listen port;
 221       exit 0; ()
 222   | "chat" :: [ "connect"; host; port ] ->
 223       let port =
 224         try
 225           int_of_string port
 226         with
 227           _ -> Arg.usage speclist usage; exit 1
 228       in
 229       chat_connect host port;
 230       exit 0; ()
 231   | _ -> Arg.usage speclist usage; exit 1
 232   end
 233
 234 let _ = Printexc.catch main ()