dcc/dcc.ml

   1 (* DCC module.
   2
   3 This file is part of Liece.
   4
   5 Author: Daiki Ueno <daiki@kake.info.waseda.ac.jp>
   6 Created: 1998-09-28
   7 Revised: 1999-01-28
   8 Keywords: IRC, liece, DCC
   9
  10 This program is free software; you can redistribute it and/or modify
  11 it under the terms of the GNU General Public License as published by
  12 the Free Software Foundation; either version 2, or (at your option)
  13 any later version.
  14
  15 This program is distributed in the hope that it will be useful,
  16 but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.     See the
  18 GNU General Public License for more details.
  19
  20 You should have received a copy of the GNU General Public License
  21 along with GNU Emacs; see the file COPYING.  If not, write to the
  22 Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 Boston, MA 02111-1307, USA.  *)
  24
  25 open Unix
  26
  27 let usage prefix progname =
  28   String.concat "\n"
  29     (List.map (fun x -> (Printf.sprintf "%s: %s %s" prefix progname x))
  30        [ "send <port> <filename>";
  31          "receive <host> <port> <size> <filename>";
  32          "chat listen <port>";
  33          "chat connect <host> <port>" ])
  34
  35 let buff = String.create 1024
  36
  37 let print_exc exc =
  38   match exc with
  39     Unix_error (err, fun_name, arg) ->
  40       prerr_string "\"";
  41       prerr_string fun_name;
  42       prerr_string "\" failed";
  43       if String.length arg > 0 then
  44         begin
  45           prerr_string " on \""; prerr_string arg; prerr_string "\""; ()
  46         end;
  47       prerr_string ": ";
  48       prerr_endline (error_message err);
  49       flush Pervasives.stderr; ()
  50   | _ ->
  51       try Printexc.print raise exc with
  52         _ -> ()
  53
  54 let accept_connection f s =
  55   let (t, addr) = accept s in
  56   f t; close t; ()
  57
  58 let write_file filename size t =
  59   let fd =
  60     try openfile filename [ O_RDONLY ] 0 with
  61       _ -> Printf.eprintf "Open failed.\n"; flush Pervasives.stderr; exit 1
  62   in
  63   let (len, rlen) = ref 0, ref 0 in
  64   while len := read fd buff 0 (String.length buff); !len <> 0
  65   do
  66     let rec loop i =
  67       let j = i + write t buff i (!len - i) in
  68       if j == !len then () else loop j
  69     in
  70     loop 0;
  71     flush (out_channel_of_descr t);
  72     rlen := !rlen + !len;
  73     Printf.printf "DCC %s %d%% (%d/%d bytes) sent.\n"
  74       filename (100 * !rlen / size) !rlen size;
  75     flush Pervasives.stdout
  76   done;
  77   close fd; close t; ()
  78
  79 let send_file port filename =
  80   try
  81     let host = gethostbyname (gethostname ()) in
  82     let haddr = string_of_inet_addr host.h_addr_list.(0) in
  83     let s = socket PF_INET SOCK_STREAM 0 in
  84     setsockopt s SO_REUSEADDR true;
  85     bind s (ADDR_INET (inet_addr_any, port));
  86     let port =
  87       match (getsockname s) with
  88         ADDR_INET (addr, port) -> port
  89       | _ -> port
  90     in
  91     listen s 1;
  92     let fd =
  93       try openfile filename [ O_RDONLY ] 0 with
  94         _ -> Printf.eprintf "Open failed.\n"; flush Pervasives.stderr; exit 1
  95     in
  96     let size = (fstat fd).st_size in
  97     close fd;
  98     Printf.printf "DCC send %s %d %s %d\n"
  99       (Filename.basename filename) port (Naddr.encode haddr) size;
 100     flush Pervasives.stdout;
 101     accept_connection (fun t -> write_file filename size t) s;
 102   with
 103     exc -> print_exc exc
 104
 105 let read_file filename size t =
 106   let fd =
 107     try openfile filename [ O_WRONLY; O_CREAT ] 0o600 with
 108       _ -> Printf.eprintf "Open failed.\n"; flush Pervasives.stderr; exit 1
 109   in
 110   let (len, rlen) = ref 0, ref 0 in
 111   while len := read t buff 0 (String.length buff); !len <> 0
 112   do
 113     let _ = write fd buff 0 !len in
 114     flush (out_channel_of_descr fd);
 115     rlen := !rlen + !len;
 116     Printf.printf "DCC %s %d%% (%d/%d bytes) received.\n"
 117       filename (100 * !rlen / size) !rlen size;
 118     flush Pervasives.stdout
 119   done;
 120   close fd; close t
 121
 122 let receive_file host port size filename =
 123   let s = socket PF_INET SOCK_STREAM 0 in
 124   connect s (ADDR_INET (inet_addr_of_string (Naddr.decode host), port));
 125   read_file filename size s; ()
 126
 127 let chat_loop s =
 128   let sel = ref [s; stdin] in
 129   while !sel <> [] do
 130     let (l, _, _) =
 131     try
 132       select !sel [] [] (-1.0)
 133     with
 134       _ -> exit 0
 135     in
 136     List.iter
 137       (fun x ->
 138         let (rfd, wfd) =
 139           if x == s then
 140             (s, stdout)
 141           else if x == stdin then
 142             (stdin, s)
 143           else
 144             (stdin, stdout)
 145         in
 146         let len = ref 0
 147         in
 148         len := read rfd buff 0 (String.length buff);
 149         if !len == 0 then
 150           begin try shutdown wfd SHUTDOWN_SEND; () with
 151             _ -> exit 0
 152           end
 153         else
 154           begin
 155             let rec loop i =
 156               let j = i + write wfd buff i (!len - i) in
 157               if j == !len then () else loop j
 158             in
 159             loop 0;
 160             flush (out_channel_of_descr wfd)
 161           end;
 162         ())
 163       l
 164   done
 165
 166 let chat_listen port =
 167   let host = gethostbyname (gethostname ()) in
 168   let haddr = string_of_inet_addr host.h_addr_list.(0) in
 169   let s = socket PF_INET SOCK_STREAM 0 in
 170   setsockopt s SO_REUSEADDR true;
 171   bind s (ADDR_INET (inet_addr_any, port));
 172   let port =
 173     match (getsockname s) with
 174       ADDR_INET (addr, port) -> port
 175     | _ -> port
 176   in
 177   listen s 1;
 178   Printf.printf "DCC chat %s %d\n" (Naddr.encode haddr) port;
 179   flush Pervasives.stdout;
 180   accept_connection
 181     (fun t ->
 182       Printf.printf "DCC chat established\n";
 183       flush Pervasives.stdout;
 184       chat_loop t) s; ()
 185
 186 let chat_connect host port =
 187   let s = socket PF_INET SOCK_STREAM 0 in
 188   connect s (ADDR_INET (inet_addr_of_string (Naddr.decode host), port));
 189   Printf.printf "DCC chat established\n";
 190   flush Pervasives.stdout;
 191   chat_loop s; ()
 192
 193 let getaddr_ext server =
 194   let addr =
 195     try (gethostbyname server).h_addr_list.(0) with
 196       _ -> inet_addr_of_string "198.41.0.4"
 197   and port = 7 in
 198   let s = socket PF_INET SOCK_DGRAM 0 in
 199   connect s (ADDR_INET (addr, port));
 200   match (getsockname s) with
 201     ADDR_INET (addr, port) -> addr
 202   | _ -> raise Not_found
 203
 204 let main () =
 205   let a = ref [] in
 206   let usage = usage "Usage" (Filename.basename Sys.argv.(0)) in
 207   let speclist = [] in
 208   Arg.parse speclist (fun x -> a := !a @ [x]) usage;
 209   begin match !a with
 210     "send" :: [ port; filename ] ->
 211       let port =
 212         try int_of_string port with
 213           _ -> Arg.usage speclist usage; exit 1
 214       in
 215       send_file port filename;
 216       exit 0; ()
 217   | "receive" :: [ host; port; size; filename ] ->
 218       let (port, size) =
 219         try
 220           int_of_string port,
 221           int_of_string size
 222         with
 223           _ -> Arg.usage speclist usage; exit 1
 224       in
 225       receive_file host port size filename;
 226       exit 0; ()
 227   | "chat" :: [ "listen"; port ] ->
 228       let port =
 229         try
 230           int_of_string port
 231         with
 232           _ -> Arg.usage speclist usage; exit 1
 233       in
 234       chat_listen port;
 235       exit 0; ()
 236   | "chat" :: [ "connect"; host; port ] ->
 237       let port =
 238         try
 239           int_of_string port
 240         with
 241           _ -> Arg.usage speclist usage; exit 1
 242       in
 243       chat_connect host port;
 244       exit 0; ()
 245   | _ -> Arg.usage speclist usage; exit 1
 246   end
 247
 248 let _ = Printexc.catch main ()