diff --git a/Dependencies/clean-platform b/Dependencies/clean-platform index 39a70914d16744646679de573b012cd494fea052..4a65aaeaf40e3754c6b53a0574bda2786e861e47 160000 --- a/Dependencies/clean-platform +++ b/Dependencies/clean-platform @@ -1 +1 @@ -Subproject commit 39a70914d16744646679de573b012cd494fea052 +Subproject commit 4a65aaeaf40e3754c6b53a0574bda2786e861e47 diff --git a/Dependencies/graph_copy/linux64/.gitignore b/Dependencies/graph_copy/linux64/.gitignore new file mode 100644 index 0000000000000000000000000000000000000000..2e10a7cd646498651656c6eb6a1978b9db5d08f1 --- /dev/null +++ b/Dependencies/graph_copy/linux64/.gitignore @@ -0,0 +1,2 @@ +*.[aso] +Clean System Files/*.o diff --git a/Dependencies/graph_copy/linux64/Clean System Files/copy_graph_to_string.o b/Dependencies/graph_copy/linux64/Clean System Files/copy_graph_to_string.o deleted file mode 100644 index 4cca1453692edf4287402c22b5dac48476fc5c44..0000000000000000000000000000000000000000 Binary files a/Dependencies/graph_copy/linux64/Clean System Files/copy_graph_to_string.o and /dev/null differ diff --git a/Dependencies/graph_copy/linux64/Clean System Files/copy_graph_to_string_interface.o b/Dependencies/graph_copy/linux64/Clean System Files/copy_graph_to_string_interface.o deleted file mode 100644 index f7f81ddc8b59cde189de5ad08b3dc83074b2f899..0000000000000000000000000000000000000000 Binary files a/Dependencies/graph_copy/linux64/Clean System Files/copy_graph_to_string_interface.o and /dev/null differ diff --git a/Dependencies/graph_copy/linux64/Clean System Files/copy_string_to_graph.o b/Dependencies/graph_copy/linux64/Clean System Files/copy_string_to_graph.o deleted file mode 100644 index 4a50174c0dd716441381fccadc533fa0b89b6547..0000000000000000000000000000000000000000 Binary files a/Dependencies/graph_copy/linux64/Clean System Files/copy_string_to_graph.o and /dev/null differ diff --git a/Dependencies/graph_copy/linux64/Clean System Files/copy_string_to_graph_interface.o b/Dependencies/graph_copy/linux64/Clean System Files/copy_string_to_graph_interface.o deleted file mode 100644 index 5bc04e6a2c667cf983343cabc91452f19cbbb934..0000000000000000000000000000000000000000 Binary files a/Dependencies/graph_copy/linux64/Clean System Files/copy_string_to_graph_interface.o and /dev/null differ diff --git a/Dependencies/graph_copy/linux64/Clean System Files/graph_to_string_with_descriptors.o b/Dependencies/graph_copy/linux64/Clean System Files/graph_to_string_with_descriptors.o deleted file mode 100644 index e7d785da87c3de877caf6066ad75d0050ff8246f..0000000000000000000000000000000000000000 Binary files a/Dependencies/graph_copy/linux64/Clean System Files/graph_to_string_with_descriptors.o and /dev/null differ diff --git a/Dependencies/graph_copy/linux64/Makefile b/Dependencies/graph_copy/linux64/Makefile index 8df1dc24304000e699986a0dbcade8a39dae9de5..332c58afcc142bc3df4a62124f6c382231c3023a 100644 --- a/Dependencies/graph_copy/linux64/Makefile +++ b/Dependencies/graph_copy/linux64/Makefile @@ -22,12 +22,12 @@ copy_string_to_graph_interface.o: copy_string_to_graph_interface.s cp copy_string_to_graph_interface.o "Clean System Files"/copy_string_to_graph_interface.o cleanup: - rm copy_graph_to_string.o - rm copy_graph_to_string_interface.o - rm copy_string_to_graph.o - rm copy_string_to_graph_interface.o - rm "Clean System Files"/copy_graph_to_string.o - rm "Clean System Files"/copy_graph_to_string_interface.o - rm "Clean System Files"/copy_string_to_graph.o - rm "Clean System Files"/copy_string_to_graph_interface.o + rm -f copy_graph_to_string.o + rm -f copy_graph_to_string_interface.o + rm -f copy_string_to_graph.o + rm -f copy_string_to_graph_interface.o + rm -f "Clean System Files"/copy_graph_to_string.o + rm -f "Clean System Files"/copy_graph_to_string_interface.o + rm -f "Clean System Files"/copy_string_to_graph.o + rm -f "Clean System Files"/copy_string_to_graph_interface.o diff --git a/Examples/BasicAPIExamples.icl b/Examples/BasicAPIExamples.icl index 9f43bea164876a2e7e21eb2746c1aeadab6ed305..24b7e6323bcbeb46904a0144400ad8e8b23a95fc 100644 --- a/Examples/BasicAPIExamples.icl +++ b/Examples/BasicAPIExamples.icl @@ -639,7 +639,7 @@ text x = TdTag [AlignAttr "center"] [Text (toString x)] TileTag :: !(!Int,!Int) !String -> HtmlTag TileTag (width,height) tile - = ImgTag [SrcAttr ("/"<+++ tile <+++ ".png"),w,h] + = ImgTag [SrcAttr ("/"<+++ tile <+++ ".png"), StyleAttr "min-height:0;",w,h] where (w,h) = (WidthAttr (toString width),HeightAttr (toString height)) diff --git a/Server/iTasks/_Framework/Engine.dcl b/Server/iTasks/_Framework/Engine.dcl index 4b6defca52fb67c8bb68b69152e52b003acdf975..71ca406cd6ced0a9e734c19fc07c00add410116b 100644 --- a/Server/iTasks/_Framework/Engine.dcl +++ b/Server/iTasks/_Framework/Engine.dcl @@ -24,6 +24,17 @@ RELATIVE_LOCATIONS :== [".": take 5 (iterate (() "..") "..")] { url :: String , task :: TaskWrapper } + +:: ServerOptions = + { appName :: String + , appPath :: FilePath + , sdkPath :: Maybe FilePath + , serverPort :: Int + , keepalive :: Int + , webDirPaths :: Maybe [FilePath] + , storeOpt :: Maybe FilePath + , saplOpt :: Maybe FilePath + } :: TaskWrapper = E.a: TaskWrapper (HTTPRequest -> Task a) & iTask a @@ -36,6 +47,16 @@ RELATIVE_LOCATIONS :== [".": take 5 (iterate (() "..") "..")] */ startEngine :: a !*World -> *World | Publishable a +/** +* Starts the task engine with options and a list of published task definitions. +* +* @param Tasks to start +* @param Options to use like port and server paths. +* @param The world +* @return The world +*/ +startEngineWithOptions :: a ServerOptions !*World -> *World | Publishable a + /** * Wraps a task together with a url to make it publishable by the engine */ diff --git a/Server/iTasks/_Framework/Engine.icl b/Server/iTasks/_Framework/Engine.icl index 3c0e86e8378fffe6bc22a49cf08bbd02b59f57f9..231c0bde7e19ac9c74d3b728b73fcd4b99435006 100644 --- a/Server/iTasks/_Framework/Engine.icl +++ b/Server/iTasks/_Framework/Engine.icl @@ -31,10 +31,18 @@ from Sapl.Linker.LazyLinker import generateLoaderState, :: LoaderStateExt from Sapl.Linker.SaplLinkerShared import :: SkipSet from Sapl.Target.Flavour import :: Flavour, toFlavour +show :: ![String] !*World -> *World +show lines world + # (console,world) = stdio world + # console = seqSt (\s c -> fwrites (s +++ "\n") c) lines console + # (_,world) = fclose console world + = world + startEngine :: a !*World -> *World | Publishable a startEngine publishable world # (opts,world) = getCommandLine world # (appName,world) = determineAppName world + # (appPath,world) = determineAppPath world # (mbSDKPath,world) = determineSDKPath SEARCH_PATHS world // Show server name # world = show (infoline appName) world @@ -51,23 +59,18 @@ startEngine publishable world | help = show instructions world //Check sdkpath # mbSDKPath = maybe mbSDKPath Just sdkOpt //Commandline SDK option overrides found paths - //Normal execution - # world = show (running port) world - # iworld = createIWorld appName mbSDKPath webDirPaths storeOpt saplOpt world - # (res,iworld) = initJSCompilerState iworld - | res =:(Error _) - = show ["Fatal error: " +++ fromError res] (destroyIWorld iworld) - // All persistent task instances should receive a reset event to continue their work - # iworld = queueAllPersistent iworld - //Run task server - # iworld = serve port (httpServer port keepalive (engine publishable) allUIChanges) - [BackgroundTask removeOutdatedSessions - ,BackgroundTask updateClocks, BackgroundTask (processEvents MAX_EVENTS)] timeout iworld - = destroyIWorld iworld + # options = + { appName = appName + , appPath = appPath + , sdkPath = mbSDKPath + , serverPort = port + , keepalive = keepalive + , webDirPaths = webDirPaths + , storeOpt = storeOpt + , saplOpt = saplOpt + } + = startEngineWithOptions publishable options world where - infoline :: !String -> [String] - infoline app = ["*** " +++ app +++ " HTTP server ***",""] - instructions :: [String] instructions = ["Available commandline options:" @@ -81,8 +84,10 @@ where ,"" ] - running :: !Int -> [String] - running port = ["Running at http://localhost" +++ (if (port == 80) "/" (":" +++ toString port +++ "/"))] + //running :: !Int -> [String] + //running port = ["Running at http://localhost" +++ (if (port == 80) "/" (":" +++ toString port +++ "/"))] + infoline :: !String -> [String] + infoline app = ["*** " +++ app +++ " HTTP server ***",""] boolOpt :: !String ![String] -> Bool boolOpt key opts = isMember key opts @@ -102,10 +107,27 @@ where stringOpt key [n,v:r] | n == key = Just v = stringOpt key [v:r] - + +startEngineWithOptions :: a ServerOptions !*World -> *World | Publishable a +startEngineWithOptions publishable options=:{appName,sdkPath,serverPort,webDirPaths,keepalive,storeOpt,saplOpt} world + # world = show (running serverPort) world + # iworld = createIWorld appName sdkPath webDirPaths storeOpt saplOpt world + # (res,iworld) = initJSCompilerState iworld + | res =:(Error _) = show ["Fatal error: " +++ fromError res] (destroyIWorld iworld) + // All persistent task instances should receive a reset event to continue their work + # iworld = queueAllPersistent iworld + //Start task server + # iworld = serve serverPort (httpServer serverPort keepalive (engine publishable) allUIChanges) + [BackgroundTask removeOutdatedSessions + ,BackgroundTask updateClocks, BackgroundTask (processEvents MAX_EVENTS)] timeout iworld + = destroyIWorld iworld +where + running :: !Int -> [String] + running port = ["Running at http://localhost" +++ (if (port == 80) "/" (":" +++ toString port +++ "/"))] + timeout :: !*IWorld -> (!Maybe Timeout,!*IWorld) timeout iworld = case 'SDS'.read taskEvents iworld of //Check if there are events in the queue - (Ok (Queue [] []),iworld) = (Just 100,iworld) //Empty queue, don't waste CPU, but refresh + (Ok (Queue [] []),iworld) = (Just 10,iworld) //Empty queue, don't waste CPU, but refresh (Ok _,iworld) = (Just 0,iworld) //There are still events, don't wait (Error _,iworld) = (Just 500,iworld) //Keep retrying, but not too fast diff --git a/Server/iTasks/_Framework/IWorld.dcl b/Server/iTasks/_Framework/IWorld.dcl index 494bec9320dc5e95b8bbba5ae083265a8ba7611c..f8ab8041f98ca6772e0746ea065423b062fee3c6 100644 --- a/Server/iTasks/_Framework/IWorld.dcl +++ b/Server/iTasks/_Framework/IWorld.dcl @@ -96,7 +96,7 @@ CLEAN_HOME_VAR :== "CLEAN_HOME" :: *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 @@ -116,6 +116,13 @@ CLEAN_HOME_VAR :== "CLEAN_HOME" :: 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 daa7a67447c7da487d32d4cd4f9d597fadd4d310..c90c9e4eafc0502a262bf67885a2c0c1b6332e65 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 //Core task server loop @@ -19,3 +19,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 2049b5aefec6475f84712da65078457a8308b74b..99f8052a9fb80b8cf821c162b6a412c3e8384e88 100644 --- a/Server/iTasks/_Framework/TaskServer.icl +++ b/Server/iTasks/_Framework/TaskServer.icl @@ -19,7 +19,7 @@ from iTasks._Framework.TaskStore import queueRefresh :: *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 @@ -31,7 +31,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 @@ -63,7 +63,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 @@ -99,9 +99,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] @@ -263,10 +263,10 @@ 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]}} # (mbe,iworld=:{ioTasks={done,todo}}) = eval {iworld & ioTasks = {done=done,todo=todo}} | mbe =: (Error _) = abort (snd (fromError mbe)) //TODO Handle the error without an abort - = 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}} @@ -321,6 +321,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) @@ -334,6 +352,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}}