Commit 3f7d5797 authored by Bas Lijnse's avatar Bas Lijnse
Browse files

Added scanning of API/Extensions dir for dirs called 'WebPublic' on startup...

Added scanning of API/Extensions dir for dirs called 'WebPublic' on startup from which static content (js, images etc) of an extension is served

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@2647 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent d37eb7b0
......@@ -122,7 +122,7 @@ where
initRPC = mkInstantTask eval
eval taskId iworld=:{IWorld|taskTime,build,sdkDirectory,dataDirectory,world}
eval taskId iworld=:{IWorld|taskTime,build,systemDirectories={sdkDirectory,dataDirectory},world}
# infile = dataDirectory </> "tmp-" +++ build </> (mkFileName taskId "request")
# outfile = dataDirectory </> "tmp-" +++ build </> (mkFileName taskId "response")
# (res,world) = writeFile infile request world
......@@ -240,17 +240,17 @@ httpDownloadDocumentTo url path
withTemporaryDirectory :: (FilePath -> Task a) -> Task a | iTask a
withTemporaryDirectory taskfun = Task eval
where
eval event repOpts (TCInit taskId ts) iworld=:{build,dataDirectory}
eval event repOpts (TCInit taskId ts) iworld=:{build,systemDirectories={dataDirectory}}
# tmpdir = dataDirectory </> "tmp-" +++ build </> (toString taskId +++ "-tmpdir")
# (taskIda,iworld=:{world}) = getNextTaskId iworld
# (mbErr,world) = createDirectory tmpdir world
# (mbErr,world) = createDirectory tmpdir world
= case mbErr of
Ok Void
= eval event repOpts (TCShared taskId ts (TCInit taskIda ts)) {iworld & world = world}
Error e=:(ecode,emsg)
= (ExceptionResult (dynamic e) emsg, {iworld & world = world})
eval event repOpts (TCShared taskId ts treea) iworld=:{build,dataDirectory,taskTime,world}
eval event repOpts (TCShared taskId ts treea) iworld=:{build,systemDirectories={dataDirectory},taskTime,world}
# tmpdir = dataDirectory </> "tmp-" +++ build </> (toString taskId +++ "-tmpdir")
# (mbCurdir,world) = getCurrentDirectory world
| isError mbCurdir = (exception (fromError mbCurdir), {IWorld|iworld & world = world})
......@@ -269,7 +269,7 @@ where
= (ValueResult value info rep (TCShared taskId info.TaskInfo.lastEvent ntreea),{IWorld|iworld & world = world})
ExceptionResult e str = (ExceptionResult e str,{IWorld|iworld & world = world})
eval event repOpts (TCDestroy (TCShared taskId ts treea)) iworld=:{build,dataDirectory} //First destroy inner task
eval event repOpts (TCDestroy (TCShared taskId ts treea)) iworld=:{build,systemDirectories={dataDirectory}} //First destroy inner task
# tmpdir = dataDirectory </> "tmp-" +++ build </> (toString taskId +++ "-tmpdir")
# (Task evala) = taskfun tmpdir
# (resa,iworld) = evala event repOpts (TCDestroy treea) iworld
......
......@@ -88,7 +88,7 @@ where
applicationDirectory :: ReadOnlyShared FilePath
applicationDirectory = createReadOnlySDS appDir
where
appDir iworld=:{IWorld|appDirectory} = (appDirectory,iworld)
appDir iworld=:{IWorld|systemDirectories={appDirectory}} = (appDirectory,iworld)
applicationConfig :: ReadOnlyShared Config
applicationConfig = createReadOnlySDS config
......
......@@ -2,7 +2,7 @@ implementation module iTasks.Framework.Engine
import StdMisc, StdArray, StdList, StdOrdList, StdTuple, StdChar, StdFile, StdBool
from StdFunc import o, seqList, ::St
import Data.Map, Data.Error, Data.Func, Internet.HTTP, Text, Text.Encodings.MIME, Text.Encodings.UrlEncoding
import Data.Map, Data.Error, Data.Func, Data.Tuple, Internet.HTTP, Text, Text.Encodings.MIME, Text.Encodings.UrlEncoding
import System.Time, System.CommandLine, System.Environment, System.OSError, System.File, System.FilePath, System.Directory
import iTasks.Framework.Util, iTasks.Framework.HtmlUtil
import iTasks.Framework.IWorld, iTasks.Framework.WebService
......@@ -169,11 +169,12 @@ readFlavour sdkPath world
= (fromJust mbFlav, world)
initIWorld :: !FilePath !*World -> *IWorld
initIWorld sdkPath world
initIWorld sdkDir world
# (appName,world) = determineAppName world
# (appPath,world) = determineAppPath world
# appDir = takeDirectory appPath
# dataDir = appDir </> appName +++ "-data"
# (extensionsWeb,world) = determineWebPublicDirs (sdkDir </>"Server"</>"iTasks"</>"API"</>"Extensions") world
# (res,world) = getFileInfo appPath world
| isError res = abort "Cannot get executable info."
# tm = (fromOk res).lastModifiedTime
......@@ -187,14 +188,17 @@ initIWorld sdkPath world
# (exists,world) = ensureDir "store" storeDir world
# ((lst, ftmap, _), world) = generateLoaderState ["sapl"] [] ["_SystemDynamic","Text.Encodings.Base64"] world
# (flavour, world) = readFlavour sdkPath world
# (flavour, world) = readFlavour sdkDir world
= {IWorld
|application = appName
,build = build
,appDirectory = appDir
,sdkDirectory = sdkPath
,dataDirectory = dataDir
,systemDirectories =
{appDirectory = appDir
,sdkDirectory = sdkDir
,dataDirectory = dataDir
,publicWebDirectories = [sdkDir </> "Client", appDir </> "Static":extensionsWeb]
}
,config = defaultConfig
,taskTime = 0
,timestamp = timestamp
......@@ -240,31 +244,28 @@ finalizeIWorld iworld=:{IWorld|world} = world
// 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...
handleStaticResourceRequest :: !HTTPRequest *IWorld -> (!HTTPResponse,!*IWorld)
handleStaticResourceRequest req iworld=:{IWorld|sdkDirectory,world}
# (appPath,world) = determineAppPath world
# path = subString (size URL_PREFIX) (size req.req_path) req.req_path
# filename = sdkDirectory </> "Client" +++ filePath path
# 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)))]
,rsp_data = fromOk mbContent}, {IWorld|iworld & world = world})
# filename = takeDirectory appPath </> "Static" +++ filePath path
# 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)))
]
,rsp_data = fromOk mbContent},{IWorld|iworld & world = world})
= (notFoundResponse req,{IWorld|iworld & world = world})
handleStaticResourceRequest req iworld=:{IWorld|systemDirectories={publicWebDirectories}}
= serveStaticResource req publicWebDirectories iworld
where
serveStaticResource req [] iworld
= (notFoundResponse req,iworld)
serveStaticResource req [d:ds] iworld=:{IWorld|world}
# path = subString (size URL_PREFIX) (size req.req_path) req.req_path
# filename = d +++ filePath path
# 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)))]
,rsp_data = fromOk mbContent}, {IWorld|iworld & world = world})
| otherwise
= serveStaticResource req ds {IWorld|iworld & world = world}
//Translate a URL path to a filesystem path
filePath path = ((replaceSubString "/" {pathSeparator}) o (replaceSubString ".." "")) path
mimeType path = extensionToMimeType (takeExtension path)
path2name path = last (split "/" path)
//path2name path = last (split "/" path)
publish :: String ServiceFormat (HTTPRequest -> Task a) -> PublishedTask | iTask a
publish url format task = {url = url, task = TaskWrapper task, defaultFormat = format}
......@@ -323,4 +324,25 @@ where
_ = searchPaths ps world
where
path = (p </> "iTasks-SDK")
//Do a recursive scan of a directory for subdirectories with the name "WebPublic"
//Files in these directories are meant to be publicly served by an iTask webserver
determineWebPublicDirs :: !FilePath !*World -> (![FilePath], !*World)
determineWebPublicDirs path world
# (dir, world) = readDirectory path world
= case dir of
Ok entries
= appFst flatten (mapSt (checkEntry path) entries world)
_ = ([],world) //TODO pass error up instead of just returning an empty list
where
checkEntry :: !FilePath !String !*World -> (![FilePath], !*World)
checkEntry dir name world
# path = dir </> name
| name == "." || name == ".." = ([],world)
| name == "WebPublic" = ([path],world) //Dont' recurse into a found WebPublic dir
| otherwise
# (mbInfo,world) = getFileInfo path world
= case mbInfo of
Ok info | info.directory = determineWebPublicDirs path world //Continue search
_ = ([],world)
......@@ -22,10 +22,8 @@ from Sapl.SaplParser import :: ParserState
:: *IWorld = { application :: !String // The name of the application
, build :: !String // The date/time identifier of the application's build
, appDirectory :: !FilePath // Location of the application's executable
, sdkDirectory :: !FilePath // Location of the iTasks SDK
, dataDirectory :: !FilePath // Location of the applications data files
, config :: !Config // The server configuration
, systemDirectories :: !SystemDirectories // Filesystem paths that are used by iTasks
, taskTime :: !TaskTime // The 'virtual' time for the task. Increments at every event
, timestamp :: !Timestamp // The timestamp of the current request
, currentDateTime :: !DateTime // The local date & time of the current request
......@@ -58,6 +56,13 @@ from Sapl.SaplParser import :: ParserState
, resources :: !*(Maybe *Resource)
}
:: SystemDirectories =
{ appDirectory :: !FilePath // Location of the application's executable
, dataDirectory :: !FilePath // Location of the applications data files
, sdkDirectory :: !FilePath // Location of the iTasks SDK
, publicWebDirectories :: ![FilePath] // List of directories that contain files that are served publicly by the iTask webserver
}
:: *Resource = Resource | .. //Extensible resource type for caching database connections etc...
updateCurrentDateTime :: !*IWorld -> *IWorld
......
......@@ -6,7 +6,7 @@ import Data.Maybe, Data.Map, Data.Functor
import System.File, System.Directory, System.OSError, System.FilePath
import Text, Text.JSON
import Data.SharedDataSource
from iTasks.Framework.IWorld import :: IWorld(..), :: Work, :: UIMessage, :: Resource
from iTasks.Framework.IWorld import :: IWorld(..), :: SystemDirectories(..), :: Work, :: UIMessage, :: Resource
from iTasks.Framework.UIDefinition import :: UIDef, :: UIControl
from iTasks.Framework.UIDiff import :: UIUpdate, :: UIDiffers
from iTasks.Framework.TaskState import :: TaskListEntry
......@@ -54,7 +54,7 @@ storeValue namespace key value iworld
= storeValueAs defaultStoreFormat namespace key value iworld
storeValueAs :: !StoreFormat !StoreNamespace !StoreKey !a !*IWorld -> *IWorld | JSONEncode{|*|}, TC a
storeValueAs format namespace key value iworld=:{IWorld|build,dataDirectory}
storeValueAs format namespace key value iworld=:{IWorld|build,systemDirectories={dataDirectory}}
= writeToDisk namespace key {StoreItem|format=format,content=content} (storePath dataDirectory build) iworld
where
content = case format of
......@@ -62,7 +62,7 @@ where
SFDynamic = serialize value
storeBlob :: !StoreNamespace !StoreKey !{#Char} !*IWorld -> *IWorld
storeBlob namespace key blob iworld=:{IWorld|build,dataDirectory}
storeBlob namespace key blob iworld=:{IWorld|build,systemDirectories={dataDirectory}}
= writeToDisk namespace key {StoreItem|format=SFDynamic,content=blob} (storePath dataDirectory build) iworld
writeToDisk :: !StoreNamespace !StoreKey !StoreItem !String !*IWorld -> *IWorld
......@@ -90,7 +90,7 @@ writeToDisk namespace key {StoreItem|format,content} location iworld=:{IWorld|wo
= {IWorld|iworld & world = world}
loadValue :: !StoreNamespace !StoreKey !*IWorld -> (!Maybe a,!*IWorld) | JSONDecode{|*|}, TC a
loadValue namespace key iworld=:{IWorld|build,dataDirectory}
loadValue namespace key iworld=:{IWorld|build,systemDirectories={dataDirectory}}
# (mbItem,old,iworld) = loadStoreItem namespace key iworld
= case mbItem of
Just item = case unpackValue (not old) item of
......@@ -113,7 +113,7 @@ unpackValue allowFunctions {StoreItem|format=SFDynamic,content}
Error _ = Nothing
loadStoreItem :: !StoreNamespace !StoreKey !*IWorld -> (!Maybe StoreItem,!Bool,!*IWorld)
loadStoreItem namespace key iworld=:{build,dataDirectory,world}
loadStoreItem namespace key iworld=:{build,systemDirectories={dataDirectory},world}
= case loadFromDisk namespace key (storePath dataDirectory build) world of
(Just item,world) = (Just item,False,{iworld & world = world})
(Nothing,world)
......@@ -124,14 +124,14 @@ loadStoreItem namespace key iworld=:{build,dataDirectory,world}
= (Nothing,False,{iworld & world = world})
loadBlob :: !StoreNamespace !StoreKey !*IWorld -> (!Maybe {#Char}, !*IWorld)
loadBlob namespace key iworld=:{build,dataDirectory,world}
loadBlob namespace key iworld=:{build,systemDirectories={dataDirectory},world}
= case loadFromDisk namespace key (storePath dataDirectory build) world of
(Just {StoreItem|content},world) = (Just content, {IWorld|iworld & world = world})
(Nothing,world) = (Nothing, {IWorld|iworld & world = world})
//Look in stores of previous builds for a version of the store that can be migrated
findOldStoreItem :: !StoreNamespace !StoreKey !*IWorld -> (!Maybe StoreItem,!*IWorld)
findOldStoreItem namespace key iworld=:{application,build,appDirectory,dataDirectory,world}
findOldStoreItem namespace key iworld=:{application,build,systemDirectories={appDirectory,dataDirectory},world}
# (builds,world) = readBuilds dataDirectory world
//Also Look in 'old' data directory
# (deprBuilds,world) = readBuilds (appDirectory </> application) world
......@@ -190,7 +190,7 @@ deleteValues :: !StoreNamespace !StorePrefix !*IWorld -> *IWorld
deleteValues namespace delKey iworld = deleteValues` namespace delKey startsWith startsWith iworld
deleteValues` :: !String !String !(String String -> Bool) !(String String -> Bool) !*IWorld -> *IWorld
deleteValues` namespace delKey filterFuncCache filterFuncDisk iworld=:{build,dataDirectory,world}
deleteValues` namespace delKey filterFuncCache filterFuncDisk iworld=:{build,systemDirectories={dataDirectory},world}
//Delete items from disk
# world = deleteFromDisk world
= {iworld & world = world}
......
......@@ -114,7 +114,7 @@ loadDocumentMeta documentId iworld
= loadValue NS_DOCUMENT_CONTENT (documentId +++ "-meta") iworld
documentLocation :: !DocumentId !*IWorld -> (!FilePath,!*IWorld)
documentLocation documentId iworld=:{build,dataDirectory}
documentLocation documentId iworld=:{build,systemDirectories={dataDirectory}}
= (storePath dataDirectory build </> NS_DOCUMENT_CONTENT </> (documentId +++ "_data.bin"),iworld)
addShareRegistration :: !BasicShareId !InstanceNo !*IWorld -> *IWorld
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment