src/utils/lib/store.ml

   1 (* Copyright 2002 b8_bavard, b8_fee_carabine, INRIA *)
   2 (*
   3     This file is part of mldonkey.
   4
   5     mldonkey is free software; you can redistribute it and/or modify
   6     it under the terms of the GNU General Public License as published by
   7     the Free Software Foundation; either version 2 of the License, or
   8     (at your option) any later version.
   9
  10     mldonkey is distributed in the hope that it will be useful,
  11     but WITHOUT ANY WARRANTY; without even the implied warranty of
  12     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13     GNU General Public License for more details.
  14
  15     You should have received a copy of the GNU General Public License
  16     along with mldonkey; if not, write to the Free Software
  17     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  18 *)
  19
  20 open Printf2
  21
  22 open Unix
  23
  24 let verbose = false
  25
  26 (**************** TYPES *******************)
  27
  28 type 'a file = {
  29     file_name : string;
  30     file_entry_size : int;
  31     file_fd : Unix.file_descr;
  32     mutable file_len : int;
  33     mutable file_all_pos : int array;
  34     mutable file_cache : 'a Weak.t;
  35     mutable file_next_pos : int;
  36     file_chunk : string;
  37   }
  38
  39 type index = int
  40
  41 type 'a t = {
  42     mutable store_name : string;
  43     mutable store_files  : (int * 'a file) list;
  44     mutable store_next_doc : int;
  45     mutable store_all_doc : int array;
  46   }
  47
  48
  49 let attrib = 1 lsl 30
  50
  51 (**************** UNIX I/O FUNCTIONS *******************)
  52
  53 let rec iter_write fd s pos len =
  54   let nwrite = Unix.write fd s pos len in
  55   if nwrite < len then
  56     iter_write fd s (pos+nwrite) (len-nwrite)
  57
  58 let really_write fd pos s =
  59   let len = String.length s in
  60   if verbose then begin
  61       lprintf_nl "write %d %d" pos len;
  62     end;
  63   ignore (Unix2.c_seek64 fd  (Int64.of_int pos) Unix.SEEK_SET);
  64   iter_write fd s 0 len
  65
  66 let rec iter_read fd s pos len =
  67   let nread = Unix.read fd s pos len in
  68   if nread < len then
  69     iter_read fd s (pos + nread) (len - nread)
  70
  71 let really_read fd pos s len =
  72   if verbose then begin
  73       lprintf_nl "read %d %d" pos len;
  74     end;
  75   ignore (Unix2.c_seek64 fd  (Int64.of_int pos) Unix.SEEK_SET);
  76   iter_read fd s 0 len
  77
  78 (********************* FILE FUNCTIONS *****************)
  79
  80 let gen_file t n =
  81   Printf.sprintf "%s_%d" t.store_name n
  82
  83 let create_file t file file_entry_size =
  84   let name = gen_file t file_entry_size in
  85   {
  86     file_name = name;
  87     file_entry_size = file_entry_size;
  88     file_fd = Unix.openfile name [O_RDWR; O_CREAT; O_TRUNC] 0o666;
  89     file_len = 0;
  90     file_all_pos = [||];
  91     file_cache = Weak.create 1;
  92     file_next_pos = 0;
  93     file_chunk = String.create file_entry_size;
  94   }
  95
  96 let file_store file str =
  97   let pos = file.file_next_pos in
  98   let len_all_pos = Array.length file.file_all_pos in
  99   if pos >= len_all_pos then begin
 100       let new_size = (len_all_pos + 10) * 2 in
 101       Unix2.c_ftruncate64 file.file_fd (Int64.of_int (new_size * file.file_entry_size)) false;
 102       let new_tab = Array.make new_size 0 in
 103       let new_weak = Weak.create new_size in
 104       (try Array.blit file.file_all_pos 0 new_tab 0 pos
 105         with e ->
 106             lprintf_nl "exc pos %d" pos;
 107             raise e);
 108       Weak.blit file.file_cache 0 new_weak 0 pos;
 109       for i = pos to new_size - 1 do new_tab.(i) <- i+1; done;
 110       file.file_all_pos <- new_tab;
 111       file.file_cache <- new_weak;
 112     end;
 113   file.file_next_pos <- file.file_all_pos.(pos);
 114   really_write file.file_fd (pos * file.file_entry_size) str;
 115   pos
 116
 117 let file_retrieve file pos =
 118   really_read file.file_fd (pos * file.file_entry_size) file.file_chunk
 119     file.file_entry_size;
 120   file.file_chunk
 121
 122 let file_close file =
 123   Unix.close file.file_fd;
 124   Sys.remove file.file_name
 125
 126 let file_remove file pos =
 127   file.file_all_pos.(pos) <- file.file_next_pos;
 128   file.file_next_pos <- pos
 129
 130 (********************** STORE FUNCTIONS *****************)
 131
 132 let create name =
 133   {
 134     store_name = name;
 135     store_files = [];
 136     store_all_doc = [||];
 137     store_next_doc = 0;
 138   }
 139
 140 let rec chunk_size n =
 141   if n < 128 then 0 else 1 + chunk_size (n/2)
 142
 143 let combine pos chunk_size attr =
 144   let v =   pos lsl 6 + chunk_size in
 145   if attr then v lor attrib else v
 146
 147 let uncombine comb =
 148   let attr = comb land attrib <> 0 in
 149   let pos = (comb land (lnot attrib)) lsr 6 in
 150   let chunk_size = comb land 31 in
 151   pos, chunk_size, attr
 152
 153 let save t doc v attr =
 154   let str = Marshal.to_string v [] in
 155   let len = String.length str in
 156   let chunk_size = chunk_size len in
 157   let file = try
 158       List.assoc chunk_size t.store_files
 159     with Not_found ->
 160         let file = create_file t chunk_size (128 lsl chunk_size) in
 161         t.store_files <- t.store_files @ [chunk_size ,file];
 162         file
 163   in
 164   let pos = file_store file str in
 165   if verbose then begin
 166       lprintf_nl "REALLY WRITE TO %d POS %d LEN %d"
 167         chunk_size pos len;
 168     end;
 169   Weak.set file.file_cache pos (Some v);
 170   let comb = combine pos chunk_size attr in
 171   t.store_all_doc.(doc) <- comb
 172
 173 let add t v =
 174   let doc = t.store_next_doc in
 175   let len_all_doc = Array.length t.store_all_doc in
 176   if doc >= len_all_doc then begin
 177       let new_size = (len_all_doc + 10) * 2 in
 178       let new_tab = Array.make new_size 0 in
 179       (try Array.blit t.store_all_doc 0 new_tab 0 doc
 180         with e -> lprintf_nl "Error in blit %d/%d" doc len_all_doc;
 181             raise e)
 182           ;
 183       for i = doc to new_size - 1 do new_tab.(i) <- i+1; done;
 184       t.store_all_doc <- new_tab
 185     end;
 186   t.store_next_doc <- t.store_all_doc.(doc);
 187   save t doc v false;
 188   doc
 189
 190 let get t doc =
 191   let combine = t.store_all_doc.(doc) in
 192   let pos, chunk_size, attrib = uncombine combine in
 193   let file = List.assoc chunk_size t.store_files in
 194   let v =  try Weak.get file.file_cache pos
 195     with e ->
 196         lprintf_nl "Exception %s for doc at pos %d (doc %d, combine %d)" (Printexc2.to_string e)
 197         pos doc combine;
 198         raise e
 199       in
 200   match v with
 201     None ->
 202       let len = file.file_entry_size in
 203       if verbose then begin
 204           lprintf_nl "REALLY READ FROM %d POS %d LEN %d"
 205             chunk_size pos len;
 206         end;
 207       let str = file_retrieve file pos in
 208       begin
 209         try
 210           Marshal.from_string str 0
 211         with e ->
 212             lprintf_nl "Marshal.from_string error";
 213             raise e
 214       end
 215   | Some v ->
 216       if verbose then
 217           lprintf_nl "Reply found in cache";
 218       v
 219
 220
 221 let remove t doc =
 222   let combine = t.store_all_doc.(doc) in
 223   let pos, chunk_size, attr = uncombine combine in
 224   let file = List.assoc chunk_size t.store_files in
 225   file_remove file pos;
 226   Weak.set file.file_cache pos None
 227
 228 let close t =
 229   let files = t.store_files in
 230   t.store_files <- [];
 231   List.iter (fun (_, file) -> file_close file) files
 232
 233 let set_attrib t doc bool =
 234   if bool then
 235     t.store_all_doc.(doc) <- t.store_all_doc.(doc) lor attrib
 236   else
 237   let bin = t.store_all_doc.(doc) in
 238   t.store_all_doc.(doc) <-  bin land (lnot attrib)
 239
 240 let get_attrib t doc =
 241   t.store_all_doc.(doc) land attrib <> 0
 242
 243 let update t doc v =
 244   let combine = t.store_all_doc.(doc) in
 245   let _, _, attr = uncombine combine in
 246   remove t doc;
 247   save t doc v attr
 248
 249 let remove t doc =
 250   remove t doc;
 251   t.store_all_doc.(doc) <- t.store_next_doc;
 252   t.store_next_doc <- doc
 253
 254 let index i = i
 255
 256 let dummy_index = -1
 257
 258 let stats t =
 259   let counter = ref 0 in
 260   List.iter (fun (_, file) ->
 261       let len = Array.length file.file_all_pos in
 262       for i = 0 to len - 1 do
 263         match Weak.get file.file_cache i with
 264           None -> ()
 265         | Some _ -> incr counter;
 266       done;
 267   ) t.store_files;
 268   !counter, Array.length t.store_all_doc