Skip to content

Commit

Permalink
Merge pull request #9 from formalsec/evaluation-work
Browse files Browse the repository at this point in the history
Evaluation work
  • Loading branch information
Th0mz authored Oct 15, 2024
2 parents 089a0d2 + 1db8a2c commit d66ad75
Show file tree
Hide file tree
Showing 34 changed files with 6,593 additions and 3,948 deletions.
16 changes: 11 additions & 5 deletions bin/main.ml
Original file line number Diff line number Diff line change
Expand Up @@ -26,22 +26,25 @@ let setup_output output_path =
let main file_name output_path config_path mode generate_mdg no_dot verbose =
(* DANGEROUS: We create "run" but don't pass it to any function?
Is there any global behaviour that will write to "run"? *)
let* code_dir, graph_dir, _ = setup_output output_path in
let* code_dir, graph_dir, run_dir = setup_output output_path in
let* dep_tree = DependencyTree.generate file_name mode in

(* process dependencies first with the aid of the depedency tree *)
let summaries = Summaries.empty () in
let module_graphs = ModuleGraphs.empty () in

let start = Sys.time () in
List.iter
(fun file_path ->
let dir = Fpath.parent @@ Fpath.v file_name in
let dir = Fpath.append (Fpath.v (Unix.getcwd ())) @@ Fpath.parent @@ Fpath.v file_path in
let file_name = Fpath.base @@ Fpath.v file_path in

(* STEP 0 : Generate AST using Flow library *)
let ast = Js_parser.from_file file_path in

(* STEP 1 : Normalize AST *)
let norm_program = Ast.Normalize.program ast file_path in

let norm_program =
if file_path = dep_tree.main then Program.set_main norm_program
else norm_program
Expand Down Expand Up @@ -85,13 +88,16 @@ let main file_name output_path config_path mode generate_mdg no_dot verbose =
Summaries.add summaries file_path exportedObject;
Summaries.add summaries alter_name exportedObject))
(DependencyTree.bottom_up_visit dep_tree);

(* output *)
if generate_mdg then (
let mdg_end = (Sys.time () -. start) *. 1000.0 in
let main = DependencyTree.get_main dep_tree in
let graph = ModuleGraphs.get module_graphs main in
if not no_dot then Mdg.Pp.Dot.output (Fpath.to_string graph_dir) graph;
Mdg.Pp.CSV.output (Fpath.to_string graph_dir) graph);
if not no_dot then Mdg.Pp.Dot.output graph_dir graph;
Mdg.Pp.CSV.output graph_dir graph;
Mdg.Pp.Time.output run_dir mdg_end;
);
Ok 0

(* setup comand line interface using CMDLiner library*)
Expand Down
315 changes: 232 additions & 83 deletions lib/ast/normalize.ml

Large diffs are not rendered by default.

40 changes: 22 additions & 18 deletions lib/ast/pp.ml
Original file line number Diff line number Diff line change
Expand Up @@ -67,8 +67,9 @@ module Js = struct
| _, Labeled {label; body} ->
let label' = print_identifier label in
let new_identation = identation + spaces_per_identation in

let body' = print_stmts body new_identation in
identation_str ^ label' ^ ":\n" ^ body' ^ "\n"
identation_str ^ label' ^ ": {\n" ^ body' ^ identation_str ^ "}\n"

| _, VarDecl {kind; id} ->
let kind' = match kind with
Expand Down Expand Up @@ -158,14 +159,14 @@ module Js = struct
let argument' = print_expr argument in
identation_str ^ left' ^ " = " ^ operator' ^ argument' ^ ";\n"

| _, AssignYield {left; argument; _ } ->
| _, Yield {left; argument; _ } ->
let left' = print_identifier left in
let argument' = map_default ((^) " " << print_expr) "" argument in
identation_str ^ left' ^ " = yield" ^ argument' ^ ";\n"

| _, AssignArray {left; _} ->
| _, AssignArray {left; size; _} ->
let left' = print_identifier left in
identation_str ^ left' ^ " = [];\n"
identation_str ^ left' ^ " = new Array(" ^ string_of_int size ^ ");\n"

| _, AssignObject {left; _} ->
let left' = print_identifier left in
Expand Down Expand Up @@ -211,6 +212,19 @@ module Js = struct
let right' = print_expr right in
identation_str ^ _object' ^ "[" ^ property' ^ "] = " ^ right' ^ ";\n"

| _, StaticDelete {left; _object; property; is_literal; _} ->
let left' = print_identifier left in
let _object' = print_expr _object in
if is_literal
then identation_str ^ left' ^ " = delete " ^ _object' ^ "[\"" ^ property ^ "\"];\n"
else identation_str ^ left' ^ " = delete " ^ _object' ^ "." ^ property ^ ";\n"

| _, DynamicDelete {left; _object; property; _} ->
let left' = print_identifier left in
let _object' = print_expr _object in
let property' = print_expr property in
identation_str ^ left' ^ " = delete " ^ _object' ^ "[" ^ property' ^ "];\n"

