From 246282e29a02ec534d4f8531f91832dd93db9c6b Mon Sep 17 00:00:00 2001
From: Virgile Prevosto <virgile.prevosto@m4x.org>
Date: Thu, 13 Dec 2018 14:57:10 +0100
Subject: [PATCH] [sarif] Minimal generation of a sarif object + introducing
mdr_register.ml
---
src/plugins/markdown-report/Makefile | 2 +-
.../markdown-report/Report_markdown.mli | 11 +-
src/plugins/markdown-report/markdown.ml | 9 +-
src/plugins/markdown-report/markdown.mli | 7 +
src/plugins/markdown-report/md_gen.ml | 19 +-
src/plugins/markdown-report/md_gen.mli | 4 +-
src/plugins/markdown-report/mdr_register.ml | 11 +
src/plugins/markdown-report/mdr_register.mli | 1 +
src/plugins/markdown-report/sarif.ml | 194 ++++++++++++------
src/plugins/markdown-report/sarif_gen.ml | 37 +++-
10 files changed, 203 insertions(+), 92 deletions(-)
create mode 100644 src/plugins/markdown-report/mdr_register.ml
create mode 100644 src/plugins/markdown-report/mdr_register.mli
diff --git a/src/plugins/markdown-report/Makefile b/src/plugins/markdown-report/Makefile
index 217b85e5d94..6cab2e41d61 100644
--- a/src/plugins/markdown-report/Makefile
+++ b/src/plugins/markdown-report/Makefile
@@ -8,7 +8,7 @@ PLUGIN_NAME:=Report_markdown
PLUGIN_GENERATED:=mdr_version.ml
PLUGIN_CMO:=\
markdown sarif mdr_version mdr_params parse_remarks \
- eva_coverage sarif_gen md_gen
+ eva_coverage md_gen sarif_gen mdr_register
PLUGIN_NO_TEST:=true
PLUGIN_REQUIRES:=ppx_deriving ppx_deriving_yojson yojson
PLUGIN_VERSION:=$(Report_markdown_VERSION)
diff --git a/src/plugins/markdown-report/Report_markdown.mli b/src/plugins/markdown-report/Report_markdown.mli
index f76e4200aa3..9ba082ead85 100644
--- a/src/plugins/markdown-report/Report_markdown.mli
+++ b/src/plugins/markdown-report/Report_markdown.mli
@@ -75,6 +75,11 @@ val plain_format: ('a, Format.formatter, unit, text) format4 -> 'a
(** gives a link whose text is the URL itself. *)
val plain_link: string -> inline
+(** [codelines lang pp code] returns a [Code_block] for [code], written
+in [lang], as pretty-printed by [pp]. *)
+val codelines:
+ string -> (Format.formatter -> 'a -> unit) -> 'a -> block_element
+
val pp_inline: Format.formatter -> inline -> unit
val pp_text: Format.formatter -> text -> unit
@@ -85,9 +90,11 @@ val pp_block: Format.formatter -> block -> unit
val pp_element: Format.formatter -> element -> unit
+val pp_elements: Format.formatter -> element list -> unit
+
val pp_pandoc: Format.formatter -> pandoc_markdown -> unit
end
module Md_gen: sig
-(** generates the report. *)
-val main: unit -> unit
+(** generates the report (either final or [draft] according to the flag) *)
+val gen_report: draft:bool -> unit -> unit
end
diff --git a/src/plugins/markdown-report/markdown.ml b/src/plugins/markdown-report/markdown.ml
index b26a07fa8fa..62e24270c2e 100644
--- a/src/plugins/markdown-report/markdown.ml
+++ b/src/plugins/markdown-report/markdown.ml
@@ -49,6 +49,11 @@ let plain_format txt = Format.kasprintf plain txt
let plain_link s = Link ([Inline_code s],s)
+let codelines lang pp code =
+ let s = Format.asprintf "@[%a@]" pp code in
+ let lines = String.split_on_char '\n' s in
+ Code_block (lang, lines)
+
let rec pp_inline fmt =
function
| Plain s -> Format.pp_print_string fmt s
@@ -194,6 +199,8 @@ and pp_element fmt = function
pp_aligns fmt header sizes;
pp_table_content fmt content sizes
+let pp_elements fmt l =
+ List.iter (fun e -> pp_element fmt e ; Format.pp_print_newline fmt ()) l
let pp_authors fmt l =
List.iter (fun t -> Format.fprintf fmt "@[<h>- %a@]@\n" pp_text t) l
@@ -207,5 +214,5 @@ let pp_pandoc fmt { title; authors; date; elements } =
Format.fprintf fmt "@[<h>...@]@\n";
Format.pp_print_newline fmt ();
end;
- List.iter (fun e -> pp_element fmt e ; Format.pp_print_newline fmt ()) elements;
+ pp_elements fmt elements;
Format.fprintf fmt "@]%!"
diff --git a/src/plugins/markdown-report/markdown.mli b/src/plugins/markdown-report/markdown.mli
index dc5199989ac..08b1f67fd0e 100644
--- a/src/plugins/markdown-report/markdown.mli
+++ b/src/plugins/markdown-report/markdown.mli
@@ -50,6 +50,11 @@ val plain_format: ('a, Format.formatter, unit, text) format4 -> 'a
(** gives a link whose text is the URL itself. *)
val plain_link: string -> inline
+(** [codelines lang pp code] returns a [Code_block] for [code], written
+in [lang], as pretty-printed by [pp]. *)
+val codelines:
+ string -> (Format.formatter -> 'a -> unit) -> 'a -> block_element
+
val pp_inline: Format.formatter -> inline -> unit
val pp_text: Format.formatter -> text -> unit
@@ -60,4 +65,6 @@ val pp_block: Format.formatter -> block -> unit
val pp_element: Format.formatter -> element -> unit
+val pp_elements: Format.formatter -> element list -> unit
+
val pp_pandoc: Format.formatter -> pandoc_markdown -> unit
diff --git a/src/plugins/markdown-report/md_gen.ml b/src/plugins/markdown-report/md_gen.ml
index c2c784b2b04..9f0804e6d5d 100644
--- a/src/plugins/markdown-report/md_gen.ml
+++ b/src/plugins/markdown-report/md_gen.ml
@@ -55,11 +55,6 @@ let get_eva_domains () =
(fun (x,y) -> ([Plain "option"; Bold x], plain y))
all_eva_domains
-let codelines lang pp code =
- let s = Format.asprintf "@[%a@]" pp code in
- let lines = String.split_on_char '\n' s in
- Code_block (lang, lines)
-
let section_domains env =
let anchor = "domains" in
let head = H3 (plain "EVA Domains", Some anchor) in
@@ -594,7 +589,7 @@ let mk_remarks is_draft =
end else Datatype.String.Map.empty
end else Datatype.String.Map.empty
-let gen_report is_draft =
+let gen_report ~draft:is_draft () =
let remarks = mk_remarks is_draft in
let env = { remarks; is_draft } in
let context = gen_context env in
@@ -643,15 +638,3 @@ let gen_report is_draft =
Mdr_params.warning
"Unable to open %s for writing (%s). No report will be generated"
(Mdr_params.Output.get()) s
-
-let main () =
- match Mdr_params.Generate.get () with
- | "none" -> ()
- | "md" -> gen_report false
- | "draft" -> gen_report true
- | "sarif" -> Sarif_gen.generate ()
- | s ->
- Mdr_params.fatal "Unexpected value for option %s: %s"
- Mdr_params.Generate.option_name s
-
-let () = Db.Main.extend main
diff --git a/src/plugins/markdown-report/md_gen.mli b/src/plugins/markdown-report/md_gen.mli
index 69af5c51b0f..503901ef440 100644
--- a/src/plugins/markdown-report/md_gen.mli
+++ b/src/plugins/markdown-report/md_gen.mli
@@ -1,2 +1,2 @@
-(** generates the report. *)
-val main: unit -> unit
+(** generates the report (either final or [draft] according to the flag) *)
+val gen_report: draft:bool -> unit -> unit
diff --git a/src/plugins/markdown-report/mdr_register.ml b/src/plugins/markdown-report/mdr_register.ml
new file mode 100644
index 00000000000..77d5d70afd4
--- /dev/null
+++ b/src/plugins/markdown-report/mdr_register.ml
@@ -0,0 +1,11 @@
+let main () =
+ match Mdr_params.Generate.get () with
+ | "none" -> ()
+ | "md" -> Md_gen.gen_report ~draft:false ()
+ | "draft" -> Md_gen.gen_report ~draft:true ()
+ | "sarif" -> Sarif_gen.generate ()
+ | s ->
+ Mdr_params.fatal "Unexpected value for option %s: %s"
+ Mdr_params.Generate.option_name s
+
+let () = Db.Main.extend main
diff --git a/src/plugins/markdown-report/mdr_register.mli b/src/plugins/markdown-report/mdr_register.mli
new file mode 100644
index 00000000000..bada67ad15e
--- /dev/null
+++ b/src/plugins/markdown-report/mdr_register.mli
@@ -0,0 +1 @@
+(** Registration of the main entry point of the plug-in. Nothing is exported *)
diff --git a/src/plugins/markdown-report/sarif.ml b/src/plugins/markdown-report/sarif.ml
index cc93381f795..1773b9f94df 100644
--- a/src/plugins/markdown-report/sarif.ml
+++ b/src/plugins/markdown-report/sarif.ml
@@ -54,13 +54,24 @@ module Message = struct
arguments: (string list [@default []]);
}[@@deriving yojson]
-let default =
- { text = "";
- messageId = "";
- richText = "";
- richMessageId = "";
- arguments = [];
- }
+let create
+ ?(text="")
+ ?(messageId="")
+ ?(richText="")
+ ?(richMessageId="")
+ ?(arguments=[])
+ ()
+ =
+ { text; messageId; richText; richMessageId; arguments }
+
+let plain_text ~text ?id:messageId ?arguments () =
+ create ~text ?messageId ?arguments ()
+
+let markdown ~markdown ?id:richMessageId ?arguments () =
+ let richText = Format.asprintf "@[%a@]" Markdown.pp_elements markdown in
+ create ~richText ?richMessageId ?arguments ()
+
+let default = create ()
end
module FileLocation = struct
@@ -69,7 +80,15 @@ module FileLocation = struct
uriBaseId: (string [@default ""])
}[@@deriving yojson]
- let default = { uri = ""; uriBaseId = "" }
+ let create ~uri ?(uriBaseId = "") () = { uri; uriBaseId }
+
+ let default = create ~uri:"" ()
+
+ let of_loc loc =
+ let open Filepath in
+ (* by construction, we have an absolute path here, no need for uriBase *)
+ let uri = ((fst loc).pos_path :> string) in
+ create ~uri ()
end
module FileContent = struct
@@ -95,18 +114,34 @@ type t = {
message: (Message.t [@default Message.default])
}[@@deriving yojson]
-let default = {
- startLine = 0;
- startColumn = 0;
- endLine = 0;
- endColumn = 0;
- charOffset = 0;
- charLength = 0;
- byteOffset = 0;
- byteLength = 0;
- snippet = FileContent.default;
- message = Message.default;
-}
+let create
+ ?(startLine = 0)
+ ?(startColumn = 0)
+ ?(endLine = 0)
+ ?(endColumn = 0)
+ ?(charOffset = 0)
+ ?(charLength = 0)
+ ?(byteOffset = 0)
+ ?(byteLength = 0)
+ ?(snippet = FileContent.default)
+ ?(message = Message.default)
+ ()
+ =
+ { startLine; startColumn; endLine; endColumn; charOffset; charLength;
+ byteOffset; byteLength; snippet; message }
+
+let default = create ()
+
+let of_loc loc =
+ let open Filepath in
+ let (start, finish) = loc in
+ let startLine = start.pos_lnum in
+ let startColumn = start.pos_cnum - start.pos_bol in
+ let byteOffset = start.pos_cnum in
+ let endLine = finish.pos_lnum in
+ let endColumn = finish.pos_cnum - finish.pos_bol in
+ let byteLength = finish.pos_cnum - start.pos_cnum in
+ create ~startLine ~startColumn ~endLine ~endColumn ~byteOffset ~byteLength ()
end
module Rectangle = struct
@@ -168,12 +203,22 @@ module PhysicalLocation = struct
contextRegion: (Region.t [@default Region.default]);
}[@@deriving yojson]
- let default = {
- id = "";
- fileLocation = FileLocation.default;
- region = Region.default;
- contextRegion = Region.default;
- }
+ let create
+ ?(id = "")
+ ~fileLocation
+ ?(region = Region.default)
+ ?(contextRegion = Region.default)
+ ()
+ =
+ { id; fileLocation; region; contextRegion }
+
+ let default = create ~fileLocation:FileLocation.default ()
+
+ let of_loc loc =
+ let fileLocation = FileLocation.of_loc loc in
+ let region = Region.of_loc loc in
+ create ~fileLocation ~region ()
+
end
module Location = struct
@@ -184,13 +229,24 @@ module Location = struct
annotations: (Region.t list [@default []]);
properties: (Properties.t [@default Properties.default]);
}[@@deriving yojson]
- let default = {
- physicalLocation = PhysicalLocation.default;
- fullyQualifiedLogicalName = "";
- message = Message.default;
- annotations = [];
- properties = Properties.default;
- }
+
+ let create
+ ~physicalLocation
+ ?(fullyQualifiedLogicalName = "")
+ ?(message = Message.default)
+ ?(annotations = [])
+ ?(properties = Properties.default)
+ ()
+ =
+ { physicalLocation; fullyQualifiedLogicalName;
+ message; annotations; properties;
+ }
+
+ let default = create ~physicalLocation:PhysicalLocation.default ()
+
+ let of_loc loc =
+ let physicalLocation = PhysicalLocation.of_loc loc in
+ create ~physicalLocation ()
end
module StackFrame = struct
@@ -683,7 +739,7 @@ end
(* we can't use Result here, as this would conflict with
Ppx_deriving_yojson_runtime.Result that is opened by the
code generated by Ppx_deriving_yojson. *)
-module Sarif_result: Json_type = struct
+module Sarif_result = struct
type t = {
ruleId: (string [@default ""]);
level: (Result_level.t [@default Result_level.NotApplicable]);
@@ -692,7 +748,7 @@ module Sarif_result: Json_type = struct
locations: (Location.t list [@default []]);
instanceGuid: (string [@default ""]);
correlationGuid: (string [@default ""]);
- occurenceCount: (int [@default 1]);
+ occurrenceCount: (int [@default 1]);
partialFingerprints:
(Additional_properties.t [@default Additional_properties.default]);
fingerprints:
@@ -711,6 +767,39 @@ module Sarif_result: Json_type = struct
fixes: (Fix.t list [@default []]);
properties: (Properties.t [@default Properties.default])
}[@@deriving yojson]
+
+let create
+ ?(ruleId = "")
+ ?(level=Result_level.NotApplicable)
+ ?(message=Message.default)
+ ?(analysisTarget=FileLocation.default)
+ ?(locations=[])
+ ?(instanceGuid="")
+ ?(correlationGuid="")
+ ?(occurrenceCount=1)
+ ?(partialFingerprints=Additional_properties.default)
+ ?(fingerprints=Additional_properties.default)
+ ?(stacks=[])
+ ?(codeFlows=[])
+ ?(graphs=[])
+ ?(graphTraversals=[])
+ ?(relatedLocations=[])
+ ?(suppressionStates=[])
+ ?(baselineState=Result_baselineState.Absent)
+ ?(attachments=[])
+ ?(workItemsUris=[])
+ ?(conversionProvenance=[])
+ ?(fixes=[])
+ ?(properties=Properties.default)
+ ()
+ =
+ {
+ ruleId;level; message; analysisTarget; locations; instanceGuid;
+ correlationGuid; occurrenceCount; partialFingerprints; fingerprints;
+ stacks; codeFlows; graphs; graphTraversals; relatedLocations;
+ suppressionStates; baselineState; attachments; workItemsUris;
+ conversionProvenance; fixes; properties
+ }
end
module VersionControlDetails = struct
@@ -774,12 +863,12 @@ let create
?(graphs=[])
?(results=[])
?(resources=Resources.default)
- ?instanceGuid
- ?correlationGuid
- ?logicalId
+ ?(instanceGuid="")
+ ?(correlationGuid="")
+ ?(logicalId="")
?(description=Message.default)
- ?automationLogicalId
- ?baselineInstanceGuid
+ ?(automationLogicalId="")
+ ?(baselineInstanceGuid="")
?(architecture="")
?(richMessageMimeType="text/markdown;variant=GFM")
?(redactionToken="")
@@ -788,31 +877,6 @@ let create
?(properties=Properties.default)
()
=
- let instanceGuid =
- match instanceGuid with
- | Some guid -> guid
- | None -> failwith "use guid generation library"
- in
- let correlationGuid =
- match correlationGuid with
- | Some guid -> guid
- | None -> failwith "use guid generation library"
- in
- let logicalId =
- match logicalId with
- | Some id -> id
- | None -> failwith "use id generator"
- in
- let automationLogicalId =
- match automationLogicalId with
- | Some id -> id
- | None -> failwith "use id generator"
- in
- let baselineInstanceGuid =
- match baselineInstanceGuid with
- | Some guid -> guid
- | None -> failwith "use guid generation library"
- in
{
tool; invocations; conversion; versionControlProvenance; originalUriBaseIds;
files; logicalLocations; graphs; results; resources; instanceGuid;
diff --git a/src/plugins/markdown-report/sarif_gen.ml b/src/plugins/markdown-report/sarif_gen.ml
index b75d9d2f0fb..aca71c01d3e 100644
--- a/src/plugins/markdown-report/sarif_gen.ml
+++ b/src/plugins/markdown-report/sarif_gen.ml
@@ -11,23 +11,54 @@ let frama_c_sarif =
~name ~version ~semanticVersion
~fullName ~downloadUri ~sarifLoggerVersion ()
+
let get_remarks () =
let f = Mdr_params.Remarks.get () in
if f <> "" then Parse_remarks.get_remarks f
else Datatype.String.Map.empty
+let get_remark remarks label =
+ match Datatype.String.Map.find_opt label remarks with
+ | None -> []
+ | Some l -> l
+
let gen_invocation () =
let commandLine = Array.fold_right (fun s acc -> s ^ " " ^ acc) Sys.argv "" in
let arguments = List.tl (Array.to_list Sys.argv) in
Invocation.create ~commandLine ~arguments ()
-let gen_run () =
+let make_message alarm annot remark =
+ let open Markdown in
+ let kind = plain (Alarms.get_name alarm ^ ":") in
+ let descr = codelines "acsl" Printer.pp_code_annotation annot in
+ let summary = Block [Text kind; descr] in
+ let markdown = summary :: remark in
+ Message.markdown ~markdown ()
+
+let gen_results remarks =
+ let treat_alarm _e _kf s ~rank:_ alarm annot (i, content) =
+ let label = "Alarm-" ^ string_of_int i in
+ let level = Result_level.Warning in
+ let remark = get_remark remarks label in
+ let message = make_message alarm annot remark in
+ let locations = [ Location.of_loc (Cil_datatype.Stmt.loc s) ] in
+ let res =
+ Sarif_result.create ~level ~message ~locations ()
+ in
+ (i+1, res :: content)
+ in
+ let _, content = Alarms.fold treat_alarm (0, []) in
+ List.rev content
+
+let gen_run remarks =
let tool = frama_c_sarif in
let invocations = [gen_invocation ()] in
- Run.create ~tool ~invocations ()
+ let results = gen_results remarks in
+ Run.create ~tool ~invocations ~results ()
let generate () =
- let runs = [ gen_run () ] in
+ let remarks = get_remarks () in
+ let runs = [ gen_run remarks ] in
let json = Schema.create ~runs () in
let out = Mdr_params.Output.get () in
let chan =
--
GitLab