Engine.icl 6.82 KB
Newer Older
1 2
implementation module Engine

3
import StdMisc, StdArray, StdList, StdOrdList, StdTuple, StdChar, StdFile, StdBool, Func
4
from StdFunc import o, seqList, ::St
5
import	Map, Time, CommandLine, Environment, Error, File, FilePath, Directory, HTTP, OSError, Text, MIME, UrlEncoding
6
import	Util, HtmlUtil
7
import	IWorld
8
import	WebService
9

10 11
CLEAN_HOME_VAR	:== "CLEAN_HOME"

12
// The iTasks engine consist of a set of HTTP request handlers
13 14 15
engine :: publish -> [(!String -> Bool,!HTTPRequest *IWorld -> (!HTTPResponse, !*IWorld))] | Publishable publish
engine publishable
	= taskHandlers (publishAll publishable) ++ defaultHandlers
16
where
17
	taskHandlers published
18
		= [((==) (URL_PREFIX +++ url), webService task defaultFormat) \\ {url,task=TaskWrapper task,defaultFormat} <- published]	
19
	
20 21
	defaultHandlers
		= [((==) "/stop", handleStopRequest)
22
		  ,(startsWith URL_PREFIX, handleStaticResourceRequest)
23 24
		  ]

25 26
initIWorld :: !FilePath !*World -> *IWorld
initIWorld sdkPath world
27 28 29
	# (appName,world) 			= determineAppName world
	# (appPath,world)			= determineAppPath world
	# appDir					= takeDirectory appPath
30
	# dataDir					= appDir </> appName +++ "-data"
31 32 33
	# (res,world)				= getFileInfo appPath world
	| isError res				= abort "Cannot get executable info."
	# tm						= (fromOk res).lastModifiedTime
34
	# build						= strfTime "%Y%m%d-%H%M%S" tm
35
	# (timestamp,world)			= time world
36
	# (currentDateTime,world)	= currentDateTimeWorld world
37 38 39 40 41
	# (_,world)					= ensureDir "data" dataDir world
	# tmpDir					= dataDir </> "tmp-" +++ build
	# (_,world)					= ensureDir "tmp" tmpDir world
	# storeDir					= dataDir </> "store-"+++ build
	# (exists,world)			= ensureDir "store" storeDir world
42 43
	= {IWorld
	  |application			= appName
44 45
	  ,build				= build
	  ,appDirectory			= appDir
46
	  ,sdkDirectory			= sdkPath
47
	  ,dataDirectory		= dataDir
48
	  ,config				= defaultConfig
Bas Lijnse's avatar
Bas Lijnse committed
49
	  ,taskTime				= 0
50
	  ,timestamp			= timestamp
51
	  ,currentDateTime		= currentDateTime
52
	  ,currentUser			= AnonymousUser ""
53
	  ,currentInstance		= 0
54
	  ,nextTaskNo			= 0
55
	  ,localShares			= newMap
56
	  ,localLists			= newMap
57 58
	  ,localTasks			= newMap
      ,eventRoute			= newMap
59
	  ,readShares			= []
60
	  ,sessions				= newMap
61
	  ,uis					= newMap
62
	  ,workQueue			= []
63 64
	  ,world				= world
	  }
65 66 67
where
	defaultConfig :: Config
	defaultConfig =
68
		{ sessionTime		= 3600
69 70 71
		, smtpServer		= "localhost"
		}
		
72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88
	padZero :: !Int -> String
	padZero number = (if (number < 10) "0" "") +++ toString number

	ensureDir :: !String !FilePath *World -> (!Bool,!*World)
	ensureDir name path world
		# (exists, world) = fileExists path world
		| exists = (True,world)
		# (res, world) = createDirectory path world
		| isError res = abort ("Cannot create " +++ name +++ " directory" +++ path +++ " : "  +++ snd (fromError res))
		= (False,world)

finalizeIWorld :: !*IWorld -> *World
finalizeIWorld iworld=:{IWorld|world} = world

// Request handler which serves static resources from the application directory,
// or a system wide default directory if it is not found locally.
// This request handler is used for serving system wide javascript, css, images, etc...
89 90
handleStaticResourceRequest :: !HTTPRequest *IWorld -> (!HTTPResponse,!*IWorld)
handleStaticResourceRequest req iworld=:{IWorld|sdkDirectory,world}
91
	# (appPath,world)		= determineAppPath world
92 93
	# path					= subString (size URL_PREFIX) (size req.req_path) req.req_path
	# filename				= sdkDirectory </> "Client" +++ filePath path