| _, StaticLookup {left; _object; property; is_literal; _} ->
let left' = print_identifier left in
let _object' = print_expr _object in
Expand All @@ -224,14 +238,16 @@ module Js = struct
let property' = print_expr property in

identation_str ^ left' ^ " = " ^ _object' ^ "[" ^ property' ^ "];\n"

| _, AssignFunction {left; params; body; _} ->
let left' = print_identifier left in
let params' = List.map print_param params in
let new_identation = identation + spaces_per_identation in
let body' = print_stmts body new_identation in

identation_str ^ left' ^ " = function (" ^ (String.concat ", " params') ^ ") {\n" ^ body' ^ identation_str ^ "}\n"

| _, Expression expr -> identation_str ^ print_expr expr ^ ";\n"

and print_expr (expr : m Expression.t): string =
match expr with
Expand All @@ -244,18 +260,6 @@ module Js = struct

let quasi_expr = List.map (fun (raw, expr) -> raw ^ (if expr != "" then "${" ^ expr ^ "}" else "")) (List.combine quasis' (expressions' @ [""])) in
"`" ^ String.concat "" quasi_expr ^ "`"

(*
| _, TaggedTemplate {tag; quasi} ->
let tag' = print_expr tag in
let quasi' = print_expr (Location.empty, Expression.TemplateLiteral quasi) in
tag' ^ quasi'
| _, MetaProperty {meta; property} ->
let meta' = print_identifier meta) in
let property' = print_identifier property) in
meta' ^ "." ^ property' *)


and print_stmts (stmts : m Statement.t list) (identation : int): string =
Expand Down Expand Up @@ -290,6 +294,6 @@ module Js = struct
let new_identation = identation + spaces_per_identation in
let body' = print_stmts body new_identation in

identation_str ^ "catch " ^ param' ^ "{\n" ^ body' ^ identation_str ^ "}"
"catch " ^ param' ^ "{\n" ^ body' ^ identation_str ^ "}"

end
91 changes: 84 additions & 7 deletions lib/ast/structures/grammar.ml
Original file line number Diff line number Diff line change
Expand Up @@ -370,7 +370,7 @@ and Statement : sig
val build : 'M -> 'M Identifier.t -> Operator.Unary.t -> 'M Expression.t -> 'M Statement.t
end

module AssignYield : sig
module Yield : sig
type 'M t = {
id : int;
left : 'M Identifier.t;
Expand All @@ -386,9 +386,10 @@ and Statement : sig
type 'M t = {
id : int;
left : 'M Identifier.t;
size : int;
}

val build : 'M -> 'M Identifier.t -> 'M Statement.t
val build : 'M -> 'M Identifier.t -> int -> 'M Statement.t
end

module AssignObject : sig
Expand Down Expand Up @@ -452,6 +453,31 @@ and Statement : sig
val build : 'M -> 'M Identifier.t ->'M Expression.t ->'M Expression.t ->'M Statement.t
end

module StaticDelete : sig
type 'M t = {
id : int;
left : 'M Identifier.t;
(* -- right -- *)
_object : 'M Expression.t;
property : string;
is_literal : bool;
}

val build : 'M -> 'M Identifier.t -> 'M Expression.t -> string -> bool -> 'M Statement.t
end

module DynamicDelete : sig
type 'M t = {
id : int;
left : 'M Identifier.t;
(* -- right -- *)
_object : 'M Expression.t;
property : 'M Expression.t;
}

val build : 'M -> 'M Identifier.t -> 'M Expression.t -> 'M Expression.t -> 'M Statement.t
end

module AssignNewCall : sig
type 'M t = {
id_call : int;
Expand Down Expand Up @@ -547,6 +573,7 @@ and Statement : sig
| Break of 'M Break.t
| Continue of 'M Continue.t
| Debugger of Debugger.t
| Yield of 'M Yield.t

(* ----- imports // exports ------ *)
| ExportDefaultDecl of 'M ExportDefaultDecl.t
Expand All @@ -557,18 +584,21 @@ and Statement : sig
| AssignSimple of 'M AssignSimple.t
| AssignBinary of 'M AssignBinary.t
| AssignUnary of 'M AssignUnary.t
| AssignYield of 'M AssignYield.t
| AssignArray of 'M AssignArray.t
| AssignObject of 'M AssignObject.t
| StaticUpdate of 'M StaticUpdate.t
| DynmicUpdate of 'M DynmicUpdate.t
| StaticLookup of 'M StaticLookup.t
| DynmicLookup of 'M DynmicLookup.t
| StaticDelete of 'M StaticDelete.t
| DynamicDelete of 'M DynamicDelete.t
| AssignNewCall of 'M AssignNewCall.t
| AssignFunCall of 'M AssignFunCall.t
| AssignMetCallStatic of 'M AssignMetCallStatic.t
| AssignMetCallDynmic of 'M AssignMetCallDynmic.t
| AssignFunction of 'M AssignFunction.t

| Expression of 'M Expression.t

type 'M t = 'M * 'M t'

Expand Down Expand Up @@ -926,18 +956,20 @@ end = struct
type 'M t = {
id : int;
left : 'M Identifier.t;
size : int;
}

