diff --git a/Funion.hs b/Funion.hs new file mode 100644 --- /dev/null +++ b/Funion.hs @@ -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 diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,3 @@ +#!/usr/bin/env runhaskell +> import Distribution.Simple +> main = defaultMain diff --git a/funion.cabal b/funion.cabal new file mode 100644 --- /dev/null +++ b/funion.cabal @@ -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