diff --git a/dhscanner-kbgen.cabal b/dhscanner-kbgen.cabal --- a/dhscanner-kbgen.cabal +++ b/dhscanner-kbgen.cabal @@ -33,7 +33,7 @@ * explain in plain English your query's purpose * et voilà ! -version: 2.2.0 +version: 2.3.0 license: GPL-3.0-only license-file: LICENSE author: OrenGitHub diff --git a/src/Kbgen.hs b/src/Kbgen.hs --- a/src/Kbgen.hs +++ b/src/Kbgen.hs @@ -64,6 +64,7 @@ ConstString(..), ConstInteger(..), MethodOfClass(..), + MethodHasName(..), ClassHas1stPartySuper(..), ClassHas3rdPartySuper(..), CallMethodOfUntypedNamedParam(..), @@ -72,6 +73,11 @@ ConstBoolTrue(..), ConstNull(..), GatedReturn(..), + TopLevelIfThenElseGadget(..), + CallGuardedByCondInThenPart(..), + CallGuardedByCondInElsePart(..), + ThenPart(..), + ElsePart(..), Comparison(..), CallableReturnsValue(..), CallableReturnsWithoutValue(..), @@ -727,6 +733,45 @@ -- This is how the fact will look inside the Prolog file -- -- @ +-- kb_method_has_name( Method, Name ). +-- @ +-- +-- __When should I use this fact__ +-- +-- @ +-- \@RestController +-- public class OidcRestController { +-- \@RequestMapping( method = RequestMethod.GET ) +-- public void oidc( ... ) { ... } +-- } +-- @ +-- +-- __Writing a predicate with this fact and others__ +-- +-- @ +-- method_of_class_by_names( Method, MethodName, ClassName ) :- +-- kb_method_has_name( Method, MethodName ), +-- kb_method_of_class( Method, Class ), +-- kb_class_def( Class, ClassName, _ ). +-- @ +-- +-- Other facts combined in this example predicate: +-- +-- * 'MethodOfClass' +-- * 'ClassDef' +-- +data MethodHasName = MethodHasName + Method -- ^ + Token.MethodName -- ^ + deriving ( Show, Eq, Ord, Generic, ToJSON, FromJSON ) + +-- | +-- +-- __Name__ +-- +-- This is how the fact will look inside the Prolog file +-- +-- @ -- kb_arg_i_for_call( Arg, Index, Call ). -- @ -- @@ -1061,6 +1106,97 @@ -- This is how the fact will look inside the Prolog file -- -- @ +-- kb_top_level_if_then_else_gadget( Callable, Cond, ThenPart, ElsePart ). +-- @ +-- +-- __When should I use this fact__ +-- +-- Every @if@ statement with a non-empty else, sitting directly in the +-- callable\'s body ( not nested inside another @if@ ), fires this fact. +-- The bitcode keeps no locations for the then \/ else parts, so both +-- wrap the location of the condition, and render as +-- @then_part_startloc_...@ \/ @else_part_startloc_...@. +-- +-- @ +-- if (isValidRedirectUrl(redirectUrl)) { +-- response.sendRedirect(redirectUrl); +-- } else { +-- response.sendError(HttpServletResponse.SC_BAD_REQUEST); +-- } +-- @ +-- +-- __Writing a predicate with this fact and others__ +-- +-- @ +-- sanitized_by_error_in_else_part( Callable, Call, Cond ) :- +-- kb_top_level_if_then_else_gadget( Callable, Cond, ThenPart, ElsePart ), +-- kb_call_guarded_by_cond_in_then_part( Call, Cond, ThenPart ), +-- kb_call_guarded_by_cond_in_else_part( ErrorCall, Cond, ElsePart ), +-- kb_call_resolved( ErrorCall, \'jakarta.servlet.http.HttpServletResponse.sendError\' ). +-- @ +-- +-- Other facts combined in this example predicate: +-- +-- * 'CallGuardedByCondInThenPart' +-- * 'CallGuardedByCondInElsePart' +-- * 'CallResolved' +-- +data TopLevelIfThenElseGadget = TopLevelIfThenElseGadget + Callable -- ^ + Cond -- ^ + ThenPart -- ^ + ElsePart -- ^ + deriving ( Show, Eq, Ord, Generic, ToJSON, FromJSON ) + +-- | +-- +-- __Name__ +-- +-- This is how the fact will look inside the Prolog file +-- +-- @ +-- kb_call_guarded_by_cond_in_then_part( Call, Cond, ThenPart ). +-- @ +-- +-- __When should I use this fact__ +-- +-- Every call in the then part of a 'TopLevelIfThenElseGadget' fires +-- this fact, including calls in @if@ statements nested inside it. +-- +data CallGuardedByCondInThenPart = CallGuardedByCondInThenPart + Call -- ^ + Cond -- ^ + ThenPart -- ^ + deriving ( Show, Eq, Ord, Generic, ToJSON, FromJSON ) + +-- | +-- +-- __Name__ +-- +-- This is how the fact will look inside the Prolog file +-- +-- @ +-- kb_call_guarded_by_cond_in_else_part( Call, Cond, ElsePart ). +-- @ +-- +-- __When should I use this fact__ +-- +-- Every call in the else part of a 'TopLevelIfThenElseGadget' fires +-- this fact, including calls in @if@ statements nested inside it. +-- +data CallGuardedByCondInElsePart = CallGuardedByCondInElsePart + Call -- ^ + Cond -- ^ + ElsePart -- ^ + deriving ( Show, Eq, Ord, Generic, ToJSON, FromJSON ) + +-- | +-- +-- __Name__ +-- +-- This is how the fact will look inside the Prolog file +-- +-- @ -- kb_comparison( Cond, Lhs, Rhs, Op ). -- @ -- @@ -1172,6 +1308,8 @@ data Rhs = Rhs Location deriving ( Show, Eq, Ord, Generic, ToJSON, FromJSON ) data ComparisonOp = ComparisonOp String deriving ( Show, Eq, Ord, Generic, ToJSON, FromJSON ) data ReturnedValue = ReturnedValue Location deriving ( Show, Eq, Ord, Generic, ToJSON, FromJSON ) +data ThenPart = ThenPart Location deriving ( Show, Eq, Ord, Generic, ToJSON, FromJSON ) +data ElsePart = ElsePart Location deriving ( Show, Eq, Ord, Generic, ToJSON, FromJSON ) data Keyword = Keyword String deriving ( Show, Eq, Ord, Generic, ToJSON, FromJSON ) data Resolved = Resolved Fqn.Fqn deriving ( Show, Eq, Ord, Generic, ToJSON, FromJSON ) @@ -1212,10 +1350,14 @@ | ConstBoolTrueCtor ConstBoolTrue | ConstNullCtor ConstNull | GatedReturnCtor GatedReturn + | TopLevelIfThenElseGadgetCtor TopLevelIfThenElseGadget + | CallGuardedByCondInThenPartCtor CallGuardedByCondInThenPart + | CallGuardedByCondInElsePartCtor CallGuardedByCondInElsePart | ComparisonCtor Comparison | CallableReturnsValueCtor CallableReturnsValue | CallableReturnsWithoutValueCtor CallableReturnsWithoutValue | MethodOfClassCtor MethodOfClass + | MethodHasNameCtor MethodHasName | ClassAnnotationCtor ClassAnnotation | ParamiOfCallableCtor ParamiOfCallable | KeywordArgForCallCtor KeywordArgForCall @@ -1254,10 +1396,14 @@ prologify (ConstBoolTrueCtor content) = prologify_ConstBoolTrue content prologify (ConstNullCtor content) = prologify_ConstNull content prologify (GatedReturnCtor content) = prologify_GatedReturn content +prologify (TopLevelIfThenElseGadgetCtor content) = prologify_TopLevelIfThenElseGadget content +prologify (CallGuardedByCondInThenPartCtor content) = prologify_CallGuardedByCondInThenPart content +prologify (CallGuardedByCondInElsePartCtor content) = prologify_CallGuardedByCondInElsePart content prologify (ComparisonCtor content) = prologify_Comparison content prologify (CallableReturnsValueCtor content) = prologify_CallableReturnsValue content prologify (CallableReturnsWithoutValueCtor content) = prologify_CallableReturnsWithoutValue content prologify (MethodOfClassCtor content) = prologify_MethodOfClass content +prologify (MethodHasNameCtor content) = prologify_MethodHasName content prologify (ClassAnnotationCtor content) = prologify_ClassAnnotation content prologify (ParamiOfCallableCtor content) = prologify_ParamiOfCallable content prologify (ParamResolvedTypeCtor content) = prologify_ParamResolvedType content @@ -1359,6 +1505,30 @@ prologify_GatedReturn :: GatedReturn -> String prologify_GatedReturn (GatedReturn (Cond c) (ReturnedValue v)) = prologify_GatedReturn' c v +thenPartify :: Location -> String +thenPartify l = "then_part_" ++ locationify l + +elsePartify :: Location -> String +elsePartify l = "else_part_" ++ locationify l + +prologify_TopLevelIfThenElseGadget' :: Location -> Location -> Location -> Location -> String +prologify_TopLevelIfThenElseGadget' callable c t e = printf "kb_top_level_if_then_else_gadget( %s, %s, %s, %s )." (locationify callable) (locationify c) (thenPartify t) (elsePartify e) + +prologify_TopLevelIfThenElseGadget :: TopLevelIfThenElseGadget -> String +prologify_TopLevelIfThenElseGadget (TopLevelIfThenElseGadget (Callable callable) (Cond c) (ThenPart t) (ElsePart e)) = prologify_TopLevelIfThenElseGadget' callable c t e + +prologify_CallGuardedByCondInThenPart' :: Location -> Location -> Location -> String +prologify_CallGuardedByCondInThenPart' call c t = printf "kb_call_guarded_by_cond_in_then_part( %s, %s, %s )." (locationify call) (locationify c) (thenPartify t) + +prologify_CallGuardedByCondInThenPart :: CallGuardedByCondInThenPart -> String +prologify_CallGuardedByCondInThenPart (CallGuardedByCondInThenPart (Call call) (Cond c) (ThenPart t)) = prologify_CallGuardedByCondInThenPart' call c t + +prologify_CallGuardedByCondInElsePart' :: Location -> Location -> Location -> String +prologify_CallGuardedByCondInElsePart' call c e = printf "kb_call_guarded_by_cond_in_else_part( %s, %s, %s )." (locationify call) (locationify c) (elsePartify e) + +prologify_CallGuardedByCondInElsePart :: CallGuardedByCondInElsePart -> String +prologify_CallGuardedByCondInElsePart (CallGuardedByCondInElsePart (Call call) (Cond c) (ElsePart e)) = prologify_CallGuardedByCondInElsePart' call c e + prologify_Comparison' :: Location -> Location -> Location -> String -> String prologify_Comparison' c l r op = printf "kb_comparison( %s, %s, %s, %s )." (locationify c) (locationify l) (locationify r) op @@ -1382,6 +1552,12 @@ prologify_MethodOfClass :: MethodOfClass -> String prologify_MethodOfClass (MethodOfClass (Method m) (Class c)) = prologify_MethodOfClass' m c + +prologify_MethodHasName' :: Location -> String -> String +prologify_MethodHasName' m name = printf "kb_method_has_name( %s, \'%s\' )." (locationify m) name + +prologify_MethodHasName :: MethodHasName -> String +prologify_MethodHasName (MethodHasName (Method m) (Token.MethodName (Token.Named name _))) = prologify_MethodHasName' m name prologify_ClassHas1stPartySuper' :: Location -> String -> FilePath -> String prologify_ClassHas1stPartySuper' c s f = printf "kb_class_has_1st_party_super( %s, \'%s\', \'%s\' )." (locationify c) s f diff --git a/test/SmokeTests.hs b/test/SmokeTests.hs --- a/test/SmokeTests.hs +++ b/test/SmokeTests.hs @@ -1,84 +1,130 @@ -module SmokeTests (runSmokeTests) where - -import Kbgen - ( Cond (..) - , ConstNull (..) - , Fact (..) - , GatedReturn (..) - , ReturnedValue (..) - , locationify - , prologify - , restoreloc - ) -import Location (Location (..)) -import Test.Hspec (Spec, hspec, it, shouldBe) - -it' :: IO () -> String -> Spec -it' testBody label = it label testBody - -completelyInvalidLocationString :: String -completelyInvalidLocationString = "Blahhh" - -testCompletelyInvalidLocationString :: IO () -testCompletelyInvalidLocationString = restoreloc completelyInvalidLocationString `shouldBe` Nothing - -locationStringWithoutProperPrefix :: String -locationStringWithoutProperPrefix = "____startloc_1_2_endloc_3_4_foo_dot_c" - -testLocationStringWithoutProperPrefix :: IO () -testLocationStringWithoutProperPrefix = restoreloc locationStringWithoutProperPrefix `shouldBe` Nothing - -locationStringWithoutProperFormatExample1 :: String -locationStringWithoutProperFormatExample1 = "startloc_1_2_end_3_4_foo_dot_c" - -testLocationStringWithoutProperFormatExample1 :: IO () -testLocationStringWithoutProperFormatExample1 = restoreloc locationStringWithoutProperFormatExample1 `shouldBe` Nothing - -locationStringWithoutProperFormatExample2 :: String -locationStringWithoutProperFormatExample2 = "startloc_1_2_endloc____3_4_foo_dot_c" - -testLocationStringWithoutProperFormatExample2 :: IO () -testLocationStringWithoutProperFormatExample2 = restoreloc locationStringWithoutProperFormatExample2 `shouldBe` Nothing - -locationStringWithoutProperFormatExample3 :: String -locationStringWithoutProperFormatExample3 = "startloc_1_2_endloc_3______4_foo_dot_c" - -testLocationStringWithoutProperFormatExample3 :: IO () -testLocationStringWithoutProperFormatExample3 = restoreloc locationStringWithoutProperFormatExample3 `shouldBe` Nothing - -sampleLoc :: Word -> Location -sampleLoc n = - Location - { lineStart = n - , colStart = n - , lineEnd = n - , colEnd = n - , filename = "foo.c" - } - -testPrologifyConstNull :: IO () -testPrologifyConstNull = - let loc = sampleLoc 1 - expected = "kb_const_null( " ++ locationify loc ++ " )." - in prologify (ConstNullCtor (ConstNull loc)) `shouldBe` expected - -testPrologifyGatedReturn :: IO () -testPrologifyGatedReturn = - let condLoc = sampleLoc 1 - retLoc = sampleLoc 2 - gr = GatedReturn (Cond condLoc) (ReturnedValue retLoc) - expected = "kb_gated_return( " ++ locationify condLoc ++ ", " ++ locationify retLoc ++ " )." - in prologify (GatedReturnCtor gr) `shouldBe` expected - -tests :: Spec -tests = do - it' testCompletelyInvalidLocationString "completelyInvalidLocationString should return Nothing" - it' testLocationStringWithoutProperPrefix "locationStringWithoutProperPrefix should return Nothing" - it' testLocationStringWithoutProperFormatExample1 "locationStringWithoutProperFormatExample1 should return Nothing" - it' testLocationStringWithoutProperFormatExample2 "locationStringWithoutProperFormatExample2 should return Nothing" - it' testLocationStringWithoutProperFormatExample3 "locationStringWithoutProperFormatExample3 should return Nothing" - it' testPrologifyConstNull "prologify_ConstNull should render kb_const_null( )." - it' testPrologifyGatedReturn "prologify_GatedReturn should render kb_gated_return( , )." - -runSmokeTests :: IO () -runSmokeTests = hspec tests +module SmokeTests (runSmokeTests) where + +import Kbgen + ( Call (..) + , CallGuardedByCondInElsePart (..) + , CallGuardedByCondInThenPart (..) + , Callable (..) + , Cond (..) + , ConstNull (..) + , ElsePart (..) + , Fact (..) + , GatedReturn (..) + , Method (..) + , MethodHasName (..) + , ReturnedValue (..) + , ThenPart (..) + , TopLevelIfThenElseGadget (..) + , locationify + , prologify + , restoreloc + ) +import Location (Location (..)) +import qualified Token +import Test.Hspec (Spec, hspec, it, shouldBe) + +it' :: IO () -> String -> Spec +it' testBody label = it label testBody + +completelyInvalidLocationString :: String +completelyInvalidLocationString = "Blahhh" + +testCompletelyInvalidLocationString :: IO () +testCompletelyInvalidLocationString = restoreloc completelyInvalidLocationString `shouldBe` Nothing + +locationStringWithoutProperPrefix :: String +locationStringWithoutProperPrefix = "____startloc_1_2_endloc_3_4_foo_dot_c" + +testLocationStringWithoutProperPrefix :: IO () +testLocationStringWithoutProperPrefix = restoreloc locationStringWithoutProperPrefix `shouldBe` Nothing + +locationStringWithoutProperFormatExample1 :: String +locationStringWithoutProperFormatExample1 = "startloc_1_2_end_3_4_foo_dot_c" + +testLocationStringWithoutProperFormatExample1 :: IO () +testLocationStringWithoutProperFormatExample1 = restoreloc locationStringWithoutProperFormatExample1 `shouldBe` Nothing + +locationStringWithoutProperFormatExample2 :: String +locationStringWithoutProperFormatExample2 = "startloc_1_2_endloc____3_4_foo_dot_c" + +testLocationStringWithoutProperFormatExample2 :: IO () +testLocationStringWithoutProperFormatExample2 = restoreloc locationStringWithoutProperFormatExample2 `shouldBe` Nothing + +locationStringWithoutProperFormatExample3 :: String +locationStringWithoutProperFormatExample3 = "startloc_1_2_endloc_3______4_foo_dot_c" + +testLocationStringWithoutProperFormatExample3 :: IO () +testLocationStringWithoutProperFormatExample3 = restoreloc locationStringWithoutProperFormatExample3 `shouldBe` Nothing + +sampleLoc :: Word -> Location +sampleLoc n = + Location + { lineStart = n + , colStart = n + , lineEnd = n + , colEnd = n + , filename = "foo.c" + } + +testPrologifyConstNull :: IO () +testPrologifyConstNull = + let loc = sampleLoc 1 + expected = "kb_const_null( " ++ locationify loc ++ " )." + in prologify (ConstNullCtor (ConstNull loc)) `shouldBe` expected + +testPrologifyGatedReturn :: IO () +testPrologifyGatedReturn = + let condLoc = sampleLoc 1 + retLoc = sampleLoc 2 + gr = GatedReturn (Cond condLoc) (ReturnedValue retLoc) + expected = "kb_gated_return( " ++ locationify condLoc ++ ", " ++ locationify retLoc ++ " )." + in prologify (GatedReturnCtor gr) `shouldBe` expected + +testPrologifyMethodHasName :: IO () +testPrologifyMethodHasName = + let methodLoc = sampleLoc 1 + name = Token.MethodName (Token.Named "oidc" (sampleLoc 2)) + mn = MethodHasName (Method methodLoc) name + expected = "kb_method_has_name( " ++ locationify methodLoc ++ ", 'oidc' )." + in prologify (MethodHasNameCtor mn) `shouldBe` expected + +testPrologifyTopLevelIfThenElseGadget :: IO () +testPrologifyTopLevelIfThenElseGadget = + let callableLoc = sampleLoc 1 + condLoc = sampleLoc 2 + g = TopLevelIfThenElseGadget (Callable callableLoc) (Cond condLoc) (ThenPart condLoc) (ElsePart condLoc) + expected = "kb_top_level_if_then_else_gadget( " ++ locationify callableLoc ++ ", " ++ locationify condLoc ++ ", then_part_" ++ locationify condLoc ++ ", else_part_" ++ locationify condLoc ++ " )." + in prologify (TopLevelIfThenElseGadgetCtor g) `shouldBe` expected + +testPrologifyCallGuardedByCondInThenPart :: IO () +testPrologifyCallGuardedByCondInThenPart = + let callLoc = sampleLoc 1 + condLoc = sampleLoc 2 + c = CallGuardedByCondInThenPart (Call callLoc) (Cond condLoc) (ThenPart condLoc) + expected = "kb_call_guarded_by_cond_in_then_part( " ++ locationify callLoc ++ ", " ++ locationify condLoc ++ ", then_part_" ++ locationify condLoc ++ " )." + in prologify (CallGuardedByCondInThenPartCtor c) `shouldBe` expected + +testPrologifyCallGuardedByCondInElsePart :: IO () +testPrologifyCallGuardedByCondInElsePart = + let callLoc = sampleLoc 1 + condLoc = sampleLoc 2 + c = CallGuardedByCondInElsePart (Call callLoc) (Cond condLoc) (ElsePart condLoc) + expected = "kb_call_guarded_by_cond_in_else_part( " ++ locationify callLoc ++ ", " ++ locationify condLoc ++ ", else_part_" ++ locationify condLoc ++ " )." + in prologify (CallGuardedByCondInElsePartCtor c) `shouldBe` expected + +tests :: Spec +tests = do + it' testCompletelyInvalidLocationString "completelyInvalidLocationString should return Nothing" + it' testLocationStringWithoutProperPrefix "locationStringWithoutProperPrefix should return Nothing" + it' testLocationStringWithoutProperFormatExample1 "locationStringWithoutProperFormatExample1 should return Nothing" + it' testLocationStringWithoutProperFormatExample2 "locationStringWithoutProperFormatExample2 should return Nothing" + it' testLocationStringWithoutProperFormatExample3 "locationStringWithoutProperFormatExample3 should return Nothing" + it' testPrologifyConstNull "prologify_ConstNull should render kb_const_null( )." + it' testPrologifyGatedReturn "prologify_GatedReturn should render kb_gated_return( , )." + it' testPrologifyMethodHasName "prologify_MethodHasName should render kb_method_has_name( , '' )." + it' testPrologifyTopLevelIfThenElseGadget "prologify_TopLevelIfThenElseGadget should render kb_top_level_if_then_else_gadget( , , then_part_, else_part_ )." + it' testPrologifyCallGuardedByCondInThenPart "prologify_CallGuardedByCondInThenPart should render kb_call_guarded_by_cond_in_then_part( , , then_part_ )." + it' testPrologifyCallGuardedByCondInElsePart "prologify_CallGuardedByCondInElsePart should render kb_call_guarded_by_cond_in_else_part( , , else_part_ )." + +runSmokeTests :: IO () +runSmokeTests = hspec tests