diff --git a/src/Tokstyle/C/Linter.hs b/src/Tokstyle/C/Linter.hs index 93fc2fc..142c880 100644 --- a/src/Tokstyle/C/Linter.hs +++ b/src/Tokstyle/C/Linter.hs @@ -18,6 +18,7 @@ import qualified Tokstyle.C.Linter.BoolConversion as BoolConversion import qualified Tokstyle.C.Linter.Cast as Cast import qualified Tokstyle.C.Linter.Conversion as Conversion import qualified Tokstyle.C.Linter.Memset as Memset +import qualified Tokstyle.C.Linter.SizeArg as SizeArg import qualified Tokstyle.C.Linter.Sizeof as Sizeof import qualified Tokstyle.C.Linter.VoidCall as VoidCall @@ -28,6 +29,7 @@ linters = , ("cast" , Cast.analyse ) , ("conversion" , Conversion.analyse ) , ("memset" , Memset.analyse ) + , ("size-arg" , SizeArg.analyse ) , ("sizeof" , Sizeof.analyse ) , ("void-call" , VoidCall.analyse ) ] diff --git a/src/Tokstyle/C/Linter/SizeArg.hs b/src/Tokstyle/C/Linter/SizeArg.hs new file mode 100644 index 0000000..eaf8412 --- /dev/null +++ b/src/Tokstyle/C/Linter/SizeArg.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE Strict #-} +module Tokstyle.C.Linter.SizeArg (analyse) where + +import Data.Functor.Identity (Identity) +import qualified Data.List as List +import qualified Data.Map as Map +import Language.C.Analysis.AstAnalysis (ExprSide (..), defaultMD, + tExpr) +import Language.C.Analysis.ConstEval (constEval, intValue) +import Language.C.Analysis.SemError (invalidAST, typeMismatch) +import Language.C.Analysis.SemRep (GlobalDecls, ParamDecl (..), + Type (..)) +import Language.C.Analysis.TravMonad (Trav, TravT, catchTravError, + recordError, throwTravError) +import Language.C.Analysis.TypeUtils (canonicalType) +import Language.C.Data.Ident (Ident (..)) +import Language.C.Pretty (pretty) +import Language.C.Syntax.AST (CExpr, CExpression (..), + annotation) +import Tokstyle.C.Env (Env) +import Tokstyle.C.Patterns +import Tokstyle.C.TraverseAst (AstActions (..), astActions, + traverseAst) + + +checkArraySizes :: Ident -> [(ParamDecl, CExpr, Type)] -> Trav Env () +checkArraySizes funId ((_, _, arrTy@(ArrayTypeSize arrSize)):(ParamName sizeParam, sizeArg, sizeTy):args) + | isIntegral sizeTy && any (`List.isInfixOf` sizeParam) ["size", "len"] = + -- Ignore any name lookup errors here. VLAs have locally defined + -- array sizes, but we don't check VLAs. + catchTravError (do + arrSizeVal <- intValue <$> constEval defaultMD Map.empty arrSize + sizeArgVal <- intValue <$> constEval defaultMD Map.empty sizeArg + case (arrSizeVal, sizeArgVal) of + (Just arrSizeConst, Just sizeArgConst) | arrSizeConst < sizeArgConst -> + let annot = (annotation sizeArg, sizeTy) in + recordError $ typeMismatch ( + "size parameter `" <> sizeParam <> "` is passed constant value `" + <> show (pretty sizeArg) <> "` (= " <> show sizeArgConst <> "),\n" + <> " which is greater than the array size of `" <> show (pretty arrTy) <> "`,\n" + <> " potentially causing buffer overrun in `" <> show (pretty funId) <> "`") annot annot + _ -> return () -- not constant, or array size greater than size arg + checkArraySizes funId args + ) $ const $ return () + +checkArraySizes funId (_:xs) = checkArraySizes funId xs +checkArraySizes _ [] = return () + + +linter :: AstActions (TravT Env Identity) +linter = astActions + { doExpr = \node act -> case node of + CCall fun@(CVar funId _) args _ -> + tExpr [] RValue fun >>= \case + FunPtrParams params -> do + tys <- mapM (fmap canonicalType . tExpr [] RValue) args + checkArraySizes funId (zip3 params args tys) + act + x -> throwTravError $ invalidAST (annotation node) $ show x + + _ -> act + } + + +analyse :: GlobalDecls -> Trav Env () +analyse = traverseAst linter diff --git a/src/Tokstyle/C/Patterns.hs b/src/Tokstyle/C/Patterns.hs index c366ecf..565a7bd 100644 --- a/src/Tokstyle/C/Patterns.hs +++ b/src/Tokstyle/C/Patterns.hs @@ -5,9 +5,12 @@ {- HLINT ignore "Use camelCase" -} module Tokstyle.C.Patterns where -import Language.C.Analysis.SemRep (CompTypeRef (..), IntType (..), - Type (..), TypeDefRef (..), - TypeName (..)) +import Language.C.Analysis.SemRep (ArraySize (..), + CompTypeRef (..), Expr, + FunType (..), IntType (..), + ParamDecl (..), Type (..), + TypeDefRef (..), TypeName (..), + VarDecl (..), VarName (..)) import Language.C.Analysis.TypeUtils (canonicalType) import Language.C.Data.Ident (Ident (..), SUERef (..)) @@ -26,6 +29,15 @@ pattern TY_sockaddr_in6_ptr <- TY_struct_ptr "sockaddr_in6" pattern TY_canon_bool <- (canonicalType -> DirectType (TyIntegral TyBool) _ _) +pattern ArrayTypeSize :: Expr -> Type +pattern ArrayTypeSize arrSize <- ArrayType _ (ArraySize _ arrSize) _ _ + +pattern ParamName :: String -> ParamDecl +pattern ParamName name <- ParamDecl (VarDecl (VarName (Ident name _ _) _) _ _) _ + +pattern FunPtrParams :: [ParamDecl] -> Type +pattern FunPtrParams params <- (canonicalType -> PtrType (FunctionType (FunType _ params _) _) _ _) + isEnum :: Type -> Bool isEnum (canonicalType -> DirectType TyEnum{} _ _) = True isEnum _ = False diff --git a/test/Tokstyle/C/Linter/SizeArgSpec.hs b/test/Tokstyle/C/Linter/SizeArgSpec.hs new file mode 100644 index 0000000..8c33c54 --- /dev/null +++ b/test/Tokstyle/C/Linter/SizeArgSpec.hs @@ -0,0 +1,169 @@ +{-# LANGUAGE OverloadedStrings #-} +module Tokstyle.C.Linter.SizeArgSpec (spec) where + +import Test.Hspec (Spec, it, shouldBe) + +import qualified Data.Text as Text +import Tokstyle.C.Linter (allWarnings, analyse) +import Tokstyle.C.LinterSpec (mustParse) + + +spec :: Spec +spec = do + it "warns when constant size argument is not the array size" $ do + ast <- mustParse + [ "void consume(char *arr, int size);" + , "void caller(void) {" + , " char arr[12];" + , " consume(arr, 13);" + , "}" + ] + analyse allWarnings ast + `shouldBe` + [ Text.unlines + [ "test.c:4: (column 16) [ERROR] >>> Type mismatch" + , " size parameter `size` is passed constant value `13` (= 13)," + , " which is greater than the array size of `char [12]`," + , " potentially causing buffer overrun in `consume`" + ] + ] + + it "can see through enum constants" $ do + ast <- mustParse + [ "enum { SIZE = 12 };" + , "void consume(char *arr, int size);" + , "void caller(void) {" + , " char arr[SIZE];" + , " consume(arr, SIZE + 1);" + , "}" + ] + analyse allWarnings ast + `shouldBe` + [ Text.unlines + [ "test.c:5: (column 16) [ERROR] >>> Type mismatch" + , " size parameter `size` is passed constant value `SIZE + 1` (= 13)," + , " which is greater than the array size of `char [SIZE]`," + , " potentially causing buffer overrun in `consume`" + ] + ] + + it "can see through typedefs" $ do + ast <- mustParse + [ "enum { SIZE = 12 };" + , "typedef unsigned int size_t;" + , "void consume(char *arr, size_t size);" + , "void caller(void) {" + , " char arr[SIZE];" + , " consume(arr, SIZE + 1);" + , "}" + ] + analyse allWarnings ast + `shouldBe` + [ Text.unlines + [ "test.c:6: (column 16) [ERROR] >>> Type mismatch" + , " size parameter `size` is passed constant value `SIZE + 1` (= 13)," + , " which is greater than the array size of `char [SIZE]`," + , " potentially causing buffer overrun in `consume`" + ] + ] + + it "can see through array typedefs" $ do + ast <- mustParse + [ "typedef char My_Array[12];" + , "void consume(char *arr, int size);" + , "void caller(void) {" + , " My_Array arr;" + , " consume(arr, 13);" + , "}" + ] + analyse allWarnings ast + `shouldBe` + [ Text.unlines + [ "test.c:5: (column 16) [ERROR] >>> Type mismatch" + , " size parameter `size` is passed constant value `13` (= 13)," + , " which is greater than the array size of `char [12]`," + , " potentially causing buffer overrun in `consume`" + ] + ] + + it "can see through function typedefs" $ do + ast <- mustParse + [ "typedef void consume_cb(char *arr, int size);" + , "consume_cb consume;" + , "void caller(void) {" + , " char arr[12];" + , " consume(arr, 13);" + , "}" + ] + analyse allWarnings ast + `shouldBe` + [ Text.unlines + [ "test.c:5: (column 16) [ERROR] >>> Type mismatch" + , " size parameter `size` is passed constant value `13` (= 13)," + , " which is greater than the array size of `char [12]`," + , " potentially causing buffer overrun in `consume`" + ] + ] + + it "works on function pointers" $ do + ast <- mustParse + [ "typedef void consume_cb(char *arr, int size);" + , "void caller(consume_cb *consume) {" + , " char arr[12];" + , " consume(arr, 13);" + , "}" + ] + analyse allWarnings ast + `shouldBe` + [ Text.unlines + [ "test.c:4: (column 16) [ERROR] >>> Type mismatch" + , " size parameter `size` is passed constant value `13` (= 13)," + , " which is greater than the array size of `char [12]`," + , " potentially causing buffer overrun in `consume`" + ] + ] + + it "works on array parameters" $ do + ast <- mustParse + [ "typedef void consume_cb(char *arr, int size);" + , "void caller(consume_cb *consume, char arr[12]) {" + , " consume(arr, 13);" + , "}" + ] + analyse allWarnings ast + `shouldBe` + [ Text.unlines + [ "test.c:3: (column 16) [ERROR] >>> Type mismatch" + , " size parameter `size` is passed constant value `13` (= 13)," + , " which is greater than the array size of `char [12]`," + , " potentially causing buffer overrun in `consume`" + ] + ] + + it "warns about string literal overrun" $ do + ast <- mustParse + [ "void consume(char *arr, int size);" + , "void caller(void) {" + , " consume(\"hello world\", 13);" + , "}" + ] + analyse allWarnings ast + `shouldBe` + [ Text.unlines + [ "test.c:3: (column 26) [ERROR] >>> Type mismatch" + , " size parameter `size` is passed constant value `13` (= 13)," + , " which is greater than the array size of `char [static 11]`," + , " potentially causing buffer overrun in `consume`" + ] + ] + + it "ignores calls where the parameter name does not indicate it's a size" $ do + ast <- mustParse + [ "typedef char My_Array[12];" + , "void consume(char *file, int line);" + , "void caller(void) {" + , " consume(\"hello.c\", 123);" + , "}" + ] + analyse allWarnings ast + `shouldBe` [] diff --git a/tokstyle.cabal b/tokstyle.cabal index 9fee7ca..9efbce3 100644 --- a/tokstyle.cabal +++ b/tokstyle.cabal @@ -24,6 +24,7 @@ library Tokstyle.C.Linter.Cast Tokstyle.C.Linter.Conversion Tokstyle.C.Linter.Memset + Tokstyle.C.Linter.SizeArg Tokstyle.C.Linter.Sizeof Tokstyle.C.Linter.VoidCall Tokstyle.C.Patterns @@ -144,6 +145,7 @@ test-suite testsuite main-is: testsuite.hs other-modules: Tokstyle.C.Linter.MemsetSpec + Tokstyle.C.Linter.SizeArgSpec Tokstyle.C.Linter.SizeofSpec Tokstyle.C.Linter.VoidCallSpec Tokstyle.C.LinterSpec