{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TupleSections         #-}
module Tokstyle.Analysis.SecurityRank
    ( SecurityRankContext(..)
    , SecurityRankState(..)
    , SecurityRankSummary
    , SecurityRankSummaryData(..)
    , runInterproceduralAnalysis
    , analyzeFunction
    , findFunctionDecls
    , findFunctionDefs
    , findStructDefs
    , getFuncNameFromDef
    , buildSecurityRankSummaryFromAnnotation
    , buildPointsToSummaryFromAnnotation
    ) where

import           Control.Monad                              (foldM, forM_, when)
import           Control.Monad.State.Strict                 (State, StateT,
                                                             execState,
                                                             execStateT, get,
                                                             lift, modify, put,
                                                             runState,
                                                             runStateT)
import           Data.Fix                                   (Fix (..))
import           Data.Foldable                              (asum)
import           Data.List                                  (find, findIndex,
                                                             foldl', nub)
import           Data.Map.Strict                            (Map)
import qualified Data.Map.Strict                            as Map
import           Data.Maybe                                 (fromMaybe,
                                                             mapMaybe)
import           Data.Set                                   (Set)
import qualified Data.Set                                   as Set
import           Data.Text                                  (Text)
import qualified Data.Text                                  as T
import           Debug.Trace                                (trace, traceM)
import qualified Language.Cimple                            as C
import           Language.Cimple.TraverseAst                (AstActions (..),
                                                             astActions,
                                                             traverseAst)
import           Text.Groom                                 (groom)
import           Text.Read                                  (readMaybe)
import           Tokstyle.Analysis.Context                  (kLimit,
                                                             pushContext)
import           Tokstyle.Analysis.DataFlow
import qualified Tokstyle.Analysis.PointsTo                 as PointsTo
import           Tokstyle.Analysis.SecurityRank.Annotations (AnnotationMap)
import           Tokstyle.Analysis.SecurityRank.Lattice
import           Tokstyle.Analysis.SecurityRank.Types       (SecurityRankSummary,
                                                             SecurityRankSummaryData (..),
                                                             emptySecurityRankSummaryData)
import           Tokstyle.Analysis.Types                    (AbstractLocation (..),
                                                             CallGraph, Context,
                                                             FunctionName,
                                                             NodeId,
                                                             PointsToMap,
                                                             PointsToSummaryData (..),
                                                             getCallers,
                                                             toAbstractLocation)
import           Tokstyle.Worklist

fakeTestSource :: FilePath
fakeTestSource :: FilePath
fakeTestSource = FilePath
"test.c"

debugging :: Bool
debugging :: Bool
debugging = Bool
False

dtrace :: String -> a -> a
dtrace :: FilePath -> a -> a
dtrace FilePath
msg a
x = if Bool
debugging then FilePath -> a -> a
forall a. FilePath -> a -> a
trace FilePath
msg a
x else a
x

dtraceM :: Monad m => String -> m ()
dtraceM :: FilePath -> m ()
dtraceM FilePath
msg = if Bool
debugging then FilePath -> m ()
forall (f :: * -> *). Applicative f => FilePath -> f ()
traceM FilePath
msg else () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

getFuncNameFromLoc :: AbstractLocation -> Maybe FunctionName
getFuncNameFromLoc :: AbstractLocation -> Maybe FunctionName
getFuncNameFromLoc (VarLocation FunctionName
name)      = FunctionName -> Maybe FunctionName
forall a. a -> Maybe a
Just FunctionName
name
getFuncNameFromLoc (FunctionLocation FunctionName
name) = FunctionName -> Maybe FunctionName
forall a. a -> Maybe a
Just FunctionName
name
getFuncNameFromLoc AbstractLocation
_                       = Maybe FunctionName
forall a. Maybe a
Nothing

-- | The context for the security rank analysis.
data SecurityRankContext l = SecurityRankContext
    { SecurityRankContext l -> FilePath
srcCurrentFile      :: FilePath
    , SecurityRankContext l -> AnnotationMap
srcAnnotations      :: AnnotationMap
    , SecurityRankContext l -> Map FunctionName SecurityRankSummary
srcSummaries        :: Map FunctionName SecurityRankSummary
    , SecurityRankContext l
-> Map FunctionName (FilePath, Node (Lexeme l))
srcFuncDecls        :: Map FunctionName (FilePath, C.Node (C.Lexeme l))
    , SecurityRankContext l
-> Map FunctionName (FilePath, Node (Lexeme l))
srcFuncDefs         :: Map FunctionName (FilePath, C.Node (C.Lexeme l))
    , SecurityRankContext l -> Map FunctionName (Node (Lexeme l))
srcStructDefs       :: Map Text (C.Node (C.Lexeme l))
    , SecurityRankContext l -> CallGraph
srcCallGraph        :: CallGraph
    , SecurityRankContext l -> PointsToContext l
srcPointsToContext  :: PointsTo.PointsToContext l
    , SecurityRankContext l -> Context
srcCurrentContext   :: Context
    , SecurityRankContext l
-> Map (FunctionName, Context) (Set (FunctionName, Context))
srcDynamicCallGraph :: Map (FunctionName, Context) (Set (FunctionName, Context))
    , SecurityRankContext l
-> Map (FunctionName, Context) (CFG l SecurityRankState)
srcAnalyzedCfgs     :: Map (FunctionName, Context) (CFG l SecurityRankState)
    }

-- | The state that flows through the intra-procedural analysis.
data SecurityRankState = SecurityRankState
    { SecurityRankState -> TaintState
srsTaintState  :: TaintState
    , SecurityRankState -> Map AbstractLocation SecurityRankSummaryData
srsFptrSigs    :: Map AbstractLocation SecurityRankSummaryData
    , SecurityRankState -> [FilePath]
srsDiagnostics :: [Diagnostic]
    } deriving (SecurityRankState -> SecurityRankState -> Bool
(SecurityRankState -> SecurityRankState -> Bool)
-> (SecurityRankState -> SecurityRankState -> Bool)
-> Eq SecurityRankState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SecurityRankState -> SecurityRankState -> Bool
$c/= :: SecurityRankState -> SecurityRankState -> Bool
== :: SecurityRankState -> SecurityRankState -> Bool
$c== :: SecurityRankState -> SecurityRankState -> Bool
Eq, Int -> SecurityRankState -> ShowS
[SecurityRankState] -> ShowS
SecurityRankState -> FilePath
(Int -> SecurityRankState -> ShowS)
-> (SecurityRankState -> FilePath)
-> ([SecurityRankState] -> ShowS)
-> Show SecurityRankState
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [SecurityRankState] -> ShowS
$cshowList :: [SecurityRankState] -> ShowS
show :: SecurityRankState -> FilePath
$cshow :: SecurityRankState -> FilePath
showsPrec :: Int -> SecurityRankState -> ShowS
$cshowsPrec :: Int -> SecurityRankState -> ShowS
Show)

instance DataFlow SecurityRankContext Text SecurityRankState where
    emptyFacts :: SecurityRankContext FunctionName -> SecurityRankState
emptyFacts SecurityRankContext FunctionName
_ = TaintState
-> Map AbstractLocation SecurityRankSummaryData
-> [FilePath]
-> SecurityRankState
SecurityRankState TaintState
forall k a. Map k a
Map.empty Map AbstractLocation SecurityRankSummaryData
forall k a. Map k a
Map.empty []
    join :: SecurityRankContext FunctionName
-> SecurityRankState -> SecurityRankState -> SecurityRankState
join SecurityRankContext FunctionName
_ s1 :: SecurityRankState
s1@(SecurityRankState TaintState
a Map AbstractLocation SecurityRankSummaryData
f1 [FilePath]
d1) s2 :: SecurityRankState
s2@(SecurityRankState TaintState
b Map AbstractLocation SecurityRankSummaryData
f2 [FilePath]
d2) =
        let result :: SecurityRankState
result = TaintState
-> Map AbstractLocation SecurityRankSummaryData
-> [FilePath]
-> SecurityRankState
SecurityRankState ((SecurityRank -> SecurityRank -> SecurityRank)
-> TaintState -> TaintState -> TaintState
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith SecurityRank -> SecurityRank -> SecurityRank
mergeRank TaintState
a TaintState
b) ((SecurityRankSummaryData
 -> SecurityRankSummaryData -> SecurityRankSummaryData)
-> Map AbstractLocation SecurityRankSummaryData
-> Map AbstractLocation SecurityRankSummaryData
-> Map AbstractLocation SecurityRankSummaryData
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith SecurityRankSummaryData
-> SecurityRankSummaryData -> SecurityRankSummaryData
joinSummaries Map AbstractLocation SecurityRankSummaryData
f1 Map AbstractLocation SecurityRankSummaryData
f2) ([FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub ([FilePath]
d1 [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
d2))
        in FilePath -> SecurityRankState -> SecurityRankState
forall a. FilePath -> a -> a
dtrace (FilePath
"\n--- JOIN ---\n" FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
"S1: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> SecurityRankState -> FilePath
forall a. Show a => a -> FilePath
groom SecurityRankState
s1 FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
"\nS2: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> SecurityRankState -> FilePath
forall a. Show a => a -> FilePath
groom SecurityRankState
s2 FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
"\nRESULT: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> SecurityRankState -> FilePath
forall a. Show a => a -> FilePath
groom SecurityRankState
result) SecurityRankState
result
    transfer :: SecurityRankContext FunctionName
-> FunctionName
-> SecurityRankState
-> Node (Lexeme FunctionName)
-> (SecurityRankState, Set (FunctionName, Context))
transfer = SecurityRankContext FunctionName
-> FunctionName
-> SecurityRankState
-> Node (Lexeme FunctionName)
-> (SecurityRankState, Set (FunctionName, Context))
transferRank


type Diagnostic = String

-- | The main entry point for the inter-procedural security rank analysis.
-- It computes summaries for all functions until a fixpoint is reached.
runInterproceduralAnalysis :: AnnotationMap
                           -> Map FunctionName PointsTo.PointsToSummary
                           -> Map FunctionName (FilePath, C.Node (C.Lexeme Text))
                           -> Map FunctionName (FilePath, C.Node (C.Lexeme Text))
                           -> Map Text (C.Node (C.Lexeme Text))
                           -> Map FunctionName SecurityRankSummary
                           -> SecurityRankContext Text
runInterproceduralAnalysis :: AnnotationMap
-> Map FunctionName PointsToSummary
-> Map FunctionName (FilePath, Node (Lexeme FunctionName))
-> Map FunctionName (FilePath, Node (Lexeme FunctionName))
-> Map FunctionName (Node (Lexeme FunctionName))
-> Map FunctionName SecurityRankSummary
-> SecurityRankContext FunctionName
runInterproceduralAnalysis AnnotationMap
annotations Map FunctionName PointsToSummary
initialPointsToSummaries Map FunctionName (FilePath, Node (Lexeme FunctionName))
funcDecls Map FunctionName (FilePath, Node (Lexeme FunctionName))
funcDefs Map FunctionName (Node (Lexeme FunctionName))
structDefs Map FunctionName SecurityRankSummary
initialSecurityRankSummaries =
    let
        worklist :: Worklist (FunctionName, [a])
worklist = [(FunctionName, [a])] -> Worklist (FunctionName, [a])
forall a. [a] -> Worklist a
fromList ([(FunctionName, [a])] -> Worklist (FunctionName, [a]))
-> [(FunctionName, [a])] -> Worklist (FunctionName, [a])
forall a b. (a -> b) -> a -> b
$ (FunctionName -> (FunctionName, [a]))
-> [FunctionName] -> [(FunctionName, [a])]
forall a b. (a -> b) -> [a] -> [b]
map (, []) (Map FunctionName (FilePath, Node (Lexeme FunctionName))
-> [FunctionName]
forall k a. Map k a -> [k]
Map.keys Map FunctionName (FilePath, Node (Lexeme FunctionName))
funcDecls)
        initialPtsCtx :: PointsToContext FunctionName
initialPtsCtx = PointsToContext :: forall l.
CallGraph
-> Map FunctionName PointsToSummary
-> Map FunctionName (Node (Lexeme FunctionName))
-> Map FunctionName (Node (Lexeme FunctionName))
-> Map FunctionName (Node (Lexeme l))
-> Map FunctionName (Node (Lexeme l))
-> Context
-> Map (FunctionName, Context) (Set (FunctionName, Context))
-> Map (FunctionName, Context) (CFG FunctionName PointsToState)
-> Set FunctionName
-> Map FunctionName (Node (Lexeme FunctionName))
-> PointsToContext l
PointsTo.PointsToContext
            { ptcCallGraph :: CallGraph
PointsTo.ptcCallGraph = CallGraph
forall k a. Map k a
Map.empty
            , ptcSummaries :: Map FunctionName PointsToSummary
PointsTo.ptcSummaries = Map FunctionName PointsToSummary
initialPointsToSummaries
            , ptcFuncDefs :: Map FunctionName (Node (Lexeme FunctionName))
PointsTo.ptcFuncDefs = ((FilePath, Node (Lexeme FunctionName))
 -> Node (Lexeme FunctionName))
-> Map FunctionName (FilePath, Node (Lexeme FunctionName))
-> Map FunctionName (Node (Lexeme FunctionName))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath, Node (Lexeme FunctionName))
-> Node (Lexeme FunctionName)
forall a b. (a, b) -> b
snd Map FunctionName (FilePath, Node (Lexeme FunctionName))
funcDefs
            , ptcFuncDecls :: Map FunctionName (Node (Lexeme FunctionName))
PointsTo.ptcFuncDecls = ((FilePath, Node (Lexeme FunctionName))
 -> Node (Lexeme FunctionName))
-> Map FunctionName (FilePath, Node (Lexeme FunctionName))
-> Map FunctionName (Node (Lexeme FunctionName))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath, Node (Lexeme FunctionName))
-> Node (Lexeme FunctionName)
forall a b. (a, b) -> b
snd Map FunctionName (FilePath, Node (Lexeme FunctionName))
funcDecls
            , ptcStructDefs :: Map FunctionName (Node (Lexeme FunctionName))
PointsTo.ptcStructDefs = Map FunctionName (Node (Lexeme FunctionName))
structDefs
            , ptcVarTypes :: Map FunctionName (Node (Lexeme FunctionName))
PointsTo.ptcVarTypes = Map FunctionName (Node (Lexeme FunctionName))
forall k a. Map k a
Map.empty
            , ptcCurrentContext :: Context
PointsTo.ptcCurrentContext = []
            , ptcDynamicCallGraph :: Map (FunctionName, Context) (Set (FunctionName, Context))
PointsTo.ptcDynamicCallGraph = Map (FunctionName, Context) (Set (FunctionName, Context))
forall k a. Map k a
Map.empty
            , ptcAnalyzedCfgs :: Map (FunctionName, Context) (CFG FunctionName PointsToState)
PointsTo.ptcAnalyzedCfgs = Map (FunctionName, Context) (CFG FunctionName PointsToState)
forall k a. Map k a
Map.empty
            , ptcLocalVars :: Set FunctionName
PointsTo.ptcLocalVars = Set FunctionName
forall a. Set a
Set.empty
            , ptcFileMacros :: Map FunctionName (Node (Lexeme FunctionName))
PointsTo.ptcFileMacros = Map FunctionName (Node (Lexeme FunctionName))
forall k a. Map k a
Map.empty
            }
        initialSrCtx :: SecurityRankContext FunctionName
initialSrCtx = SecurityRankContext :: forall l.
FilePath
-> AnnotationMap
-> Map FunctionName SecurityRankSummary
-> Map FunctionName (FilePath, Node (Lexeme l))
-> Map FunctionName (FilePath, Node (Lexeme l))
-> Map FunctionName (Node (Lexeme l))
-> CallGraph
-> PointsToContext l
-> Context
-> Map (FunctionName, Context) (Set (FunctionName, Context))
-> Map (FunctionName, Context) (CFG l SecurityRankState)
-> SecurityRankContext l
SecurityRankContext
            { srcCurrentFile :: FilePath
srcCurrentFile = FilePath
""
            , srcAnnotations :: AnnotationMap
srcAnnotations = AnnotationMap
annotations
            , srcSummaries :: Map FunctionName SecurityRankSummary
srcSummaries = Map FunctionName SecurityRankSummary
initialSecurityRankSummaries
            , srcFuncDecls :: Map FunctionName (FilePath, Node (Lexeme FunctionName))
srcFuncDecls = Map FunctionName (FilePath, Node (Lexeme FunctionName))
funcDecls
            , srcFuncDefs :: Map FunctionName (FilePath, Node (Lexeme FunctionName))
srcFuncDefs = Map FunctionName (FilePath, Node (Lexeme FunctionName))
funcDefs
            , srcStructDefs :: Map FunctionName (Node (Lexeme FunctionName))
srcStructDefs = Map FunctionName (Node (Lexeme FunctionName))
structDefs
            , srcCallGraph :: CallGraph
srcCallGraph = CallGraph
forall k a. Map k a
Map.empty
            , srcPointsToContext :: PointsToContext FunctionName
srcPointsToContext = PointsToContext FunctionName
initialPtsCtx
            , srcCurrentContext :: Context
srcCurrentContext = []
            , srcDynamicCallGraph :: Map (FunctionName, Context) (Set (FunctionName, Context))
srcDynamicCallGraph = Map (FunctionName, Context) (Set (FunctionName, Context))
forall k a. Map k a
Map.empty
            , srcAnalyzedCfgs :: Map (FunctionName, Context) (CFG FunctionName SecurityRankState)
srcAnalyzedCfgs = Map (FunctionName, Context) (CFG FunctionName SecurityRankState)
forall k a. Map k a
Map.empty
            }
    in
        SecurityRankContext FunctionName
-> Worklist (FunctionName, Context)
-> SecurityRankContext FunctionName
fixpointSummaries SecurityRankContext FunctionName
initialSrCtx Worklist (FunctionName, Context)
forall a. Worklist (FunctionName, [a])
worklist


-- | The fixed-point iteration loop for computing function summaries.
fixpointSummaries :: SecurityRankContext Text -> Worklist (FunctionName, Context) -> SecurityRankContext Text
fixpointSummaries :: SecurityRankContext FunctionName
-> Worklist (FunctionName, Context)
-> SecurityRankContext FunctionName
fixpointSummaries SecurityRankContext FunctionName
ctx Worklist (FunctionName, Context)
worklist =
    FilePath
-> SecurityRankContext FunctionName
-> SecurityRankContext FunctionName
forall a. FilePath -> a -> a
dtrace (FilePath
"\n--- FIXPOINT ITERATION ---\nWORKLIST: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Worklist (FunctionName, Context) -> FilePath
forall a. Show a => a -> FilePath
groom Worklist (FunctionName, Context)
worklist) (SecurityRankContext FunctionName
 -> SecurityRankContext FunctionName)
-> SecurityRankContext FunctionName
-> SecurityRankContext FunctionName
forall a b. (a -> b) -> a -> b
$
    case Worklist (FunctionName, Context)
-> Maybe
     ((FunctionName, Context), Worklist (FunctionName, Context))
forall a. Worklist a -> Maybe (a, Worklist a)
pop Worklist (FunctionName, Context)
worklist of
        Just ((FunctionName
funcName, Context
context), Worklist (FunctionName, Context)
worklist') ->
            FilePath
-> SecurityRankContext FunctionName
-> SecurityRankContext FunctionName
forall a. FilePath -> a -> a
dtrace (FilePath
"SecurityRank.fixpointSummaries: Analyzing " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FunctionName -> FilePath
T.unpack FunctionName
funcName FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" in context " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Context -> FilePath
forall a. Show a => a -> FilePath
groom Context
context) (SecurityRankContext FunctionName
 -> SecurityRankContext FunctionName)
-> SecurityRankContext FunctionName
-> SecurityRankContext FunctionName
forall a b. (a -> b) -> a -> b
$
            if FunctionName
-> Map FunctionName (FilePath, Node (Lexeme FunctionName)) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.notMember FunctionName
funcName (SecurityRankContext FunctionName
-> Map FunctionName (FilePath, Node (Lexeme FunctionName))
forall l.
SecurityRankContext l
-> Map FunctionName (FilePath, Node (Lexeme l))
srcFuncDefs SecurityRankContext FunctionName
ctx) then
                SecurityRankContext FunctionName
-> Worklist (FunctionName, Context)
-> SecurityRankContext FunctionName
fixpointSummaries SecurityRankContext FunctionName
ctx Worklist (FunctionName, Context)
worklist'
            else
                let
                    -- First, run the PointsTo analysis for the current function and context.
                    ptsCtx :: PointsToContext FunctionName
ptsCtx = SecurityRankContext FunctionName -> PointsToContext FunctionName
forall l. SecurityRankContext l -> PointsToContext l
srcPointsToContext SecurityRankContext FunctionName
ctx
                    ptsWorklist :: Worklist (FunctionName, Context)
ptsWorklist = [(FunctionName, Context)] -> Worklist (FunctionName, Context)
forall a. [a] -> Worklist a
fromList [(FunctionName
funcName, Context
context)]
                    ptsCtx' :: PointsToContext FunctionName
ptsCtx' = PointsToContext FunctionName
-> Worklist (FunctionName, Context) -> PointsToContext FunctionName
PointsTo.fixpointSummaries PointsToContext FunctionName
ptsCtx Worklist (FunctionName, Context)
ptsWorklist

                    -- Now, run the SecurityRank analysis with the updated points-to context.
                    (FilePath
filePath, Node (Lexeme FunctionName)
funcDef) = (FilePath, Node (Lexeme FunctionName))
-> Maybe (FilePath, Node (Lexeme FunctionName))
-> (FilePath, Node (Lexeme FunctionName))
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> (FilePath, Node (Lexeme FunctionName))
forall a. HasCallStack => FilePath -> a
error (FilePath -> (FilePath, Node (Lexeme FunctionName)))
-> FilePath -> (FilePath, Node (Lexeme FunctionName))
forall a b. (a -> b) -> a -> b
$ FilePath
"Function def not found: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FunctionName -> FilePath
T.unpack FunctionName
funcName) (FunctionName
-> Map FunctionName (FilePath, Node (Lexeme FunctionName))
-> Maybe (FilePath, Node (Lexeme FunctionName))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FunctionName
funcName (SecurityRankContext FunctionName
-> Map FunctionName (FilePath, Node (Lexeme FunctionName))
forall l.
SecurityRankContext l
-> Map FunctionName (FilePath, Node (Lexeme l))
srcFuncDefs SecurityRankContext FunctionName
ctx))
                    ctxForFunc :: SecurityRankContext FunctionName
ctxForFunc = SecurityRankContext FunctionName
ctx { srcCurrentFile :: FilePath
srcCurrentFile = FilePath
filePath, srcCurrentContext :: Context
srcCurrentContext = Context
context, srcPointsToContext :: PointsToContext FunctionName
srcPointsToContext = PointsToContext FunctionName
ptsCtx' }

                    (SecurityRankState
finalState, CFG FunctionName SecurityRankState
finalCfg, Set (FunctionName, Context)
newCallees) = SecurityRankContext FunctionName
-> Node (Lexeme FunctionName)
-> (SecurityRankState, CFG FunctionName SecurityRankState,
    Set (FunctionName, Context))
analyzeFunction SecurityRankContext FunctionName
ctxForFunc Node (Lexeme FunctionName)
funcDef

                    newSummaryData :: SecurityRankSummaryData
newSummaryData = SecurityRankContext FunctionName
-> SecurityRankState
-> CFG FunctionName SecurityRankState
-> Node (Lexeme FunctionName)
-> SecurityRankSummaryData
generateSummaryFromState SecurityRankContext FunctionName
ctxForFunc SecurityRankState
finalState CFG FunctionName SecurityRankState
finalCfg Node (Lexeme FunctionName)
funcDef
                    oldSummaries :: SecurityRankSummary
oldSummaries = SecurityRankSummary
-> Maybe SecurityRankSummary -> SecurityRankSummary
forall a. a -> Maybe a -> a
fromMaybe SecurityRankSummary
forall k a. Map k a
Map.empty (FunctionName
-> Map FunctionName SecurityRankSummary
-> Maybe SecurityRankSummary
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FunctionName
funcName (SecurityRankContext FunctionName
-> Map FunctionName SecurityRankSummary
forall l.
SecurityRankContext l -> Map FunctionName SecurityRankSummary
srcSummaries SecurityRankContext FunctionName
ctx))
                    oldSummaryData :: SecurityRankSummaryData
oldSummaryData = SecurityRankSummaryData
-> Maybe SecurityRankSummaryData -> SecurityRankSummaryData
forall a. a -> Maybe a -> a
fromMaybe SecurityRankSummaryData
emptySecurityRankSummaryData (Context -> SecurityRankSummary -> Maybe SecurityRankSummaryData
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Context
context SecurityRankSummary
oldSummaries)

                    mergedSummaryData :: SecurityRankSummaryData
mergedSummaryData = SecurityRankSummaryData
-> SecurityRankSummaryData -> SecurityRankSummaryData
joinSummaries SecurityRankSummaryData
oldSummaryData SecurityRankSummaryData
newSummaryData
                    summaries' :: Map FunctionName SecurityRankSummary
summaries' = FunctionName
-> SecurityRankSummary
-> Map FunctionName SecurityRankSummary
-> Map FunctionName SecurityRankSummary
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert FunctionName
funcName (Context
-> SecurityRankSummaryData
-> SecurityRankSummary
-> SecurityRankSummary
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Context
context SecurityRankSummaryData
mergedSummaryData SecurityRankSummary
oldSummaries) (SecurityRankContext FunctionName
-> Map FunctionName SecurityRankSummary
forall l.
SecurityRankContext l -> Map FunctionName SecurityRankSummary
srcSummaries SecurityRankContext FunctionName
ctx)

                    dynamicCallGraph' :: Map (FunctionName, Context) (Set (FunctionName, Context))
dynamicCallGraph' = (FunctionName, Context)
-> Set (FunctionName, Context)
-> Map (FunctionName, Context) (Set (FunctionName, Context))
-> Map (FunctionName, Context) (Set (FunctionName, Context))
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (FunctionName
funcName, Context
context) Set (FunctionName, Context)
newCallees (SecurityRankContext FunctionName
-> Map (FunctionName, Context) (Set (FunctionName, Context))
forall l.
SecurityRankContext l
-> Map (FunctionName, Context) (Set (FunctionName, Context))
srcDynamicCallGraph SecurityRankContext FunctionName
ctx)
                    worklistWithCallees :: Worklist (FunctionName, Context)
worklistWithCallees = [(FunctionName, Context)]
-> Worklist (FunctionName, Context)
-> Worklist (FunctionName, Context)
forall a. [a] -> Worklist a -> Worklist a
pushList (Set (FunctionName, Context) -> [(FunctionName, Context)]
forall a. Set a -> [a]
Set.toList Set (FunctionName, Context)
newCallees) Worklist (FunctionName, Context)
worklist'

                    traceMsg :: FilePath
traceMsg = FilePath
"Comparing summaries for " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FunctionName -> FilePath
T.unpack FunctionName
funcName FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" in context " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Context -> FilePath
forall a. Show a => a -> FilePath
groom Context
context FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<>
                               FilePath
"\n  OLD: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> SecurityRankSummaryData -> FilePath
forall a. Show a => a -> FilePath
groom SecurityRankSummaryData
oldSummaryData FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<>
                               FilePath
"\n  NEW_RAW: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> SecurityRankSummaryData -> FilePath
forall a. Show a => a -> FilePath
groom SecurityRankSummaryData
newSummaryData FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<>
                               FilePath
"\n  MERGED: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> SecurityRankSummaryData -> FilePath
forall a. Show a => a -> FilePath
groom SecurityRankSummaryData
mergedSummaryData
                    worklist'' :: Worklist (FunctionName, Context)
worklist'' = if FilePath -> SecurityRankSummaryData -> SecurityRankSummaryData
forall a. FilePath -> a -> a
dtrace FilePath
traceMsg SecurityRankSummaryData
mergedSummaryData SecurityRankSummaryData -> SecurityRankSummaryData -> Bool
forall a. Eq a => a -> a -> Bool
/= SecurityRankSummaryData
oldSummaryData
                                 then
                                     let dependents :: Set (FunctionName, Context)
dependents = (Set (FunctionName, Context)
 -> (FunctionName, Context)
 -> Set (FunctionName, Context)
 -> Set (FunctionName, Context))
-> Set (FunctionName, Context)
-> Map (FunctionName, Context) (Set (FunctionName, Context))
-> Set (FunctionName, Context)
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' (\Set (FunctionName, Context)
acc (FunctionName
caller, Context
callerCtx) Set (FunctionName, Context)
callees ->
                                                  if (FunctionName, Context) -> Set (FunctionName, Context) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (FunctionName
funcName, Context
context) Set (FunctionName, Context)
callees
                                                  then (FunctionName, Context)
-> Set (FunctionName, Context) -> Set (FunctionName, Context)
forall a. Ord a => a -> Set a -> Set a
Set.insert (FunctionName
caller, Context
callerCtx) Set (FunctionName, Context)
acc
                                                  else Set (FunctionName, Context)
acc
                                              ) Set (FunctionName, Context)
forall a. Set a
Set.empty Map (FunctionName, Context) (Set (FunctionName, Context))
dynamicCallGraph'
                                     in FilePath
-> Worklist (FunctionName, Context)
-> Worklist (FunctionName, Context)
forall a. FilePath -> a -> a
dtrace (FilePath
"Summary changed for " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FunctionName -> FilePath
T.unpack FunctionName
funcName FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
", adding dependents: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Set (FunctionName, Context) -> FilePath
forall a. Show a => a -> FilePath
groom Set (FunctionName, Context)
dependents) (Worklist (FunctionName, Context)
 -> Worklist (FunctionName, Context))
-> Worklist (FunctionName, Context)
-> Worklist (FunctionName, Context)
forall a b. (a -> b) -> a -> b
$ [(FunctionName, Context)]
-> Worklist (FunctionName, Context)
-> Worklist (FunctionName, Context)
forall a. [a] -> Worklist a -> Worklist a
pushList (Set (FunctionName, Context) -> [(FunctionName, Context)]
forall a. Set a -> [a]
Set.toList Set (FunctionName, Context)
dependents) Worklist (FunctionName, Context)
worklistWithCallees
                                 else Worklist (FunctionName, Context)
worklistWithCallees
                    analyzedCfgs' :: Map (FunctionName, Context) (CFG FunctionName SecurityRankState)
analyzedCfgs' = (FunctionName, Context)
-> CFG FunctionName SecurityRankState
-> Map (FunctionName, Context) (CFG FunctionName SecurityRankState)
-> Map (FunctionName, Context) (CFG FunctionName SecurityRankState)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (FunctionName
funcName, Context
context) CFG FunctionName SecurityRankState
finalCfg (SecurityRankContext FunctionName
-> Map (FunctionName, Context) (CFG FunctionName SecurityRankState)
forall l.
SecurityRankContext l
-> Map (FunctionName, Context) (CFG l SecurityRankState)
srcAnalyzedCfgs SecurityRankContext FunctionName
ctx)
                    ctx' :: SecurityRankContext FunctionName
ctx' = SecurityRankContext FunctionName
ctx { srcSummaries :: Map FunctionName SecurityRankSummary
srcSummaries = Map FunctionName SecurityRankSummary
summaries', srcDynamicCallGraph :: Map (FunctionName, Context) (Set (FunctionName, Context))
srcDynamicCallGraph = Map (FunctionName, Context) (Set (FunctionName, Context))
dynamicCallGraph', srcAnalyzedCfgs :: Map (FunctionName, Context) (CFG FunctionName SecurityRankState)
srcAnalyzedCfgs = Map (FunctionName, Context) (CFG FunctionName SecurityRankState)
analyzedCfgs', srcPointsToContext :: PointsToContext FunctionName
srcPointsToContext = PointsToContext FunctionName
ptsCtx' }
                in
                    SecurityRankContext FunctionName
-> Worklist (FunctionName, Context)
-> SecurityRankContext FunctionName
fixpointSummaries SecurityRankContext FunctionName
ctx' Worklist (FunctionName, Context)
worklist''
        Maybe ((FunctionName, Context), Worklist (FunctionName, Context))
Nothing ->
            FilePath
-> SecurityRankContext FunctionName
-> SecurityRankContext FunctionName
forall a. FilePath -> a -> a
dtrace (FilePath
"SecurityRank.fixpointSummaries: done") (SecurityRankContext FunctionName
 -> SecurityRankContext FunctionName)
-> SecurityRankContext FunctionName
-> SecurityRankContext FunctionName
forall a b. (a -> b) -> a -> b
$
            SecurityRankContext FunctionName
ctx



-- | Runs an intra-procedural analysis on a single function.
analyzeFunction :: SecurityRankContext Text -> C.Node (C.Lexeme Text) -> (SecurityRankState, CFG Text SecurityRankState, Set (FunctionName, Context))
analyzeFunction :: SecurityRankContext FunctionName
-> Node (Lexeme FunctionName)
-> (SecurityRankState, CFG FunctionName SecurityRankState,
    Set (FunctionName, Context))
analyzeFunction SecurityRankContext FunctionName
ctx Node (Lexeme FunctionName)
funcDef =
    let
        funcName :: FunctionName
funcName = Node (Lexeme FunctionName) -> FunctionName
getFuncNameFromDef Node (Lexeme FunctionName)
funcDef
    in
        if FunctionName
-> Map FunctionName (FilePath, Node (Lexeme FunctionName)) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.notMember FunctionName
funcName (SecurityRankContext FunctionName
-> Map FunctionName (FilePath, Node (Lexeme FunctionName))
forall l.
SecurityRankContext l
-> Map FunctionName (FilePath, Node (Lexeme l))
srcFuncDefs SecurityRankContext FunctionName
ctx) then
            (SecurityRankContext FunctionName -> SecurityRankState
forall (c :: * -> *) l a. DataFlow c l a => c l -> a
emptyFacts SecurityRankContext FunctionName
ctx, CFG FunctionName SecurityRankState
forall k a. Map k a
Map.empty, Set (FunctionName, Context)
forall a. Set a
Set.empty)
        else
            let
                initialFacts :: SecurityRankState
initialFacts = SecurityRankContext FunctionName
-> Node (Lexeme FunctionName) -> SecurityRankState
createInitialFacts SecurityRankContext FunctionName
ctx Node (Lexeme FunctionName)
funcDef
                cfg :: CFG FunctionName SecurityRankState
cfg = SecurityRankContext FunctionName
-> Node (Lexeme FunctionName)
-> SecurityRankState
-> CFG FunctionName SecurityRankState
forall (c :: * -> *) l a.
(DataFlow c l a, Pretty l, Ord l, Show l) =>
c l -> Node (Lexeme l) -> a -> CFG l a
buildCFG SecurityRankContext FunctionName
ctx Node (Lexeme FunctionName)
funcDef SecurityRankState
initialFacts
                (CFG FunctionName SecurityRankState
finalCfg, Set (FunctionName, Context)
newWork) = SecurityRankContext FunctionName
-> FunctionName
-> CFG FunctionName SecurityRankState
-> (CFG FunctionName SecurityRankState,
    Set (FunctionName, Context))
forall (c :: * -> *) l a.
(DataFlow c l a, Show l, Ord l) =>
c l -> l -> CFG l a -> (CFG l a, Set (l, Context))
fixpoint SecurityRankContext FunctionName
ctx FunctionName
funcName CFG FunctionName SecurityRankState
cfg
                finalState :: SecurityRankState
finalState = (SecurityRankState -> SecurityRankState -> SecurityRankState)
-> SecurityRankState -> [SecurityRankState] -> SecurityRankState
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (SecurityRankContext FunctionName
-> SecurityRankState -> SecurityRankState -> SecurityRankState
forall (c :: * -> *) l a. DataFlow c l a => c l -> a -> a -> a
join SecurityRankContext FunctionName
ctx) (SecurityRankContext FunctionName -> SecurityRankState
forall (c :: * -> *) l a. DataFlow c l a => c l -> a
emptyFacts SecurityRankContext FunctionName
ctx) (Map Int SecurityRankState -> [SecurityRankState]
forall k a. Map k a -> [a]
Map.elems ((CFGNode FunctionName SecurityRankState -> SecurityRankState)
-> CFG FunctionName SecurityRankState -> Map Int SecurityRankState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CFGNode FunctionName SecurityRankState -> SecurityRankState
forall l a. CFGNode l a -> a
cfgOutFacts CFG FunctionName SecurityRankState
finalCfg))
            in
                (SecurityRankState
finalState, CFG FunctionName SecurityRankState
finalCfg, Set (FunctionName, Context)
newWork)

findCallersOf :: SecurityRankContext Text -> FunctionName -> Context -> [(FunctionName, Context, C.Node (C.Lexeme Text))]
findCallersOf :: SecurityRankContext FunctionName
-> FunctionName
-> Context
-> [(FunctionName, Context, Node (Lexeme FunctionName))]
findCallersOf SecurityRankContext FunctionName
ctx FunctionName
calleeName Context
calleeContext =
    let
        dynamicCallGraph :: Map (FunctionName, Context) (Set (FunctionName, Context))
dynamicCallGraph = SecurityRankContext FunctionName
-> Map (FunctionName, Context) (Set (FunctionName, Context))
forall l.
SecurityRankContext l
-> Map (FunctionName, Context) (Set (FunctionName, Context))
srcDynamicCallGraph SecurityRankContext FunctionName
ctx
        callSiteNodeId :: Int
callSiteNodeId = Context -> Int
forall a. [a] -> a
head Context
calleeContext

        findCallingStmt :: CFG Text SecurityRankState -> Maybe (C.Node (C.Lexeme Text))
        findCallingStmt :: CFG FunctionName SecurityRankState
-> Maybe (Node (Lexeme FunctionName))
findCallingStmt CFG FunctionName SecurityRankState
cfg =
            let
                allStmts :: [Node (Lexeme FunctionName)]
allStmts = (CFGNode FunctionName SecurityRankState
 -> [Node (Lexeme FunctionName)])
-> [CFGNode FunctionName SecurityRankState]
-> [Node (Lexeme FunctionName)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CFGNode FunctionName SecurityRankState
-> [Node (Lexeme FunctionName)]
forall l a. CFGNode l a -> [Node (Lexeme l)]
cfgStmts (CFG FunctionName SecurityRankState
-> [CFGNode FunctionName SecurityRankState]
forall k a. Map k a -> [a]
Map.elems CFG FunctionName SecurityRankState
cfg)
                findNodeInStmt :: C.Node (C.Lexeme Text) -> Maybe (C.Node (C.Lexeme Text))
                findNodeInStmt :: Node (Lexeme FunctionName) -> Maybe (Node (Lexeme FunctionName))
findNodeInStmt Node (Lexeme FunctionName)
topStmt =
                    let
                        collector :: AstActions
  (StateT (Maybe (Node (Lexeme FunctionName))) Identity) FunctionName
collector = AstActions
  (StateT (Maybe (Node (Lexeme FunctionName))) Identity) FunctionName
forall (f :: * -> *) text. Applicative f => AstActions f text
astActions {
                            doNode :: FilePath
-> Node (Lexeme FunctionName)
-> StateT (Maybe (Node (Lexeme FunctionName))) Identity ()
-> StateT (Maybe (Node (Lexeme FunctionName))) Identity ()
doNode = \FilePath
_ (Node (Lexeme FunctionName)
node :: C.Node (C.Lexeme Text)) StateT (Maybe (Node (Lexeme FunctionName))) Identity ()
act -> do
                                StateT
  (Maybe (Node (Lexeme FunctionName)))
  Identity
  (Maybe (Node (Lexeme FunctionName)))
forall s (m :: * -> *). MonadState s m => m s
get StateT
  (Maybe (Node (Lexeme FunctionName)))
  Identity
  (Maybe (Node (Lexeme FunctionName)))
-> (Maybe (Node (Lexeme FunctionName))
    -> StateT (Maybe (Node (Lexeme FunctionName))) Identity ())
-> StateT (Maybe (Node (Lexeme FunctionName))) Identity ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                                    Just Node (Lexeme FunctionName)
_ -> () -> StateT (Maybe (Node (Lexeme FunctionName))) Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                                    Maybe (Node (Lexeme FunctionName))
Nothing -> do
                                        Bool
-> StateT (Maybe (Node (Lexeme FunctionName))) Identity ()
-> StateT (Maybe (Node (Lexeme FunctionName))) Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Node (Lexeme FunctionName) -> Int
forall a. Hashable a => Node a -> Int
C.getNodeId Node (Lexeme FunctionName)
node Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
callSiteNodeId) (StateT (Maybe (Node (Lexeme FunctionName))) Identity ()
 -> StateT (Maybe (Node (Lexeme FunctionName))) Identity ())
-> StateT (Maybe (Node (Lexeme FunctionName))) Identity ()
-> StateT (Maybe (Node (Lexeme FunctionName))) Identity ()
forall a b. (a -> b) -> a -> b
$ Maybe (Node (Lexeme FunctionName))
-> StateT (Maybe (Node (Lexeme FunctionName))) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Node (Lexeme FunctionName) -> Maybe (Node (Lexeme FunctionName))
forall a. a -> Maybe a
Just Node (Lexeme FunctionName)
topStmt)
                                        StateT (Maybe (Node (Lexeme FunctionName))) Identity ()
act
                        }
                    in
                        StateT (Maybe (Node (Lexeme FunctionName))) Identity ()
-> Maybe (Node (Lexeme FunctionName))
-> Maybe (Node (Lexeme FunctionName))
forall s a. State s a -> s -> s
execState (AstActions
  (StateT (Maybe (Node (Lexeme FunctionName))) Identity) FunctionName
-> [(FilePath, [Node (Lexeme FunctionName)])]
-> StateT (Maybe (Node (Lexeme FunctionName))) Identity ()
forall text a (f :: * -> *).
(TraverseAst text a, Applicative f) =>
AstActions f text -> a -> f ()
traverseAst AstActions
  (StateT (Maybe (Node (Lexeme FunctionName))) Identity) FunctionName
collector [(FilePath
fakeTestSource, [Node (Lexeme FunctionName)
topStmt])]) Maybe (Node (Lexeme FunctionName))
forall a. Maybe a
Nothing
            in
                [Maybe (Node (Lexeme FunctionName))]
-> Maybe (Node (Lexeme FunctionName))
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ((Node (Lexeme FunctionName) -> Maybe (Node (Lexeme FunctionName)))
-> [Node (Lexeme FunctionName)]
-> [Maybe (Node (Lexeme FunctionName))]
forall a b. (a -> b) -> [a] -> [b]
map Node (Lexeme FunctionName) -> Maybe (Node (Lexeme FunctionName))
findNodeInStmt [Node (Lexeme FunctionName)]
allStmts)

        callers :: [(FunctionName, Context, Node (Lexeme FunctionName))]
callers = ([(FunctionName, Context, Node (Lexeme FunctionName))]
 -> (FunctionName, Context)
 -> Set (FunctionName, Context)
 -> [(FunctionName, Context, Node (Lexeme FunctionName))])
-> [(FunctionName, Context, Node (Lexeme FunctionName))]
-> Map (FunctionName, Context) (Set (FunctionName, Context))
-> [(FunctionName, Context, Node (Lexeme FunctionName))]
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' (\[(FunctionName, Context, Node (Lexeme FunctionName))]
acc (FunctionName
caller, Context
callerCtx) Set (FunctionName, Context)
callees ->
            if (FunctionName, Context) -> Set (FunctionName, Context) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (FunctionName
calleeName, Context
calleeContext) Set (FunctionName, Context)
callees
            then case (FunctionName, Context)
-> Map (FunctionName, Context) (CFG FunctionName SecurityRankState)
-> Maybe (CFG FunctionName SecurityRankState)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (FunctionName
caller, Context
callerCtx) (SecurityRankContext FunctionName
-> Map (FunctionName, Context) (CFG FunctionName SecurityRankState)
forall l.
SecurityRankContext l
-> Map (FunctionName, Context) (CFG l SecurityRankState)
srcAnalyzedCfgs SecurityRankContext FunctionName
ctx) of
                    Just CFG FunctionName SecurityRankState
cfg -> case CFG FunctionName SecurityRankState
-> Maybe (Node (Lexeme FunctionName))
findCallingStmt CFG FunctionName SecurityRankState
cfg of
                        Just Node (Lexeme FunctionName)
stmt -> (FunctionName
caller, Context
callerCtx, Node (Lexeme FunctionName)
stmt) (FunctionName, Context, Node (Lexeme FunctionName))
-> [(FunctionName, Context, Node (Lexeme FunctionName))]
-> [(FunctionName, Context, Node (Lexeme FunctionName))]
forall a. a -> [a] -> [a]
: [(FunctionName, Context, Node (Lexeme FunctionName))]
acc
                        Maybe (Node (Lexeme FunctionName))
Nothing   -> [(FunctionName, Context, Node (Lexeme FunctionName))]
acc
                    Maybe (CFG FunctionName SecurityRankState)
Nothing -> [(FunctionName, Context, Node (Lexeme FunctionName))]
acc
            else [(FunctionName, Context, Node (Lexeme FunctionName))]
acc
          ) [] Map (FunctionName, Context) (Set (FunctionName, Context))
dynamicCallGraph
    in
        [(FunctionName, Context, Node (Lexeme FunctionName))]
callers

computeFactsFromCallSite :: SecurityRankContext Text -> FunctionName -> (FunctionName, Context, C.Node (C.Lexeme Text)) -> TaintState
computeFactsFromCallSite :: SecurityRankContext FunctionName
-> FunctionName
-> (FunctionName, Context, Node (Lexeme FunctionName))
-> TaintState
computeFactsFromCallSite SecurityRankContext FunctionName
ctx FunctionName
calleeName (FunctionName
callerName, Context
callerContext, Node (Lexeme FunctionName)
callStmt) =
    let
        callerCfg :: CFG FunctionName SecurityRankState
callerCfg = CFG FunctionName SecurityRankState
-> Maybe (CFG FunctionName SecurityRankState)
-> CFG FunctionName SecurityRankState
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> CFG FunctionName SecurityRankState
forall a. HasCallStack => FilePath -> a
error FilePath
"caller CFG not found for SecurityRank") (Maybe (CFG FunctionName SecurityRankState)
 -> CFG FunctionName SecurityRankState)
