提交 bb49cf8e 编写于 作者: V Vidar Holen

Parse the contents of unquoted here documents

上级 de1fa615
......@@ -23,6 +23,9 @@ import qualified Text.Regex as Re
data Id = Id Int deriving (Show, Eq, Ord)
data Quoted = Quoted | Unquoted deriving (Show, Eq)
data Dashed = Dashed | Undashed deriving (Show, Eq)
data Token =
TA_Base Id String Token
| TA_Binary Id String Token Token
......@@ -80,7 +83,7 @@ data Token =
| T_GREATAND Id
| T_Glob Id String
| T_Greater Id
| T_HereDoc Id Bool Bool String String
| T_HereDoc Id Dashed Quoted String [Token]
| T_HereString Id Token
| T_If Id
| T_IfExpression Id [([Token],[Token])] [Token]
......@@ -208,6 +211,7 @@ analyze f g i t =
delve (T_Condition id typ token) = d1 token $ T_Condition id typ
delve (T_Extglob id str l) = dl l $ T_Extglob id str
delve (T_DollarBraced id op) = d1 op $ T_DollarBraced id
delve (T_HereDoc id d q str l) = dl l $ T_HereDoc id d q str
delve (TC_And id typ str t1 t2) = d2 t1 t2 $ TC_And id typ str
delve (TC_Or id typ str t1 t2) = d2 t1 t2 $ TC_Or id typ str
......
......@@ -549,6 +549,7 @@ prop_checkUnquotedExpansions3a= verifyTree checkUnquotedExpansions "[ ! $(foo) ]
prop_checkUnquotedExpansions4 = verifyNotTree checkUnquotedExpansions "[[ $(foo) == cow ]]"
prop_checkUnquotedExpansions5 = verifyNotTree checkUnquotedExpansions "for f in $(cmd); do echo $f; done"
prop_checkUnquotedExpansions6 = verifyNotTree checkUnquotedExpansions "$(cmd)"
prop_checkUnquotedExpansions7 = verifyNotTree checkUnquotedExpansions "cat << foo\n$(ls)\nfoo"
checkUnquotedExpansions t tree =
check t
where
......@@ -870,6 +871,7 @@ inUnquotableContext tree t =
T_Redirecting _ _ _ -> or $ map (isCommand t) ["local", "declare"]
T_DoubleQuoted _ _ -> True
T_CaseExpression _ _ _ -> True
T_HereDoc _ _ _ _ _ -> True
T_ForIn _ _ _ _ -> True -- Pragmatically assume it's desirable here
x -> case Map.lookup (getId x) tree of
Nothing -> False
......@@ -1296,8 +1298,8 @@ checkSshHereDoc (T_Redirecting _ redirs cmd)
mapM_ checkHereDoc redirs
where
hasVariables = mkRegex "[`$]"
checkHereDoc (T_FdRedirect _ _ (T_HereDoc id _ False token str))
| isJust $ matchRegex hasVariables str =
checkHereDoc (T_FdRedirect _ _ (T_HereDoc id _ Unquoted token tokens))
| not (all isConstant tokens) =
warn id $ "Quote '" ++ token ++ "' to make here document expansions happen on the server side rather than on the client."
checkHereDoc _ = return ()
checkSshHereDoc _ = return ()
......
......@@ -681,24 +681,24 @@ readBackTicked = called "backtick expansion" $ do
subStart <- getPosition
subString <- readGenericLiteral (char '`')
char '`'
-- Result positions may be off due to escapes
result <- subParse subStart readCompoundList (unEscape subString)
return $ T_Backticked id result
where
-- Position may be off due to escapes
subParse pos parser input = do
lastPosition <- getPosition
lastInput <- getInput
setPosition pos
setInput input
result <- parser
setInput lastInput
setPosition lastPosition
return result
unEscape [] = []
unEscape ('\\':x:rest) | x `elem` "\"$`\\" = x : unEscape rest
unEscape ('\\':'\n':rest) = unEscape rest
unEscape (c:rest) = c : unEscape rest
subParse pos parser input = do
lastPosition <- getPosition
lastInput <- getInput
setPosition pos
setInput input
result <- parser
setInput lastInput
setPosition lastPosition
return result
prop_readDoubleQuoted = isOk readDoubleQuoted "\"Hello $FOO\""
prop_readDoubleQuoted2 = isOk readDoubleQuoted "\"$'\""
......@@ -969,7 +969,7 @@ readHereDoc = called "here document" $ do
fid <- getNextId
pos <- getPosition
try $ string "<<"
dashed <- (char '-' >> return True) <|> return False
dashed <- (char '-' >> return Dashed) <|> return Undashed
tokenPosition <- getPosition
sp <- spacing
optional $ do
......@@ -977,37 +977,56 @@ readHereDoc = called "here document" $ do
let message = "Shells are space sensitive. Use '< <(cmd)', not '<<" ++ sp ++ "(cmd)'."
parseProblemAt pos ErrorC message
hid <- getNextId
(quoted, endToken) <- (readNormalLiteral "" >>= (\x -> return (False, stripLiteral x)) )
<|> (readDoubleQuotedLiteral >>= return . (\x -> (True, stripLiteral x)))
<|> (readSingleQuotedLiteral >>= return . (\x -> (True, x)))
(quoted, endToken) <- (readNormalLiteral "" >>= (\x -> return (Unquoted, stripLiteral x)) )
<|> (readDoubleQuotedLiteral >>= return . (\x -> (Quoted, stripLiteral x)))
<|> (readSingleQuotedLiteral >>= return . (\x -> (Quoted, x)))
spacing
hereInfo <- anyChar `reluctantlyTill` (linefeed >> spacing >> (string endToken) >> (disregard whitespace <|> eof))
startPos <- getPosition
hereData <- anyChar `reluctantlyTill` (linefeed >> spacing >> (string endToken) >> (disregard whitespace <|> eof))
do
linefeed
spaces <- spacing
verifyHereDoc dashed quoted spaces hereInfo
token <- string endToken
return $ T_FdRedirect fid "" $ T_HereDoc hid dashed quoted endToken hereInfo
`attempting` (eof >> debugHereDoc tokenPosition endToken hereInfo)
verifyHereDoc dashed quoted spacing hereInfo = do
when (not dashed && spacing /= "") $ parseNote ErrorC "Use <<- instead of << if you want to indent the end token."
when (dashed && filter (/= '\t') spacing /= "" ) $ parseNote ErrorC "When using <<-, you can only indent with tabs."
return ()
debugHereDoc pos endToken doc =
if endToken `isInfixOf` doc
then
let lookAt line = when (endToken `isInfixOf` line) $
parseProblemAt pos ErrorC ("Close matches include '" ++ line ++ "' (!= '" ++ endToken ++ "').")
in do
parseProblemAt pos ErrorC ("Found '" ++ endToken ++ "' further down, but not entirely by itself.")
mapM_ lookAt (lines doc)
else if (map toLower endToken) `isInfixOf` (map toLower doc)
then parseProblemAt pos ErrorC ("Found " ++ endToken ++ " further down, but with wrong casing.")
else parseProblemAt pos ErrorC ("Couldn't find end token `" ++ endToken ++ "' in the here document.")
verifyHereDoc dashed quoted spaces hereData
string endToken
parsedData <- parseHereData quoted startPos hereData
return $ T_FdRedirect fid "" $ T_HereDoc hid dashed quoted endToken parsedData
`attempting` (eof >> debugHereDoc tokenPosition endToken hereData)
where
parseHereData Quoted startPos hereData = do
id <- getNextIdAt startPos
return $ [T_Literal id hereData]
parseHereData Unquoted startPos hereData = do
subParse startPos readHereData hereData
readHereData = many $ readNormalDollar <|> readBackTicked <|> readHereLiteral
readHereLiteral = do
id <- getNextId
chars <- anyChar `reluctantlyTill1` oneOf "`$"
return $ T_Literal id chars
verifyHereDoc dashed quoted spacing hereInfo = do
when (dashed == Undashed && spacing /= "") $
parseNote ErrorC "Use <<- instead of << if you want to indent the end token."
when (dashed == Dashed && filter (/= '\t') spacing /= "" ) $
parseNote ErrorC "When using <<-, you can only indent with tabs."
return ()
debugHereDoc pos endToken doc =
if endToken `isInfixOf` doc
then
let lookAt line = when (endToken `isInfixOf` line) $
parseProblemAt pos ErrorC ("Close matches include '" ++ line ++ "' (!= '" ++ endToken ++ "').")
in do
parseProblemAt pos ErrorC ("Found '" ++ endToken ++ "' further down, but not entirely by itself.")
mapM_ lookAt (lines doc)
else if (map toLower endToken) `isInfixOf` (map toLower doc)
then parseProblemAt pos ErrorC ("Found " ++ endToken ++ " further down, but with wrong casing.")
else parseProblemAt pos ErrorC ("Couldn't find end token `" ++ endToken ++ "' in the here document.")
readFilename = readNormalWord
......
Markdown is supported
0% .
You are about to add 0 people to the discussion. Proceed with caution.
先完成此消息的编辑!
想要评论请 注册