diff --git a/Examples/FileSystem/ClientMain.hs b/Examples/FileSystem/ClientMain.hs new file mode 100644 --- /dev/null +++ b/Examples/FileSystem/ClientMain.hs @@ -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 diff --git a/Examples/FileSystem/ControllerMain.hs b/Examples/FileSystem/ControllerMain.hs new file mode 100644 --- /dev/null +++ b/Examples/FileSystem/ControllerMain.hs @@ -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 + +-- ---------------------------------------------------------------------------- diff --git a/Examples/FileSystem/Makefile b/Examples/FileSystem/Makefile new file mode 100644 --- /dev/null +++ b/Examples/FileSystem/Makefile @@ -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) diff --git a/Examples/FileSystem/NodeMain.hs b/Examples/FileSystem/NodeMain.hs new file mode 100644 --- /dev/null +++ b/Examples/FileSystem/NodeMain.hs @@ -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 + +-- ---------------------------------------------------------------------------- diff --git a/Examples/Makefile b/Examples/Makefile new file mode 100644 --- /dev/null +++ b/Examples/Makefile @@ -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 $@ ;) diff --git a/Examples/Utils/Filehandling/FileHandlingTest.hs b/Examples/Utils/Filehandling/FileHandlingTest.hs new file mode 100644 --- /dev/null +++ b/Examples/Utils/Filehandling/FileHandlingTest.hs @@ -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 + diff --git a/Examples/Utils/Filehandling/Makefile b/Examples/Utils/Filehandling/Makefile new file mode 100644 --- /dev/null +++ b/Examples/Utils/Filehandling/Makefile @@ -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 + diff --git a/Holumbus-Storage.cabal b/Holumbus-Storage.cabal new file mode 100644 --- /dev/null +++ b/Holumbus-Storage.cabal @@ -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 +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 diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/Makefile b/Makefile new file mode 100644 --- /dev/null +++ b/Makefile @@ -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 + diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -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 diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/source/Holumbus/FileSystem/Controller.hs b/source/Holumbus/FileSystem/Controller.hs new file mode 100644 --- /dev/null +++ b/source/Holumbus/FileSystem/Controller.hs @@ -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 () diff --git a/source/Holumbus/FileSystem/Controller/ControllerData.hs b/source/Holumbus/FileSystem/Controller/ControllerData.hs new file mode 100644 --- /dev/null +++ b/source/Holumbus/FileSystem/Controller/ControllerData.hs @@ -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) + diff --git a/source/Holumbus/FileSystem/Controller/ControllerPort.hs b/source/Holumbus/FileSystem/Controller/ControllerPort.hs new file mode 100644 --- /dev/null +++ b/source/Holumbus/FileSystem/Controller/ControllerPort.hs @@ -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 diff --git a/source/Holumbus/FileSystem/FileSystem.hs b/source/Holumbus/FileSystem/FileSystem.hs new file mode 100644 --- /dev/null +++ b/source/Holumbus/FileSystem/FileSystem.hs @@ -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 "--------------------------------------------------------" diff --git a/source/Holumbus/FileSystem/Messages.hs b/source/Holumbus/FileSystem/Messages.hs new file mode 100644 --- /dev/null +++ b/source/Holumbus/FileSystem/Messages.hs @@ -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) diff --git a/source/Holumbus/FileSystem/Node.hs b/source/Holumbus/FileSystem/Node.hs new file mode 100644 --- /dev/null +++ b/source/Holumbus/FileSystem/Node.hs @@ -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] diff --git a/source/Holumbus/FileSystem/Node/NodeData.hs b/source/Holumbus/FileSystem/Node/NodeData.hs new file mode 100644 --- /dev/null +++ b/source/Holumbus/FileSystem/Node/NodeData.hs @@ -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 diff --git a/source/Holumbus/FileSystem/Node/NodePort.hs b/source/Holumbus/FileSystem/Node/NodePort.hs new file mode 100644 --- /dev/null +++ b/source/Holumbus/FileSystem/Node/NodePort.hs @@ -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 diff --git a/source/Holumbus/FileSystem/Storage.hs b/source/Holumbus/FileSystem/Storage.hs new file mode 100644 --- /dev/null +++ b/source/Holumbus/FileSystem/Storage.hs @@ -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] diff --git a/source/Holumbus/FileSystem/Storage/FileStorage.hs b/source/Holumbus/FileSystem/Storage/FileStorage.hs new file mode 100644 --- /dev/null +++ b/source/Holumbus/FileSystem/Storage/FileStorage.hs @@ -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)) diff --git a/source/Holumbus/FileSystem/UserInterface.hs b/source/Holumbus/FileSystem/UserInterface.hs new file mode 100644 --- /dev/null +++ b/source/Holumbus/FileSystem/UserInterface.hs @@ -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