-> Maybe (CFG FunctionName SecurityRankState)
-> CFG FunctionName SecurityRankState
forall a b. (a -> b) -> a -> b
$ (FunctionName, Context)
-> Map (FunctionName, Context) (CFG FunctionName SecurityRankState)
-> Maybe (CFG FunctionName SecurityRankState)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (FunctionName
callerName, Context
callerContext) (SecurityRankContext FunctionName
-> Map (FunctionName, Context) (CFG FunctionName SecurityRankState)
forall l.
SecurityRankContext l
-> Map (FunctionName, Context) (CFG l SecurityRankState)
srcAnalyzedCfgs SecurityRankContext FunctionName
ctx)
        callNode :: CFGNode FunctionName SecurityRankState
callNode = CFGNode FunctionName SecurityRankState
-> Maybe (CFGNode FunctionName SecurityRankState)
-> CFGNode FunctionName SecurityRankState
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> CFGNode FunctionName SecurityRankState
forall a. HasCallStack => FilePath -> a
error FilePath
"call node not found in CFG for SecurityRank") (Maybe (CFGNode FunctionName SecurityRankState)
 -> CFGNode FunctionName SecurityRankState)
-> Maybe (CFGNode FunctionName SecurityRankState)
-> CFGNode FunctionName SecurityRankState
forall a b. (a -> b) -> a -> b
$ (CFGNode FunctionName SecurityRankState -> Bool)
-> [CFGNode FunctionName SecurityRankState]
-> Maybe (CFGNode FunctionName SecurityRankState)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\CFGNode FunctionName SecurityRankState
n -> Node (Lexeme FunctionName)
callStmt Node (Lexeme FunctionName) -> [Node (Lexeme FunctionName)] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` CFGNode FunctionName SecurityRankState
-> [Node (Lexeme FunctionName)]
forall l a. CFGNode l a -> [Node (Lexeme l)]
cfgStmts CFGNode FunctionName SecurityRankState
n) (CFG FunctionName SecurityRankState
-> [CFGNode FunctionName SecurityRankState]
forall k a. Map k a -> [a]
Map.elems CFG FunctionName SecurityRankState
callerCfg)
        stmtsBeforeCall :: [Node (Lexeme FunctionName)]
stmtsBeforeCall = (Node (Lexeme FunctionName) -> Bool)
-> [Node (Lexeme FunctionName)] -> [Node (Lexeme FunctionName)]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Node (Lexeme FunctionName) -> Node (Lexeme FunctionName) -> Bool
forall a. Eq a => a -> a -> Bool
/= Node (Lexeme FunctionName)
callStmt) (CFGNode FunctionName SecurityRankState
-> [Node (Lexeme FunctionName)]
forall l a. CFGNode l a -> [Node (Lexeme l)]
cfgStmts CFGNode FunctionName SecurityRankState
callNode)
        callerState :: TaintState
callerState = SecurityRankState -> TaintState
srsTaintState (SecurityRankState -> TaintState)
-> SecurityRankState -> TaintState
forall a b. (a -> b) -> a -> b
$ (SecurityRankState, Set (FunctionName, Context))
-> SecurityRankState
forall a b. (a, b) -> a
fst ((SecurityRankState, Set (FunctionName, Context))
 -> SecurityRankState)
-> (SecurityRankState, Set (FunctionName, Context))
-> SecurityRankState
forall a b. (a -> b) -> a -> b
$ ((SecurityRankState, Set (FunctionName, Context))
 -> Node (Lexeme FunctionName)
 -> (SecurityRankState, Set (FunctionName, Context)))
-> (SecurityRankState, Set (FunctionName, Context))
-> [Node (Lexeme FunctionName)]
-> (SecurityRankState, Set (FunctionName, Context))
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
            (\ (SecurityRankState
accFacts, Set (FunctionName, Context)
_) Node (Lexeme FunctionName)
stmt -> SecurityRankContext FunctionName
-> FunctionName
-> SecurityRankState
-> Node (Lexeme FunctionName)
-> (SecurityRankState, Set (FunctionName, Context))
transferRank SecurityRankContext FunctionName
ctx FunctionName
callerName SecurityRankState
accFacts Node (Lexeme FunctionName)
stmt)
            (CFGNode FunctionName SecurityRankState -> SecurityRankState
forall l a. CFGNode l a -> a
cfgInFacts CFGNode FunctionName SecurityRankState
callNode, Set (FunctionName, Context)
forall a. Set a
Set.empty)
            [Node (Lexeme FunctionName)]
stmtsBeforeCall

        -- Recompute the PointsToMap at the call site
        pctx :: PointsToContext FunctionName
pctx = (SecurityRankContext FunctionName -> PointsToContext FunctionName
forall l. SecurityRankContext l -> PointsToContext l
srcPointsToContext SecurityRankContext FunctionName
ctx) { ptcCurrentContext :: Context
PointsTo.ptcCurrentContext = Context
callerContext }
        callerPtsCfg :: CFG FunctionName PointsToState
callerPtsCfg = FilePath
-> CFG FunctionName PointsToState -> CFG FunctionName PointsToState
forall a. FilePath -> a -> a
dtrace (FilePath
"computeFactsFromCallSite: Looking up Pts CFG for (" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FunctionName -> FilePath
T.unpack FunctionName
callerName FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
", " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Context -> FilePath
forall a. Show a => a -> FilePath
groom Context
callerContext FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
") in " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ [(FunctionName, Context)] -> FilePath
forall a. Show a => a -> FilePath
show (Map (FunctionName, Context) (CFG FunctionName PointsToState)
-> [(FunctionName, Context)]
forall k a. Map k a -> [k]
Map.keys (PointsToContext FunctionName
-> Map (FunctionName, Context) (CFG FunctionName PointsToState)
forall l.
PointsToContext l
-> Map (FunctionName, Context) (CFG FunctionName PointsToState)
PointsTo.ptcAnalyzedCfgs PointsToContext FunctionName
pctx))) (CFG FunctionName PointsToState -> CFG FunctionName PointsToState)
-> CFG FunctionName PointsToState -> CFG FunctionName PointsToState
forall a b. (a -> b) -> a -> b
$ CFG FunctionName PointsToState
-> Maybe (CFG FunctionName PointsToState)
-> CFG FunctionName PointsToState
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> CFG FunctionName PointsToState
forall a. HasCallStack => FilePath -> a
error (FilePath -> CFG FunctionName PointsToState)
-> FilePath -> CFG FunctionName PointsToState
forall a b. (a -> b) -> a -> b
$ FilePath
"caller Pts CFG not found for (" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FunctionName -> FilePath
T.unpack FunctionName
callerName FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
", " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Context -> FilePath
forall a. Show a => a -> FilePath
groom Context
callerContext FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
")") (Maybe (CFG FunctionName PointsToState)
 -> CFG FunctionName PointsToState)
-> Maybe (CFG FunctionName PointsToState)
-> CFG FunctionName PointsToState
forall a b. (a -> b) -> a -> b
$ (FunctionName, Context)
-> Map (FunctionName, Context) (CFG FunctionName PointsToState)
-> Maybe (CFG FunctionName PointsToState)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (FunctionName
callerName, Context
callerContext) (PointsToContext FunctionName
-> Map (FunctionName, Context) (CFG FunctionName PointsToState)
forall l.
PointsToContext l
-> Map (FunctionName, Context) (CFG FunctionName PointsToState)
PointsTo.ptcAnalyzedCfgs PointsToContext FunctionName
pctx)
        ptsCallNode :: CFGNode FunctionName PointsToState
ptsCallNode = CFGNode FunctionName PointsToState
-> Maybe (CFGNode FunctionName PointsToState)
-> CFGNode FunctionName PointsToState
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> CFGNode FunctionName PointsToState
forall a. HasCallStack => FilePath -> a
error FilePath
"call node not found in Pts CFG") (Maybe (CFGNode FunctionName PointsToState)
 -> CFGNode FunctionName PointsToState)
-> Maybe (CFGNode FunctionName PointsToState)
-> CFGNode FunctionName PointsToState
forall a b. (a -> b) -> a -> b
$ (CFGNode FunctionName PointsToState -> Bool)
-> [CFGNode FunctionName PointsToState]
-> Maybe (CFGNode FunctionName PointsToState)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\CFGNode FunctionName PointsToState
n -> Node (Lexeme FunctionName)
callStmt Node (Lexeme FunctionName) -> [Node (Lexeme FunctionName)] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` CFGNode FunctionName PointsToState -> [Node (Lexeme FunctionName)]
forall l a. CFGNode l a -> [Node (Lexeme l)]
cfgStmts CFGNode FunctionName PointsToState
n) (CFG FunctionName PointsToState
-> [CFGNode FunctionName PointsToState]
forall k a. Map k a -> [a]
Map.elems CFG FunctionName PointsToState
callerPtsCfg)

        callerPtsMap :: PointsToMap
callerPtsMap = PointsToState -> PointsToMap
PointsTo.ptsMap (PointsToState -> PointsToMap) -> PointsToState -> PointsToMap
forall a b. (a -> b) -> a -> b
$ (PointsToState, Set (FunctionName, Context)) -> PointsToState
forall a b. (a, b) -> a
fst ((PointsToState, Set (FunctionName, Context)) -> PointsToState)
-> (PointsToState, Set (FunctionName, Context)) -> PointsToState
forall a b. (a -> b) -> a -> b
$ ((PointsToState, Set (FunctionName, Context))
 -> Node (Lexeme FunctionName)
 -> (PointsToState, Set (FunctionName, Context)))
