undefect. CWE-407 — 63 sites patched across 27 ecosystems
Authors: russell@unturf.com · brackishbert@gmail.com · foxhop.net · TimeHexOn.com Patches, unit tests, benchmarks, whitepaper, and outreach briefs. Public domain — no copyright claimed. Use freely.
This commit is contained in:
commit
0a580b313d
70422 changed files with 17213626 additions and 0 deletions
35
defects/ghc/patch/ghc-0003-checknode-uniqset.patch
Normal file
35
defects/ghc/patch/ghc-0003-checknode-uniqset.patch
Normal file
|
|
@ -0,0 +1,35 @@
|
|||
diff --git a/compiler/GHC/Data/Graph/Ops.hs b/compiler/GHC/Data/Graph/Ops.hs
|
||||
index dc90b9e..16e097a 100644
|
||||
--- a/compiler/GHC/Data/Graph/Ops.hs
|
||||
+++ b/compiler/GHC/Data/Graph/Ops.hs
|
||||
@@ -571,7 +571,7 @@ scanGraph match graph
|
||||
-- If they don't then throw an error
|
||||
--
|
||||
validateGraph
|
||||
- :: (Uniquable k, Outputable k, Eq color)
|
||||
+ :: (Uniquable k, Outputable k, Uniquable color)
|
||||
=> SDoc -- ^ extra debugging info to display on error
|
||||
-> Bool -- ^ whether this graph is supposed to be colored.
|
||||
-> Graph k cls color -- ^ graph to validate
|
||||
@@ -622,7 +622,7 @@ validateGraph doc isColored graph
|
||||
-- | If this node is colored, check that all the nodes which
|
||||
-- conflict with it have different colors.
|
||||
checkNode
|
||||
- :: (Uniquable k, Eq color)
|
||||
+ :: (Uniquable k, Uniquable color)
|
||||
=> Graph k cls color
|
||||
-> Node k cls color
|
||||
-> Bool -- ^ True if this node is ok
|
||||
@@ -633,8 +633,11 @@ checkNode graph node
|
||||
$ nonDetEltsUniqSet $ nodeConflicts node
|
||||
-- See Note [Unique Determinism and code generation]
|
||||
|
||||
+ -- CWE-407 fix: build a UniqSet of neighbour colors for O(1) lookup.
|
||||
+ -- `elem color neighbourColors` is O(deg); UniqSet is O(1) amortized.
|
||||
, neighbourColors <- mapMaybe nodeColor neighbors
|
||||
- , elem color neighbourColors
|
||||
+ , let neighbourColorSet = mkUniqSet neighbourColors
|
||||
+ , elementOfUniqSet color neighbourColorSet
|
||||
= False
|
||||
|
||||
| otherwise
|
||||
108
defects/ghc/patch/ghc-cwe407-set-membership.patch
Normal file
108
defects/ghc/patch/ghc-cwe407-set-membership.patch
Normal file
|
|
@ -0,0 +1,108 @@
|
|||
diff --git a/compiler/GHC/Data/Graph/Directed/Internal.hs b/compiler/GHC/Data/Graph/Directed/Internal.hs
|
||||
index 159e1ff..c560954 100644
|
||||
--- a/compiler/GHC/Data/Graph/Directed/Internal.hs
|
||||
+++ b/compiler/GHC/Data/Graph/Directed/Internal.hs
|
||||
@@ -7,6 +7,7 @@ import Data.Array
|
||||
import qualified Data.Graph as G
|
||||
import Data.Graph ( Vertex, SCC(..) ) -- Used in the underlying representation
|
||||
import Data.Tree
|
||||
+import qualified Data.IntSet as IntSet
|
||||
|
||||
data Graph node = Graph {
|
||||
gr_int_graph :: IntGraph,
|
||||
@@ -70,10 +71,13 @@ scc :: IntGraph -> [SCC Vertex]
|
||||
scc graph = map decode forest
|
||||
where
|
||||
forest = {-# SCC "Digraph.scc" #-} G.scc graph
|
||||
+ -- CWE-407 fix: precompute IntSet adjacency for O(1) self-loop check
|
||||
+ -- was: v `elem` (graph ! v) — O(degree) per vertex
|
||||
+ graphSets = fmap IntSet.fromList graph -- Array Vertex IntSet
|
||||
|
||||
decode (Node v []) | mentions_itself v = CyclicSCC [v]
|
||||
| otherwise = AcyclicSCC v
|
||||
decode other = CyclicSCC (dec other [])
|
||||
where dec (Node v ts) vs = v : foldr dec vs ts
|
||||
- mentions_itself v = v `elem` (graph ! v)
|
||||
+ mentions_itself v = v `IntSet.member` (graphSets ! v)
|
||||
|
||||
diff --git a/compiler/GHC/Data/Graph/Inductive/Graph.hs b/compiler/GHC/Data/Graph/Inductive/Graph.hs
|
||||
index 80d17d4..6ee3558 100644
|
||||
--- a/compiler/GHC/Data/Graph/Inductive/Graph.hs
|
||||
+++ b/compiler/GHC/Data/Graph/Inductive/Graph.hs
|
||||
@@ -176,6 +176,17 @@ class Graph gr where
|
||||
labEdges :: gr a b -> [LEdge b]
|
||||
labEdges = ufold (\(_,v,_,s)->(map (\(l,w)->(v,w,l)) s ++)) []
|
||||
|
||||
+ -- | True if there is a directed edge between two nodes.
|
||||
+ -- Default implementation is O(degree); implementations may override for O(1).
|
||||
+ -- CWE-407 fix: override in PatriciaTree with IM.member for O(log degree).
|
||||
+ hasEdge :: gr a b -> Edge -> Bool
|
||||
+ hasEdge gr (v,w) = w `elem` suc gr v
|
||||
+
|
||||
+ -- | True if there is an undirected edge between two nodes.
|
||||
+ -- Default implementation is O(degree); implementations may override for O(1).
|
||||
+ hasNeighbor :: gr a b -> Node -> Node -> Bool
|
||||
+ hasNeighbor gr v w = w `elem` neighbors gr v
|
||||
+
|
||||
class (Graph gr) => DynGraph gr where
|
||||
-- | Merge the 'Context' into the 'DynGraph'.
|
||||
--
|
||||
@@ -484,14 +495,6 @@ indeg' = length . context1l'
|
||||
deg' :: Context a b -> Int
|
||||
deg' (p,_,_,s) = length p+length s
|
||||
|
||||
--- | Checks if there is a directed edge between two nodes.
|
||||
-hasEdge :: Graph gr => gr a b -> Edge -> Bool
|
||||
-hasEdge gr (v,w) = w `elem` suc gr v
|
||||
-
|
||||
--- | Checks if there is an undirected edge between two nodes.
|
||||
-hasNeighbor :: Graph gr => gr a b -> Node -> Node -> Bool
|
||||
-hasNeighbor gr v w = w `elem` neighbors gr v
|
||||
-
|
||||
-- | Checks if there is a labelled edge between two nodes.
|
||||
hasLEdge :: (Graph gr, Eq b) => gr a b -> LEdge b -> Bool
|
||||
hasLEdge gr (v,w,l) = (w,l) `elem` lsuc gr v
|
||||
diff --git a/compiler/GHC/Data/Graph/Inductive/PatriciaTree.hs b/compiler/GHC/Data/Graph/Inductive/PatriciaTree.hs
|
||||
index 09ec8af..54bb2bc 100644
|
||||
--- a/compiler/GHC/Data/Graph/Inductive/PatriciaTree.hs
|
||||
+++ b/compiler/GHC/Data/Graph/Inductive/PatriciaTree.hs
|
||||
@@ -104,6 +104,17 @@ instance Graph Gr where
|
||||
label <- labels
|
||||
return (node, next, label)
|
||||
|
||||
+ -- CWE-407 fix: O(log degree) IntMap lookup vs O(degree) elem on list
|
||||
+ hasEdge (Gr g) (v,w) =
|
||||
+ case IM.lookup v g of
|
||||
+ Nothing -> False
|
||||
+ Just (_, _, s) -> IM.member w s
|
||||
+
|
||||
+ hasNeighbor (Gr g) v w =
|
||||
+ case IM.lookup v g of
|
||||
+ Nothing -> False
|
||||
+ Just (p, _, s) -> IM.member w p || IM.member w s
|
||||
+
|
||||
instance DynGraph Gr where
|
||||
(p, v, l, s) & (Gr g)
|
||||
= let !g1 = IM.insert v (preds, l, succs) g
|
||||
diff --git a/compiler/GHC/Tc/TyCl/Utils.hs b/compiler/GHC/Tc/TyCl/Utils.hs
|
||||
index da19c17..c779e88 100644
|
||||
--- a/compiler/GHC/Tc/TyCl/Utils.hs
|
||||
+++ b/compiler/GHC/Tc/TyCl/Utils.hs
|
||||
@@ -884,6 +884,7 @@ mkOneRecordSelector all_cons idDetails fl has_sel
|
||||
-- Find a representative constructor, con1
|
||||
rec_sel_info@(RSI { rsi_def = cons_w_field })
|
||||
= conLikesRecSelInfo all_cons [lbl]
|
||||
+ cons_w_field_set = mkUniqSet cons_w_field -- CWE-407 fix: O(1) lookup in dealt_with
|
||||
con1 = assert (not (null cons_w_field)) $ head cons_w_field
|
||||
|
||||
-- Construct the IdDetails
|
||||
@@ -970,7 +971,8 @@ mkOneRecordSelector all_cons idDetails fl has_sel
|
||||
dealt_with :: ConLike -> Bool
|
||||
dealt_with (PatSynCon _) = False -- We can't predict overlap
|
||||
dealt_with con@(RealDataCon dc)
|
||||
- = con `elem` cons_w_field || dataConCannotMatch inst_tys dc
|
||||
+ = con `elementOfUniqSet` cons_w_field_set -- CWE-407 fix: O(1) vs O(n) elem
|
||||
+ || dataConCannotMatch inst_tys dc
|
||||
where
|
||||
inst_tys = dataConResRepTyArgs dc
|
||||
|
||||
Loading…
Add table
Add a link
Reference in a new issue