diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,25 @@ +#! /usr/bin/env runhaskell + +-- Copyright: 2009 Dino Morelli +-- License: BSD3 (see LICENSE) +-- Author: Dino Morelli + +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 diff --git a/TODO b/TODO new file mode 100644 --- /dev/null +++ b/TODO @@ -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 diff --git a/conf/example.mult-conf b/conf/example.mult-conf new file mode 100644 --- /dev/null +++ b/conf/example.mult-conf @@ -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 diff --git a/multiplicity.cabal b/multiplicity.cabal new file mode 100644 --- /dev/null +++ b/multiplicity.cabal @@ -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 +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 diff --git a/src/Multiplicity/Common.hs b/src/Multiplicity/Common.hs new file mode 100644 --- /dev/null +++ b/src/Multiplicity/Common.hs @@ -0,0 +1,15 @@ +-- Copyright: 2009 Dino Morelli +-- License: BSD3 (see LICENSE) +-- Author: Dino Morelli + +module Multiplicity.Common + ( ecTerminated + ) + where + +import System.Exit ( ExitCode (..) ) + + +-- Exit code for when this program terminates abnormally +ecTerminated :: ExitCode +ecTerminated = ExitFailure 126 diff --git a/src/Multiplicity/Docs.hs b/src/Multiplicity/Docs.hs new file mode 100644 --- /dev/null +++ b/src/Multiplicity/Docs.hs @@ -0,0 +1,64 @@ +-- Copyright: 2009 Dino Morelli +-- License: BSD3 (see LICENSE) +-- Author: Dino Morelli + +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 " + , "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 diff --git a/src/main.hs b/src/main.hs new file mode 100644 --- /dev/null +++ b/src/main.hs @@ -0,0 +1,184 @@ +-- Copyright: 2009 Dino Morelli +-- License: BSD3 (see LICENSE) +-- Author: Dino Morelli + +{-# 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 diff --git a/util/prefs/boring b/util/prefs/boring new file mode 100644 --- /dev/null +++ b/util/prefs/boring @@ -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($|/)