3 This file is part of Liece.
5 Author: Daiki Ueno <daiki@kake.info.waseda.ac.jp>
8 Keywords: IRC, liece, DCC
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)
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.
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. *)
27 let usage prefix progname =
29 (List.map (fun x -> (Printf.sprintf "%s: %s %s" prefix progname x))
30 [ "send <port> <filename>";
31 "receive <host> <port> <size> <filename>";
33 "chat connect <host> <port>" ])
35 let buff = String.create 1024
39 Unix_error (err, fun_name, arg) ->
41 prerr_string fun_name;
42 prerr_string "\" failed";
43 if String.length arg > 0 then
45 prerr_string " on \""; prerr_string arg; prerr_string "\""; ()
48 prerr_endline (error_message err);
49 flush Pervasives.stderr; ()
51 try Printexc.print raise exc with
54 let accept_connection f s =
55 let (t, addr) = accept s in
58 let write_file filename size t =
60 try openfile filename [ O_RDONLY ] 0 with
61 _ -> Printf.eprintf "Open failed.\n"; flush Pervasives.stderr; exit 1
63 let (len, rlen) = ref 0, ref 0 in
64 while len := read fd buff 0 (String.length buff); !len <> 0
67 let j = i + write t buff i (!len - i) in
68 if j == !len then () else loop j
71 flush (out_channel_of_descr t);
73 Printf.printf "DCC %s %d%% (%d/%d bytes) sent.\n"
74 filename (100 * !rlen / size) !rlen size;
75 flush Pervasives.stdout
79 let send_file port filename =
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));
87 match (getsockname s) with
88 ADDR_INET (addr, port) -> port
93 try openfile filename [ O_RDONLY ] 0 with
94 _ -> Printf.eprintf "Open failed.\n"; flush Pervasives.stderr; exit 1
96 let size = (fstat fd).st_size in
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;
105 let read_file filename size t =
107 try openfile filename [ O_WRONLY; O_CREAT ] 0o600 with
108 _ -> Printf.eprintf "Open failed.\n"; flush Pervasives.stderr; exit 1
110 let (len, rlen) = ref 0, ref 0 in
111 while len := read t buff 0 (String.length buff); !len <> 0
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
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; ()
128 let sel = ref [s; stdin] in
132 select !sel [] [] (-1.0)
141 else if x == stdin then
148 len := read rfd buff 0 (String.length buff);
150 begin try shutdown wfd SHUTDOWN_SEND; () with
156 let j = i + write wfd buff i (!len - i) in
157 if j == !len then () else loop j
160 flush (out_channel_of_descr wfd)
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));
173 match (getsockname s) with
174 ADDR_INET (addr, port) -> port
178 Printf.printf "DCC chat %s %d\n" (Naddr.encode haddr) port;
179 flush Pervasives.stdout;
182 Printf.printf "DCC chat established\n";
183 flush Pervasives.stdout;
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;
193 let getaddr_ext server =
195 try (gethostbyname server).h_addr_list.(0) with
196 _ -> inet_addr_of_string "198.41.0.4"
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
206 let usage = usage "Usage" (Filename.basename Sys.argv.(0)) in
208 Arg.parse speclist (fun x -> a := !a @ [x]) usage;
210 "send" :: [ port; filename ] ->
212 try int_of_string port with
213 _ -> Arg.usage speclist usage; exit 1
215 send_file port filename;
217 | "receive" :: [ host; port; size; filename ] ->
223 _ -> Arg.usage speclist usage; exit 1
225 receive_file host port size filename;
227 | "chat" :: [ "listen"; port ] ->
232 _ -> Arg.usage speclist usage; exit 1
236 | "chat" :: [ "connect"; host; port ] ->
241 _ -> Arg.usage speclist usage; exit 1
243 chat_connect host port;
245 | _ -> Arg.usage speclist usage; exit 1
248 let _ = Printexc.catch main ()