packages feed

Holumbus-Storage (empty) → 0.0.1

raw patch · 23 files changed

+2959/−0 lines, 23 filesdep +Holumbus-Distributiondep +basedep +binarysetup-changed

Dependencies added: Holumbus-Distribution, base, binary, bytestring, containers, directory, haskell98, hslogger, hxt, network, time, unix

Files

+ Examples/FileSystem/ClientMain.hs view
@@ -0,0 +1,53 @@+-- ----------------------------------------------------------------------------+{- |+  Module     : +  Copyright  : Copyright (C) 2008 Stefan Schmidt+  License    : MIT++  Maintainer : Stefan Schmidt (stefanschmidt@web.de)+  Stability  : experimental+  Portability: portable+  Version    : 0.1+++-}+-- ----------------------------------------------------------------------------++module Main(main) where++import           Holumbus.Common.Utils                          ( handleAll )+import           Holumbus.Common.Logging+import           Holumbus.Network.PortRegistry.PortRegistryPort+import qualified Holumbus.FileSystem.FileSystem                 as FS+import qualified Holumbus.FileSystem.UserInterface              as UI+++version :: String+version = "Holumbus-FileSystem Standalone-Client 0.1"+++main :: IO ()+main+  = do+    putStrLn version+    handleAll (\e -> putStrLn $ "EXCEPTION: " ++ show e) $+      do+      initializeLogging []+      p <- newPortRegistryFromXmlFile "/tmp/registry.xml"+      setPortRegistry p+      fs <- initializeData+      UI.runUI fs version      +      deinitializeData fs+++initializeData :: IO (FS.FileSystem)+initializeData +  = do+    fs <- FS.mkFileSystemClient FS.defaultFSClientConfig+    return fs+++deinitializeData :: FS.FileSystem -> IO ()+deinitializeData fs+  = do+    FS.closeFileSystem fs
+ Examples/FileSystem/ControllerMain.hs view
@@ -0,0 +1,56 @@+-- ----------------------------------------------------------------------------+{- |++  Module     : +  Copyright  : Copyright (C) 2008 Stefan Schmidt+  License    : MIT++  Maintainer : Stefan Schmidt (stefanschmidt@web.de)+  Stability  : experimental+  Portability: portable+  Version    : 0.1+++-}+-- ----------------------------------------------------------------------------++module Main(main) where++import           Holumbus.Common.Logging+import           Holumbus.Common.Utils                         	( handleAll )+import           Holumbus.Network.PortRegistry.PortRegistryPort+import qualified Holumbus.FileSystem.FileSystem 		as FS+import qualified Holumbus.FileSystem.UserInterface 		as UI+++version :: String+version = "Holumbus-FileSystem Standalone-Controller 0.1"+++main :: IO ()+main+  = do+    putStrLn version+    handleAll (\e -> putStrLn $ "EXCEPTION: " ++ show e) $+      do+      initializeLogging []+      p <- newPortRegistryFromXmlFile "/tmp/registry.xml"+      setPortRegistry p+      fs <- initializeData+      UI.runUI fs version      +      deinitializeData fs+++initializeData :: IO (FS.FileSystem)+initializeData +  = do+    fs <- FS.mkFileSystemController FS.defaultFSControllerConfig+    return fs+++deinitializeData :: FS.FileSystem -> IO ()+deinitializeData fs+  = do+    FS.closeFileSystem fs++-- ----------------------------------------------------------------------------
+ Examples/FileSystem/Makefile view
@@ -0,0 +1,30 @@+# Making FileSystem-Standalone Programs++HOME		= ../../..++SOURCE		= .++GHC_FLAGS	= -Wall -threaded -O2 -hidir $(OUTPUT) -odir $(OUTPUT)+GHC		= ghc $(GHC_FLAGS)++RM_FLAGS	= -rf+RM		= rm $(RM_FLAGS)++PROG		= ControllerMain NodeMain ClientMain++OUTPUT		= output++all : $(PROG)++#prof : $(PROG).hs+#	[ -d $(OUTPUT) ] || mkdir -p $(OUTPUT)+#	$(RM) $(OUTPUT)/*+#	$(GHC) -prof -auto-all -ignore-package Holumbus -i../../source/ --make -o $(PROG)_p $(PROG).hs++% : %.hs+	[ -d $(OUTPUT) ] || mkdir -p $(OUTPUT)+	$(RM) $(OUTPUT)/*+	$(GHC) --make -o $@ $<++clean :+	$(RM) $(PROG) $(OUTPUT)
+ Examples/FileSystem/NodeMain.hs view
@@ -0,0 +1,56 @@+-- ----------------------------------------------------------------------------+{- |+  Module     : +  Copyright  : Copyright (C) 2008 Stefan Schmidt+  License    : MIT++  Maintainer : Stefan Schmidt (stefanschmidt@web.de)+  Stability  : experimental+  Portability: portable+  Version    : 0.1+++-}+-- ----------------------------------------------------------------------------++module Main(main) where++import           Holumbus.Common.Logging+import           Holumbus.Common.Utils                          ( handleAll )++import           Holumbus.Network.PortRegistry.PortRegistryPort+import qualified Holumbus.FileSystem.FileSystem                 as FS+import qualified Holumbus.FileSystem.UserInterface              as UI+++version :: String+version = "Holumbus-FileSystem Standalone-Node 0.1"+++main :: IO ()+main+  = do+    putStrLn version+    handleAll (\e -> putStrLn $ "EXCEPTION: " ++ show e) $+      do+      initializeLogging []+      p <- newPortRegistryFromXmlFile "/tmp/registry.xml"+      setPortRegistry p+      fs <- initializeData+      UI.runUI fs version      +      deinitializeData fs+++initializeData :: IO (FS.FileSystem)+initializeData +  = do+    let config = FS.defaultFSNodeConfig+    FS.mkFileSystemNode config+++deinitializeData :: FS.FileSystem -> IO ()+deinitializeData fs+  = do+    FS.closeFileSystem fs++-- ----------------------------------------------------------------------------
+ Examples/Makefile view
@@ -0,0 +1,15 @@+# Making all examples++FILESYSTEM        = FileSystem+UTILS             = Utils/Filehandling+ALLEXAMPLES       = $(FILESYSTEM) $(UTILS)+++all :+	$(foreach i,$(ALLEXAMPLES),$(MAKE) -C $i all ;)++wc :+	@wc -l `find . -wholename './_darcs/*' -prune -o -name "*.hs" -print`++clean :+	$(foreach i,$(ALLEXAMPLES),$(MAKE) -C $i $@ ;)
+ Examples/Utils/Filehandling/FileHandlingTest.hs view
@@ -0,0 +1,96 @@+-- ----------------------------------------------------------------------------+{- |+  Module     : +  Copyright  : Copyright (C) 2008 Stefan Schmidt+  License    : MIT++  Maintainer : Stefan Schmidt (stefanschmidt@web.de)+  Stability  : experimental+  Portability: portable+  Version    : 0.1+++-}+-- ----------------------------------------------------------------------------++module Main(main) where+++import           Data.Binary+import qualified Data.ByteString.Lazy as B++import           Holumbus.Common.FileHandling+++version :: String+version = "FileHandlingTest 0.1"+++text1 :: String+text1 = "Hello"++text2 :: String+text2 = "World"++bin1 :: B.ByteString+bin1 = encode "Hello"++bin2 :: B.ByteString+bin2 = encode "World"++list1 :: [String]+list1 = ["Hello"]++list2 :: [String]+list2 = ["World"]+++textfileName :: String+textfileName = "test.txt"++binfileName :: String+binfileName = "test.bin"++listfileName :: String+listfileName = "test.lst"++compareResults :: (Show a, Eq a) => a -> a -> IO ()+compareResults v1 v2+  = do+    putStrLn "comparing"+    putStrLn $ "v1: " ++ show v1+    putStrLn $ "v2: " ++ show v2+    putStrLn $ "equal: " ++ show (v1 == v2) ++main :: IO ()+main+  = do+    putStrLn version+    +    putStrLn ""+    putStrLn "textfileTest"+    writeToTextFile textfileName text1+    t1 <- readFromTextFile textfileName+    compareResults text1 t1+    appendToTextFile textfileName text2+    t2 <- readFromTextFile textfileName+    compareResults (text1 ++ text2) t2+    +    putStrLn ""+    putStrLn "binfileTest"+    writeToBinFile binfileName bin1+    b1 <- readFromBinFile binfileName+    compareResults bin1 b1+    appendToBinFile binfileName bin2+    b2 <- readFromBinFile binfileName+    compareResults (B.append bin1 bin2) b2+    +    putStrLn ""+    putStrLn "textfileTest"+    writeToListFile listfileName list1+    l1 <- readFromListFile listfileName+    compareResults list1 l1+    appendToListFile listfileName list2+    l2 <- readFromListFile listfileName+    compareResults (list1 ++ list2) l2+
+ Examples/Utils/Filehandling/Makefile view
@@ -0,0 +1,31 @@+# Making FileSystem-Standalone Programs++HOME		= ../..++SOURCE		= .++GHC_FLAGS	= -Wall -threaded -O2 -hidir $(OUTPUT) -odir $(OUTPUT)+GHC		= ghc $(GHC_FLAGS)++RM_FLAGS	= -rf+RM		= rm $(RM_FLAGS)++PROG		= FileHandlingTest++OUTPUT		= output++all : $(PROG)++#prof : $(PROG).hs+#	[ -d $(OUTPUT) ] || mkdir -p $(OUTPUT)+#	$(RM) $(OUTPUT)/*+#	$(GHC) -prof -auto-all -ignore-package Holumbus -i../../source/ --make -o $(PROG)_p $(PROG).hs++% : %.hs+	[ -d $(OUTPUT) ] || mkdir -p $(OUTPUT)+	$(RM) $(OUTPUT)/*+	$(GHC) --make -o $@ $<++clean :+	$(RM) $(PROG) $(OUTPUT) test.txt test.bin test.lst+
+ Holumbus-Storage.cabal view
@@ -0,0 +1,56 @@+name:          Holumbus-Storage+version:       0.0.1+license:       OtherLicense+license-file:  LICENSE+author:        Uwe Schmidt, Stefan Schmidt+copyright:     Copyright (c) 2008 Uwe Schmidt, Stefan Schmidt+maintainer:    Stefan Schmidt <sts@holumbus.org>+stability:     experimental+category:      Distributed Computing+synopsis:      a distributed storage system+homepage:      http://holumbus.fh-wedel.de+description:   This package contains a library for building distributed storage systems.+build-type:    Simple+cabal-version: >=1.6++extra-source-files:+    README+    Makefile+    Examples/FileSystem/ClientMain.hs+    Examples/FileSystem/Makefile+    Examples/FileSystem/ControllerMain.hs+    Examples/FileSystem/NodeMain.hs+    Examples/Makefile+    Examples/Utils/Filehandling/FileHandlingTest.hs+    Examples/Utils/Filehandling/Makefile++library+  build-depends:  base >= 3+                , binary     >= 0.4+                , bytestring >= 0.9+                , containers >= 0.1+                , directory  >= 1.0+                , haskell98  >= 1+                , hslogger   >= 1.0+                , hxt        >= 8.2+                , network    >= 2.1+                , time       >= 1.1+                , unix       >= 2.3+                , Holumbus-Distribution >= 0.0.1++  hs-source-dirs: +                  source+  exposed-modules:  +                  Holumbus.FileSystem.UserInterface+                , Holumbus.FileSystem.FileSystem+                , Holumbus.FileSystem.Storage+                , Holumbus.FileSystem.Storage.FileStorage+                , Holumbus.FileSystem.Messages+                , Holumbus.FileSystem.Node+                , Holumbus.FileSystem.Node.NodeData+                , Holumbus.FileSystem.Node.NodePort+                , Holumbus.FileSystem.Controller+                , Holumbus.FileSystem.Controller.ControllerData+                , Holumbus.FileSystem.Controller.ControllerPort+  ghc-options: -Wall -threaded+  extensions: Arrows DeriveDataTypeable ExistentialQuantification
+ LICENSE view
@@ -0,0 +1,21 @@+The MIT License++Copyright (c) 2008 Stefan Schmidt++Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the "Software"),+to deal in the Software without restriction, including without limitation the+rights to use, copy, modify, merge, publish, distribute, sublicense, and/or +sell copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +THE SOFTWARE.
+ Makefile view
@@ -0,0 +1,58 @@+# Making all+#+# Building the library and generating documentation is done by cabal,+# only the tests and the examples will be built using make.++# TEST_BASE	= test+EXAMPLES_BASE	= Examples+#PROGRAMS_BASE   = Programs+++all : configure build doc++configure :+	@runhaskell Setup.hs configure++doc	: configure+	@runhaskell Setup.hs haddock --hyperlink-source --hscolour-css=hscolour.css++build	: configure+	@runhaskell Setup.hs build++install :+	@runhaskell Setup.hs install --global++prof	:+	@runhaskell Setup.hs configure -p+	@runhaskell Setup.hs build++dist	:+	@runhaskell Setup.hs sdist++# alltests :+#	$(MAKE) -C $(TEST_BASE) all++examples :+	$(MAKE) -C $(EXAMPLES_BASE) all++#programs :+#	$(MAKE) -C $(PROGRAMS_BASE) all++wc :+	@wc -l `find ./source/Holumbus -wholename './_darcs/*' -prune -o -name "*.hs" -print`   +	# $(MAKE) -C $(TEST_BASE) wc+	$(MAKE) -C $(EXAMPLES_BASE) wc+	#$(MAKE) -C $(PROGRAMS_BASE) wc++zip:	clean+	@zip -r holumbus_storage$$(date +%Y%m%d_%H%M).zip *++clean :+	@runhaskell Setup.hs clean+	@rm -rf holumbus_storage*.zip+	# $(MAKE) -C $(TEST_BASE) clean+	$(MAKE) -C $(EXAMPLES_BASE) clean+	#$(MAKE) -C $(PROGRAMS_BASE) clean++.PHONY	: all configure doc build install prof dist examples wc zip clean+
+ README view
@@ -0,0 +1,57 @@+This is the Holumbus-Storage library++Version 0.0.1++Stefan Schmidt sts@holumbus.org++http://holumbus.fh-wedel.de++About+-----++Holumbus is a set of Haskell libraries. This package contains the +Holumbus-Storage library for building and distributed storage systems.++This library depends on the Holumbus-Distribution library.+++Contents+--------++Examples  Some example applications and utilities.+source    Source code of the Holumbus-Storage library.+++Requirements+------------++So far, this library is only tested under Linux, please let us know, if there are +any problems under Windows or other OSes.+The Holumbus-MapReduce library requires at least GHC 6.10 and the +following packages (available via Hackage).++  containers+  hslogger+  directory+  network+  time+  bytestring+  binary+  hxt+  Holumbus-Distribution+++Installation+------------++A Cabal file is provided, therefore Holumbus-Storage can be installed using+the standard Cabal way:++$ runhaskell Setup.hs configure+$ runhaskell Setup.hs build+$ runhaskell Setup.hs install # with root privileges++If you prefer to do it the old way there with make:++$ make build+$ make install # with root privileges
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ source/Holumbus/FileSystem/Controller.hs view
@@ -0,0 +1,59 @@+-- ----------------------------------------------------------------------------++{- |+  Module     : Holumbus.FileSystem.Controller+  Copyright  : Copyright (C) 2008 Stefan Schmidt+  License    : MIT++  Maintainer : Stefan Schmidt (stefanschmidt@web.de)+  Stability  : experimental+  Portability: portable+  Version    : 0.1+++-}++-- ----------------------------------------------------------------------------++module Holumbus.FileSystem.Controller+(+-- * Typeclass+  ControllerClass(..)+)+where++import           Prelude hiding (appendFile)++import qualified Data.Set as Set++import           Holumbus.Network.Site+import           Holumbus.Network.Communication+import qualified Holumbus.FileSystem.Storage as S++++-- ----------------------------------------------------------------------------+-- Typeclass+-- ----------------------------------------------------------------------------+++class ControllerClass c where+  +  closeController :: c -> IO ()+    +  getFileSites :: S.FileId -> c -> IO (Set.Set SiteId)+  +  containsFile :: S.FileId -> c -> IO Bool+  +  getNearestNodePortWithFile :: S.FileId -> SiteId -> c -> IO (Maybe ClientPort)+  +  getNearestNodePortForFile :: S.FileId -> Integer -> SiteId -> c -> IO (Maybe ClientPort)+  +  +  -- only to be used by the nodes+  +  createFile :: S.FileId -> IdType -> c -> IO ()++  deleteFile :: S.FileId -> IdType -> c -> IO ()++  appendFile :: S.FileId -> IdType -> c -> IO ()
+ source/Holumbus/FileSystem/Controller/ControllerData.hs view
@@ -0,0 +1,464 @@+-- ----------------------------------------------------------------------------++{- |+  Module     : Holumbus.FileSystem.Controller.ControllerData+  Copyright  : Copyright (C) 2008 Stefan Schmidt+  License    : MIT++  Maintainer : Stefan Schmidt (stefanschmidt@web.de)+  Stability  : experimental+  Portability: portable+  Version    : 0.1+++-}++-- ----------------------------------------------------------------------------++module Holumbus.FileSystem.Controller.ControllerData+(+-- * datatypes+  ControllerData+  +-- * creation and destruction+, newController+)+where++import           Prelude hiding (appendFile)++import           Control.Concurrent++import           Data.Maybe+import qualified Data.List                              as List+import qualified Data.Map                               as Map+import qualified Data.Set                               as Set++import           System.Log.Logger++import           Holumbus.Common.Debug+import           Holumbus.Common.Utils                  ( handleAll )++import qualified Holumbus.FileSystem.Controller         as C+import qualified Holumbus.FileSystem.Node               as N+import qualified Holumbus.FileSystem.Node.NodePort      as NP+import qualified Holumbus.FileSystem.Messages           as M+import qualified Holumbus.FileSystem.Storage            as S++import           Holumbus.Network.Site+import           Holumbus.Network.Communication+++localLogger :: String+localLogger = "Holumbus.FileSystem.Controller"++-- ----------------------------------------------------------------------------+--+-- ----------------------------------------------------------------------------++type FileToNodeMap = Map.Map S.FileId (Set.Set M.NodeId)++data FileControllerData = FileControllerData {+    cm_FileToNodeMap :: ! FileToNodeMap+  }++type FileController = MVar FileControllerData+++data ControllerData = ControllerData {+    cd_Server         :: Server+  , cd_FileController :: FileController+  }+++-- ----------------------------------------------------------------------------+--+-- ----------------------------------------------------------------------------+newFileController :: IO FileController+newFileController+  = do+    let fc = FileControllerData Map.empty+    newMVar fc+++newController :: StreamName -> Maybe PortNumber -> IO ControllerData+newController sn pn+  = do+    -- initialise the server+    c <- newEmptyMVar+    server <- newServer sn pn (dispatch c) (Just $ registerNode c) (Just $ unregisterNode c)+    -- initialize values+    fc <- newFileController+    let con = ControllerData server fc+    putMVar c con    +    return con+  ++dispatch +  :: MVar ControllerData +  -> M.ControllerRequestMessage +  -> IO (Maybe M.ControllerResponseMessage)+dispatch c msg+  = do+    cd <-readMVar c+    case msg of+      (M.CReqGetFileSites f) ->+        do+        s <- C.getFileSites f cd+        return $ Just $ M.CRspGetFileSites s+      (M.CReqContains f) ->+        do+        b <- C.containsFile f cd+        return $ Just $ M.CRspContains b+      (M.CReqGetNearestNodePortWithFile f sid) ->+        do+        p <- C.getNearestNodePortWithFile f sid cd+        return $ Just $ M.CRspGetNearestNodePortWithFile p+      (M.CReqGetNearestNodePortForFile f l sid) ->+        do+        p <- C.getNearestNodePortForFile f l sid cd+        return $ Just $ M.CRspGetNearestNodePortForFile p+      (M.CReqCreate f n) ->+        do+        C.createFile f n cd+        return $ Just $ M.CRspSuccess+      (M.CReqAppend f n) -> +        do+        C.appendFile f n cd+        return $ Just $ M.CRspSuccess+      (M.CReqDelete f n) ->+        do+        C.deleteFile f n cd+        return $ Just $ M.CRspSuccess+      _ -> return Nothing+++registerNode :: MVar ControllerData -> IdType -> ClientPort -> IO ()+registerNode c i cp+  = do+    let np = NP.newNodePort cp+    fids <- N.getFileIds np+    cd <- readMVar c+    modifyMVar (cd_FileController cd) $+      \fc ->+      do+      let fc' = addFilesToController fids i fc+      return (fc', ())+++unregisterNode :: MVar ControllerData -> IdType -> ClientPort -> IO ()+unregisterNode c i _+  = do+    debugM localLogger "unregisterNode: start"+    cd <- readMVar c+    modifyMVar (cd_FileController cd) $+      \fc ->+      do+      let fc' = deleteFilesFromController i fc+      return (fc', ())+    debugM localLogger "unregisterNode: end"+    +    +-- ----------------------------------------------------------------------------+--+-- ----------------------------------------------------------------------------+++{-++nodes2sites :: ControllerMaps -> [M.NodeId] ->  [SiteId]+nodes2sites (ControllerMaps _ nsm _ _ _) nids = lookupList nsm nids + +sites2ports :: ControllerMaps -> [SiteId] ->  [NP.NodePort]+sites2ports (ControllerMaps _ _ spm _ _) sids = lookupList spm sids +++-- | gets all nodessites+getNodesList :: ControllerMaps -> [M.NodeId]+getNodesList (ControllerMaps _ nsm _ _ _) = Map.keys nsm+++-- TODO+getNodesWithSpace :: S.FileId -> Integer -> ControllerMaps -> [SiteId]+getNodesWithSpace _ _ cm = getSiteList cm+++getOtherFileNodes :: S.FileId -> M.NodeId -> ControllerMaps -> [M.NodeId]+getOtherFileNodes f nid (ControllerMaps fnm _ _ _ _)+  = Set.toList $ Set.delete nid allNids+  where+    allNids = Map.findWithDefault (Set.empty) f fnm   ++-- | the minimal occurrence of a file on the nodes+copyingLimit :: Int+copyingLimit = 2+++-- | Get a list of all fileIds that should be copied.+--   That means that the file has not enough copies+-- TODO we only compare the nodeid... we should look for sites or hosts+getFilesForCopying :: FileControllerData -> [S.FileId]+getFilesForCopying cm = (fst . unzip) filteredList +  where+    fnm = cm_FileToNodeMap cm+    filteredList = filter setSelector (Map.toList fnm)+    setSelector (_,s) = Set.size s < copyingLimit+-}+++-- | Adds the files of a node to the global directory.+addFilesToController :: [S.FileId] -> M.NodeId -> FileControllerData -> FileControllerData+addFilesToController fids nid cm +  = cm { cm_FileToNodeMap = fnm' }+  where+    fnm = cm_FileToNodeMap cm+    fnm' = Map.unionWith combine fnm newMap+    newMap = Map.fromList $ zip fids (repeat $ Set.singleton nid)+    combine s1 s2 = Set.union s1 s2+++-- | Deletes the files of a node from the global directory.+deleteFilesFromController :: M.NodeId -> FileControllerData -> FileControllerData+deleteFilesFromController nid cm+  = cm { cm_FileToNodeMap = fnm' }+  where +    fnm = cm_FileToNodeMap cm +    fnm' = Map.fromList filteredList+    filteredList = filter (\(_,s) -> s /= Set.empty) list+    list = map (\(k,s) -> (k, Set.delete nid s)) (Map.toList fnm)+++addFileToController :: S.FileId -> M.NodeId -> FileControllerData -> FileControllerData+addFileToController fid nid cm = addFilesToController [fid] nid cm+++deleteFileFromController :: S.FileId -> FileControllerData -> FileControllerData+deleteFileFromController fid cm+  = cm { cm_FileToNodeMap = fnm' }+  where +    fnm = cm_FileToNodeMap cm +    fnm' = Map.delete fid fnm+    ++-- | gets the List of all sites the file is located on...+getFileClientInfoList :: S.FileId -> Server -> FileControllerData -> IO [ClientInfo]+getFileClientInfoList f s cm+  = do+    let fnm = cm_FileToNodeMap cm+    let is = Set.toList $ maybe Set.empty id (Map.lookup f fnm)+    mbDats <- mapM (\i -> getClientInfo i s) is+    return $ catMaybes mbDats  ++++lookupNearestPortWithFile :: S.FileId -> SiteId -> Server -> FileControllerData -> IO (Maybe ClientPort)+lookupNearestPortWithFile f sid s cm+  = do+    dats <- getFileClientInfoList f s cm+    let sids  = map (\ci -> ci_Site ci) dats+        mbns  = nearestId sid sids+        mbdat = maybe Nothing (\ns -> List.find (\ci -> (ci_Site ci) == ns) dats) mbns+        mbnp  = maybe Nothing (\ci -> Just $ ci_Port ci) mbdat +    return mbnp+++lookupNearestPortWithFileAndSpace :: S.FileId -> Integer -> SiteId -> Server -> FileControllerData -> IO (Maybe ClientPort)+lookupNearestPortWithFileAndSpace f _size sid s cm+  = lookupNearestPortWithFile f sid s cm+{-    dats <- getFileClientInfoList f s cm+    -- TODO add Capacity+    let sids  = map (\ci -> ci_Site ci) $ filter (...) dats+        mbns  = nearestId sid sids+        mbdat = maybe Nothing (\ns -> List.find (\(s,_,_) -> s == ns) dats) mbns+        mbnp  = maybe Nothing (\(_,np,_) -> Just np) mbdat+    return mbnp +-}++-- TODO add capacity+lookupNearestPortWithSpace :: Integer -> SiteId -> Server -> FileControllerData -> IO (Maybe ClientPort)+lookupNearestPortWithSpace _size sid s _cm+  = do+    dats <- getAllClientInfos s +    let sids  = map (\ci -> ci_Site ci) dats+        mbns  = nearestId sid sids+        mbdat = maybe Nothing (\ns -> List.find (\ci -> (ci_Site ci) == ns) dats) mbns+        mbnp  = maybe Nothing (\ci -> Just $ ci_Port ci) mbdat +    return mbnp+++lookupPortWithoutFile :: S.FileId -> Server -> FileControllerData -> IO (Maybe ClientPort)+lookupPortWithoutFile f s cm+  = do+    -- get all sites with the files+    fileCis <- getFileClientInfoList f s cm+    -- get all sites+    allCis  <- getAllClientInfos s+    let fileNids = map ci_Id fileCis+        allNids  = map ci_Id allCis+        nonNids  = Set.toList $ Set.difference (Set.fromList allNids) (Set.fromList fileNids)+    if (null nonNids)+      then return Nothing+      else do+        let i = head nonNids+        mbCi <- getClientInfo i s+        case mbCi of+          (Just ci) -> return $ Just $ ci_Port ci+          (Nothing) -> return Nothing +++lookupNearestPortForFile :: S.FileId -> Integer -> SiteId -> Server -> FileControllerData -> IO (Maybe ClientPort)+lookupNearestPortForFile f size sid s cm+  -- if file exists, get nearest node, else the closest with space+  = do+    nodeWithFile    <- lookupNearestPortWithFileAndSpace f size sid s cm+    nodeWithoutFile <- lookupNearestPortWithSpace size sid s cm +    let mbnp = maybe nodeWithoutFile (\np -> Just np) nodeWithFile+{-  debugM localLogger $ "lookupNearestPortForFile: file:            " ++ show f    +    debugM localLogger $ "lookupNearestPortForFile: size:            " ++ show size+    debugM localLogger $ "lookupNearestPortForFile: site:            " ++ show sid    +    debugM localLogger $ "lookupNearestPortForFile: nodeWithFile:    " ++ show nodeWithFile+    debugM localLogger $ "lookupNearestPortForFile: nodeWithoutFile: " ++ show nodeWithoutFile+    debugM localLogger $ "lookupNearestPortForFile: result:          " ++ show mbnp+-}  return mbnp+    ++getOtherFilePorts :: S.FileId -> IdType -> Server -> FileControllerData -> IO [ClientInfo]+getOtherFilePorts f nid s cm+  = do+    let fnm = cm_FileToNodeMap cm+    -- get all nodes which hold the file without the given node+    let otherids = Set.toList $ Set.delete nid $ maybe Set.empty id (Map.lookup f fnm)+    mbDats <- mapM (\i -> getClientInfo i s) otherids    +    return $ catMaybes mbDats++  +deleteFileFromNodes :: S.FileId -> [NP.NodePort] -> IO ()+deleteFileFromNodes fid nps = sequence_ $ map deleteFileFromNode nps+  where+    deleteFileFromNode np +      = do+        handleAll (\e -> putStrLn $ show e) $+          do +          -- send a delete-request to the node +          -- but don't inform the controller again (False)+          N.deleteFile fid False np+          return ()+          +-- ----------------------------------------------------------------------------+--+-- ---------------------------------------------------------------------------- ++instance C.ControllerClass ControllerData where++  closeController cd +    = do+      debugM localLogger "closing Server"+      closeServer (cd_Server cd)+      debugM localLogger "server closed"+++  +  -- getFileSites :: S.FileId -> Controller -> IO (Set.Set SiteId) +  getFileSites f cd+    = withMVar (cd_FileController cd) $+        \fc ->+        do+        dats <- getFileClientInfoList f (cd_Server cd) fc +        let sids = map (\ci -> ci_Site ci) dats+        return (Set.fromList sids)++  +  -- containsFile :: S.FileId -> Controller -> IO Bool+  containsFile f cd+    = withMVar (cd_FileController cd) $+        \fc -> return $ Map.member f (cm_FileToNodeMap fc)+  +      +  -- getNearestNodePortWithFile :: S.FileId -> SiteId -> c -> IO (Maybe M.NodeRequestPort)+  getNearestNodePortWithFile f sid cd+    = withMVar (cd_FileController cd) $+        \fc -> lookupNearestPortWithFile f sid (cd_Server cd) fc ++ +  -- getNearestNodePortForFile :: S.FileId -> Integer -> SiteId -> c -> IO (Maybe M.NodeRequestPort)+  getNearestNodePortForFile f c sid cd+    = withMVar (cd_FileController cd) $+        \fc -> lookupNearestPortForFile f c sid (cd_Server cd) fc+++-- ----------------------------------------------------------------------------+-- used by the nodes+-- ----------------------------------------------------------------------------+++--createFile :: S.FileId -> M.NodeId -> ControllerData -> IO ControllerData+  createFile f nid cd+    = modifyMVar (cd_FileController cd) $+        \fc ->+        do+        mbCi <- getClientInfo nid (cd_Server cd)+        case mbCi of+          (Just ci) ->+            do+            let fc' = addFileToController f nid fc+            -- copy file to one other node+            mpCp <- lookupPortWithoutFile f (cd_Server cd) fc+            case mpCp of+              (Just cp) -> +                do +                return ()+                -- let np = NP.newNodePort cp+                -- N.copyFile f (ci_Port ci) np+              (Nothing) -> return ()                  +            return (fc', ())+          (Nothing) -> return (fc,())+++--appendFile :: S.FileId -> M.NodeId -> ControllerData -> IO ControllerData+  appendFile f nid cd+    = modifyMVar (cd_FileController cd) $+        \fc ->+        do+        mbCi <- getClientInfo nid (cd_Server cd)+        case mbCi of+          (Just ci) ->+            do+            -- renew file entry+            let fc' = addFileToController f nid fc+            -- get other nodes with this file+            cps <- getOtherFilePorts f nid (cd_Server cd) fc+            let nps = map (\i -> NP.newNodePort (ci_Port i)) cps+            -- order them to copy the file from the first node+            mapM (N.copyFile f (ci_Port ci)) nps+            return (fc', ())+          (Nothing) -> return (fc,())+++--deleteFile :: S.FileId -> M.NodeId -> ControllerData -> IO ControllerData+  deleteFile f nid cd+    = modifyMVar (cd_FileController cd) $+        \fc ->+        do+        -- inform all other nodes to delete node+        cps <- getOtherFilePorts f nid (cd_Server cd) fc+        let nps = map (\ci -> NP.newNodePort (ci_Port ci)) cps+        deleteFileFromNodes f nps+        -- delete file from Controller+        let fc' = deleteFileFromController f fc        +        return (fc', ())+        +        ++instance Debug ControllerData where+  printDebug cd+    = do+      putStrLn "Controller-Object (full)"+      putStrLn "--------------------------------------------------------"        +      putStrLn "Server"+      printDebug (cd_Server cd)+      putStrLn "--------------------------------------------------------"+      putStrLn "FileToNodeMap:"+      withMVar (cd_FileController cd) $+        \fc -> do+        putStrLn $ show (cm_FileToNodeMap $ fc) +
+ source/Holumbus/FileSystem/Controller/ControllerPort.hs view
@@ -0,0 +1,142 @@+-- ----------------------------------------------------------------------------++{- |+  Module     : Holumbus.FileSystem.Controller.ControllerClass+  Copyright  : Copyright (C) 2008 Stefan Schmidt+  License    : MIT++  Maintainer : Stefan Schmidt (stefanschmidt@web.de)+  Stability  : experimental+  Portability: portable+  Version    : 0.1+++-}++-- ----------------------------------------------------------------------------++module Holumbus.FileSystem.Controller.ControllerPort+(+-- * Datatypes+  ControllerPort+  +-- * Creation and Destruction+, newControllerPort+, newControllerPortFromServerPort+)+where++import Holumbus.Common.Debug+import Holumbus.Network.Communication+import Holumbus.FileSystem.Messages+import Holumbus.FileSystem.Controller+++-- ----------------------------------------------------------------------------+-- Datatypes+-- ----------------------------------------------------------------------------+++data ControllerPort = ControllerPort ServerPort+  deriving (Show)+++-- | Creates a new ControllerPort+newControllerPort :: StreamName -> Maybe SocketId -> IO ControllerPort+newControllerPort sn soid+  = do+    sp <- newServerPort sn soid+    return (ControllerPort sp)++newControllerPortFromServerPort :: ServerPort -> ControllerPort+newControllerPortFromServerPort sp = ControllerPort sp++-- ----------------------------------------------------------------------------+-- Typeclass instanciation+-- ----------------------------------------------------------------------------+++instance ControllerClass ControllerPort where+  +  closeController _ = return ()+  +    +  -- getServerPort (ControllerPort p) = p+  +  +  getFileSites f (ControllerPort p)  +    = do+      sendRequestToServer p time30 (CReqGetFileSites f) $+        \rsp ->+        do+        case rsp of+          (CRspGetFileSites set) -> return (Just set)+          _ -> return Nothing++  +  containsFile f (ControllerPort p)+    = do+      sendRequestToServer p time30 (CReqContains f) $+        \rsp ->+        do+        case rsp of+          (CRspContains b) -> return (Just b)+          _ -> return Nothing+  +  +  getNearestNodePortWithFile f sid (ControllerPort p)+    = do+      sendRequestToServer p time30 (CReqGetNearestNodePortWithFile f sid) $+        \rsp ->+        do+        case rsp of+          (CRspGetNearestNodePortWithFile po) -> return (Just po)+          _ -> return Nothing++  +  getNearestNodePortForFile f l sid (ControllerPort p)+    = do+      sendRequestToServer p time30 (CReqGetNearestNodePortForFile f l sid) $+        \rsp ->+        do+        case rsp of+          (CRspGetNearestNodePortForFile po) -> return (Just po)+          _ -> return Nothing+            +            +  createFile f nid (ControllerPort p)+    = do+      sendRequestToServer p time30 (CReqCreate f nid) $+        \rsp ->+        do+        case rsp of+          (CRspSuccess) -> return (Just $ ())+          _ -> return Nothing+++  appendFile f nid (ControllerPort p)+    = do+      sendRequestToServer p time30 (CReqAppend f nid) $+        \rsp ->+        do+        case rsp of+          (CRspSuccess) -> return (Just $ ())+          _ -> return Nothing+++  deleteFile f nid (ControllerPort p)+    = do+      sendRequestToServer p time30 (CReqDelete f nid) $+        \rsp ->+        do+        case rsp of+          (CRspSuccess) -> return (Just $ ())+          _ -> return Nothing++            +            +instance Debug ControllerPort where            +  printDebug (ControllerPort p)+    = do+      putStrLn "ControllerPort:"+      putStrLn $ show p
+ source/Holumbus/FileSystem/FileSystem.hs view
@@ -0,0 +1,393 @@+-- ----------------------------------------------------------------------------++{- |+  Module     : Holumbus.FileSystem.FileSystem+  Copyright  : Copyright (C) 2008 Stefan Schmidt+  License    : MIT++  Maintainer : Stefan Schmidt (stefanschmidt@web.de)+  Stability  : experimental+  Portability: portable+  Version    : 0.1+++-}++-- ----------------------------------------------------------------------------++{-# OPTIONS -fglasgow-exts #-}+module Holumbus.FileSystem.FileSystem+(+-- * Datatypes+  S.FileId+, S.FileContent+, S.getContentLength+, S.FileData(..)+, FileSystem++-- * Configuration+, FSStandaloneConf(..)+, defaultFSStandaloneConfig+, FSControllerConf(..)+, defaultFSControllerConfig+, FSNodeConf(..)+, defaultFSNodeConfig+, FSClientConf(..)+, defaultFSClientConfig++-- * Creation and Destruction+, mkStandaloneFileSystem+, mkFileSystemController+, mkFileSystemNode+, mkFileSystemClient+, closeFileSystem++-- * Operations+, getMySiteId+, getFileSites+, getNearestNodePortWithFile+, getNearestNodePortForFile+, containsFile++, createFile+, appendFile+, deleteFile++, getFileContent+, getFileData+, isFileLocal++)+where++import           Prelude hiding (appendFile)++import           Control.Concurrent+import           Control.Monad++import qualified Data.Set as Set++import           System.Log.Logger++import           Holumbus.Common.Debug++import qualified Holumbus.FileSystem.Controller                as C+import qualified Holumbus.FileSystem.Controller.ControllerData as CD+import qualified Holumbus.FileSystem.Controller.ControllerPort as CP++import qualified Holumbus.FileSystem.Node                      as N+import qualified Holumbus.FileSystem.Node.NodeData             as ND+import qualified Holumbus.FileSystem.Node.NodePort             as NP++import qualified Holumbus.FileSystem.Storage                   as S+import qualified Holumbus.FileSystem.Storage.FileStorage       as FST++import           Holumbus.Network.Site+import           Holumbus.Network.Communication+++localLogger :: String+localLogger = "Holumbus.FileSystem.FileSystem"+ +-- ---------------------------------------------------------------------------+-- Datatypes+-- ---------------------------------------------------------------------------++data FileSystemData = +   forall c n. (C.ControllerClass c, N.NodeClass n, Debug c, Debug n) =>+   FileSystemData SiteId c (Maybe n)+--    fsd_siteId     :: SiteId+--  , fsd_controller :: MVar c+--  , fsd_nodep      :: forall n. (N.Node n) => MVar (Maybe n)+--}++data FileSystem = FileSystem (MVar FileSystemData)++instance Show FileSystem where+  show _ = "FileSystem"++++-- ---------------------------------------------------------------------------+-- Configurations+-- ---------------------------------------------------------------------------+++data FSStandaloneConf = FSStandaloneConf {+    fstc_StreamName       :: StreamName+  , fstc_StoragePath      :: FilePath+  , fstc_StorageFile      :: FilePath+  } +  +defaultFSStandaloneConfig :: FSStandaloneConf+defaultFSStandaloneConfig = FSStandaloneConf "FSController" "storage/" "directory"+++data FSControllerConf = FSControllerConf {+    fcoc_StreamName       :: StreamName+  , fcoc_PortNumber       :: Maybe PortNumber+  }+   +defaultFSControllerConfig :: FSControllerConf+defaultFSControllerConfig = FSControllerConf "FSController" Nothing+++data FSNodeConf = FSNodeConf {+    fnoc_StreamName       :: StreamName+  , fnoc_SocketId         :: Maybe SocketId+  , fnoc_StoragePath      :: FilePath+  , fnoc_StorageFile      :: FilePath+  }+   +defaultFSNodeConfig :: FSNodeConf+defaultFSNodeConfig = FSNodeConf "FSController" Nothing "storage/" "directory"+++data FSClientConf = FSClientConf {+    fclc_StreamName       :: StreamName+  , fclc_SocketId         :: Maybe SocketId+  }+   +defaultFSClientConfig :: FSClientConf+defaultFSClientConfig = FSClientConf "FSController" Nothing+++++-- ---------------------------------------------------------------------------+-- Creation and Destruction+-- ---------------------------------------------------------------------------+++mkStandaloneFileSystem+  :: FSStandaloneConf +  -> IO (FileSystem)+mkStandaloneFileSystem conf+  = do+    controller <- CD.newController (fstc_StreamName conf) Nothing+    let storage = FST.newFileStorage (fstc_StoragePath conf) (fstc_StorageFile conf) +    node <- ND.newNode (fstc_StreamName conf) Nothing storage+    fs <- newFileSystem controller (Just node)+    return fs+++mkFileSystemController+  :: FSControllerConf+  -> IO (FileSystem)+mkFileSystemController conf+  = do+    sid <- getSiteId+    infoM localLogger $ "initialising controller on site " ++ show sid  +    controller <- CD.newController (fcoc_StreamName conf) (fcoc_PortNumber conf)+    newFileSystem controller (Nothing::Maybe NP.NodePort)+  ++mkFileSystemNode+  :: FSNodeConf+  -> IO (FileSystem)+mkFileSystemNode conf+  = do+    sid <- getSiteId+    infoM localLogger $ "initialising node on site " ++ show sid  +    cp <- CP.newControllerPort (fnoc_StreamName conf) (fnoc_SocketId conf)+    infoM localLogger "creating filestorage"+    let storage = FST.newFileStorage (fnoc_StoragePath conf) (fnoc_StorageFile conf) +    node <- ND.newNode (fnoc_StreamName conf) (fnoc_SocketId conf) storage+    newFileSystem cp (Just node)+  ++mkFileSystemClient+  :: FSClientConf+  -> IO (FileSystem)+mkFileSystemClient conf+  = do+    sid <- getSiteId+    infoM localLogger $ "initialising client on site " ++ show sid  +    cp <- CP.newControllerPort (fclc_StreamName conf) (fclc_SocketId conf)+    newFileSystem cp (Nothing::Maybe NP.NodePort)+++-- | Closes the filesystem.+closeFileSystem :: FileSystem -> IO ()+closeFileSystem (FileSystem fs) +  = do+    debugM localLogger "beginning to close filesystem"+    withMVar fs $+      \(FileSystemData _ c n) ->+      do+      case n of+        (Just n') -> +          do+          debugM localLogger "closing Node"+          N.closeNode n'+        (Nothing) -> +          do+          debugM localLogger "no Node to close"+          return ()+      debugM localLogger "closing Controller"+      C.closeController c+      debugM localLogger "filesystem closed"++++-- ---------------------------------------------------------------------------+-- private helper-functions+-- ---------------------------------------------------------------------------+++-- | Creates a new FileSystem with a controller and (maybe) a node.+newFileSystem :: (C.ControllerClass c, N.NodeClass n, Debug c, Debug n) => c -> Maybe n -> IO (FileSystem)+newFileSystem c n+  = do+    sid <- getSiteId+    fs <- newMVar (FileSystemData sid c n)+    return (FileSystem fs)+++-- | get a NodePort from a NodeRequestPort+createNodePort :: (Maybe ClientPort) -> (Maybe NP.NodePort)+createNodePort Nothing = Nothing+createNodePort (Just p) = Just $ NP.newNodePort p+++-- ---------------------------------------------------------------------------+-- public functions+-- ---------------------------------------------------------------------------++getMySiteId :: FileSystem -> IO (SiteId)+getMySiteId (FileSystem fs)+  = do +    withMVar fs $+      \(FileSystemData s _ _) -> return s++-- | Get a set of all sites the file exists.+getFileSites :: S.FileId -> FileSystem -> IO (Set.Set SiteId)+getFileSites f (FileSystem fs)+  = do+    withMVar fs $+      \(FileSystemData _ c _) -> +      C.getFileSites f c+++-- | gets the nearest NodePort with our fileId+getNearestNodePortWithFile :: S.FileId -> FileSystem -> IO (Maybe NP.NodePort)+getNearestNodePortWithFile f (FileSystem fs)+  = withMVar fs $+      \(FileSystemData sid c _) -> +      (liftM createNodePort) $ C.getNearestNodePortWithFile f sid c+    ++-- | gets the nearest NodePort on which we can create our fileId. we need the+--   content-size to get a node with enough space.+getNearestNodePortForFile :: S.FileId -> Integer -> FileSystem -> IO (Maybe NP.NodePort)+getNearestNodePortForFile f l (FileSystem fs)+  = withMVar fs $+      \(FileSystemData sid c _) -> +      (liftM createNodePort) $ C.getNearestNodePortForFile f l sid c+++-- | Checks if a file is in the filesystem+containsFile :: S.FileId -> FileSystem -> IO Bool+containsFile f (FileSystem fs)+  = do+    withMVar fs $+      \(FileSystemData _ c _) ->+      C.containsFile f c+++-- | Creates a file in the filesystem.+createFile :: S.FileId -> S.FileContent -> FileSystem -> IO ()+createFile f c fs+  = do+    infoM localLogger $ "creating file: " ++ show f+    np <- getNearestNodePortForFile f (S.getContentLength c) fs+    case np of+      (Nothing) -> return ()+      (Just np') -> +        do +        N.createFile f c np'+        return ()+++-- | Appends a file in the fileSystem.+appendFile :: S.FileId -> S.FileContent -> FileSystem -> IO ()+appendFile f c fs+  = do+    infoM localLogger $ "appending file: " ++ show f+    np <- getNearestNodePortForFile f (S.getContentLength c) fs+    debugM localLogger $ "nearest port: " ++ show np+    case np of+      (Nothing) -> return ()+      (Just np') ->+        do+        N.appendFile f c np'+        return ()+++-- | Deletes a file from the filesystem.+deleteFile :: S.FileId -> FileSystem -> IO ()+deleteFile f fs+  = do+    infoM localLogger $ "deleting file: " ++ show f+    np <- getNearestNodePortWithFile f fs+    case np of+      (Nothing) -> return ()+      (Just np') ->+        do+        -- start a delete cascade... (True)+        N.deleteFile f True np'+        return ()+++-- | Gets the file content from the nearest site whitch holds the file+getFileContent :: S.FileId -> FileSystem -> IO (Maybe S.FileContent)+getFileContent f fs+  = do+    infoM localLogger $ "getting file: " ++ show f+    np <- getNearestNodePortWithFile f fs+    case np of+      (Nothing) -> return Nothing+      (Just np') ->+        do+        N.getFileContent f np' +++-- | Gets the file data from the nearest site whitch holds the file+getFileData :: S.FileId -> FileSystem -> IO (Maybe S.FileData)+getFileData f fs +  = do+    np <- getNearestNodePortWithFile f fs+    case np of+      (Nothing) -> return Nothing+      (Just np') ->+        do+        N.getFileData f np' +++-- | Tests, if the local storage (if one exists) holds the file+isFileLocal :: S.FileId -> FileSystem -> IO Bool+isFileLocal f (FileSystem fs)+  = do+    withMVar fs $+      \(FileSystemData _ _ n) ->+      maybe (return False) (\n' -> N.containsFile f n') n+++instance Debug FileSystem where  +  printDebug (FileSystem fs)+    = do+      withMVar fs $+        \(FileSystemData s c n) ->+        do+        putStrLn "--------------------------------------------------------"+        putStrLn "FileSystem - internal data\n"+        putStrLn "--------------------------------------------------------"+        putStrLn "SiteId:"+        putStrLn $ show s+        putStrLn "--------------------------------------------------------"+        putStrLn "Controller:"+        printDebug c+        putStrLn "--------------------------------------------------------"+        putStrLn "Node:"+        maybe (putStrLn "NOTHING") (\n' -> printDebug n') n+        putStrLn "--------------------------------------------------------"
+ source/Holumbus/FileSystem/Messages.hs view
@@ -0,0 +1,233 @@+-- ----------------------------------------------------------------------------++{- |+  Module     : Holumbus.FileSystem.Messages+  Copyright  : Copyright (C) 2008 Stefan Schmidt+  License    : MIT++  Maintainer : Stefan Schmidt (stefanschmidt@web.de)+  Stability  : experimental+  Portability: portable+  Version    : 0.1++  This module contains all message types which are exchanged between node and+  Controller.+-}++-- ----------------------------------------------------------------------------++{-# OPTIONS -fglasgow-exts #-}+module Holumbus.FileSystem.Messages+(+-- * Datatypes+  NodeId++-- * Message Types from and to the Controller+, ControllerRequestMessage(..)+, ControllerResponseMessage(..)++-- * Message Types from and to the Node+, NodeRequestMessage(..)+, NodeResponseMessage(..)++-- * request an response handling+, performPortAction -- reexport from Holumbus.Network.Messages+)+where++import           Prelude hiding (appendFile)++import           Data.Binary+import           Data.Set++import           Holumbus.Network.Communication+import qualified Holumbus.Network.Site as Site+import qualified Holumbus.FileSystem.Storage as S+import           Holumbus.Network.Messages++++-- ----------------------------------------------------------------------------+-- Datatypes+-- ---------------------------------------------------------------------------- ++type NodeId = Int++++-- ----------------------------------------------------------------------------+-- Message Types from and to the Controller+-- ----------------------------------------------------------------------------+++-- | Requests datatype, which is send to a filesystem Controller.+data ControllerRequestMessage+  = CReqContains                   S.FileId+  | CReqGetFileSites               S.FileId+  | CReqGetNearestNodePortWithFile S.FileId Site.SiteId +  | CReqGetNearestNodePortForFile  S.FileId Integer Site.SiteId+  | CReqCreate                     S.FileId NodeId+  | CReqAppend                     S.FileId NodeId+  | CReqDelete                     S.FileId NodeId+  | CReqUnknown+  deriving (Show)+++instance Binary ControllerRequestMessage where+  put (CReqContains f)                      = putWord8 1  >> put f+  put (CReqGetFileSites f)                  = putWord8 2  >> put f+  put (CReqGetNearestNodePortWithFile f s)  = putWord8 3  >> put f >> put s+  put (CReqGetNearestNodePortForFile f l s) = putWord8 4  >> put f >> put l >> put s+  put (CReqCreate f n)                      = putWord8 5  >> put f >> put n+  put (CReqAppend f n)                      = putWord8 6  >> put f >> put n+  put (CReqDelete f n)                      = putWord8 7  >> put f >> put n+  put (CReqUnknown)                         = putWord8 0+  get+    = do+      t <- getWord8+      case t of+        1  -> get >>= \f -> return (CReqContains f)+        2  -> get >>= \f -> return (CReqGetFileSites f)+        3  -> get >>= \f -> get >>= \s -> return (CReqGetNearestNodePortWithFile f s)+        4  -> get >>= \f -> get >>= \l -> get >>= \s -> return (CReqGetNearestNodePortForFile  f l s)+        5  -> get >>= \f -> get >>= \n -> return (CReqCreate f n)+        6  -> get >>= \f -> get >>= \n -> return (CReqAppend f n)+        7  -> get >>= \f -> get >>= \n -> return (CReqDelete f n)+        _  -> return (CReqUnknown)+++-- | Response datatype from a filesystem Controller.+data ControllerResponseMessage+  = CRspSuccess+  | CRspGetFileSites (Set Site.SiteId)+  | CRspContains Bool+  | CRspGetNearestNodePortWithFile (Maybe ClientPort)+  | CRspGetNearestNodePortForFile (Maybe ClientPort)+  | CRspError String+  | CRspUnknown+  deriving (Show)+  +  +instance RspMsg ControllerResponseMessage where+  isError (CRspError _) = True+  isError _ = False+  +  getErrorMsg (CRspError e) = e+  getErrorMsg _ = ""+  +  isUnknown (CRspUnknown) = True+  isUnknown _ = False+  +  mkErrorMsg e = CRspError e+++instance Binary ControllerResponseMessage where+  put (CRspSuccess)                       = putWord8 1+  put (CRspGetFileSites s)                = putWord8 2 >> put s +  put (CRspContains b)                    = putWord8 3 >> put b+  put (CRspGetNearestNodePortWithFile p)  = putWord8 4 >> put p+  put (CRspGetNearestNodePortForFile p)   = putWord8 5 >> put p+  put (CRspError e)                       = putWord8 6 >> put e+  put (CRspUnknown)                       = putWord8 0+  get+    = do+      t <- getWord8+      case t of+        1 -> return (CRspSuccess)+        2 -> get >>= \s -> return (CRspGetFileSites s) +        3 -> get >>= \b -> return (CRspContains b)+        4 -> get >>= \p -> return (CRspGetNearestNodePortWithFile p)+        5 -> get >>= \p -> return (CRspGetNearestNodePortForFile p)+        6 -> get >>= \e -> return (CRspError e)+        _ -> return (CRspUnknown)++++-- ----------------------------------------------------------------------------+-- Message Types from and to the Node+-- ----------------------------------------------------------------------------+++-- | Requests datatype, which is send to a filesystem node.+data NodeRequestMessage +  = NReqCreate          S.FileId S.FileContent+  | NReqAppend          S.FileId S.FileContent+  | NReqDelete          S.FileId Bool+  | NReqCopy            S.FileId ClientPort+  | NReqContains        S.FileId+  | NReqGetFileContent  S.FileId+  | NReqGetFileData     S.FileId+  | NReqGetFileIds      +  | NReqUnknown         +  deriving (Show)+++instance Binary NodeRequestMessage where+  put (NReqCreate i c)       = putWord8 1 >> put i >> put c+  put (NReqAppend i c)       = putWord8 2 >> put i >> put c+  put (NReqDelete i b)       = putWord8 3 >> put i >> put b+  put (NReqCopy i cp)        = putWord8 4 >> put i >> put cp+  put (NReqContains i)       = putWord8 5 >> put i+  put (NReqGetFileContent i) = putWord8 6 >> put i+  put (NReqGetFileData i)    = putWord8 7 >> put i+  put (NReqGetFileIds)       = putWord8 8+  put (NReqUnknown)          = putWord8 0+  get+    = do+      t <- getWord8+      case t of+        1 -> get >>= \i -> get >>= \c -> return (NReqCreate i c) +        2 -> get >>= \i -> get >>= \c -> return (NReqAppend i c) +        3 -> get >>= \i -> get >>= \b -> return (NReqDelete i b)+        4 -> get >>= \i -> get >>= \cp -> return (NReqCopy i cp)+        5 -> get >>= \i -> return (NReqContains i)+        6 -> get >>= \i -> return (NReqGetFileContent i)+        7 -> get >>= \i -> return (NReqGetFileData i)+        8 -> return (NReqGetFileIds)+        _ -> return (NReqUnknown)+++-- | Response datatype from a filesystem node.+data NodeResponseMessage+  = NRspSuccess+  | NRspContains Bool+  | NRspGetFileContent (Maybe S.FileContent)+  | NRspGetFileData (Maybe S.FileData)+  | NRspGetFileIds [S.FileId]+  | NRspError String+  | NRspUnknown+  deriving (Show)      +++instance RspMsg NodeResponseMessage where+  isError (NRspError _) = True+  isError _ = False+  +  getErrorMsg (NRspError e) = e+  getErrorMsg _ = ""+  +  isUnknown (NRspUnknown) = True+  isUnknown _ = False+  +  mkErrorMsg e = NRspError e++        +instance Binary NodeResponseMessage where+  put (NRspSuccess)          = putWord8 1+  put (NRspContains b)       = putWord8 2 >> put b+  put (NRspGetFileContent c) = putWord8 3 >> put c+  put (NRspGetFileData d)    = putWord8 4 >> put d+  put (NRspGetFileIds ls)    = putWord8 5 >> put ls+  put (NRspError e)          = putWord8 6 >> put e+  put (NRspUnknown)          = putWord8 0+  get+    = do+      t <- getWord8+      case t of+        1 -> return (NRspSuccess)+        2 -> get >>= \b  -> return (NRspContains b)+        3 -> get >>= \c  -> return (NRspGetFileContent c)+        4 -> get >>= \d  -> return (NRspGetFileData d)+        5 -> get >>= \ls -> return (NRspGetFileIds ls)+        6 -> get >>= \e  -> return (NRspError e)+        _ -> return (NRspUnknown)
+ source/Holumbus/FileSystem/Node.hs view
@@ -0,0 +1,52 @@+-- ----------------------------------------------------------------------------++{- |+  Module     : Holumbus.FileSystem.Node+  Copyright  : Copyright (C) 2008 Stefan Schmidt+  License    : MIT++  Maintainer : Stefan Schmidt (stefanschmidt@web.de)+  Stability  : experimental+  Portability: portable+  Version    : 0.1+++-}++-- ----------------------------------------------------------------------------++module Holumbus.FileSystem.Node+(+-- * Typeclass+  NodeClass(..)++)+where++import qualified Holumbus.FileSystem.Storage as S+import           Holumbus.Network.Communication+++-- ----------------------------------------------------------------------------+-- Typeclass+-- ----------------------------------------------------------------------------++class NodeClass n where++  closeNode :: n -> IO ()++  createFile :: S.FileId -> S.FileContent -> n -> IO ()++  appendFile :: S.FileId -> S.FileContent -> n -> IO ()++  deleteFile :: S.FileId -> Bool -> n -> IO ()++  copyFile :: S.FileId -> ClientPort -> n -> IO ()++  containsFile :: S.FileId -> n -> IO Bool++  getFileContent :: S.FileId -> n -> IO (Maybe S.FileContent)++  getFileData :: S.FileId -> n -> IO (Maybe S.FileData)++  getFileIds :: n -> IO [S.FileId]
+ source/Holumbus/FileSystem/Node/NodeData.hs view
@@ -0,0 +1,278 @@+-- ----------------------------------------------------------------------------++{- |+  Module     : Holumbus.FileSystem.Node.NodeData+  Copyright  : Copyright (C) 2008 Stefan Schmidt+  License    : MIT++  Maintainer : Stefan Schmidt (stefanschmidt@web.de)+  Stability  : experimental+  Portability: portable+  Version    : 0.1+++-}++-- ----------------------------------------------------------------------------++module Holumbus.FileSystem.Node.NodeData+(+-- * data types+  NodeData++-- * creation and destruction+, newNode+)+where++import           Prelude hiding (appendFile)++import           Control.Concurrent+import           Control.Monad+import           Data.Maybe+import           System.IO hiding (appendFile)+import           System.Log.Logger++import           Holumbus.Common.Debug+import           Holumbus.Common.Utils+import           Holumbus.FileSystem.Node+import           Holumbus.FileSystem.Node.NodePort+import qualified Holumbus.FileSystem.Controller as C+import qualified Holumbus.FileSystem.Controller.ControllerPort as CP+import qualified Holumbus.FileSystem.Messages as M+import qualified Holumbus.FileSystem.Storage as S+import qualified Holumbus.FileSystem.Storage.FileStorage as FS++import           Holumbus.Network.Communication++localLogger :: String+localLogger = "Holumbus.FileSystem.Node.NodeData"+++-- ----------------------------------------------------------------------------+--+-- ----------------------------------------------------------------------------++      +-- | Node datatype.+data NodeData = NodeData {+    nd_Client          :: Client+  , nd_Storage         :: FS.FileStorage+  }++data Node = Node (MVar NodeData)++-- ----------------------------------------------------------------------------+--+-- ----------------------------------------------------------------------------++newNode :: StreamName -> Maybe SocketId -> FS.FileStorage -> IO Node+newNode sn soid stor+  = do+    -- initialise the client+    node <- newEmptyMVar+    client <- newClient sn soid (dispatch (Node node))+    -- open storage+    stor' <- S.openStorage stor             +    putMVar node (NodeData client stor')+    return (Node node)+++dispatch +  :: Node+  -> M.NodeRequestMessage +  -> IO (Maybe M.NodeResponseMessage)+dispatch nd msg+  = do+    case msg of+      (M.NReqCreate i c) ->+        do+        createFile i c nd+        return $ Just M.NRspSuccess        +      (M.NReqAppend i c) -> +        do+        appendFile i c nd+        return $ Just M.NRspSuccess+      (M.NReqDelete i b) ->+        do+        deleteFile i b nd+        return $ Just M.NRspSuccess+      (M.NReqCopy i cp) ->+        do+        copyFile i cp nd+        return $ Just M.NRspSuccess+      (M.NReqContains i)-> +        do+        b <- containsFile i nd+        return $ Just $ M.NRspContains b+      (M.NReqGetFileContent i) ->+        do+        c <- getFileContent i nd+        return $ Just $ M.NRspGetFileContent c+      (M.NReqGetFileData i) ->+        do+        d <- getFileData i nd+        return $ Just $ M.NRspGetFileData d+      (M.NReqGetFileIds) ->+        do+        ls <- getFileIds nd+        return $ Just $ M.NRspGetFileIds ls+      _ -> return Nothing ++++-- ----------------------------------------------------------------------------+--+-- ----------------------------------------------------------------------------+++changeStorage :: (FS.FileStorage -> IO FS.FileStorage) -> Node -> IO ()+changeStorage f (Node node)+  = modifyMVar node $ +      \nd -> +      do+      stor' <- f (nd_Storage nd)+      return (nd {nd_Storage = stor'}, ())+++readStorage :: (FS.FileStorage-> IO a) -> Node -> IO a+readStorage f (Node node)+  = withMVar node $ \nd -> f (nd_Storage nd)++++-- ----------------------------------------------------------------------------+-- Typeclass instanciation (NodeClass)+-- ----------------------------------------------------------------------------+++instance NodeClass Node where+  ++  closeNode (Node node)+    = modifyMVar node $+        \nd ->+        do+        infoM localLogger "closing filesystem node"+        closeClient (nd_Client nd)+        return (nd,())+      +     +  --createFile :: S.FileId -> S.FileContent -> Node -> IO ()+  createFile i c n@(Node node)+    = do+      client <- withMVar node $ \nd -> return (nd_Client nd)+      nid <- getClientId client+      case nid of+        (Nothing) ->+          do+          --TODO better exception-handling+          errorM localLogger $ "createFile \"" ++ i ++ "\" - no nid"+          return ()+        (Just nid') ->+          do+          changeStorage (\stor -> S.createFile stor i c) n +          server <- getServerPort client+          let cp = CP.newControllerPortFromServerPort server+          C.createFile i nid' cp+          return ()+          ++  --appendFile :: S.FileId -> S.FileContent -> Node -> IO ()+  appendFile i c n@(Node node)+    = do+      client <- withMVar node $ \nd -> return (nd_Client nd)+      nid <- getClientId client+      case nid of+        (Nothing) ->+          do+          --TODO better exception-handling          +          errorM localLogger $ "appendFile \"" ++ i ++ "\" - no nid"+          return ()+        (Just nid') ->+          do+          changeStorage (\stor -> S.appendFile stor i c) n+          server <- getServerPort client+          let cp = CP.newControllerPortFromServerPort server+          -- Inform Controller that file has changed.+          C.appendFile i nid' cp          +          return ()+++  --deleteFile :: S.FileId -> Node -> IO ()+  deleteFile i b n@(Node node)+    = do+      client <- withMVar node $ \nd -> return (nd_Client nd)+      nid <- getClientId client+      case nid of+        (Nothing) ->+          do+          --TODO better exception-handling+          errorM localLogger $ "deleteFile \"" ++ i ++ "\" - no nid"+          return ()+        (Just nid') ->+          do+          changeStorage (\stor -> S.deleteFile stor i) n+          if (b) +            then do+              server <- getServerPort client+              let cp = CP.newControllerPortFromServerPort server+              C.deleteFile i nid' cp+              return ()+            else return ()+++  copyFile i cp n+    = do+      let np = newNodePort cp+      c <- getFileContent i np+      -- TODO do not create new file data +      --d <- getFileData i np+      if (isJust c) +        then do+          createFile i (fromJust c) n+          return ()+        else do+          errorM localLogger $ "copyFile: no content for \"" ++ i ++ "\" found"+          return ()+++  --containsFile :: S.FileId -> Node -> IO Bool+  containsFile i n+    = do+      readStorage (\stor -> S.containsFile stor i) n+++  --getFileContent :: S.FileId -> Node -> IO (Maybe S.FileContent)+  getFileContent i n+    = do+      c <- readStorage (\stor -> S.getFileContent stor i) n+      debugM localLogger $ "getFileContent: " ++ show c+      return c+    ++  --getFileData :: S.FileId -> Node -> IO (Maybe S.FileData)+  getFileData i nd+    = do+      readStorage (\stor -> S.getFileData stor i) nd+++  --getFileIds :: Node -> IO [S.FileId]+  getFileIds nd+    = do+      readStorage (\stor -> S.getFileIds stor) nd+++++instance Debug Node where+  printDebug (Node node)+    = do+      putStrLn "Node-Object (full)"+      withMVar node $+        \nd ->+        do+        printDebug (nd_Client nd)+        putStrLn $ prettyRecordLine gap "Storage:" (nd_Storage nd)+        where+        gap = 20
+ source/Holumbus/FileSystem/Node/NodePort.hs view
@@ -0,0 +1,144 @@+-- ----------------------------------------------------------------------------++{- |+  Module     : Holumbus.FileSystem.Node.NodePort+  Copyright  : Copyright (C) 2008 Stefan Schmidt+  License    : MIT++  Maintainer : Stefan Schmidt (stefanschmidt@web.de)+  Stability  : experimental+  Portability: portable+  Version    : 0.1+++-}++-- ----------------------------------------------------------------------------++module Holumbus.FileSystem.Node.NodePort+(+-- * Datatypes+  NodePort+  +-- * Creation and Destruction+, newNodePort+)+where++import Holumbus.Common.Debug+import Holumbus.Network.Communication+import Holumbus.FileSystem.Messages+import Holumbus.FileSystem.Node+++-- ----------------------------------------------------------------------------+-- Datatypes+-- ----------------------------------------------------------------------------+++data NodePort = NodePort ClientPort+  deriving (Show)+++-- | Creates a new NodePort.+newNodePort :: ClientPort -> NodePort+newNodePort p = NodePort p+++++-- ----------------------------------------------------------------------------+-- Typeclass instanciation+-- ----------------------------------------------------------------------------+++instance NodeClass NodePort where+  +  closeNode _ = return ()+  +  +  createFile i c (NodePort p)+    = do+      sendRequestToClient p time30 (NReqCreate i c) $+        \rsp ->+        do+        case rsp of+            (NRspSuccess) -> return (Just ())+            _ -> return Nothing+++  appendFile i c (NodePort p)+    = do+      sendRequestToClient p time30 (NReqAppend i c) $+        \rsp ->+        do+        case rsp of+          (NRspSuccess) -> return (Just ())+          _ -> return Nothing+++  deleteFile i b (NodePort p) +    = do+      sendRequestToClient p time30 (NReqDelete i b) $+        \rsp ->+        do+        case rsp of+          (NRspSuccess) -> return (Just ())+          _ -> return Nothing+++  copyFile i cp (NodePort p)+    = do+      sendRequestToClient p time30 (NReqCopy i cp) $+        \rsp ->+        do+        case rsp of+          (NRspSuccess) -> return (Just ())+          _ -> return Nothing+++  containsFile i (NodePort p)+    = do+      sendRequestToClient p time30 (NReqContains i) $+        \rsp ->+        do+        case rsp of+          (NRspContains b) -> return (Just b)+          _ -> return Nothing+++  getFileContent i (NodePort p)+    = do+      sendRequestToClient p time30 (NReqGetFileContent i) $+        \rsp ->+        do+        case rsp of+          (NRspGetFileContent c) -> return (Just c)+          _ -> return Nothing++    +  getFileData i (NodePort p)+    = do+      sendRequestToClient p time30 (NReqGetFileData i) $+        \rsp ->+        do+        case rsp of+          (NRspGetFileData d) -> return (Just d)+          _ -> return Nothing+++  getFileIds (NodePort p)+    = do+      sendRequestToClient p time30 (NReqGetFileIds) $+        \rsp ->+        do+        case rsp of+          (NRspGetFileIds ls) -> return (Just ls)+          _ -> return Nothing+++instance Debug NodePort where+  printDebug (NodePort p)+    = do+      putStrLn "NodePort:"+      putStrLn $ show p
+ source/Holumbus/FileSystem/Storage.hs view
@@ -0,0 +1,216 @@+-- ----------------------------------------------------------------------------++{- |+  Module     : Holumbus.FileSystem.Storage+  Copyright  : Copyright (C) 2008 Stefan Schmidt+  License    : MIT++  Maintainer : Stefan Schmidt (stefanschmidt@web.de)+  Stability  : experimental+  Portability: portable+  Version    : 0.1++  This Module contains the typeclass of a storage and the associated datatypes.+  +-}++-- ----------------------------------------------------------------------------++module Holumbus.FileSystem.Storage+(+-- * file datatypes+  FileId+, FileContent+--, getFileContentType++-- * file operation+, getContentLength++-- * metadata+, FileData(..)+, createFileData+, updateFileData++-- * storage typeclass+, Storage(..)+)+where++import           Prelude hiding (appendFile)+import           Data.Binary+import           Data.Time+import qualified Data.ByteString.Lazy as B+++-- -----------------------------------------------------------------------------+-- the file content+-- -----------------------------------------------------------------------------++-- | The file-identifier, should be unique in the whole system and+--   be an instance of the classes show, eq, ord and binary+type FileId = String++{-+data FileType = FTText | FTList | FTBin+  deriving (Show, Eq, Ord, Enum)+  +instance Binary FileType where+  put (FTText) = putWord8 1+  put (FTList) = putWord8 2+  put (FTBin) = putWord8 0+  get+    = do+      t <- getWord8+      case t of+        1 -> return FTText+        2 -> return FTList+        _ -> return FTBin+-}++type FileContent = B.ByteString++{-+-- | The content of a file, this will be generic in further versions+data FileContent +  = TextFile String+  | ListFile [B.ByteString]+  | BinFile B.ByteString+  deriving (Show)+++-- | gets the type of the file content+getFileContentType :: FileContent -> FileType+getFileContentType (TextFile _) = FTText+getFileContentType (ListFile _) = FTList+getFileContentType (BinFile _)  = FTBin+-}++getContentLength :: FileContent -> Integer+getContentLength c = fromIntegral $ B.length c++{-+-- | The length of the file-content+getContentLength :: FileContent -> Integer+getContentLength (TextFile s) = fromIntegral $ length s+getContentLength (ListFile s) = fromIntegral $ length s+getContentLength (BinFile s)  = fromIntegral $ B.length s+-}+++-- | A hash function for the content, to compare two files+getContentHash :: FileContent -> Integer+getContentHash _ = 0+++{-+instance Binary FileContent where+  put (TextFile s) = putWord8 1 >> put s+  put (ListFile s) = putWord8 2 >> put s+  put (BinFile s)  = putWord8 0 >> put s+  get +    = do+      t <- getWord8+      case t of+        1 -> get >>= \s -> return (TextFile s)+        2 -> get >>= \s -> return (ListFile s)+        _ -> get >>= \s -> return (BinFile s)       +-}+++-- -----------------------------------------------------------------------------+-- the file metadata+-- -----------------------------------------------------------------------------++-- | metadata of a file, known by the storage.+data FileData = MkFileData {+  --  fd_Type             :: FileType  -- ^ filetype+    fd_FileId           :: FileId    -- ^ filename+  , fd_Size             :: Integer   -- ^ filesize+  , fd_CreationDate     :: UTCTime   -- ^ creation date+  , fd_LastModifiedDate :: UTCTime   -- ^ last modified date+  , fd_Hashvalue        :: Integer   -- ^ hash value+  } deriving (Show)++-- | Create a new file data item.+createFileData :: FileId -> FileContent -> IO (FileData)+createFileData i c+  = do +    time <- getCurrentTime+    return (MkFileData+      -- (getFileContentType c)+      i+      (getContentLength c)+      time+      time+      (getContentHash c)+     )++-- | Updates a new file data item with the date, size and hash value of+--   an old one. First parameter is the new item, second the old one.+updateFileData :: FileData -> FileData -> FileData+updateFileData new old+  = old {+      fd_Size             = fd_Size new+    , fd_LastModifiedDate = fd_LastModifiedDate new+    , fd_Hashvalue        = fd_Hashvalue new+    }+++instance Binary FileData where+  put d +    = -- put (fd_Type d) >>+      put (fd_FileId d) >> +      put (fd_Size d) >> +      put (show $ fd_CreationDate d) >> +      put (show $ fd_LastModifiedDate d) >>+      put (fd_Hashvalue d)+  get +    = do+      -- t    <- get+      name <- get+      size <- get+      dat1 <- get+      dat2 <- get+      hash <- get+      return (MkFileData name size (read dat1) (read dat2) hash) ++++-- -----------------------------------------------------------------------------+-- the storage typeclass+-- -----------------------------------------------------------------------------++-- | The interface of a storage.  +class Storage s where++  -- | Initialize the storage.+  openStorage :: s -> IO (s)+  +  -- | Deinitialize the storage.+  closeStorage :: s -> IO (s)+  +  -- | Create a new file in the storage.+  --   Overwrite the file if it already exists.+  createFile :: s -> FileId -> FileContent -> IO (s)++  -- | Delete a file in the storage.+  --   Nothing happens if the file doesn't exist+  deleteFile :: s -> FileId -> IO (s)++  -- | Append the content of the file.+  --   Create a new file, if it doesn't already exist+  appendFile :: s -> FileId -> FileContent -> IO (s)++  -- | Check if the file is already in the storage+  containsFile :: s -> FileId -> IO Bool++  -- | Get the content of a file.+  --   Return Nothing, if the file doesn't exist+  getFileContent :: s -> FileId -> IO (Maybe FileContent)++  -- | Get the metadata of a file.+  --   Return Nothing, if the file doesn't exist+  getFileData :: s -> FileId -> IO(Maybe FileData)++  -- | List the files in the storage   +  getFileIds :: s -> IO [FileId]
+ source/Holumbus/FileSystem/Storage/FileStorage.hs view
@@ -0,0 +1,245 @@+-- ----------------------------------------------------------------------------++{- |+  Module     : Holumbus.FileSystem.Storage.FileStorage+  Copyright  : Copyright (C) 2008 Stefan Schmidt+  License    : MIT++  Maintainer : Stefan Schmidt (stefanschmidt@web.de)+  Stability  : experimental+  Portability: portable+  Version    : 0.1++  Implementation of the storage class.+  The FileStorage saves each file in a single physical file. The metadata of+  the files is hold in an extra directory an saved on disk.++-}++-- ----------------------------------------------------------------------------++module Holumbus.FileSystem.Storage.FileStorage+    (+      -- * datatypes+      FileStorage++      -- * storage initialisation+    , newFileStorage +    )+where++import           Control.Monad+import           Control.Exception+import qualified Data.ByteString.Lazy as B+import           Data.Binary+import           Data.Maybe+import           System.IO+import           System.Directory+import           System.Log.Logger+import qualified Data.Map as Map++import           Holumbus.Common.Utils		 ( handleAll )+import           Holumbus.Common.FileHandling+import qualified Holumbus.FileSystem.Storage	 as S++localLogger :: String+localLogger = "Holumbus.FileSystem.Storage.FileStorage"++-- | The directory of the files in the storage. +type StorageFileDirectory = Map.Map S.FileId S.FileData++-- | The filestorage datatype.+--   Every file is physically saved in one file on the harddisk+data FileStorage = MkFileStorage {+    fs_Path        :: FilePath             -- ^ path to the storage directory+  , fs_DirfilePath :: FilePath             -- ^ path to the directory file+  , fs_Directory   :: StorageFileDirectory -- ^ the directory with the metadata+  } deriving (Show)++-- -----------------------------------------------------------------------------+-- internal operations - adding and deleting files to the directory+-- -----------------------------------------------------------------------------++-- | Add or update a new file to the directory. +addFileData :: StorageFileDirectory -> S.FileData -> StorageFileDirectory+addFileData dir new +  = Map.insert fn dat dir+    where+      fn = (S.fd_FileId new)+      dat = maybe new (S.updateFileData new) (Map.lookup fn dir)++-- | Delete a new file to the directory.+deleteFileData :: StorageFileDirectory -> S.FileId -> StorageFileDirectory+deleteFileData dir i = Map.delete i dir++-- | Lookup the metadata from the directory.+lookupFileData :: StorageFileDirectory -> S.FileId -> (Maybe S.FileData)+lookupFileData dir i = Map.lookup i dir++-- | Get all fileIds from the directory+getIds :: StorageFileDirectory -> [S.FileId]+getIds dir = Map.keys dir++-- | Check, if a fileId is a member of the storage+isMember :: StorageFileDirectory -> S.FileId -> Bool+isMember dir i = Map.member i dir++++-- -----------------------------------------------------------------------------+-- file storage operations and typeclass +-- -----------------------------------------------------------------------------++++-- | Create a new filestorage, which is empty an contains no files +newFileStorage +  :: FilePath           -- ^ the path of the filestorage on disk +  -> FilePath           -- ^ the name of the directory file+  -> FileStorage+newFileStorage path name +  = MkFileStorage path (path ++ name) Map.empty+++-- | Loads the filestorage from disk      +readDirectory :: FileStorage -> IO (FileStorage)+readDirectory stor+  = do+    handleAll (\_ -> writeDirectory stor) $+      bracket+        (do+         infoM localLogger ("opening filestorage directory: " ++ (fs_DirfilePath stor))+         openFile (fs_DirfilePath stor) ReadMode+        )+        (hClose)+        (\hdl -> +          do+          pkg <- liftM words $ hGetLine hdl+          raw <- B.hGet hdl (read $ head pkg)+          dir <- return (decode raw)+          return (stor {fs_Directory = dir})+        )+++-- | Saves the filestorage on disk  +writeDirectory :: FileStorage -> IO (FileStorage)+writeDirectory stor+  = do+    bracket +      (do+       infoM localLogger ("writing filestorage directory: " ++ (fs_DirfilePath stor))+       createDirectoryIfMissing True (fs_Path stor)+       openFile (fs_DirfilePath stor) WriteMode)+      (hClose) +      (\hdl ->+        do +        enc <- return (encode $ fs_Directory stor)+        hPutStrLn hdl ((show $ B.length enc) ++ " ")+        B.hPut hdl enc    +        return stor+      )+++-- | deriving FileStorage from the class Storage+instance S.Storage FileStorage where++  openStorage = readDirectory+++  closeStorage = writeDirectory+++  createFile stor fn c +    = do+      writeToBinFile path c+      -- case c of+      --  (S.TextFile t) -> writeToTextFile path t+      --  (S.ListFile l) -> writeToListFile path l+      --  (S.BinFile  b) -> writeToBinFile path b+      dat <- S.createFileData fn c+      writeDirectory $ stor {fs_Directory = newdir dat} +      where+        path = (fs_Path stor) ++ fn+        newdir d = addFileData (fs_Directory stor) d +++  deleteFile stor i+    = do+      stor' <- +        if isMember (fs_Directory stor) i+          then do +            removeFile path+            return (stor {fs_Directory = newdir})+          else+            return stor+      writeDirectory $ stor'+      where+        path = (fs_Path stor) ++ i+        newdir = deleteFileData (fs_Directory stor) i+++  appendFile stor i c+    = do+      if isMember (fs_Directory stor) i+        then do+          appendToBinFile path c+              -- case c of+              --  (S.TextFile t) -> appendToTextFile path t+              --  (S.ListFile l) -> appendToListFile path l+              --  (S.BinFile  b) -> appendToBinFile path b+          dat <- S.createFileData i c+          writeDirectory $ stor { fs_Directory = newdir dat }+        else do+          S.createFile stor i c      +      where+        path = (fs_Path stor) ++ i+        newdir d = addFileData (fs_Directory stor) d+++  containsFile stor i+    = do+      return (isMember (fs_Directory stor) i)++  +  getFileContent stor i+    = do+      infoM localLogger $ "getFileContent: reading " ++ show i+      if (isMember (fs_Directory stor) i) +        then do+          handleAll (\e -> do+              errorM localLogger $ "getFileContent: " ++ show e+              return Nothing+            ) $ +            do+            -- metaData <- S.getFileData stor i+            c <- readFromBinFile path+            {-+            c <- case (S.fd_Type $ fromJust metaData) of+              (S.FTText) -> +                 do+                 t <- readFromTextFile path+                 return $ S.TextFile t+              (S.FTList) ->+                 do+                 l <- readFromListFile path+                 return $ S.ListFile l+              (S.FTBin)  -> +                 do+                 b <- readFromBinFile path+                 return $ S.BinFile b+            -}+            debugM localLogger $ "getFileContent: content: " ++ show c+            return (Just c)+        else do return Nothing+      where+        path = (fs_Path stor) ++ i+++  getFileData stor i+    = do+      return (lookupFileData (fs_Directory stor) i)+++  getFileIds stor+    = do+      return (getIds (fs_Directory stor))
+ source/Holumbus/FileSystem/UserInterface.hs view
@@ -0,0 +1,202 @@+-- ----------------------------------------------------------------------------+{- |+  Module     : Holumbus.FileSystem.UserInterface +  Copyright  : Copyright (C) 2008 Stefan Schmidt+  License    : MIT++  Maintainer : Stefan Schmidt (stefanschmidt@web.de)+  Stability  : experimental+  Portability: portable+  Version    : 0.1++  A nice console-user interface for the Holumbus-Filesystem based on the+  Holumbus-Commandline-Interface. To get a standalone FileSystem-Site, just+  add a filesystem-object.++-}+-- ----------------------------------------------------------------------------++module Holumbus.FileSystem.UserInterface+    (+      -- * operations+      runUI+    )+where++import           Data.Binary+import           Data.List++import qualified Holumbus.Common.Debug                  as DEBUG+import           Holumbus.Common.Utils                  ( handleAll )++import qualified Holumbus.Console.Console               as Console+import qualified Holumbus.FileSystem.FileSystem         as FS+import qualified Holumbus.FileSystem.Storage            as S+++-- ----------------------------------------------------------------------------+-- Operations+-- ----------------------------------------------------------------------------++-- | runs the user interface... just add an fileSystem an a fancy version-number+runUI :: FS.FileSystem -> String -> IO ()+runUI fs version+  = do+    -- starts the console with the specified commands+    Console.handleUserInput (createConsole version) fs++++-- ----------------------------------------------------------------------------+-- private functions+-- ----------------------------------------------------------------------------+++createConsole :: String -> Console.ConsoleData (FS.FileSystem)+createConsole version =+  Console.addConsoleCommand "id"        getMySiteId     "get my siteId" $+  Console.addConsoleCommand "sites"     getFileSites    "get all sites with the given file name" $+  Console.addConsoleCommand "with"      getNearestNodePortWithFile      "gets the nearest node-port with a file (DEBUG)" $+  Console.addConsoleCommand "for"       getNearestNodePortForFile       "gets the nearest node-port for a (new) file (DEBUG)" $  +  Console.addConsoleCommand "contains"  containsFile    "is file in filesystem or not" $+  Console.addConsoleCommand "create"    createFile      "adds a file" $+  Console.addConsoleCommand "append"    append          "appends to a file" $+  Console.addConsoleCommand "delete"    deleteFile      "deletes a file" $+  Console.addConsoleCommand "content"   getFileContent  "gets the content of a file" $+  Console.addConsoleCommand "data"      getFileData     "gets the metadata of a file" $+  Console.addConsoleCommand "local"     isFileLocal     "test, if the file is on the local node" $+  Console.addConsoleCommand "debug"     printDebug      "prints internal state of the filesystem (DEBUG)" $ +  Console.addConsoleCommand "version"   (printVersion version)          "prints the version" $ +  Console.initializeConsole+  ++getFileNameAndContent :: [String] -> (S.FileId, S.FileContent)+getFileNameAndContent []   = error "no filename given"+getFileNameAndContent (x:xs) = (x, encode $ intercalate " " xs)+-- getFileNameAndContent (x:xs) = (x, S.TextFile $ intercalate " " xs)+++getFileNameAndContentSize :: [String] -> (S.FileId, Integer)+getFileNameAndContentSize []   = error "no filename given"+getFileNameAndContentSize (x1:[]) = (x1, 0)+getFileNameAndContentSize (x1:x2:_) = (x1, read x2)+++getMySiteId :: FS.FileSystem -> [String] -> IO ()+getMySiteId fs _+  = do+    handleAll (\e -> putStrLn $ show e) $+      do+      i <- FS.getMySiteId fs+      putStrLn $ show i+     ++getFileSites :: FS.FileSystem -> [String] -> IO ()+getFileSites fs opts+  = do+    handleAll (\e -> putStrLn $ show e) $+      do+      let (n, _) = getFileNameAndContent opts+      s <- FS.getFileSites n fs+      putStrLn $ show s+++getNearestNodePortWithFile :: FS.FileSystem -> [String] -> IO ()+getNearestNodePortWithFile fs opts+  = do+    handleAll (\e -> putStrLn $ show e) $+      do+      let (n, _) = getFileNameAndContent opts+      p <- FS.getNearestNodePortWithFile n fs+      putStrLn $ show p+++getNearestNodePortForFile :: FS.FileSystem -> [String] -> IO ()+getNearestNodePortForFile fs opts+  = do+    handleAll (\e -> putStrLn $ show e) $+      do+      let (n, s) = getFileNameAndContentSize opts+      p <- FS.getNearestNodePortForFile n s fs+      putStrLn $ show p+++containsFile :: FS.FileSystem -> [String] -> IO ()+containsFile fs opts +  = do+    handleAll (\e -> putStrLn $ show e) $+      do+      let (n, _) = getFileNameAndContent opts+      b <- FS.containsFile n fs+      putStrLn $ show b+++createFile :: FS.FileSystem -> [String] -> IO ()+createFile fs opts +  = do+    handleAll (\e -> putStrLn $ show e) $+      do+      let (n, c) = getFileNameAndContent opts+      FS.createFile n c fs +++append :: FS.FileSystem -> [String] -> IO ()+append fs opts+  = do+    handleAll (\e -> putStrLn $ show e) $+      do+      let (n, c) = getFileNameAndContent opts+      FS.appendFile n c fs+  ++deleteFile :: FS.FileSystem -> [String] -> IO ()+deleteFile fs opts+  = do+    handleAll (\e -> putStrLn $ show e) $+      do+      let (n, _) = getFileNameAndContent opts+      FS.deleteFile n fs+++getFileContent :: FS.FileSystem -> [String] -> IO ()+getFileContent fs opts+  = do+    handleAll (\e -> putStrLn $ show e) $+      do+      let (n, _) = getFileNameAndContent opts+      c <- FS.getFileContent n fs+      putStrLn $ show c+++getFileData :: FS.FileSystem -> [String] -> IO ()+getFileData fs opts+  = do+    handleAll (\e -> putStrLn $ show e) $+      do+      let (n, _) = getFileNameAndContent opts+      d <- FS.getFileData n fs+      putStrLn $ show d+      ++isFileLocal :: FS.FileSystem -> [String] -> IO ()+isFileLocal fs opts +  = do+    handleAll (\e -> putStrLn $ show e) $+      do+      let (n, _) = getFileNameAndContent opts+      b <- FS.isFileLocal n fs+      putStrLn $ show b+    +      +printDebug :: FS.FileSystem -> [String] -> IO ()+printDebug fs _+  = do+    handleAll (\e -> putStrLn $ show e) $+      do+      DEBUG.printDebug fs+  +  +printVersion :: String -> FS.FileSystem -> [String] -> IO ()+printVersion version _ _+  = do+    putStrLn version