diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,24 @@ +Copyright (c) 2012, Paul van der Walt and Sjoerd Timmer +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 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 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.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,6 @@ +module Main where + +import Distribution.Simple + +main = defaultMain + diff --git a/dotfs.cabal b/dotfs.cabal new file mode 100644 --- /dev/null +++ b/dotfs.cabal @@ -0,0 +1,61 @@ +name: dotfs +version: 0.1.1 +synopsis: Filesystem to manage and parse dotfiles +description: A system which, when pointed to a folder full of specially + annotated config files, will present these files tailored to + your current environment. Useful for making, for example, an if-block + in your mutt-config depending on your current location, which you + can retrieve via some shell command. +category: System +license: BSD3 +license-file: LICENSE +author: Sjoerd Timmer and Paul van der Walt +maintainer: Paul van der Walt +homepage: http://github.com/toothbrush/dotfs +build-depends: base, + test-framework >= 0.4.1, + test-framework-quickcheck2, + test-framework-hunit, + quickcheck >= 2.4 +build-type: Simple +cabal-version: >= 1.10 + +Test-Suite test-dotfs + type: exitcode-stdio-1.0 + build-depends: + base >= 4 && < 5, + HUnit >= 1.2 && < 2, + QuickCheck >= 2.4, + test-framework >= 0.4.1, + test-framework-quickcheck2, + test-framework-hunit, + containers, + transformers, + parsec >= 3, + haskell-src, + template-haskell + ghc-options: -Wall -rtsopts + hs-source-dirs: src, . + default-language: Haskell98 + main-is: Test/Main.hs + +Executable dotfs + default-language: Haskell98 + hs-source-dirs: src, . + ghc-options: -threaded + -- TODO: make this compile cleanly with -Wall + main-is: DotFS.hs + build-depends: bytestring >=0.9, + base >= 4 && < 5, + HFuse > 0.2.4, + directory>=1, + unix >= 2.3, + filepath >=1.1, + parsec, + containers, + transformers, + process + +source-repository head + type: git + location: https://toothbrush@github.com/toothbrush/dotfs.git diff --git a/src/DotFS.hs b/src/DotFS.hs new file mode 100644 --- /dev/null +++ b/src/DotFS.hs @@ -0,0 +1,100 @@ +{-# LANGUAGE Haskell98 #-} +module Main where + +import Util.Options +import Util.Sanity +import Core.FSActions +import Core.Datatypes +import Data.List + +import System.Console.GetOpt +import System.Environment +import System.IO +import System.Fuse +import Control.Monad + +{- + - TODO: we can fill in actualPath now. do we want to though? + -} + +{- TODO +* There's currently no real error checking whatsoever. +* Thread in logging +* Can I delete "dotfsVirtualPath"? +* need to add unit tests +-} + + +--------------------------------------------------------------------------------- +-- Parse arguments and main +--------------------------------------------------------------------------------- + +main :: IO () +main = do + (args, fuseargs) <- liftM (break (== "--")) getArgs -- send arguments after "--" to fusermount + let (actions, dirList, errors) = getOpt Permute options args + + -- Currently ignoring. Need to thread logging throughout + opts <- foldl (>>=) (return defaultOptions) actions + + (mp, dirs) <- validateDirs dirList + hPutStrLn stderr ("Mountpoint = \t "++mp) + hPutStrLn stderr (" Conf = \t "++show dirs) + case script opts of + True -> hPutStrLn stdout (printScript mp dirs) + False -> return () + withArgs (mp:fuseargs) $ fuseMain (dotFSOps opts mp dirs) defaultExceptionHandler + + +printScript :: FilePath -> Conf -> String +printScript mountpoint (C confdir) = concat (intersperse "\n" + [ "#!/bin/bash" + , "#" + , "# The idea here is to make symlinks to all the files in " + , "# the mounted conf directory, inside the user's home (~)" + , "#" + , "# Should only need to be run once." + , "# Will not overwrite files or directories, but will update" + , "# symlinks, if found." + , "#" + , "# (c) Paul van der Walt, April 2012" + , "" + , "home=$HOME" + , "confdir=\"" ++ confdir ++ "\"" + , "" + , "mountpoint=\"" ++ mountpoint ++ "\"" + , "" + , "for i in $(ls -a $confdir) ;" + , "do" + , " # skip the breadcrumbs" + , " # skip .git too, since it makes shit way slow" + , " if [ \"$i\" = \".\" ] || [ \"$i\" = \"..\" ] || [ \"$i\" = \".git\" ] || [ \"${i##*.}\" = \"dontlink\" ]; " + , " then " + , " continue" + , " fi" + , " # here we should make symlinks, only if the source" + , " # doesn't yet exist" + , " newsource=\"$home/$(basename $i)\"" + , " # note that preserving the tree structure here" + , " # happens automatically, since `ls` only goes 1 deep." + , " target=\"$mountpoint/$i\"" + , " target_orig=\"$confdir/$i\"" + , " if [ -L \"$newsource\" ] ; # -L <=> exists and is symlink" + , " then" + , " # rm old link" + , " echo rm -v \"$newsource\"" + , " fi" + , " # you would think it's now enough to let ln try to make" + , " # a symlink, since it'll fail if the newsource exists, but" + , " # in the case of directories, it thinks the newsource is" + , " # WHERE you'd like the link, i.e. you get stuff like:" + , " # `~/.somefolder/.somefolder` -> `mountpoint/.somefolder`" + , " echo \"if [ ! -e \"$newsource\" ] ; then # -e <=> file exists\"" + , " echo \" if [ -e \"$target_orig.dontlink\" ] ; then\"" + , " echo \" ln -s -v \"$target_orig\" \"$newsource\"\"" + , " echo \" else\"" + , " echo \" ln -s -v \"$target\" \"$newsource\"\"" + , " echo \" fi\"" + , " echo \"fi\"" + , "done" + ]) diff --git a/src/Test/Main.hs b/src/Test/Main.hs new file mode 100644 --- /dev/null +++ b/src/Test/Main.hs @@ -0,0 +1,6 @@ +module Main where + +import Test.Unit + +main :: IO () +main = runTests