-
Notifications
You must be signed in to change notification settings - Fork 5
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
initial import from darcs of lfs 0.5
- Loading branch information
pad
committed
Sep 29, 2010
0 parents
commit 77ef313
Showing
485 changed files
with
89,649 additions
and
0 deletions.
There are no files selected for viewing
Large diffs are not rendered by default.
Oops, something went wrong.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,12 @@ | ||
# autogenerated by configure | ||
|
||
# Where to install the binary | ||
BINDIR=/usr/local/bin | ||
|
||
# Where to install the man pages | ||
MANDIR=/usr/local/man | ||
|
||
SHAREDIR=/usr/local/share/lfs | ||
|
||
# Features | ||
FEATURE_BACKTRACE=0 |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,33 @@ | ||
SRCSPEC= lfs.ml plugins.ml demo.ml | ||
SRCCORE= lfs.ml spec.ml | ||
SRCREALMEM=lfsmem_fuse.ml | ||
|
||
#spec: | ||
# perl -pi -e 's/.*##\s*IMPL//g' LfsOcaml.mlx | ||
# perl -pi -e 's/##(.*)##SPEC/$$1/g' LfsOcaml.mlx | ||
|
||
|
||
coredemo: $(SRCCOREDEMO:.ml=.cmx) | ||
$(OCAMLOPT) -o $@ $(SYSLIBSCORE:=.cmxa) $(SRCCOREDEMO:.ml=.cmx) | ||
clean:: | ||
rm -f coredemo | ||
|
||
|
||
coredemo.top: $(SRCCOREDEMO:.ml=.cmo) | ||
$(OCAMLMKTOP) -o $@ $(LIBSCORE:=.cma) $(SRCCOREDEMO:.ml=.cmo) | ||
clean:: | ||
rm -f coredemo.top | ||
|
||
|
||
lfsmem: $(SRCREALMEM:.ml=.cmx) | ||
$(OCAMLOPT) -o $@ $(LIBSCORE:=.cmxa) \ | ||
-ccopt -Locamlfuse Fuse.cmxa -cclib -lfuse -cclib -lcamlidl \ | ||
$(SRCREALMEM:.ml=.cmx) | ||
clean:: | ||
rm -f lfsmem | ||
|
||
|
||
specdemo: $(SRCSPEC:.ml=.cmx) | ||
$(OCAMLOPT) -o $@ $(LIBSSPEC:=.cmxa) $(SRCSPEC:.ml=.cmx) | ||
clean:: | ||
rm -f specdemo |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,233 @@ | ||
open Common | ||
open Fullcommon | ||
|
||
open Lfs | ||
|
||
open Oassocdbm | ||
|
||
open Common_fuse | ||
|
||
open Ioplugins | ||
|
||
let launch_db_and_lfs path_meta argv_fuse = | ||
let obj_to_path = (fun obj -> | ||
(* cos of ext2 limitation, cant have dire with more than 32000 files => have to split *) | ||
(* coupling: with check_world *) | ||
path_meta ^ "/files/" ^ (i_to_s (obj / 1000)) ^ "/" ^ (i_to_s obj)) | ||
in | ||
let obj_to_filename = (fun obj -> obj_to_path obj ^ "/data") in | ||
|
||
begin | ||
|
||
Lfs._realfs := true; | ||
Lfs.core_get_path_data := (fun () -> path_meta); | ||
|
||
Lfs.core_get_fcontent__id := | ||
(function (Real o) -> read_file (obj_to_filename o) | _ -> raise Impossible); | ||
|
||
Lfs.core_set_fcontent__fst := | ||
(function ((Core content), o) -> (Real o) | _ -> raise Impossible); | ||
|
||
Lfs.core_get_size_fcontent__slength := | ||
(function (Real o) -> (try filesize (obj_to_filename o) with _ -> 0) +> size_mo_ko | _ -> raise Impossible); | ||
(* why try ? cos perl first call ml to check if can mkfile, and then create file on disk (but normally no more pb cos dont get called) *) | ||
|
||
Lfs.core_update_fcontent__fst := | ||
(function (content, o) -> | ||
(* CONFIG, can comment if want lazy update (or no update at all) *) | ||
write_file (obj_to_filename o) (content()); | ||
(* CONFIG, can comment if trust poffs :) *) | ||
ignore(Sys.command("mkdir " ^ (obj_to_path o) ^ "/RCS")); | ||
ignore(Unix.system("cd " ^ (obj_to_path o) ^ "; cp data _backup; echo bidon | ci -l _backup")); | ||
(Real o) | ||
); | ||
|
||
|
||
Lfs.hook_find_alogic := (fun id -> uninteract_logic (obj_to_filename id)); | ||
Lfs.hook_find_transducer := (fun id prop conv -> (* IMPL *) | ||
(* Lfs.core_hook_transducer := (fun id prop -> ##SPEC *) | ||
if prop = (Prop "transducer:") | ||
then Left (uninteract_transducer (obj_to_filename id) obj_to_filename) | ||
else Right (uninteract_adv_transducer (obj_to_filename id) conv)); (* IMPL *) | ||
(* else AdvTrans (uninteract_adv_transducer (obj_to_filename id))); ##SPEC *) | ||
|
||
|
||
(* old: simple persistence | ||
let (data:(int * Lfs.world)) = get_value (path_meta ^ "/ocaml_world") in | ||
(Lfs.w := snd data; | ||
Common._counter := fst data | ||
) | ||
old: no persistence | ||
(Lfs.w := Lfs.default_world; | ||
Common._counter := 2; | ||
); | ||
*) | ||
(* rescue: let init_not_reload = false in let _ = (Common._counter := 300000; Common._counter2 := 300000 * 20) in *) | ||
let init_not_reload = not (Sys.file_exists (path_meta ^ "/counter")) in | ||
if init_not_reload | ||
then Common._counter := 2 (* inode must be at least > 1, to avoid conflict with root inode = 1. as file id are inode id => same constraint , TODO freeobj *) | ||
else (Common._counter := get_value (path_meta ^ "/counter"); | ||
Common._counter2 := get_value (path_meta ^ "/counter2"); | ||
); | ||
let adapt = fun f o -> if init_not_reload then f o else o in | ||
|
||
|
||
(* CONFIG *) | ||
let size_buffer = 500 in | ||
let caching db = new oassoc_buffer size_buffer db in | ||
(* !!!!!!!!!!!!!!!!!!!!!!! *) | ||
(* let caching db = db in ## take care cos if not buffered, many stuff slow down (specially context creation) *) | ||
|
||
(* I now use GDBM (easier to install and less segfault (but no transaction)) *) | ||
(* lfs *) | ||
let gchildrendb = Dbm.opendbm (path_meta ^ "/children") [Dbm.Dbm_create;Dbm.Dbm_rdwr] 0o777 in | ||
let gparentsdb = Dbm.opendbm (path_meta ^ "/parents") [Dbm.Dbm_create;Dbm.Dbm_rdwr] 0o777 in | ||
|
||
let iprop_propdb = Dbm.opendbm (path_meta ^ "/iprop_prop") [Dbm.Dbm_create;Dbm.Dbm_rdwr] 0o777 in | ||
let prop_ipropdb = Dbm.opendbm (path_meta ^ "/prop_iprop") [Dbm.Dbm_create;Dbm.Dbm_rdwr] 0o777 in | ||
let cache_is_formuladb = Dbm.opendbm (path_meta ^ "/cache_is_formula") [Dbm.Dbm_create;Dbm.Dbm_rdwr] 0o777 in | ||
|
||
let filesdb = Dbm.opendbm (path_meta ^ "/filesdb") [Dbm.Dbm_create;Dbm.Dbm_rdwr] 0o777 in | ||
let extfilesdb = Dbm.opendbm (path_meta ^ "/extfiles") [Dbm.Dbm_create;Dbm.Dbm_rdwr] 0o777 in | ||
|
||
let children_assoc = (caching (new oassocdbm [] gchildrendb (fun osetb -> osetb#tosetb) (fun setb -> new osetb setb) ) ) in | ||
let parents_assoc = (caching (new oassocdbm [] gparentsdb (fun osetb -> osetb#tosetb) (fun setb -> new osetb setb) ) ) in | ||
let prop_iprop_assoc = (caching (new oassocdbm [] prop_ipropdb id id)) in | ||
let iprop_prop_assoc = (caching (new oassocdbm [] iprop_propdb id id)) in | ||
let cache_is_formula_assoc = (caching (new oassocdbm [] cache_is_formuladb (fun oset -> oset#tosetb) (fun set -> new osetb set))) in | ||
let files_assoc = (caching (new oassocdbm [] filesdb id id)) in | ||
let extfiles_assoc = (caching (new oassocdbm [] extfilesdb (fun oset -> oset#toseti) (fun set -> new oseti set) ) ) in (* OPT5 *) | ||
(* IFNOT OPT5 let extfiles_assoc = (caching (new Bdbo.oassocbtree [] extfilesdb (fun oset -> oset#tosetb) (fun set -> new osetb set) ) ) in *) | ||
|
||
|
||
(* pof *) | ||
let _count = ref 0 in (* IMPL *) | ||
let _ = Unix.system ("rm -f " ^ path_meta ^ "/*extparts*") in (* IMPL *) | ||
let _ = Unix.system ("rm -f " ^ path_meta ^ "/*partsinfo*") in (* IMPL *) | ||
let _ = Unix.system ("rm -rf " ^ path_meta ^ "/files/2[0-9][0-9][0-9]/*") in (* the views *) | ||
(* | ||
Lfs.empty_extparts := (fun () -> (* IMPL *) | ||
let _ = incr _count in (* IMPL *) | ||
let newdb = Dbm.opendbm (path_meta ^ "/extparts" ^ i_to_s !_count) [Dbm.Dbm_create;Dbm.Dbm_rdwr] 0o777 in | ||
(* coupling: must be same seti than in empty_ext ##IMPL *) | ||
caching (new oassocdbm [] newdb (fun oset -> oset#toseti) (fun set -> new oseti set)) (* OPT5 ##IMPL *) | ||
(* IFNOT OPT5 caching (new Bdbo.oassocbtree [] newdb (fun oset -> oset#tosetb) (fun set -> new osetb set)) ##IMPL *) | ||
); (* IMPL *) | ||
*) (* IMPL *) | ||
|
||
Lfs.empty_partsinfo := (fun () -> (* IMPL *) | ||
let _ = incr _count in (* IMPL *) | ||
let newdb = Dbm.opendbm (path_meta ^ "/partsinfo" ^ i_to_s !_count) [Dbm.Dbm_create;Dbm.Dbm_rdwr] 0o777 in | ||
(* note: i bufferise partsinfo just for the grouping of io, not for the multiple update gain, cos never happened for this assoc ##IMPL *) | ||
caching (new oassocdbm [] newdb id id) (* IMPL *) | ||
); (* IMPL *) | ||
(* IMPL *) | ||
|
||
|
||
Lfs.w := { default_world with (* IMPL *) | ||
graphp = (new ograph2way (* IMPL *) | ||
children_assoc (* IMPL *) | ||
parents_assoc (* IMPL *) | ||
emptysb (* IMPL *) | ||
) (* IMPL *) | ||
+> adapt (fun o -> o#add_node iroot); (* IMPL *) | ||
prop_iprop = prop_iprop_assoc (* IMPL *) | ||
+> adapt (fun o -> o#add (root, iroot)); (* IMPL *) | ||
iprop_prop = iprop_prop_assoc (* IMPL *) | ||
+> adapt (fun o -> o#add (iroot, root)); (* IMPL *) | ||
cache_is_formula = cache_is_formula_assoc; (* IMPL *) | ||
(* IMPL *) | ||
files = files_assoc; (* IMPL *) | ||
extfiles = extfiles_assoc (* IMPL *) | ||
+> adapt (fun o -> o#add (iroot, empty_ext ())); (* IMPL *) | ||
}; (* IMPL *) | ||
|
||
|
||
|
||
|
||
Common_fuse.main path_meta ((fun () -> ()), (fun () -> ()), (fun () -> ())) argv_fuse; | ||
|
||
(try | ||
begin | ||
(* generic are in fact flush, to use if use with caching (oassoc_buffer, cos table are buffered) *) | ||
children_assoc#generic; | ||
parents_assoc#generic; | ||
prop_iprop_assoc#generic; | ||
iprop_prop_assoc#generic; | ||
cache_is_formula_assoc#generic; | ||
files_assoc#generic; | ||
extfiles_assoc#generic; | ||
|
||
(* Txn.commit !t None; *) | ||
|
||
(* | ||
Dbm.close gchildrendb; | ||
Dbm.close gparentsdb; | ||
Dbm.close prop_ipropdb; | ||
Dbm.close iprop_propdb; | ||
Dbm.close cache_is_formuladb; | ||
Dbm.close filesdb; | ||
Dbm.close extfilesdb; | ||
*) | ||
end | ||
with _ -> () | ||
); | ||
let _ = Timing() in | ||
write_value !Common._counter (path_meta ^ "/counter"); | ||
write_value !Common._counter2 (path_meta ^ "/counter2"); | ||
|
||
() | ||
end | ||
|
||
|
||
|
||
(************************************************************************************) | ||
let _ = | ||
begin | ||
Lfs.copyright (); | ||
let arg1 = ref None in | ||
let arg2 = ref None in | ||
let options = Arg.align | ||
[ "-fastfsck", Arg.Set Flag.fast_fsck, " do not check for coverability"; | ||
"-fsckonly", Arg.Set Flag.fsck_only, " launch fsck and exit"; | ||
"-timeout", Arg.Set_int Flag.timeout, " set number of seconds before interrupting lfs or buggy external plugins"; | ||
"-nostat", Arg.Set Flag.nostat, " dont launch stat"; | ||
"-nofsck", Arg.Set Flag.nofsck, " dont launch fsck"; | ||
"-command", Arg.Set Flag.exec_internal_command, " launch only the internal command specified in lfsbdb_fuse.ml"; | ||
"-notransact", Arg.Set Flag.notransact, " dont use transaction"; | ||
] in | ||
let usage_msg = | ||
("Usage: " ^ basename Sys.argv.(0) ^ " [options] <LFS-meta-data-path> <mountpoint>\nOptions are:") in | ||
Arg.parse | ||
options | ||
(fun s -> | ||
match !arg1 with | ||
| None -> arg1 := Some s | ||
| Some arg1 -> | ||
(arg2 := Some s; | ||
launch_db_and_lfs arg1 (Array.of_list ((Sys.argv.(0)::"-s"::"-o"::"max_read=16384,allow_other"::[s]))) | ||
) | ||
) | ||
usage_msg; | ||
(match (!arg1, !arg2) with | ||
| (Some _, Some _) -> () | ||
| _ -> Arg.usage options usage_msg | ||
); | ||
|
||
end | ||
|
||
(* | ||
let _ = | ||
Lfs.copyright (); | ||
match (Array.to_list Sys.argv ) with | ||
| x::y::ys -> | ||
begin | ||
Sys.chdir y; | ||
launch_db_and_lfs (Sys.getcwd()) (Array.of_list (x::"-s"::"-o"::"max_read=16384,allow_other"::ys)) | ||
end | ||
| _ -> failwith "give me a path, and a mountpoint, where are LFS meta-data ?" | ||
*) |
Oops, something went wrong.