hsbackup (empty) → 0.1

raw patch · 4 files changed

+132/−0 lines, 4 filesdep +basedep +bytestringdep +cmdargssetup-changed

Dependencies added: base, bytestring, cmdargs, directory, filepath, hashed-storage, old-locale, strict, time

Files

LICENSE +30/−0
Setup.hs +2/−0
hsbackup.cabal +31/−0
main.hs +69/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2010 Petr Rockai <me@mornfall.net>++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 Petr Rockai 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,2 @@+import Distribution.Simple+main = defaultMain

+ hsbackup.cabal view

@@ -0,0 +1,31 @@+name:                hsbackup+version:             0.1+synopsis:            simple utility for rolling filesystem backups+description:         Take backups of a directory and store them in a hashed format.+                     Currently only supports plain files and directories. Very crude+                     and limited, do NOT use in production. To be improved. Will break+                     backward compatibility in future versions.++-- The license under which the package is released.+-- copyright:+license:             BSD3+license-file:        LICENSE++-- The package author(s).+author:              Petr Rockai+maintainer:          me@mornfall.net+category:            System+build-type:          Simple++-- extra-source-files:++-- Constraint on the version of Cabal needed to build this package.+cabal-version:       >=1.6++Executable hsbackup+  main-is: main.hs+  -- other-modules:+  build-depends: base < 5, hashed-storage, cmdargs, strict,+                 bytestring, filepath, directory,+                 time, old-locale+

+ main.hs view

@@ -0,0 +1,69 @@+import Prelude hiding ( readFile )+import System.IO.Strict+import System.Console.CmdArgs+import qualified Config as C+import System.FilePath+import System.Directory++import Data.Time.Clock+import Data.Time.Format+import System.Locale++import Storage.Hashed.Plain+import Storage.Hashed.Darcs+import Storage.Hashed.Hash+import Storage.Hashed.Tree+import Storage.Hashed.AnchoredPath+import qualified Data.ByteString.Char8 as BSC++data Backup = Backup { root :: Hash+                     , date :: String+                     , path :: String }+              deriving Show++help = "A simple backup utility."++showtime = formatTime defaultTimeLocale "%F.%R"++readrepo = map (wibble . words) . lines+    where wibble [h, d, p] = Backup (decodeBase16 $ BSC.pack h) d p+          wibble x = error $ show x++repo path = getrepo path `catch` \_ -> makerepo path+listrepo r = putStr $ unlines . map line $ r+  where line (Backup h d p) = unwords [BSC.unpack $ encodeBase16 h, d, p]+listdir r h = do t <- expand =<< readDarcsHashed r (Nothing, h)+                 putStr $ unlines [ unwords [ BSC.unpack $ encodeBase16 $ itemHash i+                                            , anchorPath "" p ]+                                            | (p, i) <- list t ]++{- catpath r h p = do t <- expand =<< readDarcsHashed r (Nothing, h)+                   case findBlob t p of+                     Nothing -> fail $ showPath p ++ " does not exist." -}++writerepo r to = writeFile (to </> "list") (unlines $ map line r) >> return r+  where line (Backup r d p) = unwords [BSC.unpack $ encodeBase16 r, d, p]+makerepo path = writerepo [] path+getrepo path = readrepo `fmap` (readFile $ path </> "list")++make from to = do f <- darcsUpdateHashes =<< expand =<< readPlainTree from+                  hash <- writeDarcsHashed f to+                  dt <- getCurrentTime+                  path <- canonicalizePath from+                  r <- repo to+                  writerepo (r ++ [Backup hash (showtime dt) path]) to+                  putStrLn $ "new backup root: " ++ (BSC.unpack $ encodeBase16 hash)++restore repo to root = do createDirectory to+                          t <- expand =<< readDarcsHashed repo (Nothing, root)+                          writePlainTree t to++main = do cfg <- cmdArgs help C.conf+          print cfg+          case cfg of+            C.Take from to -> make from to+            C.List r "" -> listrepo =<< getrepo r+            C.List r h -> listdir r (decodeBase16 $ BSC.pack h)+            C.Restore r t "" -> do x <- last `fmap` repo r+                                   restore r t (root x)+            C.Restore r t h -> restore r t (decodeBase16 $ BSC.pack h)