-> (PointsToState, Set (FunctionName, Context))
-> [Node (Lexeme FunctionName)]
-> (PointsToState, Set (FunctionName, Context))
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
            (\(PointsToState
accFacts, Set (FunctionName, Context)
_) Node (Lexeme FunctionName)
stmt -> PointsToContext FunctionName
-> FunctionName
-> PointsToState
-> Node (Lexeme FunctionName)
-> (PointsToState, Set (FunctionName, Context))
PointsTo.transferPointsToState PointsToContext FunctionName
pctx FunctionName
callerName PointsToState
accFacts Node (Lexeme FunctionName)
stmt)
            (CFGNode FunctionName PointsToState -> PointsToState
forall l a. CFGNode l a -> a
cfgInFacts CFGNode FunctionName PointsToState
ptsCallNode, Set (FunctionName, Context)
forall a. Set a
Set.empty)
            [Node (Lexeme FunctionName)]
stmtsBeforeCall

        (Node (Lexeme FunctionName)
_, [Node (Lexeme FunctionName)]
args) = case Node (Lexeme FunctionName)
-> NodeF (Lexeme FunctionName) (Node (Lexeme FunctionName))
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Node (Lexeme FunctionName)
callStmt of
            C.ExprStmt (Fix (C.FunctionCall Node (Lexeme FunctionName)
e [Node (Lexeme FunctionName)]
a)) -> (Node (Lexeme FunctionName)
e, [Node (Lexeme FunctionName)]
a)
            C.FunctionCall Node (Lexeme FunctionName)
e [Node (Lexeme FunctionName)]
a -> (Node (Lexeme FunctionName)
e, [Node (Lexeme FunctionName)]
a)
            C.AssignExpr Node (Lexeme FunctionName)
_ AssignOp
_ (Fix (C.FunctionCall Node (Lexeme FunctionName)
e [Node (Lexeme FunctionName)]
a)) -> (Node (Lexeme FunctionName)
e, [Node (Lexeme FunctionName)]
a)
            C.VarDeclStmt Node (Lexeme FunctionName)
_ (Just (Fix (C.FunctionCall Node (Lexeme FunctionName)
e [Node (Lexeme FunctionName)]
a))) -> (Node (Lexeme FunctionName)
e, [Node (Lexeme FunctionName)]
a)
            NodeF (Lexeme FunctionName) (Node (Lexeme FunctionName))
_ -> FilePath
-> (Node (Lexeme FunctionName), [Node (Lexeme FunctionName)])
forall a. HasCallStack => FilePath -> a
error (FilePath
 -> (Node (Lexeme FunctionName), [Node (Lexeme FunctionName)]))
-> FilePath
-> (Node (Lexeme FunctionName), [Node (Lexeme FunctionName)])
forall a b. (a -> b) -> a -> b
$ FilePath
"Unhandled call statement structure in SecurityRank: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Node (Lexeme FunctionName) -> FilePath
forall a. Show a => a -> FilePath
groom Node (Lexeme FunctionName)
callStmt

        (FilePath
_, Node (Lexeme FunctionName)
calleeDef) = (FilePath, Node (Lexeme FunctionName))
-> Maybe (FilePath, Node (Lexeme FunctionName))
-> (FilePath, Node (Lexeme FunctionName))
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> (FilePath, Node (Lexeme FunctionName))
forall a. HasCallStack => FilePath -> a
error (FilePath -> (FilePath, Node (Lexeme FunctionName)))
-> FilePath -> (FilePath, Node (Lexeme FunctionName))
forall a b. (a -> b) -> a -> b
$ FilePath
"callee def not found: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FunctionName -> FilePath
T.unpack FunctionName
calleeName) (FunctionName
-> Map FunctionName (FilePath, Node (Lexeme FunctionName))
-> Maybe (FilePath, Node (Lexeme FunctionName))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FunctionName
calleeName (SecurityRankContext FunctionName
-> Map FunctionName (FilePath, Node (Lexeme FunctionName))
forall l.
SecurityRankContext l
-> Map FunctionName (FilePath, Node (Lexeme l))
srcFuncDefs SecurityRankContext FunctionName
ctx))
        paramNames :: [FunctionName]
paramNames = Node (Lexeme FunctionName) -> [FunctionName]
getParamNamesFromDef Node (Lexeme FunctionName)
calleeDef

        paramFacts :: [(AbstractLocation, SecurityRank)]
paramFacts = (FunctionName
 -> Node (Lexeme FunctionName) -> (AbstractLocation, SecurityRank))
-> [FunctionName]
-> [Node (Lexeme FunctionName)]
-> [(AbstractLocation, SecurityRank)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\FunctionName
pName Node (Lexeme FunctionName)
arg ->
            let rank :: SecurityRank
rank = SecurityRankContext FunctionName
-> FunctionName
-> TaintState
-> PointsToMap
-> Node (Lexeme FunctionName)
-> SecurityRank
evalRank SecurityRankContext FunctionName
ctx FunctionName
callerName TaintState
callerState PointsToMap
callerPtsMap Node (Lexeme FunctionName)
arg
            in (FunctionName -> AbstractLocation
VarLocation FunctionName
pName, SecurityRank
rank)
          ) [FunctionName]
paramNames [Node (Lexeme FunctionName)]
args
    in
        FilePath -> TaintState -> TaintState
forall a. FilePath -> a -> a
dtrace (FilePath
"computeFactsFromCallSite for " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FunctionName -> FilePath
T.unpack FunctionName
calleeName FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" called by " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FunctionName -> FilePath
T.unpack FunctionName
callerName FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" in context " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Context -> FilePath
forall a. Show a => a -> FilePath
groom Context
callerContext FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<>
                FilePath
"\n  CALLER_TAINT_STATE: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> TaintState -> FilePath
forall a. Show a => a -> FilePath
groom TaintState
callerState FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<>
                FilePath
"\n  CALLER_PTS_MAP: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> PointsToMap -> FilePath
forall a. Show a => a -> FilePath
groom PointsToMap
callerPtsMap FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<>
                FilePath
"\n  PARAM_FACTS: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> [(AbstractLocation, SecurityRank)] -> FilePath
forall a. Show a => a -> FilePath
groom [(AbstractLocation, SecurityRank)]
paramFacts) (TaintState -> TaintState) -> TaintState -> TaintState
forall a b. (a -> b) -> a -> b
$
        [(AbstractLocation, SecurityRank)] -> TaintState
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(AbstractLocation, SecurityRank)]
paramFacts



createInitialFacts :: SecurityRankContext Text -> C.Node (C.Lexeme Text) -> SecurityRankState
createInitialFacts :: SecurityRankContext FunctionName
-> Node (Lexeme FunctionName) -> SecurityRankState
createInitialFacts SecurityRankContext FunctionName
ctx Node (Lexeme FunctionName)
funcDef =
    let
        funcName :: FunctionName
funcName = Node (Lexeme FunctionName) -> FunctionName
getFuncNameFromDef Node (Lexeme FunctionName)
funcDef
        calleeContext :: Context
calleeContext = SecurityRankContext FunctionName -> Context
forall l. SecurityRankContext l -> Context
srcCurrentContext SecurityRankContext FunctionName
ctx
        funcAnns :: Map FunctionName SecurityRank
funcAnns = Map FunctionName SecurityRank
-> Maybe (Map FunctionName SecurityRank)
-> Map FunctionName SecurityRank
forall a. a -> Maybe a -> a
fromMaybe Map FunctionName SecurityRank
forall k a. Map k a
Map.empty (FunctionName
-> AnnotationMap -> Maybe (Map FunctionName SecurityRank)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FunctionName
funcName (SecurityRankContext FunctionName -> AnnotationMap
forall l. SecurityRankContext l -> AnnotationMap
srcAnnotations SecurityRankContext FunctionName
ctx))
        paramTypes :: [Node (Lexeme FunctionName)]
paramTypes = Node (Lexeme FunctionName) -> [Node (Lexeme FunctionName)]
getParamTypesFromDef Node (Lexeme FunctionName)
funcDef
        paramNames :: [FunctionName]
paramNames = Node (Lexeme FunctionName) -> [FunctionName]
getParamNamesFromDef Node (Lexeme FunctionName)
funcDef

        -- Taint from annotations on parameters and struct fields.
        paramTaints :: TaintState
paramTaints = (SecurityRank -> SecurityRank -> SecurityRank)
-> [(AbstractLocation, SecurityRank)] -> TaintState
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith SecurityRank -> SecurityRank -> SecurityRank
mergeRank ([(AbstractLocation, SecurityRank)] -> TaintState)
-> [(AbstractLocation, SecurityRank)] -> TaintState
forall a b. (a -> b) -> a -> b
$ ((FunctionName, Node (Lexeme FunctionName))
 -> [(AbstractLocation, SecurityRank)])
-> [(FunctionName, Node (Lexeme FunctionName))]
-> [(AbstractLocation, SecurityRank)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(FunctionName
pName, Node (Lexeme FunctionName)
pType) ->
            FilePath
-> [(AbstractLocation, SecurityRank)]
-> [(AbstractLocation, SecurityRank)]
forall a. FilePath -> a -> a
dtrace (FilePath
"  Processing param: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FunctionName -> FilePath
T.unpack FunctionName
pName FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" with type " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Node (Lexeme FunctionName) -> FilePath
forall a. Show a => a -> FilePath
groom Node (Lexeme FunctionName)
pType) ([(AbstractLocation, SecurityRank)]
 -> [(AbstractLocation, SecurityRank)])
-> [(AbstractLocation, SecurityRank)]
-> [(AbstractLocation, SecurityRank)]
forall a b. (a -> b) -> a -> b
$
            let
                paramAnnTaint :: [(AbstractLocation, SecurityRank)]
paramAnnTaint = case FunctionName -> Map FunctionName SecurityRank -> Maybe SecurityRank
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (FunctionName
"source:" FunctionName -> FunctionName -> FunctionName
forall a. Semigroup a => a -> a -> a
<> FunctionName
pName) Map FunctionName SecurityRank
funcAnns of
                    Just SecurityRank
rank ->
                        let loc :: AbstractLocation
loc = case Node (Lexeme FunctionName)
-> NodeF (Lexeme FunctionName) (Node (Lexeme FunctionName))
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Node (Lexeme FunctionName)
pType of
                                C.TyPointer {} -> AbstractLocation -> AbstractLocation
DerefLocation (FunctionName -> AbstractLocation
VarLocation FunctionName
pName)
                                NodeF (Lexeme FunctionName) (Node (Lexeme FunctionName))
_              -> FunctionName -> AbstractLocation
VarLocation FunctionName
pName
                        in [(AbstractLocation
loc, SecurityRank
rank)]
                    Maybe SecurityRank
Nothing   -> []

                structFieldTaint :: [(AbstractLocation, SecurityRank)]
structFieldTaint = case Node (Lexeme FunctionName)
-> NodeF (Lexeme FunctionName) (Node (Lexeme FunctionName))
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Node (Lexeme FunctionName)
pType of
                    C.TyPointer (Fix (C.TyStruct (C.L AlexPosn
_ LexemeClass
_ FunctionName
structName))) ->
                        let structDef :: Node (Lexeme FunctionName)
structDef = Node (Lexeme FunctionName)
-> Maybe (Node (Lexeme FunctionName)) -> Node (Lexeme FunctionName)
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> Node (Lexeme FunctionName)
forall a. HasCallStack => FilePath -> a
error (FilePath -> Node (Lexeme FunctionName))
-> FilePath -> Node (Lexeme FunctionName)
forall a b. (a -> b) -> a -> b
$ FilePath
"Struct def not found: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FunctionName -> FilePath
T.unpack FunctionName
structName) (FunctionName
-> Map FunctionName (Node (Lexeme FunctionName))
-> Maybe (Node (Lexeme FunctionName))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FunctionName
structName (SecurityRankContext FunctionName
-> Map FunctionName (Node (Lexeme FunctionName))
forall l.
SecurityRankContext l -> Map FunctionName (Node (Lexeme l))
srcStructDefs SecurityRankContext FunctionName
ctx))
                            memberNames :: [FunctionName]
memberNames = Node (Lexeme FunctionName) -> [FunctionName]
getStructMemberNames Node (Lexeme FunctionName)
structDef
                            baseLoc :: AbstractLocation
baseLoc = AbstractLocation -> AbstractLocation
DerefLocation (FunctionName -> AbstractLocation
VarLocation FunctionName
pName)
                        in FilePath
-> [(AbstractLocation, SecurityRank)]
-> [(AbstractLocation, SecurityRank)]
forall a. FilePath -> a -> a
dtrace (FilePath
"    Struct " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FunctionName -> FilePath
T.unpack FunctionName
structName FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" has members: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> [FunctionName] -> FilePath
forall a. Show a => a -> FilePath
groom [FunctionName]
memberNames) ([(AbstractLocation, SecurityRank)]
 -> [(AbstractLocation, SecurityRank)])
-> [(AbstractLocation, SecurityRank)]
-> [(AbstractLocation, SecurityRank)]
forall a b. (a -> b) -> a -> b
$
                           (FunctionName -> Maybe (AbstractLocation, SecurityRank))
-> [FunctionName] -> [(AbstractLocation, SecurityRank)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\FunctionName
mName ->
                               let memberAnnKey :: FunctionName
memberAnnKey = FunctionName
structName FunctionName -> FunctionName -> FunctionName
forall a. Semigroup a => a -> a -> a
<> FunctionName
"." FunctionName -> FunctionName -> FunctionName
forall a. Semigroup a => a -> a -> a
<> FunctionName
mName
                                   memberAnns :: Map FunctionName SecurityRank
memberAnns = Map FunctionName SecurityRank
-> Maybe (Map FunctionName SecurityRank)
-> Map FunctionName SecurityRank
forall a. a -> Maybe a -> a
fromMaybe Map FunctionName SecurityRank
forall k a. Map k a
Map.empty (FunctionName
-> AnnotationMap -> Maybe (Map FunctionName SecurityRank)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FunctionName
memberAnnKey (SecurityRankContext FunctionName -> AnnotationMap
forall l. SecurityRankContext l -> AnnotationMap
srcAnnotations SecurityRankContext FunctionName
ctx))
                               in case FunctionName -> Map FunctionName SecurityRank -> Maybe SecurityRank
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FunctionName
"source" Map FunctionName SecurityRank
memberAnns of
                                   Just SecurityRank
rank -> (AbstractLocation, SecurityRank)
-> Maybe (AbstractLocation, SecurityRank)
forall a. a -> Maybe a
Just (AbstractLocation -> FunctionName -> AbstractLocation
FieldLocation AbstractLocation
baseLoc FunctionName
mName, SecurityRank
rank)
                                   Maybe SecurityRank
Nothing   -> Maybe (AbstractLocation, SecurityRank)
forall a. Maybe a
Nothing
                           ) [FunctionName]
memberNames
                    NodeF (Lexeme FunctionName) (Node (Lexeme FunctionName))
_ -> []
            in [(AbstractLocation, SecurityRank)]
paramAnnTaint [(AbstractLocation, SecurityRank)]
-> [(AbstractLocation, SecurityRank)]
-> [(AbstractLocation, SecurityRank)]
forall a. [a] -> [a] -> [a]
++ [(AbstractLocation, SecurityRank)]
structFieldTaint
          ) ([FunctionName]
-> [Node (Lexeme FunctionName)]
-> [(FunctionName, Node (Lexeme FunctionName))]
forall a b. [a] -> [b] -> [(a, b)]
zip [FunctionName]
paramNames [Node (Lexeme FunctionName)]
paramTypes)

        initialTaintState :: TaintState
initialTaintState = if Context -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Context
calleeContext
            then TaintState
paramTaints
            else
                let
                    callers :: [(FunctionName, Context, Node (Lexeme FunctionName))]
callers = SecurityRankContext FunctionName
-> FunctionName
-> Context
-> [(FunctionName, Context, Node (Lexeme FunctionName))]
findCallersOf SecurityRankContext FunctionName
ctx FunctionName
funcName Context
calleeContext
                    factList :: [TaintState]
factList = ((FunctionName, Context, Node (Lexeme FunctionName)) -> TaintState)
-> [(FunctionName, Context, Node (Lexeme FunctionName))]
-> [TaintState]
forall a b. (a -> b) -> [a] -> [b]
map (SecurityRankContext FunctionName
-> FunctionName
-> (FunctionName, Context, Node (Lexeme FunctionName))
-> TaintState
computeFactsFromCallSite SecurityRankContext FunctionName
ctx FunctionName
funcName) [(FunctionName, Context, Node (Lexeme FunctionName))]
callers
                    taintFromCallers :: TaintState
taintFromCallers = (TaintState -> TaintState -> TaintState)
-> TaintState -> [TaintState] -> TaintState
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((SecurityRank -> SecurityRank -> SecurityRank)
-> TaintState -> TaintState -> TaintState
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith SecurityRank -> SecurityRank -> SecurityRank
mergeRank) TaintState
forall k a. Map k a
Map.empty [TaintState]
factList
                in
                    (SecurityRank -> SecurityRank -> SecurityRank)
-> TaintState -> TaintState -> TaintState
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith SecurityRank -> SecurityRank -> SecurityRank
mergeRank TaintState
paramTaints TaintState
taintFromCallers
    in
        TaintState
-> Map AbstractLocation SecurityRankSummaryData
-> [FilePath]
-> SecurityRankState
SecurityRankState TaintState
initialTaintState Map AbstractLocation SecurityRankSummaryData
forall k a. Map k a
Map.empty []




-- | Generates a function summary from the final state of its analysis.
generateSummaryFromState :: SecurityRankContext Text -> SecurityRankState -> CFG Text SecurityRankState -> C.Node (C.Lexeme Text) -> SecurityRankSummaryData
generateSummaryFromState :: SecurityRankContext FunctionName
-> SecurityRankState
-> CFG FunctionName SecurityRankState
-> Node (Lexeme FunctionName)
-> SecurityRankSummaryData
generateSummaryFromState SecurityRankContext FunctionName
ctx SecurityRankState
finalState CFG FunctionName SecurityRankState
finalCfg Node (Lexeme FunctionName)
funcNode =
    let
        funcName :: FunctionName
funcName = Node (Lexeme FunctionName) -> FunctionName
getFuncNameFromDef Node (Lexeme FunctionName)
funcNode
        paramNames :: [FunctionName]
paramNames = Node (Lexeme FunctionName) -> [FunctionName]
getParamNamesFromDef Node (Lexeme FunctionName)
funcNode
        taintState :: TaintState
taintState = SecurityRankState -> TaintState
srsTaintState SecurityRankState
finalState

        -- 1. Handle output parameters by checking the final taint state
        paramOutRanks :: TaintState
paramOutRanks = [(AbstractLocation, SecurityRank)] -> TaintState
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(AbstractLocation, SecurityRank)] -> TaintState)
-> [(AbstractLocation, SecurityRank)] -> TaintState
forall a b. (a -> b) -> a -> b
$ (FunctionName -> Maybe (AbstractLocation, SecurityRank))
-> [FunctionName] -> [(AbstractLocation, SecurityRank)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\FunctionName
pName ->
            let pLoc :: AbstractLocation
pLoc = AbstractLocation -> AbstractLocation
DerefLocation (FunctionName -> AbstractLocation
VarLocation FunctionName
pName)
            in case AbstractLocation -> TaintState -> Maybe SecurityRank
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup AbstractLocation
pLoc TaintState
taintState of
                Just SecurityRank
rank | SecurityRank
rank SecurityRank -> SecurityRank -> Bool
forall a. Ord a => a -> a -> Bool
< SecurityRank
Safe -> (AbstractLocation, SecurityRank)
-> Maybe (AbstractLocation, SecurityRank)
forall a. a -> Maybe a
Just (AbstractLocation
pLoc, SecurityRank
rank)
                Maybe SecurityRank
_                       -> Maybe (AbstractLocation, SecurityRank)
forall a. Maybe a
Nothing
            ) [FunctionName]
paramNames

        -- 2. Handle return value
        returnStmts :: [Node (Lexeme FunctionName)]
returnStmts = Node (Lexeme FunctionName) -> [Node (Lexeme FunctionName)]
findReturnStmts Node (Lexeme FunctionName)
funcNode
        returnedRanks :: [SecurityRank]
returnedRanks = (Node (Lexeme FunctionName) -> SecurityRank)
-> [Node (Lexeme FunctionName)] -> [SecurityRank]
forall a b. (a -> b) -> [a] -> [b]
map (FunctionName
-> CFG FunctionName SecurityRankState
-> Node (Lexeme FunctionName)
-> SecurityRank
evalReturnFromCFG FunctionName
funcName CFG FunctionName SecurityRankState
finalCfg) [Node (Lexeme FunctionName)]
returnStmts
        finalReturnRank :: SecurityRank
finalReturnRank = (SecurityRank -> SecurityRank -> SecurityRank)
-> SecurityRank -> [SecurityRank] -> SecurityRank
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' SecurityRank -> SecurityRank -> SecurityRank
mergeRank SecurityRank
Safe [SecurityRank]
returnedRanks
        returnOutRank :: TaintState
returnOutRank = if SecurityRank
finalReturnRank SecurityRank -> SecurityRank -> Bool
forall a. Ord a => a -> a -> Bool
< SecurityRank
Safe
                        then AbstractLocation -> SecurityRank -> TaintState
forall k a. k -> a -> Map k a
Map.singleton (FunctionName -> AbstractLocation
ReturnLocation FunctionName
funcName) SecurityRank
finalReturnRank
                        else TaintState
forall k a. Map k a
Map.empty

        -- 3. Get summary info from annotations
        funcAnns :: Map FunctionName SecurityRank
funcAnns = Map FunctionName SecurityRank
-> Maybe (Map FunctionName SecurityRank)
-> Map FunctionName SecurityRank
forall a. a -> Maybe a -> a
fromMaybe Map FunctionName SecurityRank
forall k a. Map k a
Map.empty (FunctionName
-> AnnotationMap -> Maybe (Map FunctionName SecurityRank)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FunctionName
funcName (SecurityRankContext FunctionName -> AnnotationMap
forall l. SecurityRankContext l -> AnnotationMap
srcAnnotations SecurityRankContext FunctionName
ctx))
        (TaintState
annotatedOutputRanks, Map Int SecurityRank
annotatedSinks) = ((TaintState, Map Int SecurityRank)
 -> FunctionName
 -> SecurityRank
 -> (TaintState, Map Int SecurityRank))
-> (TaintState, Map Int SecurityRank)
-> Map FunctionName SecurityRank
-> (TaintState, Map Int SecurityRank)
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' (FunctionName
-> [FunctionName]
-> (TaintState, Map Int SecurityRank)
-> FunctionName
-> SecurityRank
-> (TaintState, Map Int SecurityRank)
forall a.
FunctionName
-> [FunctionName]
-> (Map AbstractLocation a, Map Int a)
-> FunctionName
-> a
-> (Map AbstractLocation a, Map Int a)
buildRanksFromAnnotations FunctionName
funcName [FunctionName]
paramNames) (TaintState
forall k a. Map k a
Map.empty, Map Int SecurityRank
forall k a. Map k a
Map.empty) Map FunctionName SecurityRank
funcAnns

        -- 4. Combine analysis results with annotation results
        finalOutputRanks :: TaintState
finalOutputRanks = (SecurityRank -> SecurityRank -> SecurityRank)
-> TaintState -> TaintState -> TaintState
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith SecurityRank -> SecurityRank -> SecurityRank
forall a. Ord a => a -> a -> a
min (TaintState -> TaintState -> TaintState
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union TaintState
paramOutRanks TaintState
returnOutRank) TaintState
annotatedOutputRanks
        sinksFromAnalysis :: Map Int SecurityRank
sinksFromAnalysis = SecurityRankContext FunctionName
-> CFG FunctionName SecurityRankState
-> Node (Lexeme FunctionName)
-> Map Int SecurityRank
findSinksInFunctionBody SecurityRankContext FunctionName
ctx CFG FunctionName SecurityRankState
finalCfg Node (Lexeme FunctionName)
funcNode
        finalSinks :: Map Int SecurityRank
finalSinks = (SecurityRank -> SecurityRank -> SecurityRank)
-> Map Int SecurityRank
-> Map Int SecurityRank
-> Map Int SecurityRank
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith SecurityRank -> SecurityRank -> SecurityRank
forall a. Ord a => a -> a -> a
max Map Int SecurityRank
sinksFromAnalysis Map Int SecurityRank
annotatedSinks

        diagnostics :: [FilePath]
diagnostics = [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub (SecurityRankState -> [FilePath]
srsDiagnostics SecurityRankState
finalState)
        summary :: SecurityRankSummaryData
summary = TaintState
-> Map Int SecurityRank -> [FilePath] -> SecurityRankSummaryData
SecurityRankSummaryData TaintState
finalOutputRanks Map Int SecurityRank
finalSinks [FilePath]
diagnostics
    in
        FilePath -> SecurityRankSummaryData -> SecurityRankSummaryData
forall a. FilePath -> a -> a
dtrace (FilePath
"SecurityRank.generateSummaryFromState (" FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FunctionName -> FilePath
T.unpack FunctionName
funcName FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
")\n  SUMMARY: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> SecurityRankSummaryData -> FilePath
forall a. Show a => a -> FilePath
groom SecurityRankSummaryData
summary) SecurityRankSummaryData
summary
  where
    buildRanksFromAnnotations :: FunctionName
-> [FunctionName]
-> (Map AbstractLocation a, Map Int a)
-> FunctionName
-> a
-> (Map AbstractLocation a, Map Int a)
buildRanksFromAnnotations FunctionName
funcName [FunctionName]
paramNames (Map AbstractLocation a
outs, Map Int a
sinks) FunctionName
key a
rank =
        case FunctionName -> FunctionName -> [FunctionName]
T.splitOn FunctionName
":" FunctionName
key of
            [FunctionName
"source", FunctionName
"return"] ->
                (AbstractLocation
-> a -> Map AbstractLocation a -> Map AbstractLocation a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (FunctionName -> AbstractLocation
ReturnLocation FunctionName
funcName) a
rank Map AbstractLocation a
outs, Map Int a
sinks)
            [FunctionName
"source", FunctionName
paramName] ->
                (AbstractLocation
-> a -> Map AbstractLocation a -> Map AbstractLocation a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (AbstractLocation -> AbstractLocation
DerefLocation (FunctionName -> AbstractLocation
VarLocation FunctionName
paramName)) a
rank Map AbstractLocation a
outs, Map Int a
sinks)
            [FunctionName
"sink", FunctionName
paramName] ->
                case (FunctionName -> Bool) -> [FunctionName] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (FunctionName -> FunctionName -> Bool
forall a. Eq a => a -> a -> Bool
== FunctionName
paramName) [FunctionName]
paramNames of
                    Just Int
i  -> (Map AbstractLocation a
outs, Int -> a -> Map Int a -> Map Int a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Int
i a
rank Map Int a
sinks)
                    Maybe Int
Nothing -> (Map AbstractLocation a
outs, Map Int a
sinks)
            [FunctionName]
_ -> (Map AbstractLocation a
outs, Map Int a
sinks)

    findReturnStmts :: C.Node (C.Lexeme Text) -> [C.Node (C.Lexeme Text)]
    findReturnStmts :: Node (Lexeme FunctionName) -> [Node (Lexeme FunctionName)]
findReturnStmts Node (Lexeme FunctionName)
node = State [Node (Lexeme FunctionName)] ()
-> [Node (Lexeme FunctionName)] -> [Node (Lexeme FunctionName)]
forall s a. State s a -> s -> s
execState (AstActions (State [Node (Lexeme FunctionName)]) FunctionName
-> [(FilePath, [Node (Lexeme FunctionName)])]
-> State [Node (Lexeme FunctionName)] ()
forall text a (f :: * -> *).
(TraverseAst text a, Applicative f) =>
AstActions f text -> a -> f ()
traverseAst AstActions (State [Node (Lexeme FunctionName)]) FunctionName
collector [(FilePath
fakeTestSource, [Node (Lexeme FunctionName)
node])]) []
      where
        collector :: AstActions (State [C.Node (C.Lexeme Text)]) Text
        collector :: AstActions (State [Node (Lexeme FunctionName)]) FunctionName
collector = AstActions (State [Node (Lexeme FunctionName)]) FunctionName
forall (f :: * -> *) text. Applicative f => AstActions f text
astActions
            { doNode :: FilePath
-> Node (Lexeme FunctionName)
-> State [Node (Lexeme FunctionName)] ()
-> State [Node (Lexeme FunctionName)] ()
doNode = \FilePath
_ Node (Lexeme FunctionName)
n State [Node (Lexeme FunctionName)] ()
act -> do
                case Node (Lexeme FunctionName)
-> NodeF (Lexeme FunctionName) (Node (Lexeme FunctionName))
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Node (Lexeme FunctionName)
n of
                    C.Return (Just Node (Lexeme FunctionName)
_) -> ([Node (Lexeme FunctionName)] -> [Node (Lexeme FunctionName)])
-> State [Node (Lexeme FunctionName)] ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Node (Lexeme FunctionName)
n Node (Lexeme FunctionName)
-> [Node (Lexeme FunctionName)] -> [Node (Lexeme FunctionName)]
forall a. a -> [a] -> [a]
:)
                    NodeF (Lexeme FunctionName) (Node (Lexeme FunctionName))
_                 -> () -> State [Node (Lexeme FunctionName)] ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                State [Node (Lexeme FunctionName)] ()
act
            }

    evalReturnFromCFG :: FunctionName -> CFG Text SecurityRankState -> C.Node (C.Lexeme Text) -> SecurityRank
    evalReturnFromCFG :: FunctionName
