Skip to content

Commit cdf6913

Browse files
urieluriel
committed
add files
0 parents  commit cdf6913

File tree

15 files changed

+4372
-0
lines changed

15 files changed

+4372
-0
lines changed

‎LICENSE

Lines changed: 674 additions & 0 deletions
Large diffs are not rendered by default.

‎Makefile

Lines changed: 51 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,51 @@
1+
DEBUG=-DDEBUG
2+
PP=-pp "cpp -w $(DEBUG)" #"camlp4o pa_macro.cmo $(DEBUG)"
3+
OCAMLOPT=ocamlopt $(PP)
4+
OCAMLC=ocamlc $(PP)
5+
OCAMLDOC=ocamldoc $(PP)
6+
CFLAGS=-Wall
7+
8+
SRC=pijul.cmx interaction.cmx commands.cmx main.cmx
9+
pijul:$(SRC) mdb.cmxa
10+
ocamlfind ocamlopt -package cryptokit -o $@ -cclib -L. mdb.cmxa str.cmxa -linkpkg $(SRC)
11+
12+
pijul.cmx:mdb.cmxa pijul.cmi
13+
pijul.cmi:mdb.cmxa
14+
commands.cmx:pijul.cmx interaction.cmx
15+
interaction.cmx:pijul.cmx
16+
main.cmx:commands.cmx pijul.cmx
17+
test.cmx:pijul.cmx
18+
19+
%.cmx:%.ml
20+
ocamlfind $(OCAMLOPT) -package cryptokit -c -w A -o $@ $<
21+
%.cmi:%.mli
22+
$(OCAMLC) -c -w A -o $@ $<
23+
24+
mdb.cmxa:mdb_constants.ml mdb.ml lmdb_stubs.o
25+
ocamlmklib -o mdb lmdb_stubs.o mdb_constants.ml mdb.ml -llmdb -linkall
26+
27+
28+
mdb_constants.ml:make_stubs
29+
bash make_stubs
30+
31+
lmdb_stubs.o:lmdb_stubs.c
32+
cc -fPIC -Wall -c -o $@ $<
33+
34+
.PHONY:doc remotedoc
35+
doc:
36+
ocamldoc -html -d doc pijul.mli
37+
38+
remotedoc:doc
39+
rsync -r doc gitit@ovh:pijul/static/
40+
41+
42+
clean:
43+
rm -f *~ *.cm[oxai] *.cmxa *.o *.so *.a
44+
rm -Rf doc
45+
46+
TESTS=tests/basic.tested tests/linedel.tested tests/unrecord.tested tests/rollback.tested
47+
48+
shell-tests: pijul $(TESTS)
49+
50+
%.tested:%.sh
51+
pijul=`pwd`/pijul bash $<

‎commands.ml

Lines changed: 113 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,113 @@
1+
exception Nothing_to_record
2+
3+
let now () =
4+
let i=Unix.open_process_in "date -In" in
5+
let d=input_line i in
6+
let _=Unix.close_process_in i in
7+
d
8+
9+
10+
let polite_record pijul_path records update_files=
11+
(* let records=with_cursor txn alldb.dbi_nodes (filter records) in *)
12+
match records with
13+
[]-> raise Nothing_to_record
14+
| _->
15+
begin
16+
let time= now () in
17+
(* let author=ask_author pijul_path in *)
18+
(* let name=ask_name () in *)
19+
let author="" and name="" in
20+
let obsoletes=[] in
21+
let patch=Pijul.({ records;dependencies=dependencies records; obsoletes; name; author; time }) in
22+
(* List.iter (fun d->Printf.eprintf "dep %S\n" (to_hex d)) patch.dependencies;flush stderr; *)
23+
let patches_path=Pijul.patchesdir pijul_path in
24+
let patchid=Pijul.save_patch ~patches_path patch in
25+
Pijul.with_pijul
26+
pijul_path
27+
(fun _ txn->
28+
let repo=Pijul.open_repository txn in
29+
let _=Pijul.apply txn repo patch patchid in
30+
Pijul.sync_files txn repo patch patchid update_files;
31+
Pijul.write_changes ~pijuldir:pijul_path txn repo;
32+
()
33+
)
34+
end
35+
36+
let record pijul_path dir txn =
37+
let repo = Pijul.open_repository txn in
38+
let records,update_files=Pijul.record ~working_copy:dir txn repo in
39+
polite_record pijul_path records update_files
40+
41+
42+
let sort_patches patches_path patches=
43+
List.sort
44+
(fun a b->
45+
let pa=let o=open_in_bin (Filename.concat patches_path (Pijul.to_hex (String.sub a 0 Pijul.hash_size))) in
46+
let t=Pijul.input_time o in
47+
close_in o; t
48+
in
49+
let pb=let o=open_in_bin (Filename.concat patches_path (Pijul.to_hex (String.sub b 0 Pijul.hash_size))) in
50+
let t=Pijul.input_time o in
51+
close_in o; t
52+
in
53+
compare pb pa
54+
)
55+
patches
56+
57+
let unrecord pijul_path =
58+
let patches_path=Pijul.patchesdir pijul_path in
59+
let patches=
60+
Pijul.with_pijul
61+
pijul_path
62+
(fun _ txn->
63+
let repo=Pijul.open_repository txn in
64+
Pijul.(branch_patches txn repo repo.current_branch);
65+
)
66+
in
67+
let patches=sort_patches patches_path patches in
68+
let patches=Interaction.filter_patches pijul_path false "unrecord" patches in
69+
let patches=Pijul.patches_topo patches_path patches in
70+
Pijul.with_pijul
71+
pijul_path
72+
(fun _ txn->
73+
let repo=Pijul.open_repository txn in
74+
List.iter
75+
(fun patch_id->
76+
let o=open_in (Filename.concat patches_path (Pijul.to_hex patch_id)) in
77+
let p=Pijul.input_patch o in
78+
close_in o;
79+
Pijul.unsafe_unrecord txn repo p patch_id;
80+
Pijul.unrecord_sync txn repo patch_id;
81+
) patches;
82+
Pijul.write_changes ~pijuldir:pijul_path txn repo;
83+
)
84+
85+
86+
let rollback pijul_path=
87+
let patches_path=Pijul.patchesdir pijul_path in
88+
let patches=
89+
Pijul.with_pijul
90+
pijul_path
91+
(fun _ txn->
92+
let repo=Pijul.open_repository txn in
93+
Pijul.(branch_patches txn repo repo.current_branch);
94+
)
95+
in
96+
let patches=sort_patches patches_path patches in
97+
let patches=Interaction.filter_patches pijul_path false "rollback" patches in
98+
let patches=Pijul.patches_topo patches_path patches in
99+
100+
let rollback_records=ref [] in
101+
Pijul.with_pijul
102+
pijul_path
103+
(fun _ txn->
104+
let repo=Pijul.open_repository txn in
105+
List.iter
106+
(fun patch_id->
107+
let o=open_in (Filename.concat patches_path (Pijul.to_hex patch_id)) in
108+
let p=Pijul.input_patch o in
109+
close_in o;
110+
rollback_records:=Pijul.(rollback txn repo p.records patch_id) @ !rollback_records
111+
) patches;
112+
);
113+
polite_record pijul_path !rollback_records Pijul.M.empty

