@@ -43,14 +43,19 @@ data ParsedOperation = RODatabaseContextOp RODatabaseContextOperator |
4343 RelVarExportOp RelVarDataExportOperator
4444
4545interpreterParserP :: Parser ParsedOperation
46−interpreterParserP = liftM RODatabaseContextOp (roDatabaseContextOperatorP <* eof) <|>
47− liftM InfoOp (infoOpP <* eof) <|>
48− liftM GraphOp (transactionGraphOpP <* eof) <|>
49− liftM ROGraphOp (roTransactionGraphOpP <* eof) <|>
50− liftM DatabaseContextExprOp (databaseExprOpP <* eof) <|>
46+interpreterParserP = safeInterpreterParserP <|>
5147 liftM ImportRelVarOp (importCSVP <* eof) <|>
5248 liftM ImportDBContextOp (tutdImportP <* eof) <|>
5349 liftM RelVarExportOp (exportCSVP <* eof)
50+
51+-- the safe interpreter never reads or writes the file system
52+safeInterpreterParserP :: Parser ParsedOperation
53+safeInterpreterParserP = liftM RODatabaseContextOp (roDatabaseContextOperatorP <* eof) <|>
54+ liftM InfoOp (infoOpP <* eof) <|>
55+ liftM GraphOp (transactionGraphOpP <* eof) <|>
56+ liftM ROGraphOp (roTransactionGraphOpP <* eof) <|>
57+ liftM DatabaseContextExprOp (databaseExprOpP <* eof)
58+
5459
5560promptText :: Maybe HeadName -> StringType
5661promptText mHeadName = "TutorialD (" `T.append` transInfo `T.append` "): "
@@ -60,9 +65,15 @@ promptText mHeadName = "TutorialD (" `T.append` transInfo `T.append` "): "
6065parseTutorialD :: String -> Either ParseError ParsedOperation
6166parseTutorialD inputString = parse interpreterParserP "" inputString
6267
68+--only parse tutoriald which doesn't result in file I/O
69+safeParseTutorialD :: String -> Either ParseError ParsedOperation
70+safeParseTutorialD inputString = parse safeInterpreterParserP "" inputString
71+
72+data SafeEvaluationFlag = SafeEvaluation | UnsafeEvaluation deriving (Eq)
73+
6374--execute the operation and display result
64−evalTutorialD :: C.SessionId -> C.Connection -> ParsedOperation -> IO (TutorialDOperatorResult)
65−evalTutorialD sessionId conn expr = case expr of
75+evalTutorialD :: C.SessionId -> C.Connection -> SafeEvaluationFlag -> ParsedOperation -> IO (TutorialDOperatorResult)
76+evalTutorialD sessionId conn safe expr = case expr of
6677
6778 --this does not pass through the ProjectM36.Client library because the operations
6879 --are specific to the interpreter, though some operations may be of general use in the future
@@ -88,39 +99,53 @@ evalTutorialD sessionId conn expr = case expr of
8899 Right rel -> pure (DisplayRelationResult rel)
89100
90101 (ImportRelVarOp execOp@(RelVarDataImportOperator relVarName _ _)) -> do
91− -- collect attributes from relvar name
92− -- is there a race condition here? The attributes of the relvar may have since changed, no?
93− eImportType <- C.typeForRelationalExpr sessionId conn (RelationVariable relVarName)
94− case eImportType of
95− Left err -> barf err
96− Right importType -> do
97− exprErr <- evalRelVarDataImportOperator execOp (attributes importType)
98− case exprErr of
99− Left err -> barf err
100− Right dbexpr -> evalTutorialD sessionId conn (DatabaseContextExprOp dbexpr)
102+ if needsSafe then
103+ unsafeError
104+ else do
105+ -- collect attributes from relvar name
106+ -- is there a race condition here? The attributes of the relvar may have since changed, no?
107+ eImportType <- C.typeForRelationalExpr sessionId conn (RelationVariable relVarName)
108+ case eImportType of
109+ Left err -> barf err
110+ Right importType -> do
111+ exprErr <- evalRelVarDataImportOperator execOp (attributes importType)
112+ case exprErr of
113+ Left err -> barf err
114+ Right dbexpr -> evalTutorialD sessionId conn safe (DatabaseContextExprOp dbexpr)
101115
102116 (ImportDBContextOp execOp) -> do
103− mDbexprs <- evalDatabaseContextDataImportOperator execOp
104− case mDbexprs of
105− Left err -> barf err
106− Right dbexprs -> evalTutorialD sessionId conn (DatabaseContextExprOp dbexprs)
117+ if needsSafe then
118+ unsafeError
119+ else do
120+ mDbexprs <- evalDatabaseContextDataImportOperator execOp
121+ case mDbexprs of
122+ Left err -> barf err
123+ Right dbexprs -> evalTutorialD sessionId conn safe (DatabaseContextExprOp dbexprs)
107124
108125 (InfoOp execOp) -> do
109− case evalInformationOperator execOp of
110− Left err -> barf err
111− Right info -> pure (DisplayResult info)
126+ if needsSafe then
127+ unsafeError
128+ else
129+ case evalInformationOperator execOp of
130+ Left err -> barf err
131+ Right info -> pure (DisplayResult info)
112132
113133 (RelVarExportOp execOp@(RelVarDataExportOperator relExpr _ _)) -> do
114134 --eval relexpr to relation and pass to export function
115− eRel <- C.executeRelationalExpr sessionId conn relExpr
116− case eRel of
117− Left err -> barf err
118− Right rel -> do
119− exportResult <- evalRelVarDataExportOperator execOp rel
120− case exportResult of
121− Just err -> barf err
122− Nothing -> pure QuietSuccessResult
135+ if needsSafe then
136+ unsafeError
137+ else do
138+ eRel <- C.executeRelationalExpr sessionId conn relExpr
139+ case eRel of
140+ Left err -> barf err
141+ Right rel -> do
142+ exportResult <- evalRelVarDataExportOperator execOp rel
143+ case exportResult of
144+ Just err -> barf err
145+ Nothing -> pure QuietSuccessResult
123146 where
147+ needsSafe = safe == SafeEvaluation
148+ unsafeError = pure $ DisplayErrorResult "File I/O operation prohibited."
124149 barf err = return $ DisplayErrorResult (T.pack (show err))
125150
126151data InterpreterConfig = LocalInterpreterConfig PersistenceStrategy HeadName|
@@ -147,6 +172,6 @@ reprLoop config sessionId conn = do
147172 Left err -> do
148173 displayOpResult $ DisplayErrorResult (T.pack (show err))
149174 Right parsed -> do
150− evald <- evalTutorialD sessionId conn parsed
175+ evald <- evalTutorialD sessionId conn UnsafeEvaluation parsed
151176 displayOpResult evald
152177 reprLoop config sessionId conn