Skip to content

Commit 2831fca

Browse files
committed
[Seedcorpus] use config
1 parent 5849813 commit 2831fca

File tree

1 file changed

+72
-66
lines changed

1 file changed

+72
-66
lines changed

src/seedcorpus/sliced_cfg_edge_cov_based.ml

Lines changed: 72 additions & 66 deletions
Original file line numberDiff line numberDiff line change
@@ -67,80 +67,86 @@ let save ?(parent : int option) (seed : Seed.t) =
6767
let evaluate_seeds_and_construct_seedpool seeds node_tbl distmap =
6868
let open AUtil in
6969
let pool = create () in
70-
(* let pools =
71-
List.fold_left
72-
(fun pools (_, llm, traces) ->
73-
let seed = Seed.make llm traces "" node_tbl distmap in
74-
L.debug "evaluate seed: \n%s\n" (ALlvm.string_of_llmodule llm);
75-
L.debug "score: %s" (string_of_float (Seed.score seed));
76-
seed :: pools)
77-
[] seeds
78-
in
79-
let init_cov =
80-
List.fold_left
81-
(fun accu seed -> Coverage.union accu (Seed.edge_cov seed))
82-
Coverage.empty pools
83-
in
84-
pools |> List.to_seq |> add_seq pool;
85-
(pool, init_cov) *)
86-
let pool_covers, pool_noncovers =
87-
List.fold_left
88-
(fun (pool_covers, pool_noncovers) (_, llm, traces) ->
89-
let seed = Seed.make llm traces "" node_tbl distmap in
90-
L.debug "evaluate seed: \n%s\n" (ALlvm.string_of_llmodule llm);
91-
L.debug "score: %s" (string_of_float (Seed.score seed));
92-
(* will assume all-edges option to non-directed fuzzing *)
93-
if !Config.coverage = Config.FuzzingMode.All_edges then
94-
(pool_covers, seed :: pool_noncovers)
95-
else if Seed.covers seed then (seed :: pool_covers, pool_noncovers)
96-
else (pool_covers, seed :: pool_noncovers))
97-
([], []) seeds
98-
in
99-
if pool_covers = [] then (
100-
L.info "No covering seeds found. Using closest seeds.";
101-
let pool_closest =
102-
pool_noncovers
103-
|> List.sort_uniq (fun a b ->
104-
compare
105-
(ALlvm.hash_llm (Seed.llmodule a))
106-
(ALlvm.hash_llm (Seed.llmodule b)))
107-
in
108-
let pool_closest =
109-
if !Config.score = Config.FuzzingMode.Constant then pool_closest
110-
else
111-
pool_closest
112-
|> List.sort (fun a b -> compare (Seed.score a) (Seed.score b))
113-
in
114-
let pool_closest =
115-
(* will assume all-edges option to non-directed fuzzing *)
116-
if !Config.coverage = Config.FuzzingMode.All_edges then pool_closest
117-
else pool_closest |> take !Config.max_initial_seed
70+
if
71+
(* Optimuzz_Base *)
72+
!Config.score = Config.FuzzingMode.Constant
73+
&& !Config.coverage = Config.FuzzingMode.All_edges
74+
then (
75+
let pools =
76+
List.fold_left
77+
(fun pools (_, llm, traces) ->
78+
let seed = Seed.make llm traces "" node_tbl distmap in
79+
L.debug "evaluate seed: \n%s\n" (ALlvm.string_of_llmodule llm);
80+
L.debug "score: %s" (string_of_float (Seed.score seed));
81+
seed :: pools)
82+
[] seeds
11883
in
119-
12084
let init_cov =
12185
List.fold_left
12286
(fun accu seed -> Coverage.union accu (Seed.edge_cov seed))
123-
Coverage.empty pool_closest
87+
Coverage.empty pools
12488
in
125-
pool_closest |> List.to_seq |> add_seq pool;
89+
pools |> List.to_seq |> add_seq pool;
12690
(pool, init_cov))
127-
else (
128-
(* if we have covering seeds, we use covering seeds only. *)
129-
L.info "Covering seeds found. Using them only.";
130-
let pool_covers =
131-
pool_covers
132-
|> List.sort_uniq (fun a b ->
133-
compare
134-
(ALlvm.hash_llm (Seed.llmodule a))
135-
(ALlvm.hash_llm (Seed.llmodule b)))
136-
in
137-
let init_cov =
91+
else
92+
let pool_covers, pool_noncovers =
13893
List.fold_left
139-
(fun accu seed -> Coverage.union accu (Seed.edge_cov seed))
140-
Coverage.empty pool_covers
94+
(fun (pool_covers, pool_noncovers) (_, llm, traces) ->
95+
let seed = Seed.make llm traces "" node_tbl distmap in
96+
L.debug "evaluate seed: \n%s\n" (ALlvm.string_of_llmodule llm);
97+
L.debug "score: %s" (string_of_float (Seed.score seed));
98+
(* will assume all-edges option to non-directed fuzzing *)
99+
if !Config.coverage = Config.FuzzingMode.All_edges then
100+
(pool_covers, seed :: pool_noncovers)
101+
else if Seed.covers seed then (seed :: pool_covers, pool_noncovers)
102+
else (pool_covers, seed :: pool_noncovers))
103+
([], []) seeds
141104
in
142-
pool_covers |> List.to_seq |> add_seq pool;
143-
(pool, init_cov))
105+
if pool_covers = [] then (
106+
L.info "No covering seeds found. Using closest seeds.";
107+
let pool_closest =
108+
pool_noncovers
109+
|> List.sort_uniq (fun a b ->
110+
compare
111+
(ALlvm.hash_llm (Seed.llmodule a))
112+
(ALlvm.hash_llm (Seed.llmodule b)))
113+
in
114+
let pool_closest =
115+
if !Config.score = Config.FuzzingMode.Constant then pool_closest
116+
else
117+
pool_closest
118+
|> List.sort (fun a b -> compare (Seed.score a) (Seed.score b))
119+
in
120+
let pool_closest =
121+
(* will assume all-edges option to non-directed fuzzing *)
122+
if !Config.coverage = Config.FuzzingMode.All_edges then pool_closest
123+
else pool_closest |> take !Config.max_initial_seed
124+
in
125+
126+
let init_cov =
127+
List.fold_left
128+
(fun accu seed -> Coverage.union accu (Seed.edge_cov seed))
129+
Coverage.empty pool_closest
130+
in
131+
pool_closest |> List.to_seq |> add_seq pool;
132+
(pool, init_cov))
133+
else (
134+
(* if we have covering seeds, we use covering seeds only. *)
135+
L.info "Covering seeds found. Using them only.";
136+
let pool_covers =
137+
pool_covers
138+
|> List.sort_uniq (fun a b ->
139+
compare
140+
(ALlvm.hash_llm (Seed.llmodule a))
141+
(ALlvm.hash_llm (Seed.llmodule b)))
142+
in
143+
let init_cov =
144+
List.fold_left
145+
(fun accu seed -> Coverage.union accu (Seed.edge_cov seed))
146+
Coverage.empty pool_covers
147+
in
148+
pool_covers |> List.to_seq |> add_seq pool;
149+
(pool, init_cov))
144150

145151
let make llctx node_tbl (distmap : float Aflgo.DistanceTable.t) =
146152
let open AUtil in

0 commit comments

Comments
 (0)