[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Mldonkey-commits] mldonkey config/Makefile.in distrib/ChangeLog s...
|
From: |
mldonkey-commits |
|
Subject: |
[Mldonkey-commits] mldonkey config/Makefile.in distrib/ChangeLog s... |
|
Date: |
Mon, 03 Apr 2006 20:50:10 +0000 |
CVSROOT: /sources/mldonkey
Module name: mldonkey
Branch:
Changes by: spiralvoice <address@hidden> 06/04/03 20:50:09
Modified files:
config : Makefile.in
distrib : ChangeLog
src/daemon/chat: chat_options.ml
src/daemon/common: commonComplexOptions.ml commonGlobals.ml
commonMultimedia.ml commonOptions.ml
src/daemon/driver: driverControlers.ml driverMain.ml
src/gtk2/gui : guiHtml.ml
src/networks/donkey: donkeyComplexOptions.ml donkeyImport.ml
donkeyIndexer.ml donkeyInteractive.ml
donkeyOvernetImport.ml donkeyPandora.ml
src/utils/cdk : file.ml printexc2.ml unix2.ml zip.ml
src/utils/lib : avifile.ml gettext.ml4 misc.ml options.ml4
src/utils/net : geoip.ml http_client.ml ip_set.ml
tcpBufferedSocket.ml
src/utils/ocamlrss: rss.ml
Log message:
patch #5004
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/config/Makefile.in.diff?tr1=1.153&tr2=1.154&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/distrib/ChangeLog.diff?tr1=1.781&tr2=1.782&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/daemon/chat/chat_options.ml.diff?tr1=1.2&tr2=1.3&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/daemon/common/commonComplexOptions.ml.diff?tr1=1.51&tr2=1.52&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/daemon/common/commonGlobals.ml.diff?tr1=1.62&tr2=1.63&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/daemon/common/commonMultimedia.ml.diff?tr1=1.12&tr2=1.13&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/daemon/common/commonOptions.ml.diff?tr1=1.136&tr2=1.137&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/daemon/driver/driverControlers.ml.diff?tr1=1.64&tr2=1.65&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/daemon/driver/driverMain.ml.diff?tr1=1.104&tr2=1.105&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/gtk2/gui/guiHtml.ml.diff?tr1=1.6&tr2=1.7&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/networks/donkey/donkeyComplexOptions.ml.diff?tr1=1.43&tr2=1.44&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/networks/donkey/donkeyImport.ml.diff?tr1=1.8&tr2=1.9&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/networks/donkey/donkeyIndexer.ml.diff?tr1=1.7&tr2=1.8&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/networks/donkey/donkeyInteractive.ml.diff?tr1=1.95&tr2=1.96&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/networks/donkey/donkeyOvernetImport.ml.diff?tr1=1.1&tr2=1.2&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/networks/donkey/donkeyPandora.ml.diff?tr1=1.6&tr2=1.7&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/utils/cdk/file.ml.diff?tr1=1.5&tr2=1.6&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/utils/cdk/printexc2.ml.diff?tr1=1.4&tr2=1.5&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/utils/cdk/unix2.ml.diff?tr1=1.24&tr2=1.25&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/utils/cdk/zip.ml.diff?tr1=1.5&tr2=1.6&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/utils/lib/avifile.ml.diff?tr1=1.6&tr2=1.7&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/utils/lib/gettext.ml4.diff?tr1=1.5&tr2=1.6&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/utils/lib/misc.ml.diff?tr1=1.5&tr2=1.6&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/utils/lib/options.ml4.diff?tr1=1.17&tr2=1.18&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/utils/net/geoip.ml.diff?tr1=1.4&tr2=1.5&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/utils/net/http_client.ml.diff?tr1=1.27&tr2=1.28&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/utils/net/ip_set.ml.diff?tr1=1.25&tr2=1.26&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/utils/net/tcpBufferedSocket.ml.diff?tr1=1.42&tr2=1.43&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/utils/ocamlrss/rss.ml.diff?tr1=1.2&tr2=1.3&r1=text&r2=text
Patches:
Index: mldonkey/config/Makefile.in
diff -u mldonkey/config/Makefile.in:1.153 mldonkey/config/Makefile.in:1.154
--- mldonkey/config/Makefile.in:1.153 Wed Mar 29 15:41:33 2006
+++ mldonkey/config/Makefile.in Mon Apr 3 20:50:08 2006
@@ -155,7 +155,7 @@
$(CDK)/printexc2.ml $(CDK)/genlex2.ml $(CDK)/sysenv.ml \
$(CDK)/netbase.ml $(CDK)/filepath.ml $(CDK)/string2.ml \
$(CDK)/filename2.ml $(CDK)/list2.ml $(CDK)/hashtbl2.ml \
- $(CDK)/file.ml $(CDK)/unix2.ml \
+ $(CDK)/unix2.ml $(CDK)/file.ml \
$(CDK)/heap_c.c $(CDK)/array2.ml $(CDK)/sort2.ml
ifneq ("$(PTHREAD_CFLAGS)" , "")
Index: mldonkey/distrib/ChangeLog
diff -u mldonkey/distrib/ChangeLog:1.781 mldonkey/distrib/ChangeLog:1.782
--- mldonkey/distrib/ChangeLog:1.781 Mon Apr 3 20:35:05 2006
+++ mldonkey/distrib/ChangeLog Mon Apr 3 20:50:08 2006
@@ -15,6 +15,7 @@
=========
2006/04/03
+5004: Automatically closes opened descriptors using "tryopen pattern" (pango)
5005: CommonBlocking: Do not block IPs when GeoIP database is not loaded
2006/04/02
Index: mldonkey/src/daemon/chat/chat_options.ml
diff -u mldonkey/src/daemon/chat/chat_options.ml:1.2
mldonkey/src/daemon/chat/chat_options.ml:1.3
--- mldonkey/src/daemon/chat/chat_options.ml:1.2 Thu Jul 7 00:25:45 2005
+++ mldonkey/src/daemon/chat/chat_options.ml Mon Apr 3 20:50:08 2006
@@ -75,12 +75,8 @@
;;
let create_options_file name =
- ignore
- (
- if not (Sys.file_exists name) then
- let oc = open_out name in
- close_out oc
- );
+ if not (Sys.file_exists name) then
+ Unix2.tryopen_write name ignore; (* should we catch exceptions here ? *)
{
file_name = name;
file_options =[];
@@ -291,16 +287,15 @@
raise (Failure (Buffer.contents buf))
end
else
- let ic = open_in filename in
- let s = Stream.of_channel ic in
try
- let stream = lexer s in
let list =
- try parse_gwmlrc stream with
- e ->
- lprintf_nl "At pos %d/%d" (Stream.count s) (Stream.count stream);
- raise e
- in
+ Unix2.tryopen_read filename (fun ic ->
+ let s = Stream.of_channel ic in
+ let stream = lexer s in
+ try parse_gwmlrc stream with
+ e ->
+ lprintf_nl "At pos %d/%d" (Stream.count s) (Stream.count
stream);
+ raise e) in
List.iter
(fun o ->
try
@@ -560,7 +555,7 @@
let filename = opfile.file_name in
let temp_file = filename ^ ".tmp" in
let old_file = filename ^ ".old" in
- let oc = open_out temp_file in
+ Unix2.tryopen_write temp_file (fun oc ->
save_module "" oc
(List.map
(fun o ->
@@ -593,10 +588,11 @@
with
_ -> ())
opfile.file_rc;
- end;
- close_out oc;
- (try Sys.rename filename old_file with _ -> ());
- (try Sys.rename temp_file filename with _ -> ())
+ end);
+ try
+ Sys.rename filename old_file;
+ Sys.rename temp_file filename
+ with _ -> ();
;;
let save_with_help opfile =
Index: mldonkey/src/daemon/common/commonComplexOptions.ml
diff -u mldonkey/src/daemon/common/commonComplexOptions.ml:1.51
mldonkey/src/daemon/common/commonComplexOptions.ml:1.52
--- mldonkey/src/daemon/common/commonComplexOptions.ml:1.51 Wed Mar 29
15:41:33 2006
+++ mldonkey/src/daemon/common/commonComplexOptions.ml Mon Apr 3 20:50:08 2006
@@ -977,85 +977,69 @@
open Zip
let backup_zip archive files =
- begin
- let oc = Zip.open_out archive in
- try
- List.iter (fun file ->
- begin
- try
- let s = Unix.stat file in
- Zip.copy_file_to_entry file oc ~level:9 ~mtime:s.Unix.st_mtime
file
- with e ->
- failwith (Printf.sprintf "Zip: error %s in %s"
(Printexc2.to_string e) file)
- end
- ) files;
- Zip.close_out oc
- with e ->
- Zip.close_out oc;
- failwith (Printf.sprintf "Zip: error %s in %s" (Printexc2.to_string e)
archive)
- end
+ try
+ Unix2.tryopen_write_zip archive (fun oc ->
+ List.iter (fun file ->
+ try
+ let s = Unix.stat file in
+ Zip.copy_file_to_entry file oc ~level:9 ~mtime:s.Unix.st_mtime file
+ with e ->
+ failwith (Printf.sprintf "Zip: error %s in %s" (Printexc2.to_string
e) file)
+ ) files)
+ with e ->
+ failwith (Printf.sprintf "Zip: error %s in %s" (Printexc2.to_string e)
archive)
open Tar
let backup_tar archive files =
- let failed_files = ref "" in
- let otar = Tar.open_out ~compress:`Gzip archive in
+ let failed_files = ref [] in
+ Unix2.tryopen_write_tar ~compress:`Gzip archive (fun otar ->
List.iter (fun arg ->
- begin
try
- let ic = Pervasives.open_in_bin arg in
- let stat = Unix.stat arg in
- let size = stat.Unix.st_size in
- if size > Sys.max_string_length then
- begin
- Tar.close_out otar;
- failwith (Printf.sprintf "Tar: file %s too big, limit %d byte" arg
Sys.max_string_length)
- end;
- let header =
- { Tar.t_name = arg;
- t_mode = 0o644;
- t_uid = stat.Unix.st_uid;
- t_gid = stat.Unix.st_gid;
- t_size = 0;
- t_mtime = Int32.of_float stat.Unix.st_mtime;
- t_chksum = 0;
- t_typeflag = REGULAR;
- t_linkname = "";
- t_format = POSIX_FORMAT;
- t_uname = "";
- t_gname = "";
- t_devmajor = 0;
- t_devminor = 0;
- t_prefix = "";
- t_gnu = None;}
- in
- let s = String.create size in
- Pervasives.really_input ic s 0 size;
- Pervasives.close_in ic;
- Tar.output otar header s
- with e ->
- let error = (Printexc2.to_string e) in
- if error =
- "Gzip.Error(\"error during compression\")"
- && Autoconf.windows && arg = "fasttrack.ini" then
- (* for whatever reason this error is raised on Windows,
- but fasttrack.ini is stored correctly *)
- if !verbose then
- lprintf_nl () "Tar: Windows specific pseudo error %s in %s"
error arg
- else ()
- else
- begin
- if !failed_files = "" then
- failed_files := arg
- else
- failed_files := Printf.sprintf "%s %s" !failed_files arg;
- lprintf_nl () "Tar: error %s in %s" error arg
- end
- end
- ) files;
- Tar.close_out otar;
- if !failed_files <> "" then
- failwith (Printf.sprintf "Tar: error backing up %s" !failed_files)
+ let header, s =
+ Unix2.tryopen_read_bin arg (fun ic ->
+ let stat = Unix.stat arg in
+ let size = stat.Unix.st_size in
+ if size > Sys.max_string_length then
+ failwith (Printf.sprintf "Tar: file %s too big, limit %d byte"
arg Sys.max_string_length);
+ let header =
+ { Tar.t_name = arg;
+ t_mode = 0o644;
+ t_uid = stat.Unix.st_uid;
+ t_gid = stat.Unix.st_gid;
+ t_size = 0;
+ t_mtime = Int32.of_float stat.Unix.st_mtime;
+ t_chksum = 0;
+ t_typeflag = REGULAR;
+ t_linkname = "";
+ t_format = POSIX_FORMAT;
+ t_uname = "";
+ t_gname = "";
+ t_devmajor = 0;
+ t_devminor = 0;
+ t_prefix = "";
+ t_gnu = None;} in
+ let s = String.create size in
+ Pervasives.really_input ic s 0 size;
+ header, s) in
+ Tar.output otar header s
+ with e ->
+ let error = Printexc2.to_string e in
+ if error = "Gzip.Error(\"error during compression\")"
+ && Autoconf.windows && arg = "fasttrack.ini" then begin
+ (* for whatever reason this error is raised on Windows,
+ but fasttrack.ini is stored correctly *)
+ if !verbose then
+ lprintf_nl () "Tar: Windows specific pseudo error %s in %s" error
arg
+ end
+ else begin
+ failed_files := arg :: !failed_files;
+ lprintf_nl () "Tar: error %s in %s" error arg
+ end
+ ) files);
+ if !failed_files <> [] then
+ failwith (Printf.sprintf "Tar: error backing up %s"
+ (String.concat " " (List.rev !failed_files)))
let backup_options () =
let counter = ref 1 in
Index: mldonkey/src/daemon/common/commonGlobals.ml
diff -u mldonkey/src/daemon/common/commonGlobals.ml:1.62
mldonkey/src/daemon/common/commonGlobals.ml:1.63
--- mldonkey/src/daemon/common/commonGlobals.ml:1.62 Fri Mar 17 18:33:16 2006
+++ mldonkey/src/daemon/common/commonGlobals.ml Mon Apr 3 20:50:08 2006
@@ -459,9 +459,9 @@
let log_chat_message i num n s =
Fifo.put chat_message_fifo (last_time(),i,num,n,s);
try
- let oc = open_out_gen [Open_creat; Open_wronly; Open_append] 0o600
!messages_log in
- Printf.fprintf oc "%s: %s (%s): %s\n" (Date.simple
(BasicSocket.date_of_int (last_time ()))) n i s;
- close_out oc;
+ Unix2.tryopen_write_gen !messages_log [Open_creat; Open_wronly;
Open_append]
+ 0o600 (fun oc ->
+ Printf.fprintf oc "%s: %s (%s): %s\n" (Date.simple
(BasicSocket.date_of_int (last_time ()))) n i s)
with e ->
lprintf_nl "[ERROR] Exception %s while trying to log message to %s"
(Printexc2.to_string e) !messages_log;
Index: mldonkey/src/daemon/common/commonMultimedia.ml
diff -u mldonkey/src/daemon/common/commonMultimedia.ml:1.12
mldonkey/src/daemon/common/commonMultimedia.ml:1.13
--- mldonkey/src/daemon/common/commonMultimedia.ml:1.12 Wed Dec 14 21:17:46 2005
+++ mldonkey/src/daemon/common/commonMultimedia.ml Mon Apr 3 20:50:08 2006
@@ -622,12 +622,11 @@
*)
let get_info file =
- let ic = open_in_bin file in
try
- search_info_mp3 file;
- search_info_avi ic ;
- search_info_ogg ic;
- close_in ic;
+ Unix2.tryopen_read_bin file (fun ic ->
+ search_info_mp3 file;
+ search_info_avi ic ;
+ search_info_ogg ic);
let es =
try
List.map String.lowercase (Filename2.extensions file)
@@ -653,13 +652,11 @@
| "ogm" :: _ -> FormatType ("ogm", "Video")
| "asf" :: _ -> FormatType ("asf", "Video")
| _ -> FormatUnknown
- with e ->
- close_in ic;
- match e with
- FormatFound f -> f
- | e ->
- lprintf_nl "get_info: Exception in %s" (Printexc2.to_string e);
- FormatUnknown
+ with
+ | FormatFound f -> f
+ | e ->
+ lprintf_nl "get_info: Exception in %s" (Printexc2.to_string e);
+ FormatUnknown
module Bchunk =
Index: mldonkey/src/daemon/common/commonOptions.ml
diff -u mldonkey/src/daemon/common/commonOptions.ml:1.136
mldonkey/src/daemon/common/commonOptions.ml:1.137
--- mldonkey/src/daemon/common/commonOptions.ml:1.136 Wed Mar 29 15:41:33 2006
+++ mldonkey/src/daemon/common/commonOptions.ml Mon Apr 3 20:50:08 2006
@@ -191,10 +191,8 @@
end;
let pid =
try
- let pid_ci = open_in pid_filename in
- let pid = int_of_string (input_line pid_ci) in
- close_in pid_ci;
- pid
+ Unix2.tryopen_read pid_filename (fun pid_ci ->
+ int_of_string (input_line pid_ci))
with _ ->
lprintf_nl "But it couldn't be read to check if the process still
exists.";
lprintf_nl "To avoid doing any harm, MLDonkey will now stop.";
Index: mldonkey/src/daemon/driver/driverControlers.ml
diff -u mldonkey/src/daemon/driver/driverControlers.ml:1.64
mldonkey/src/daemon/driver/driverControlers.ml:1.65
--- mldonkey/src/daemon/driver/driverControlers.ml:1.64 Fri Mar 17 18:33:16 2006
+++ mldonkey/src/daemon/driver/driverControlers.ml Mon Apr 3 20:50:08 2006
@@ -841,12 +841,12 @@
(* if files are small really_input should be okay *)
let read_theme_page page =
- let theme_page = get_theme_page page in
- let file = open_in theme_page in
- let size = (Unix.stat theme_page).Unix.st_size in
- let s = String.make size ' ' in
- let _ = really_input file s 0 size in
- close_in file; s
+ let theme_page = get_theme_page page in
+ Unix2.tryopen_read theme_page (fun file ->
+ let size = (Unix.stat theme_page).Unix.st_size in
+ let s = String.make size ' ' in
+ really_input file s 0 size;
+ s)
let add_simple_commands buf =
let this_page = "commands.html" in
Index: mldonkey/src/daemon/driver/driverMain.ml
diff -u mldonkey/src/daemon/driver/driverMain.ml:1.104
mldonkey/src/daemon/driver/driverMain.ml:1.105
--- mldonkey/src/daemon/driver/driverMain.ml:1.104 Wed Mar 29 15:41:33 2006
+++ mldonkey/src/daemon/driver/driverMain.ml Mon Apr 3 20:50:08 2006
@@ -148,29 +148,28 @@
);
CommonWeb.add_web_kind "motd.conf" "Setup changes of the day"
(fun _ filename ->
- let ic = open_in filename in
try
- while true do
- let line = input_line ic in
- let cmd, args = String2.cut_at line ' ' in
- let name, value = String2.cut_at args ' ' in
- match cmd with
- "set" ->
- CommonInteractive.set_fully_qualified_options name value
- | "add_item" ->
- CommonInteractive.add_item_to_fully_qualified_options name value
- | "del_item" ->
- CommonInteractive.del_item_from_fully_qualified_options name value
- | _ ->
- lprintf_nl () (_b "UNUSED LINE: %s") line
-
- done;
+ Unix2.tryopen_read filename (fun ic ->
+ try
+ while true do
+ let line = input_line ic in
+ let cmd, args = String2.cut_at line ' ' in
+ let name, value = String2.cut_at args ' ' in
+ match cmd with
+ | "set" ->
+ CommonInteractive.set_fully_qualified_options name value
+ | "add_item" ->
+ CommonInteractive.add_item_to_fully_qualified_options name
value
+ | "del_item" ->
+ CommonInteractive.del_item_from_fully_qualified_options name
value
+ | _ ->
+ lprintf_nl () (_b "UNUSED LINE: %s") line
+ done
+ with End_of_file -> ())
with
- | End_of_file ->
- close_in ic
- | e -> lprintf_nl () (_b "Error while reading motd.conf(%s): %s") filename
- (Printexc2.to_string e);
- close_in ic
+ e ->
+ lprintf_nl () (_b "Error while reading motd.conf(%s): %s") filename
+ (Printexc2.to_string e)
)
@@ -618,9 +617,7 @@
Filename.concat !pid pid_filename,
Printf.sprintf "%s\n" (string_of_int(Unix.getpid()))
in
- let oc = open_out pid_file in
- output_string oc s;
- close_out oc;
+ Unix2.tryopen_write pid_file (fun oc -> output_string oc s);
CommonGlobals.do_at_exit (fun _ -> try Sys.remove pid_file with _ -> ());
if !verbose then
lprintf_nl () (_b "Starting with pid %s") (string_of_int(Unix.getpid ()))
Index: mldonkey/src/gtk2/gui/guiHtml.ml
diff -u mldonkey/src/gtk2/gui/guiHtml.ml:1.6
mldonkey/src/gtk2/gui/guiHtml.ml:1.7
--- mldonkey/src/gtk2/gui/guiHtml.ml:1.6 Sun Nov 27 14:04:33 2005
+++ mldonkey/src/gtk2/gui/guiHtml.ml Mon Apr 3 20:50:08 2006
@@ -168,14 +168,13 @@
File.from_string filename _s;
with _ -> (lprintf_nl2 "failed in H.wget_string")
end;
- let in_chan = open_in_bin filename in
- let lexb = Lexing.from_channel in_chan in
- let dl = GuiNetHtml.parse_document
- ~return_declarations:true ~return_pis:true
- ~return_comments:true lexb
- in
- f dl;
- close_in in_chan) (fun n m -> progress n m)
+ Unix2.tryopen_read_bin filename (fun in_chan ->
+ let lexb = Lexing.from_channel in_chan in
+ let dl = GuiNetHtml.parse_document
+ ~return_declarations:true ~return_pis:true
+ ~return_comments:true lexb
+ in
+ f dl)) (fun n m -> progress n m)
(*************************************************************************)
Index: mldonkey/src/networks/donkey/donkeyComplexOptions.ml
diff -u mldonkey/src/networks/donkey/donkeyComplexOptions.ml:1.43
mldonkey/src/networks/donkey/donkeyComplexOptions.ml:1.44
--- mldonkey/src/networks/donkey/donkeyComplexOptions.ml:1.43 Fri Feb 17
22:24:41 2006
+++ mldonkey/src/networks/donkey/donkeyComplexOptions.ml Mon Apr 3
20:50:09 2006
@@ -80,7 +80,7 @@
end
) (connected_servers());
- let oc = open_out "onlinesig.dat" in
+ Unix2.tryopen_write "onlinesig.dat" (fun oc ->
if !most_users = Int64.zero then
output_string oc ("0\n")
@@ -90,8 +90,7 @@
let ulkbs = (( (float_of_int !udp_upload_rate) +. (float_of_int
!control_upload_rate)) /. 1024.0) in
output_string oc (Printf.sprintf "%.1f|%.1f|%d\n" dlkbs ulkbs
- (Intmap.length !CommonUploads.pending_slots_map));
- close_out oc
+ (Intmap.length !CommonUploads.pending_slots_map)))
(************ COMPLEX OPTIONS *****************)
Index: mldonkey/src/networks/donkey/donkeyImport.ml
diff -u mldonkey/src/networks/donkey/donkeyImport.ml:1.8
mldonkey/src/networks/donkey/donkeyImport.ml:1.9
--- mldonkey/src/networks/donkey/donkeyImport.ml:1.8 Fri Jul 22 10:58:55 2005
+++ mldonkey/src/networks/donkey/donkeyImport.ml Mon Apr 3 20:50:09 2006
@@ -28,7 +28,7 @@
open DonkeyMftp
let dump_file filename =
- let ic = open_in filename in
+ Unix2.tryopen_read filename (fun ic ->
let s = String.create 20 in
try
lprintf "file: %s\n" filename;
@@ -40,8 +40,7 @@
dump (String.sub s 0 n);
pos := !pos + n;
done
- with _ ->
- close_in ic
+ with End_of_file | Exit -> ())
module Server = struct
Index: mldonkey/src/networks/donkey/donkeyIndexer.ml
diff -u mldonkey/src/networks/donkey/donkeyIndexer.ml:1.7
mldonkey/src/networks/donkey/donkeyIndexer.ml:1.8
--- mldonkey/src/networks/donkey/donkeyIndexer.ml:1.7 Sun Dec 18 14:50:38 2005
+++ mldonkey/src/networks/donkey/donkeyIndexer.ml Mon Apr 3 20:50:09 2006
@@ -59,7 +59,7 @@
let load_comments filename =
try
- let ic = open_in filename in
+ Unix2.tryopen_read filename (fun ic ->
try
while true do
let s = read_request ic in
@@ -68,25 +68,20 @@
add_comment md4 comment
done
with
- End_of_file -> close_in ic
- | e ->
- close_in ic;
- lprintf "Error loading %s: %s" filename (Printexc2.to_string e);
- lprint_newline ()
+ End_of_file -> ())
with e ->
lprintf "Error loading %s: %s" filename (Printexc2.to_string e);
lprint_newline ()
let save_comments () =
- let oc = open_out comment_filename in
+ Unix2.tryopen_write filename (fun oc ->
let buf = Buffer.create 256 in
Hashtbl.iter (fun md4 comment ->
Buffer.reset buf;
buf_md4 buf md4;
buf_string buf comment;
output_request oc (Buffer.contents buf);
- ) comments;
- close_out oc
+ ) comments)
let comment_result r doc =
try
@@ -517,12 +512,12 @@
let load_old_history () =
- let ic = open_in "history.dat" in
+ Unix2.tryopen_read "history.dat" (fun ic ->
try
while true do
ignore (index_result_no_filter (input_old_result ic))
done
- with _ -> close_in ic
+ with End_of_file -> ())
let init () =
(* load history *)
@@ -532,21 +527,21 @@
save_file_history =:= false;
lprintf "Loading history file ...";
let list = ref [] in
- let ic = open_in history_file in
- try
- while true do
- let file = input_result ic in
- let rs = index_result_no_filter file in
- list := doc_value rs.result_index :: !list;
- done
- with
- End_of_file ->
- lprintf "done\n";
- close_in ic
- | e -> (* some error *)
+ try
+ Unix2.tryopen_read history_file (fun ic ->
+ try
+ while true do
+ let file = input_result ic in
+ let rs = index_result_no_filter file in
+ list := doc_value rs.result_index :: !list;
+ done
+ with
+ End_of_file ->
+ lprintf "done\n")
+ with
+ e -> (* some error *)
lprintf "Error %s reading history file\n"
(Printexc2.to_string e);
- close_in ic;
lprintf "Generating new file\n";
begin try
(try close_history_oc () with _ -> ());
Index: mldonkey/src/networks/donkey/donkeyInteractive.ml
diff -u mldonkey/src/networks/donkey/donkeyInteractive.ml:1.95
mldonkey/src/networks/donkey/donkeyInteractive.ml:1.96
--- mldonkey/src/networks/donkey/donkeyInteractive.ml:1.95 Wed Mar 29
15:41:33 2006
+++ mldonkey/src/networks/donkey/donkeyInteractive.ml Mon Apr 3 20:50:09 2006
@@ -125,46 +125,40 @@
let unpack_server_met filename url =
let ext = String.lowercase (Filename2.extension filename) in
let last_ext = String.lowercase (Filename2.last_extension filename) in
- let real_ext = if last_ext = ".zip" then
- last_ext
- else
- ext
- in
+ let real_ext = if last_ext = ".zip" then last_ext else ext in
match real_ext with
- ".zip" ->
- begin try
- let ic = Zip.open_in filename in
- try
- let file = Zip.find_entry ic "server.met" in
- Zip.close_in ic;
- lprintf_nl () "server.met found in %s" url;
- let _ = Misc.archive_extract filename "zip" in
- file.Zip.filename
- with e ->
- Zip.close_in ic;
- lprintf_nl () "Exception %s while extracting server.met from %s"
- (Printexc2.to_string e) url;
- raise Not_found
- with e ->
- lprintf_nl () "Exception %s while opening %s"
- (Printexc2.to_string e) url;
- raise Not_found
- end
+ | ".zip" ->
+ (try
+ let result =
+ Unix2.tryopen_read_zip filename (fun ic ->
+ try
+ let file = Zip.find_entry ic "server.met" in
+ lprintf_nl () "server.met found in %s" url;
+ file.Zip.filename
+ with e ->
+ lprintf_nl () "Exception %s while extracting server.met from
%s"
+ (Printexc2.to_string e) url;
+ raise e) in
+ (try
+ ignore(Misc.archive_extract filename "zip")
+ with e ->
+ lprintf_nl () "Exception %s while extracting server.met from %s"
+ (Printexc2.to_string e) url;
+ raise e);
+ result
+ with e ->
+ lprintf_nl () "Exception %s while opening %s"
+ (Printexc2.to_string e) url;
+ raise Not_found)
| ".met.gz" | ".met.bz2" | ".gz" | ".bz2" ->
- begin
- let filetype =
- if ext = ".bz2" || ext = ".met.bz2" then
- "bz2"
- else
- "gz"
- in try
- let s = Misc.archive_extract filename filetype in
- s
- with e ->
- lprintf_nl () "Exception %s while extracting from %s"
- (Printexc2.to_string e) url;
- raise Not_found
- end
+ (let filetype =
+ if ext = ".bz2" || ext = ".met.bz2" then "bz2" else "gz" in
+ try
+ Misc.archive_extract filename filetype
+ with e ->
+ lprintf_nl () "Exception %s while extracting from %s"
+ (Printexc2.to_string e) url;
+ raise Not_found)
(* if file is not a supported archive type try loading servers from that file
anyway *)
| _ -> filename
Index: mldonkey/src/networks/donkey/donkeyOvernetImport.ml
diff -u mldonkey/src/networks/donkey/donkeyOvernetImport.ml:1.1
mldonkey/src/networks/donkey/donkeyOvernetImport.ml:1.2
--- mldonkey/src/networks/donkey/donkeyOvernetImport.ml:1.1 Mon May 2
11:40:28 2005
+++ mldonkey/src/networks/donkey/donkeyOvernetImport.ml Mon Apr 3 20:50:09 2006
@@ -29,7 +29,7 @@
open DonkeyMftp
let dump_file filename =
- let ic = open_in_bin filename in
+ Unix2.tryopen_read_bin filename (fun ic ->
let s = String.create 20 in
try
lprintf "file: %s\n" filename;
@@ -41,8 +41,7 @@
dump (String.sub s 0 n);
pos := !pos + n;
done
- with _ ->
- close_in ic
+ with End_of_file -> ())
module Peer = struct
Index: mldonkey/src/networks/donkey/donkeyPandora.ml
diff -u mldonkey/src/networks/donkey/donkeyPandora.ml:1.6
mldonkey/src/networks/donkey/donkeyPandora.ml:1.7
--- mldonkey/src/networks/donkey/donkeyPandora.ml:1.6 Thu Dec 15 19:41:46 2005
+++ mldonkey/src/networks/donkey/donkeyPandora.ml Mon Apr 3 20:50:09 2006
@@ -231,17 +231,13 @@
let commit () =
-
- let oc = open_out "trace.out" in
- output_value oc connections;
- close_out oc
+ Unix2.tryopen_write "trace.out" (fun oc -> output_value oc connections)
exception ServerConnection
let read_trace () =
- let ic = open_in "trace.out" in
- let connections = input_value ic in
- close_in ic;
+ let connections =
+ Unix2.tryopen_read "trace.out" (fun ic -> input_value ic) in
mldonkey_emule_proto.emule_sourceexchange <- 5;
Index: mldonkey/src/utils/cdk/file.ml
diff -u mldonkey/src/utils/cdk/file.ml:1.5 mldonkey/src/utils/cdk/file.ml:1.6
--- mldonkey/src/utils/cdk/file.ml:1.5 Wed Dec 14 21:17:47 2005
+++ mldonkey/src/utils/cdk/file.ml Mon Apr 3 20:50:09 2006
@@ -19,7 +19,7 @@
(* read a whole file *)
let to_string name =
- let chan = open_in_bin name in
+ Unix2.tryopen_read_bin name (fun chan ->
let buf_size = 1024 in
let buf = String.create buf_size in
let rec iter buf nb_read =
@@ -37,9 +37,7 @@
in
iter buf nb_read
in
- let buf = iter buf 0 in
- close_in chan;
- buf
+ iter buf 0)
let read_whole_chan chan =
let buf = Buffer.create 1024 in
@@ -57,45 +55,32 @@
read_whole_chan chan
let to_copy in_name out_name =
- let in_chan = open_in_bin in_name and
- out_chan = open_out_bin out_name in
+ Unix2.tryopen_read_bin in_name (fun in_chan ->
+ Unix2.tryopen_write_bin out_name (fun out_chan ->
try
let rec rcpy () =
let c = input_byte in_chan in
output_byte out_chan c;
flush out_chan;
- rcpy ();
+ rcpy ()
in
rcpy ()
- with
- End_of_file -> ()
+ with End_of_file -> ()))
let from_string name s =
- let oc = open_out_bin name in
- output_string oc s;
- close_out oc
+ Unix2.tryopen_write_bin name (fun oc -> output_string oc s)
let iter f name =
- let ic = open_in_bin name in
- try
- while true do
- let line = input_line ic in
- f line
- done
- with
- End_of_file -> close_in ic
- | e -> close_in ic; raise e
+ Unix2.tryopen_read_bin name (fun ic ->
+ try
+ while true do
+ let line = input_line ic in
+ f line
+ done
+ with End_of_file -> ())
let from_value name s =
- let oc = open_out_bin name in
- output_value oc s;
- close_out oc
+ Unix2.tryopen_write_bin name (fun oc -> output_value oc s)
let to_value name =
- let ic = open_in_bin name in
- try
- let v = input_value ic in
- close_in ic;
- v
- with
- | e -> close_in ic; raise e
+ Unix2.tryopen_read_bin name (fun ic -> input_value ic)
Index: mldonkey/src/utils/cdk/printexc2.ml
diff -u mldonkey/src/utils/cdk/printexc2.ml:1.4
mldonkey/src/utils/cdk/printexc2.ml:1.5
--- mldonkey/src/utils/cdk/printexc2.ml:1.4 Fri Dec 2 12:02:36 2005
+++ mldonkey/src/utils/cdk/printexc2.ml Mon Apr 3 20:50:09 2006
@@ -17,7 +17,7 @@
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*)
-open Printf2;;
+open Printf2
open Printf
let locfmt =
Index: mldonkey/src/utils/cdk/unix2.ml
diff -u mldonkey/src/utils/cdk/unix2.ml:1.24
mldonkey/src/utils/cdk/unix2.ml:1.25
--- mldonkey/src/utils/cdk/unix2.ml:1.24 Wed Mar 8 18:49:58 2006
+++ mldonkey/src/utils/cdk/unix2.ml Mon Apr 3 20:50:09 2006
@@ -19,35 +19,66 @@
open Printf2
open Unix
+
+let tryopen openf closef filename f =
+ let descr = openf filename in
+ let result =
+ try
+ f descr
+ with e ->
+ (try closef descr with _ -> ());
+ raise e in
+ closef descr;
+ result
+
+let tryopen_read fn f = tryopen open_in close_in fn f
+let tryopen_write fn f = tryopen open_out close_out fn f
+let tryopen_read_bin fn f = tryopen open_in_bin close_in fn f
+let tryopen_write_bin fn f = tryopen open_out_bin close_out fn f
+let tryopen_read_gen fn flags perm f =
+ tryopen (open_in_gen flags perm) close_in fn f
+let tryopen_write_gen fn flags perm f =
+ tryopen (open_out_gen flags perm) close_out fn f
+let tryopen_openfile fn flags perm f =
+ tryopen (fun fn -> Unix.openfile fn flags perm) Unix.close fn f
+let tryopen_dir dir f = tryopen opendir closedir dir f
+let tryopen_read_zip fn f = tryopen Zip.open_in Zip.close_in fn f
+let tryopen_write_zip fn f = tryopen Zip.open_out Zip.close_out fn f
+let tryopen_read_tar fn f =
+ tryopen Tar.open_in Tar.close_in fn f
+let tryopen_write_tar ?compress fn f =
+ tryopen (Tar.open_out ?compress) Tar.close_out fn f
+let tryopen_read_gzip fn f =
+ tryopen Gzip.open_in Gzip.close_in fn f
+let tryopen_write_gzip ?level fn f =
+ tryopen (Gzip.open_out ?level) Gzip.close_out fn f
+let tryopen_read_bzip2 fn f =
+ tryopen Bzip2.open_in Bzip2.close_in fn f
+let tryopen_write_bzip2 ?level fn f =
+ tryopen (Bzip2.open_out ?level) Bzip2.close_out fn f
let list_directory filename =
- let dir = opendir filename in
let list = ref [] in
- try
- while true do
- let file = readdir dir in
- if file <> "." && file <> ".." &&
- not (file = ".DS_Store" && Autoconf.system = "macosx") then begin
- list := file :: !list
- end;
- done;
- assert false
- with _ ->
- closedir dir;
- !list
+ tryopen_dir filename (fun dir ->
+ try
+ while true do
+ let file = readdir dir in
+ if file <> "." && file <> ".." &&
+ not (file = ".DS_Store" && Autoconf.system = "macosx") then
+ list := file :: !list
+ done
+ with End_of_file -> ());
+ !list
let iter_directory f dirname =
- let dir = opendir dirname in
- try
- while true do
- let file = readdir dir in
- if file <> "." && file <> ".." then begin
+ tryopen_dir dirname (fun dir ->
+ try
+ while true do
+ let file = readdir dir in
+ if file <> "." && file <> ".." then
f (Filename.concat dirname file)
- end;
- done;
- assert false
- with _ ->
- closedir dir
+ done
+ with End_of_file -> ())
let is_directory filename =
try let s = Unix.stat filename in s.st_kind = S_DIR with _ -> false
@@ -56,31 +87,39 @@
try let s = Unix.lstat filename in s.st_kind = S_LNK with _ -> false
let chmod f o =
- try Unix.chmod f o with e -> lprintf_nl "warning: chmod failed on %s: %s" f
(Printexc2.to_string e)
+ try
+ Unix.chmod f o
+ with e ->
+ lprintf_nl "warning: chmod failed on %s: %s" f (Printexc2.to_string e)
let rec safe_mkdir dir =
if Sys.file_exists dir then begin
- if not (is_directory dir) then
- failwith (Printf.sprintf "%s already exists but is not a directory"
dir)
- end
+ if not (is_directory dir) then
+ failwith (Printf.sprintf "%s already exists but is not a directory" dir)
+ end
else
- if is_link dir then
- begin try
- ignore (opendir dir)
+ if is_link dir then
+ try
+ tryopen_dir dir ignore
with
- Unix.Unix_error (EACCES, _, _) -> lprintf_nl "access denied for
directory %s" dir; exit 73
- | Unix.Unix_error (ENOENT, _, _) -> lprintf_nl "directory %s not found,
orphaned link?" dir; exit 73
- | e -> lprintf_nl "error %s for directory %s" (Printexc2.to_string e)
dir; exit 73
- end
- else begin
+ | Unix.Unix_error (EACCES, _, _) ->
+ lprintf_nl "access denied for directory %s" dir;
+ exit 73
+ | Unix.Unix_error (ENOENT, _, _) ->
+ lprintf_nl "directory %s not found, orphaned link?" dir;
+ exit 73
+ | e ->
+ lprintf_nl "error %s for directory %s" (Printexc2.to_string e) dir;
+ exit 73
+ else
let predir = Filename.dirname dir in
if predir <> dir then safe_mkdir predir;
- begin try
+ try
Unix.mkdir dir 0o775
with
- e -> lprintf_nl "error %s for directory %s" (Printexc2.to_string e)
dir; exit 73
- end
- end
+ e ->
+ lprintf_nl "error %s for directory %s" (Printexc2.to_string e) dir;
+ exit 73
(* same as in downloadClient.ml *)
@@ -101,17 +140,17 @@
really_read fd s (pos + nread) (len - nread)
let copy oldname newname =
- let ic = open_in_bin oldname in
- let oc = open_out_bin newname in
- let buffer_len = 8192 in
- let buffer = String.create buffer_len in
- let rec copy_file () =
- let n = input ic buffer 0 buffer_len in
- if n = 0 then () else begin output oc buffer 0 n; copy_file () end in
- copy_file ();
- close_in ic;
- close_out oc
-
+ tryopen_read_bin oldname (fun ic ->
+ tryopen_write_bin newname (fun oc ->
+ let buffer_len = 8192 in
+ let buffer = String.create buffer_len in
+ let rec copy_file () =
+ let n = input ic buffer 0 buffer_len in
+ if n = 0 then () else begin
+ output oc buffer 0 n;
+ copy_file ()
+ end in
+ copy_file ()))
let rename oldname newname =
if oldname <> newname then
@@ -161,19 +200,30 @@
let rec can_write_to_directory dirname =
let temp_file = Filename.concat dirname "tmp_" ^ random () ^ "_mld.tmp" in
+ let check () =
+ tryopen_openfile temp_file [O_WRONLY; O_CREAT] 0o600 (fun fd ->
+ let test_string = "mldonkey accesstest - this file can be deleted\n" in
+ really_write fd test_string 0 (String.length test_string));
+ (try Sys.remove temp_file with _ -> ()) in
try
- (let oc = open_out_gen [Open_creat; Open_wronly; Open_append] 0o600
temp_file in
- output_string oc "mldonkey accesstest - this file can be deleted";
- close_out oc);
- (try Sys.remove temp_file with _ -> ())
+ check ()
with
- Sys_error s when s = temp_file ^ ": " ^ (Unix.error_message Unix.EACCES) ->
- lprintf_nl "can not create files in directory %s, check rights..."
dirname; exit 73
- | Sys_error s when s = temp_file ^ ": " ^ (Unix.error_message Unix.ENOENT) ->
- (try safe_mkdir dirname; can_write_to_directory dirname with _ ->
- lprintf_nl "%s does not exist and can not be created, exiting..."
dirname; exit 73)
- | Sys_error s -> lprintf_nl "%s for directory %s" s dirname; exit 73
- | e -> lprintf_nl "%s for directory %s" (Printexc2.to_string e) dirname;
exit 73
+ | Unix.Unix_error (Unix.EACCES, _, _) ->
+ lprintf_nl "can not create files in directory %s, check rights..."
dirname;
+ exit 73
+ | Unix.Unix_error (Unix.ENOENT, _, _) ->
+ (try
+ safe_mkdir dirname;
+ check ()
+ with _ ->
+ lprintf_nl "%s does not exist and can not be created, exiting..."
dirname;
+ exit 73)
+ | Unix.Unix_error (error, what, code) ->
+ lprintf_nl "%s for directory %s" (error_message error) what;
+ exit 73
+ | e ->
+ lprintf_nl "%s for directory %s" (Printexc2.to_string e) dirname;
+ exit 73
(** The resource type to query or set with [getrlimit] or [setrlimit] *)
type rlimit_resource = RLIMIT_CPU (** CPU time in seconds *)
Index: mldonkey/src/utils/cdk/zip.ml
diff -u mldonkey/src/utils/cdk/zip.ml:1.5 mldonkey/src/utils/cdk/zip.ml:1.6
--- mldonkey/src/utils/cdk/zip.ml:1.5 Thu Dec 15 19:41:46 2005
+++ mldonkey/src/utils/cdk/zip.ml Mon Apr 3 20:50:09 2006
@@ -10,7 +10,7 @@
(* *)
(***********************************************************************)
-(* $Id: zip.ml,v 1.5 2005/12/15 19:41:46 spiralvoice Exp $ *)
+(* $Id: zip.ml,v 1.6 2006/04/03 20:50:09 spiralvoice Exp $ *)
(* Module [Zip]: reading and writing ZIP archives *)
@@ -545,4 +545,3 @@
with x ->
Pervasives.close_in ic; raise x
-
Index: mldonkey/src/utils/lib/avifile.ml
diff -u mldonkey/src/utils/lib/avifile.ml:1.6
mldonkey/src/utils/lib/avifile.ml:1.7
--- mldonkey/src/utils/lib/avifile.ml:1.6 Wed Dec 14 21:17:47 2005
+++ mldonkey/src/utils/lib/avifile.ml Mon Apr 3 20:50:09 2006
@@ -112,7 +112,7 @@
lprintf "%s: %d" s i
let load file =
- let ic = open_in file in
+ Unix2.tryopen_read file (fun ic ->
(* pos: 0 *)
let s = input_string4 ic in
if s <> "RIFF" then failwith "Not an AVI file (RIFF absent)";
@@ -221,6 +221,5 @@
in
let pos0 = 16L in
- iter_list pos0 (pos0 ++ size);
- close_in ic;
+ iter_list pos0 (pos0 ++ size))
Index: mldonkey/src/utils/lib/gettext.ml4
diff -u mldonkey/src/utils/lib/gettext.ml4:1.5
mldonkey/src/utils/lib/gettext.ml4:1.6
--- mldonkey/src/utils/lib/gettext.ml4:1.5 Mon Aug 1 20:09:13 2005
+++ mldonkey/src/utils/lib/gettext.ml4 Mon Apr 3 20:50:09 2006
@@ -332,10 +332,9 @@
match !strings_file with
None -> ()
| Some filename ->
- if !save_strings_file && not !strings_file_error then
+ if !save_strings_file && not !strings_file_error then
try
- let oc = open_out filename in
- try
+ Unix2.tryopen_write filename (fun oc ->
Hashtbl.iter (fun modname names ->
@@ -361,10 +360,7 @@
) modules;
- close_out oc;
- save_strings_file := false
- with e ->
- close_out oc; raise e
+ save_strings_file := false)
with e ->
lprintf "Gettext.save_strings: Error %s\n\n"
(Printexc2.to_string e)
@@ -400,22 +396,20 @@
(* If the file exists, load it. Check that '%' formats are the same
in the default and in the translation. *)
(*lprintf "Loading...\n"; *)
- begin
- try
- let ic = open_in filename in
+ (try
+ Unix2.tryopen_read filename (fun ic ->
let s = Stream.of_channel ic in
try
let stream = lexer s in
(* lprintf "x\n"; *)
current_modname := "general";
- parse_file stream
+ parse_file stream
with e ->
- close_in ic; strings_file_error := true;
- lprintf "Gettext.set_strings_file: Exception %s in %s at pos %d\n"
- (Printexc2.to_string e) filename (Stream.count s)
+ strings_file_error := true;
+ lprintf "Gettext.set_strings_file: Exception %s in %s at pos %d\n"
+ (Printexc2.to_string e) filename (Stream.count s))
with e ->
- save_strings_file := true
- end;
+ save_strings_file := true);
save_strings ()
@@ -443,22 +437,20 @@
| [< 'String s1 >] -> s1
in
-begin
- try
- let ic = open_in f1 in
+(try
+ Unix2.tryopen_read f1(fun ic ->
let s = Stream.of_channel ic in
try
let stream = lexer s in
(* lprintf "x\n"; *)
parse_file stream
with e ->
- close_in ic; strings_file_error := true;
+ strings_file_error := true;
lprintf "Gettext.set_strings_file: Exception %s in %s at pos %d\n"
- (Printexc2.to_string e) f1 (Stream.count s)
+ (Printexc2.to_string e) f1 (Stream.count s))
with e ->
- save_strings_file := true;
- lprintf "Gettext.set_strings_file: no message file found. Creating one\n"
-end;
+ save_strings_file := true;
+ lprintf "Gettext.set_strings_file: no message file found. Creating one\n");
let translate2 s0 s1 =
try
@@ -478,22 +470,20 @@
| [< 'String s1 >] -> s1
in
- begin
try
- let ic = open_in f2 in
+ Unix2.tryopen_read f2 (fun ic ->
let s = Stream.of_channel ic in
try
let stream = lexer s in
(* lprintf "x\n"; *)
parse_file stream
with e ->
- close_in ic; strings_file_error := true;
+ strings_file_error := true;
lprintf "Gettext.set_strings_file: Exception %s in %s at pos %d\n"
- (Printexc2.to_string e) f2 (Stream.count s)
+ (Printexc2.to_string e) f2 (Stream.count s))
with e ->
- save_strings_file := true;
- lprintf "Gettext.set_strings_file: no message file found. Creating
one\n"
- end;
+ save_strings_file := true;
+ lprintf "Gettext.set_strings_file: no message file found. Creating
one\n"
with _ -> ()
Index: mldonkey/src/utils/lib/misc.ml
diff -u mldonkey/src/utils/lib/misc.ml:1.5 mldonkey/src/utils/lib/misc.ml:1.6
--- mldonkey/src/utils/lib/misc.ml:1.5 Wed Dec 14 21:17:47 2005
+++ mldonkey/src/utils/lib/misc.ml Mon Apr 3 20:50:09 2006
@@ -59,9 +59,8 @@
end
let zip_extract zipfile =
- let ic = Zip.open_in zipfile in
- List.iter (zip_extract_entry ic) (Zip.entries ic);
- Zip.close_in ic
+ Unix2.tryopen_read_zip zipfile (fun ic ->
+ List.iter (zip_extract_entry ic) (Zip.entries ic))
let rec zip_add_entry oc file =
let s = Unix.stat file in
@@ -71,45 +70,41 @@
| Unix.S_DIR ->
Zip.add_entry "" oc ~mtime:s.Unix.st_mtime
(if Filename.check_suffix file "/" then file else file ^ "/");
- let d = Unix.opendir file in
- begin try
- while true do
- let e = Unix.readdir d in
- if e <> "." && e <> ".." then zip_add_entry oc (Filename.concat file
e)
- done
- with End_of_file -> ()
- end;
- Unix.closedir d
+ Unix2.tryopen_dir file (fun d ->
+ try
+ while true do
+ let e = Unix.readdir d in
+ if e <> "." && e <> ".." then
+ zip_add_entry oc (Filename.concat file e)
+ done
+ with End_of_file -> ())
| _ -> ()
let zip_create zipfile files =
- let oc = Zip.open_out zipfile in
- Array.iter (zip_add_entry oc) files;
- Zip.close_out oc
+ Unix2.tryopen_write_zip zipfile (fun oc ->
+ Array.iter (zip_add_entry oc) files)
let gz_extract filename =
- begin
- let file = ref "" in
- try
- let buffer = String.create 4096 in
- let file_out = Filename.temp_file "arch_" ".tmp" in
- file := file_out;
- let ic = Gzip.open_in filename in
- let oc = open_out_bin file_out in
+ let file = ref "" in
+ try
+ let buffer = String.create 4096 in
+ let file_out = Filename.temp_file "arch_" ".tmp" in
+ file := file_out;
+ Unix2.tryopen_read_gzip filename (fun ic ->
+ Unix2.tryopen_write_bin file_out (fun oc ->
let rec decompress () =
let n = Gzip.input ic buffer 0 (String.length buffer) in
- if n = 0 then ()
- else
- begin
- output oc buffer 0 n;
- decompress()
- end
- in decompress();
- Gzip.close_in ic;
- close_out oc;
- file_out
- with e -> (try Sys.remove !file with _ -> ()); raise e
- end
+ if n = 0 then ()
+ else
+ begin
+ output oc buffer 0 n;
+ decompress()
+ end
+ in decompress()));
+ file_out
+ with e ->
+ (try if !file <> "" then Sys.remove !file with _ -> ());
+ raise e
open Misc2
Index: mldonkey/src/utils/lib/options.ml4
diff -u mldonkey/src/utils/lib/options.ml4:1.17
mldonkey/src/utils/lib/options.ml4:1.18
--- mldonkey/src/utils/lib/options.ml4:1.17 Sun Jan 29 18:40:18 2006
+++ mldonkey/src/utils/lib/options.ml4 Mon Apr 3 20:50:09 2006
@@ -254,37 +254,33 @@
Printf.eprintf "Please, check your configurations files, and
rename/remove this file\n";
Printf.eprintf "before restarting\n";
exit 70
- end
- else
- let ic = open_in filename in
+ end;
+ Unix2.tryopen_read filename (fun ic ->
+ let s = Stream.of_channel ic in
try
- let s = Stream.of_channel ic in
- try
- let stream = lexer s in
- Hashtbl.clear once_values;
- let list =
- try parse_gwmlrc stream with
- e ->
- Printf.eprintf "Syntax error while parsing file %s at pos
%d:(%s)\n"
- filename (Stream.count s) (Printexc2.to_string e);
- Printf.eprintf "it seems that %s is corrupt,\n" filename;
- Printf.eprintf "try to use a backup from %s\n"
- (Filename.concat (Sys.getcwd ()) "old_config");
- exit 70
- in
- Hashtbl.clear once_values;
- let affect_option o =
- try
- begin try
- o.option_value <-
- o.option_class.from_value (find_value o.option_name list)
- with
- SideEffectOption -> ()
- end;
- exec_chooks o;
- exec_hooks o
- with
- SideEffectOption -> ()
+ let stream = lexer s in
+ Hashtbl.clear once_values;
+ let list =
+ try
+ parse_gwmlrc stream
+ with e ->
+ Printf.eprintf "Syntax error while parsing file %s at pos %d:(%s)\n"
+ filename (Stream.count s) (Printexc2.to_string e);
+ Printf.eprintf "it seems that %s is corrupt,\n" filename;
+ Printf.eprintf "try to use a backup from %s\n"
+ (Filename.concat (Sys.getcwd ()) "old_config");
+ exit 70 in
+ Hashtbl.clear once_values;
+ let affect_option o =
+ try
+ (try
+ o.option_value <-
+ o.option_class.from_value (find_value o.option_name list)
+ with SideEffectOption -> ());
+ exec_chooks o;
+ exec_hooks o
+ with
+ | SideEffectOption -> ()
| OptionNotFound ->
if !print_options_not_found then
begin
@@ -307,14 +303,10 @@
Don't change this. *)
List.iter (fun s ->
List.iter affect_option s.section_options) sections;
- close_in ic;
- list
- with
- e ->
- lprintf "Error %s in %s\n" (Printexc2.to_string e) filename;
- []
- with
- e -> close_in ic; raise e
+ list
+ with e ->
+ lprintf "Error %s in %s\n" (Printexc2.to_string e) filename;
+ [])
let exit_exn = Exit
@@ -829,38 +821,37 @@
if not (Sys.file_exists old_file) && (Sys.file_exists old_old_file) then
Sys.rename old_old_file old_file;
old_file in
- let oc = open_out temp_file in
- if !save_private then
- ( try Unix.chmod temp_file 0o600 with _ -> () );
try
- once_values_counter := 0;
- title_opfile := true;
- Hashtbl.clear once_values_rev;
- let advanced = ref false in
- List.iter (fun s ->
+ Unix2.tryopen_write temp_file (fun oc ->
+ (* race! *)
+ if !save_private then (try Unix.chmod temp_file 0o600 with _ -> ());
+ once_values_counter := 0;
+ title_opfile := true;
+ Hashtbl.clear once_values_rev;
+ let advanced = ref false in
+ List.iter (fun s ->
let options = List.filter (fun o ->
- if o.option_advanced then advanced := true;
- not o.option_advanced)
- s.section_options in
+ if o.option_advanced then advanced := true;
+ not o.option_advanced) s.section_options in
if options <> [] then begin
- if s.section_name <> [] then begin
- Printf.fprintf oc "\n\n";
- Printf.fprintf oc "
(************************************)\n";
- if !title_opfile then begin
- Printf.fprintf oc " (* Never edit options files when
*)\n";
- Printf.fprintf oc " (* the daemon is running
*)\n";
- Printf.fprintf oc "
(************************************)\n";
- title_opfile := false;
- end;
- Printf.fprintf oc " (* SECTION : %s *)\n"
(string_of_string_list s.section_name);
- Printf.fprintf oc " (* %s *)\n" s.section_help;
- Printf.fprintf oc "
(************************************)\n";
- Printf.fprintf oc "\n\n";
- end;
- save_module "" oc (List.map option_to_value options)
- end
- ) opfile.file_sections;
- if !advanced then begin
+ if s.section_name <> [] then begin
+ Printf.fprintf oc "\n\n";
+ Printf.fprintf oc " (************************************)\n";
+ if !title_opfile then begin
+ Printf.fprintf oc " (* Never edit options files when *)\n";
+ Printf.fprintf oc " (* the daemon is running *)\n";
+ Printf.fprintf oc " (************************************)\n";
+ title_opfile := false;
+ end;
+ Printf.fprintf oc " (* SECTION : %s *)\n"
(string_of_string_list s.section_name);
+ Printf.fprintf oc " (* %s *)\n" s.section_help;
+ Printf.fprintf oc " (************************************)\n";
+ Printf.fprintf oc "\n\n";
+ end;
+ save_module "" oc (List.map option_to_value options)
+ end
+ ) opfile.file_sections;
+ if !advanced then begin
Printf.fprintf oc "\n\n\n";
Printf.fprintf oc
"(*****************************************************************)\n";
Printf.fprintf oc "(*
*)\n";
@@ -872,58 +863,57 @@
Printf.fprintf oc
"(*****************************************************************)\n";
Printf.fprintf oc "\n\n\n";
List.iter (fun s ->
- let options = List.filter (fun o -> o.option_advanced)
- s.section_options in
- if options = [] then () else let _ = () in
- Printf.fprintf oc "\n\n";
- Printf.fprintf oc " (************************************)\n";
-
- Printf.fprintf oc " (* SECTION : %s FOR EXPERTS *)\n"
(string_of_string_list s.section_name);
- Printf.fprintf oc " (* %s *)\n" s.section_help;
- Printf.fprintf oc " (************************************)\n";
- Printf.fprintf oc "\n\n";
- save_module "" oc (List.map option_to_value options)
+ let options = List.filter (fun o -> o.option_advanced)
+ s.section_options in
+ if options = [] then () else let _ = () in
+ Printf.fprintf oc "\n\n";
+ Printf.fprintf oc " (************************************)\n";
+
+ Printf.fprintf oc " (* SECTION : %s FOR EXPERTS *)\n"
(string_of_string_list s.section_name);
+ Printf.fprintf oc " (* %s *)\n" s.section_help;
+ Printf.fprintf oc " (************************************)\n";
+ Printf.fprintf oc "\n\n";
+ save_module "" oc (List.map option_to_value options)
) opfile.file_sections;
end;
- if not opfile.file_pruned then
- begin
- let rem = ref [] in
- Printf.fprintf oc "\n(*\n The following options are not used (errors,
obsolete, ...) \n*)\n";
- List.iter
- (fun (name, value) ->
- try
- List.iter
- (fun s ->
- List.iter
- (fun o ->
- match o.option_name with
- n :: _ -> if n = name then raise Exit
- | _ -> ())
- s.section_options)
- opfile.file_sections;
- rem := (name, value) :: !rem;
- Printf.fprintf oc "%s = " (safe_string name);
- save_value " " oc value;
- Printf.fprintf oc "\n"
- with
- Exit -> ()
- | e ->
- lprintf "Exception %s in Options.save\n"
- (Printexc2.to_string e);
- )
- opfile.file_rc;
- opfile.file_rc <- !rem
- end;
- Hashtbl.clear once_values_rev;
- close_out oc;
- begin try Unix2.rename filename old_file with _ -> () end;
- begin try Unix2.rename temp_file filename with _ -> () end;
+ if not opfile.file_pruned then
+ begin
+ let rem = ref [] in
+ Printf.fprintf oc "\n(*\n The following options are not used
(errors, obsolete, ...) \n*)\n";
+ List.iter
+ (fun (name, value) ->
+ try
+ List.iter
+ (fun s ->
+ List.iter
+ (fun o ->
+ match o.option_name with
+ n :: _ -> if n = name then raise Exit
+ | _ -> ())
+ s.section_options)
+ opfile.file_sections;
+ rem := (name, value) :: !rem;
+ Printf.fprintf oc "%s = " (safe_string name);
+ save_value " " oc value;
+ Printf.fprintf oc "\n"
+ with
+ | Exit -> ()
+ | e ->
+ lprintf "Exception %s in Options.save\n"
+ (Printexc2.to_string e);
+ )
+ opfile.file_rc;
+ opfile.file_rc <- !rem
+ end;
+ Hashtbl.clear once_values_rev);
+ (try
+ Unix2.rename filename old_file;
+ Unix2.rename temp_file filename
+ with _ -> ());
opfile.file_after_save_hook ();
- with
- e ->
- close_out oc;
- opfile.file_after_save_hook ();
- raise e
+ with e ->
+ opfile.file_after_save_hook ();
+ raise e
let save_with_help opfile =
with_help := true;
Index: mldonkey/src/utils/net/geoip.ml
diff -u mldonkey/src/utils/net/geoip.ml:1.4 mldonkey/src/utils/net/geoip.ml:1.5
--- mldonkey/src/utils/net/geoip.ml:1.4 Wed Mar 29 15:41:33 2006
+++ mldonkey/src/utils/net/geoip.ml Mon Apr 3 20:50:09 2006
@@ -137,28 +137,31 @@
ext
in
match real_ext with
- ".zip" ->
- begin
- try
- let ic = Zip.open_in filename in
+ | ".zip" ->
+ (try
+ let file =
+ Unix2.tryopen_read_zip filename (fun ic ->
try
- let file = Zip.find_entry ic "GeoIP.dat" in
- Zip.close_in ic;
- ignore(Misc.archive_extract filename "zip");
- let geo_file = Filename.concat "web_infos" "GeoIP.dat" in
- (try Sys.remove geo_file with _ -> ());
- Unix2.rename file.Zip.filename geo_file;
- geo_file
+ Zip.find_entry ic "GeoIP.dat"
with e ->
- Zip.close_in ic;
lprintf_nl "Exception %s while extracting geoip.dat"
(Printexc2.to_string e);
- raise Not_found
+ raise e) in
+ try
+ ignore(Misc.archive_extract filename "zip");
+ let geo_file = Filename.concat "web_infos" "GeoIP.dat" in
+ (try Sys.remove geo_file with _ -> ());
+ Unix2.rename file.Zip.filename geo_file;
+ geo_file
with e ->
- lprintf_nl "Exception %s while opening %s"
- (Printexc2.to_string e) filename;
- raise Not_found
- end
+ lprintf_nl "Exception %s while extracting geoip.dat"
+ (Printexc2.to_string e);
+ raise e
+ with e ->
+ lprintf_nl "Exception %s while opening %s"
+ (Printexc2.to_string e) filename;
+ raise Not_found)
+
| ".dat.gz" | ".dat.bz2" | ".gz" | ".bz2" ->
begin
let filetype =
Index: mldonkey/src/utils/net/http_client.ml
diff -u mldonkey/src/utils/net/http_client.ml:1.27
mldonkey/src/utils/net/http_client.ml:1.28
--- mldonkey/src/utils/net/http_client.ml:1.27 Sun Jan 29 18:42:02 2006
+++ mldonkey/src/utils/net/http_client.ml Mon Apr 3 20:50:09 2006
@@ -390,10 +390,9 @@
let webinfos_dir = "web_infos" in
Unix2.safe_mkdir webinfos_dir;
Unix2.can_write_to_directory webinfos_dir;
- let filename = Filename.concat webinfos_dir (Filename.basename
r.req_url.Url.short_file) in
- let oc = open_out_bin filename in
- output_string oc s;
- close_out oc;
+ let filename = Filename.concat webinfos_dir
+ (Filename.basename r.req_url.Url.short_file) in
+ Unix2.tryopen_write_bin filename (fun oc -> output_string oc s);
if r.req_save_to_file_time <> 0. then
Unix.utimes filename r.req_save_to_file_time r.req_save_to_file_time;
try
Index: mldonkey/src/utils/net/ip_set.ml
diff -u mldonkey/src/utils/net/ip_set.ml:1.25
mldonkey/src/utils/net/ip_set.ml:1.26
--- mldonkey/src/utils/net/ip_set.ml:1.25 Wed Mar 29 15:41:33 2006
+++ mldonkey/src/utils/net/ip_set.ml Mon Apr 3 20:50:09 2006
@@ -168,11 +168,11 @@
let guardian_regexp = Str.regexp "^\\(.*\\):
*\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)-\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)"
in
let ipfilter_regexp = Str.regexp "^\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)
*- *\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\) *, *[0-9]+ *, *\\(.*\\)$" in
- let cin = open_in filename in
let bl = ref bl in
let nranges = ref 0 in
- let nlines = ref 0 in
let error = ref false in
+ Unix2.tryopen_read filename (fun cin ->
+ let nlines = ref 0 in
try
while true do
let line = input_line cin in
@@ -210,14 +210,12 @@
error := true
end;
lprintf " %d" !nlines;
- done;
- bl_empty (* not reached *)
- with End_of_file ->
- if !error then lprint_newline ();
- close_in cin;
- if remove then (try Sys.remove filename with _ -> ());
- let optimized_bl = bl_optimize !bl in
- lprintf_nl () "%d ranges loaded - optimized to %d" !nranges (bl_length
optimized_bl);
+ done
+ with End_of_file -> ());
+ if !error then lprint_newline ();
+ if remove then (try Sys.remove filename with _ -> ());
+ let optimized_bl = bl_optimize !bl in
+ lprintf_nl () "%d ranges loaded - optimized to %d" !nranges (bl_length
optimized_bl);
(* bl_optimizedp optimized_bl;
for i=0 to 999999 do
let random_ip = Ip.of_ints (Random.int 256, Random.int 256, Random.int
256, Random.int 256) in
@@ -226,7 +224,7 @@
| Some _, Some _ -> ()
| _ -> assert false
done; *)
- optimized_bl
+ optimized_bl
let load filename =
lprintf_nl () "loading %s" filename;
@@ -236,30 +234,27 @@
let filenames_list =
["guarding.p2p"; "guarding_full.p2p"; "ipfilter.dat"] in
(try
- let ic = Zip.open_in filename in
- try
- let rec find_in_zip l =
- match l with
- | [] -> raise Not_found
- | h :: q ->
- try
- let file = Zip.find_entry ic h in
- lprintf_nl () "%s found in zip file" h;
- ignore(Misc.archive_extract filename "zip");
- load_merge bl_empty file.Zip.filename true
- with Not_found ->
- find_in_zip q in
- let bl = find_in_zip filenames_list in
- Zip.close_in ic;
- bl
- with e ->
- Zip.close_in ic;
- lprintf_nl () "Exception %s while extracting %s from %s"
- (Printexc2.to_string e)
- (String.concat "/" filenames_list)
- filename;
- lprintf_nl () "One of the mentioned files has to be present in the
zip file";
- bl_empty
+ Unix2.tryopen_read_zip filename (fun ic ->
+ try
+ let rec find_in_zip l =
+ match l with
+ | [] -> raise Not_found
+ | h :: q ->
+ try
+ let file = Zip.find_entry ic h in
+ lprintf_nl () "%s found in zip file" h;
+ ignore(Misc.archive_extract filename "zip");
+ load_merge bl_empty file.Zip.filename true
+ with Not_found ->
+ find_in_zip q in
+ find_in_zip filenames_list
+ with e ->
+ lprintf_nl () "Exception %s while extracting %s from %s"
+ (Printexc2.to_string e)
+ (String.concat "/" filenames_list)
+ filename;
+ lprintf_nl () "One of the mentioned files has to be present in the
zip file";
+ bl_empty)
with e ->
lprintf_nl () "Exception %s while opening %s"
(Printexc2.to_string e)
Index: mldonkey/src/utils/net/tcpBufferedSocket.ml
diff -u mldonkey/src/utils/net/tcpBufferedSocket.ml:1.42
mldonkey/src/utils/net/tcpBufferedSocket.ml:1.43
--- mldonkey/src/utils/net/tcpBufferedSocket.ml:1.42 Fri Feb 17 22:24:41 2006
+++ mldonkey/src/utils/net/tcpBufferedSocket.ml Mon Apr 3 20:50:09 2006
@@ -1806,27 +1806,20 @@
let load_stats filename =
try
- let ic = open_in filename in
- let rec iter_first ic =
- let titles = input_line ic in
- iter_second ic titles
- and iter_second ic titles =
- let values = input_line ic in
- join_stats titles values;
- iter_first ic
-
- in
- try
- iter_first ic
- with
- End_of_file -> close_in ic
- | e ->
- lprintf "[BWS] Error %s reading %s\n" (Printexc2.to_string e) filename;
- close_in ic; proc_net_fs := false
- with
- | e ->
- lprintf "[BWS] Error %s opening %s\n" (Printexc2.to_string e) filename;
- proc_net_fs := false
+ Unix2.tryopen_read filename (fun ic ->
+ try
+ let rec iter_first ic =
+ let titles = input_line ic in
+ iter_second ic titles
+ and iter_second ic titles =
+ let values = input_line ic in
+ join_stats titles values;
+ iter_first ic in
+ iter_first ic
+ with End_of_file -> ())
+ with e ->
+ lprintf "[BWS] Error %s opening %s\n" (Printexc2.to_string e) filename;
+ proc_net_fs := false
let proc_net_timer _ =
if !proc_net_fs && !verbose_bandwidth > 0 then begin
Index: mldonkey/src/utils/ocamlrss/rss.ml
diff -u mldonkey/src/utils/ocamlrss/rss.ml:1.2
mldonkey/src/utils/ocamlrss/rss.ml:1.3
--- mldonkey/src/utils/ocamlrss/rss.ml:1.2 Thu Jan 26 10:40:01 2006
+++ mldonkey/src/utils/ocamlrss/rss.ml Mon Apr 3 20:50:09 2006
@@ -181,8 +181,7 @@
let print_channel = Rss_io.print_channel
let print_file ?date_fmt file ch =
- let oc = open_out file in
+ Unix2.tryopen_write file (fun oc ->
let fmt = Format.formatter_of_out_channel oc in
print_channel ?date_fmt fmt ch;
- Format.pp_print_flush fmt ();
- close_out oc
+ Format.pp_print_flush fmt ())
- [Mldonkey-commits] mldonkey config/Makefile.in distrib/ChangeLog s...,
mldonkey-commits <=