funion (empty) → 0.0.1

raw patch · 4 files changed

+256/−0 lines, 4 filesdep +HFusedep +basedep +bytestringsetup-changed

Dependencies added: HFuse, base, bytestring, directory, filepath, haskell98, unix

Files

Funion.hs +211/−0
LICENSE +25/−0
Setup.lhs +3/−0
funion.cabal +17/−0

+ Funion.hs view

@@ -0,0 +1,211 @@+module Main where++import qualified Data.ByteString.Char8 as B+import System.Posix.Types+import System.Posix.Files+import System.FilePath.Posix+import System.Posix.IO+import System.Directory+import System.Fuse+import System.IO+import System(getArgs)+import System.Environment(withArgs)+import Control.Monad+import Data.Maybe+import Data.List (nubBy)+import Data.ByteString.Char8 (pack)++{-+OPEN QUESTIONS:+For now, I suppose that I could just specify the directories that I want to union on the command line.+What about making this more aggressive and having some way of specifying unioning rules?  Perhaps+via a DSL?++How should I present SymLinks?  +-}++{- TODO(nathan)+* CHANGE ARGUMENTS TO PROGRAM +  Change it so that all arguments are assumed to be 'mine' unless somehow+  otherwise noted.  Possibly with "--" ++* There's currently no real error checking whatsoever.+* Add funionWrite+-}++data FunionFS = FunionFS {+    funionEntryName     :: FilePath+  , funionActualPath    :: FilePath+  , funionVirtualPath   :: FilePath+  , funionFileStat      :: FileStat+  , funionContents      :: [FunionFS]+  }+ deriving Show+++dirContents :: FilePath -> IO [FilePath]+dirContents = fmap (filter (`notElem` [".",".."])) . getDirectoryContents+++fileExists, dirExists :: FilePath -> FilePath -> IO Bool+fileExists path name = doesFileExist $ path </> name+dirExists  path name = doesDirectoryExist $ path </> name+++getFileStats, getDirStats :: FilePath-> FilePath -> IO FunionFS+getFileStats path name = getStats RegularFile (path </> name)+getDirStats path name = getStats Directory (path </> name)+++getStats :: EntryType -> FilePath -> IO FunionFS+getStats entrytype uri = do+  status <- getFileStatus uri+  return FunionFS {+      funionEntryName   = takeFileName uri+    , funionActualPath  = uri+    , funionVirtualPath = ""+    , funionFileStat    = FileStat { statEntryType = entrytype+        , statFileMode  = fileMode status+        , statLinkCount = linkCount status+        , statFileOwner = fileOwner status+        , statFileGroup = fileGroup status+        , statSpecialDeviceID = specialDeviceID status+        , statFileSize  = fileSize status+        , statBlocks    = 1            -- This is WRONG.  Change+        , statAccessTime= accessTime status+        , statModificationTime = modificationTime status+        , statStatusChangeTime = statusChangeTime status+      }+     , funionContents = []+  }+++readDir :: FilePath -> IO (FunionFS)+readDir uri = do+  contents <- dirContents uri+  files <- filterM (fileExists uri) contents+  fileList <- mapM (getFileStats uri) files+  -- list of directories+  dirs <- filterM (dirExists uri) contents+  dirList <- mapM (getDirStats uri) dirs++  return FunionFS {+      funionEntryName   = takeFileName uri+    , funionActualPath  = ""+    , funionVirtualPath = uri+    , funionFileStat    = dirStat+    , funionContents    = fileList ++ dirList+  }++funionLookUp :: [FilePath] -> FilePath -> IO (Maybe FunionFS)+funionLookUp dirsToUnion path = do+  dirs  <- filterM (`dirExists` path) dirsToUnion+  dirList <- mapM (readDir.(</> path)) dirs+  files <- filterM (`fileExists` path) dirsToUnion+  fileStats <- mapM (`getFileStats` path) files+  let contents = map funionContents dirList+  case dirs of+    []        -> if length fileStats > 0 then return $ Just $ head fileStats else return Nothing+    otherwise -> return $ if length fileStats > 0 then Just $ head fileStats else Just FunionFS {+            funionEntryName   = takeFileName path+          , funionActualPath  = ""+          , funionVirtualPath = path+          , funionFileStat    = dirStat+          , funionContents    = nubBy (\x y -> (funionEntryName x) == (funionEntryName y))  $ concat contents+        }+++funionFSOps :: [FilePath] -> FuseOperations Fd+funionFSOps dir =+  defaultFuseOps{ fuseGetFileStat        = funionGetFileStat dir+                , fuseOpen               = funionOpen dir+                , fuseFlush              = funionFlush dir+                , fuseRead               = funionRead dir+                , fuseOpenDirectory      = funionOpenDirectory dir+                , fuseReadDirectory      = funionReadDirectory dir+                , fuseGetFileSystemStats = funionGetFileSystemStats dir+                }+++funionGetFileStat :: [FilePath] -> FilePath -> IO (Either Errno FileStat)+funionGetFileStat dirsToUnion (_:dir) = do+    (Just file) <- funionLookUp dirsToUnion dir+    return $ Right $ funionFileStat file+++funionOpen :: [FilePath] -> FilePath -> OpenMode -> OpenFileFlags -> IO (Either Errno Fd)+funionOpen dirsToUnion (_:path) mode flags = do+  file <- funionLookUp dirsToUnion path+  case file of+    Just f -> do+            fd <- openFd (funionActualPath f) ReadOnly Nothing defaultFileFlags+            return (Right fd)+    Nothing -> return (Left eNOENT)++-- What if 'fd' is no good?  What will happen?+funionFlush :: [FilePath] -> FilePath -> Fd -> IO Errno+funionFlush _ _ fd = do closeFd fd; return eOK+++funionOpenDirectory :: [FilePath] -> FilePath -> IO Errno+funionOpenDirectory dirsToUnion (_:path) = do+  extantDirs <- filterM (`dirExists` path) dirsToUnion+  return $ if length extantDirs > 0 then eOK else eNOENT+++funionGetFileSystemStats :: [FilePath]->String -> IO (Either Errno FileSystemStats)+funionGetFileSystemStats fileTree  str =+  return $ Right FileSystemStats+    { fsStatBlockSize  = 512+    , fsStatBlockCount = 1+    , fsStatBlocksFree = 1+    , fsStatBlocksAvailable = 1+    , fsStatFileCount  = 5      -- IS THIS CORRECT?+    , fsStatFilesFree  = 10     -- WHAT IS THIS?+    , fsStatMaxNameLength = 255 -- SEEMS SMALL?+    }+++funionReadDirectory :: [FilePath] ->FilePath -> IO (Either Errno [(FilePath, FileStat)])+funionReadDirectory dirsToUnion (_:dir) = do+  entry <- funionLookUp dirsToUnion dir+  let contents = funionContents $ fromJust entry+  let dirContents = map (\x -> (funionEntryName x :: String , funionFileStat x)) contents+  return $ Right $ [ (".", dirStat), ("..", dirStat)] ++ dirContents+++funionRead  :: [FilePath] -> FilePath -> Fd -> ByteCount -> FileOffset -> IO (Either Errno B.ByteString)+funionRead dirsToUnion (_:path) fd byteCount offset = do+  (Just file) <- funionLookUp dirsToUnion path+  fdSeek fd AbsoluteSeek offset+  (bytes, num) <- fdRead fd  byteCount+  return $ Right $ pack bytes+++dirStat = FileStat { statEntryType = Directory+  , statFileMode = foldr1 unionFileModes+                     [ ownerReadMode+                     , ownerExecuteMode+                     , groupReadMode+                     , groupExecuteMode+                     , otherReadMode+                     , otherExecuteMode+                     ]+  , statLinkCount = 5+  , statFileOwner = 1000+  , statFileGroup = 1000+  , statSpecialDeviceID = 0+  , statFileSize  = 4096+  , statBlocks    = 1+  , statAccessTime= 0+  , statModificationTime = 0+  , statStatusChangeTime = 0+  }+++main :: IO ()+main = do+  args <- getArgs+  let args' = map tail $ filter (\(x:xs) ->  x == '+') args+  let args2 = filter(\(x:xs) -> x /= '+') args+  withArgs args2 $ fuseMain (funionFSOps args')  defaultExceptionHandler

+ LICENSE view

@@ -0,0 +1,25 @@+Copyright (c) 2010, Nathan M. Wiegand+All rights reserved.++Redistribution and use in source and binary forms, with or without modification,+are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright notice,+    * this list of conditions and the following disclaimer.+    * Redistributions in binary form must reproduce the above copyright notice,+    * this list of conditions and the following disclaimer in the documentation+    * and/or other materials provided with the distribution.+    * Neither the name of the author nor the names of its contributors+    * may be used to endorse or promote products derived from this software+    * without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON+ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ Setup.lhs view

@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain

+ funion.cabal view

@@ -0,0 +1,17 @@+name:                funion+version:             0.0.1+synopsis:            A unioning file-system using HFuse +description:         A unioning file-system using HFuse+category:            System+license:             BSD3+license-file:        LICENSE+author:              Nathan Wiegand+maintainer:          nathanwiegand@gmail.com+homepage:            http://github.com/nathanwiegand/funion+build-depends:       base+build-type:          Simple++executable:          funion+main-is:             Funion.hs+ghc-options:         -threaded+build-depends:       base >= 3 && <= 4, HFuse >= 0.2.1, bytestring >=0.9, haskell98, directory >= 1, unix >= 2.3, filepath >= 1.1