From dd888597c903c99c003d37a540020879bfd043db Mon Sep 17 00:00:00 2001
From: Virgile Prevosto <virgile.prevosto@m4x.org>
Date: Wed, 22 Jul 2020 19:14:13 +0200
Subject: [PATCH] [sarif] on the road to sarif 2.1.0 migration
---
src/plugins/markdown-report/sarif.ml | 435 +++++++++++++++--------
src/plugins/markdown-report/sarif_gen.ml | 28 +-
2 files changed, 297 insertions(+), 166 deletions(-)
diff --git a/src/plugins/markdown-report/sarif.ml b/src/plugins/markdown-report/sarif.ml
index b41a31c18ac..0a778905e0f 100644
--- a/src/plugins/markdown-report/sarif.ml
+++ b/src/plugins/markdown-report/sarif.ml
@@ -32,6 +32,15 @@ module type Json_type = sig
val to_yojson: t -> Yojson.Safe.t
end
+module Json_string: Json_type with type t = string =
+struct
+ type t = string
+ let of_yojson = function
+ | `String s -> Ok s
+ | _ -> Error "string"
+ let to_yojson s = `String s
+end
+
module Json_dictionary(J: Json_type):
Json_type with type t = (string * J.t) list =
struct
@@ -55,6 +64,8 @@ struct
`Assoc json_l
end
+module JsonStringDictionary = Json_dictionary(Json_string)
+
module Uri: sig
include Json_type with type t = private string
val sarif_github:t
@@ -124,13 +135,80 @@ module ArtifactLocation = struct
create ~uri ()
end
-module FileContent = struct
+module ArtifactLocationDictionary = Json_dictionary(ArtifactLocation)
+
+module Custom_properties =
+ Json_dictionary(struct
+ type t = Yojson.Safe.t
+ let of_yojson x = Ok x
+ let to_yojson x = x
+ end)
+
+module Properties = struct
+ type tags = string list [@@deriving yojson]
+
+ type t = {
+ tags: tags;
+ additional_properties: Custom_properties.t
+ }
+
+ let default = { tags = []; additional_properties = [] }
+
+ let create additional_properties =
+ let tags = List.map fst additional_properties in
+ { tags; additional_properties }
+
+ let of_yojson = function
+ | `Null -> Ok default
+ | `Assoc l ->
+ (match List.assoc_opt "tags" l with
+ | None -> Error "properties"
+ | Some json ->
+ (match tags_of_yojson json with
+ | Ok tags ->
+ let additional_properties = List.remove_assoc "tags" l in
+ Ok { tags; additional_properties }
+ | Error loc -> Error ("properties." ^ loc)))
+ | _ -> Error "properties"
+
+ let to_yojson { tags; additional_properties } =
+ match tags with
+ | [] -> `Null
+ | _ -> `Assoc (("tags", tags_to_yojson tags)::additional_properties)
+end
+
+module MultiformatMessageString = struct
+ type t = {
+ text: string;
+ markdown: (string [@default ""]);
+ properties: (Properties.t [@default Properties.default])
+ }[@@deriving yojson]
+
+ let create ~text ?(markdown="") ?(properties=Properties.default) () =
+ { text; markdown; properties }
+
+ let default = create ~text:"default" ()
+end
+
+module MultiformatMessageStringDictionary =
+ Json_dictionary(MultiformatMessageString)
+
+module ArtifactContent = struct
type t =
- | Text of string [@name "text"]
- | Binary of string [@name "binary"]
+ { text: (string [@default ""]);
+ binary: (string [@default ""]);
+ rendered:
+ (MultiformatMessageString.t [@default MultiformatMessageString.default]);
+ properties: (Properties.t [@default Properties.default])
+ }
[@@deriving yojson]
- let default = Text ""
+ let create ?(text="") ?(binary="")
+ ?(rendered=MultiformatMessageString.default)
+ ?(properties=Properties.default) () =
+ { text; binary; rendered; properties }
+
+ let default = create ()
end
module Region = struct
@@ -143,7 +221,7 @@ module Region = struct
charLength: (int [@default 0]);
byteOffset: (int [@default 0]);
byteLength: (int [@default 0]);
- snippet: (FileContent.t [@default FileContent.default]);
+ snippet: (ArtifactContent.t [@default ArtifactContent.default]);
message: (Message.t [@default Message.default])
}[@@deriving yojson]
@@ -156,7 +234,7 @@ module Region = struct
?(charLength = 0)
?(byteOffset = 0)
?(byteLength = 0)
- ?(snippet = FileContent.default)
+ ?(snippet = ArtifactContent.default)
?(message = Message.default)
()
=
@@ -187,46 +265,6 @@ module Rectangle = struct
[@@deriving yojson]
end
-module Custom_properties =
- Json_dictionary(struct
- type t = Yojson.Safe.t
- let of_yojson x = Ok x
- let to_yojson x = x
- end)
-
-module Properties = struct
- type tags = string list [@@deriving yojson]
-
- type t = {
- tags: tags;
- additional_properties: Custom_properties.t
- }
-
- let default = { tags = []; additional_properties = [] }
-
- let create additional_properties =
- let tags = List.map fst additional_properties in
- { tags; additional_properties }
-
- let of_yojson = function
- | `Null -> Ok default
- | `Assoc l ->
- (match List.assoc_opt "tags" l with
- | None -> Error "properties"
- | Some json ->
- (match tags_of_yojson json with
- | Ok tags ->
- let additional_properties = List.remove_assoc "tags" l in
- Ok { tags; additional_properties }
- | Error loc -> Error ("properties." ^ loc)))
- | _ -> Error "properties"
-
- let to_yojson { tags; additional_properties } =
- match tags with
- | [] -> `Null
- | _ -> `Assoc (("tags", tags_to_yojson tags)::additional_properties)
-end
-
module PhysicalLocation = struct
type t = {
id: (string [@default ""]);
@@ -659,42 +697,47 @@ end
module Replacement = struct
type t = {
deletedRegion: Region.t;
- insertedContent: (FileContent.t [@default FileContent.default])
+ insertedContent: (ArtifactContent.t [@default ArtifactContent.default])
}[@@deriving yojson]
end
-module File = struct
+module Artifact = struct
type t = {
- artifactLocation: (ArtifactLocation.t [@default ArtifactLocation.default]);
- parentKey: (string [@default ""]);
+ description: (Message.t [@default Message.default]);
+ location: (ArtifactLocation.t [@default ArtifactLocation.default]);
+ parentIndex: (int [@default -1]);
offset: (int [@default 0]);
- length: (int [@default 0]);
+ length: (int [@default -1]);
roles: (Role.t list [@default []]);
mimeType: (string [@default ""]);
- contents: (FileContent.t [@default FileContent.default]);
+ contents: (ArtifactContent.t [@default ArtifactContent.default]);
encoding: (string [@default ""]);
- hashes: (Hash.t list [@default []]);
- lastModifiedTime: (string [@default ""]);
+ sourceLanguage: (string [@default ""]);
+ hashes: (JsonStringDictionary.t [@default []]);
+ lastModifiedTimeUtc: (string [@default ""]);
properties: (Properties.t [@default Properties.default]);
}[@@deriving yojson]
let create
- ?(artifactLocation = ArtifactLocation.default)
- ?(parentKey = "")
+ ?(description = Message.default)
+ ?(location = ArtifactLocation.default)
+ ?(parentIndex = -1)
?(offset = 0)
- ?(length = 0)
+ ?(length = -1)
?(roles = [])
?(mimeType = "")
- ?(contents = FileContent.default)
+ ?(contents = ArtifactContent.default)
?(encoding = "")
+ ?(sourceLanguage = "")
?(hashes = [])
- ?(lastModifiedTime = "")
+ ?(lastModifiedTimeUtc = "")
?(properties = Properties.default)
()
=
{
- artifactLocation; parentKey; offset; length; roles; mimeType; contents;
- encoding; hashes; lastModifiedTime; properties
+ description; location; parentIndex; offset; length; roles; mimeType;
+ contents; encoding; sourceLanguage; hashes; lastModifiedTimeUtc;
+ properties
}
end
@@ -737,97 +780,139 @@ end
module RuleConfigLevel:
sig
include Json_type with type t = private string
+ val cl_none: t
val cl_note: t
val cl_warning: t
val cl_error: t
- val cl_open: t
end
=
struct
type t = string [@@deriving yojson]
+ let cl_none = "none"
let cl_note = "note"
let cl_warning = "warning"
let cl_error = "error"
- let cl_open = "open"
end
-module RuleConfiguration = struct
+module ReportingConfiguration = struct
type t = {
enabled: (bool [@default false]);
- defaultLevel: (RuleConfigLevel.t [@default RuleConfigLevel.cl_open]);
- parameters: (Properties.t [@default Properties.default])
+ defaultLevel: (RuleConfigLevel.t [@default RuleConfigLevel.cl_none]);
+ rank: (int [@default -1]);
+ parameters: (Properties.t [@default Properties.default]);
+ properties: (Properties.t [@default Properties.default]);
}[@@deriving yojson]
let default = {
enabled = false;
- defaultLevel = RuleConfigLevel.cl_open;
+ defaultLevel = RuleConfigLevel.cl_none;
+ rank = -1;
parameters = Properties.default;
+ properties = Properties.default;
}
end
-module Rule = struct
+module ToolComponentReference =struct
+type t = {
+ name: (string [@default ""]);
+ index: (int [@default -1]);
+ guid: (string [@default ""]);
+ properties: (Properties.t [@default Properties.default]);
+}[@@deriving yojson]
+
+let create
+ ?(name="") ?(index = -1) ?(guid = "") ?(properties=Properties.default) () =
+ { name; index; guid; properties }
+
+let default = create ()
+
+end
+
+module ReportingDescriptorReference =
+struct
type t = {
id: (string [@default ""]);
- name: (string [@default ""]);
- shortDescription: (Message.t [@default Message.default]);
- fullDescription: (Message.t [@default Message.default]);
- messageStrings:
- (Additional_properties.t [@default Additional_properties.default]);
- richMessageStrings:
- (Additional_properties.t [@default Additional_properties.default]);
- configuration: (RuleConfiguration.t [@default RuleConfiguration.default]);
- helpUri: (string [@default ""]);
+ index: (int [@default -1]);
+ guid: (string [@default ""]);
+ toolComponent:
+ (ToolComponentReference.t [@default ToolComponentReference.default]);
properties: (Properties.t [@default Properties.default]);
}[@@deriving yojson]
- let default = {
- id = "";
- name = "";
- shortDescription = Message.default;
- fullDescription = Message.default;
- messageStrings = Additional_properties.default;
- richMessageStrings = Additional_properties.default;
- configuration = RuleConfiguration.default;
- helpUri = "";
- properties = Properties.default;
- }
-
let create
- ~id
- ?(name="")
- ?(shortDescription=Message.default)
- ?(fullDescription=Message.default)
- ?(messageStrings=Additional_properties.default)
- ?(richMessageStrings=Additional_properties.default)
- ?(configuration=RuleConfiguration.default)
- ?(helpUri="")
- ?(properties=Properties.default)
- ()
- =
- { id; name; shortDescription; fullDescription; messageStrings;
- richMessageStrings; configuration; helpUri; properties }
+ ?(id="") ?(index = -1) ?(guid="")
+ ?(toolComponent=ToolComponentReference.default)
+ ?(properties=Properties.default) () =
+ { id; index; guid; toolComponent; properties }
+ let default = create ()
end
-module Rule_dictionary = Json_dictionary(Rule)
+module ReportingDescriptorRelationship = struct
+ type t = {
+ target: ReportingDescriptorReference.t;
+ kinds: (string list [@default ["relevant"]]);
+ description: (Message.t [@default Message.default]);
+ properties: (Properties.t [@default Properties.default]);
+ }[@@deriving yojson]
+
+ let create
+ ~target
+ ?(kinds=["relevant"])
+ ?(description=Message.default)
+ ?(properties=Properties.default) () =
+ { target; kinds; description; properties }
-module Resources = struct
+ let default = create ~target:ReportingDescriptorReference.default ()
+end
+
+module ReportingDescriptor = struct
type t = {
+ id: string;
+ deprecatedIds: (string list [@default []]);
+ guid: (string [@default ""]);
+ deprecatedGuids: (string list [@default []]);
+ name: (string [@default ""]);
+ deprecatedNames: (string list [@default []]);
+ shortDescription:
+ (MultiformatMessageString.t [@default MultiformatMessageString.default]);
+ fullDescription:
+ (MultiformatMessageString.t [@default MultiformatMessageString.default]);
messageStrings:
- (Additional_properties.t [@default Additional_properties.default]);
- rules: (Rule_dictionary.t [@default []]);
+ (MultiformatMessageStringDictionary.t [@default []]);
+ defaultConfiguration:
+ (ReportingConfiguration.t [@default ReportingConfiguration.default]);
+ helpUri: (string [@default ""]);
+ help:
+ (MultiformatMessageString.t [@default MultiformatMessageString.default]);
+ relationships:
+ (ReportingDescriptorRelationship.t list [@default []]);
+ properties: (Properties.t [@default Properties.default]);
}[@@deriving yojson]
- let default = {
- messageStrings = Additional_properties.default;
- rules = [] }
-
let create
- ?(messageStrings=Additional_properties.default)
- ?(rules=[])
+ ~id
+ ?(deprecatedIds=[])
+ ?(guid="")
+ ?(deprecatedGuids=[])
+ ?(name="")
+ ?(deprecatedNames=[])
+ ?(shortDescription=MultiformatMessageString.default)
+ ?(fullDescription=MultiformatMessageString.default)
+ ?(messageStrings=[])
+ ?(defaultConfiguration=ReportingConfiguration.default)
+ ?(helpUri="")
+ ?(help=MultiformatMessageString.default)
+ ?(relationships=[])
+ ?(properties=Properties.default)
()
=
- { messageStrings; rules }
+ { id; deprecatedIds; guid; deprecatedGuids; name; deprecatedNames;
+ shortDescription; fullDescription; messageStrings;
+ defaultConfiguration; helpUri; help; relationships; properties }
+
+ let default = create ~id:"id" ()
+
end
module Result_kind:
@@ -979,10 +1064,6 @@ module VersionControlDetails = struct
}[@@deriving yojson]
end
-module File_dictionary = Json_dictionary(File)
-
-module LogicalLocation_dictionary = Json_dictionary(LogicalLocation)
-
module ColumnKind: sig
include Json_type with type t = private string
val utf16CodeUnits: t
@@ -995,65 +1076,117 @@ struct
let unicodeCodePoints = "unicodeCodePoints"
end
+module RunAutomationDetails = struct
+ type t = unit [@@deriving yojson]
+ let default = ()
+end
+
+module ExternalPropertyFileReferences = struct
+ type t = unit [@@deriving yojson]
+ let default = ()
+end
+
+module ToolComponent = struct
+ type t = unit [@@deriving yojson]
+ let create () = ()
+ let default = ()
+end
+
+module Address = struct
+ type t = unit [@@deriving yojson]
+ let default = []
+end
+
+module WebRequest = struct
+ type t = unit [@@deriving yojson]
+end
+
+module WebResponse = struct
+ type t = unit [@@deriving yojson]
+end
+
+module SpecialLocations = struct
+ type t = unit [@@deriving yojson]
+ let default = ()
+end
+
module Run = struct
type t = {
tool: Tool.t;
invocations: (Invocation.t list [@default []]);
conversion: (Conversion.t [@default Conversion.default]);
+ language: (string [@default "en-US"]);
versionControlProvenance: (VersionControlDetails.t list [@default []]);
originalUriBaseIds:
- (Additional_properties.t [@default Additional_properties.default]);
- files: (File_dictionary.t [@default []]);
- logicalLocations: (LogicalLocation_dictionary.t [@default []]);
- graphs: (Graph_dictionary.t [@default []]);
+ (ArtifactLocationDictionary.t [@default []]);
+ artifacts: (Artifact.t list [@default []]);
+ logicalLocations: (LogicalLocation.t list [@default []]);
+ graphs: (Graph.t list [@default []]);
results: (Sarif_result.t list [@default []]);
- resources: (Resources.t [@default Resources.default]);
- instanceGuid: (string [@default ""]);
- correlationGuid: (string [@default ""]);
- logicalId: (string [@default ""]);
- description: (Message.t [@default Message.default]);
- automationLogicalId: (string [@default ""]);
- baselineInstanceGuid: (string [@default ""]);
- architecture: (string [@default ""]);
- richMessageMimeType: (string [@default "text/markdown;variant=GFM" ]);
- redactionToken: (string [@default ""]);
- defaultFileEncoding: (string [@default "utf-8"]);
+ automationDetails:
+ (RunAutomationDetails.t [@default RunAutomationDetails.default]);
+ runAggregates: (RunAutomationDetails.t list [@default []]);
+ baselineGuid: (string [@default ""]);
+ redactionToken: (string list [@default []]);
+ defaultEncoding: (string [@default "utf-8"]);
+ defaultSourceLanguage: (string [@default ""]);
+ newlineSequences: (string list [@default ["\r\n"; "\n"]]);
columnKind: (ColumnKind.t [@default ColumnKind.unicodeCodePoints]);
+ externalPropertyFileReferences:
+ (ExternalPropertyFileReferences.t
+ [@default ExternalPropertyFileReferences.default]);
+ threadFlowLocations: (ThreadFlowLocation.t list [@default []]);
+ taxonomies: (ToolComponent.t list [@default []]);
+ addresses: (Address.t list [@default []]);
+ translations: (ToolComponent.t list [@default []]);
+ policies: (ToolComponent.t list [@default[]]);
+ webRequests: (WebRequest.t list [@default[]]);
+ webResponses: (WebResponse.t list [@default[]]);
+ specialLocations: (SpecialLocations.t [@default SpecialLocations.default]);
properties: (Properties.t [@default Properties.default]);
}
[@@deriving yojson]
let create
~tool
- ~invocations
+ ?(invocations=[])
?(conversion=Conversion.default)
+ ?(language="en-US")
?(versionControlProvenance=[])
- ?(originalUriBaseIds=Additional_properties.default)
- ?(files=[])
+ ?(originalUriBaseIds=[])
+ ?(artifacts=[])
?(logicalLocations=[])
?(graphs=[])
?(results=[])
- ?(resources=Resources.default)
- ?(instanceGuid="")
- ?(correlationGuid="")
- ?(logicalId="")
- ?(description=Message.default)
- ?(automationLogicalId="")
- ?(baselineInstanceGuid="")
- ?(architecture="")
- ?(richMessageMimeType="text/markdown;variant=GFM")
- ?(redactionToken="")
- ?(defaultFileEncoding="utf-8")
+ ?(automationDetails=RunAutomationDetails.default)
+ ?(runAggregates=[])
+ ?(baselineGuid="")
+ ?(redactionToken=[])
+ ?(defaultEncoding="utf-8")
+ ?(defaultSourceLanguage="C")
+ ?(newlineSequences=["\r\n"; "\n"])
?(columnKind=ColumnKind.unicodeCodePoints)
+ ?(externalPropertyFileReferences=ExternalPropertyFileReferences.default)
+ ?(threadFlowLocations=[])
+ ?(taxonomies=[])
+ ?(addresses=[])
+ ?(translations=[])
+ ?(policies=[])
+ ?(webRequests=[])
+ ?(webResponses=[])
+ ?(specialLocations=SpecialLocations.default)
?(properties=Properties.default)
()
=
{
- tool; invocations; conversion; versionControlProvenance; originalUriBaseIds;
- files; logicalLocations; graphs; results; resources; instanceGuid;
- correlationGuid; logicalId; description; automationLogicalId;
- baselineInstanceGuid; architecture; richMessageMimeType;
- redactionToken; defaultFileEncoding; columnKind; properties
+ tool; invocations; conversion; versionControlProvenance;
+ language; originalUriBaseIds;
+ artifacts; logicalLocations; graphs; results;
+ automationDetails; runAggregates; baselineGuid; redactionToken;
+ defaultEncoding; defaultSourceLanguage; newlineSequences; columnKind;
+ externalPropertyFileReferences; threadFlowLocations; taxonomies;
+ addresses; translations; policies; webRequests; webResponses;
+ specialLocations; properties;
}
end
diff --git a/src/plugins/markdown-report/sarif_gen.ml b/src/plugins/markdown-report/sarif_gen.ml
index 7204ae3f339..7c47c507a1a 100644
--- a/src/plugins/markdown-report/sarif_gen.ml
+++ b/src/plugins/markdown-report/sarif_gen.ml
@@ -156,26 +156,23 @@ let gen_statuses () =
in
List.rev (Property_status.fold f [])
-let gen_files () =
+let gen_artifacts () =
let add_src_file f =
- let key =
- let fname = Filepath.Normalized.to_pretty_string f in
- Filename.chop_extension (Filename.basename fname)
- in
- let artifactLocation = ArtifactLocation.create ~uri:(f :> string) () in
+ let uri = (f:Filepath.Normalized.t :> string) in
+ let location = ArtifactLocation.create ~uri () in
let roles = [ Role.analysisTarget ] in
let mimeType = "text/x-csrc" in
- key, File.create ~artifactLocation ~roles ~mimeType ()
+ Artifact.create ~location ~roles ~mimeType ()
in
List.map add_src_file (Kernel.Files.get ())
let add_rule id desc l =
let text = desc ^ "." in
- let shortDescription = Message.plain_text ~text () in
- let rule = Rule.create ~id ~shortDescription () in
- (id, rule) :: l
+ let shortDescription = MultiformatMessageString.create ~text () in
+ let rule = ReportingDescriptor.create ~id ~shortDescription () in
+ rule :: l
-let make_rule_dictionary rules = Datatype.String.Map.fold add_rule rules []
+let make_taxonomies rules = Datatype.String.Map.fold add_rule rules []
let gen_run remarks =
let tool = frama_c_sarif in
@@ -189,11 +186,12 @@ let gen_run remarks =
Datatype.String.Map.add
"user-spec" "User-written ACSL specification" rules
in
- let rules = make_rule_dictionary rules in
- let resources = Resources.create ~rules () in
+ let rules = make_taxonomies rules in
+ ignore(rules);
+ let taxonomies = [ToolComponent.create (* ~rules*) ()] in
let results = results @ user_annot_results in
- let files = gen_files () in
- Run.create ~tool ~invocations ~results ~resources ~files ()
+ let artifacts = gen_artifacts () in
+ Run.create ~tool ~invocations ~results ~taxonomies ~artifacts ()
let generate () =
let remarks = get_remarks () in
--
GitLab