-> CFG FunctionName SecurityRankState
-> Node (Lexeme FunctionName)
-> SecurityRank
evalReturnFromCFG FunctionName
funcName CFG FunctionName SecurityRankState
cfg stmt :: Node (Lexeme FunctionName)
stmt@(Fix (C.Return (Just Node (Lexeme FunctionName)
expr))) =
        case (CFGNode FunctionName SecurityRankState -> Bool)
-> [CFGNode FunctionName SecurityRankState]
-> Maybe (CFGNode FunctionName SecurityRankState)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\CFGNode FunctionName SecurityRankState
node -> Node (Lexeme FunctionName)
stmt Node (Lexeme FunctionName) -> [Node (Lexeme FunctionName)] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` CFGNode FunctionName SecurityRankState
-> [Node (Lexeme FunctionName)]
forall l a. CFGNode l a -> [Node (Lexeme l)]
cfgStmts CFGNode FunctionName SecurityRankState
node) (CFG FunctionName SecurityRankState
-> [CFGNode FunctionName SecurityRankState]
forall k a. Map k a -> [a]
Map.elems CFG FunctionName SecurityRankState
cfg) of
            Just CFGNode FunctionName SecurityRankState
node ->
                let
                    pctx :: PointsToContext FunctionName
pctx = SecurityRankContext FunctionName -> PointsToContext FunctionName
forall l. SecurityRankContext l -> PointsToContext l
srcPointsToContext SecurityRankContext FunctionName
ctx
                    -- Find the points-to CFG for the current function and context
                    ptsCfg :: CFG FunctionName PointsToState
ptsCfg = CFG FunctionName PointsToState
-> Maybe (CFG FunctionName PointsToState)
-> CFG FunctionName PointsToState
forall a. a -> Maybe a -> a
fromMaybe (CFG FunctionName PointsToState
-> Maybe (CFG FunctionName PointsToState)
-> CFG FunctionName PointsToState
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> CFG FunctionName PointsToState
forall a. HasCallStack => FilePath -> a
error (FilePath -> CFG FunctionName PointsToState)
-> FilePath -> CFG FunctionName PointsToState
forall a b. (a -> b) -> a -> b
$ FilePath
"Points-to CFG not found for func " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FunctionName -> FilePath
T.unpack FunctionName
funcName) ((FunctionName, Context)
-> Map (FunctionName, Context) (CFG FunctionName PointsToState)
-> Maybe (CFG FunctionName PointsToState)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (FunctionName
funcName, []) (PointsToContext FunctionName
-> Map (FunctionName, Context) (CFG FunctionName PointsToState)
forall l.
PointsToContext l
-> Map (FunctionName, Context) (CFG FunctionName PointsToState)
PointsTo.ptcAnalyzedCfgs PointsToContext FunctionName
pctx)))
                           ((FunctionName, Context)
-> Map (FunctionName, Context) (CFG FunctionName PointsToState)
-> Maybe (CFG FunctionName PointsToState)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (FunctionName
funcName, SecurityRankContext FunctionName -> Context
forall l. SecurityRankContext l -> Context
srcCurrentContext SecurityRankContext FunctionName
ctx) (PointsToContext FunctionName
-> Map (FunctionName, Context) (CFG FunctionName PointsToState)
forall l.
PointsToContext l
-> Map (FunctionName, Context) (CFG FunctionName PointsToState)
PointsTo.ptcAnalyzedCfgs PointsToContext FunctionName
pctx))
                    -- Find the corresponding node in the points-to CFG
                    ptNode :: CFGNode FunctionName PointsToState
ptNode = CFGNode FunctionName PointsToState
-> Maybe (CFGNode FunctionName PointsToState)
-> CFGNode FunctionName PointsToState
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> CFGNode FunctionName PointsToState
forall a. HasCallStack => FilePath -> a
error FilePath
"Statement not found in points-to CFG for summary gen") (Maybe (CFGNode FunctionName PointsToState)
 -> CFGNode FunctionName PointsToState)
-> Maybe (CFGNode FunctionName PointsToState)
-> CFGNode FunctionName PointsToState
forall a b. (a -> b) -> a -> b
$
                             (CFGNode FunctionName PointsToState -> Bool)
-> [CFGNode FunctionName PointsToState]
-> Maybe (CFGNode FunctionName PointsToState)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\CFGNode FunctionName PointsToState
n -> Node (Lexeme FunctionName)
stmt Node (Lexeme FunctionName) -> [Node (Lexeme FunctionName)] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` CFGNode FunctionName PointsToState -> [Node (Lexeme FunctionName)]
forall l a. CFGNode l a -> [Node (Lexeme l)]
cfgStmts CFGNode FunctionName PointsToState
n) (CFG FunctionName PointsToState
-> [CFGNode FunctionName PointsToState]
forall k a. Map k a -> [a]
Map.elems CFG FunctionName PointsToState
ptsCfg)
                    -- Use the facts *after* the statement for the rank evaluation
                    ptsMap :: PointsToMap
ptsMap = PointsToState -> PointsToMap
PointsTo.ptsMap (PointsToState -> PointsToMap) -> PointsToState -> PointsToMap
forall a b. (a -> b) -> a -> b
$ CFGNode FunctionName PointsToState -> PointsToState
forall l a. CFGNode l a -> a
cfgOutFacts CFGNode FunctionName PointsToState
ptNode
                in
                    SecurityRankContext FunctionName
-> FunctionName
-> TaintState
-> PointsToMap
-> Node (Lexeme FunctionName)
-> SecurityRank
evalRank SecurityRankContext FunctionName
ctx FunctionName
funcName (SecurityRankState -> TaintState
srsTaintState (CFGNode FunctionName SecurityRankState -> SecurityRankState
forall l a. CFGNode l a -> a
cfgOutFacts CFGNode FunctionName SecurityRankState
node)) PointsToMap
ptsMap Node (Lexeme FunctionName)
expr
            Maybe (CFGNode FunctionName SecurityRankState)
Nothing   -> SecurityRank
Safe -- Should not happen in a well-formed CFG
    evalReturnFromCFG FunctionName
_ CFG FunctionName SecurityRankState
_ Node (Lexeme FunctionName)
_ = SecurityRank
Safe



_getVarNameFromLoc' :: AbstractLocation -> Text
_getVarNameFromLoc' :: AbstractLocation -> FunctionName
_getVarNameFromLoc' (VarLocation FunctionName
n) = FunctionName
n
_getVarNameFromLoc' AbstractLocation
_               = FunctionName
""

getFuncNameFromCall :: PointsTo.PointsToContext Text -> PointsTo.MacroDefinitionMap -> FunctionName -> PointsToMap -> C.Node (C.Lexeme Text) -> [FunctionName]
getFuncNameFromCall :: PointsToContext FunctionName
-> Map FunctionName (Node (Lexeme FunctionName))
-> FunctionName
-> PointsToMap
-> Node (Lexeme FunctionName)
-> [FunctionName]
getFuncNameFromCall PointsToContext FunctionName
pctx Map FunctionName (Node (Lexeme FunctionName))
macroCtx FunctionName
funcName PointsToMap
ptsMap Node (Lexeme FunctionName)
callExpr =
    let (Set AbstractLocation
callees, Set (FunctionName, Context)
_) = Map FunctionName (Node (Lexeme FunctionName))
-> PointsToContext FunctionName
-> Set FunctionName
-> FunctionName
-> PointsToMap
-> Node (Lexeme FunctionName)
-> (Set AbstractLocation, Set (FunctionName, Context))
PointsTo.evalPointsToSet Map FunctionName (Node (Lexeme FunctionName))
macroCtx PointsToContext FunctionName
pctx (PointsToContext FunctionName -> Set FunctionName
forall l. PointsToContext l -> Set FunctionName
PointsTo.ptcLocalVars PointsToContext FunctionName
pctx) FunctionName
funcName PointsToMap
ptsMap Node (Lexeme FunctionName)
callExpr
    in (AbstractLocation -> Maybe FunctionName)
