picnoir/hnix
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

Guard against infinitely recursive function calls

Browse source 
Fixes #432
This commit is contained in:
John Wiegley 2019-03-10 14:06:32 -07:00
parent f2033c0694
commit 41d44b018c
1 changed files with 15 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

26
src/Nix/Exec.hs
View file

@ -253,17 +253,21 @@ instance MonadNix e m => MonadEval (NValue m) m where
infixl 1 `callFunc`
callFunc :: forall e m. (MonadNix e m, Typeable m)
=> NValue m -> m (NValue m) -> m (NValue m)
callFunc fun arg = case fun of
NVClosure params f -> do
traceM $ "callFunc:NVFunction taking " ++ show params
f arg
NVBuiltin name f -> do
span <- currentPos
withFrame Info (Calling @m @(NThunk m) name span) $ f arg
s@(NVSet m _) | Just f <- M.lookup "__functor" m -> do
traceM "callFunc:__functor"
force f $ (`callFunc` pure s) >=> (`callFunc` arg)
x -> throwError $ ErrorCall $ "Attempt to call non-function: " ++ show x
callFunc fun arg = do
frames :: Frames <- asks (view hasLens)
when (length frames > 2000) $
throwError $ ErrorCall "Function call stack exhausted"
case fun of
NVClosure params f -> do
traceM $ "callFunc:NVFunction taking " ++ show params
f arg
NVBuiltin name f -> do
span <- currentPos
withFrame Info (Calling @m @(NThunk m) name span) $ f arg
s@(NVSet m _) | Just f <- M.lookup "__functor" m -> do
traceM "callFunc:__functor"
force f $ (`callFunc` pure s) >=> (`callFunc` arg)
x -> throwError $ ErrorCall $ "Attempt to call non-function: " ++ show x
execUnaryOp :: (Framed e m, MonadVar m)
=> Scopes m (NThunk m) -> SrcSpan -> NUnaryOp -> NValue m