From 890b822813baa638e27a01376e95d995d37fdcea Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Sat, 15 Oct 2016 11:47:03 +0200 Subject: [PATCH] Add functionality to dynamically add and remove background tasks --- Server/iTasks/_Framework/IWorld.dcl | 9 ++++++- Server/iTasks/_Framework/TaskServer.dcl | 8 +++++- Server/iTasks/_Framework/TaskServer.icl | 34 +++++++++++++++++++------ 3 files changed, 41 insertions(+), 10 deletions(-) diff --git a/Server/iTasks/_Framework/IWorld.dcl b/Server/iTasks/_Framework/IWorld.dcl index 113d45c02..35b08eb82 100644 --- a/Server/iTasks/_Framework/IWorld.dcl +++ b/Server/iTasks/_Framework/IWorld.dcl @@ -92,7 +92,7 @@ from TCPIP import :: TCP_Listener, :: TCP_Listener_, :: TCP_RChannel_, :: TCP_SC :: *IOTaskInstance = ListenerInstance !ListenerInstanceOpts !*TCP_Listener | ConnectionInstance !ConnectionInstanceOpts !*TCP_DuplexChannel - | BackgroundInstance !BackgroundTask + | BackgroundInstance !BackgroundInstanceOpts !BackgroundTask :: ListenerInstanceOpts = { taskId :: !TaskId //Reference to the task that created the listener @@ -112,6 +112,13 @@ from TCPIP import :: TCP_Listener, :: TCP_Listener_, :: TCP_RChannel_, :: TCP_SC :: ConnectionId :== Int +:: BackgroundInstanceOpts = + { bgInstId :: !BackgroundTaskId + } + +:: BackgroundTaskId :== Int + + :: IOStates :== Map TaskId IOState :: IOState = IOActive !(Map ConnectionId (!Dynamic,!Bool)) diff --git a/Server/iTasks/_Framework/TaskServer.dcl b/Server/iTasks/_Framework/TaskServer.dcl index 1ffb6c661..efb72956e 100644 --- a/Server/iTasks/_Framework/TaskServer.dcl +++ b/Server/iTasks/_Framework/TaskServer.dcl @@ -8,7 +8,7 @@ from Internet.HTTP import :: HTTPRequest, :: HTTPResponse from System.Time import :: Timestamp from Data.Error import :: MaybeError from iTasks.API.Core.Types import :: TaskId -from iTasks._Framework.IWorld import :: IWorld +from iTasks._Framework.IWorld import :: IWorld, :: BackgroundTaskId from iTasks._Framework.Task import :: ConnectionTask, :: BackgroundTask, :: TaskException from iTasks._Framework.Engine import :: ConnectionType @@ -20,3 +20,9 @@ addListener :: !TaskId !Int !Bool !ConnectionTask !*IWorld -> (!MaybeError TaskE //Dynamically add a connection addConnection :: !TaskId !String !Int !ConnectionTask !*IWorld -> (!MaybeError TaskException (),!*IWorld) + +//Dynamically add a background task +addBackgroundTask :: !BackgroundTaskId !BackgroundTask !*IWorld -> (!MaybeError TaskException (),!*IWorld) + +//Dynamically remove a background task +removeBackgroundTask :: !BackgroundTaskId !*IWorld -> (!MaybeError TaskException (),!*IWorld) diff --git a/Server/iTasks/_Framework/TaskServer.icl b/Server/iTasks/_Framework/TaskServer.icl index ff76c8ac9..792553022 100644 --- a/Server/iTasks/_Framework/TaskServer.icl +++ b/Server/iTasks/_Framework/TaskServer.icl @@ -18,7 +18,7 @@ import iTasks._Framework.TaskEval :: *IOTaskInstanceDuringSelect = ListenerInstanceDS !ListenerInstanceOpts | ConnectionInstanceDS !ConnectionInstanceOpts !*TCP_SChannel - | BackgroundInstanceDS !BackgroundTask + | BackgroundInstanceDS !BackgroundInstanceOpts !BackgroundTask serve :: !Int !ConnectionTask ![BackgroundTask] (*IWorld -> (!Maybe Timeout,!*IWorld)) *IWorld -> *IWorld serve port ct bt determineTimeout iworld @@ -30,7 +30,7 @@ init port ct bt iworld=:{IWorld|ioTasks,world} | not success = abort ("Error: port "+++ toString port +++ " already in use.\n") # opts = {ListenerInstanceOpts|taskId=TaskId 0 0, nextConnectionId=0, port=port, connectionTask=ct, removeOnClose = True} # ioStates = 'DM'.fromList [(TaskId 0 0, IOActive 'DM'.newMap)] - = {iworld & ioTasks = {done=[],todo=[ListenerInstance opts (fromJust mbListener):map BackgroundInstance bt]}, ioStates = ioStates, world = world} + = {iworld & ioTasks = {done=[],todo=[ListenerInstance opts (fromJust mbListener):map (BackgroundInstance {bgInstId=0})bt]}, ioStates = ioStates, world = world} loop :: !(*IWorld -> (!Maybe Timeout,!*IWorld)) !*IWorld -> *IWorld loop determineTimeout iworld @@ -62,7 +62,7 @@ toSelectSet [i:is] = case i of ListenerInstance opts l = ([l:ls],rs,[ListenerInstanceDS opts:is]) ConnectionInstance opts {rChannel,sChannel} = (ls,[rChannel:rs],[ConnectionInstanceDS opts sChannel:is]) - BackgroundInstance bt = (ls,rs,[BackgroundInstanceDS bt:is]) + BackgroundInstance opts bt = (ls,rs,[BackgroundInstanceDS opts bt:is]) /* Restore the list of main loop instances. In the same pass also update the indices in the select result to match the @@ -98,9 +98,9 @@ where # (is,ch) = fromSelectSet` (i+1) numListeners numSeenListeners (numSeenReceivers+1) ls rs [(c,what):ch] is = ([ConnectionInstance opts {rChannel=rChannel,sChannel=sChannel}:is],ch) //Background tasks - fromSelectSet` i numListeners numSeenListeners numSeenReceivers ls rs ch [BackgroundInstanceDS bt:is] + fromSelectSet` i numListeners numSeenListeners numSeenReceivers ls rs ch [BackgroundInstanceDS opts bt:is] # (is,ch) = fromSelectSet` (i+1) numListeners numSeenListeners numSeenReceivers ls rs ch is - = ([BackgroundInstance bt:is],ch) + = ([BackgroundInstance opts bt:is],ch) ulength [] = (0,[]) ulength [x:xs] @@ -262,9 +262,9 @@ process i chList iworld=:{ioTasks={done,todo=[ConnectionInstance opts {rChannel, # world = closeChannel sChannel world = process (i+1) chList {iworld & ioTasks={done=done,todo=todo}, ioStates = ioStates, world=world} -process i chList iworld=:{ioTasks={done,todo=[BackgroundInstance bt=:(BackgroundTask eval):todo]}} +process i chList iworld=:{ioTasks={done,todo=[BackgroundInstance opts bt=:(BackgroundTask eval):todo]}} # iworld=:{ioTasks={done,todo}} = eval {iworld & ioTasks = {done=done,todo=todo}} - = process (i+1) chList {iworld & ioTasks={done=[BackgroundInstance bt:done],todo=todo}} + = process (i+1) chList {iworld & ioTasks={done=[BackgroundInstance opts bt:done],todo=todo}} process i chList iworld=:{ioTasks={done,todo=[t:todo]}} = process (i+1) chList {iworld & ioTasks={done=[t:done],todo=todo}} @@ -319,6 +319,24 @@ addConnection taskId=:(TaskId instanceNo _) host port connectionTask iworld=:{io Error e = 'DM'.put taskId (IOException e) ioStates = (Ok (),{iworld & ioTasks = {done=done,todo=todo}, ioStates = ioStates, world = world}) +//Dynamically add a background task +addBackgroundTask :: !BackgroundTaskId !BackgroundTask !*IWorld -> (!MaybeError TaskException (),!*IWorld) +addBackgroundTask btid bt iworld=:{ioTasks={done,todo}} +# todo = todo ++ [BackgroundInstance {BackgroundInstanceOpts|bgInstId=btid} bt] += (Ok (), {iworld & ioTasks={done=done, todo=todo}}) + +//Dynamically remove a background task +removeBackgroundTask :: !BackgroundTaskId !*IWorld -> (!MaybeError TaskException (),!*IWorld) +removeBackgroundTask btid iworld=:{ioTasks={done,todo}} +//We filter the tasks and use the boolean state to hold whether a task was dropped +# (r, todo) = foldr (\e (b, l)->let (b`, e`)=drop e in (b` || b, if b` l [e`:l])) (False, []) todo +# iworld = {iworld & ioTasks={done=done, todo=todo}} +| not r = (Error (exception "No backgroundtask with that id"), iworld) += (Ok (), iworld) + where + drop a=:(BackgroundInstance {bgInstId} _) = (bgInstId == btid, a) + drop a = (False, a) + checkSelect :: !Int ![(!Int,!SelectResult)] -> (!Maybe SelectResult,![(!Int,!SelectResult)]) checkSelect i chList =:[(who,what):ws] | (i == who) = (Just what,ws) checkSelect i chList = (Nothing,chList) @@ -332,6 +350,6 @@ halt iworld=:{ioTasks={todo=[ConnectionInstance _ {rChannel,sChannel}:todo],done # world = closeRChannel rChannel world # world = closeChannel sChannel world = halt {iworld & ioTasks = {todo=todo,done=done}} -halt iworld=:{ioTasks={todo=[BackgroundInstance _ :todo],done},world} +halt iworld=:{ioTasks={todo=[BackgroundInstance _ _ :todo],done},world} = halt {iworld & ioTasks= {todo=todo,done=done}} -- GitLab