let build (metadata : 'M) (left' : 'M Identifier.t) : 'M Statement.t =
let build (metadata : 'M) (left' : 'M Identifier.t) (size' : int): 'M Statement.t =
let assign_info = Statement.AssignArray {
id = get_id ();
left = left';
size = size';
}
in
(metadata, assign_info)
end

module AssignYield = struct
module Yield = struct
type 'M t = {
id : int;
left : 'M Identifier.t;
Expand All @@ -947,7 +979,7 @@ end = struct
}

let build (metadata : 'M) (left' : 'M Identifier.t) (argument' : 'M Expression.t option) (delegate': bool) : 'M Statement.t =
let yield_info = Statement.AssignYield {
let yield_info = Statement.Yield {
id = get_id ();
left = left';
argument = argument';
Expand Down Expand Up @@ -1076,6 +1108,46 @@ end = struct
(metadata, assign_info)
end

module StaticDelete = struct
type 'M t = {
id : int;
left : 'M Identifier.t;
(* -- right -- *)
_object : 'M Expression.t;
property : string;
is_literal : bool;
}

let build (metadata : 'M) (left' : 'M Identifier.t) (_object' : 'M Expression.t) (property' : string) (is_literal' : bool) : 'M Statement.t =
let assign_info = Statement.StaticDelete {
id = get_id ();
left = left';
_object = _object';
property = property';
is_literal = is_literal';
} in
(metadata, assign_info)
end

module DynamicDelete = struct
type 'M t = {
id : int;
left : 'M Identifier.t;
(* -- right -- *)
_object : 'M Expression.t;
property : 'M Expression.t;
}

let build (metadata : 'M) (left' : 'M Identifier.t) (_object' : 'M Expression.t) (property' : 'M Expression.t) : 'M Statement.t =
let assign_info = Statement.DynamicDelete {
id = get_id ();
left = left';
_object = _object';
property = property';
} in
(metadata, assign_info)
end

module AssignFunCall = struct
type 'M t = {
id_call : int;
Expand Down Expand Up @@ -1197,6 +1269,8 @@ end = struct
| Break of 'M Break.t
| Continue of 'M Continue.t
| Debugger of Debugger.t
| Yield of 'M Yield.t


(* ----- imports // exports ------ *)
| ExportDefaultDecl of 'M ExportDefaultDecl.t
Expand All @@ -1207,18 +1281,21 @@ end = struct
| AssignSimple of 'M AssignSimple.t
| AssignBinary of 'M AssignBinary.t
| AssignUnary of 'M AssignUnary.t
| AssignYield of 'M AssignYield.t
| AssignArray of 'M AssignArray.t
| AssignObject of 'M AssignObject.t
| StaticUpdate of 'M StaticUpdate.t
| DynmicUpdate of 'M DynmicUpdate.t
| StaticLookup of 'M StaticLookup.t
| DynmicLookup of 'M DynmicLookup.t
| StaticDelete of 'M StaticDelete.t
| DynamicDelete of 'M DynamicDelete.t
| AssignNewCall of 'M AssignNewCall.t
| AssignFunCall of 'M AssignFunCall.t
| AssignMetCallStatic of 'M AssignMetCallStatic.t
| AssignMetCallDynmic of 'M AssignMetCallDynmic.t
| AssignFunction of 'M AssignFunction.t

| Expression of 'M Expression.t

type 'M t = 'M * 'M t'
end
Expand Down
2 changes: 1 addition & 1 deletion lib/auxiliary/functions.ml
Original file line number Diff line number Diff line change
Expand Up @@ -25,6 +25,6 @@ let hd_opt (lst : 'a list) : 'a option =

let split3 (lst : ('a * 'b * 'c) list) : 'a list * 'b list * 'c list =
let rec aux lst (xs, ys, zs) = match lst with
| [] -> (xs, ys, zs)
| [] -> (List.rev xs, List.rev ys, List.rev zs)
| (x, y, z)::tail -> aux tail (x::xs, y::ys, z::zs)
in aux lst ([], [], [])
9 changes: 6 additions & 3 deletions lib/mdg/analyse.ml
Original file line number Diff line number Diff line change
Expand Up @@ -181,7 +181,7 @@ module GraphConstrunction (Auxiliary : AbstractAnalysis.T) = struct


(* -------- N E W O B J E C T -------- *)
| loc, AssignArray {id; left}
| loc, AssignArray {id; left; _}
| loc, AssignObject {id; left} ->
let l_i = alloc id in
store_update left (LocationSet.singleton l_i);
Expand Down Expand Up @@ -291,14 +291,17 @@ module GraphConstrunction (Auxiliary : AbstractAnalysis.T) = struct
);

add_ret_node l_retn loc;

| _, AssignYield _
| _, Yield _

(* -------- O T H E R C O N S T R U C T S -------- *)
| _, ExportDefaultDecl _
| _, ExportNamedDecl _
| _, ImportDecl _

| _, Expression _
| _, StaticDelete _
| _, DynamicDelete _
| _, VarDecl _
| _, Throw _
| _, Break _
Expand Down
Loading

0 comments on commit d66ad75

Please sign in to comment.