‎interaction.ml

Lines changed: 97 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,97 @@
1+
(*
2+
unrecord p: if q depends on p, selecting p must also select q.
3+
push p: if p depends on q, selecting p must also select q.
4+
5+
This function takes care of all this:
6+
7+
"push mode" means include_deps=true, "unrecord mode" means include_deps=false.
8+
*)
9+
10+
let general_filter l include_deps key dep que=
11+
let str=String.create 1 in
12+
let last_asked=ref 1 in
13+
let rec filter actions past i sel unsel sel_deps unsel_deps=match actions with
14+
[]->(
15+
if i- !last_asked > 1 then (
16+
);
17+
List.fold_left (fun l (u,v,_,_,_,_) -> if u then v::l else l) [] past
18+
)
19+
| h::s->
20+
let k=key h in
21+
let deps=dep h in
22+
let selected,direction=
23+
if if include_deps then Pijul.S.mem k sel_deps else
24+
List.exists (fun d->Pijul.S.mem d sel) deps
25+
then
26+
true,1
27+
else
28+
if if include_deps then List.exists (fun d->Pijul.S.mem d unsel) deps
29+
else Pijul.S.mem k unsel_deps
30+
then
31+
false,1
32+
else
33+
begin
34+
if i- !last_asked > 1 then (
35+
Printf.printf "Skipping %d\n" (i- !last_asked-1);flush stdout;
36+
);
37+
que h i;
38+
last_asked:=i;
39+
flush stdout;
40+
str.[0]<-'\000';
41+
let _=Unix.read Unix.stdin str 0 1 in
42+
Printf.fprintf stdout "\n";
43+
match str with
44+
"y"->true,1
45+
| "n"->false,1
46+
| "k"->false, -1
47+
| _->false,0
48+
end
49+
in
50+
if direction<0 then
51+
match past with
52+
[]->filter actions past i sel unsel sel_deps unsel_deps
53+
| (_,u,a,b,c,d)::v->filter (u::actions) v (i-1) a b c d
54+
else if direction=0 then
55+
filter actions past i sel unsel sel_deps unsel_deps
56+
else
57+
let sel',unsel'=if selected then Pijul.S.add k sel,unsel else sel,Pijul.S.add k unsel
58+
and sel_deps',unsel_deps'=
59+
if selected then List.fold_left (fun m d->Pijul.S.add d m) sel_deps deps,unsel_deps
60+
else sel_deps,List.fold_left (fun m d->Pijul.S.add d m) unsel_deps deps
61+
in
62+
filter s ((selected,h,sel,unsel,sel_deps,unsel_deps)::past) (i+1) sel' unsel' sel_deps' unsel_deps'
63+
in
64+
let tcattr = if Unix.isatty Unix.stdin
65+
then
66+
let tcattr=Unix.tcgetattr Unix.stdin in
67+
Unix.tcsetattr Unix.stdin Unix.TCSADRAIN { tcattr with Unix.c_icanon=false };
68+
Some tcattr
69+
else
70+
None
71+
in
72+
let f=filter l [] 1 Pijul.S.empty Pijul.S.empty Pijul.S.empty Pijul.S.empty in
73+
let () = match tcattr with | Some tcattr -> Unix.tcsetattr Unix.stdin Unix.TCSADRAIN tcattr | None -> () in
74+
f
75+
76+
77+
let filter_patches pijuldir push_mode action all_patches=
78+
let n=List.length all_patches in
79+
general_filter
80+
all_patches
81+
push_mode
82+
(fun h->h)
83+
(fun h->
84+
let o=open_in_bin (Filename.concat (Pijul.patchesdir pijuldir) (Pijul.to_hex h)) in
85+
let p=Pijul.input_dependencies o in
86+
close_in o;
87+
p)
88+
(fun h i->
89+
let p=
90+
let o=open_in_bin (Filename.concat (Pijul.patchesdir pijuldir) (Pijul.to_hex h)) in
91+
let p=Pijul.input_patch o in
92+
close_in o;
93+
p
94+
in
95+
let open Pijul in
96+
Printf.fprintf stdout "%s %s\n * %s\nShall I %s this patch? (%d/%d) [ynk]: " p.time p.author p.name action i n
97+
)

0 commit comments

Comments
 (0)