Permalink
Browse files

import what's done already

  • Loading branch information...
1 parent 7417780 commit 15d1db77c79f0c135d13ff4f8a8b79009afd86a4 @temoto committed Aug 20, 2010
Showing with 332 additions and 0 deletions.
  1. +24 −0 Makefile
  2. +90 −0 NginxLint/Data.hs
  3. +59 −0 NginxLint/Hint.hs
  4. +46 −0 NginxLint/Main.hs
  5. +93 −0 NginxLint/Parse.hs
  6. +20 −0 test.conf
View
@@ -0,0 +1,24 @@
+# nginxlint make recipe
+
+# settings
+HC := ghc
+
+# Don't modify anything below without a reason.
+srcs := \
+ NginxLint/Data.hs \
+ NginxLint/Hint.hs \
+ NginxLint/Main.hs \
+ NginxLint/Parse.hs
+
+.PHONY: all clean test
+
+all: nginxlint
+
+clean:
+ @rm -f nginxlint $(patsubst %.hs,%.hi,${srcs}) $(patsubst %.hs,%.o,${srcs})
+
+nginxlint: ${srcs}
+ @$(HC) --make ${srcs} -o $@
+
+test: nginxlint
+ @./nginxlint test.conf
View
@@ -0,0 +1,90 @@
+{-# LANGUAGE DeriveDataTypeable, MultiParamTypeClasses #-}
+module NginxLint.Data where
+
+import Data.Data
+import Data.Generics.Str
+import Data.Generics.Uniplate.Operations
+import Data.List (intercalate)
+import qualified Text.ParserCombinators.Parsec as P
+
+
+type Ident = String
+
+data NgFile = NgFile FilePath [Decl]
+ deriving (Eq, Show)
+
+data Arg
+ = RawString P.SourcePos String
+ | QuotedString P.SourcePos String
+ | Integer P.SourcePos Integer
+ deriving (Data, Eq, Show, Typeable)
+
+data Decl
+ = Decl P.SourcePos Ident [Arg]
+ | Block P.SourcePos Ident [Arg] [Decl]
+ | If P.SourcePos [Arg] [Decl]
+ | Location P.SourcePos [Arg] [Decl]
+ deriving (Data, Eq, Show, Typeable)
+
+instance Typeable P.SourcePos where
+
+instance Data P.SourcePos where
+
+instance Biplate NgFile Decl where
+ biplate (NgFile fname ds) = (listStr ds, \newds -> NgFile fname (strList newds))
+
+instance Uniplate Decl where
+ uniplate d@(Decl _ _ _) = (Zero, \Zero -> d)
+ uniplate d@(Block pos ident args children) = (listStr children, \newds -> Block pos ident args (strList newds))
+ uniplate d@(If pos args children) = (listStr children, \newds -> If pos args (strList newds))
+ uniplate d@(Location pos args children) = (listStr children, \newds -> If pos args (strList newds))
+
+
+class NgPositioned a where
+ ng_getPosition :: a -> P.SourcePos
+
+
+instance NgPositioned Arg where
+ ng_getPosition (RawString pos _) = pos
+ ng_getPosition (QuotedString pos _) = pos
+ ng_getPosition (Integer pos _) = pos
+
+instance NgPositioned Decl where
+ ng_getPosition (Decl pos _ _) = pos
+ ng_getPosition (Block pos _ _ _) = pos
+
+
+-- Hint where, category, id, content
+data Hint = Hint P.SourcePos String String String
+
+
+instance NgPositioned Hint where
+ ng_getPosition (Hint pos _ _ _) = pos
+
+
+-- pretty print for P.SourcePos
+ppSrcPos pos = P.sourceName pos ++ ":" ++ show (P.sourceLine pos)
+ ++ ":" ++ show (P.sourceColumn pos)
+
+-- pretty print for Arg
+ppArg (RawString _ s) = s
+ppArg (QuotedString _ s) = "\"" ++ s ++ "\""
+ppArg (Integer _ i) = show i
+
+ppArgList = concatMap (\a -> " " ++ ppArg a)
+
+-- pretty print for Decl
+ppDecl (Decl _ name args ) = name ++ ppArgList args ++ ";\n"
+ppDecl (Block _ name args ds) = name ++ ppArgList args ++ " {\n"
+ ++ concatMap (\d -> " " ++ ppDecl d) ds
+ ++ "}\n"
+ppDecl (If pos args ds) = "if ( " ++ ppArgList args ++ " ) {\n"
+ ++ concatMap (\d -> " " ++ ppDecl d) ds
+ ++ "}\n"
+ppDecl (Location pos args ds) = ppDecl $ Block pos "location" args ds
+
+
+-- pretty print for Hint
+ppHint h@(Hint _ cat ident content) = ppSrcPos pos ++ " "
+ ++ cat ++ ":" ++ ident ++ ": " ++ content
+ where pos = ng_getPosition h
View
@@ -0,0 +1,59 @@
+module NginxLint.Hint where
+
+import Data.List
+import Data.Maybe
+import Debug.Trace
+import qualified Text.ParserCombinators.Parsec as P
+
+import NginxLint.Data
+import NginxLint.Parse
+
+
+argHints :: [Arg -> Maybe Hint]
+argHints = [ hintArgExcessiveQuot
+ ]
+
+declHints :: [Decl -> Maybe Hint]
+declHints = [ hintDeclPrefixRegexNoCaptures
+ ]
+
+analyzeDecl :: Decl -> [Hint]
+analyzeDecl d = mapMaybe (\f -> f d) declHints
+ ++ concatMap analyzeArg (extractDeclArgs d)
+ where extractDeclArgs (Decl _ _ args) = args
+ extractDeclArgs (Block _ _ args _) = args
+
+analyzeArg :: Arg -> [Hint]
+analyzeArg arg = mapMaybe (\f -> f arg) argHints
+
+
+declIsLocation (Block _ "location" _ _) = True
+declIsLocation _ = False
+
+isLocationRegex (Block _ "location" [RawString _ op, _] _) = op `elem` ["~", "~*"]
+isLocationRegex _ = False
+
+
+hintDeclPrefixRegexNoCaptures :: Decl -> Maybe Hint
+hintDeclPrefixRegexNoCaptures decl@(Block _ "location" [RawString _ op, RawString _ pat] _)
+ | op == "~"
+ && "^" `isPrefixOf` pat
+ && not ("(" `isInfixOf` pat) = Just $
+ Hint (ng_getPosition decl) "Loc" "prnc" ("Prefix regex location without captures: " ++ pat ++ " Use: location " ++ tail pat)
+ | otherwise = Nothing
+hintDeclPrefixRegexNoCaptures _ = Nothing
+
+
+hintDeclIfFilename :: Decl -> Maybe Hint
+hintDeclIfFilename decl@(Block _ "if" args _) = trace (show decl) Nothing
+hintDeclIfFilename _ = Nothing
+
+
+hintArgExcessiveQuot :: Arg -> Maybe Hint
+hintArgExcessiveQuot arg@(QuotedString _ qs) =
+ case P.parse plainString "" qs of
+ Left _ -> Nothing
+ Right (RawString _ s)
+ | s == qs -> Just $ Hint (ng_getPosition arg) "Arg" "eq" ("Excessive quoting: \"" ++ qs ++ "\"")
+ | otherwise -> Nothing
+hintArgExcessiveQuot _ = Nothing
View
@@ -0,0 +1,46 @@
+module Main where
+
+import Data.Generics.Uniplate.Operations
+import System.Environment
+import System.Exit
+import System.IO
+import Text.ParserCombinators.Parsec (parseFromFile)
+
+import NginxLint.Data
+import NginxLint.Hint
+import NginxLint.Parse
+
+
+main = processFiles
+
+processFiles :: IO ()
+processFiles = do
+ args <- getArgs
+ if length args >= 1 && head args == "-print"
+ then mapM_ (processFile printParsed) (tail args)
+ else mapM_ (processFile processHints) args
+
+processFile :: (NgFile -> IO ()) -> FilePath -> IO ()
+processFile fun fname = do
+ result <- parseFromFile parseFile fname
+ case result of
+ Left err -> do
+ print err
+ exitFailure
+ Right ngfile -> fun ngfile
+
+processHints :: NgFile -> IO ()
+processHints f@(NgFile fname _) = do_hints
+ where
+ do_hints = if null hints
+ then putStrLn (fname ++ ": No suggestions.")
+ else mapM_ (putStrLn . ppHint) hints
+
+ all_decls = universeBi f
+ hints = concatMap analyzeDecl all_decls
+
+printParsed :: NgFile -> IO ()
+printParsed (NgFile fname decls) = do
+ putStrLn $ "# " ++ fname
+ putStrLn $ "#"
+ mapM_ (putStrLn . ppDecl) decls
View
@@ -0,0 +1,93 @@
+module NginxLint.Parse where
+
+import Debug.Trace
+import Text.ParserCombinators.Parsec hiding (spaces)
+import Text.ParserCombinators.Parsec.Language (emptyDef)
+import qualified Text.ParserCombinators.Parsec.Token as T
+
+import NginxLint.Data
+
+
+parseFile :: Parser NgFile
+parseFile = do whiteSpace
+ pos <- getPosition
+ ds <- many decl
+ eof
+ return $ NgFile (sourceName pos) ds
+
+decl :: Parser Decl
+decl = try ifDecl <|> nonIfDecl
+
+nonIfDecl = try blockDecl <|> oneDecl
+
+oneDecl = do whiteSpace
+ pos <- getPosition
+ name <- identifier
+ args <- many argument
+ lexeme (char ';')
+ return $ Decl pos name args
+ <?> "directive"
+
+blockDecl = do whiteSpace
+ pos <- getPosition
+ name <- identifier
+ args <- try (many argument)
+ ds <- braces (many decl)
+ return $ Block pos name args ds
+
+ifDecl = do whiteSpace
+ pos <- getPosition
+ reserved "if"
+ symbol "("
+ args <- argument `manyTill` try (symbol ")")
+ ds <- braces (many nonIfDecl)
+ return $ Block pos "if" args ds
+
+argument :: Parser Arg
+argument = quotedString <|> plainString
+ <|> parseInteger
+ <?> "directive argument"
+
+parseInteger = do pos <- getPosition
+ n <- integer
+ return $ Integer pos n
+
+quotedString = do pos <- getPosition
+ symbol "\""
+ s <- many (noneOf "\"")
+ symbol "\""
+ return $ QuotedString pos s
+
+plainString = do pos <- getPosition
+ s <- lexeme ps
+ return $ RawString pos s
+ <?> "plain string"
+ where ps = many1 (noneOf " \"\v\t\r\n(){};")
+
+
+lexer :: T.TokenParser ()
+lexer = T.makeTokenParser nginxDef
+
+nginxDef = emptyDef
+ { T.commentLine = "#"
+ , T.nestedComments = False
+ , T.opLetter = oneOf "<=>"
+ , T.reservedNames = ["if"]
+ }
+
+whiteSpace = T.whiteSpace lexer
+lexeme = T.lexeme lexer
+symbol = T.symbol lexer
+braces = T.braces lexer
+natural = T.natural lexer
+float = T.float lexer
+integer = T.natural lexer
+parens = T.parens lexer
+comma = T.comma lexer
+semi = T.semi lexer
+dot = T.dot lexer
+identifier = T.identifier lexer
+reserved = T.reserved lexer
+commaSep = T.commaSep lexer
+commaSep1 = T.commaSep1 lexer
+semiSep = T.semiSep lexer
View
@@ -0,0 +1,20 @@
+# Normal string.
+error_log /var/log/nginx/error.log info;
+
+# Quoting is not needed.
+error_log "/var/log/nginx/quoted.log" info;
+
+
+# Regex is not needed.
+location ~ ^/foo {
+ root /excessive/regex;
+}
+
+# Regex may be not needed (if user didn't want case insensitive matching)
+location ~* ^/foo {
+ root /maybe/excessive/regex;
+}
+
+if (!-f $request_filename) {
+ root /dont/use/if;
+}

0 comments on commit 15d1db7

Please sign in to comment.