94 95 96 97 98
	# type					= mimeType filename
	# (mbContent, world)	= readFile filename world
	| isOk mbContent		= ({rsp_headers = fromList [("Status","200 OK"),
											   ("Content-Type", type),
											   ("Content-Length", toString (size (fromOk mbContent)))]
99
							   	,rsp_data = fromOk mbContent}, {IWorld|iworld & world = world})
100
	# filename				= takeDirectory appPath </> "Static" +++ filePath path
101 102 103 104 105 106
	# type					= mimeType filename
	# (mbContent, world)	= readFile filename world
	| isOk mbContent 		= ({rsp_headers = fromList [("Status","200 OK"),
											   ("Content-Type", type),
											   ("Content-Length", toString (size (fromOk mbContent)))											   
											   ]
107 108
							   	,rsp_data = fromOk mbContent},{IWorld|iworld & world = world})						   								 	 							   
	= (notFoundResponse req,{IWorld|iworld & world = world})
109 110 111 112 113
where
	//Translate a URL path to a filesystem path
	filePath path	= ((replaceSubString "/" {pathSeparator}) o (replaceSubString ".." "")) path
	mimeType path	= extensionToMimeType (takeExtension path)

114 115
handleStopRequest :: HTTPRequest *IWorld -> (!HTTPResponse,!*IWorld)
handleStopRequest req iworld = ({newHTTPResponse & rsp_headers = fromList [("X-Server-Control","stop")], rsp_data = "Server stopped..."}, iworld) //Stop
116

117
path2name path = last (split "/" path)
118

Bas Lijnse's avatar
Bas Lijnse committed
119
publish :: String ServiceFormat (HTTPRequest -> Task a) -> PublishedTask | iTask a
Bas Lijnse's avatar
 
Bas Lijnse committed
120
publish url format task = {url = url, task = TaskWrapper task, defaultFormat = format}
121 122 123

instance Publishable (Task a) | iTask a
where
Bas Lijnse's avatar
Bas Lijnse committed
124
	publishAll task = [publish "/" WebApp (\_ -> task)]
125

Bas Lijnse's avatar
Bas Lijnse committed
126 127 128 129
instance Publishable (HTTPRequest -> Task a) | iTask a
where
	publishAll task = [publish "/" WebApp task]
	
130 131 132 133
instance Publishable [PublishedTask]
where
	publishAll list = list

ecrombag's avatar
ecrombag committed
134
// Determines the server executables path
135
determineAppPath :: !*World -> (!FilePath, !*World)
ecrombag's avatar
ecrombag committed
136
determineAppPath world
137
	# ([arg:_],world) = getCommandLine world
138
	| dropDirectory arg <> "ConsoleClient.exe" = (arg,world) //toCanonicalPath arg world
139 140 141 142 143 144 145 146 147 148 149 150 151 152 153
	//Using dynamic linker:	
	# (res, world)				= getCurrentDirectory world	
	| isError res				= abort "Cannot get current directory."	
	# currentDirectory			= fromOk res
	# (res, world)				= readDirectory currentDirectory world	
	| isError res				= abort "Cannot read current directory."	
	# batchfiles				= [f \\ f <- fromOk res | takeExtension f == "bat" ]
	| isEmpty batchfiles		= abort "No dynamic linker batch file found."	
	# (infos, world)			= seqList (map getFileInfo batchfiles) world	
	| any isError infos	 		= abort "Cannot get file information."	
	= (currentDirectory </> (fst o hd o sortBy cmpFileTime) (zip2 batchfiles infos), world)	
	where		
		cmpFileTime (_,Ok {FileInfo | lastModifiedTime = x})
					(_,Ok {FileInfo | lastModifiedTime = y}) = mkTime x > mkTime y
	
154 155 156
// Determines the server executables name
determineAppName :: !*World -> (!String,!*World)
determineAppName world 
157 158
	# (appPath, world) = determineAppPath world
	= ((dropExtension o dropDirectory) appPath, world)
159 160

determineSDKPath :: ![FilePath] !*World -> (!Maybe FilePath, !*World)
161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176
determineSDKPath paths world
	//Try environment var first
	# (mbCleanHome,world) = getEnvironmentVariable CLEAN_HOME_VAR world
	= case mbCleanHome of
		Nothing			= searchPaths paths world
		Just cleanHome	= searchPaths [cleanHome] world
where	
	searchPaths [] world = (Nothing, world)
	searchPaths [p:ps] world
		# (mbInfo,world) = getFileInfo path world
		= case mbInfo of
			Ok info	| info.directory	= (Just path,world)
			_							= searchPaths ps world
	where
		path = (p </> "iTasks-SDK")