[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Mldonkey-commits] mldonkey distrib/ChangeLog src/daemon/common/co...
|
From: |
mldonkey-commits |
|
Subject: |
[Mldonkey-commits] mldonkey distrib/ChangeLog src/daemon/common/co... |
|
Date: |
Mon, 09 Jan 2006 00:25:59 +0000 |
CVSROOT: /sources/mldonkey
Module name: mldonkey
Branch:
Changes by: spiralvoice <address@hidden> 06/01/09 00:25:59
Modified files:
distrib : ChangeLog
src/daemon/common: commonFile.ml commonFile.mli commonHasher_c.c
commonInteractive.ml commonOptions.ml
commonShared.ml commonSwarming2.ml
commonUploads.ml
src/daemon/driver: driverLink.ml
src/networks/bittorrent: bTGlobals.ml bTTorrent.ml
src/networks/direct_connect: dcGlobals.ml
src/networks/donkey: donkeyGlobals.ml donkeyInteractive.ml
donkeyMain.ml donkeyShare.ml
src/networks/fasttrack: fasttrackGlobals.ml
src/networks/fileTP: fileTPGlobals.ml
src/networks/gnutella: gnutellaGlobals.ml gnutellaProtocol.ml
src/networks/openFT: openFTGlobals.ml
src/networks/opennap: opennapGlobals.ml
src/networks/soulseek: slskGlobals.ml
src/utils/cdk : unix2.ml
src/utils/lib : md4.ml unix32.ml unix32.mli
tools : get_range.ml make_torrent.ml mld_hash.ml
Log message:
patch #4770
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/distrib/ChangeLog.diff?tr1=1.664&tr2=1.665&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/daemon/common/commonFile.ml.diff?tr1=1.48&tr2=1.49&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/daemon/common/commonFile.mli.diff?tr1=1.11&tr2=1.12&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/daemon/common/commonHasher_c.c.diff?tr1=1.10&tr2=1.11&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/daemon/common/commonInteractive.ml.diff?tr1=1.60&tr2=1.61&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/daemon/common/commonOptions.ml.diff?tr1=1.117&tr2=1.118&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/daemon/common/commonShared.ml.diff?tr1=1.27&tr2=1.28&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/daemon/common/commonSwarming2.ml.diff?tr1=1.25&tr2=1.26&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/daemon/common/commonUploads.ml.diff?tr1=1.38&tr2=1.39&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/daemon/driver/driverLink.ml.diff?tr1=1.8&tr2=1.9&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/networks/bittorrent/bTGlobals.ml.diff?tr1=1.47&tr2=1.48&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/networks/bittorrent/bTTorrent.ml.diff?tr1=1.10&tr2=1.11&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/networks/direct_connect/dcGlobals.ml.diff?tr1=1.11&tr2=1.12&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/networks/donkey/donkeyGlobals.ml.diff?tr1=1.67&tr2=1.68&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/networks/donkey/donkeyInteractive.ml.diff?tr1=1.81&tr2=1.82&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/networks/donkey/donkeyMain.ml.diff?tr1=1.42&tr2=1.43&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/networks/donkey/donkeyShare.ml.diff?tr1=1.36&tr2=1.37&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/networks/fasttrack/fasttrackGlobals.ml.diff?tr1=1.29&tr2=1.30&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/networks/fileTP/fileTPGlobals.ml.diff?tr1=1.17&tr2=1.18&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/networks/gnutella/gnutellaGlobals.ml.diff?tr1=1.33&tr2=1.34&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/networks/gnutella/gnutellaProtocol.ml.diff?tr1=1.17&tr2=1.18&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/networks/openFT/openFTGlobals.ml.diff?tr1=1.4&tr2=1.5&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/networks/opennap/opennapGlobals.ml.diff?tr1=1.10&tr2=1.11&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/networks/soulseek/slskGlobals.ml.diff?tr1=1.11&tr2=1.12&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/utils/cdk/unix2.ml.diff?tr1=1.20&tr2=1.21&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/utils/lib/md4.ml.diff?tr1=1.15&tr2=1.16&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/utils/lib/unix32.ml.diff?tr1=1.53&tr2=1.54&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/utils/lib/unix32.mli.diff?tr1=1.18&tr2=1.19&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/tools/get_range.ml.diff?tr1=1.4&tr2=1.5&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/tools/make_torrent.ml.diff?tr1=1.7&tr2=1.8&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/tools/mld_hash.ml.diff?tr1=1.5&tr2=1.6&r1=text&r2=text
Patches:
Index: mldonkey/distrib/ChangeLog
diff -u mldonkey/distrib/ChangeLog:1.664 mldonkey/distrib/ChangeLog:1.665
--- mldonkey/distrib/ChangeLog:1.664 Mon Jan 9 00:22:58 2006
+++ mldonkey/distrib/ChangeLog Mon Jan 9 00:25:58 2006
@@ -15,6 +15,8 @@
please test carefully and report your findings.
2006/01/09
+4770: Change file opening mechanism, open rw only when needed (pango)
+ new verbosity option "file" to control Unix32 file handling
4777: Display IP:port for LowID clients, GUI protocol update (zet)
2006/01/07
Index: mldonkey/src/daemon/common/commonFile.ml
diff -u mldonkey/src/daemon/common/commonFile.ml:1.48
mldonkey/src/daemon/common/commonFile.ml:1.49
--- mldonkey/src/daemon/common/commonFile.ml:1.48 Mon Jan 9 00:22:35 2006
+++ mldonkey/src/daemon/common/commonFile.ml Mon Jan 9 00:25:58 2006
@@ -52,7 +52,7 @@
mutable impl_file_ops : 'a file_ops;
mutable impl_file_size : int64;
mutable impl_file_age : int;
- mutable impl_file_fd : Unix32.t;
+ mutable impl_file_fd : Unix32.t option;
mutable impl_file_downloaded : int64;
mutable impl_file_received : int64;
mutable impl_file_last_received : (int64 * int) list;
@@ -121,7 +121,7 @@
impl_file_ops = Obj.magic 0;
impl_file_size = Int64.zero;
impl_file_age = 0;
- impl_file_fd = Unix32.create_diskfile "" [Unix.O_RDONLY] 0o666;
+ impl_file_fd = None;
impl_file_downloaded = Int64.zero;
impl_file_received = Int64.zero;
impl_file_last_received = [];
@@ -410,19 +410,20 @@
let file_size file =
(as_file_impl file).impl_file_size
-let file_disk_name file =
- Unix32.filename (as_file_impl file).impl_file_fd
-
let file_fd file =
- (as_file_impl file).impl_file_fd
+ match (as_file_impl file).impl_file_fd with
+ | Some fd -> fd
+ | None -> raise Not_found
+
+let file_disk_name file =
+ Unix32.filename (file_fd file)
let set_file_fd file fd =
- (as_file_impl file).impl_file_fd <- fd
+ (as_file_impl file).impl_file_fd <- Some fd
let set_file_disk_name file filename =
let orig_fd = file_fd file in
- if orig_fd != Unix32.bad_fd then
- Unix32.rename orig_fd filename
+ Unix32.rename orig_fd filename
let file_downloaded file = (as_file_impl file).impl_file_downloaded
Index: mldonkey/src/daemon/common/commonFile.mli
diff -u mldonkey/src/daemon/common/commonFile.mli:1.11
mldonkey/src/daemon/common/commonFile.mli:1.12
--- mldonkey/src/daemon/common/commonFile.mli:1.11 Tue Dec 6 19:34:04 2005
+++ mldonkey/src/daemon/common/commonFile.mli Mon Jan 9 00:25:58 2006
@@ -27,7 +27,7 @@
mutable impl_file_ops : 'a file_ops;
mutable impl_file_size : int64;
mutable impl_file_age : int;
- mutable impl_file_fd : Unix32.t;
+ mutable impl_file_fd : Unix32.t option;
mutable impl_file_downloaded : int64;
mutable impl_file_received : int64;
mutable impl_file_last_received : (int64 * int) list;
Index: mldonkey/src/daemon/common/commonHasher_c.c
diff -u mldonkey/src/daemon/common/commonHasher_c.c:1.10
mldonkey/src/daemon/common/commonHasher_c.c:1.11
--- mldonkey/src/daemon/common/commonHasher_c.c:1.10 Wed Dec 28 21:33:24 2005
+++ mldonkey/src/daemon/common/commonHasher_c.c Mon Jan 9 00:25:58 2006
@@ -328,28 +328,35 @@
/* fprintf(stderr,"waiting for next job\n"); */
pthread_cond_timedwait(&cond, &mutex, &timeout);
- if(!job_done){
+ if(!job_done) {
/* fprintf(stderr,"job started\n"); */
- if(job_method == METHOD_MD4)
- md4_unsafe64_fd_direct(job_fd, job_begin_pos, job_len, p_job_result);
- else
- if( job_method == METHOD_MD5)
- md5_unsafe64_fd_direct(job_fd, job_begin_pos, job_len, p_job_result);
- else
- if( job_method == METHOD_SHA1)
- sha1_unsafe64_fd_direct(job_fd, job_begin_pos, job_len,
p_job_result);
- else
- if( job_method == METHOD_TIGER){
- long bsize = tiger_block_size(job_len);
- tiger_tree_fd(job_fd, job_len, 0, bsize, p_job_result);
- } else {
- printf("commonHasher_c.c: method sha1 not implemented\n");
- exit(2);
- }
- /* fprintf(stderr,"job finished\n"); */
- job_done = 1;
+ long bsize;
+ switch(job_method) {
+ case METHOD_MD4:
+ md4_unsafe64_fd_direct(job_fd, job_begin_pos, job_len, job_result);
+ break;
+
+ case METHOD_MD5:
+ md5_unsafe64_fd_direct(job_fd, job_begin_pos, job_len, job_result);
+ break;
+
+ case METHOD_SHA1:
+ sha1_unsafe64_fd_direct(job_fd, job_begin_pos, job_len, job_result);
+ break;
+
+ case METHOD_TIGER:
+ bsize = tiger_block_size(job_len);
+ tiger_tree_fd(job_fd, job_len, 0, bsize, job_result);
+ break;
+
+ default:
+ printf("commonHasher_c.c: method not implemented\n");
+ exit(2);
+ }
+ /* fprintf(stderr,"job finished\n"); */
+ job_done = 1;
}
}
Index: mldonkey/src/daemon/common/commonInteractive.ml
diff -u mldonkey/src/daemon/common/commonInteractive.ml:1.60
mldonkey/src/daemon/common/commonInteractive.ml:1.61
--- mldonkey/src/daemon/common/commonInteractive.ml:1.60 Sun Jan 1
19:36:03 2006
+++ mldonkey/src/daemon/common/commonInteractive.ml Mon Jan 9 00:25:58 2006
@@ -231,14 +231,16 @@
with e ->
lprintf_nl "[cInt] Exception %s in file_cancel"
(Printexc2.to_string e);
) subfiles;
- (try
- let fd = file_fd file in
- if fd != Unix32.bad_fd then Unix32.remove (file_fd file)
- with e ->
- lprintf_nl "[cInt]Sys.remove %s exception %s"
- (file_disk_name file)
- (Printexc2.to_string e); );
- Unix32.destroy (file_fd file);
+ try
+ let fd = file_fd file in
+ (try
+ Unix32.remove fd
+ with e ->
+ lprintf_nl "[cInt]Sys.remove %s exception %s"
+ (file_disk_name file)
+ (Printexc2.to_string e));
+ Unix32.destroy fd
+ with Not_found -> ()
with e ->
lprintf_nl "[cInt] Exception in file_cancel: %s" (Printexc2.to_string e)
Index: mldonkey/src/daemon/common/commonOptions.ml
diff -u mldonkey/src/daemon/common/commonOptions.ml:1.117
mldonkey/src/daemon/common/commonOptions.ml:1.118
--- mldonkey/src/daemon/common/commonOptions.ml:1.117 Fri Jan 6 22:32:36 2006
+++ mldonkey/src/daemon/common/commonOptions.ml Mon Jan 9 00:25:58 2006
@@ -437,6 +437,7 @@
sm : debug source management
net : debug net
gui : debug gui
+ file : debug file handling
do : some download warnings
up : some upload warnings
unk : unknown messages
@@ -1579,7 +1580,7 @@
if !!log_file <> "" then
try
if Sys.file_exists !!log_file then
- if (Unix32.getsize !!log_file false)
+ if (Unix32.getsize !!log_file)
> (Int64ops.megabytes !!log_file_size) then begin
Sys.remove !!log_file;
lprintf_nl "Logfile %s reset: bigger than %d MB" !!log_file
!!log_file_size
@@ -1693,6 +1694,7 @@
BasicSocket.debug := v;
TcpServerSocket.debug := v;
UdpSocket.debug := v;
+ Unix32.verbose := v;
verbose_download := v;
verbose_upload := v;
verbose_unknown_messages := v;
@@ -1724,6 +1726,7 @@
| "verb" -> verbose := true
| "sm" -> incr verbose_sources
| "net" -> BasicSocket.debug := true; TcpServerSocket.debug := true;
UdpSocket.debug := true
+ | "file" -> Unix32.verbose := true
| "gui" -> GuiProto.verbose_gui_decoding := true
| "do" -> verbose_download := true
| "up" -> verbose_upload := true
Index: mldonkey/src/daemon/common/commonShared.ml
diff -u mldonkey/src/daemon/common/commonShared.ml:1.27
mldonkey/src/daemon/common/commonShared.ml:1.28
--- mldonkey/src/daemon/common/commonShared.ml:1.27 Mon Jan 2 12:08:14 2006
+++ mldonkey/src/daemon/common/commonShared.ml Mon Jan 9 00:25:58 2006
@@ -145,7 +145,7 @@
let codedname = Filename.concat dirname filename in
if !verbose_share then
lprintf_nl () "sharing %s" fullname;
- let size = Unix32.getsize fullname false in
+ let size = Unix32.getsize fullname in
incr files_scanned;
files_scanned_size := !files_scanned_size ++ size;
if Unix2.is_directory fullname then begin
@@ -277,7 +277,7 @@
end
else
try
- let size = (Unix32.getsize full_name) false in
+ let size = Unix32.getsize full_name in
if size > strategy.sharing_minsize &&
size < strategy.sharing_maxsize &&
(strategy.sharing_extensions = [] ||
Index: mldonkey/src/daemon/common/commonSwarming2.ml
diff -u mldonkey/src/daemon/common/commonSwarming2.ml:1.25
mldonkey/src/daemon/common/commonSwarming2.ml:1.26
--- mldonkey/src/daemon/common/commonSwarming2.ml:1.25 Sat Dec 24 02:36:09 2005
+++ mldonkey/src/daemon/common/commonSwarming2.ml Mon Jan 9 00:25:58 2006
@@ -3220,7 +3220,7 @@
let block_sizes = [| 1000; 400; 299 |]
let block_sizes = Array.map Int64.of_int block_sizes
- let file_check_fd = Unix32.create_diskfile file Unix32.rw_flag 0o444
+ let file_check_fd = Unix32.create_diskfile file true
module S = Make(struct
@@ -3315,7 +3315,7 @@
let nchunks = Int64.to_int (Int64.pred file_size //
block_size) + 1 in
let file = {
- file_fd = Unix32.create_diskfile temp_filename
Unix32.rw_flag 0o666;
+ file_fd = Unix32.create_diskfile temp_filename true;
file_num = i;
file_name = "toto";
file_size = file_size;
Index: mldonkey/src/daemon/common/commonUploads.ml
diff -u mldonkey/src/daemon/common/commonUploads.ml:1.38
mldonkey/src/daemon/common/commonUploads.ml:1.39
--- mldonkey/src/daemon/common/commonUploads.ml:1.38 Wed Dec 14 21:17:46 2005
+++ mldonkey/src/daemon/common/commonUploads.ml Mon Jan 9 00:25:58 2006
@@ -499,8 +499,8 @@
| MD5EXT ->
let md5ext =
try
- let fd = Unix32.create_rw info.shared_fullname in
- let file_size = Unix32.getsize64 fd false in
+ let fd = Unix32.create_ro info.shared_fullname in
+ let file_size = Unix32.getsize64 fd in
let len64 = min 307200L file_size in
let len = Int64.to_int len64 in
let s = String.create len in
Index: mldonkey/src/daemon/driver/driverLink.ml
diff -u mldonkey/src/daemon/driver/driverLink.ml:1.8
mldonkey/src/daemon/driver/driverLink.ml:1.9
--- mldonkey/src/daemon/driver/driverLink.ml:1.8 Wed Dec 14 21:17:46 2005
+++ mldonkey/src/daemon/driver/driverLink.ml Mon Jan 9 00:25:58 2006
@@ -373,7 +373,7 @@
let file = correct_file file in
if !verbose_dp500 then lprintf "Size of [%s]\n" file;
let fd = Unix32.create_ro file in
- let size = Unix32.getsize64 fd false in
+ let size = Unix32.getsize64 fd in
write_string sock (Printf.sprintf "%015Ld" size)
else
if command = "GET" then
@@ -394,7 +394,7 @@
end;
let pclink_buf, len_read =
if len_read = 0 then
- let size = Unix32.getsize64 fd false in
+ let size = Unix32.getsize64 fd in
let size = Int64.to_int size in
String.create size, size
else
Index: mldonkey/src/networks/bittorrent/bTGlobals.ml
diff -u mldonkey/src/networks/bittorrent/bTGlobals.ml:1.47
mldonkey/src/networks/bittorrent/bTGlobals.ml:1.48
--- mldonkey/src/networks/bittorrent/bTGlobals.ml:1.47 Sun Jan 1 19:36:03 2006
+++ mldonkey/src/networks/bittorrent/bTGlobals.ml Mon Jan 9 00:25:58 2006
@@ -55,7 +55,7 @@
let file_size file = file.file_file.impl_file_size
let file_downloaded file = file_downloaded (as_file file)
let file_age file = file.file_file.impl_file_age
-let file_fd file = file.file_file.impl_file_fd
+let file_fd file = file_fd (as_file file)
let file_disk_name file = file_disk_name (as_file file)
let file_state file = file_state (as_file file)
let file_num file = file_num (as_file file)
@@ -169,7 +169,7 @@
let file_fd =
if file_files <> [] then
Unix32.create_multifile file_temp
- [Unix.O_RDWR; Unix.O_CREAT] 0o666 file_files
+ true file_files
else
Unix32.create_rw file_temp
in
@@ -226,7 +226,7 @@
file_shared = None;
} and file_impl = {
dummy_file_impl with
- impl_file_fd = file_fd;
+ impl_file_fd = Some file_fd;
impl_file_size = t.torrent_length;
impl_file_downloaded = Int64.zero;
impl_file_val = file;
@@ -291,7 +291,7 @@
ft_retry = (fun _ -> ());
} and file_impl = {
dummy_file_impl with
- impl_file_fd = Unix32.bad_fd;
+ impl_file_fd = None;
impl_file_size = zero;
impl_file_downloaded = Int64.zero;
impl_file_val = ft;
Index: mldonkey/src/networks/bittorrent/bTTorrent.ml
diff -u mldonkey/src/networks/bittorrent/bTTorrent.ml:1.10
mldonkey/src/networks/bittorrent/bTTorrent.ml:1.11
--- mldonkey/src/networks/bittorrent/bTTorrent.ml:1.10 Sun Jan 1 19:36:03 2006
+++ mldonkey/src/networks/bittorrent/bTTorrent.ml Mon Jan 9 00:25:58 2006
@@ -387,19 +387,19 @@
if Unix2.is_directory fullname then
iter_directory list basename
else
- (basename, Unix32.getsize fullname false) :: list
+ (basename, Unix32.getsize fullname) :: list
in
iter_files left dirname tail
in
let files = iter_directory [] "" in
- let t = Unix32.create_multifile filename Unix32.ro_flag 0o666 files in
+ let t = Unix32.create_multifile filename false files in
files, t
else
[], Unix32.create_ro filename
in
Unix32.flush_fd t;
- let length = Unix32.getsize64 t false in
+ let length = Unix32.getsize64 t in
let npieces = 1+ Int64.to_int ((length -- one) // chunk_size) in
let pieces = Array.create npieces Sha1.null in
for i = 0 to npieces - 1 do
Index: mldonkey/src/networks/direct_connect/dcGlobals.ml
diff -u mldonkey/src/networks/direct_connect/dcGlobals.ml:1.11
mldonkey/src/networks/direct_connect/dcGlobals.ml:1.12
--- mldonkey/src/networks/direct_connect/dcGlobals.ml:1.11 Tue Jul 5
12:28:57 2005
+++ mldonkey/src/networks/direct_connect/dcGlobals.ml Mon Jan 9 00:25:58 2006
@@ -278,7 +278,7 @@
file_clients = [];
} and impl = {
dummy_file_impl with
- impl_file_fd = t;
+ impl_file_fd = Some t;
impl_file_size = file_size;
impl_file_downloaded = current_size;
impl_file_val = file;
@@ -458,5 +458,5 @@
let file_size file = file.file_file.impl_file_size
let file_downloaded file = file_downloaded (as_file file.file_file)
let file_age file = file.file_file.impl_file_age
-let file_fd file = file.file_file.impl_file_fd
-
\ No newline at end of file
+let file_fd file = file_fd (as_file file.file_file)
+
Index: mldonkey/src/networks/donkey/donkeyGlobals.ml
diff -u mldonkey/src/networks/donkey/donkeyGlobals.ml:1.67
mldonkey/src/networks/donkey/donkeyGlobals.ml:1.68
--- mldonkey/src/networks/donkey/donkeyGlobals.ml:1.67 Mon Jan 9 00:22:35 2006
+++ mldonkey/src/networks/donkey/donkeyGlobals.ml Mon Jan 9 00:25:58 2006
@@ -100,7 +100,7 @@
let file_size file = file.file_file.impl_file_size
let file_downloaded file = file_downloaded (as_file file)
let file_age file = file.file_file.impl_file_age
-let file_fd file = file.file_file.impl_file_fd
+let file_fd file = file_fd (as_file file)
let file_disk_name file = file_disk_name (as_file file)
let file_best_name file = file_best_name (as_file file)
@@ -307,7 +307,7 @@
&& file.file_diskname = file_diskname
then
file.file_file.impl_file_fd <-
- Unix32.create_diskfile file.file_diskname Unix32.rw_flag 0o666;
+ Some (Unix32.create_diskfile file.file_diskname true);
if Unix32.destroyed (file_fd file) then
lprintf_nl () "New Edonkey file with %b && %b remaining destroyed fd
%s"
(not writable) (file.file_diskname = file_diskname)
file.file_diskname;
@@ -326,14 +326,14 @@
(* Only if the file does not already exists *)
not (Sys.file_exists file_diskname)
then
- Unix32.create_sparsefile file_diskname
+ Unix32.create_sparsefile file_diskname writable
else
- Unix32.create_diskfile file_diskname Unix32.rw_flag 0o666
+ Unix32.create_diskfile file_diskname writable
in
let file_size =
if file_size = Int64.zero then
try
- Unix32.getsize file_diskname writable
+ Unix32.getsize file_diskname
with _ ->
failwith "Zero length file ?"
else file_size
@@ -365,7 +365,7 @@
impl_file_ops = file_ops;
impl_file_age = last_time ();
impl_file_size = file_size;
- impl_file_fd = t;
+ impl_file_fd = Some t;
impl_file_best_name = Filename.basename file_diskname;
impl_file_last_seen = last_time () - 100 * 24 * 3600;
}
Index: mldonkey/src/networks/donkey/donkeyInteractive.ml
diff -u mldonkey/src/networks/donkey/donkeyInteractive.ml:1.81
mldonkey/src/networks/donkey/donkeyInteractive.ml:1.82
--- mldonkey/src/networks/donkey/donkeyInteractive.ml:1.81 Mon Jan 9
00:22:35 2006
+++ mldonkey/src/networks/donkey/donkeyInteractive.ml Mon Jan 9 00:25:58 2006
@@ -1494,7 +1494,7 @@
ignore (Hashtbl.find files_by_md4 md4)
with Not_found ->
let file_diskname = Filename.concat !!temp_directory filename in
- let size = Unix32.getsize file_diskname true in
+ let size = Unix32.getsize file_diskname in
if size <> zero then
let names =
(* TODO RESULT
Index: mldonkey/src/networks/donkey/donkeyMain.ml
diff -u mldonkey/src/networks/donkey/donkeyMain.ml:1.42
mldonkey/src/networks/donkey/donkeyMain.ml:1.43
--- mldonkey/src/networks/donkey/donkeyMain.ml:1.42 Sun Dec 18 14:50:38 2005
+++ mldonkey/src/networks/donkey/donkeyMain.ml Mon Jan 9 00:25:59 2006
@@ -183,7 +183,9 @@
let enabler = ref true in
is_enabled := true;
network.op_network_disable <- disable enabler;
- client_public_key := Unix32.load_key (!!client_private_key);
+ (try
+ client_public_key := Unix32.load_key (!!client_private_key)
+ with _ -> ());
if not !!enable_donkey then enable_donkey =:= true;
try
@@ -216,7 +218,7 @@
try
let file_disk_name = file_disk_name file in
if Unix32.file_exists file_disk_name &&
- Unix32.getsize file_disk_name false <> Int64.zero then
begin
+ Unix32.getsize file_disk_name <> Int64.zero then begin
(* getsize writable=false is ok because file has state
FileDownloaded *)
lprintf_nl () "FILE DOWNLOADED";
Index: mldonkey/src/networks/donkey/donkeyShare.ml
diff -u mldonkey/src/networks/donkey/donkeyShare.ml:1.36
mldonkey/src/networks/donkey/donkeyShare.ml:1.37
--- mldonkey/src/networks/donkey/donkeyShare.ml:1.36 Sun Jan 1 19:36:03 2006
+++ mldonkey/src/networks/donkey/donkeyShare.ml Mon Jan 9 00:25:59 2006
@@ -216,7 +216,7 @@
lprintf_nl () "Shared file doesn't exist";
raise Not_found;
end;
- if Unix32.getsize sh.shared_name false <> sh.shared_size then begin
+ if Unix32.getsize sh.shared_name <> sh.shared_size then begin
lprintf_nl () "Bad shared file size";
raise Not_found;
end;
Index: mldonkey/src/networks/fasttrack/fasttrackGlobals.ml
diff -u mldonkey/src/networks/fasttrack/fasttrackGlobals.ml:1.29
mldonkey/src/networks/fasttrack/fasttrackGlobals.ml:1.30
--- mldonkey/src/networks/fasttrack/fasttrackGlobals.ml:1.29 Mon Jan 9
00:22:35 2006
+++ mldonkey/src/networks/fasttrack/fasttrackGlobals.ml Mon Jan 9 00:25:59 2006
@@ -78,7 +78,7 @@
let file_size file = file.file_file.impl_file_size
let file_downloaded file = file_downloaded (as_file file)
let file_age file = file.file_file.impl_file_age
-let file_fd file = file.file_file.impl_file_fd
+let file_fd file = file_fd (as_file file)
let file_disk_name file = file_disk_name (as_file file)
let file_state file =
file_state (as_file file)
@@ -274,7 +274,7 @@
file_ttr = None;
} and file_impl = {
dummy_file_impl with
- impl_file_fd = t;
+ impl_file_fd = Some t;
impl_file_size = file_size;
impl_file_downloaded = Int64.zero;
impl_file_val = file;
Index: mldonkey/src/networks/fileTP/fileTPGlobals.ml
diff -u mldonkey/src/networks/fileTP/fileTPGlobals.ml:1.17
mldonkey/src/networks/fileTP/fileTPGlobals.ml:1.18
--- mldonkey/src/networks/fileTP/fileTPGlobals.ml:1.17 Fri Dec 2 12:08:26 2005
+++ mldonkey/src/networks/fileTP/fileTPGlobals.ml Mon Jan 9 00:25:59 2006
@@ -71,7 +71,7 @@
let file_size file = file.file_file.impl_file_size
let file_downloaded file = file_downloaded (as_file file)
let file_age file = file.file_file.impl_file_age
-let file_fd file = file.file_file.impl_file_fd
+let file_fd file = file_fd (as_file file)
let file_disk_name file = file_disk_name (as_file file)
let file_best_name file = file_best_name (as_file file)
@@ -147,7 +147,7 @@
file_nconnected_clients = 0;
} and file_impl = {
dummy_file_impl with
- impl_file_fd = t;
+ impl_file_fd = Some t;
impl_file_size = zero;
impl_file_downloaded = zero;
impl_file_val = file;
Index: mldonkey/src/networks/gnutella/gnutellaGlobals.ml
diff -u mldonkey/src/networks/gnutella/gnutellaGlobals.ml:1.33
mldonkey/src/networks/gnutella/gnutellaGlobals.ml:1.34
--- mldonkey/src/networks/gnutella/gnutellaGlobals.ml:1.33 Mon Jan 9
00:22:35 2006
+++ mldonkey/src/networks/gnutella/gnutellaGlobals.ml Mon Jan 9 00:25:59 2006
@@ -78,7 +78,7 @@
let file_size file = file.file_file.impl_file_size
let file_downloaded file = file_downloaded (as_file file)
let file_age file = file.file_file.impl_file_age
-let file_fd file = file.file_file.impl_file_fd
+let file_fd file = file_fd (as_file file)
let file_disk_name file = file_disk_name (as_file file)
let file_state file = file_state (as_file file)
let file_num file = file_num (as_file file)
@@ -304,7 +304,7 @@
file_ttr = None;
} and file_impl = {
dummy_file_impl with
- impl_file_fd = t;
+ impl_file_fd = Some t;
impl_file_size = file_size;
impl_file_downloaded = Int64.zero;
impl_file_val = file;
Index: mldonkey/src/networks/gnutella/gnutellaProtocol.ml
diff -u mldonkey/src/networks/gnutella/gnutellaProtocol.ml:1.17
mldonkey/src/networks/gnutella/gnutellaProtocol.ml:1.18
--- mldonkey/src/networks/gnutella/gnutellaProtocol.ml:1.17 Sun Oct 16
20:42:54 2005
+++ mldonkey/src/networks/gnutella/gnutellaProtocol.ml Mon Jan 9 00:25:59 2006
@@ -511,7 +511,7 @@
(fun pos upload_buffer spos rlen ->
Unix32.read fd pos upload_buffer spos rlen),
- Unix32.getsize64 fd false, []
+ Unix32.getsize64 fd, []
else
failwith (Printf.sprintf "Cannot find TigerTree [%s]" urn)
| _ -> failwith "Cannot parse /uri-res/N2T request"
Index: mldonkey/src/networks/openFT/openFTGlobals.ml
diff -u mldonkey/src/networks/openFT/openFTGlobals.ml:1.4
mldonkey/src/networks/openFT/openFTGlobals.ml:1.5
--- mldonkey/src/networks/openFT/openFTGlobals.ml:1.4 Mon Nov 1 11:23:02 2004
+++ mldonkey/src/networks/openFT/openFTGlobals.ml Mon Jan 9 00:25:59 2006
@@ -61,7 +61,7 @@
let file_size file = file.file_file.impl_file_size
let file_downloaded file = file.file_file.impl_file_downloaded
let file_age file = file.file_file.impl_file_age
-let file_fd file = file.file_file.impl_file_fd
+let file_fd file = file_fd (as_file file.file_file)
let file_disk_name file = file_disk_name (as_file file.file_file)
let set_file_disk_name file = set_file_disk_name (as_file file.file_file)
@@ -187,7 +187,7 @@
file_clients = [];
} and file_impl = {
dummy_file_impl with
- impl_file_fd = Unix32.create file_temp [Unix.O_RDWR; Unix.O_CREAT]
0o666;
+ impl_file_fd = Some (Unix32.create_rw file_temp);
impl_file_size = file_size;
impl_file_downloaded = current_size;
impl_file_val = file;
Index: mldonkey/src/networks/opennap/opennapGlobals.ml
diff -u mldonkey/src/networks/opennap/opennapGlobals.ml:1.10
mldonkey/src/networks/opennap/opennapGlobals.ml:1.11
--- mldonkey/src/networks/opennap/opennapGlobals.ml:1.10 Tue Jun 28
23:17:07 2005
+++ mldonkey/src/networks/opennap/opennapGlobals.ml Mon Jan 9 00:25:59 2006
@@ -203,7 +203,7 @@
dummy_file_impl with
impl_file_ops = file_ops;
impl_file_val = file;
- impl_file_fd = t;
+ impl_file_fd = Some t;
impl_file_size = file_size;
impl_file_downloaded = current_size;
impl_file_age = last_time ();
@@ -327,7 +327,7 @@
let file_size file = file.file_file.impl_file_size
let file_downloaded file = file_downloaded (as_file file.file_file)
let file_age file = file.file_file.impl_file_age
-let file_fd file = file.file_file.impl_file_fd
+let file_fd file = file_fd (as_file file.file_file)
let shared_counter = ref (Int64.zero)
Index: mldonkey/src/networks/soulseek/slskGlobals.ml
diff -u mldonkey/src/networks/soulseek/slskGlobals.ml:1.11
mldonkey/src/networks/soulseek/slskGlobals.ml:1.12
--- mldonkey/src/networks/soulseek/slskGlobals.ml:1.11 Sat May 28 11:19:42 2005
+++ mldonkey/src/networks/soulseek/slskGlobals.ml Mon Jan 9 00:25:59 2006
@@ -93,7 +93,7 @@
let file_size file = file.file_file.impl_file_size
let file_downloaded file = file_downloaded (as_file file.file_file)
let file_age file = file.file_file.impl_file_age
-let file_fd file = file.file_file.impl_file_fd
+let file_fd file = file_fd (as_file file.file_file)
let client_type c =
client_type (as_client c.client_client)
@@ -268,7 +268,7 @@
file_clients = [];
} and impl = {
dummy_file_impl with
- impl_file_fd = Unix32.create_rw file_temp;
+ impl_file_fd = Some (Unix32.create_rw file_temp);
impl_file_size = file_size;
impl_file_downloaded = current_size;
impl_file_val = file;
Index: mldonkey/src/utils/cdk/unix2.ml
diff -u mldonkey/src/utils/cdk/unix2.ml:1.20
mldonkey/src/utils/cdk/unix2.ml:1.21
--- mldonkey/src/utils/cdk/unix2.ml:1.20 Wed Dec 14 21:17:47 2005
+++ mldonkey/src/utils/cdk/unix2.ml Mon Jan 9 00:25:59 2006
@@ -132,6 +132,7 @@
"unix_lseek_64"
external c_getsize64 : string -> int64 = "ml_getsize64"
external c_getfdsize64 : Unix.file_descr -> int64 = "ml_getfdsize64"
+(* c_ftruncate64 sets size, optionally using a sparse file *)
external c_ftruncate64 : Unix.file_descr -> int64 -> bool -> unit =
"mld_ftruncate_64"
external c_getdtablesize : unit -> int = "ml_getdtablesize"
Index: mldonkey/src/utils/lib/md4.ml
diff -u mldonkey/src/utils/lib/md4.ml:1.15 mldonkey/src/utils/lib/md4.ml:1.16
--- mldonkey/src/utils/lib/md4.ml:1.15 Sun Oct 16 20:42:55 2005
+++ mldonkey/src/utils/lib/md4.ml Mon Jan 9 00:25:59 2006
@@ -341,7 +341,7 @@
let file s =
let digest = String.create hash_length in
- let file_size = Unix32.getsize s false in
+ let file_size = Unix32.getsize s in
unsafe_file digest s file_size;
digest
@@ -489,7 +489,7 @@
"tigertree_unsafe64_fd"
let unsafe_file digest filename file_size =
- let fd = Unix32.create_diskfile filename [Unix.O_RDONLY] 0o444 in
+ let fd = Unix32.create_diskfile filename false in
Unix32.apply_on_chunk fd Int64.zero file_size
(fun fd pos ->
digest_subfile digest fd pos file_size)
Index: mldonkey/src/utils/lib/unix32.ml
diff -u mldonkey/src/utils/lib/unix32.ml:1.53
mldonkey/src/utils/lib/unix32.ml:1.54
--- mldonkey/src/utils/lib/unix32.ml:1.53 Wed Dec 28 21:37:39 2005
+++ mldonkey/src/utils/lib/unix32.ml Mon Jan 9 00:25:59 2006
@@ -22,114 +22,143 @@
open Int64ops
open Printf2
+let lprintf_nl =
+ (fun format ->
+ lprintf "%s[Ux32] " (log_time ());
+ lprintf_nl2 format)
+
let chunk_min_size = ref 65000L
-
+
let max_buffered = ref (Int64.of_int (1024 * 1024))
-
+
let create_dir_mask = ref "755"
-let verbose = false
+let verbose = ref false
let max_cache_size = ref 50
-
+
let mini (x: int) (y: int) =
if x > y then y else x
-
+
let rights = 0o664
-
+
let ro_flag = [Unix.O_RDONLY]
-let rw_flag = [Unix.O_CREAT; Unix.O_RDWR]
-
+let rw_flag = [Unix.O_RDWR]
+let rw_creat_flag = [Unix.O_CREAT; Unix.O_RDWR]
+
external external_start : string -> unit = "external_start"
external external_exit : unit -> unit = "external_exit"
external uname : unit -> string = "ml_uname"
-
+
(* CryptoPP *)
external create_key : unit -> string = "ml_createKey"
external load_key : string -> string = "ml_loadKey"
external create_signature : string -> int -> int64 -> int -> int64 -> string =
"ml_createSignature"
external verify_signature : string -> int -> string -> int -> int64 -> int ->
int64 -> bool = "ml_verifySignature_bytecode" "ml_verifySignature"
-
-let really_write fd s pos len =
+
+(* let really_write fd s pos len =
try
Unix2.really_write fd s pos len
- with e -> raise e
+ with e -> raise e *)
+let really_write = Unix2.really_write
module FDCache = struct
type t = {
mutable fd : Unix.file_descr option;
mutable filename : string;
- mutable destroyed : bool;
-(* mutable exist : bool; *)
- }
-
+ mutable writable : bool;
+ mutable destroyed : bool; (* could we get rid of this ? *)
+ }
+
let cache_size = ref 0
let cache = Fifo.create ()
-
- let create f =
-(* let exist = Sys.file_exists f in *)
- {
- filename = f;
- fd = None;
- destroyed = false;
-(* exist = exist; *)
- }
let close t =
- if not t.destroyed then begin
- match t.fd with
+ if not t.destroyed then
+ match t.fd with
| Some fd ->
-(* lprintf "close_one: closing %d\n" (Obj.magic fd); *)
- (try Unix.close fd with _ -> ());
- t.fd <- None;
- decr cache_size
+ if !verbose then lprintf_nl "Close %s" t.filename;
+ (try Unix.close fd with e ->
+ lprintf_nl "Exception in FDCache.close %s: %s"
+ t.filename
+ (Printexc2.to_string e);
+ raise e);
+ t.fd <- None;
+ decr cache_size
| None -> ()
- end
- let check_destroyed t =
+ let is_closed t =
if t.destroyed then
- failwith "Unix32: Cannot use destroyed FD"
-
- let destroy t =
- if not t.destroyed then begin
- close t;
- t.destroyed <- true
- end
-
+ true
+ else match t.fd with
+ | Some fd -> false
+ | None -> true
+
let rec close_one () =
if not (Fifo.empty cache) then
let t = Fifo.take cache in
match t.fd with
- None ->
- close_one ()
- | Some fd ->
- close t
-
+ | None ->
+ close_one ()
+ | Some fd ->
+ try
+ close t
+ with _ -> close_one ()
- let local_force_fd t writable =
+ let check_destroyed t =
+ if t.destroyed then
+ failwith (Printf.sprintf
+ "Unix32.check_destroyed %s: Cannot use destroyed FD" t.filename)
+
+ let destroy t =
+ if not t.destroyed then begin
+ (try close t with _ -> ());
+ t.destroyed <- true
+ end
+
+ let _local_force_fd creat t =
check_destroyed t;
let fd =
match t.fd with
- None ->
- if !cache_size >= !max_cache_size then close_one ();
- let fd =
- if writable then begin
- try
- Unix.openfile t.filename rw_flag rights
- with Unix.Unix_error( (Unix.EACCES | Unix.EROFS) ,_,_) ->
- Unix.openfile t.filename ro_flag 0o400
- end
- else
- Unix.openfile t.filename ro_flag 0o400
- in
- incr cache_size;
-(* lprintf "local_force: opening %d\n" (Obj.magic fd); *)
- Fifo.put cache t;
- t.fd <- Some fd;
- fd
- | Some fd -> fd
+ | Some fd -> fd
+ | None ->
+ if !cache_size >= !max_cache_size then close_one ();
+ let fd =
+ try
+ if t.writable then
+ Unix.openfile t.filename
+ (if creat then rw_creat_flag else rw_flag) rights
+ else
+ Unix.openfile t.filename ro_flag 0o400
+ with e ->
+ lprintf_nl "Exception in FDCache._local_force_fd %s (%s): %s"
+ t.filename
+ (if t.writable then "rw" else "ro")
+ (Printexc2.to_string e);
+ raise e
+ in
+ incr cache_size;
+(* lprintf "local_force: opening %d\n" (Obj.magic fd_rw); *)
+ Fifo.put cache t;
+ t.fd <- Some fd;
+ fd
in
(* lprintf "local_force_fd %d\n" (Obj.magic fd); *)
- fd
+ fd
+
+ let create f writable =
+ if !verbose then lprintf_nl "Open %s (%s)" f (if writable then "rw" else
"ro");
+ let t =
+ {
+ filename = f;
+ writable = writable;
+ fd = None;
+ destroyed = false;
+ }
+ in
+ let _fd = _local_force_fd true t in
+ t
+
+ let local_force_fd t = _local_force_fd false t
let close_all () =
while not (Fifo.empty cache) do
@@ -137,68 +166,132 @@
done
let rename t f =
+ try
check_destroyed t;
close t;
Unix2.rename t.filename f;
destroy t
+ with e ->
+ lprintf_nl "Exception in FDCache.rename %s %s: %s"
+ t.filename
+ f
+ (Printexc2.to_string e);
+ raise e
let multi_rename t f file =
+ try
check_destroyed t;
close t;
(let d = (Filename.dirname (Filename.concat f file)) in
Unix2.safe_mkdir d;
- Unix2.chmod d (Misc.int_of_octal_string !create_dir_mask);
+ Unix2.chmod d (Misc.int_of_octal_string !create_dir_mask);
Unix2.can_write_to_directory d);
Unix2.rename t.filename (Filename.concat f file);
destroy t
+ with e ->
+ lprintf_nl "Exception in FDCache.multi_rename %s %s: %s"
+ t.filename
+ (Filename.concat f file)
+ (Printexc2.to_string e);
+ raise e
let ftruncate64 t len sparse =
+ try
check_destroyed t;
- Unix2.c_ftruncate64 (local_force_fd t true) len sparse
+ Unix2.c_ftruncate64 (local_force_fd t) len sparse
+ with e ->
+ lprintf_nl "Exception in FDCache.ftruncate64 %s %Ld (%s): %s"
+ t.filename
+ len
+ (if sparse then "sparse" else "not sparse")
+ (Printexc2.to_string e);
+ raise e
- let getsize64 t writable =
+ let getsize64 t =
+ try
check_destroyed t;
- let s = Unix2.c_getfdsize64 (local_force_fd t writable) in
- if not writable then close t;
+ let was_closed = is_closed t in
+ let s = Unix2.c_getfdsize64 (local_force_fd t) in
+ if was_closed then
+ close t;
s
+ with e ->
+ lprintf_nl "Exception in FDCache.getsize64 %s: %s"
+ t.filename
+ (Printexc2.to_string e);
+ raise e
let mtime64 t =
+ try
check_destroyed t;
let st = Unix.LargeFile.stat t.filename in
st.Unix.LargeFile.st_mtime
+ with e ->
+ lprintf_nl "Exception in FDCache.mtime64 %s: %s"
+ t.filename
+ (Printexc2.to_string e);
+ raise e
let exists t =
+ try
check_destroyed t;
Sys.file_exists t.filename
+ with e ->
+ lprintf_nl "Exception in FDCache.exists %s: %s"
+ t.filename
+ (Printexc2.to_string e);
+ raise e
let remove t =
+ try
check_destroyed t;
- if exists t then Sys.remove t.filename;
+ if exists t then
+ Sys.remove t.filename;
destroy t
+ with e ->
+ lprintf_nl "Exception in FDCache.remove %s: %s"
+ t.filename
+ (Printexc2.to_string e);
+ raise e
let read file file_pos string string_pos len =
- let fd = local_force_fd file true in
- (*
- I know I am calling local_force_fd with writable = true
- although we are reading here, but I had problems with
- it like exceptions in really_write
- *)
- let _ = Unix2.c_seek64 fd file_pos Unix.SEEK_SET in
- if verbose then lprintf "really_read %d\n" len;
+ try
+ let fd = local_force_fd file in
+ ignore(Unix2.c_seek64 fd file_pos Unix.SEEK_SET);
+ if !verbose then
+ lprintf_nl "really_read %s %Ld %d"
+ file.filename
+ file_pos
+ len;
Unix2.really_read fd string string_pos len
+ with e ->
+ lprintf_nl "Exception in FDCache.read %s %Ld %d: %s"
+ file.filename
+ file_pos
+ len
+ (Printexc2.to_string e);
+ raise e
let write file file_pos string string_pos len =
- let fd = local_force_fd file true in
- let _ = Unix2.c_seek64 fd file_pos Unix.SEEK_SET in
- if verbose then lprintf "really_write %d\n" len;
- begin
- try
- really_write fd string string_pos len
- with e ->
- lprintf_nl "[Unix32] Exception %s in write: file %s file_pos=%Ld
len=%d string_pos=%d, string length=%d"
- (Printexc2.to_string e) file.filename file_pos len string_pos
(String.length string);
- raise e
- end
+ try
+ assert (file.writable);
+ let fd = local_force_fd file in
+ ignore(Unix2.c_seek64 fd file_pos Unix.SEEK_SET);
+ if !verbose then
+ lprintf_nl "really_write %s %Ld %d"
+ file.filename
+ file_pos
+ len;
+ really_write fd string string_pos len
+ with e ->
+ lprintf_nl "Exception in FDCache.write file %s file_pos=%Ld len=%d
string_pos=%d, string length=%d: %s"
+ file.filename
+ file_pos
+ len
+ string_pos
+ (String.length string)
+ (Printexc2.to_string e);
+ raise e
let copy_chunk t1 t2 pos1 pos2 len64 =
check_destroyed t1;
@@ -215,19 +308,29 @@
iter (remaining -- len64) (pos1 ++ len64) (pos2 ++ len64)
end
in
- iter len64 pos1 pos2
+ try
+ iter len64 pos1 pos2
+ with e ->
+ lprintf_nl "Exception in FDCache.copy_chunk %s %Ld to %s %Ld (%Ld): %s"
+ t1.filename
+ pos1
+ t2.filename
+ pos2
+ len64
+ (Printexc2.to_string e);
+ raise e
end
module type File = sig
type t
- val create : string -> t
+ val create : string -> bool -> t
val apply_on_chunk : t -> int64 -> int64 ->
(Unix.file_descr -> int64 -> 'a) -> 'a
val close : t -> unit
val rename : t -> string -> unit
val ftruncate64 : t -> int64 -> bool -> unit
- val getsize64 : t -> bool -> int64
+ val getsize64 : t -> int64
val mtime64 : t -> float
val exists : t -> bool
val remove : t -> unit
@@ -245,7 +348,7 @@
let create = FDCache.create
let apply_on_chunk t pos_s len_s f =
- let fd = FDCache.local_force_fd t true in
+ let fd = FDCache.local_force_fd t in
f fd pos_s
let close = FDCache.close
@@ -270,7 +373,7 @@
match !zero_chunk_fd_option with
Some fd -> fd
| None ->
- let fd = FDCache.create zero_chunk_name in
+ let fd = FDCache.create zero_chunk_name true in
FDCache.ftruncate64 fd zero_chunk_len false;
zero_chunk_fd_option := Some fd;
fd
@@ -322,17 +425,14 @@
let rec print_tree indent tree =
match tree with
- Leaf file -> lprintf "%s - %s (%Ld,%Ld)\n"
+ Leaf file -> lprintf_nl "%s - %s (%Ld,%Ld)"
indent file.filename file.pos file.len
| Node (pos, tree1, tree2) ->
- lprintf "%scut at %Ld\n" indent pos;
+ lprintf_nl "%scut at %Ld" indent pos;
print_tree (indent ^ " ") tree1;
print_tree (indent ^ " ") tree2
- let rights = 0o664
- let access = [Unix.O_CREAT; Unix.O_RDWR]
-
- let create dirname files =
+ let create dirname writable files =
Unix2.safe_mkdir dirname;
let rec iter files pos files2 =
match files with
@@ -354,19 +454,19 @@
| (filename, size) :: tail ->
let temp_filename = Filename.concat dirname filename in
Unix2.safe_mkdir (Filename.dirname temp_filename);
- let fd = FDCache.create temp_filename in
- let cur_len = ref Int64.zero in
- if not (Unix2.is_directory temp_filename) then
- begin
- ignore(FDCache.local_force_fd fd true);
- cur_len := FDCache.getsize64 fd true;
- end;
+ let fd = FDCache.create temp_filename writable in
+ let cur_len =
+ if Unix2.is_directory temp_filename then 0L
+ else begin
+ ignore(FDCache.local_force_fd fd);
+ FDCache.getsize64 fd
+ end in
iter tail (pos ++ size)
({
filename = filename;
pos = pos;
len = size;
- current_len = !cur_len;
+ current_len = cur_len;
fd = fd;
tail = [];
} :: files2)
@@ -399,7 +499,7 @@
let rec fill_zeros file_out file_pos max_len =
if max_len > zero then
let max_possible_write = min max_len zero_chunk_len in
- FDCache.copy_chunk (zero_chunk_fd()) file_out
+ FDCache.copy_chunk (zero_chunk_fd ()) file_out
zero file_pos max_possible_write;
fill_zeros file_out (file_pos ++ max_possible_write)
(max_len -- max_possible_write)
@@ -411,45 +511,49 @@
let file_begin = file.pos in
let max_current_pos = file_begin ++ file.current_len in
if max_current_pos >= chunk_end then
- let fd = FDCache.local_force_fd file.fd true in
+ let fd = FDCache.local_force_fd file.fd in
f fd (chunk_begin -- file_begin)
else
- let temp_file = Filename.temp_file "chunk" ".tmp" in
- let file_out = FDCache.create temp_file in
+ let temp_file = Filename.temp_file "chunk" ".tmp" in
+ let file_out = FDCache.create temp_file true in
+ try
(* first file *)
- let in_pos = chunk_begin -- file_begin in
- let in_len = max_current_pos -- chunk_begin in
- FDCache.copy_chunk file.fd file_out
- in_pos zero in_len;
- let zeros =
- min (chunk_len -- in_len) (file.len -- file.current_len)
- in
- fill_zeros file_out in_len zeros;
- let in_len = in_len ++ zeros in
+ let in_pos = chunk_begin -- file_begin in
+ let in_len = max_current_pos -- chunk_begin in
+ FDCache.copy_chunk file.fd file_out
+ in_pos zero in_len;
+ let zeros =
+ min (chunk_len -- in_len) (file.len -- file.current_len) in
+ fill_zeros file_out in_len zeros;
+ let in_len = in_len ++ zeros in
(* other files *)
- do_on_remaining tail in_len (chunk_len -- in_len)
- (fun file file_pos len ->
- let max_current_pos = min len file.current_len in
- FDCache.copy_chunk file.fd file_out
- zero file_pos max_current_pos;
- let file_pos = file_pos ++ max_current_pos in
- let zeros = len -- max_current_pos in
- fill_zeros file_out file_pos zeros;
- file_pos ++ zeros
- );
- FDCache.close file_out;
- let fd = FDCache.local_force_fd file_out true in
- try
- let v = f fd zero in
- FDCache.close file_out;
- Sys.remove temp_file;
- v
- with e ->
+ do_on_remaining tail in_len (chunk_len -- in_len)
+ (fun file file_pos len ->
+ let max_current_pos = min len file.current_len in
+ FDCache.copy_chunk file.fd file_out
+ zero file_pos max_current_pos;
+ let file_pos = file_pos ++ max_current_pos in
+ let zeros = len -- max_current_pos in
+ fill_zeros file_out file_pos zeros;
+ file_pos ++ zeros
+ );
+ FDCache.close file_out;
+ let fd = FDCache.local_force_fd file_out in
+ let v = f fd zero in
FDCache.close file_out;
Sys.remove temp_file;
- raise e
+ v
+ with e ->
+ lprintf_nl "Exception in MultiFile.apply_on_chunk %s %Ld %Ld: %s"
+ t.dirname
+ chunk_begin
+ chunk_len
+ (Printexc2.to_string e);
+ (try FDCache.close file_out with _ -> ());
+ (try Sys.remove temp_file with _ -> ());
+ raise e
let close t =
List.iter (fun file -> FDCache.close file.fd) t.files
@@ -459,7 +563,8 @@
let rename t f =
close t;
- List.iter (fun file -> FDCache.multi_rename file.fd f file.filename)
t.files
+ List.iter (fun file -> FDCache.multi_rename file.fd f file.filename)
+ t.files
let ftruncate64 t size sparse =
t.size <- size
@@ -467,16 +572,28 @@
let getsize64 t = t.size
let mtime64 t =
- let st = Unix.LargeFile.stat t.dirname in
- st.Unix.LargeFile.st_mtime
+ try
+ let st = Unix.LargeFile.stat t.dirname in
+ st.Unix.LargeFile.st_mtime
+ with e ->
+ lprintf_nl "Exception in MultiFile.mtime64 %s: %s"
+ t.dirname
+ (Printexc2.to_string e);
+ raise e
let exists t =
Sys.file_exists t.dirname
let remove t =
- close t;
- if Sys.file_exists t.dirname then
- Unix2.remove_all_directory t.dirname
+ try
+ close t;
+ if Sys.file_exists t.dirname then
+ Unix2.remove_all_directory t.dirname
+ with e ->
+ lprintf_nl "Exception in MultiFile.remove %s: %s"
+ t.dirname
+ (Printexc2.to_string e);
+ raise e
let file_write file in_file_pos s in_string_pos len =
(* prevent write to zero-byte files so BT downloads finish *)
@@ -520,12 +637,12 @@
(* other files *)
do_on_remaining tail (string_pos + in_len)
- (chunk_len -- first_read)
- (fun file string_pos len64 ->
- let len = Int64.to_int len64 in
- f file zero string string_pos len;
- string_pos + len
- )
+ (chunk_len -- first_read)
+ (fun file string_pos len64 ->
+ let len = Int64.to_int len64 in
+ f file zero string string_pos len;
+ string_pos + len
+ )
let read t chunk_begin string string_pos len =
io file_read t chunk_begin string string_pos len
@@ -557,11 +674,9 @@
mutable dirname : string;
mutable size : int64;
mutable chunks : chunk array;
+ mutable writable : bool;
}
- let rights = 0o664
- let access = [Unix.O_CREAT; Unix.O_RDWR]
-
let zero_chunk () =
{
chunkname = zero_chunk_name;
@@ -570,10 +685,10 @@
fd = zero_chunk_fd ();
}
- let create filename =
-(* lprintf "SparseFile.create %s\n" filename; *)
+ let create filename writable =
+(* lprintf_nl "SparseFile.create %s" filename; *)
let dirname = filename ^ ".chunks" in
-(* lprintf "Creating directory %s\n" dirname; *)
+(* lprintf_nl "Creating directory %s" dirname; *)
Unix2.safe_mkdir dirname;
Unix2.can_write_to_directory dirname;
{
@@ -581,60 +696,71 @@
dirname = dirname;
chunks = [||];
size = zero;
+ writable = writable;
}
let find_read_pos t pos =
let nchunks = Array.length t.chunks in
let rec iter t start len =
if len <= 0 then start else
- let milen = len/2 in
- let med = start + milen in
- let chunk = t.chunks.(med) in
- if chunk.pos <= pos && pos -- chunk.pos < chunk.len then med else
- if chunk.pos > pos then
- if med = start then start else
- iter t start milen
- else
- let next = med+1 in
- iter t next (start+len-next)
+ let milen = len/2 in
+ let med = start + milen in
+ let chunk = t.chunks.(med) in
+ if chunk.pos <= pos && pos -- chunk.pos < chunk.len then med
+ else
+ if chunk.pos > pos then
+ if med = start then start
+ else
+ iter t start milen
+ else
+ let next = med+1 in
+ iter t next (start+len-next)
in
- iter t 0 nchunks
+ iter t 0 nchunks
let find_write_pos t pos =
let nchunks = Array.length t.chunks in
let rec iter t start len =
- if len <= 0 then start else
- let milen = len/2 in
- let med = start + milen in
- let chunk = t.chunks.(med) in
- if chunk.pos <= pos && pos -- chunk.pos <= chunk.len then med else
- if chunk.pos > pos then
- if med = start then start else
- iter t start milen
- else
- let next = med+1 in
- iter t next (start+len-next)
+ if len <= 0 then start
+ else
+ let milen = len/2 in
+ let med = start + milen in
+ let chunk = t.chunks.(med) in
+ if chunk.pos <= pos && pos -- chunk.pos <= chunk.len then med
+ else
+ if chunk.pos > pos then
+ if med = start then start
+ else
+ iter t start milen
+ else
+ let next = med+1 in
+ iter t next (start+len-next)
in
- iter t 0 nchunks
+ iter t 0 nchunks
+
+(* (*** debugging code ***)
-(*
let find_read_pos2 t pos =
let rec iter t i len =
- if i = len then i else
- let chunk = t.chunks.(i) in
- if chunk.pos ++ chunk.len > pos then i else
- iter t (i+1) len
+ if i = len then i
+ else
+ let chunk = t.chunks.(i) in
+ if chunk.pos ++ chunk.len > pos then i
+ else
+ iter t (i+1) len
in
- iter t 0 (Array.length t.chunks)
+ iter t 0 (Array.length t.chunks)
let find_write_pos2 t pos =
let rec iter t i len =
- if i = len then i else
- let chunk = t.chunks.(i) in
- if chunk.pos ++ chunk.len >= pos then i else
- iter t (i+1) len
+ if i = len then i
+ else
+ let chunk = t.chunks.(i) in
+ if chunk.pos ++ chunk.len >= pos then i
+ else
+ iter t (i+1) len
in
- iter t 0 (Array.length t.chunks)
+ iter t 0 (Array.length t.chunks)
let _ =
let one = 1L in
@@ -642,24 +768,24 @@
let three = 3L in
for i = 0 to 3 do
let chunks = Array.init i (fun i ->
- let name = string_of_int i in
- let pos = 3 * i + 1 in
- let fd = FDCache.create name access rights in
- lprintf " %d [%d - %d]" i pos (pos+2);
- {
- chunkname = name;
- pos = Int64.of_int pos;
- len = two;
- fd = fd;
- }
- ) in
- lprintf "\n";
+ let name = string_of_int i in
+ let pos = 3 * i + 1 in
+ let fd = FDCache.create name writable in
+ lprintf " %d [%d - %d]" i pos (pos+2);
+ {
+ chunkname = name;
+ pos = Int64.of_int pos;
+ len = two;
+ fd = fd;
+ }
+ ) in
+ lprintf_nl "";
let t = {
- filename = "";
- dirname = "";
- size = zero;
- chunks = chunks;
- } in
+ filename = "";
+ dirname = "";
+ size = zero;
+ chunks = chunks;
+ } in
for j = 0 to 3 * i + 3 do
let pos = (Int64.of_int j) in
let i1 = find_write_pos t pos in
@@ -667,7 +793,7 @@
let i2 = find_write_pos2 t pos in
assert (i1 = i2)
done;
- lprintf "\n";
+ lprintf_nl "";
done;
exit 0
*)
@@ -687,54 +813,59 @@
let chunk = t.chunks.(index) in
let in_chunk_pos = chunk_begin -- chunk.pos in
- let fd = FDCache.local_force_fd chunk.fd true in
+ let fd = FDCache.local_force_fd chunk.fd in
f fd in_chunk_pos
else
- let temp_file = Filename.temp_file "chunk" ".tmp" in
- let file_out = FDCache.create temp_file in
+ let temp_file = Filename.temp_file "chunk" ".tmp" in
+ let file_out = FDCache.create temp_file t.writable in
- let rec iter pos index chunk_begin chunk_len =
-
- if chunk_len > zero then
- let chunk =
- if index >= nchunks then
- let z = zero_chunk () in
- z.pos <- chunk_begin;
- z
- else
- let chunk = t.chunks.(index) in
- let next_pos = chunk.pos in
- if next_pos > chunk_begin then
- let z = zero_chunk () in
- z.pos <- chunk_begin;
- z.len <- min zero_chunk_len (next_pos -- chunk_begin);
- z
- else
- chunk
- in
+ let rec iter pos index chunk_begin chunk_len =
+ if chunk_len > zero then
+ let chunk =
+ if index >= nchunks then
+ let z = zero_chunk () in
+ z.pos <- chunk_begin;
+ z
+ else
+ let chunk = t.chunks.(index) in
+ let next_pos = chunk.pos in
+ if next_pos > chunk_begin then
+ let z = zero_chunk () in
+ z.pos <- chunk_begin;
+ z.len <- min zero_chunk_len (next_pos -- chunk_begin);
+ z
+ else
+ chunk
+ in
- let in_chunk_pos = chunk_begin -- chunk.pos in
- let max_len = min chunk_len (chunk.len -- in_chunk_pos) in
+ let in_chunk_pos = chunk_begin -- chunk.pos in
+ let max_len = min chunk_len (chunk.len -- in_chunk_pos) in
- FDCache.copy_chunk chunk.fd file_out
- in_chunk_pos pos max_len;
- iter (pos ++ max_len) (index+1) (chunk_begin ++ max_len)
- (chunk_len -- max_len)
-
- in
- iter zero (find_read_pos t chunk_begin) chunk_begin chunk_len;
-
- FDCache.close file_out;
- let fd = FDCache.local_force_fd file_out true in
- try
- let v = f fd zero in
- Sys.remove temp_file;
- v
- with e ->
- Sys.remove temp_file;
- raise e
+ FDCache.copy_chunk chunk.fd file_out
+ in_chunk_pos pos max_len;
+ iter (pos ++ max_len) (index+1) (chunk_begin ++ max_len)
+ (chunk_len -- max_len)
+
+ in
+ try
+ iter zero (find_read_pos t chunk_begin) chunk_begin chunk_len;
+
+ FDCache.close file_out;
+ let fd = FDCache.local_force_fd file_out in
+ let v = f fd zero in
+ Sys.remove temp_file;
+ v
+ with e ->
+ lprintf_nl "Exception in SparseFile.apply_on_chunk %s %Ld %Ld: %s"
+ t.dirname
+ chunk_begin
+ chunk_len
+ (Printexc2.to_string e);
+ (try FDCache.close file_out with _ -> ());
+ (try Sys.remove temp_file with _ -> ());
+ raise e
let close t =
Array.iter (fun file -> FDCache.close file.fd) t.chunks
@@ -749,10 +880,9 @@
let chunk_len = t.size in
let nchunks = Array.length t.chunks in
- let file_out = FDCache.create f in
+ let file_out = FDCache.create f true in
let rec iter pos index chunk_begin chunk_len =
-
if chunk_len > zero then
let chunk =
if index >= nchunks then
@@ -760,15 +890,15 @@
z.pos <- chunk_begin;
z
else
- let chunk = t.chunks.(index) in
- let next_pos = chunk.pos in
- if next_pos > chunk_begin then
- let z = zero_chunk () in
- z.pos <- chunk_begin;
- z.len <- min zero_chunk_len (next_pos -- chunk_begin);
- z
+ let chunk = t.chunks.(index) in
+ let next_pos = chunk.pos in
+ if next_pos > chunk_begin then
+ let z = zero_chunk () in
+ z.pos <- chunk_begin;
+ z.len <- min zero_chunk_len (next_pos -- chunk_begin);
+ z
else
- chunk
+ chunk
in
let in_chunk_pos = chunk_begin -- chunk.pos in
@@ -780,35 +910,47 @@
if chunk.fd != zero_chunk_fd () then FDCache.remove chunk.fd;
iter (pos ++ max_len) (index+1) (chunk_begin ++ max_len)
- (chunk_len -- max_len)
+ (chunk_len -- max_len)
in
- iter zero 0 chunk_begin chunk_len;
- FDCache.close file_out;
- ()
-(*
- Sys.rename t.dirname f;
- List.iter (fun file ->
- file.fd.FDCache.filename <- Filename.concat t.dirname file.filename
- ) t.files
+ iter zero 0 chunk_begin chunk_len;
+ FDCache.close file_out;
+ ()
+(* (* why is that commented off ? Does SparseFile.rename actually work ? *)
+ Sys.rename t.dirname f;
+ List.iter (fun file ->
+ file.fd.FDCache.filename <- Filename.concat t.dirname file.filename
+ ) t.files
*)
let ftruncate64 t size sparse =
t.size <- size
- let getsize64 t writable = t.size
+ let getsize64 t = t.size
let mtime64 t =
- let st = Unix.LargeFile.stat t.dirname in
- st.Unix.LargeFile.st_mtime
+ try
+ let st = Unix.LargeFile.stat t.dirname in
+ st.Unix.LargeFile.st_mtime
+ with e ->
+ lprintf_nl "Exception in SparseFile.mtime64 %s: %s"
+ t.dirname
+ (Printexc2.to_string e);
+ raise e
let exists t =
Sys.file_exists t.dirname
let remove t =
- close t;
+ try
+ close t;
(* lprintf "Removing %s\n" t.dirname; *)
- Unix2.remove_all_directory t.dirname
+ Unix2.remove_all_directory t.dirname
+ with e ->
+ lprintf_nl "Exception in SparseFile.remove %s: %s"
+ t.dirname
+ (Printexc2.to_string e);
+ raise e
let read t chunk_begin string string_pos chunk_len =
let chunk_len64 = Int64.of_int chunk_len in
@@ -823,15 +965,15 @@
z.pos <- chunk_begin;
z
else
- let chunk = t.chunks.(index) in
- let next_pos = chunk.pos in
- if next_pos > chunk_begin then
- let z = zero_chunk () in
- z.pos <- chunk_begin;
- z.len <- min zero_chunk_len (next_pos -- chunk_begin);
- z
- else
- chunk
+ let chunk = t.chunks.(index) in
+ let next_pos = chunk.pos in
+ if next_pos > chunk_begin then
+ let z = zero_chunk () in
+ z.pos <- chunk_begin;
+ z.len <- min zero_chunk_len (next_pos -- chunk_begin);
+ z
+ else
+ chunk
in
let in_chunk_pos = chunk_begin -- chunk.pos in
@@ -840,46 +982,43 @@
FDCache.read chunk.fd in_chunk_pos string string_pos max_len;
iter (string_pos + max_len) (index+1) (chunk_begin ++ max_len64)
- (chunk_len64 -- max_len64)
-
+ (chunk_len64 -- max_len64)
in
- iter string_pos (find_read_pos t chunk_begin) chunk_begin chunk_len64
+ iter string_pos (find_read_pos t chunk_begin) chunk_begin chunk_len64
let write t chunk_begin string string_pos len =
let index = find_write_pos t chunk_begin in
-
let len64 = Int64.of_int len in
-
let nchunks = Array.length t.chunks in
if index = Array.length t.chunks then begin
(* lprintf "Adding chunk at end\n"; *)
- let chunk_name = Int64.to_string chunk_begin in
- let chunk_name = Filename.concat t.dirname chunk_name in
- let fd = FDCache.create chunk_name in
- let chunk = {
- chunkname = chunk_name;
- pos = chunk_begin;
- len = zero;
- fd = fd;
- } in
- let new_array = Array.create (nchunks+1) chunk in
- Array.blit t.chunks 0 new_array 0 nchunks;
- t.chunks <- new_array
+ let chunk_name = Int64.to_string chunk_begin in
+ let chunk_name = Filename.concat t.dirname chunk_name in
+ let fd = FDCache.create chunk_name t.writable in
+ let chunk = {
+ chunkname = chunk_name;
+ pos = chunk_begin;
+ len = zero;
+ fd = fd;
+ } in
+ let new_array = Array.create (nchunks+1) chunk in
+ Array.blit t.chunks 0 new_array 0 nchunks;
+ t.chunks <- new_array
- end else
- if t.chunks.(index).pos > chunk_begin then begin
+ end else
+ if t.chunks.(index).pos > chunk_begin then begin
(* lprintf "Inserting chunk\n"; *)
let chunk_name = Int64.to_string chunk_begin in
let chunk_name = Filename.concat t.dirname chunk_name in
- let fd = FDCache.create chunk_name in
+ let fd = FDCache.create chunk_name t.writable in
let chunk = {
- chunkname = chunk_name;
- pos = chunk_begin;
- len = zero;
- fd = fd;
- } in
+ chunkname = chunk_name;
+ pos = chunk_begin;
+ len = zero;
+ fd = fd;
+ } in
let new_array = Array.create (nchunks+1) chunk in
Array.blit t.chunks 0 new_array 0 index;
Array.blit t.chunks index new_array (index+1) (nchunks-index);
@@ -893,15 +1032,15 @@
if index = nchunks-1 then
index, len, Int64.of_int len
else
- let max_pos = t.chunks.(index+1).pos in
- let max_possible_len64 = max_pos -- chunk_begin in
- let len64 = Int64.of_int len in
- let max_len64 = min max_possible_len64 len64 in
- let max_len = Int64.to_int max_len64 in
- if max_len64 = max_possible_len64 then
- index+1, max_len, max_len64
- else
- index, max_len, max_len64
+ let max_pos = t.chunks.(index+1).pos in
+ let max_possible_len64 = max_pos -- chunk_begin in
+ let len64 = Int64.of_int len in
+ let max_len64 = min max_possible_len64 len64 in
+ let max_len = Int64.to_int max_len64 in
+ if max_len64 = max_possible_len64 then
+ index+1, max_len, max_len64
+ else
+ index, max_len, max_len64
in
let chunk = t.chunks.(index) in
@@ -910,9 +1049,9 @@
chunk.len <- chunk.len ++ max_len64;
iter next_index (chunk_begin ++ max_len64)
- (string_pos + max_len) (len - max_len)
+ (string_pos + max_len) (len - max_len)
in
- iter index chunk_begin string_pos len;
+ iter index chunk_begin string_pos len;
t.size <- max t.size (chunk_begin ++ len64);
@@ -933,6 +1072,7 @@
type file = {
mutable file_kind : file_kind;
mutable filename : string;
+ mutable writable : bool;
mutable error : exn option;
mutable buffers : (string * int * int * int64 * int64) list;
}
@@ -940,47 +1080,55 @@
module H = Weak.Make(struct
type old_t = file
type t = old_t
- let hash t = Hashtbl.hash t.filename
+ let hash t = Hashtbl.hash (t.filename, t.writable)
- let equal x y = x.filename = y.filename
+ let equal x y = x.filename = y.filename && x.writable = y.writable
end)
let dummy = {
- file_kind = DiskFile (DiskFile.create "");
+ file_kind = Destroyed;
filename = "";
+ writable = false;
error = None;
buffers = [];
}
let table = H.create 100
-let create f creator =
+let create f writable creator =
try
- let fd = H.find table { dummy with filename = f } in
+ let fd = H.find table { dummy with filename = f; writable = writable } in
(* lprintf "%s already exists\n" f; *)
fd
- with _ ->
- let t = {
- file_kind = creator f;
- filename = f;
- error = None;
- buffers = [];
- } in
- H.add table t;
- t
-
-
-
-let create_diskfile filename _ _ =
- create filename (fun f -> DiskFile (DiskFile.create f))
-
-let create_multifile filename _ _ files =
- create filename (fun f ->
- MultiFile (MultiFile.create f files))
-
-let create_sparsefile filename =
- create filename (fun f ->
- SparseFile (SparseFile.create f))
+ with Not_found ->
+ let t = {
+ file_kind = creator f;
+ filename = f;
+ writable = writable;
+ error = None;
+ buffers = [];
+ } in
+ H.add table t;
+ t
+
+(* check if a writable descriptor on the same file exists *)
+let find_writable fd =
+ if fd.writable then Some fd
+ else
+ try
+ Some (H.find table { fd with writable = true })
+ with Not_found -> None
+
+let create_diskfile filename writable =
+ create filename writable (fun f -> DiskFile (DiskFile.create f writable))
+
+let create_multifile filename writable files =
+ create filename writable (fun f ->
+ MultiFile (MultiFile.create f writable files))
+
+let create_sparsefile filename writable =
+ create filename writable (fun f ->
+ SparseFile (SparseFile.create f writable))
let ftruncate64 t len sparse =
match t.file_kind with
@@ -996,12 +1144,12 @@
| SparseFile t -> SparseFile.mtime64 t
| Destroyed -> failwith "Unix32.mtime64 on destroyed FD"
-let getsize64 t writable =
+let getsize64 t =
match t.file_kind with
- | DiskFile t -> DiskFile.getsize64 t writable
+ | DiskFile t -> DiskFile.getsize64 t
(* only avoid opening rw on shared files, shared files can only be
DiskFile *)
| MultiFile t -> MultiFile.getsize64 t
- | SparseFile t -> SparseFile.getsize64 t writable
+ | SparseFile t -> SparseFile.getsize64 t
| Destroyed -> failwith "Unix32.getsize64 on destroyed FD"
let fds_size = Unix2.c_getdtablesize ()
@@ -1009,105 +1157,92 @@
let buffered_bytes = ref Int64.zero
let modified_files = ref []
-(*
-let _ =
-
- lprintf "Your system supports %d file descriptors\n" fds_size;
- lprintf "You can download files up to %s\n\n"
- ( match Unix2.c_sizeofoff_t () with
- | 4 -> "2GB"
- | _ -> Printf.sprintf "2^%d-1 bits (do the maths ;-p)"
- ((Unix2.c_sizeofoff_t () *8)-1)
- )
-*)
-
-(* at most 50 files can be opened simultaneously *)
-
-
let filename t = t.filename
let write file file_pos string string_pos len =
if len > 0 then
- match file.file_kind with
- | DiskFile t -> DiskFile.write t file_pos string string_pos len
- | MultiFile t -> MultiFile.write t file_pos string string_pos len
- | SparseFile t -> SparseFile.write t file_pos string string_pos len
- | Destroyed -> failwith "Unix32.write on destroyed FD"
+ match file.file_kind with
+ | DiskFile t -> DiskFile.write t file_pos string string_pos len
+ | MultiFile t -> MultiFile.write t file_pos string string_pos len
+ | SparseFile t -> SparseFile.write t file_pos string string_pos len
+ | Destroyed -> failwith "Unix32.write on destroyed FD"
else
- lprintf "Unix32.write: error, invalid argument len = 0\n"
+ lprintf_nl "Unix32.write: error, invalid argument len = 0"
let buffer = Buffer.create 65000
-
let flush_buffer t offset =
- if verbose then lprintf "flush_buffer\n";
+ if !verbose then lprintf_nl "flush_buffer";
let s = Buffer.contents buffer in
Buffer.reset buffer;
let len = String.length s in
try
- if verbose then lprintf "seek64 %Ld\n" offset;
+ if !verbose then lprintf_nl "seek64 %Ld" offset;
if len > 0 then write t offset s 0 len;
(*
let fd, offset = fd_of_chunk t offset (Int64.of_int len) in
let final_pos = Unix2.c_seek64 fd offset Unix.SEEK_SET in
- if verbose then lprintf "really_write %d\n" len;
+ if verbose then lprintf_nl "really_write %d" len;
Unix2.really_write fd s 0 len;
*)
buffered_bytes := !buffered_bytes -- (Int64.of_int len);
- if verbose then lprintf "written %d bytes (%Ld)\n" len !buffered_bytes;
+ if !verbose then lprintf_nl "written %d bytes (%Ld)" len !buffered_bytes;
with e ->
- lprintf "exception %s in flush_buffer\n" (Printexc2.to_string e);
- t.buffers <- (s, 0, len, offset, Int64.of_int len) :: t.buffers;
- raise e
+ lprintf_nl "exception %s in flush_buffer" (Printexc2.to_string e);
+ t.buffers <- (s, 0, len, offset, Int64.of_int len) :: t.buffers;
+ raise e
let flush_fd t =
- if t.buffers = [] then () else
- let list =
- List.sort (fun (_, _, _, o1, l1) (_, _, _, o2, l2) ->
- let c = compare o1 o2 in
- if c = 0 then compare l2 l1 else c)
- t.buffers
- in
- if verbose then lprintf "flush_fd\n";
- t.buffers <- list;
- let rec iter_out () =
- match t.buffers with
- [] -> ()
- | (s, pos_s, len_s, offset, len) :: tail ->
- Buffer.reset buffer;
- Buffer.add_substring buffer s pos_s len_s;
- t.buffers <- tail;
- iter_in offset len
-
- and iter_in offset len =
- match t.buffers with
- [] -> flush_buffer t offset
- | (s, pos_s, len_s, offset2, len2) :: tail ->
- let in_offset = offset ++ len -- offset2 in
- if in_offset = Int64.zero then begin
- Buffer.add_substring buffer s pos_s len_s;
- t.buffers <- tail;
- iter_in offset (len ++ len2);
- end else
- if in_offset < Int64.zero then begin
- flush_buffer t offset;
- iter_out ()
- end else
- let keep_len = len2 -- in_offset in
- if verbose then lprintf "overlap %Ld\n" keep_len;
- t.buffers <- tail;
- if keep_len <= Int64.zero then begin
- buffered_bytes := !buffered_bytes -- len2;
- iter_in offset len
- end else begin
- let new_pos = len2 -- keep_len in
- Buffer.add_substring buffer s
- (pos_s + Int64.to_int new_pos) (Int64.to_int keep_len);
- buffered_bytes := !buffered_bytes -- new_pos;
- iter_in offset (len ++ keep_len)
- end
- in
- iter_out ()
+ match find_writable t with
+ | None -> ()
+ | Some t ->
+ if t.buffers = [] then () else
+ let list =
+ List.sort (fun (_, _, _, o1, l1) (_, _, _, o2, l2) ->
+ let c = compare o1 o2 in
+ if c = 0 then compare l2 l1 else c)
+ t.buffers
+ in
+ if !verbose then lprintf_nl "flush_fd";
+ t.buffers <- list;
+ let rec iter_out () =
+ match t.buffers with
+ | [] -> ()
+ | (s, pos_s, len_s, offset, len) :: tail ->
+ Buffer.reset buffer;
+ Buffer.add_substring buffer s pos_s len_s;
+ t.buffers <- tail;
+ iter_in offset len
+
+ and iter_in offset len =
+ match t.buffers with
+ | [] -> flush_buffer t offset
+ | (s, pos_s, len_s, offset2, len2) :: tail ->
+ let in_offset = offset ++ len -- offset2 in
+ if in_offset = Int64.zero then begin
+ Buffer.add_substring buffer s pos_s len_s;
+ t.buffers <- tail;
+ iter_in offset (len ++ len2);
+ end else
+ if in_offset < Int64.zero then begin
+ flush_buffer t offset;
+ iter_out ()
+ end else
+ let keep_len = len2 -- in_offset in
+ if !verbose then lprintf_nl "overlap %Ld" keep_len;
+ t.buffers <- tail;
+ if keep_len <= 0L then begin
+ buffered_bytes := !buffered_bytes -- len2;
+ iter_in offset len
+ end else begin
+ let new_pos = len2 -- keep_len in
+ Buffer.add_substring buffer s
+ (pos_s + Int64.to_int new_pos) (Int64.to_int keep_len);
+ buffered_bytes := !buffered_bytes -- new_pos;
+ iter_in offset (len ++ keep_len)
+ end
+ in
+ iter_out ()
let read t file_pos string string_pos len =
flush_fd t;
@@ -1121,41 +1256,41 @@
let flush _ =
try
- if verbose then lprintf "flush all\n";
+ if !verbose then lprintf_nl "flush all";
let rec iter list =
match list with
- [] -> []
+ | [] -> []
| t :: tail ->
try
flush_fd t;
t.error <- None;
iter tail
with e ->
- t.error <- Some e;
- t :: (iter tail)
+ t.error <- Some e;
+ t :: (iter tail)
in
- modified_files := iter !modified_files;
- if !buffered_bytes <> Int64.zero then
- lprintf "[ERROR] remaining bytes after flush\n"
+ modified_files := iter !modified_files;
+ if !buffered_bytes <> 0L then
+ lprintf_nl "[ERROR] remaining bytes after flush"
with e ->
- lprintf "[ERROR] Exception %s in Unix32.flush\n"
+ lprintf_nl "[ERROR] Exception %s in Unix32.flush"
(Printexc2.to_string e)
let buffered_write t offset s pos_s len_s =
let len = Int64.of_int len_s in
match t.error with
- None ->
+ | None ->
if len > Int64.zero then begin
- if not (List.memq t !modified_files) then
- modified_files := t:: !modified_files;
- t.buffers <- (s, pos_s, len_s, offset, len) :: t.buffers;
- buffered_bytes := !buffered_bytes ++ len;
- if verbose then
- lprintf "buffering %Ld bytes (%Ld)\n" len !buffered_bytes;
+ if not (List.memq t !modified_files) then
+ modified_files := t :: !modified_files;
+ t.buffers <- (s, pos_s, len_s, offset, len) :: t.buffers;
+ buffered_bytes := !buffered_bytes ++ len;
+ if !verbose then
+ lprintf_nl "buffering %Ld bytes (%Ld)" len !buffered_bytes;
(* Don't buffer more than 1 Mo *)
- if !buffered_bytes > !max_buffered then flush ()
- end
+ if !buffered_bytes > !max_buffered then flush ()
+ end
| Some e ->
raise e
@@ -1176,18 +1311,19 @@
iter (remaining - len) (pos1 ++ len64) (pos2 ++ len64)
end
in
- iter len pos1 pos2
+ iter len pos1 pos2
let mega = megabytes 1
+
let rec copy t1 t2 pos1 pos2 len64 =
if len64 > mega then begin
- copy_chunk t1 t2 pos1 pos2 (Int64.to_int mega);
- copy t1 t2 (pos1 ++ mega) (pos2 ++ mega) (len64 -- mega)
- end else
+ copy_chunk t1 t2 pos1 pos2 (Int64.to_int mega);
+ copy t1 t2 (pos1 ++ mega) (pos2 ++ mega) (len64 -- mega)
+ end else
copy_chunk t1 t2 pos1 pos2 (Int64.to_int len64)
-
let close_all = FDCache.close_all
+
let close t =
flush_fd t;
match t.file_kind with
@@ -1198,18 +1334,17 @@
let destroy t =
if t.file_kind <> Destroyed then begin
- H.remove table t;
- (match t.file_kind with
- | DiskFile t -> DiskFile.destroy t
- | MultiFile t -> MultiFile.destroy t
- | SparseFile t -> SparseFile.destroy t
- | Destroyed -> ());
- t.file_kind <- Destroyed
- end
+ H.remove table t;
+ (match t.file_kind with
+ | DiskFile t -> DiskFile.destroy t
+ | MultiFile t -> MultiFile.destroy t
+ | SparseFile t -> SparseFile.destroy t
+ | Destroyed -> ());
+ t.file_kind <- Destroyed
+ end
-(* let create_ro filename = create_diskfile filename ro_flag 0o666 *)
-let create_rw filename = create_diskfile filename rw_flag 0o666
-let create_ro = create_rw
+let create_rw filename = create_diskfile filename true
+let create_ro filename = create_diskfile filename false
let apply_on_chunk t pos len f =
match t.file_kind with
@@ -1237,10 +1372,15 @@
| SparseFile t -> SparseFile.remove t
| Destroyed -> failwith "Unix32.remove on destroyed FD"
-let getsize s writable = getsize64 (create_ro s) writable
+let getsize s = getsize64 (create_ro s)
let mtime s = mtime64 (create_ro s)
-let file_exists s = exists (create_ro s)
+let file_exists s =
+ (* We use this instead of Sys.file_exists, in case exists has side
+ effects ? *)
+ try
+ exists (create_ro s)
+ with Unix.Unix_error (Unix.ENOENT, _, _) -> false
let rename t f =
flush_fd t;
@@ -1271,121 +1411,122 @@
* copy_chunk: remove this
*)
- type t = {
- file : file;
- mutable file_parts : part list;
- }
-
- and part = {
- mutable part_file : file;
- mutable part_begin : int64;
- mutable part_len : int64;
- mutable part_end : int64;
- mutable part_shared : t list;
- }
-
- let copy_shared_parts_out file parts =
- List2.tail_map (fun part ->
- if part.part_file == file then
- match part.part_shared with
- [] -> part
- | t :: tail ->
- lprintf "Copy shared part to another file\n";
- copy part.part_file t.file part.part_begin part.part_begin
- part.part_len;
- lprintf " Copy done.\n";
- part.part_file <- t.file;
- part.part_shared <- tail;
- { part with part_file = file; part_shared = [] }
- else part
- ) parts
-
- let copy_shared_parts_in file parts =
- List2.tail_map (fun part ->
- if part.part_file != file then begin
- lprintf "Copy shared part to another file\n";
- copy part.part_file file part.part_begin part.part_begin
- part.part_len;
- lprintf " Copy done.\n";
- part.part_shared <- List.filter (fun t -> t.file != file)
- part.part_shared;
- { part with part_file = file; part_shared = [] }
- end else part
- ) parts
-
- let remove t =
- t.file_parts <- copy_shared_parts_out t.file t.file_parts;
- remove t.file
-
- let destroy t =
- t.file_parts <- copy_shared_parts_out t.file t.file_parts;
- destroy t.file
-
- let old_close = close
-
- let close t = close t.file
- let getsize64 t = getsize64 t.file
- let filename t = filename t.file
-
- let rename t file_name =
- t.file_parts <- copy_shared_parts_in t.file t.file_parts;
- t.file_parts <- copy_shared_parts_out t.file t.file_parts;
- rename t.file file_name
-
- let mtime64 t = mtime64 t.file
- let flush_fd t = flush_fd t.file
+ type t = {
+ file : file;
+ mutable file_parts : part list;
+ }
- let apply_on_parts f t file_pos s pos len =
- List.iter (fun part ->
- f part.part_file file_pos s pos len) t.file_parts
+ and part = {
+ mutable part_file : file;
+ mutable part_begin : int64;
+ mutable part_len : int64;
+ mutable part_end : int64;
+ mutable part_shared : t list;
+ }
- let buffered_write t file_pos s pos len =
- apply_on_parts buffered_write t file_pos s pos len
+ let copy_shared_parts_out file parts =
+ List2.tail_map (fun part ->
+ if part.part_file == file then
+ match part.part_shared with
+ | [] -> part
+ | t :: tail ->
+ lprintf_nl "Copy shared part to another file";
+ copy part.part_file t.file part.part_begin part.part_begin
+ part.part_len;
+ lprintf_nl " Copy done.";
+ part.part_file <- t.file;
+ part.part_shared <- tail;
+ { part with part_file = file; part_shared = [] }
+ else part
+ ) parts
+
+ let copy_shared_parts_in file parts =
+ List2.tail_map (fun part ->
+ if part.part_file != file then begin
+ lprintf_nl "Copy shared part to another file";
+ copy part.part_file file part.part_begin part.part_begin
+ part.part_len;
+ lprintf_nl " Copy done.";
+ part.part_shared <- List.filter (fun t -> t.file != file)
+ part.part_shared;
+ { part with part_file = file; part_shared = [] }
+ end else
+ part
+ ) parts
+
+ let remove t =
+ t.file_parts <- copy_shared_parts_out t.file t.file_parts;
+ remove t.file
+
+ let destroy t =
+ t.file_parts <- copy_shared_parts_out t.file t.file_parts;
+ destroy t.file
+
+ let old_close = close
+
+ let close t = close t.file
+ let getsize64 t = getsize64 t.file
+ let filename t = filename t.file
+
+ let rename t file_name =
+ t.file_parts <- copy_shared_parts_in t.file t.file_parts;
+ t.file_parts <- copy_shared_parts_out t.file t.file_parts;
+ rename t.file file_name
+
+ let mtime64 t = mtime64 t.file
+ let flush_fd t = flush_fd t.file
+
+ let apply_on_parts f t file_pos s pos len =
+ List.iter (fun part ->
+ f part.part_file file_pos s pos len) t.file_parts
+
+ let buffered_write t file_pos s pos len =
+ apply_on_parts buffered_write t file_pos s pos len
- let buffered_write_copy t file_pos s pos len =
- apply_on_parts buffered_write_copy t file_pos s pos len
+ let buffered_write_copy t file_pos s pos len =
+ apply_on_parts buffered_write_copy t file_pos s pos len
- let write t file_pos s pos len =
- apply_on_parts write t file_pos s pos len
+ let write t file_pos s pos len =
+ apply_on_parts write t file_pos s pos len
- let read t file_pos s pos len =
- apply_on_parts read t file_pos s pos len
+ let read t file_pos s pos len =
+ apply_on_parts read t file_pos s pos len
(* TODO: there is no need to create a temporary file when the wanted chunk
-overlaps different parts, but these parts are on the same physical file. *)
- let apply_on_chunk t chunk_begin chunk_len f =
- let chunk_end = chunk_begin ++ chunk_len in
- let rec iter list =
- match list with
- [] -> assert false
- | part :: tail ->
- if part.part_begin <= chunk_begin &&
- part.part_end >= chunk_end then
+ * overlaps different parts, but these parts are on the same physical file. *)
+ let apply_on_chunk t chunk_begin chunk_len f =
+ let chunk_end = chunk_begin ++ chunk_len in
+ let rec iter list =
+ match list with
+ | [] -> assert false
+ | part :: tail ->
+ if part.part_begin <= chunk_begin &&
+ part.part_end >= chunk_end then
apply_on_chunk part.part_file chunk_begin chunk_len f
- else
+ else
if part.part_end > chunk_begin then
make_temp_file list
else
iter tail
- and make_temp_file list =
- let temp_file = Filename.temp_file "chunk" ".tmp" in
- let file_out = create_rw temp_file in
+ and make_temp_file list =
+ let temp_file = Filename.temp_file "chunk" ".tmp" in
+ let file_out = create_rw temp_file in
- let rec fill pos chunk_begin chunk_len list =
- if chunk_len > zero then
- match list with
- [] -> ()
- | part :: tail ->
+ let rec fill pos chunk_begin chunk_len list =
+ if chunk_len > zero then
+ match list with
+ | [] -> ()
+ | part :: tail ->
- let tocopy = min chunk_len (part.part_end -- chunk_begin) in
- copy_chunk part.part_file file_out chunk_begin pos
- (Int64.to_int tocopy);
- fill (pos ++ tocopy) (chunk_begin ++ tocopy)
+ let tocopy = min chunk_len (part.part_end -- chunk_begin) in
+ copy_chunk part.part_file file_out chunk_begin pos
+ (Int64.to_int tocopy);
+ fill (pos ++ tocopy) (chunk_begin ++ tocopy)
(chunk_len -- tocopy) tail
- in
+ in
fill zero chunk_begin chunk_len list;
old_close file_out;
try
@@ -1393,18 +1534,17 @@
Sys.remove temp_file;
v
with e ->
- Sys.remove temp_file;
+ (try Sys.remove temp_file with _ -> ());
raise e
-
+
in
-
- iter t.file_parts
-
- let ftruncate64 t len sparse =
+ iter t.file_parts
+
+ let ftruncate64 t len sparse =
ftruncate64 t.file len sparse
-
+
let maxint64 = megabytes 1000000
-
+
let create file =
let part = {
part_file = file;
@@ -1415,14 +1555,14 @@
} in
{ file = file; file_parts = [part] }
- let create_diskfile file_name flags rights =
- create (create_diskfile file_name flags rights)
+ let create_diskfile file_name writable =
+ create (create_diskfile file_name writable)
- let create_multifile file_name flags rights files =
- create (create_multifile file_name flags rights files)
+ let create_multifile file_name writable files =
+ create (create_multifile file_name writable files)
- let create_sparsefile file_name =
- create (create_sparsefile file_name)
+ let create_sparsefile file_name writable =
+ create (create_sparsefile file_name writable)
let create_ro filename =
create (create_ro filename)
@@ -1444,10 +1584,12 @@
type t = file
+(*
let bad_fd =
let t = create_rw "/dev/null" in
t.file_kind <- Destroyed;
t
+*)
type statfs = {
f_type : int64; (* type of filesystem *)
Index: mldonkey/src/utils/lib/unix32.mli
diff -u mldonkey/src/utils/lib/unix32.mli:1.18
mldonkey/src/utils/lib/unix32.mli:1.19
--- mldonkey/src/utils/lib/unix32.mli:1.18 Sun Oct 23 16:05:42 2005
+++ mldonkey/src/utils/lib/unix32.mli Mon Jan 9 00:25:59 2006
@@ -19,6 +19,8 @@
type t
+val verbose : bool ref
+
val external_start : string -> unit
val external_exit : unit -> unit
val uname : unit -> string
@@ -34,8 +36,9 @@
(* val force_fd : t -> Unix.file_descr *)
(* val seek64 : t -> int64 -> Unix.seek_command -> int64 *)
-val getsize : string -> bool -> int64
-val getsize64 : t -> bool -> int64
+val getsize : string -> int64
+val getsize64 : t -> int64
+(* size, sparse flag *)
val ftruncate64 : t -> int64 -> bool -> unit
val close_all : unit -> unit
@@ -66,29 +69,29 @@
(Unix.file_descr -> int64 -> 'a) -> 'a
-val create_diskfile : string -> Unix.open_flag list -> int -> t
+val create_diskfile : string -> bool -> t
val create_ro : string -> t
val create_rw : string -> t
(*
-[create_multifile dirname access rights files]: create a directory
+[create_multifile dirname writable files]: create a directory
[dirname] containing the files in [files]. [files] is a list of tuples
[(filename, size)] where [filename] is relative inside the directory
[dirname] and [size] is the size of the files.
*)
val create_multifile :
- string -> Unix.open_flag list -> int -> (string * int64) list -> t
+ string -> bool -> (string * int64) list -> t
-val create_sparsefile : string -> t
+val create_sparsefile : string -> bool -> t
val ro_flag : Unix.open_flag list
val rw_flag : Unix.open_flag list
val destroy : t -> unit
-val bad_fd : t
-
+val dummy : t
+
val destroyed : t -> bool
val bsize : string -> int64 option
Index: mldonkey/tools/get_range.ml
diff -u mldonkey/tools/get_range.ml:1.4 mldonkey/tools/get_range.ml:1.5
--- mldonkey/tools/get_range.ml:1.4 Sat May 28 11:19:43 2005
+++ mldonkey/tools/get_range.ml Mon Jan 9 00:25:59 2006
@@ -53,7 +53,7 @@
"size" ->
if Array.length Sys.argv <> 3 then usage ();
let filename = argv.(2) in
- Printf.printf "[SIZE %Ld]\n" (Unix32.getsize filename false)
+ Printf.printf "[SIZE %Ld]\n" (Unix32.getsize filename)
| "range" ->
if Array.length Sys.argv <> 6 then usage ();
@@ -111,4 +111,4 @@
with e ->
lprintf "Exception %s\n" (Printexc2.to_string e);
exit 2
-
\ No newline at end of file
+
Index: mldonkey/tools/make_torrent.ml
diff -u mldonkey/tools/make_torrent.ml:1.7 mldonkey/tools/make_torrent.ml:1.8
--- mldonkey/tools/make_torrent.ml:1.7 Wed Oct 19 13:02:28 2005
+++ mldonkey/tools/make_torrent.ml Mon Jan 9 00:25:59 2006
@@ -150,12 +150,12 @@
torrent.torrent_name (Filename.basename filename);
end;
let t = if torrent.torrent_files <> [] then
- Unix32.create_multifile filename Unix32.ro_flag 0o666
+ Unix32.create_multifile filename false
torrent.torrent_files
else Unix32.create_ro filename
in
- let length = Unix32.getsize64 t false in
+ let length = Unix32.getsize64 t in
if torrent.torrent_length <> length then begin
Printf.printf "ERROR: computed size %Ld <> torrent size %Ld\n"
Index: mldonkey/tools/mld_hash.ml
diff -u mldonkey/tools/mld_hash.ml:1.5 mldonkey/tools/mld_hash.ml:1.6
--- mldonkey/tools/mld_hash.ml:1.5 Wed Oct 19 12:43:27 2005
+++ mldonkey/tools/mld_hash.ml Mon Jan 9 00:25:59 2006
@@ -90,7 +90,7 @@
let sha1 = Sha1.digest_subfile fd zero file_size in
let tiger = TigerTree.digest_subfile fd zero file_size in
lprintf "urn:bitprint:%s.%s\n" (Sha1.to_string sha1) (TigerTree.to_string
tiger);
- let file_size = Unix32.getsize64 fd false in
+ let file_size = Unix32.getsize64 fd in
let nchunks = Int64.to_int (Int64.pred file_size // tiger_block_size) + 1 in
let chunks =
let chunks = Array.create nchunks tiger in
@@ -115,8 +115,8 @@
(*************************************************************************)
let bitprint_filename filename partial =
- let fd = Unix32.create_rw filename in
- let file_size = Unix32.getsize64 fd false in
+ let fd = Unix32.create_ro filename in
+ let file_size = Unix32.getsize64 fd in
let (sha1, tiger2) = bitprint_file fd file_size partial in
lprintf "urn:bitprint:%s.%s\n" (Sha1.to_string sha1) (TigerTree.to_string
tiger2);
()
@@ -155,8 +155,8 @@
(*************************************************************************)
let sha1_hash_filename block_size filename =
- let fd = Unix32.create_rw filename in
- let file_size = Unix32.getsize64 fd false in
+ let fd = Unix32.create_ro filename in
+ let file_size = Unix32.getsize64 fd in
let nchunks = Int64.to_int (Int64.pred file_size // block_size) + 1 in
for i = 0 to nchunks - 1 do
let begin_pos = block_size ** (Int64.of_int i) in
@@ -175,8 +175,8 @@
(*************************************************************************)
let ed2k_hash_filename filename partial =
- let fd = Unix32.create_rw filename in
- let file_size = Unix32.getsize64 fd false in
+ let fd = Unix32.create_ro filename in
+ let file_size = Unix32.getsize64 fd in
let md4 = ed2k_hash_file fd file_size partial in
lprintf "ed2k://|file|%s|%Ld|%s|/\n"
(Url.encode (Filename.basename filename))
@@ -190,8 +190,8 @@
(*************************************************************************)
let sig2dat_hash_filename filename partial =
- let fd = Unix32.create_rw filename in
- let file_size = Unix32.getsize64 fd false in
+ let fd = Unix32.create_ro filename in
+ let file_size = Unix32.getsize64 fd in
let len64 = min 307200L file_size in
let len = Int64.to_int len64 in
let s = String.create len in
@@ -222,10 +222,10 @@
let dummy_string = "bonjourhello1" in
let create_diskfile filename size =
- Unix32.create_diskfile filename Unix32.rw_flag 0o066
+ Unix32.create_diskfile filename true
in
let create_sparsefile filename size =
- Unix32.create_sparsefile filename
+ Unix32.create_sparsefile filename true
in
let create_multifile filename size =
let rec iter pos size list =
@@ -242,7 +242,7 @@
lprintf " %-50s %Ld\n" name size;
) files;
Unix32.create_multifile filename
- Unix32.rw_flag 0o066 files
+ true files
in
let (file_types : (string * (string -> int64 -> Unix32.t)
@@ -351,8 +351,8 @@
let len = Int64.to_int (end_pos -- begin_pos) in
let s1 = String.create len in
let s2 = String.create len in
- let fd1 = Unix32.create_rw filename1 in
- let fd2 = Unix32.create_rw filename2 in
+ let fd1 = Unix32.create_ro filename1 in
+ let fd2 = Unix32.create_ro filename2 in
Unix32.read fd1 begin_pos s1 0 len;
Unix32.read fd2 begin_pos s2 0 len;
- [Mldonkey-commits] mldonkey distrib/ChangeLog src/daemon/common/co..., mldonkey-commits, 2006/01/01
- [Mldonkey-commits] mldonkey distrib/ChangeLog src/daemon/common/co..., mldonkey-commits, 2006/01/01
- [Mldonkey-commits] mldonkey distrib/ChangeLog src/daemon/common/co..., mldonkey-commits, 2006/01/02
- [Mldonkey-commits] mldonkey distrib/ChangeLog src/daemon/common/co..., mldonkey-commits, 2006/01/03
- [Mldonkey-commits] mldonkey distrib/ChangeLog src/daemon/common/co..., mldonkey-commits, 2006/01/04
- [Mldonkey-commits] mldonkey distrib/ChangeLog src/daemon/common/co..., mldonkey-commits, 2006/01/04
- [Mldonkey-commits] mldonkey distrib/ChangeLog src/daemon/common/co..., mldonkey-commits, 2006/01/04
- [Mldonkey-commits] mldonkey distrib/ChangeLog src/daemon/common/co..., mldonkey-commits, 2006/01/06
- [Mldonkey-commits] mldonkey distrib/ChangeLog src/daemon/common/co..., mldonkey-commits, 2006/01/07
- [Mldonkey-commits] mldonkey distrib/ChangeLog src/daemon/common/co..., mldonkey-commits, 2006/01/08
- [Mldonkey-commits] mldonkey distrib/ChangeLog src/daemon/common/co...,
mldonkey-commits <=
- [Mldonkey-commits] mldonkey distrib/ChangeLog src/daemon/common/co..., mldonkey-commits, 2006/01/11
- [Mldonkey-commits] mldonkey distrib/ChangeLog src/daemon/common/co..., mldonkey-commits, 2006/01/11
- [Mldonkey-commits] mldonkey distrib/ChangeLog src/daemon/common/co..., mldonkey-commits, 2006/01/12
- [Mldonkey-commits] mldonkey distrib/ChangeLog src/daemon/common/co..., mldonkey-commits, 2006/01/12
- [Mldonkey-commits] mldonkey distrib/ChangeLog src/daemon/common/co..., mldonkey-commits, 2006/01/16
- [Mldonkey-commits] mldonkey distrib/ChangeLog src/daemon/common/co..., mldonkey-commits, 2006/01/18
- [Mldonkey-commits] mldonkey distrib/ChangeLog src/daemon/common/co..., mldonkey-commits, 2006/01/18
- [Mldonkey-commits] mldonkey distrib/ChangeLog src/daemon/common/co..., mldonkey-commits, 2006/01/29
- [Mldonkey-commits] mldonkey distrib/ChangeLog src/daemon/common/co..., mldonkey-commits, 2006/01/29
- [Mldonkey-commits] mldonkey distrib/ChangeLog src/daemon/common/co..., mldonkey-commits, 2006/01/29