-> [AbstractLocation] -> [FunctionName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe AbstractLocation -> Maybe FunctionName
getFuncNameFromLoc (Set AbstractLocation -> [AbstractLocation]
forall a. Set a -> [a]
Set.toList Set AbstractLocation
callees)

findSinksInFunctionBody :: SecurityRankContext Text -> CFG Text SecurityRankState -> C.Node (C.Lexeme Text) -> Map Int SecurityRank
findSinksInFunctionBody :: SecurityRankContext FunctionName
-> CFG FunctionName SecurityRankState
-> Node (Lexeme FunctionName)
-> Map Int SecurityRank
findSinksInFunctionBody SecurityRankContext FunctionName
ctx CFG FunctionName SecurityRankState
cfg Node (Lexeme FunctionName)
funcDef =
    let
        funcName :: FunctionName
funcName = Node (Lexeme FunctionName) -> FunctionName
getFuncNameFromDef Node (Lexeme FunctionName)
funcDef
        paramNames :: [FunctionName]
paramNames = Node (Lexeme FunctionName) -> [FunctionName]
getParamNamesFromDef Node (Lexeme FunctionName)
funcDef
        pctx' :: PointsToContext FunctionName
pctx' = SecurityRankContext FunctionName -> PointsToContext FunctionName
forall l. SecurityRankContext l -> PointsToContext l
srcPointsToContext SecurityRankContext FunctionName
ctx
        context :: Context
context = SecurityRankContext FunctionName -> Context
forall l. SecurityRankContext l -> Context
srcCurrentContext SecurityRankContext FunctionName
ctx

        -- Get the points-to CFG for the current function and context
        ptsCfg :: CFG FunctionName PointsToState
ptsCfg = CFG FunctionName PointsToState
-> Maybe (CFG FunctionName PointsToState)
-> CFG FunctionName PointsToState
forall a. a -> Maybe a -> a
fromMaybe (CFG FunctionName PointsToState
-> Maybe (CFG FunctionName PointsToState)
-> CFG FunctionName PointsToState
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> CFG FunctionName PointsToState
forall a. HasCallStack => FilePath -> a
error (FilePath -> CFG FunctionName PointsToState)
-> FilePath -> CFG FunctionName PointsToState
forall a b. (a -> b) -> a -> b
$ FilePath
"Points-to CFG not found for func " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FunctionName -> FilePath
T.unpack FunctionName
funcName) ((FunctionName, Context)
-> Map (FunctionName, Context) (CFG FunctionName PointsToState)
-> Maybe (CFG FunctionName PointsToState)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (FunctionName
funcName, []) (PointsToContext FunctionName
-> Map (FunctionName, Context) (CFG FunctionName PointsToState)
forall l.
PointsToContext l
-> Map (FunctionName, Context) (CFG FunctionName PointsToState)
PointsTo.ptcAnalyzedCfgs PointsToContext FunctionName
pctx')))
               ((FunctionName, Context)
-> Map (FunctionName, Context) (CFG FunctionName PointsToState)
-> Maybe (CFG FunctionName PointsToState)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (FunctionName
funcName, Context
context) (PointsToContext FunctionName
-> Map (FunctionName, Context) (CFG FunctionName PointsToState)
forall l.
PointsToContext l
-> Map (FunctionName, Context) (CFG FunctionName PointsToState)
PointsTo.ptcAnalyzedCfgs PointsToContext FunctionName
pctx'))

        allCalls :: [Node (Lexeme FunctionName)]
allCalls = ((Int, CFGNode FunctionName SecurityRankState)
 -> [Node (Lexeme FunctionName)])
-> [(Int, CFGNode FunctionName SecurityRankState)]
-> [Node (Lexeme FunctionName)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (CFGNode FunctionName SecurityRankState
-> [Node (Lexeme FunctionName)]
findCallsInNode (CFGNode FunctionName SecurityRankState
 -> [Node (Lexeme FunctionName)])
-> ((Int, CFGNode FunctionName SecurityRankState)
    -> CFGNode FunctionName SecurityRankState)
-> (Int, CFGNode FunctionName SecurityRankState)
-> [Node (Lexeme FunctionName)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, CFGNode FunctionName SecurityRankState)
-> CFGNode FunctionName SecurityRankState
forall a b. (a, b) -> b
snd) (CFG FunctionName SecurityRankState
-> [(Int, CFGNode FunctionName SecurityRankState)]
forall k a. Map k a -> [(k, a)]
Map.toList CFG FunctionName SecurityRankState
cfg)

        findCallsInNode :: CFGNode Text SecurityRankState -> [C.Node (C.Lexeme Text)]
        findCallsInNode :: CFGNode FunctionName SecurityRankState
-> [Node (Lexeme FunctionName)]
findCallsInNode CFGNode FunctionName SecurityRankState
node = (Node (Lexeme FunctionName) -> Bool)
-> [Node (Lexeme FunctionName)] -> [Node (Lexeme FunctionName)]
forall a. (a -> Bool) -> [a] -> [a]
filter Node (Lexeme FunctionName) -> Bool
forall lexeme. Fix (NodeF lexeme) -> Bool
isCall (CFGNode FunctionName SecurityRankState
-> [Node (Lexeme FunctionName)]
forall l a. CFGNode l a -> [Node (Lexeme l)]
cfgStmts CFGNode FunctionName SecurityRankState
node)
          where isCall :: Fix (NodeF lexeme) -> Bool
isCall (Fix (C.FunctionCall Fix (NodeF lexeme)
_ [Fix (NodeF lexeme)]
_))                    = Bool
True
                isCall (Fix (C.ExprStmt (Fix (C.FunctionCall Fix (NodeF lexeme)
_ [Fix (NodeF lexeme)]
_)))) = Bool
True
                isCall Fix (NodeF lexeme)
_                                             = Bool
False

        getPointsToMapAtStmt :: C.Node (C.Lexeme Text) -> (PointsToMap, PointsTo.MacroDefinitionMap)
        getPointsToMapAtStmt :: Node (Lexeme FunctionName)
-> (PointsToMap, Map FunctionName (Node (Lexeme FunctionName)))
getPointsToMapAtStmt Node (Lexeme FunctionName)
stmt =
            let
                ptNode :: CFGNode FunctionName PointsToState
ptNode = CFGNode FunctionName PointsToState
-> Maybe (CFGNode FunctionName PointsToState)
-> CFGNode FunctionName PointsToState
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> CFGNode FunctionName PointsToState
forall a. HasCallStack => FilePath -> a
error FilePath
"Statement not found in points-to CFG for sink finding") (Maybe (CFGNode FunctionName PointsToState)
 -> CFGNode FunctionName PointsToState)
-> Maybe (CFGNode FunctionName PointsToState)
-> CFGNode FunctionName PointsToState
forall a b. (a -> b) -> a -> b
$
                         (CFGNode FunctionName PointsToState -> Bool)
-> [CFGNode FunctionName PointsToState]
-> Maybe (CFGNode FunctionName PointsToState)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\CFGNode FunctionName PointsToState
n -> Node (Lexeme FunctionName)
stmt Node (Lexeme FunctionName) -> [Node (Lexeme FunctionName)] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` CFGNode FunctionName PointsToState -> [Node (Lexeme FunctionName)]
forall l a. CFGNode l a -> [Node (Lexeme l)]
cfgStmts CFGNode FunctionName PointsToState
n) (CFG FunctionName PointsToState
-> [CFGNode FunctionName PointsToState]
forall k a. Map k a -> [a]
Map.elems CFG FunctionName PointsToState
ptsCfg)
                ptNodeState :: PointsToState
ptNodeState = CFGNode FunctionName PointsToState -> PointsToState
forall l a. CFGNode l a -> a
cfgInFacts CFGNode FunctionName PointsToState
ptNode
            in
                (PointsToState -> PointsToMap
PointsTo.ptsMap PointsToState
ptNodeState, PointsToState -> Map FunctionName (Node (Lexeme FunctionName))
PointsTo.ptsMacros PointsToState
ptNodeState)

        processCall :: C.Node (C.Lexeme Text) -> Map Int SecurityRank
        processCall :: Node (Lexeme FunctionName) -> Map Int SecurityRank
processCall Node (Lexeme FunctionName)
callStmt =
            let
                (Node (Lexeme FunctionName)
callExpr, [Node (Lexeme FunctionName)]
args) = case Node (Lexeme FunctionName)
-> NodeF (Lexeme FunctionName) (Node (Lexeme FunctionName))
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Node (Lexeme FunctionName)
callStmt of
                    C.FunctionCall Node (Lexeme FunctionName)
e [Node (Lexeme FunctionName)]
a -> (Node (Lexeme FunctionName)
e, [Node (Lexeme FunctionName)]
a)
                    C.ExprStmt (Fix (C.FunctionCall Node (Lexeme FunctionName)
e [Node (Lexeme FunctionName)]
a)) -> (Node (Lexeme FunctionName)
e, [Node (Lexeme FunctionName)]
a)
                    NodeF (Lexeme FunctionName) (Node (Lexeme FunctionName))
_ -> FilePath
-> (Node (Lexeme FunctionName), [Node (Lexeme FunctionName)])
forall a. HasCallStack => FilePath -> a
error FilePath
"Unhandled call statement"

                _pctx'' :: PointsToContext FunctionName
_pctx'' = SecurityRankContext FunctionName -> PointsToContext FunctionName
forall l. SecurityRankContext l -> PointsToContext l
srcPointsToContext SecurityRankContext FunctionName
ctx
                (PointsToMap
ptsMap, Map FunctionName (Node (Lexeme FunctionName))
macroMap) = Node (Lexeme FunctionName)
-> (PointsToMap, Map FunctionName (Node (Lexeme FunctionName)))
getPointsToMapAtStmt Node (Lexeme FunctionName)
callStmt
                calleeNames :: [FunctionName]
calleeNames = PointsToContext FunctionName
-> Map FunctionName (Node (Lexeme FunctionName))
-> FunctionName
-> PointsToMap
-> Node (Lexeme FunctionName)
-> [FunctionName]
getFuncNameFromCall PointsToContext FunctionName
pctx' Map FunctionName (Node (Lexeme FunctionName))
macroMap FunctionName
funcName PointsToMap
ptsMap Node (Lexeme FunctionName)
callExpr

                inferredSinks :: Map Int SecurityRank
inferredSinks = (Map Int SecurityRank -> FunctionName -> Map Int SecurityRank)
-> Map Int SecurityRank -> [FunctionName] -> Map Int SecurityRank
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Map Int SecurityRank
accSinks FunctionName
calleeName ->
                    let
                        calleeSummaryMap :: SecurityRankSummary
calleeSummaryMap = SecurityRankSummary
-> Maybe SecurityRankSummary -> SecurityRankSummary
forall a. a -> Maybe a -> a
fromMaybe SecurityRankSummary
forall k a. Map k a
Map.empty (FunctionName
-> Map FunctionName SecurityRankSummary
-> Maybe SecurityRankSummary
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FunctionName
calleeName (SecurityRankContext FunctionName
-> Map FunctionName SecurityRankSummary
forall l.
SecurityRankContext l -> Map FunctionName SecurityRankSummary
srcSummaries SecurityRankContext FunctionName
ctx))
                        -- Important: Use the callee's context-free summary to propagate general sink properties
                        summaryData :: SecurityRankSummaryData
summaryData = SecurityRankSummaryData
-> Maybe SecurityRankSummaryData -> SecurityRankSummaryData
forall a. a -> Maybe a -> a
fromMaybe SecurityRankSummaryData
emptySecurityRankSummaryData (Context -> SecurityRankSummary -> Maybe SecurityRankSummaryData
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [] SecurityRankSummary
calleeSummaryMap)
                        calleeSinks :: Map Int SecurityRank
calleeSinks = SecurityRankSummaryData -> Map Int SecurityRank
srsSinks SecurityRankSummaryData
summaryData

                        newSinks :: Map Int SecurityRank
newSinks = (Map Int SecurityRank
 -> Int -> SecurityRank -> Map Int SecurityRank)
-> Map Int SecurityRank
-> Map Int SecurityRank
-> Map Int SecurityRank
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' (\Map Int SecurityRank
acc Int
calleeParamIndex SecurityRank
sinkRank ->
                            let
                                argExpr :: Node (Lexeme FunctionName)
argExpr = [Node (Lexeme FunctionName)]
args [Node (Lexeme FunctionName)] -> Int -> Node (Lexeme FunctionName)
forall a. [a] -> Int -> a
!! Int
calleeParamIndex
                            in
                                case Node (Lexeme FunctionName)
-> NodeF (Lexeme FunctionName) (Node (Lexeme FunctionName))
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Node (Lexeme FunctionName)
argExpr of
                                    C.VarExpr (C.L AlexPosn
_ LexemeClass
_ FunctionName
argName) ->
                                        case (FunctionName -> Bool) -> [FunctionName] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (FunctionName -> FunctionName -> Bool
forall a. Eq a => a -> a -> Bool
== FunctionName
argName) [FunctionName]
paramNames of
                                            Just Int
callerParamIndex -> (SecurityRank -> SecurityRank -> SecurityRank)
-> Int
-> SecurityRank
-> Map Int SecurityRank
-> Map Int SecurityRank
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith SecurityRank -> SecurityRank -> SecurityRank
forall a. Ord a => a -> a -> a
max Int
callerParamIndex SecurityRank
sinkRank Map Int SecurityRank
acc
                                            Maybe Int
Nothing -> Map Int SecurityRank
acc
                                    NodeF (Lexeme FunctionName) (Node (Lexeme FunctionName))
_ -> Map Int SecurityRank
acc
                          ) Map Int SecurityRank
forall k a. Map k a
Map.empty Map Int SecurityRank
calleeSinks
                    in
                        (SecurityRank -> SecurityRank -> SecurityRank)
-> Map Int SecurityRank
-> Map Int SecurityRank
-> Map Int SecurityRank
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith SecurityRank -> SecurityRank -> SecurityRank
forall a. Ord a => a -> a -> a
max Map Int SecurityRank
accSinks Map Int SecurityRank
newSinks
                  ) Map Int SecurityRank
forall k a. Map k a
Map.empty [FunctionName]
calleeNames
            in
                Map Int SecurityRank
inferredSinks
    in
        (Map Int SecurityRank
 -> Map Int SecurityRank -> Map Int SecurityRank)
-> Map Int SecurityRank
-> [Map Int SecurityRank]
-> Map Int SecurityRank
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((SecurityRank -> SecurityRank -> SecurityRank)
-> Map Int SecurityRank
-> Map Int SecurityRank
-> Map Int SecurityRank
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith SecurityRank -> SecurityRank -> SecurityRank
forall a. Ord a => a -> a -> a
max) Map Int SecurityRank
forall k a. Map k a
Map.empty ((Node (Lexeme FunctionName) -> Map Int SecurityRank)
-> [Node (Lexeme FunctionName)] -> [Map Int SecurityRank]
forall a b. (a -> b) -> [a] -> [b]
map Node (Lexeme FunctionName) -> Map Int SecurityRank
processCall [Node (Lexeme FunctionName)]
allCalls)

-- | Joins two summaries, taking the min rank for each location.
joinSummaries :: SecurityRankSummaryData -> SecurityRankSummaryData -> SecurityRankSummaryData
joinSummaries :: SecurityRankSummaryData
-> SecurityRankSummaryData -> SecurityRankSummaryData
joinSummaries (SecurityRankSummaryData TaintState
a Map Int SecurityRank
b [FilePath]
d1) (SecurityRankSummaryData TaintState
c Map Int SecurityRank
d [FilePath]
d2) =
    TaintState
-> Map Int SecurityRank -> [FilePath] -> SecurityRankSummaryData
SecurityRankSummaryData ((SecurityRank -> SecurityRank -> SecurityRank)
-> TaintState -> TaintState -> TaintState
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith SecurityRank -> SecurityRank -> SecurityRank
forall a. Ord a => a -> a -> a
min TaintState
a TaintState
c) ((SecurityRank -> SecurityRank -> SecurityRank)
-> Map Int SecurityRank
-> Map Int SecurityRank
-> Map Int SecurityRank
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith SecurityRank -> SecurityRank -> SecurityRank
forall a. Ord a => a -> a -> a
min Map Int SecurityRank
b Map Int SecurityRank
d) ([FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub ([FilePath]
d1 [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
d2))

buildSecurityRankSummaryFromAnnotation :: AnnotationMap -> FunctionName -> C.Node (C.Lexeme Text) -> SecurityRankSummary
buildSecurityRankSummaryFromAnnotation :: AnnotationMap
-> FunctionName
-> Node (Lexeme FunctionName)
-> SecurityRankSummary
buildSecurityRankSummaryFromAnnotation AnnotationMap
annotations FunctionName
funcName Node (Lexeme FunctionName)
funcNode =
    let
        funcAnns :: Map FunctionName SecurityRank
funcAnns = Map FunctionName SecurityRank
-> Maybe (Map FunctionName SecurityRank)
-> Map FunctionName SecurityRank
forall a. a -> Maybe a -> a
fromMaybe Map FunctionName SecurityRank
forall k a. Map k a
Map.empty (FunctionName
-> AnnotationMap -> Maybe (Map FunctionName SecurityRank)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FunctionName
funcName AnnotationMap
annotations)
        paramNames :: [FunctionName]
paramNames = Node (Lexeme FunctionName) -> [FunctionName]
getParamNamesFromDef Node (Lexeme FunctionName)
funcNode
        (TaintState
outputRanks, Map Int SecurityRank
sinks) = ((TaintState, Map Int SecurityRank)
 -> FunctionName
 -> SecurityRank
 -> (TaintState, Map Int SecurityRank))
-> (TaintState, Map Int SecurityRank)
-> Map FunctionName SecurityRank
-> (TaintState, Map Int SecurityRank)
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' ([FunctionName]
-> (TaintState, Map Int SecurityRank)
-> FunctionName
-> SecurityRank
-> (TaintState, Map Int SecurityRank)
forall a.
[FunctionName]
-> (Map AbstractLocation a, Map Int a)
-> FunctionName
-> a
-> (Map AbstractLocation a, Map Int a)
buildRanks [FunctionName]
paramNames) (TaintState
forall k a. Map k a
Map.empty, Map Int SecurityRank
forall k a. Map k a
Map.empty) Map FunctionName SecurityRank
funcAnns
    in
        Context -> SecurityRankSummaryData -> SecurityRankSummary
forall k a. k -> a -> Map k a
Map.singleton [] (TaintState
-> Map Int SecurityRank -> [FilePath] -> SecurityRankSummaryData
SecurityRankSummaryData TaintState
outputRanks Map Int SecurityRank
sinks [])
  where
    buildRanks :: [FunctionName]
-> (Map AbstractLocation a, Map Int a)
-> FunctionName
-> a
-> (Map AbstractLocation a, Map Int a)
buildRanks [FunctionName]
paramNames (Map AbstractLocation a
outs, Map Int a
sinks) FunctionName
key a
rank =
        case FunctionName -> FunctionName -> [FunctionName]
T.splitOn FunctionName
":" FunctionName
key of
            [FunctionName
"source", FunctionName
"return"] ->
                (AbstractLocation
-> a -> Map AbstractLocation a -> Map AbstractLocation a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (FunctionName -> AbstractLocation
ReturnLocation FunctionName
funcName) a
rank Map AbstractLocation a
outs, Map Int a
sinks)
            [FunctionName
"source", FunctionName
paramName] ->
                (AbstractLocation
-> a -> Map AbstractLocation a -> Map AbstractLocation a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (AbstractLocation -> AbstractLocation
DerefLocation (FunctionName -> AbstractLocation
VarLocation FunctionName
paramName)) a
rank Map AbstractLocation a
outs, Map Int a
sinks)
            [FunctionName
"sink", FunctionName
paramName] ->
                case (FunctionName -> Bool) -> [FunctionName] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (FunctionName -> FunctionName -> Bool
forall a. Eq a => a -> a -> Bool
== FunctionName
paramName) [FunctionName]
paramNames of
                    Just Int
i  -> (Map AbstractLocation a
outs, Int -> a -> Map Int a -> Map Int a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Int
i a
rank Map Int a
sinks)
                    Maybe Int
Nothing -> (Map AbstractLocation a
outs, Map Int a
sinks)
            [FunctionName
"sink", FunctionName
_callee, FunctionName
"return"] ->
                (Map AbstractLocation a
outs, Map Int a
sinks) -- This case seems incorrect, ignore for now.
            [FunctionName]
_ -> (Map AbstractLocation a
outs, Map Int a
sinks)

-- | The transfer function for a single statement.
transferRank :: SecurityRankContext Text -> FunctionName -> SecurityRankState -> C.Node (C.Lexeme Text) -> (SecurityRankState, Set (FunctionName, Context))
transferRank :: SecurityRankContext FunctionName
-> FunctionName
-> SecurityRankState
-> Node (Lexeme FunctionName)
-> (SecurityRankState, Set (FunctionName, Context))
transferRank SecurityRankContext FunctionName
ctx FunctionName
funcName SecurityRankState
currentState Node (Lexeme FunctionName)
stmt = State (Set (FunctionName, Context)) SecurityRankState
-> Set (FunctionName, Context)
-> (SecurityRankState, Set (FunctionName, Context))
forall s a. State s a -> s -> (a, s)
runState (StateT SecurityRankState (State (Set (FunctionName, Context))) ()
-> SecurityRankState
-> State (Set (FunctionName, Context)) SecurityRankState
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT (SecurityRankContext FunctionName
-> FunctionName
-> Node (Lexeme FunctionName)
-> StateT
     SecurityRankState (State (Set (FunctionName, Context))) ()
transferRank' SecurityRankContext FunctionName
ctx FunctionName
funcName Node (Lexeme FunctionName)
stmt) SecurityRankState
currentState) Set (FunctionName, Context)
forall a. Set a
Set.empty

transferRank' :: SecurityRankContext Text -> FunctionName -> C.Node (C.Lexeme Text) -> StateT SecurityRankState (State (Set (FunctionName, Context))) ()
transferRank' :: SecurityRankContext FunctionName
-> FunctionName
-> Node (Lexeme FunctionName)
-> StateT
     SecurityRankState (State (Set (FunctionName, Context))) ()
transferRank' SecurityRankContext FunctionName
ctx FunctionName
funcName Node (Lexeme FunctionName)
stmt = do
    SecurityRankState
st <- StateT
  SecurityRankState
  (State (Set (FunctionName, Context)))
  SecurityRankState
forall s (m :: * -> *). MonadState s m => m s
get
    let tracePrefix :: FilePath
tracePrefix = FilePath
"SecurityRank.transferRank' (" FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FunctionName -> FilePath
T.unpack FunctionName
funcName FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
", " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Context -> FilePath
forall a. Show a => a -> FilePath
groom (SecurityRankContext FunctionName -> Context
forall l. SecurityRankContext l -> Context
srcCurrentContext SecurityRankContext FunctionName
ctx) FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
")"
    FilePath
-> StateT
     SecurityRankState (State (Set (FunctionName, Context))) ()
forall (m :: * -> *). Monad m => FilePath -> m ()
dtraceM (FilePath
 -> StateT
      SecurityRankState (State (Set (FunctionName, Context))) ())
-> FilePath
-> StateT
     SecurityRankState (State (Set (FunctionName, Context))) ()
forall a b. (a -> b) -> a -> b
$ FilePath
tracePrefix FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
"\n  STMT: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Node (Lexeme FunctionName) -> FilePath
forall a. Show a => a -> FilePath
groom Node (Lexeme FunctionName)
stmt FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
"\n  STATE BEFORE: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> TaintState -> FilePath
forall a. Show a => a -> FilePath
groom (SecurityRankState -> TaintState
srsTaintState SecurityRankState
st)
    NodeF (Lexeme FunctionName) (Node (Lexeme FunctionName))
-> StateT
     SecurityRankState (State (Set (FunctionName, Context))) ()
forall (m :: * -> *) (t :: (* -> *) -> * -> *).
(MonadState (Set (FunctionName, Context)) m,
 MonadState SecurityRankState (t m), MonadTrans t) =>
NodeF (Lexeme FunctionName) (Node (Lexeme FunctionName)) -> t m ()
go (Node (Lexeme FunctionName)
-> NodeF (Lexeme FunctionName) (Node (Lexeme FunctionName))
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Node (Lexeme FunctionName)
stmt)
  where
    nodeId :: NodeId
    nodeId :: Int
nodeId = Node (Lexeme FunctionName) -> Int
forall a. Hashable a => Node a -> Int
C.getNodeId Node (Lexeme FunctionName)
stmt
    pctx :: PointsToContext FunctionName
pctx = (SecurityRankContext FunctionName -> PointsToContext FunctionName
forall l. SecurityRankContext l -> PointsToContext l
srcPointsToContext SecurityRankContext FunctionName
ctx) { ptcCurrentContext :: Context
PointsTo.ptcCurrentContext = SecurityRankContext FunctionName -> Context
forall l. SecurityRankContext l -> Context
srcCurrentContext SecurityRankContext FunctionName
ctx }
    ptsCfg :: CFG FunctionName PointsToState
ptsCfg =
        let analyzedCfgs :: Map (FunctionName, Context) (CFG FunctionName PointsToState)
analyzedCfgs = PointsToContext FunctionName
-> Map (FunctionName, Context) (CFG FunctionName PointsToState)
forall l.
PointsToContext l
-> Map (FunctionName, Context) (CFG FunctionName PointsToState)
PointsTo.ptcAnalyzedCfgs PointsToContext FunctionName
pctx
        in CFG FunctionName PointsToState
-> Maybe (CFG FunctionName PointsToState)
-> CFG FunctionName PointsToState
forall a. a -> Maybe a -> a
fromMaybe (CFG FunctionName PointsToState
-> Maybe (CFG FunctionName PointsToState)
-> CFG FunctionName PointsToState
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> CFG FunctionName PointsToState
forall a. HasCallStack => FilePath -> a
error (FilePath -> CFG FunctionName PointsToState)
-> FilePath -> CFG FunctionName PointsToState
forall a b. (a -> b) -> a -> b
$ FilePath
"Points-to CFG not found for function " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FunctionName -> FilePath
T.unpack FunctionName
funcName FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" in context " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Context -> FilePath
forall a. Show a => a -> FilePath
groom (SecurityRankContext FunctionName -> Context
forall l. SecurityRankContext l -> Context
srcCurrentContext SecurityRankContext FunctionName
ctx)) ((FunctionName, Context)
-> Map (FunctionName, Context) (CFG FunctionName PointsToState)
-> Maybe (CFG FunctionName PointsToState)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (FunctionName
funcName, []) Map (FunctionName, Context) (CFG FunctionName PointsToState)
analyzedCfgs))
           ((FunctionName, Context)
-> Map (FunctionName, Context) (CFG FunctionName PointsToState)
-> Maybe (CFG FunctionName PointsToState)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (FunctionName
funcName, SecurityRankContext FunctionName -> Context
forall l. SecurityRankContext l -> Context
srcCurrentContext SecurityRankContext FunctionName
ctx) Map (FunctionName, Context) (CFG FunctionName PointsToState)
analyzedCfgs)
    ptNode :: CFGNode FunctionName PointsToState
ptNode = CFGNode FunctionName PointsToState
-> Maybe (CFGNode FunctionName PointsToState)
-> CFGNode FunctionName PointsToState
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> CFGNode FunctionName PointsToState
forall a. HasCallStack => FilePath -> a
error FilePath
"Statement not found in points-to CFG") (Maybe (CFGNode FunctionName PointsToState)
 -> CFGNode FunctionName PointsToState)
-> Maybe (CFGNode FunctionName PointsToState)
-> CFGNode FunctionName PointsToState
forall a b. (a -> b) -> a -> b
$
             (CFGNode FunctionName PointsToState -> Bool)
-> [CFGNode FunctionName PointsToState]
-> Maybe (CFGNode FunctionName PointsToState)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\CFGNode FunctionName PointsToState
n -> Node (Lexeme FunctionName)
stmt Node (Lexeme FunctionName) -> [Node (Lexeme FunctionName)] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` CFGNode FunctionName PointsToState -> [Node (Lexeme FunctionName)]
forall l a. CFGNode l a -> [Node (Lexeme l)]
cfgStmts CFGNode FunctionName PointsToState
n) (CFG FunctionName PointsToState
-> [CFGNode FunctionName PointsToState]
forall k a. Map k a -> [a]
Map.elems CFG FunctionName PointsToState
ptsCfg)
    (PointsToMap
ptsMapBefore, Map FunctionName (Node (Lexeme FunctionName))
ptsMacrosBefore) =
        let
            blockStmts :: [Node (Lexeme FunctionName)]
blockStmts = CFGNode FunctionName PointsToState -> [Node (Lexeme FunctionName)]
forall l a. CFGNode l a -> [Node (Lexeme l)]
cfgStmts CFGNode FunctionName PointsToState
ptNode
            inFacts :: PointsToState
inFacts = CFGNode FunctionName PointsToState -> PointsToState
forall l a. CFGNode l a -> a
cfgInFacts CFGNode FunctionName PointsToState
ptNode
            mStmtIndex :: Maybe Int
mStmtIndex = (Node (Lexeme FunctionName) -> Bool)
-> [Node (Lexeme FunctionName)] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (Node (Lexeme FunctionName) -> Node (Lexeme FunctionName) -> Bool
forall a. Eq a => a -> a -> Bool
== Node (Lexeme FunctionName)
stmt) [Node (Lexeme FunctionName)]
blockStmts
        in
            case Maybe Int
mStmtIndex of
                Just Int
stmtIndex ->
                    let
                        stmtsBefore :: [Node (Lexeme FunctionName)]
stmtsBefore = Int -> [Node (Lexeme FunctionName)] -> [Node (Lexeme FunctionName)]
forall a. Int -> [a] -> [a]
take Int
stmtIndex [Node (Lexeme FunctionName)]
blockStmts
                        finalState :: PointsToState
finalState = (PointsToState, Set Any) -> PointsToState
forall a b. (a, b) -> a
fst ((PointsToState, Set Any) -> PointsToState)
-> (PointsToState, Set Any) -> PointsToState
forall a b. (a -> b) -> a -> b
$ ((PointsToState, Set Any)
 -> Node (Lexeme FunctionName) -> (PointsToState, Set Any))
-> (PointsToState, Set Any)
-> [Node (Lexeme FunctionName)]
-> (PointsToState, Set Any)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\(PointsToState
accFacts, Set Any
_) Node (Lexeme FunctionName)
s ->
                            let (PointsToState
newFacts, Set (FunctionName, Context)
_) = PointsToContext FunctionName
-> FunctionName
-> PointsToState
-> Node (Lexeme FunctionName)
-> (PointsToState, Set (FunctionName, Context))
PointsTo.transferPointsToState PointsToContext FunctionName
pctx FunctionName
funcName PointsToState
accFacts Node (Lexeme FunctionName)
s
                            in (PointsToState
newFacts, Set Any
forall a. Set a
Set.empty))
                            (PointsToState
inFacts, Set Any
forall a. Set a
Set.empty) [Node (Lexeme FunctionName)]
stmtsBefore
                    in
                        (PointsToState -> PointsToMap
PointsTo.ptsMap PointsToState
finalState, PointsToState -> Map FunctionName (Node (Lexeme FunctionName))
PointsTo.ptsMacros PointsToState
finalState)
                Maybe Int
Nothing ->
                    FilePath
-> (PointsToMap, Map FunctionName (Node (Lexeme FunctionName)))
forall a. HasCallStack => FilePath -> a
error (FilePath
 -> (PointsToMap, Map FunctionName (Node (Lexeme FunctionName))))
-> FilePath
-> (PointsToMap, Map FunctionName (Node (Lexeme FunctionName)))
forall a b. (a -> b) -> a -> b
$ FilePath
"BUG: Statement not found in its own basic block: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Node (Lexeme FunctionName) -> FilePath
forall a. Show a => a -> FilePath
groom Node (Lexeme FunctionName)
stmt
    ptsMap :: PointsToMap
ptsMap = PointsToMap
ptsMapBefore

    go :: NodeF (Lexeme FunctionName) (Node (Lexeme FunctionName)) -> t m ()
go NodeF (Lexeme FunctionName) (Node (Lexeme FunctionName))
node = case NodeF (Lexeme FunctionName) (Node (Lexeme FunctionName))
node of
        C.ExprStmt Node (Lexeme FunctionName)
expr -> NodeF (Lexeme FunctionName) (Node (Lexeme FunctionName)) -> t m ()
go (Node (Lexeme FunctionName)
-> NodeF (Lexeme FunctionName) (Node (Lexeme FunctionName))
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Node (Lexeme FunctionName)
expr)

        C.AssignExpr Node (Lexeme FunctionName)
lhs AssignOp
C.AopEq rhs :: Node (Lexeme FunctionName)
rhs@(Fix (C.UnaryExpr UnaryOp
C.UopAddress (Fix (C.VarExpr (C.L AlexPosn
_ LexemeClass
_ FunctionName
rhsFuncName)))))
            | FunctionName
-> Map FunctionName (FilePath, Node (Lexeme FunctionName)) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member FunctionName
rhsFuncName (SecurityRankContext FunctionName
-> Map FunctionName (FilePath, Node (Lexeme FunctionName))
forall l.
SecurityRankContext l
-> Map FunctionName (FilePath, Node (Lexeme l))
srcFuncDefs SecurityRankContext FunctionName
ctx) Bool -> Bool -> Bool
|| FunctionName
-> Map FunctionName (FilePath, Node (Lexeme FunctionName)) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member FunctionName
rhsFuncName (SecurityRankContext FunctionName
-> Map FunctionName (FilePath, Node (Lexeme FunctionName))
forall l.
SecurityRankContext l
-> Map FunctionName (FilePath, Node (Lexeme l))
srcFuncDecls SecurityRankContext FunctionName
ctx) -> do
                SecurityRankState
st <- t m SecurityRankState
forall s (m :: * -> *). MonadState s m => m s
get
                FilePath -> t m ()
forall (m :: * -> *). Monad m => FilePath -> m ()
dtraceM (FilePath -> t m ()) -> FilePath -> t m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"  FUNC_PTR_ASSIGN: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FunctionName -> FilePath
T.unpack FunctionName
rhsFuncName
                let lhsLoc :: AbstractLocation
lhsLoc = HasCallStack => Node (Lexeme FunctionName) -> AbstractLocation
Node (Lexeme FunctionName) -> AbstractLocation
toAbstractLocation Node (Lexeme FunctionName)
lhs
                let summaries :: Map FunctionName SecurityRankSummary
summaries = SecurityRankContext FunctionName
-> Map FunctionName SecurityRankSummary
forall l.
SecurityRankContext l -> Map FunctionName SecurityRankSummary
srcSummaries SecurityRankContext FunctionName
ctx
                let rhsSummary :: SecurityRankSummary
rhsSummary = SecurityRankSummary
-> Maybe SecurityRankSummary -> SecurityRankSummary
forall a. a -> Maybe a -> a
fromMaybe SecurityRankSummary
forall k a. Map k a
Map.empty (FunctionName
-> Map FunctionName SecurityRankSummary
-> Maybe SecurityRankSummary
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FunctionName
rhsFuncName Map FunctionName SecurityRankSummary
summaries)
                let rhsSummaryData :: SecurityRankSummaryData
rhsSummaryData = SecurityRankSummaryData
-> Maybe SecurityRankSummaryData -> SecurityRankSummaryData
forall a. a -> Maybe a -> a
fromMaybe SecurityRankSummaryData
emptySecurityRankSummaryData (Context -> SecurityRankSummary -> Maybe SecurityRankSummaryData
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [] SecurityRankSummary
rhsSummary) -- Simplified: assume empty context
                FilePath -> t m ()
forall (m :: * -> *). Monad m => FilePath -> m ()
dtraceM (FilePath -> t m ()) -> FilePath -> t m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"  RHS_SUMMARY: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> SecurityRankSummaryData -> FilePath
forall a. Show a => a -> FilePath
groom SecurityRankSummaryData
rhsSummaryData
                case AbstractLocation
-> Map AbstractLocation SecurityRankSummaryData
-> Maybe SecurityRankSummaryData
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup AbstractLocation
lhsLoc (SecurityRankState -> Map AbstractLocation SecurityRankSummaryData
srsFptrSigs SecurityRankState
st) of
                    Maybe SecurityRankSummaryData
Nothing -> do
                        FilePath -> t m ()
forall (m :: * -> *). Monad m => FilePath -> m ()
dtraceM FilePath
"  FIRST_ASSIGN"
                        (SecurityRankState -> SecurityRankState) -> t m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((SecurityRankState -> SecurityRankState) -> t m ())
-> (SecurityRankState -> SecurityRankState) -> t m ()
forall a b. (a -> b) -> a -> b
$ \SecurityRankState
s -> SecurityRankState
s { srsFptrSigs :: Map AbstractLocation SecurityRankSummaryData
srsFptrSigs = AbstractLocation
-> SecurityRankSummaryData
-> Map AbstractLocation SecurityRankSummaryData
-> Map AbstractLocation SecurityRankSummaryData
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert AbstractLocation
lhsLoc SecurityRankSummaryData
rhsSummaryData (SecurityRankState -> Map AbstractLocation SecurityRankSummaryData
srsFptrSigs SecurityRankState
s) }
                    Just SecurityRankSummaryData
expectedSummary -> do
                        FilePath -> t m ()
forall (m :: * -> *). Monad m => FilePath -> m ()
dtraceM (FilePath -> t m ()) -> FilePath -> t m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"  SUBSEQUENT_ASSIGN, EXPECTED: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> SecurityRankSummaryData -> FilePath
forall a. Show a => a -> FilePath
groom SecurityRankSummaryData
expectedSummary
                        let expectedSinks :: Map Int SecurityRank
expectedSinks = SecurityRankSummaryData -> Map Int SecurityRank
srsSinks SecurityRankSummaryData
expectedSummary
                        let rhsSinks :: Map Int SecurityRank
rhsSinks = SecurityRankSummaryData -> Map Int SecurityRank
srsSinks SecurityRankSummaryData
rhsSummaryData
                        let allIndices :: Context
allIndices = Set Int -> Context
forall a. Set a -> [a]
Set.toList (Set Int -> Set Int -> Set Int
forall a. Ord a => Set a -> Set a -> Set a
Set.union (Map Int SecurityRank -> Set Int
forall k a. Map k a -> Set k
Map.keysSet Map Int SecurityRank
expectedSinks) (Map Int SecurityRank -> Set Int
forall k a. Map k a -> Set k
Map.keysSet Map Int SecurityRank
rhsSinks))

                        Context -> (Int -> t m ()) -> t m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Context
allIndices ((Int -> t m ()) -> t m ()) -> (Int -> t m ()) -> t m ()
forall a b. (a -> b) -> a -> b
$ \Int
i -> do
                            let expectedRank :: SecurityRank
expectedRank = SecurityRank -> Maybe SecurityRank -> SecurityRank
forall a. a -> Maybe a -> a
fromMaybe SecurityRank
Safe (Int -> Map Int SecurityRank -> Maybe SecurityRank
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
i Map Int SecurityRank
expectedSinks)
                            let rhsRank :: SecurityRank
rhsRank = SecurityRank -> Maybe SecurityRank -> SecurityRank
forall a. a -> Maybe a -> a
fromMaybe SecurityRank
Safe (Int -> Map Int SecurityRank -> Maybe SecurityRank
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
i Map Int SecurityRank
rhsSinks)
                            Bool -> t m () -> t m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SecurityRank
rhsRank SecurityRank -> SecurityRank -> Bool
forall a. Ord a => a -> a -> Bool
< SecurityRank
expectedRank) (t m () -> t m ()) -> t m () -> t m ()
forall a b. (a -> b) -> a -> b
$ do
                                let location :: FunctionName
location = FilePath -> Node (Lexeme FunctionName) -> FunctionName
forall a. HasLocation a => FilePath -> a -> FunctionName
C.sloc (SecurityRankContext FunctionName -> FilePath
forall l. SecurityRankContext l -> FilePath
srcCurrentFile SecurityRankContext FunctionName
ctx) Node (Lexeme FunctionName)
stmt
                                    diag :: FilePath
diag = FunctionName -> FilePath
T.unpack FunctionName
location FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
": security risk: incompatible function signature assigned to function pointer; expected sink rank " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ SecurityRank -> FilePath
forall a. Show a => a -> FilePath
show SecurityRank
expectedRank FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" for argument " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
i FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
", but got rank " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ SecurityRank -> FilePath
forall a. Show a => a -> FilePath
show SecurityRank
rhsRank
                                (SecurityRankState -> SecurityRankState) -> t m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((SecurityRankState -> SecurityRankState) -> t m ())
-> (SecurityRankState -> SecurityRankState) -> t m ()
forall a b. (a -> b) -> a -> b
$ \SecurityRankState
s -> SecurityRankState
s { srsDiagnostics :: [FilePath]
srsDiagnostics = SecurityRankState -> [FilePath]
srsDiagnostics SecurityRankState
s [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
diag] }

                        let newSummary :: SecurityRankSummaryData
newSummary = SecurityRankSummaryData
-> SecurityRankSummaryData -> SecurityRankSummaryData
joinSummaries SecurityRankSummaryData
expectedSummary SecurityRankSummaryData
rhsSummaryData
                        (SecurityRankState -> SecurityRankState) -> t m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((SecurityRankState -> SecurityRankState) -> t m ())
-> (SecurityRankState -> SecurityRankState) -> t m ()
forall a b. (a -> b) -> a -> b
$ \SecurityRankState
s -> SecurityRankState
s { srsFptrSigs :: Map AbstractLocation SecurityRankSummaryData
srsFptrSigs = AbstractLocation
-> SecurityRankSummaryData
-> Map AbstractLocation SecurityRankSummaryData
-> Map AbstractLocation SecurityRankSummaryData
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert AbstractLocation
lhsLoc SecurityRankSummaryData
newSummary (SecurityRankState -> Map AbstractLocation SecurityRankSummaryData
srsFptrSigs SecurityRankState
s) }
                let rhsRank :: SecurityRank
rhsRank = SecurityRankContext FunctionName
-> FunctionName
-> TaintState
-> PointsToMap
-> Node (Lexeme FunctionName)
-> SecurityRank
evalRank SecurityRankContext FunctionName
ctx FunctionName
funcName (SecurityRankState -> TaintState
srsTaintState SecurityRankState
st) PointsToMap
ptsMap Node (Lexeme FunctionName)
rhs
                (SecurityRankState -> SecurityRankState) -> t m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((SecurityRankState -> SecurityRankState) -> t m ())
-> (SecurityRankState -> SecurityRankState) -> t m ()
forall a b. (a -> b) -> a -> b
$ \SecurityRankState
s -> SecurityRankState
s { srsTaintState :: TaintState
srsTaintState = AbstractLocation -> SecurityRank -> TaintState -> TaintState
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert AbstractLocation
lhsLoc SecurityRank
rhsRank (SecurityRankState -> TaintState
srsTaintState SecurityRankState
s) }

        C.AssignExpr lhs :: Node (Lexeme FunctionName)
lhs@(Fix (C.ArrayAccess Node (Lexeme FunctionName)
_ Node (Lexeme FunctionName)
_)) AssignOp
C.AopEq Node (Lexeme FunctionName)
rhs -> do
            SecurityRankState
st <- t m SecurityRankState
forall s (m :: * -> *). MonadState s m => m s
get
            let lhsLoc :: AbstractLocation
lhsLoc = HasCallStack => Node (Lexeme FunctionName) -> AbstractLocation
Node (Lexeme FunctionName) -> AbstractLocation
toAbstractLocation Node (Lexeme FunctionName)
lhs
            let rhsRank :: SecurityRank
rhsRank = SecurityRankContext FunctionName
-> FunctionName
-> TaintState
-> PointsToMap
-> Node (Lexeme FunctionName)
-> SecurityRank
evalRank SecurityRankContext FunctionName
ctx FunctionName
funcName (SecurityRankState -> TaintState
srsTaintState SecurityRankState
st) PointsToMap
ptsMap Node (Lexeme FunctionName)
rhs
            FilePath -> t m ()
forall (m :: * -> *). Monad m => FilePath -> m ()
dtraceM (FilePath -> t m ()) -> FilePath -> t m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"  ASSIGN to ArrayAccess. LHS_LOC=" FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> AbstractLocation -> FilePath
forall a. Show a => a -> FilePath
groom AbstractLocation
lhsLoc FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
", RHS_RANK=" FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> SecurityRank -> FilePath
forall a. Show a => a -> FilePath
groom SecurityRank
rhsRank
            (SecurityRankState -> SecurityRankState) -> t m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((SecurityRankState -> SecurityRankState) -> t m ())
-> (SecurityRankState -> SecurityRankState) -> t m ()
forall a b. (a -> b) -> a -> b
$ \SecurityRankState
s -> SecurityRankState
s { srsTaintState :: TaintState
srsTaintState = AbstractLocation -> SecurityRank -> TaintState -> TaintState
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert AbstractLocation
lhsLoc SecurityRank
rhsRank (SecurityRankState -> TaintState
srsTaintState SecurityRankState
s) }


        C.AssignExpr Node (Lexeme FunctionName)
lhs AssignOp
_ rhs :: Node (Lexeme FunctionName)
rhs@(Fix (C.FunctionCall Node (Lexeme FunctionName)
callExpr [Node (Lexeme FunctionName)]
args)) -> do
            SecurityRankState
st <- t m SecurityRankState
forall s (m :: * -> *). MonadState s m => m s
get
            let lhsLoc :: AbstractLocation
lhsLoc = HasCallStack => Node (Lexeme FunctionName) -> AbstractLocation
Node (Lexeme FunctionName) -> AbstractLocation
toAbstractLocation Node (Lexeme FunctionName)
lhs

            -- Process sinks and output parameters for the call
            let (Set AbstractLocation
calleePointsTo, Set (FunctionName, Context)
_) = Map FunctionName (Node (Lexeme FunctionName))
-> PointsToContext FunctionName
-> Set FunctionName
-> FunctionName
-> PointsToMap
-> Node (Lexeme FunctionName)
-> (Set AbstractLocation, Set (FunctionName, Context))
PointsTo.evalPointsToSet Map FunctionName (Node (Lexeme FunctionName))
ptsMacrosBefore PointsToContext FunctionName
pctx (PointsToContext FunctionName -> Set FunctionName
forall l. PointsToContext l -> Set FunctionName
PointsTo.ptcLocalVars PointsToContext FunctionName
pctx) FunctionName
funcName PointsToMap
ptsMap Node (Lexeme FunctionName)
callExpr
            let calleeNames :: [FunctionName]
calleeNames = (AbstractLocation -> Maybe FunctionName)
-> [AbstractLocation] -> [FunctionName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe AbstractLocation -> Maybe FunctionName
getFuncNameFromLoc (Set AbstractLocation -> [AbstractLocation]
forall a. Set a -> [a]
Set.toList Set AbstractLocation
calleePointsTo)
            let newContext :: Context
newContext = Int -> Int -> Context -> Context
pushContext Int
kLimit Int
nodeId (SecurityRankContext FunctionName -> Context
forall l. SecurityRankContext l -> Context
srcCurrentContext SecurityRankContext FunctionName
ctx)

            -- Use foldM to correctly thread the state when processing multiple callees
            SecurityRankState
stAfterCallees <- (SecurityRankState -> FunctionName -> t m SecurityRankState)
-> SecurityRankState -> [FunctionName] -> t m SecurityRankState
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\SecurityRankState
currentState FunctionName
calleeName -> do
                m () -> t m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> t m ()) -> m () -> t m ()
forall a b. (a -> b) -> a -> b
$ (Set (FunctionName, Context) -> Set (FunctionName, Context))
-> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((FunctionName, Context)
-> Set (FunctionName, Context) -> Set (FunctionName, Context)
forall a. Ord a => a -> Set a -> Set a
Set.insert (FunctionName
calleeName, Context
newContext))
                let calleeSummary :: SecurityRankSummary
calleeSummary = SecurityRankSummary
-> Maybe SecurityRankSummary -> SecurityRankSummary
forall a. a -> Maybe a -> a
fromMaybe SecurityRankSummary
forall k a. Map k a
Map.empty (FunctionName
-> Map FunctionName SecurityRankSummary
-> Maybe SecurityRankSummary
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FunctionName
calleeName (SecurityRankContext FunctionName
-> Map FunctionName SecurityRankSummary
forall l.
SecurityRankContext l -> Map FunctionName SecurityRankSummary
srcSummaries SecurityRankContext FunctionName
ctx))
                let summaryForContext :: Maybe SecurityRankSummaryData
summaryForContext = Context -> SecurityRankSummary -> Maybe SecurityRankSummaryData
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Context
newContext SecurityRankSummary
calleeSummary
                let summaryForEmpty :: Maybe SecurityRankSummaryData
summaryForEmpty = Context -> SecurityRankSummary -> Maybe SecurityRankSummaryData
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [] SecurityRankSummary
calleeSummary
                let summaryData :: SecurityRankSummaryData
summaryData = SecurityRankSummaryData
-> Maybe SecurityRankSummaryData -> SecurityRankSummaryData
forall a. a -> Maybe a -> a
fromMaybe (SecurityRankSummaryData
-> Maybe SecurityRankSummaryData -> SecurityRankSummaryData
forall a. a -> Maybe a -> a
fromMaybe SecurityRankSummaryData
emptySecurityRankSummaryData Maybe SecurityRankSummaryData
summaryForEmpty) Maybe SecurityRankSummaryData
summaryForContext

                -- Check sinks using the state from *before* this specific call
                let diags :: [FilePath]
diags = ((Int, SecurityRank) -> Maybe FilePath)
-> [(Int, SecurityRank)] -> [FilePath]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (SecurityRankState
-> FunctionName
-> Node (Lexeme FunctionName)
-> [Node (Lexeme FunctionName)]
-> PointsToMap
-> (Int, SecurityRank)
-> Maybe FilePath
forall a p p.
Show a =>
SecurityRankState
-> p
-> a
-> [Node (Lexeme FunctionName)]
-> p
-> (Int, SecurityRank)
-> Maybe FilePath
checkSinkViolation SecurityRankState
st FunctionName
funcName Node (Lexeme FunctionName)
callExpr [Node (Lexeme FunctionName)]
args PointsToMap
ptsMapBefore) (Map Int SecurityRank -> [(Int, SecurityRank)]
forall k a. Map k a -> [(k, a)]
Map.toList (SecurityRankSummaryData -> Map Int SecurityRank
srsSinks SecurityRankSummaryData
summaryData))

                -- Apply output taints from the summary
                let newTaintState :: TaintState
newTaintState = SecurityRankState
-> [Node (Lexeme FunctionName)]
-> FunctionName
-> SecurityRankSummaryData
-> TaintState
applySummaryTaints SecurityRankState
currentState [Node (Lexeme FunctionName)]
args FunctionName
calleeName SecurityRankSummaryData
summaryData
                SecurityRankState -> t m SecurityRankState
forall (m :: * -> *) a. Monad m => a -> m a
return (SecurityRankState -> t m SecurityRankState)
-> SecurityRankState -> t m SecurityRankState
forall a b. (a -> b) -> a -> b
$ SecurityRankState
currentState { srsTaintState :: TaintState
srsTaintState = TaintState
newTaintState, srsDiagnostics :: [FilePath]
srsDiagnostics = SecurityRankState -> [FilePath]
srsDiagnostics SecurityRankState
currentState [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
diags }
              ) SecurityRankState
st [FunctionName]
calleeNames

            -- Now that the state is updated, evaluate the rank of the RHS (the return value)
            let rhsRank :: SecurityRank
rhsRank = SecurityRankContext FunctionName
-> FunctionName
-> TaintState
-> PointsToMap
-> Node (Lexeme FunctionName)
-> SecurityRank
evalRank SecurityRankContext FunctionName
ctx FunctionName
funcName (SecurityRankState -> TaintState
srsTaintState SecurityRankState
stAfterCallees) PointsToMap
ptsMapBefore Node (Lexeme FunctionName)
rhs
            FilePath -> t m ()
forall (m :: * -> *). Monad m => FilePath -> m ()
dtraceM (FilePath -> t m ()) -> FilePath -> t m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"  ASSIGN from FunctionCall. LHS_LOC=" FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> AbstractLocation -> FilePath
forall a. Show a => a -> FilePath
groom AbstractLocation
lhsLoc FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
", RHS_RANK=" FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> SecurityRank -> FilePath
forall a. Show a => a -> FilePath
groom SecurityRank
rhsRank

            -- And finally, update the state with the assignment
            SecurityRankState -> t m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (SecurityRankState -> t m ()) -> SecurityRankState -> t m ()
forall a b. (a -> b) -> a -> b
$ SecurityRankState
stAfterCallees { srsTaintState :: TaintState
srsTaintState = AbstractLocation -> SecurityRank -> TaintState -> TaintState
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert AbstractLocation
lhsLoc SecurityRank
rhsRank (SecurityRankState -> TaintState
srsTaintState SecurityRankState
stAfterCallees) }

        C.AssignExpr Node (Lexeme FunctionName)
lhs AssignOp
_ Node (Lexeme FunctionName)
rhs -> do
            SecurityRankState
st <- t m SecurityRankState
forall s (m :: * -> *). MonadState s m => m s
get
            let lhsLoc :: AbstractLocation
lhsLoc = HasCallStack => Node (Lexeme FunctionName) -> AbstractLocation
Node (Lexeme FunctionName) -> AbstractLocation
toAbstractLocation Node (Lexeme FunctionName)
lhs
            let rhsRank :: SecurityRank
rhsRank = SecurityRankContext FunctionName
-> FunctionName
-> TaintState
-> PointsToMap
-> Node (Lexeme FunctionName)
-> SecurityRank
evalRank SecurityRankContext FunctionName
ctx FunctionName
funcName (SecurityRankState -> TaintState
srsTaintState SecurityRankState
st) PointsToMap
ptsMapBefore Node (Lexeme FunctionName)
rhs
            FilePath -> t m ()
forall (m :: * -> *). Monad m => FilePath -> m ()
dtraceM (FilePath -> t m ()) -> FilePath -> t m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"  ASSIGN generic. LHS_LOC=" FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> AbstractLocation -> FilePath
forall a. Show a => a -> FilePath
groom AbstractLocation
lhsLoc FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
", RHS_RANK=" FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> SecurityRank -> FilePath
forall a. Show a => a -> FilePath
groom SecurityRank
rhsRank
            let newState :: TaintState
newState =
                    case Node (Lexeme FunctionName)
lhs of
                        Fix (C.MemberAccess Node (Lexeme FunctionName)
base Lexeme FunctionName
_) ->
                            let baseType :: Maybe a
baseType = Maybe a
forall a. Maybe a
Nothing -- Placeholder for type lookup
                            in case Maybe (NodeF Any Any)
forall a. Maybe a
baseType of
                                Just (C.TyUnion Any
_) ->
                                    let unionMembers :: [FunctionName]
unionMembers = [FunctionName
"tainted_member", FunctionName
"other_member"] -- Placeholder
                                    in (TaintState -> FunctionName -> TaintState)
-> TaintState -> [FunctionName] -> TaintState
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\TaintState
s FunctionName
member -> AbstractLocation -> SecurityRank -> TaintState -> TaintState
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (AbstractLocation -> FunctionName -> AbstractLocation
FieldLocation (HasCallStack => Node (Lexeme FunctionName) -> AbstractLocation
Node (Lexeme FunctionName) -> AbstractLocation
toAbstractLocation Node (Lexeme FunctionName)
base) FunctionName
member) SecurityRank
rhsRank TaintState
s)
                                              (SecurityRankState -> TaintState
srsTaintState SecurityRankState
st)
                                              [FunctionName]
unionMembers
                                Maybe (NodeF Any Any)
_ -> AbstractLocation -> SecurityRank -> TaintState -> TaintState
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert AbstractLocation
lhsLoc SecurityRank
rhsRank (SecurityRankState -> TaintState
srsTaintState SecurityRankState
st)
                        Node (Lexeme FunctionName)
_ -> AbstractLocation -> SecurityRank -> TaintState -> TaintState
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert AbstractLocation
lhsLoc SecurityRank
rhsRank (SecurityRankState -> TaintState
srsTaintState SecurityRankState
st)
            (SecurityRankState -> SecurityRankState) -> t m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((SecurityRankState -> SecurityRankState) -> t m ())
-> (SecurityRankState -> SecurityRankState) -> t m ()
forall a b. (a -> b) -> a -> b
$ \SecurityRankState
s -> SecurityRankState
s { srsTaintState :: TaintState
srsTaintState = TaintState
newState }

        C.VarDeclStmt (Fix (C.VarDecl Node (Lexeme FunctionName)
_ (C.L AlexPosn
_ LexemeClass
_ FunctionName
varName) [Node (Lexeme FunctionName)]
_)) (Just Node (Lexeme FunctionName)
initializer) -> do
            SecurityRankState
st <- t m SecurityRankState
forall s (m :: * -> *). MonadState s m => m s
get
            let varLoc :: AbstractLocation
varLoc = FunctionName -> AbstractLocation
VarLocation FunctionName
varName

            -- Special handling for function calls to propagate taint from summaries
            let finalRank :: SecurityRank
finalRank = case Node (Lexeme FunctionName)
-> NodeF (Lexeme FunctionName) (Node (Lexeme FunctionName))
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Node (Lexeme FunctionName)
initializer of
                    C.FunctionCall Node (Lexeme FunctionName)
callExpr [Node (Lexeme FunctionName)]
args ->
                        let
                            (Set AbstractLocation
calleePointsTo, Set (FunctionName, Context)
_) = Map FunctionName (Node (Lexeme FunctionName))
-> PointsToContext FunctionName
-> Set FunctionName
-> FunctionName
-> PointsToMap
-> Node (Lexeme FunctionName)
-> (Set AbstractLocation, Set (FunctionName, Context))
PointsTo.evalPointsToSet Map FunctionName (Node (Lexeme FunctionName))
ptsMacrosBefore PointsToContext FunctionName
pctx (PointsToContext FunctionName -> Set FunctionName
forall l. PointsToContext l -> Set FunctionName
PointsTo.ptcLocalVars PointsToContext FunctionName
pctx) FunctionName
funcName PointsToMap
ptsMapBefore Node (Lexeme FunctionName)
callExpr
                            calleeNames :: [FunctionName]
calleeNames = (AbstractLocation -> Maybe FunctionName)
-> [AbstractLocation] -> [FunctionName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe AbstractLocation -> Maybe FunctionName
getFuncNameFromLoc (Set AbstractLocation -> [AbstractLocation]
forall a. Set a -> [a]
Set.toList Set AbstractLocation
calleePointsTo)
                            newContext :: Context
newContext = Int -> Int -> Context -> Context
pushContext Int
kLimit (Node (Lexeme FunctionName) -> Int
forall a. Hashable a => Node a -> Int
C.getNodeId Node (Lexeme FunctionName)
initializer) (SecurityRankContext FunctionName -> Context
forall l. SecurityRankContext l -> Context
srcCurrentContext SecurityRankContext FunctionName
ctx)
                        in
                            (SecurityRank -> FunctionName -> SecurityRank)
-> SecurityRank -> [FunctionName] -> SecurityRank
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\SecurityRank
currentRank FunctionName
calleeName ->
                                let
                                    calleeSummaryMap :: SecurityRankSummary
calleeSummaryMap = SecurityRankSummary
-> Maybe SecurityRankSummary -> SecurityRankSummary
forall a. a -> Maybe a -> a
fromMaybe SecurityRankSummary
forall k a. Map k a
Map.empty (FunctionName
-> Map FunctionName SecurityRankSummary
-> Maybe SecurityRankSummary
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FunctionName
calleeName (SecurityRankContext FunctionName
-> Map FunctionName SecurityRankSummary
forall l.
SecurityRankContext l -> Map FunctionName SecurityRankSummary
srcSummaries SecurityRankContext FunctionName
ctx))
                                    summaryForContext :: Maybe SecurityRankSummaryData
summaryForContext = Context -> SecurityRankSummary -> Maybe SecurityRankSummaryData
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Context
newContext SecurityRankSummary
calleeSummaryMap
                                    summaryForEmpty :: Maybe SecurityRankSummaryData
summaryForEmpty = Context -> SecurityRankSummary -> Maybe SecurityRankSummaryData
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [] SecurityRankSummary
calleeSummaryMap
                                    summaryData :: SecurityRankSummaryData
summaryData = SecurityRankSummaryData
-> Maybe SecurityRankSummaryData -> SecurityRankSummaryData
forall a. a -> Maybe a -> a
fromMaybe (SecurityRankSummaryData
-> Maybe SecurityRankSummaryData -> SecurityRankSummaryData
forall a. a -> Maybe a -> a
fromMaybe SecurityRankSummaryData
emptySecurityRankSummaryData Maybe SecurityRankSummaryData
summaryForEmpty) Maybe SecurityRankSummaryData
summaryForContext
                                    (FilePath
_, Node (Lexeme FunctionName)
calleeDecl) = (FilePath, Node (Lexeme FunctionName))
-> Maybe (FilePath, Node (Lexeme FunctionName))
-> (FilePath, Node (Lexeme FunctionName))
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> (FilePath, Node (Lexeme FunctionName))
forall a. HasCallStack => FilePath -> a
error (FilePath -> (FilePath, Node (Lexeme FunctionName)))
-> FilePath -> (FilePath, Node (Lexeme FunctionName))
forall a b. (a -> b) -> a -> b
$ FilePath
"Function not found: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FunctionName -> FilePath
T.unpack FunctionName
calleeName) (FunctionName
-> Map FunctionName (FilePath, Node (Lexeme FunctionName))
-> Maybe (FilePath, Node (Lexeme FunctionName))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FunctionName
calleeName (SecurityRankContext FunctionName
-> Map FunctionName (FilePath, Node (Lexeme FunctionName))
forall l.
SecurityRankContext l
-> Map FunctionName (FilePath, Node (Lexeme l))
srcFuncDecls SecurityRankContext FunctionName
ctx))
                                    paramNames :: [FunctionName]
paramNames = Node (Lexeme FunctionName) -> [FunctionName]
getParamNamesFromDef Node (Lexeme FunctionName)
calleeDecl
                                    argRanks :: [SecurityRank]
argRanks = (Node (Lexeme FunctionName) -> SecurityRank)
-> [Node (Lexeme FunctionName)] -> [SecurityRank]
forall a b. (a -> b) -> [a] -> [b]
map (SecurityRankContext FunctionName
-> FunctionName
-> TaintState
-> PointsToMap
-> Node (Lexeme FunctionName)
-> SecurityRank
evalRank SecurityRankContext FunctionName
ctx FunctionName
funcName (SecurityRankState -> TaintState
srsTaintState SecurityRankState
st) PointsToMap
ptsMapBefore) [Node (Lexeme FunctionName)]
args
                                    substMap :: TaintState
substMap = [(AbstractLocation, SecurityRank)] -> TaintState
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(AbstractLocation, SecurityRank)] -> TaintState)
-> [(AbstractLocation, SecurityRank)] -> TaintState
forall a b. (a -> b) -> a -> b
$ [AbstractLocation]
-> [SecurityRank] -> [(AbstractLocation, SecurityRank)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((FunctionName -> AbstractLocation)
-> [FunctionName] -> [AbstractLocation]
forall a b. (a -> b) -> [a] -> [b]
map FunctionName -> AbstractLocation
VarLocation [FunctionName]
paramNames) [SecurityRank]
argRanks
                                    substitute :: AbstractLocation -> SecurityRank
substitute AbstractLocation
loc = SecurityRank -> Maybe SecurityRank -> SecurityRank
forall a. a -> Maybe a -> a
fromMaybe SecurityRank
Safe (AbstractLocation -> TaintState -> Maybe SecurityRank
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup AbstractLocation
loc TaintState
substMap)

                                    summaryRank :: SecurityRank
summaryRank = (SecurityRank -> (AbstractLocation, SecurityRank) -> SecurityRank)
-> SecurityRank
-> [(AbstractLocation, SecurityRank)]
-> SecurityRank
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\SecurityRank
acc (AbstractLocation
outLoc, SecurityRank
outRank) ->
                                        case AbstractLocation
outLoc of
                                            ReturnLocation FunctionName
_ -> SecurityRank -> SecurityRank -> SecurityRank
forall a. Ord a => a -> a -> a
min SecurityRank
acc SecurityRank
outRank
                                            DerefLocation (VarLocation FunctionName
pName) ->
                                                SecurityRank -> SecurityRank -> SecurityRank
forall a. Ord a => a -> a -> a
min SecurityRank
acc (AbstractLocation -> SecurityRank
substitute (FunctionName -> AbstractLocation
VarLocation FunctionName
pName))
                                            AbstractLocation
_ -> SecurityRank
acc
                                        ) SecurityRank
