multiplicity (empty) → 0.1.0
raw patch · 9 files changed
+465/−0 lines, 9 filesdep +basedep +containersdep +fez-confsetup-changed
Dependencies added: base, containers, fez-conf, mtl, process
Files
- LICENSE +31/−0
- Setup.hs +25/−0
- TODO +3/−0
- conf/example.mult-conf +51/−0
- multiplicity.cabal +24/−0
- src/Multiplicity/Common.hs +15/−0
- src/Multiplicity/Docs.hs +64/−0
- src/main.hs +184/−0
- util/prefs/boring +68/−0
+ LICENSE view
@@ -0,0 +1,31 @@+Copyright Dino Morelli 2009++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 Dino Morelli nor the names of other+ 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+OWNER 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.hs view
@@ -0,0 +1,25 @@+#! /usr/bin/env runhaskell++-- Copyright: 2009 Dino Morelli+-- License: BSD3 (see LICENSE)+-- Author: Dino Morelli <dino@ui3.info>++import Control.Monad ( unless )+import Distribution.Simple+import System.FilePath+import System.Posix.Files ( createSymbolicLink, fileExist )+++main = defaultMainWithHooks (simpleUserHooks + { postBuild = customPostBuild+ } )+ where+ -- Create symlink to the binary after build for developer + -- convenience+ customPostBuild _ _ _ _ = do+ let dest = "multiplicity"++ exists <- fileExist dest+ unless exists $ do+ let src = "dist" </> "build" </> dest </> dest+ createSymbolicLink src dest
+ TODO view
@@ -0,0 +1,3 @@+- Even though duplicity doesn't support it (in 4.12.x), can we do something like a --dry-run ? I know it won't do much beyond showing the cli that would go to duplicity. But hey, it would be something.++- Add support for Amazon S3, if necessary
+ conf/example.mult-conf view
@@ -0,0 +1,51 @@+# This is an example conf file for multiplicity+# You will pass the path to a conf file like this as the first argument+# to multiplicity. If you're doing full system backups as root, I+# suggest storing this somewhere like /etc/mult/ or similar.++# See documentation for duplicity for info on the switches here.+++# common-args: All common args we need to pass straight though to +# duplicity++# This could include things like:+# common-args=--encrypt-key ABCDEF12 --sign-key ABCDEF12 --ssh-options -oIdentityFile=/home/someuser/.ssh/somesshkeyfile++# Any other args for duplicity not related to filtering, src/dest +# paths or the passphrase should go in common-args++common-args=--encrypt-key ABCDEF12+++# passphrase: Passphrase for your signing and encryption private key.++# Note: Even if you do use different key pairs for signing and +# encryption, duplicity can't handle more than one passphrase at the +# time this was written.++passphrase=foo bar baz+++# filters, src-dir: These describe the (probably local) data to be +# backed up++# The filters could also refer to another file:+# filters=--include-globbing-filelist /full/path/to/filelist++# This is often saner than trying to pack complicated instructions+# into --include/--exclude args++# See duplicity's documentation for the format of these things++filters=--include /var/log/foo --exclude /var/log+src-dir=/var/log+++# target-url: Remote location for backup++# This can also be a local dir, like:+# target-url=file:///local/dir/containing/this/backup/set+# Again, see duplicity documentation++target-url=scp://user@remotesystem//dir/containing/this/backup/set
+ multiplicity.cabal view
@@ -0,0 +1,24 @@+name: multiplicity+version: 0.1.0+cabal-version: >= 1.2+build-type: Simple+synopsis: Wrapper program for duplicity, adding config files+description: Multiplicity is a configuration file driven wrapper + around duplicity. It allows you to easily define + backup sets as config files and avoid long, + repetitive command lines.+homepage: http://ui3.info/d/proj/multiplicity.html+category: Backup+license: BSD3+license-file: LICENSE+author: Dino Morelli +maintainer: Dino Morelli <dino@ui3.info>+stability: experimental+tested-with: GHC>=6.10.1+data-files: conf/example.mult-conf++executable multiplicity+ main-is: main.hs+ hs-source-dirs: src+ build-depends: base, containers, fez-conf, mtl, process+ ghc-options: -Wall
+ src/Multiplicity/Common.hs view
@@ -0,0 +1,15 @@+-- Copyright: 2009 Dino Morelli+-- License: BSD3 (see LICENSE)+-- Author: Dino Morelli <dino@ui3.info>++module Multiplicity.Common+ ( ecTerminated+ )+ where++import System.Exit ( ExitCode (..) )+++-- Exit code for when this program terminates abnormally+ecTerminated :: ExitCode+ecTerminated = ExitFailure 126
+ src/Multiplicity/Docs.hs view
@@ -0,0 +1,64 @@+-- Copyright: 2009 Dino Morelli+-- License: BSD3 (see LICENSE)+-- Author: Dino Morelli <dino@ui3.info>++module Multiplicity.Docs+ ( usage+ , sampleConfig+ )+ where++import System.Exit ( exitWith )++import Multiplicity.Common ( ecTerminated )+import Paths_multiplicity+++{- Show usage to user and get out of here.+-}+usage :: IO ()+usage = do+ putStr $ unlines+ [ "Wrapper program for duplicity, adding config files"+ , ""+ , "Usage:"+ , " multiplicity CONFPATH [ACTION] [ARGS for duplicity]"+ , " multiplicity --sample-config"+ , ""+ , "Options:"+ , " CONFPATH Path to a multiplicity config file"+ , " ACTION duplicity action to perform"+ , " (defaults to full or incr as necessary)"+ , " ARGS Additional arguments for duplicity"+ , " --sample-config Print a sample config file to stdout"+ , ""+ , "Multiplicity is a configuration file driven wrapper around duplicity. It allows you to easily define backup sets as config files and avoid long, repetitive command lines."+ , ""+ , "Commands like this:"+ , ""+ , " $ PASSPHRASE=\"foo bar baz\" duplicity --ssh-options -oIdentityFile=/home/foo/.ssh/bar --encrypt-key ABCDEF12 --include /var/log/baz --exclude /var/log --verbosity 5 full /var/log scp://foo@florb//var/remote/backup/location"+ , ""+ , "Turn into this, with multiplicity:"+ , ""+ , " $ multiplicity yourbackup.conf full --verbosity 5"+ , ""+ , "Easy!"+ , ""+ , "For more information see the man page for duplicity, which you will need to have installed on your system in addition to multiplicity."+ , "And make sure you read the sample config file (use --sample-config), it's heavily documented."+ , ""+ , "Version 0.1.0 2009-Feb-05 Dino Morelli <dino@ui3.info>"+ , "http://ui3.info/d/proj/multiplicity.html"+ ]++ exitWith ecTerminated+++{- Show sample config to user and get out of here.+-}+sampleConfig :: IO ()+sampleConfig = do+ confPath <- getDataFileName "conf/example.mult-conf"+ putStr =<< readFile confPath++ exitWith ecTerminated
+ src/main.hs view
@@ -0,0 +1,184 @@+-- Copyright: 2009 Dino Morelli+-- License: BSD3 (see LICENSE)+-- Author: Dino Morelli <dino@ui3.info>++{-# LANGUAGE FlexibleContexts #-}++import Control.Monad.Error+import Control.Monad.Reader+import Data.List ( intercalate, isPrefixOf )+import Data.Map hiding ( map, null )+import Fez.Data.Conf ( ConfMap, parseToMap )+import Prelude hiding ( lookup )+import System.Environment ( getArgs )+import System.Exit ( ExitCode (..), exitWith )+import System.IO ( BufferMode (..), hSetBuffering, stdout )+import System.Process ( runCommand, waitForProcess )+import Text.Printf++import Multiplicity.Common ( ecTerminated )+import Multiplicity.Docs ( usage, sampleConfig )+++-- Data type to hold environment for Reader monad+data Env = Env+ { config :: ConfMap+ , rawArgs :: [String]+ }+++{- Custom monad stack for this application:+ ErrorT wrapped around Reader+-}++type Mult a = ErrorT String (Reader Env) a++runMult :: ErrorT e (Reader r) a -> r -> Either e a+runMult ev env = runReader (runErrorT ev) env+++-- Type to carry results of parseArgs action+type ParseResult = (String, String)+++{- Lookup in the config (which is a Map String String) as an+ (ErrorT String) action with meaningful error message.+-}+lookupE :: (MonadError String m) => String -> ConfMap -> m String+lookupE key mp = maybe (throwError $ "Key " ++ key ++ " not found")+ return $ lookup key mp+++{- parseArgs transforms the config file plus passed args into the proper+ list of args for duplicity. Not as easy as it sounds, these arg+ lists are dependent on the duplicity action to be taken++ The real work of this program is all in here.+-}++parseArgs :: String -> Mult ParseResult++parseArgs "full" = parseType1+parseArgs "incremental" = parseType1+parseArgs "incr" = parseType1+ -- duplicity accepts this abbreviation+parseArgs "" = parseType1++parseArgs "restore" = parseType2+parseArgs "verify" = parseType2++parseArgs "collection-status" = parseType3+parseArgs "list-current-files" = parseType3+parseArgs "cleanup" = parseType3+parseArgs "remove-older-than" = parseType3+parseArgs "remove-all-but-n-full" = parseType3++-- Anything else is crazy and unexpected, throw an error+parseArgs action = throwError $ "Unknown action: " ++ action+++parseType1 :: Mult ParseResult+parseType1 = do+ args <- liftM (intercalate " ") $ asks rawArgs+ conf <- asks config++ pw <- lookupE "passphrase" conf+ cs <- lookupE "common-args" conf+ filters <- lookupE "filters" conf+ srcDir <- lookupE "src-dir" conf+ targetUrl <- lookupE "target-url" conf++ return ( pw+ , printf "%s %s %s %s %s" cs args filters srcDir targetUrl )+++parseType2 :: Mult ParseResult+parseType2 = do+ arglist <- asks rawArgs+ conf <- asks config++ pw <- lookupE "passphrase" conf+ cs <- lookupE "common-args" conf+ srcUrl <- lookupE "target-url" conf+ let args = intercalate " " $ init arglist+ let targetDir = last arglist++ return ( pw+ , printf "%s %s %s %s" cs args srcUrl targetDir )+++parseType3 :: Mult ParseResult+parseType3 = do+ args <- liftM (intercalate " ") $ asks rawArgs+ conf <- asks config++ pw <- lookupE "passphrase" conf+ cs <- lookupE "common-args" conf+ targetUrl <- lookupE "target-url" conf++ return ( pw+ , printf "%s %s %s" args cs targetUrl )+++{- These two functions are the handlers for failure and success of + parseArgs+-}++endBadly :: String -> IO ExitCode+endBadly err = do+ putStrLn err+ return ecTerminated+++invokeDuplicity :: String -> ParseResult -> IO ExitCode+invokeDuplicity action (pw, args) = do+ let displayCommand = buildCmdString "**HIDDEN**" action args + let realCommand = buildCmdString pw action args++ hSetBuffering stdout NoBuffering++ printf "\nCommand used to invoke duplicity:\n%s\n\n"+ (displayCommand :: String)++ waitForProcess =<< runCommand realCommand++ where+ buildCmdString = printf "PASSPHRASE=\"%s\" duplicity %s %s"+++{- Make sense of the varied shapes of command-line we accept,+ parse it into conf path, action and duplicity arg list.+ Or fail with Nothing+-}+parseCommandLine :: [String] -> Maybe (String, String, [String])+parseCommandLine (confPath:[])+ | "--" `isPrefixOf` confPath = Nothing+parseCommandLine (confPath:[]) = Just (confPath, "", [])+parseCommandLine (confPath:everythingElse)+ | beginsWithSwitch everythingElse =+ Just (confPath, "", everythingElse)+ where+ beginsWithSwitch (first:_) = "--" `isPrefixOf` first+ beginsWithSwitch _ = False+parseCommandLine (confPath:action:switches) =+ Just (confPath, action, switches)+parseCommandLine _ = Nothing+++main :: IO ()+main = do+ allArgs <- getArgs++ -- Special case where user asked for sample config+ when ("--sample-config" `elem` allArgs) sampleConfig++ case (parseCommandLine allArgs) of+ Nothing -> usage+ Just (confPath, action, rest) -> do+ conf <- liftM parseToMap $ readFile confPath++ -- Transform those raw args into complete args, or figure + -- out why we can't.+ let parseResult = runMult (parseArgs action) (Env conf rest)++ exitWith =<< either endBadly (invokeDuplicity action) parseResult
+ util/prefs/boring view
@@ -0,0 +1,68 @@+# Boring file regexps:+\.hi$+\.hi-boot$+\.o-boot$+\.o$+\.o\.cmd$+\.p_hi$+\.p_o$+\.installed-pkg-config+\.setup-config+\.setup-config^dist(/|$)+# *.ko files aren't boring by default because they might+# be Korean translations rather than kernel modules.+# \.ko$+\.ko\.cmd$+\.mod\.c$+(^|/)\.tmp_versions($|/)+(^|/)CVS($|/)+\.cvsignore$+^\.#+(^|/)RCS($|/)+,v$+(^|/)\.svn($|/)+(^|/)\.hg($|/)+(^|/)\.git($|/)+\.bzr$+(^|/)SCCS($|/)+~$+(^|/)_darcs($|/)+(^|/)\.darcsrepo($|/)+\.BAK$+\.orig$+\.rej$+(^|/)vssver\.scc$+\.swp$+(^|/)MT($|/)+(^|/)\{arch\}($|/)+(^|/).arch-ids($|/)+(^|/),+\.prof$+(^|/)\.DS_Store$+(^|/)BitKeeper($|/)+(^|/)ChangeSet($|/)+\.py[co]$+\.elc$+\.class$+\.zwc$+\.revdep-rebuild.*+\..serverauth.*+\#+(^|/)Thumbs\.db$+(^|/)autom4te\.cache($|/)+(^|/)config\.(log|status)$+^\.depend$+(^|/)(tags|TAGS)$+#(^|/)\.[^/]+(^|/|\.)core$+\.(obj|a|exe|so|lo|la)$+^\.darcs-temp-mail$+-darcs-backup[[:digit:]]+$+\.(fas|fasl|sparcf|x86f)$+\.part$+(^|/)\.waf-[[:digit:].]+-[[:digit:]]+($|/)+(^|/)\.lock-wscript$+^\.darcs-temp-mail$+\_vti_cnf$+\_vti_pvt$+(^|/)dist($|/)