Safe (TaintState -> [(AbstractLocation, SecurityRank)]
forall k a. Map k a -> [(k, a)]
Map.toList (SecurityRankSummaryData -> TaintState
srsOutputRanks SecurityRankSummaryData
summaryData))
                                in
                                    SecurityRank -> SecurityRank -> SecurityRank
forall a. Ord a => a -> a -> a
min SecurityRank
currentRank SecurityRank
summaryRank
                            ) SecurityRank
Safe [FunctionName]
calleeNames
                    NodeF (Lexeme FunctionName) (Node (Lexeme FunctionName))
_ -> SecurityRankContext FunctionName
-> FunctionName
-> TaintState
-> PointsToMap
-> Node (Lexeme FunctionName)
-> SecurityRank
evalRank SecurityRankContext FunctionName
ctx FunctionName
funcName (SecurityRankState -> TaintState
srsTaintState SecurityRankState
st) PointsToMap
ptsMapBefore Node (Lexeme FunctionName)
initializer

            FilePath -> t m ()
forall (m :: * -> *). Monad m => FilePath -> m ()
dtraceM (FilePath -> t m ()) -> FilePath -> t m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"  VAR_DECL. VAR_LOC=" FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> AbstractLocation -> FilePath
forall a. Show a => a -> FilePath
groom AbstractLocation
varLoc FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
", RHS_RANK=" FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> SecurityRank -> FilePath
forall a. Show a => a -> FilePath
groom SecurityRank
finalRank
            (SecurityRankState -> SecurityRankState) -> t m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((SecurityRankState -> SecurityRankState) -> t m ())
-> (SecurityRankState -> SecurityRankState) -> t m ()
forall a b. (a -> b) -> a -> b
$ \SecurityRankState
s -> SecurityRankState
s { srsTaintState :: TaintState
srsTaintState = AbstractLocation -> SecurityRank -> TaintState -> TaintState
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert AbstractLocation
varLoc SecurityRank
finalRank (SecurityRankState -> TaintState
srsTaintState SecurityRankState
s) }

        C.FunctionCall Node (Lexeme FunctionName)
callExpr [Node (Lexeme FunctionName)]
args -> do
            SecurityRankState
st <- t m SecurityRankState
forall s (m :: * -> *). MonadState s m => m s
get
            FilePath -> t m ()
forall (m :: * -> *). Monad m => FilePath -> m ()
dtraceM (FilePath -> t m ()) -> FilePath -> t m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"  FUNCTION_CALL: STMT: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Node (Lexeme FunctionName) -> FilePath
forall a. Show a => a -> FilePath
groom Node (Lexeme FunctionName)
stmt
            FilePath -> t m ()
forall (m :: * -> *). Monad m => FilePath -> m ()
dtraceM (FilePath -> t m ()) -> FilePath -> t m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"  CONTEXT: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Context -> FilePath
forall a. Show a => a -> FilePath
groom (SecurityRankContext FunctionName -> Context
forall l. SecurityRankContext l -> Context
srcCurrentContext SecurityRankContext FunctionName
ctx) FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
"\n  PTS_CFG InFacts: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> PointsToState -> FilePath
forall a. Show a => a -> FilePath
groom (CFGNode FunctionName PointsToState -> PointsToState
forall l a. CFGNode l a -> a
cfgInFacts CFGNode FunctionName PointsToState
ptNode) FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
"\n  PTS_MAP before evalPointsToSet: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> PointsToMap -> FilePath
forall a. Show a => a -> FilePath
groom PointsToMap
ptsMapBefore
            let (Set AbstractLocation
calleePointsTo, Set (FunctionName, Context)
_) = Map FunctionName (Node (Lexeme FunctionName))
-> PointsToContext FunctionName
-> Set FunctionName
-> FunctionName
-> PointsToMap
-> Node (Lexeme FunctionName)
-> (Set AbstractLocation, Set (FunctionName, Context))
PointsTo.evalPointsToSet Map FunctionName (Node (Lexeme FunctionName))
ptsMacrosBefore PointsToContext FunctionName
pctx (PointsToContext FunctionName -> Set FunctionName
forall l. PointsToContext l -> Set FunctionName
PointsTo.ptcLocalVars PointsToContext FunctionName
pctx) FunctionName
funcName PointsToMap
ptsMapBefore Node (Lexeme FunctionName)
callExpr
            let calleeNames :: [FunctionName]
calleeNames = (AbstractLocation -> Maybe FunctionName)
-> [AbstractLocation] -> [FunctionName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe AbstractLocation -> Maybe FunctionName
getFuncNameFromLoc (Set AbstractLocation -> [AbstractLocation]
forall a. Set a -> [a]
Set.toList Set AbstractLocation
calleePointsTo)
            FilePath -> t m ()
forall (m :: * -> *). Monad m => FilePath -> m ()
dtraceM (FilePath -> t m ()) -> FilePath -> t m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"  FUNCTION_CALL: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Node (Lexeme FunctionName) -> FilePath
forall a. Show a => a -> FilePath
groom Node (Lexeme FunctionName)
callExpr FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" -> " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> [FunctionName] -> FilePath
forall a. Show a => a -> FilePath
groom [FunctionName]
calleeNames
            let newContext :: Context
newContext = Int -> Int -> Context -> Context
pushContext Int
kLimit Int
nodeId (SecurityRankContext FunctionName -> Context
forall l. SecurityRankContext l -> Context
srcCurrentContext SecurityRankContext FunctionName
ctx)

            -- Use foldM to correctly thread the state when processing multiple callees
            SecurityRankState
stAfterCallees <- (SecurityRankState -> FunctionName -> t m SecurityRankState)
-> SecurityRankState -> [FunctionName] -> t m SecurityRankState
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\SecurityRankState
currentState FunctionName
calleeName -> do
                m () -> t m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> t m ()) -> m () -> t m ()
forall a b. (a -> b) -> a -> b
$ (Set (FunctionName, Context) -> Set (FunctionName, Context))
-> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((FunctionName, Context)
-> Set (FunctionName, Context) -> Set (FunctionName, Context)
forall a. Ord a => a -> Set a -> Set a
Set.insert (FunctionName
calleeName, Context
newContext))
                let calleeSummary :: SecurityRankSummary
calleeSummary = SecurityRankSummary
-> Maybe SecurityRankSummary -> SecurityRankSummary
forall a. a -> Maybe a -> a
fromMaybe SecurityRankSummary
forall k a. Map k a
Map.empty (FunctionName
-> Map FunctionName SecurityRankSummary
-> Maybe SecurityRankSummary
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FunctionName
calleeName (SecurityRankContext FunctionName
-> Map FunctionName SecurityRankSummary
forall l.
SecurityRankContext l -> Map FunctionName SecurityRankSummary
srcSummaries SecurityRankContext FunctionName
ctx))
                let summaryForContext :: Maybe SecurityRankSummaryData
summaryForContext = Context -> SecurityRankSummary -> Maybe SecurityRankSummaryData
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Context
newContext SecurityRankSummary
calleeSummary
                let summaryForEmpty :: Maybe SecurityRankSummaryData
summaryForEmpty = Context -> SecurityRankSummary -> Maybe SecurityRankSummaryData
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [] SecurityRankSummary
calleeSummary
                let summaryData :: SecurityRankSummaryData
summaryData = SecurityRankSummaryData
-> Maybe SecurityRankSummaryData -> SecurityRankSummaryData
forall a. a -> Maybe a -> a
fromMaybe (SecurityRankSummaryData
-> Maybe SecurityRankSummaryData -> SecurityRankSummaryData
forall a. a -> Maybe a -> a
fromMaybe SecurityRankSummaryData
emptySecurityRankSummaryData Maybe SecurityRankSummaryData
summaryForEmpty) Maybe SecurityRankSummaryData
summaryForContext
                FilePath -> t m ()
forall (m :: * -> *). Monad m => FilePath -> m ()
dtraceM (FilePath -> t m ()) -> FilePath -> t m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"  SUMMARY for " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FunctionName -> FilePath
T.unpack FunctionName
calleeName FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
": " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> SecurityRankSummaryData -> FilePath
forall a. Show a => a -> FilePath
groom SecurityRankSummaryData
summaryData

                -- Check sinks using the state from *before* this specific call
                let diags :: [FilePath]
diags = ((Int, SecurityRank) -> Maybe FilePath)
-> [(Int, SecurityRank)] -> [FilePath]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (SecurityRankState
-> FunctionName
-> Node (Lexeme FunctionName)
-> [Node (Lexeme FunctionName)]
-> PointsToMap
-> (Int, SecurityRank)
-> Maybe FilePath
forall a p p.
Show a =>
SecurityRankState
-> p
-> a
-> [Node (Lexeme FunctionName)]
-> p
-> (Int, SecurityRank)
-> Maybe FilePath
checkSinkViolation SecurityRankState
st FunctionName
funcName Node (Lexeme FunctionName)
callExpr [Node (Lexeme FunctionName)]
args PointsToMap
ptsMapBefore) (Map Int SecurityRank -> [(Int, SecurityRank)]
forall k a. Map k a -> [(k, a)]
Map.toList (SecurityRankSummaryData -> Map Int SecurityRank
srsSinks SecurityRankSummaryData
summaryData))

                -- Apply output taints from the summary
                let newTaintState :: TaintState
newTaintState = SecurityRankState
-> [Node (Lexeme FunctionName)]
-> FunctionName
-> SecurityRankSummaryData
-> TaintState
applySummaryTaints SecurityRankState
currentState [Node (Lexeme FunctionName)]
args FunctionName
calleeName SecurityRankSummaryData
summaryData
                FilePath -> t m ()
forall (m :: * -> *). Monad m => FilePath -> m ()
dtraceM (FilePath -> t m ()) -> FilePath -> t m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"  TAINT_STATE after summary: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> TaintState -> FilePath
forall a. Show a => a -> FilePath
groom TaintState
newTaintState
                SecurityRankState -> t m SecurityRankState
forall (m :: * -> *) a. Monad m => a -> m a
return (SecurityRankState -> t m SecurityRankState)
-> SecurityRankState -> t m SecurityRankState
forall a b. (a -> b) -> a -> b
$ SecurityRankState
currentState { srsTaintState :: TaintState
srsTaintState = TaintState
newTaintState, srsDiagnostics :: [FilePath]
srsDiagnostics = SecurityRankState -> [FilePath]
srsDiagnostics SecurityRankState
currentState [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
diags }
              ) SecurityRankState
st [FunctionName]
calleeNames
            SecurityRankState -> t m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put SecurityRankState
stAfterCallees

        C.Return (Just Node (Lexeme FunctionName)
expr) -> do
            SecurityRankState
st <- t m SecurityRankState
forall s (m :: * -> *). MonadState s m => m s
get
            let returnRank :: SecurityRank
returnRank = SecurityRankContext FunctionName
-> FunctionName
-> TaintState
-> PointsToMap
-> Node (Lexeme FunctionName)
-> SecurityRank
evalRank SecurityRankContext FunctionName
ctx FunctionName
funcName (SecurityRankState -> TaintState
srsTaintState SecurityRankState
st) PointsToMap
ptsMapBefore Node (Lexeme FunctionName)
expr
            let funcAnns :: Map FunctionName SecurityRank
funcAnns = Map FunctionName SecurityRank
-> Maybe (Map FunctionName SecurityRank)
-> Map FunctionName SecurityRank
forall a. a -> Maybe a -> a
fromMaybe Map FunctionName SecurityRank
forall k a. Map k a
Map.empty (FunctionName
-> AnnotationMap -> Maybe (Map FunctionName SecurityRank)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FunctionName
funcName (SecurityRankContext FunctionName -> AnnotationMap
forall l. SecurityRankContext l -> AnnotationMap
srcAnnotations SecurityRankContext FunctionName
ctx))
            case FunctionName -> Map FunctionName SecurityRank -> Maybe SecurityRank
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FunctionName
"sink:return" Map FunctionName SecurityRank
funcAnns of
                Just SecurityRank
expectedRank ->
                    Bool -> t m () -> t m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SecurityRank
returnRank SecurityRank -> SecurityRank -> Bool
forall a. Ord a => a -> a -> Bool
< SecurityRank
expectedRank) (t m () -> t m ()) -> t m () -> t m ()
forall a b. (a -> b) -> a -> b
$ do
                        let location :: FunctionName
location = FilePath -> Node (Lexeme FunctionName) -> FunctionName
forall a. HasLocation a => FilePath -> a -> FunctionName
C.sloc (SecurityRankContext FunctionName -> FilePath
forall l. SecurityRankContext l -> FilePath
srcCurrentFile SecurityRankContext FunctionName
ctx) Node (Lexeme FunctionName)
stmt
                            diag :: FilePath
diag = FunctionName -> FilePath
T.unpack FunctionName
location FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
": security risk: tainted data of rank " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ SecurityRank -> FilePath
forall a. Show a => a -> FilePath
show SecurityRank
returnRank FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" returned from function with sink rank " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ SecurityRank -> FilePath
forall a. Show a => a -> FilePath
show SecurityRank
expectedRank
                        FilePath -> t m ()
forall (m :: * -> *). Monad m => FilePath -> m ()
dtraceM (FilePath -> t m ()) -> FilePath -> t m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"  RETURN violation. " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
diag
                        (SecurityRankState -> SecurityRankState) -> t m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((SecurityRankState -> SecurityRankState) -> t m ())
-> (SecurityRankState -> SecurityRankState) -> t m ()
forall a b. (a -> b) -> a -> b
$ \SecurityRankState
s -> SecurityRankState
s { srsDiagnostics :: [FilePath]
srsDiagnostics = SecurityRankState -> [FilePath]
srsDiagnostics SecurityRankState
s [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
diag] }
                Maybe SecurityRank
Nothing -> () -> t m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

        NodeF (Lexeme FunctionName) (Node (Lexeme FunctionName))
_ -> do
            () -> t m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    checkSinkViolation :: SecurityRankState
-> p
-> a
-> [Node (Lexeme FunctionName)]
-> p
-> (Int, SecurityRank)
-> Maybe FilePath
checkSinkViolation SecurityRankState
st p
_ a
callExpr [Node (Lexeme FunctionName)]
args p
_ (Int
paramIndex, SecurityRank
sinkRank) =
        let arg :: Node (Lexeme FunctionName)
arg = [Node (Lexeme FunctionName)]
args [Node (Lexeme FunctionName)] -> Int -> Node (Lexeme FunctionName)
forall a. [a] -> Int -> a
!! Int
paramIndex
            actualRank :: SecurityRank
actualRank = SecurityRankContext FunctionName
-> FunctionName
-> TaintState
-> PointsToMap
-> Node (Lexeme FunctionName)
-> SecurityRank
evalRank SecurityRankContext FunctionName
ctx FunctionName
funcName (SecurityRankState -> TaintState
srsTaintState SecurityRankState
st) PointsToMap
ptsMap Node (Lexeme FunctionName)
arg
            location :: FunctionName
location = FilePath -> Node (Lexeme FunctionName) -> FunctionName
forall a. HasLocation a => FilePath -> a -> FunctionName
C.sloc (SecurityRankContext FunctionName -> FilePath
forall l. SecurityRankContext l -> FilePath
srcCurrentFile SecurityRankContext FunctionName
ctx) Node (Lexeme FunctionName)
stmt
            diag :: FilePath
diag = FilePath
"checkSinkViolation: callExpr=" FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> FilePath
forall a. Show a => a -> FilePath
groom a
callExpr FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" arg=" FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Node (Lexeme FunctionName) -> FilePath
forall a. Show a => a -> FilePath
groom Node (Lexeme FunctionName)
arg FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" actualRank=" FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> SecurityRank -> FilePath
forall a. Show a => a -> FilePath
groom SecurityRank
actualRank FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" sinkRank=" FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> SecurityRank -> FilePath
forall a. Show a => a -> FilePath
groom SecurityRank
sinkRank
            res :: Maybe FilePath
res = if SecurityRank
actualRank SecurityRank -> SecurityRank -> Bool
forall a. Ord a => a -> a -> Bool
< SecurityRank
sinkRank
                  then FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ FunctionName -> FilePath
T.unpack FunctionName
location FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
": security risk: tainted data of rank " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ SecurityRank -> FilePath
forall a. Show a => a -> FilePath
show SecurityRank
actualRank FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" sent to sink of rank " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ SecurityRank -> FilePath
forall a. Show a => a -> FilePath
show SecurityRank
sinkRank
                  else Maybe FilePath
forall a. Maybe a
Nothing
        in FilePath -> Maybe FilePath -> Maybe FilePath
forall a. FilePath -> a -> a
dtrace (FilePath
diag FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
"\n  RESULT: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Maybe FilePath -> FilePath
forall a. Show a => a -> FilePath
groom Maybe FilePath
res) Maybe FilePath
res

    applySummaryTaints :: SecurityRankState
-> [Node (Lexeme FunctionName)]
-> FunctionName
-> SecurityRankSummaryData
-> TaintState
applySummaryTaints SecurityRankState
st [Node (Lexeme FunctionName)]
args FunctionName
calleeName SecurityRankSummaryData
summary =
        let (FilePath
_, Node (Lexeme FunctionName)
calleeDecl) = (FilePath, Node (Lexeme FunctionName))
-> Maybe (FilePath, Node (Lexeme FunctionName))
-> (FilePath, Node (Lexeme FunctionName))
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> (FilePath, Node (Lexeme FunctionName))
forall a. HasCallStack => FilePath -> a
error (FilePath -> (FilePath, Node (Lexeme FunctionName)))
-> FilePath -> (FilePath, Node (Lexeme FunctionName))
forall a b. (a -> b) -> a -> b
$ FilePath
"Function not found: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FunctionName -> FilePath
T.unpack FunctionName
calleeName) (FunctionName
-> Map FunctionName (FilePath, Node (Lexeme FunctionName))
-> Maybe (FilePath, Node (Lexeme FunctionName))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FunctionName
calleeName (SecurityRankContext FunctionName
-> Map FunctionName (FilePath, Node (Lexeme FunctionName))
forall l.
SecurityRankContext l
-> Map FunctionName (FilePath, Node (Lexeme l))
srcFuncDecls SecurityRankContext FunctionName
ctx))
            paramNames :: [FunctionName]
paramNames = Node (Lexeme FunctionName) -> [FunctionName]
getParamNamesFromDef Node (Lexeme FunctionName)
calleeDecl
        in (TaintState -> AbstractLocation -> SecurityRank -> TaintState)
-> TaintState -> TaintState -> TaintState
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' (SecurityRankState
-> [Node (Lexeme FunctionName)]
-> [FunctionName]
-> TaintState
-> AbstractLocation
-> SecurityRank
-> TaintState
forall p a.
p
-> [Node (Lexeme FunctionName)]
-> [FunctionName]
-> Map AbstractLocation a
-> AbstractLocation
-> a
-> Map AbstractLocation a
applyTaintForLoc SecurityRankState
st [Node (Lexeme FunctionName)]
args [FunctionName]
paramNames) (SecurityRankState -> TaintState
srsTaintState SecurityRankState
st) (SecurityRankSummaryData -> TaintState
srsOutputRanks SecurityRankSummaryData
summary)

    applyTaintForLoc :: p
-> [Node (Lexeme FunctionName)]
-> [FunctionName]
-> Map AbstractLocation a
-> AbstractLocation
-> a
-> Map AbstractLocation a
applyTaintForLoc p
_ [Node (Lexeme FunctionName)]
args [FunctionName]
paramNames Map AbstractLocation a
acc AbstractLocation
outLoc a
rank =
        case AbstractLocation
outLoc of
            DerefLocation (VarLocation FunctionName
paramName) ->
                case (FunctionName -> Bool) -> [FunctionName] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (FunctionName -> FunctionName -> Bool
forall a. Eq a => a -> a -> Bool
== FunctionName
paramName) [FunctionName]
paramNames of
                    Just Int
i ->
                        let arg :: Node (Lexeme FunctionName)
arg = [Node (Lexeme FunctionName)]
args [Node (Lexeme FunctionName)] -> Int -> Node (Lexeme FunctionName)
forall a. [a] -> Int -> a
!! Int
i
                            argLoc :: AbstractLocation
argLoc = HasCallStack => Node (Lexeme FunctionName) -> AbstractLocation
Node (Lexeme FunctionName) -> AbstractLocation
toAbstractLocation Node (Lexeme FunctionName)
arg
                        in AbstractLocation
-> a -> Map AbstractLocation a -> Map AbstractLocation a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert AbstractLocation
argLoc a
rank Map AbstractLocation a
acc
                    Maybe Int
Nothing -> Map AbstractLocation a
acc
            VarLocation FunctionName
paramName ->
                case (FunctionName -> Bool) -> [FunctionName] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (FunctionName -> FunctionName -> Bool
forall a. Eq a => a -> a -> Bool
== FunctionName
paramName) [FunctionName]
paramNames of
                    Just Int
i -> AbstractLocation
-> a -> Map AbstractLocation a -> Map AbstractLocation a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (HasCallStack => Node (Lexeme FunctionName) -> AbstractLocation
Node (Lexeme FunctionName) -> AbstractLocation
toAbstractLocation ([Node (Lexeme FunctionName)]
args [Node (Lexeme FunctionName)] -> Int -> Node (Lexeme FunctionName)
forall a. [a] -> Int -> a
!! Int
i)) a
rank Map AbstractLocation a
acc
                    Maybe Int
Nothing -> Map AbstractLocation a
acc
            AbstractLocation
_ -> Map AbstractLocation a
acc

-- | Evaluates an expression to determine its security rank.
evalRank :: SecurityRankContext Text -> FunctionName -> TaintState -> PointsToMap -> C.Node (C.Lexeme Text) -> SecurityRank
evalRank :: SecurityRankContext FunctionName
-> FunctionName
-> TaintState
-> PointsToMap
-> Node (Lexeme FunctionName)
-> SecurityRank
evalRank SecurityRankContext FunctionName
ctx FunctionName
funcName TaintState
currentState PointsToMap
ptsMap Node (Lexeme FunctionName)
node = Node (Lexeme FunctionName) -> SecurityRank
go Node (Lexeme FunctionName)
node
  where
    go :: Node (Lexeme FunctionName) -> SecurityRank
go n :: Node (Lexeme FunctionName)
n@(Fix NodeF (Lexeme FunctionName) (Node (Lexeme FunctionName))
expr) =
        let
            pctx :: PointsToContext FunctionName
pctx = (SecurityRankContext FunctionName -> PointsToContext FunctionName
forall l. SecurityRankContext l -> PointsToContext l
srcPointsToContext SecurityRankContext FunctionName
ctx) { ptcCurrentContext :: Context
PointsTo.ptcCurrentContext = SecurityRankContext FunctionName -> Context
forall l. SecurityRankContext l -> Context
srcCurrentContext SecurityRankContext FunctionName
ctx }
        in case NodeF (Lexeme FunctionName) (Node (Lexeme FunctionName))
expr of
            C.VarExpr (C.L AlexPosn
_ LexemeClass
_ FunctionName
name) ->
                let
                    loc :: AbstractLocation
loc = FunctionName -> AbstractLocation
VarLocation FunctionName
name
                    ownRank :: SecurityRank
ownRank = SecurityRank -> Maybe SecurityRank -> SecurityRank
forall a. a -> Maybe a -> a
fromMaybe SecurityRank
Safe (AbstractLocation -> TaintState -> Maybe SecurityRank
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup AbstractLocation
loc TaintState
currentState)
                    pointsToSet :: Set AbstractLocation
pointsToSet = Set AbstractLocation
-> Maybe (Set AbstractLocation) -> Set AbstractLocation
forall a. a -> Maybe a -> a
fromMaybe Set AbstractLocation
forall a. Set a
Set.empty (AbstractLocation -> PointsToMap -> Maybe (Set AbstractLocation)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup AbstractLocation
loc PointsToMap
ptsMap)
                    pointedToRanks :: Set SecurityRank
pointedToRanks = (AbstractLocation -> SecurityRank)
-> Set AbstractLocation -> Set SecurityRank
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (\AbstractLocation
l -> SecurityRank -> Maybe SecurityRank -> SecurityRank
forall a. a -> Maybe a -> a
fromMaybe SecurityRank
Safe (AbstractLocation -> TaintState -> Maybe SecurityRank
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup AbstractLocation
l TaintState
currentState)) Set AbstractLocation
pointsToSet
                    minPointedToRank :: SecurityRank
minPointedToRank = if Set SecurityRank -> Bool
forall a. Set a -> Bool
Set.null Set SecurityRank
pointedToRanks then SecurityRank
Safe else Set SecurityRank -> SecurityRank
forall a. Set a -> a
Set.findMin Set SecurityRank
pointedToRanks
                in
                    SecurityRank -> SecurityRank -> SecurityRank
forall a. Ord a => a -> a -> a
min SecurityRank
ownRank SecurityRank
minPointedToRank
            C.MemberAccess Node (Lexeme FunctionName)
baseExpr (C.L AlexPosn
_ LexemeClass
_ FunctionName
memberName) ->
                let
                    baseLoc :: AbstractLocation
baseLoc = HasCallStack => Node (Lexeme FunctionName) -> AbstractLocation
Node (Lexeme FunctionName) -> AbstractLocation
toAbstractLocation Node (Lexeme FunctionName)
baseExpr
                    baseRank :: SecurityRank
baseRank = SecurityRank -> Maybe SecurityRank -> SecurityRank
forall a. a -> Maybe a -> a
fromMaybe SecurityRank
Safe (AbstractLocation -> TaintState -> Maybe SecurityRank
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup AbstractLocation
baseLoc TaintState
currentState)
                    fieldRank :: SecurityRank
fieldRank = SecurityRank -> Maybe SecurityRank -> SecurityRank
forall a. a -> Maybe a -> a
fromMaybe SecurityRank
Safe (AbstractLocation -> TaintState -> Maybe SecurityRank
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (AbstractLocation -> FunctionName -> AbstractLocation
FieldLocation AbstractLocation
baseLoc FunctionName
memberName) TaintState
currentState)
                in
                    SecurityRank -> SecurityRank -> SecurityRank
forall a. Ord a => a -> a -> a
min SecurityRank
baseRank SecurityRank
fieldRank
            C.PointerAccess Node (Lexeme FunctionName)
baseExpr (C.L AlexPosn
_ LexemeClass
_ FunctionName
memberName) ->
                let
                    (Set AbstractLocation
baseLocs, Set (FunctionName, Context)
_) = Map FunctionName (Node (Lexeme FunctionName))
-> PointsToContext FunctionName
-> Set FunctionName
-> FunctionName
-> PointsToMap
-> Node (Lexeme FunctionName)
-> (Set AbstractLocation, Set (FunctionName, Context))
PointsTo.evalPointsToSet (FilePath -> Map FunctionName (Node (Lexeme FunctionName))
forall a. HasCallStack => FilePath -> a
error FilePath
"no macro context") PointsToContext FunctionName
pctx (PointsToContext FunctionName -> Set FunctionName
forall l. PointsToContext l -> Set FunctionName
PointsTo.ptcLocalVars PointsToContext FunctionName
pctx) FunctionName
funcName PointsToMap
ptsMap Node (Lexeme FunctionName)
baseExpr
                    baseRanks :: Set SecurityRank
baseRanks = (AbstractLocation -> SecurityRank)
-> Set AbstractLocation -> Set SecurityRank
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (\AbstractLocation
l -> SecurityRank -> Maybe SecurityRank -> SecurityRank
forall a. a -> Maybe a -> a
fromMaybe SecurityRank
Safe (AbstractLocation -> TaintState -> Maybe SecurityRank
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup AbstractLocation
l TaintState
currentState)) Set AbstractLocation
baseLocs
                    minBaseRank :: SecurityRank
minBaseRank = if Set SecurityRank -> Bool
forall a. Set a -> Bool
Set.null Set SecurityRank
baseRanks then SecurityRank
Safe else Set SecurityRank -> SecurityRank
forall a. Set a -> a
Set.findMin Set SecurityRank
baseRanks
                    fieldRanks :: Set SecurityRank
fieldRanks = (AbstractLocation -> SecurityRank)
-> Set AbstractLocation -> Set SecurityRank
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (\AbstractLocation
l -> SecurityRank -> Maybe SecurityRank -> SecurityRank
forall a. a -> Maybe a -> a
fromMaybe SecurityRank
Safe (AbstractLocation -> TaintState -> Maybe SecurityRank
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (AbstractLocation -> FunctionName -> AbstractLocation
FieldLocation AbstractLocation
l FunctionName
memberName) TaintState
currentState)) Set AbstractLocation
baseLocs
                    minFieldRank :: SecurityRank
minFieldRank = if Set SecurityRank -> Bool
forall a. Set a -> Bool
Set.null Set SecurityRank
fieldRanks then SecurityRank
Safe else Set SecurityRank -> SecurityRank
forall a. Set a -> a
Set.findMin Set SecurityRank
fieldRanks
                in
                    SecurityRank -> SecurityRank -> SecurityRank
forall a. Ord a => a -> a -> a
min SecurityRank
minBaseRank SecurityRank
minFieldRank
            C.ArrayAccess Node (Lexeme FunctionName)
baseExpr Node (Lexeme FunctionName)
_ ->
                let loc :: AbstractLocation
loc = HasCallStack => Node (Lexeme FunctionName) -> AbstractLocation
Node (Lexeme FunctionName) -> AbstractLocation
toAbstractLocation Node (Lexeme FunctionName)
n
                in SecurityRank -> Maybe SecurityRank -> SecurityRank
forall a. a -> Maybe a -> a
fromMaybe (Node (Lexeme FunctionName) -> SecurityRank
go Node (Lexeme FunctionName)
baseExpr) (AbstractLocation -> TaintState -> Maybe SecurityRank
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup AbstractLocation
loc TaintState
currentState)
            C.UnaryExpr UnaryOp
C.UopDeref Node (Lexeme FunctionName)
ptrExpr ->
                let
                    ptrLoc :: AbstractLocation
ptrLoc = HasCallStack => Node (Lexeme FunctionName) -> AbstractLocation
Node (Lexeme FunctionName) -> AbstractLocation
toAbstractLocation Node (Lexeme FunctionName)
ptrExpr
                    ptrRank :: SecurityRank
ptrRank = SecurityRank -> Maybe SecurityRank -> SecurityRank
forall a. a -> Maybe a -> a
fromMaybe SecurityRank
Safe (AbstractLocation -> TaintState -> Maybe SecurityRank
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup AbstractLocation
ptrLoc TaintState
currentState)
                    pointsToSet :: Set AbstractLocation
pointsToSet = Set AbstractLocation
-> Maybe (Set AbstractLocation) -> Set AbstractLocation
forall a. a -> Maybe a -> a
fromMaybe Set AbstractLocation
forall a. Set a
Set.empty (AbstractLocation -> PointsToMap -> Maybe (Set AbstractLocation)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup AbstractLocation
ptrLoc PointsToMap
ptsMap)
                    pointedToRanks :: Set SecurityRank
pointedToRanks = (AbstractLocation -> SecurityRank)
-> Set AbstractLocation -> Set SecurityRank
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (\AbstractLocation
loc -> SecurityRank -> Maybe SecurityRank -> SecurityRank
forall a. a -> Maybe a -> a
fromMaybe SecurityRank
Safe (AbstractLocation -> TaintState -> Maybe SecurityRank
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup AbstractLocation
loc TaintState
currentState)) Set AbstractLocation
pointsToSet
                    minPointedToRank :: SecurityRank
minPointedToRank = if Set SecurityRank -> Bool
forall a. Set a -> Bool
Set.null Set SecurityRank
pointedToRanks then SecurityRank
Safe else Set SecurityRank -> SecurityRank
forall a. Set a -> a
Set.findMin Set SecurityRank
pointedToRanks
                in
                    SecurityRank -> SecurityRank -> SecurityRank
forall a. Ord a => a -> a -> a
min SecurityRank
ptrRank SecurityRank
minPointedToRank
            C.UnaryExpr UnaryOp
C.UopAddress Node (Lexeme FunctionName)
inner ->
                let innerLoc :: AbstractLocation
innerLoc = HasCallStack => Node (Lexeme FunctionName) -> AbstractLocation
Node (Lexeme FunctionName) -> AbstractLocation
toAbstractLocation Node (Lexeme FunctionName)
inner
                in SecurityRank -> Maybe SecurityRank -> SecurityRank
forall a. a -> Maybe a -> a
fromMaybe SecurityRank
Safe (AbstractLocation -> TaintState -> Maybe SecurityRank
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup AbstractLocation
innerLoc TaintState
currentState)
            C.FunctionCall Node (Lexeme FunctionName)
callExpr [Node (Lexeme FunctionName)]
args ->
                let
                    (Set AbstractLocation
calleePointsTo, Set (FunctionName, Context)
_) = Map FunctionName (Node (Lexeme FunctionName))
-> PointsToContext FunctionName
-> Set FunctionName
-> FunctionName
-> PointsToMap
-> Node (Lexeme FunctionName)
-> (Set AbstractLocation, Set (FunctionName, Context))
PointsTo.evalPointsToSet (FilePath -> Map FunctionName (Node (Lexeme FunctionName))
forall a. HasCallStack => FilePath -> a
error FilePath
"no macro context") PointsToContext FunctionName
pctx (PointsToContext FunctionName -> Set FunctionName
forall l. PointsToContext l -> Set FunctionName
PointsTo.ptcLocalVars PointsToContext FunctionName
pctx) FunctionName
funcName PointsToMap
ptsMap Node (Lexeme FunctionName)
callExpr
                    calleeNames :: [FunctionName]
calleeNames = (AbstractLocation -> Maybe FunctionName)
-> [AbstractLocation] -> [FunctionName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe AbstractLocation -> Maybe FunctionName
getFuncNameFromLoc (Set AbstractLocation -> [AbstractLocation]
forall a. Set a -> [a]
Set.toList Set AbstractLocation
calleePointsTo)
                    newContext :: Context
newContext = Int -> Int -> Context -> Context
pushContext Int
kLimit (Node (Lexeme FunctionName) -> Int
forall a. Hashable a => Node a -> Int
C.getNodeId Node (Lexeme FunctionName)
n) (SecurityRankContext FunctionName -> Context
forall l. SecurityRankContext l -> Context
srcCurrentContext SecurityRankContext FunctionName
ctx)

                    applySummaryForCallee :: SecurityRank -> FunctionName -> SecurityRank
                    applySummaryForCallee :: SecurityRank -> FunctionName -> SecurityRank
applySummaryForCallee SecurityRank
currentRank FunctionName
calleeName =
                        let
                            calleeSummaryMap :: SecurityRankSummary
calleeSummaryMap = SecurityRankSummary
-> Maybe SecurityRankSummary -> SecurityRankSummary
forall a. a -> Maybe a -> a
fromMaybe SecurityRankSummary
forall k a. Map k a
Map.empty (FunctionName
-> Map FunctionName SecurityRankSummary
-> Maybe SecurityRankSummary
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FunctionName
calleeName (SecurityRankContext FunctionName
-> Map FunctionName SecurityRankSummary
forall l.
SecurityRankContext l -> Map FunctionName SecurityRankSummary
srcSummaries SecurityRankContext FunctionName
ctx))
                            summaryForContext :: Maybe SecurityRankSummaryData
summaryForContext = Context -> SecurityRankSummary -> Maybe SecurityRankSummaryData
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Context
newContext SecurityRankSummary
calleeSummaryMap
                            summaryForEmpty :: Maybe SecurityRankSummaryData
summaryForEmpty = Context -> SecurityRankSummary -> Maybe SecurityRankSummaryData
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [] SecurityRankSummary
calleeSummaryMap
                            summaryData :: SecurityRankSummaryData
summaryData = SecurityRankSummaryData
-> Maybe SecurityRankSummaryData -> SecurityRankSummaryData
forall a. a -> Maybe a -> a
fromMaybe (SecurityRankSummaryData
-> Maybe SecurityRankSummaryData -> SecurityRankSummaryData
forall a. a -> Maybe a -> a
fromMaybe SecurityRankSummaryData
emptySecurityRankSummaryData Maybe SecurityRankSummaryData
summaryForEmpty) Maybe SecurityRankSummaryData
summaryForContext

                            -- Get the parameter names for the callee
                            (FilePath
_, Node (Lexeme FunctionName)
calleeDecl) = (FilePath, Node (Lexeme FunctionName))
-> Maybe (FilePath, Node (Lexeme FunctionName))
-> (FilePath, Node (Lexeme FunctionName))
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> (FilePath, Node (Lexeme FunctionName))
forall a. HasCallStack => FilePath -> a
error (FilePath -> (FilePath, Node (Lexeme FunctionName)))
-> FilePath -> (FilePath, Node (Lexeme FunctionName))
forall a b. (a -> b) -> a -> b
$ FilePath
"Function not found: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FunctionName -> FilePath
T.unpack FunctionName
calleeName) (FunctionName
-> Map FunctionName (FilePath, Node (Lexeme FunctionName))
-> Maybe (FilePath, Node (Lexeme FunctionName))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FunctionName
calleeName (SecurityRankContext FunctionName
-> Map FunctionName (FilePath, Node (Lexeme FunctionName))
forall l.
SecurityRankContext l
-> Map FunctionName (FilePath, Node (Lexeme l))
srcFuncDecls SecurityRankContext FunctionName
ctx))
                            paramNames :: [FunctionName]
paramNames = Node (Lexeme FunctionName) -> [FunctionName]
getParamNamesFromDef Node (Lexeme FunctionName)
calleeDecl

                            -- Evaluate the rank of each argument at the call site
                            argRanks :: [SecurityRank]
argRanks = (Node (Lexeme FunctionName) -> SecurityRank)
-> [Node (Lexeme FunctionName)] -> [SecurityRank]
forall a b. (a -> b) -> [a] -> [b]
map (SecurityRankContext FunctionName
-> FunctionName
-> TaintState
-> PointsToMap
-> Node (Lexeme FunctionName)
-> SecurityRank
evalRank SecurityRankContext FunctionName
ctx FunctionName
funcName TaintState
currentState PointsToMap
ptsMap) [Node (Lexeme FunctionName)]
args

                            -- Create a substitution map from parameter locations to argument ranks
                            substMap :: TaintState
substMap = [(AbstractLocation, SecurityRank)] -> TaintState
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(AbstractLocation, SecurityRank)] -> TaintState)
-> [(AbstractLocation, SecurityRank)] -> TaintState
forall a b. (a -> b) -> a -> b
$ [AbstractLocation]
-> [SecurityRank] -> [(AbstractLocation, SecurityRank)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((FunctionName -> AbstractLocation)
-> [FunctionName] -> [AbstractLocation]
forall a b. (a -> b) -> [a] -> [b]
map FunctionName -> AbstractLocation
VarLocation [FunctionName]
paramNames) [SecurityRank]
argRanks

                            -- Substitute parameter locations in the summary's output ranks
                            substitute :: AbstractLocation -> SecurityRank
substitute AbstractLocation
loc = SecurityRank -> Maybe SecurityRank -> SecurityRank
forall a. a -> Maybe a -> a
fromMaybe SecurityRank
Safe (AbstractLocation -> TaintState -> Maybe SecurityRank
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup AbstractLocation
loc TaintState
substMap)

                            finalRank :: SecurityRank
finalRank = (SecurityRank -> (AbstractLocation, SecurityRank) -> SecurityRank)
-> SecurityRank
-> [(AbstractLocation, SecurityRank)]
-> SecurityRank
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\SecurityRank
acc (AbstractLocation
outLoc, SecurityRank
outRank) ->
                                case AbstractLocation
outLoc of
                                    ReturnLocation FunctionName
_ -> SecurityRank -> SecurityRank -> SecurityRank
forall a. Ord a => a -> a -> a
min SecurityRank
acc SecurityRank
outRank
                                    DerefLocation (VarLocation FunctionName
pName) ->
                                        SecurityRank -> SecurityRank -> SecurityRank
forall a. Ord a => a -> a -> a
min SecurityRank
acc (AbstractLocation -> SecurityRank
substitute (FunctionName -> AbstractLocation
VarLocation FunctionName
pName))
                                    -- Propagate taint from arguments to return value if the function just returns it
                                    VarLocation FunctionName
pName -> SecurityRank -> SecurityRank -> SecurityRank
forall a. Ord a => a -> a -> a
min SecurityRank
acc (AbstractLocation -> SecurityRank
substitute (FunctionName -> AbstractLocation
VarLocation FunctionName
pName))
                                    AbstractLocation
_ -> SecurityRank
acc
                                ) SecurityRank
Safe (TaintState -> [(AbstractLocation, SecurityRank)]
forall k a. Map k a -> [(k, a)]
Map.toList (SecurityRankSummaryData -> TaintState
srsOutputRanks SecurityRankSummaryData
summaryData))

                        in
                            SecurityRank -> SecurityRank -> SecurityRank
forall a. Ord a => a -> a -> a
min SecurityRank
currentRank SecurityRank
finalRank

                in
                    FilePath -> SecurityRank -> SecurityRank
forall a. FilePath -> a -> a
dtrace (FilePath
"evalRank FunctionCall: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Node (Lexeme FunctionName) -> FilePath
forall a. Show a => a -> FilePath
groom Node (Lexeme FunctionName)
n FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" -> " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> [FunctionName] -> FilePath
forall a. Show a => a -> FilePath
groom [FunctionName]
calleeNames FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" => " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> SecurityRank -> FilePath
forall a. Show a => a -> FilePath
groom ((SecurityRank -> FunctionName -> SecurityRank)
-> SecurityRank -> [FunctionName] -> SecurityRank
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' SecurityRank -> FunctionName -> SecurityRank
applySummaryForCallee SecurityRank
Safe [FunctionName]
calleeNames)) (SecurityRank -> SecurityRank) -> SecurityRank -> SecurityRank
forall a b. (a -> b) -> a -> b
$
                    (SecurityRank -> FunctionName -> SecurityRank)
-> SecurityRank -> [FunctionName] -> SecurityRank
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' SecurityRank -> FunctionName -> SecurityRank
applySummaryForCallee SecurityRank
Safe [FunctionName]
calleeNames
            C.LiteralExpr {} -> SecurityRank
Safe
            C.ParenExpr Node (Lexeme FunctionName)
inner -> Node (Lexeme FunctionName) -> SecurityRank
go Node (Lexeme FunctionName)
inner
            C.CastExpr Node (Lexeme FunctionName)
_ Node (Lexeme FunctionName)
inner -> Node (Lexeme FunctionName) -> SecurityRank
go Node (Lexeme FunctionName)
inner
            C.BinaryExpr Node (Lexeme FunctionName)
lhs BinaryOp
_ Node (Lexeme FunctionName)
rhs -> SecurityRank -> SecurityRank -> SecurityRank
forall a. Ord a => a -> a -> a
min (Node (Lexeme FunctionName) -> SecurityRank
go Node (Lexeme FunctionName)
lhs) (Node (Lexeme FunctionName) -> SecurityRank
go Node (Lexeme FunctionName)
rhs)
            C.TernaryExpr Node (Lexeme FunctionName)
_ Node (Lexeme FunctionName)
trueExpr Node (Lexeme FunctionName)
falseExpr -> SecurityRank -> SecurityRank -> SecurityRank
forall a. Ord a => a -> a -> a
min (Node (Lexeme FunctionName) -> SecurityRank
go Node (Lexeme FunctionName)
trueExpr) (Node (Lexeme FunctionName) -> SecurityRank
go Node (Lexeme FunctionName)
falseExpr)
            NodeF (Lexeme FunctionName) (Node (Lexeme FunctionName))
_ -> SecurityRank
Safe

-- | Finds all function declarations and definitions.
findFunctionDecls :: [(FilePath, [C.Node (C.Lexeme Text)])] -> Map FunctionName (FilePath, C.Node (C.Lexeme Text))
findFunctionDecls :: [(FilePath, [Node (Lexeme FunctionName)])]
-> Map FunctionName (FilePath, Node (Lexeme FunctionName))
findFunctionDecls [(FilePath, [Node (Lexeme FunctionName)])]
tus = State (Map FunctionName (FilePath, Node (Lexeme FunctionName))) ()
-> Map FunctionName (FilePath, Node (Lexeme FunctionName))
-> Map FunctionName (FilePath, Node (Lexeme FunctionName))
forall s a. State s a -> s -> s
execState (AstActions
  (StateT
     (Map FunctionName (FilePath, Node (Lexeme FunctionName))) Identity)
  FunctionName
-> [(FilePath, [Node (Lexeme FunctionName)])]
-> State
     (Map FunctionName (FilePath, Node (Lexeme FunctionName))) ()
forall text a (f :: * -> *).
(TraverseAst text a, Applicative f) =>
AstActions f text -> a -> f ()
traverseAst AstActions
  (StateT
     (Map FunctionName (FilePath, Node (Lexeme FunctionName))) Identity)
  FunctionName
collector [(FilePath, [Node (Lexeme FunctionName)])]
tus) Map FunctionName (FilePath, Node (Lexeme FunctionName))
forall k a. Map k a
Map.empty
  where
    collector :: AstActions
  (StateT
     (Map FunctionName (FilePath, Node (Lexeme FunctionName))) Identity)
  FunctionName
collector = AstActions
  (StateT
     (Map FunctionName (FilePath, Node (Lexeme FunctionName))) Identity)
  FunctionName
forall (f :: * -> *) text. Applicative f => AstActions f text
astActions
        { doNode :: FilePath
-> Node (Lexeme FunctionName)
-> State
     (Map FunctionName (FilePath, Node (Lexeme FunctionName))) ()
-> State
     (Map FunctionName (FilePath, Node (Lexeme FunctionName))) ()
doNode = \FilePath
fp Node (Lexeme FunctionName)
node State (Map FunctionName (FilePath, Node (Lexeme FunctionName))) ()
act -> do
            case Node (Lexeme FunctionName)
-> NodeF (Lexeme FunctionName) (Node (Lexeme FunctionName))
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Node (Lexeme FunctionName)
node of
                C.FunctionDefn Scope
_ (Fix (C.FunctionPrototype Node (Lexeme FunctionName)
_ (C.L AlexPosn
_ LexemeClass
_ FunctionName
name) [Node (Lexeme FunctionName)]
_)) Node (Lexeme FunctionName)
_ ->
                    (Map FunctionName (FilePath, Node (Lexeme FunctionName))
 -> Map FunctionName (FilePath, Node (Lexeme FunctionName)))
-> State
     (Map FunctionName (FilePath, Node (Lexeme FunctionName))) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (FunctionName
-> (FilePath, Node (Lexeme FunctionName))
-> Map FunctionName (FilePath, Node (Lexeme FunctionName))
-> Map FunctionName (FilePath, Node (Lexeme FunctionName))
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert FunctionName
name (FilePath
fp, Node (Lexeme FunctionName)
node))
                C.FunctionDecl Scope
_ (Fix (C.FunctionPrototype Node (Lexeme FunctionName)
_ (C.L AlexPosn
_ LexemeClass
_ FunctionName
name) [Node (Lexeme FunctionName)]
_)) ->
                    (Map FunctionName (FilePath, Node (Lexeme FunctionName))
 -> Map FunctionName (FilePath, Node (Lexeme FunctionName)))
-> State
     (Map FunctionName (FilePath, Node (Lexeme FunctionName))) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (FunctionName
-> (FilePath, Node (Lexeme FunctionName))
-> Map FunctionName (FilePath, Node (Lexeme FunctionName))
-> Map FunctionName (FilePath, Node (Lexeme FunctionName))
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert FunctionName
name (FilePath
fp, Node (Lexeme FunctionName)
node))
                NodeF (Lexeme FunctionName) (Node (Lexeme FunctionName))
_ -> ()
-> State
     (Map FunctionName (FilePath, Node (Lexeme FunctionName))) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            State (Map FunctionName (FilePath, Node (Lexeme FunctionName))) ()
act
        }

-- | Finds all function definitions.
findFunctionDefs :: [(FilePath, [C.Node (C.Lexeme Text)])] -> Map FunctionName (FilePath, C.Node (C.Lexeme Text))
findFunctionDefs :: [(FilePath, [Node (Lexeme FunctionName)])]
-> Map FunctionName (FilePath, Node (Lexeme FunctionName))
findFunctionDefs [(FilePath, [Node (Lexeme FunctionName)])]
tus = State (Map FunctionName (FilePath, Node (Lexeme FunctionName))) ()
-> Map FunctionName (FilePath, Node (Lexeme FunctionName))
-> Map FunctionName (FilePath, Node (Lexeme FunctionName))
forall s a. State s a -> s -> s
execState (AstActions
  (StateT
     (Map FunctionName (FilePath, Node (Lexeme FunctionName))) Identity)
  FunctionName
-> [(FilePath, [Node (Lexeme FunctionName)])]
-> State
     (Map FunctionName (FilePath, Node (Lexeme FunctionName))) ()
forall text a (f :: * -> *).
(TraverseAst text a, Applicative f) =>
AstActions f text -> a -> f ()
traverseAst AstActions
  (StateT
     (Map FunctionName (FilePath, Node (Lexeme FunctionName))) Identity)
  FunctionName
collector [(FilePath, [Node (Lexeme FunctionName)])]
tus) Map FunctionName (FilePath, Node (Lexeme FunctionName))
forall k a. Map k a
Map.empty
  where
    collector :: AstActions
  (StateT
     (Map FunctionName (FilePath, Node (Lexeme FunctionName))) Identity)
  FunctionName
collector = AstActions
  (StateT
     (Map FunctionName (FilePath, Node (Lexeme FunctionName))) Identity)
  FunctionName
forall (f :: * -> *) text. Applicative f => AstActions f text
astActions
        { doNode :: FilePath
-> Node (Lexeme FunctionName)
-> State
     (Map FunctionName (FilePath, Node (Lexeme FunctionName))) ()
-> State
     (Map FunctionName (FilePath, Node (Lexeme FunctionName))) ()
doNode = \FilePath
fp Node (Lexeme FunctionName)
node State (Map FunctionName (FilePath, Node (Lexeme FunctionName))) ()
act -> do
            case Node (Lexeme FunctionName)
-> NodeF (Lexeme FunctionName) (Node (Lexeme FunctionName))
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Node (Lexeme FunctionName)
node of
                C.FunctionDefn Scope
_ (Fix (C.FunctionPrototype Node (Lexeme FunctionName)
_ (C.L AlexPosn
_ LexemeClass
_ FunctionName
name) [Node (Lexeme FunctionName)]
_)) Node (Lexeme FunctionName)
_ ->
                    (Map FunctionName (FilePath, Node (Lexeme FunctionName))
 -> Map FunctionName (FilePath, Node (Lexeme FunctionName)))
-> State
     (Map FunctionName (FilePath, Node (Lexeme FunctionName))) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (FunctionName
-> (FilePath, Node (Lexeme FunctionName))
-> Map FunctionName (FilePath, Node (Lexeme FunctionName))
-> Map FunctionName (FilePath, Node (Lexeme FunctionName))
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert FunctionName
name (FilePath
fp, Node (Lexeme FunctionName)
node))
                NodeF (Lexeme FunctionName) (Node (Lexeme FunctionName))
_ -> ()
-> State
     (Map FunctionName (FilePath, Node (Lexeme FunctionName))) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            State (Map FunctionName (FilePath, Node (Lexeme FunctionName))) ()
act
        }

findStructDefs :: [C.Node (C.Lexeme Text)] -> Map Text (C.Node (C.Lexeme Text))
findStructDefs :: [Node (Lexeme FunctionName)]
-> Map FunctionName (Node (Lexeme FunctionName))
findStructDefs [Node (Lexeme FunctionName)]
nodes = State (Map FunctionName (Node (Lexeme FunctionName))) ()
-> Map FunctionName (Node (Lexeme FunctionName))
-> Map FunctionName (Node (Lexeme FunctionName))
forall s a. State s a -> s -> s
execState (AstActions
  (StateT (Map FunctionName (Node (Lexeme FunctionName))) Identity)
  FunctionName
-> [Node (Lexeme FunctionName)]
-> State (Map FunctionName (Node (Lexeme FunctionName))) ()
forall text a (f :: * -> *).
(TraverseAst text a, Applicative f) =>
AstActions f text -> a -> f ()
traverseAst AstActions
  (StateT (Map FunctionName (Node (Lexeme FunctionName))) Identity)
  FunctionName
collector [Node (Lexeme FunctionName)]
nodes) Map FunctionName (Node (Lexeme FunctionName))
forall k a. Map k a
Map.empty
  where
    collector :: AstActions
  (StateT (Map FunctionName (Node (Lexeme FunctionName))) Identity)
  FunctionName
collector = AstActions
  (StateT (Map FunctionName (Node (Lexeme FunctionName))) Identity)
  FunctionName
forall (f :: * -> *) text. Applicative f => AstActions f text
astActions
        { doNode :: FilePath
-> Node (Lexeme FunctionName)
-> State (Map FunctionName (Node (Lexeme FunctionName))) ()
-> State (Map FunctionName (Node (Lexeme FunctionName))) ()
doNode = \FilePath
_ Node (Lexeme FunctionName)
node State (Map FunctionName (Node (Lexeme FunctionName))) ()
act -> do
            case Node (Lexeme FunctionName)
-> NodeF (Lexeme FunctionName) (Node (Lexeme FunctionName))
forall (f :: * -> *). Fix f -> f (Fix f)
unFix Node (Lexeme FunctionName)
node of
                C.Struct (C.L AlexPosn
_ LexemeClass
_ FunctionName
name) [Node (Lexeme FunctionName)]
_ ->
                    (Map FunctionName (Node (Lexeme FunctionName))
 -> Map FunctionName (Node (Lexeme FunctionName)))
-> State (Map FunctionName (Node (Lexeme FunctionName))) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (FunctionName
-> Node (Lexeme FunctionName)
-> Map FunctionName (Node (Lexeme FunctionName))
-> Map FunctionName (Node (Lexeme FunctionName))
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert FunctionName
name Node (Lexeme FunctionName)
node)
                C.Typedef (Fix (C.Struct (C.L AlexPosn
_ LexemeClass
_ FunctionName
name) [Node (Lexeme FunctionName)]
_)) Lexeme FunctionName
_ ->
                    (Map FunctionName (Node (Lexeme FunctionName))
 -> Map FunctionName (Node (Lexeme FunctionName)))
-> State (Map FunctionName (Node (Lexeme FunctionName))) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (FunctionName
-> Node (Lexeme FunctionName)
-> Map FunctionName (Node (Lexeme FunctionName))
-> Map FunctionName (Node (Lexeme FunctionName))
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert FunctionName
name Node (Lexeme FunctionName)
node)
                NodeF (Lexeme FunctionName) (Node (Lexeme FunctionName))
_ -> () -> State (Map FunctionName (Node (Lexeme FunctionName))) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            State (Map FunctionName (Node (Lexeme FunctionName))) ()
act
        }

getFuncNameFromDef :: C.Node (C.Lexeme Text) -> FunctionName
getFuncNameFromDef :: Node (Lexeme FunctionName) -> FunctionName
getFuncNameFromDef (Fix (C.FunctionDefn Scope
_ (Fix (C.FunctionPrototype Node (Lexeme FunctionName)
_ (C.L AlexPosn
_ LexemeClass
_ FunctionName
name) [Node (Lexeme FunctionName)]
_)) Node (Lexeme FunctionName)
_)) = FunctionName
name
getFuncNameFromDef (Fix (C.FunctionDecl Scope
_ (Fix (C.FunctionPrototype Node (Lexeme FunctionName)
_ (C.L AlexPosn
_ LexemeClass
_ FunctionName
name) [Node (Lexeme FunctionName)]
_)))) = FunctionName
name
getFuncNameFromDef Node (Lexeme FunctionName)
_ = FilePath -> FunctionName
forall a. HasCallStack => FilePath -> a
error FilePath
"Node is not a function definition or declaration"

getParamNamesFromDef :: C.Node (C.Lexeme Text) -> [Text]
getParamNamesFromDef :: Node (Lexeme FunctionName) -> [FunctionName]
getParamNamesFromDef (Fix (C.FunctionDefn Scope
_ (Fix (C.FunctionPrototype Node (Lexeme FunctionName)
_ Lexeme FunctionName
_ [Node (Lexeme FunctionName)]
params)) Node (Lexeme FunctionName)
_)) =
    (Node (Lexeme FunctionName) -> Maybe FunctionName)
-> [Node (Lexeme FunctionName)] -> [FunctionName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Node (Lexeme FunctionName) -> Maybe FunctionName
getParamName [Node (Lexeme FunctionName)]
params
getParamNamesFromDef (Fix (C.FunctionDecl Scope
_ (Fix (C.FunctionPrototype Node (Lexeme FunctionName)
_ Lexeme FunctionName
_ [Node (Lexeme FunctionName)]
params)))) =
    (Node (Lexeme FunctionName) -> Maybe FunctionName)
-> [Node (Lexeme FunctionName)] -> [FunctionName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Node (Lexeme FunctionName) -> Maybe FunctionName
getParamName [Node (Lexeme FunctionName)]
params
getParamNamesFromDef Node (Lexeme FunctionName)
_ = []

getParamName :: C.Node (C.Lexeme Text) -> Maybe Text
getParamName :: Node (Lexeme FunctionName) -> Maybe FunctionName
getParamName (Fix (C.VarDecl Node (Lexeme FunctionName)
_ (C.L AlexPosn
_ LexemeClass
_ FunctionName
name) [Node (Lexeme FunctionName)]
_)) = FunctionName -> Maybe FunctionName
forall a. a -> Maybe a
Just FunctionName
name
getParamName Node (Lexeme FunctionName)
_                                    = Maybe FunctionName
forall a. Maybe a
Nothing

getParamTypesFromDef :: C.Node (C.Lexeme Text) -> [C.Node (C.Lexeme Text)]
getParamTypesFromDef :: Node (Lexeme FunctionName) -> [Node (Lexeme FunctionName)]
getParamTypesFromDef (Fix (C.FunctionDefn Scope
_ (Fix (C.FunctionPrototype Node (Lexeme FunctionName)
_ Lexeme FunctionName
_ [Node (Lexeme FunctionName)]
params)) Node (Lexeme FunctionName)
_)) =
    (Node (Lexeme FunctionName) -> Maybe (Node (Lexeme FunctionName)))
-> [Node (Lexeme FunctionName)] -> [Node (Lexeme FunctionName)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Node (Lexeme FunctionName) -> Maybe (Node (Lexeme FunctionName))
getParamType [Node (Lexeme FunctionName)]
params
getParamTypesFromDef (Fix (C.FunctionDecl Scope
_ (Fix (C.FunctionPrototype Node (Lexeme FunctionName)
_ Lexeme FunctionName
_ [Node (Lexeme FunctionName)]
params)))) =
    (Node (Lexeme FunctionName) -> Maybe (Node (Lexeme FunctionName)))
-> [Node (Lexeme FunctionName)] -> [Node (Lexeme FunctionName)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Node (Lexeme FunctionName) -> Maybe (Node (Lexeme FunctionName))
getParamType [Node (Lexeme FunctionName)]
params
getParamTypesFromDef Node (Lexeme FunctionName)
_ = []

getParamType :: C.Node (C.Lexeme Text) -> Maybe (C.Node (C.Lexeme Text))
getParamType :: Node (Lexeme FunctionName) -> Maybe (Node (Lexeme FunctionName))
getParamType (Fix (C.VarDecl Node (Lexeme FunctionName)
ty Lexeme FunctionName
_ [Node (Lexeme FunctionName)]
_)) = Node (Lexeme FunctionName) -> Maybe (Node (Lexeme FunctionName))
forall a. a -> Maybe a
Just Node (Lexeme FunctionName)
ty
getParamType Node (Lexeme FunctionName)
_                        = Maybe (Node (Lexeme FunctionName))
forall a. Maybe a
Nothing

getStructMemberNames :: C.Node (C.Lexeme Text) -> [Text]
getStructMemberNames :: Node (Lexeme FunctionName) -> [FunctionName]
getStructMemberNames (Fix (C.Struct Lexeme FunctionName
_ [Node (Lexeme FunctionName)]
decls)) =
    (Node (Lexeme FunctionName) -> Maybe FunctionName)
-> [Node (Lexeme FunctionName)] -> [FunctionName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Node (Lexeme FunctionName) -> Maybe FunctionName
getMemberName [Node (Lexeme FunctionName)]
decls
getStructMemberNames (Fix (C.Typedef (Fix (C.Struct Lexeme FunctionName
_ [Node (Lexeme FunctionName)]
decls)) Lexeme FunctionName
_)) =
    (Node (Lexeme FunctionName) -> Maybe FunctionName)
-> [Node (Lexeme FunctionName)] -> [FunctionName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Node (Lexeme FunctionName) -> Maybe FunctionName
getMemberName [Node (Lexeme FunctionName)]
decls
getStructMemberNames Node (Lexeme FunctionName)
_ = []

getMemberName :: C.Node (C.Lexeme Text) -> Maybe Text
getMemberName :: Node (Lexeme FunctionName) -> Maybe FunctionName
getMemberName (Fix (C.MemberDecl (Fix (C.VarDecl Node (Lexeme FunctionName)
_ (C.L AlexPosn
_ LexemeClass
_ FunctionName
name) [Node (Lexeme FunctionName)]
_)) Maybe (Lexeme FunctionName)
_)) = FunctionName -> Maybe FunctionName
forall a. a -> Maybe a
Just FunctionName
name
getMemberName (Fix (C.Commented Node (Lexeme FunctionName)
_ (Fix (C.MemberDecl (Fix (C.VarDecl Node (Lexeme FunctionName)
_ (C.L AlexPosn
_ LexemeClass
_ FunctionName
name) [Node (Lexeme FunctionName)]
_)) Maybe (Lexeme FunctionName)
_)))) = FunctionName -> Maybe FunctionName
forall a. a -> Maybe a
Just FunctionName
name
getMemberName Node (Lexeme FunctionName)
_ = Maybe FunctionName
forall a. Maybe a
Nothing

buildPointsToSummaryFromAnnotation :: AnnotationMap -> FunctionName -> C.Node (C.Lexeme Text) -> PointsTo.PointsToSummary
buildPointsToSummaryFromAnnotation :: AnnotationMap
-> FunctionName -> Node (Lexeme FunctionName) -> PointsToSummary
buildPointsToSummaryFromAnnotation AnnotationMap
annotations FunctionName
funcName Node (Lexeme FunctionName)
_ =
    let
        funcAnns :: Map FunctionName SecurityRank
funcAnns = Map FunctionName SecurityRank
-> Maybe (Map FunctionName SecurityRank)
-> Map FunctionName SecurityRank
forall a. a -> Maybe a -> a
fromMaybe Map FunctionName SecurityRank
forall k a. Map k a
Map.empty (FunctionName
-> AnnotationMap -> Maybe (Map FunctionName SecurityRank)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FunctionName
funcName AnnotationMap
annotations)
        outputPointsTo' :: PointsToMap
outputPointsTo' = (PointsToMap -> FunctionName -> SecurityRank -> PointsToMap)
-> PointsToMap -> Map FunctionName SecurityRank -> PointsToMap
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' PointsToMap -> FunctionName -> SecurityRank -> PointsToMap
forall p. PointsToMap -> FunctionName -> p -> PointsToMap
buildOutputPointsTo PointsToMap
forall k a. Map k a
Map.empty Map FunctionName SecurityRank
funcAnns
    in
        Context -> PointsToSummaryData -> PointsToSummary
forall k a. k -> a -> Map k a
Map.singleton [] (Set AbstractLocation -> PointsToMap -> PointsToSummaryData
PointsToSummaryData Set AbstractLocation
forall a. Set a
Set.empty PointsToMap
outputPointsTo')
  where
    buildOutputPointsTo :: PointsToMap -> FunctionName -> p -> PointsToMap
buildOutputPointsTo PointsToMap
acc FunctionName
key p
_ =
        case FunctionName -> FunctionName -> [FunctionName]
T.splitOn FunctionName
":" FunctionName
key of
            [FunctionName
"source", FunctionName
paramName] ->
                AbstractLocation
-> Set AbstractLocation -> PointsToMap -> PointsToMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (AbstractLocation -> AbstractLocation
DerefLocation (FunctionName -> AbstractLocation
VarLocation FunctionName
paramName)) (AbstractLocation -> Set AbstractLocation
forall a. a -> Set a
Set.singleton (Int -> AbstractLocation
HeapLocation (FunctionName -> Int
hash FunctionName
funcName))) PointsToMap
acc
            [FunctionName]
_ -> PointsToMap
acc
    hash :: FunctionName -> Int
hash = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> (FunctionName -> Int) -> FunctionName -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunctionName -> Int
T.length -- Simple hash for demonstration