factor out common imports
no code changes
This commit is contained in:
parent
003a604a6e
commit
8ef2095fa0
83 changed files with 264 additions and 619 deletions
Annex.hsAnnexCommon.hsAnnexQueue.hsBackend.hs
Backend
Branch.hsCatFile.hsCmdLine.hsCommand.hsCommand
Add.hsAddUrl.hsConfigList.hsDescribe.hsDrop.hsDropKey.hsDropUnused.hsFind.hsFix.hsFromKey.hsFsck.hsGet.hsInAnnex.hsInit.hsInitRemote.hsLock.hsMap.hsMerge.hsMigrate.hsMove.hsRecvKey.hsSemitrust.hsSendKey.hsSetKey.hsStatus.hsTrust.hsUnannex.hsUninit.hsUnlock.hsUntrust.hsUnused.hsUpgrade.hsVersion.hsWhereis.hs
Common.hsConfig.hsContent.hsCrypto.hsGit.hsGitAnnex.hsInit.hsLimit.hsLocationLog.hsLocations.hsMessages.hsOptions.hsPresenceLog.hsRemote.hsRemote
RemoteLog.hsTrust.hsTypes
UUID.hsUpgrade.hsUpgrade
Utility.hsUtility
Version.hsgit-annex-shell.hsgit-annex.cabalgit-union-merge.hstest.hs
6
Annex.hs
6
Annex.hs
|
@ -19,10 +19,10 @@ module Annex (
|
||||||
gitRepo
|
gitRepo
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.State
|
|
||||||
import Control.Monad.IO.Control
|
import Control.Monad.IO.Control
|
||||||
import Control.Applicative hiding (empty)
|
import Control.Monad.State
|
||||||
|
|
||||||
|
import Common
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import Git.CatFile
|
import Git.CatFile
|
||||||
import Git.Queue
|
import Git.Queue
|
||||||
|
@ -75,7 +75,7 @@ newState gitrepo = AnnexState
|
||||||
{ repo = gitrepo
|
{ repo = gitrepo
|
||||||
, backends = []
|
, backends = []
|
||||||
, remotes = []
|
, remotes = []
|
||||||
, repoqueue = empty
|
, repoqueue = Git.Queue.empty
|
||||||
, output = NormalOutput
|
, output = NormalOutput
|
||||||
, force = False
|
, force = False
|
||||||
, fast = False
|
, fast = False
|
||||||
|
|
13
AnnexCommon.hs
Normal file
13
AnnexCommon.hs
Normal file
|
@ -0,0 +1,13 @@
|
||||||
|
module AnnexCommon (
|
||||||
|
module Common,
|
||||||
|
module Types,
|
||||||
|
module Annex,
|
||||||
|
module Locations,
|
||||||
|
module Messages,
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Common
|
||||||
|
import Types
|
||||||
|
import Annex (gitRepo)
|
||||||
|
import Locations
|
||||||
|
import Messages
|
|
@ -11,13 +11,9 @@ module AnnexQueue (
|
||||||
flushWhenFull
|
flushWhenFull
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.State (liftIO)
|
import AnnexCommon
|
||||||
import Control.Monad (when, unless)
|
|
||||||
|
|
||||||
import Annex
|
import Annex
|
||||||
import Messages
|
|
||||||
import qualified Git.Queue
|
import qualified Git.Queue
|
||||||
import Utility.SafeCommand
|
|
||||||
|
|
||||||
{- Adds a git command to the queue. -}
|
{- Adds a git command to the queue. -}
|
||||||
add :: String -> [CommandParam] -> [FilePath] -> Annex ()
|
add :: String -> [CommandParam] -> [FilePath] -> Annex ()
|
||||||
|
|
12
Backend.hs
12
Backend.hs
|
@ -16,20 +16,14 @@ module Backend (
|
||||||
maybeLookupBackendName
|
maybeLookupBackendName
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.State (liftIO, when)
|
|
||||||
import Control.Applicative
|
|
||||||
import System.IO.Error (try)
|
import System.IO.Error (try)
|
||||||
import System.FilePath
|
|
||||||
import System.Posix.Files
|
import System.Posix.Files
|
||||||
import Data.Maybe
|
|
||||||
|
|
||||||
import Locations
|
import AnnexCommon
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import Types
|
|
||||||
import Types.Key
|
import Types.Key
|
||||||
import qualified Types.Backend as B
|
import qualified Types.Backend as B
|
||||||
import Messages
|
|
||||||
|
|
||||||
-- When adding a new backend, import it here and add it to the list.
|
-- When adding a new backend, import it here and add it to the list.
|
||||||
import qualified Backend.WORM
|
import qualified Backend.WORM
|
||||||
|
@ -59,7 +53,7 @@ orderedList = do
|
||||||
Annex.changeState $ \state -> state { Annex.backends = l' }
|
Annex.changeState $ \state -> state { Annex.backends = l' }
|
||||||
return l'
|
return l'
|
||||||
getstandard = do
|
getstandard = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
return $ parseBackendList $
|
return $ parseBackendList $
|
||||||
Git.configGet g "annex.backends" ""
|
Git.configGet g "annex.backends" ""
|
||||||
|
|
||||||
|
@ -108,7 +102,7 @@ type BackendFile = (Maybe (Backend Annex), FilePath)
|
||||||
-}
|
-}
|
||||||
chooseBackends :: [FilePath] -> Annex [BackendFile]
|
chooseBackends :: [FilePath] -> Annex [BackendFile]
|
||||||
chooseBackends fs = do
|
chooseBackends fs = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
forced <- Annex.getState Annex.forcebackend
|
forced <- Annex.getState Annex.forcebackend
|
||||||
if isJust forced
|
if isJust forced
|
||||||
then do
|
then do
|
||||||
|
|
|
@ -7,23 +7,11 @@
|
||||||
|
|
||||||
module Backend.SHA (backends) where
|
module Backend.SHA (backends) where
|
||||||
|
|
||||||
import Control.Monad.State
|
import AnnexCommon
|
||||||
import Data.String.Utils
|
|
||||||
import System.Cmd.Utils
|
|
||||||
import System.IO
|
|
||||||
import System.Directory
|
|
||||||
import Data.Maybe
|
|
||||||
import System.Posix.Files
|
|
||||||
import System.FilePath
|
|
||||||
|
|
||||||
import Messages
|
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import Locations
|
|
||||||
import Content
|
import Content
|
||||||
import Types
|
|
||||||
import Types.Backend
|
import Types.Backend
|
||||||
import Types.Key
|
import Types.Key
|
||||||
import Utility.SafeCommand
|
|
||||||
import qualified Build.SysConfig as SysConfig
|
import qualified Build.SysConfig as SysConfig
|
||||||
|
|
||||||
type SHASize = Int
|
type SHASize = Int
|
||||||
|
@ -110,7 +98,7 @@ keyValueE size file = keyValue size file >>= maybe (return Nothing) addE
|
||||||
{- A key's checksum is checked during fsck. -}
|
{- A key's checksum is checked during fsck. -}
|
||||||
checkKeyChecksum :: SHASize -> Key -> Annex Bool
|
checkKeyChecksum :: SHASize -> Key -> Annex Bool
|
||||||
checkKeyChecksum size key = do
|
checkKeyChecksum size key = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
fast <- Annex.getState Annex.fast
|
fast <- Annex.getState Annex.fast
|
||||||
let file = gitAnnexLocation g key
|
let file = gitAnnexLocation g key
|
||||||
present <- liftIO $ doesFileExist file
|
present <- liftIO $ doesFileExist file
|
||||||
|
|
|
@ -10,9 +10,9 @@ module Backend.URL (
|
||||||
fromUrl
|
fromUrl
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import AnnexCommon
|
||||||
import Types.Backend
|
import Types.Backend
|
||||||
import Types.Key
|
import Types.Key
|
||||||
import Types
|
|
||||||
|
|
||||||
backends :: [Backend Annex]
|
backends :: [Backend Annex]
|
||||||
backends = [backend]
|
backends = [backend]
|
||||||
|
|
|
@ -7,12 +7,8 @@
|
||||||
|
|
||||||
module Backend.WORM (backends) where
|
module Backend.WORM (backends) where
|
||||||
|
|
||||||
import Control.Monad.State
|
import AnnexCommon
|
||||||
import System.FilePath
|
|
||||||
import System.Posix.Files
|
|
||||||
|
|
||||||
import Types.Backend
|
import Types.Backend
|
||||||
import Types
|
|
||||||
import Types.Key
|
import Types.Key
|
||||||
|
|
||||||
backends :: [Backend Annex]
|
backends :: [Backend Annex]
|
||||||
|
|
50
Branch.hs
50
Branch.hs
|
@ -18,33 +18,17 @@ module Branch (
|
||||||
name
|
name
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad (unless, when, liftM, filterM)
|
|
||||||
import Control.Monad.State (liftIO)
|
|
||||||
import Control.Applicative ((<$>))
|
|
||||||
import System.FilePath
|
|
||||||
import System.Directory
|
|
||||||
import Data.String.Utils
|
|
||||||
import System.Cmd.Utils
|
|
||||||
import System.IO
|
|
||||||
import System.IO.Binary
|
import System.IO.Binary
|
||||||
import System.Posix.Process
|
|
||||||
import System.Posix.IO
|
|
||||||
import System.Posix.Files
|
|
||||||
import System.Exit
|
import System.Exit
|
||||||
import qualified Data.ByteString.Lazy.Char8 as L
|
import qualified Data.ByteString.Lazy.Char8 as L
|
||||||
import Control.Monad.IO.Control (liftIOOp)
|
import Control.Monad.IO.Control (liftIOOp)
|
||||||
import qualified Control.Exception.Base
|
import qualified Control.Exception
|
||||||
|
|
||||||
|
import AnnexCommon
|
||||||
import Types.BranchState
|
import Types.BranchState
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import qualified Git.UnionMerge
|
import qualified Git.UnionMerge
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import Utility
|
|
||||||
import Utility.Conditional
|
|
||||||
import Utility.SafeCommand
|
|
||||||
import Types
|
|
||||||
import Messages
|
|
||||||
import Locations
|
|
||||||
import CatFile
|
import CatFile
|
||||||
|
|
||||||
type GitRef = String
|
type GitRef = String
|
||||||
|
@ -79,7 +63,7 @@ withIndex :: Annex a -> Annex a
|
||||||
withIndex = withIndex' False
|
withIndex = withIndex' False
|
||||||
withIndex' :: Bool -> Annex a -> Annex a
|
withIndex' :: Bool -> Annex a -> Annex a
|
||||||
withIndex' bootstrapping a = do
|
withIndex' bootstrapping a = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
let f = index g
|
let f = index g
|
||||||
reset <- liftIO $ Git.useIndex f
|
reset <- liftIO $ Git.useIndex f
|
||||||
|
|
||||||
|
@ -123,7 +107,7 @@ getCache file = getState >>= handle
|
||||||
{- Creates the branch, if it does not already exist. -}
|
{- Creates the branch, if it does not already exist. -}
|
||||||
create :: Annex ()
|
create :: Annex ()
|
||||||
create = unlessM hasBranch $ do
|
create = unlessM hasBranch $ do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
e <- hasOrigin
|
e <- hasOrigin
|
||||||
if e
|
if e
|
||||||
then liftIO $ Git.run g "branch" [Param name, Param originname]
|
then liftIO $ Git.run g "branch" [Param name, Param originname]
|
||||||
|
@ -136,7 +120,7 @@ commit message = do
|
||||||
fs <- getJournalFiles
|
fs <- getJournalFiles
|
||||||
when (not $ null fs) $ lockJournal $ do
|
when (not $ null fs) $ lockJournal $ do
|
||||||
stageJournalFiles fs
|
stageJournalFiles fs
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
withIndex $ liftIO $ Git.commit g message fullname [fullname]
|
withIndex $ liftIO $ Git.commit g message fullname [fullname]
|
||||||
|
|
||||||
{- Ensures that the branch is up-to-date; should be called before
|
{- Ensures that the branch is up-to-date; should be called before
|
||||||
|
@ -161,13 +145,13 @@ update = do
|
||||||
-}
|
-}
|
||||||
unless (null fs) $ stageJournalFiles fs
|
unless (null fs) $ stageJournalFiles fs
|
||||||
mapM_ mergeref refs
|
mapM_ mergeref refs
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
liftIO $ Git.commit g "update" fullname (fullname:refs)
|
liftIO $ Git.commit g "update" fullname (fullname:refs)
|
||||||
Annex.changeState $ \s -> s { Annex.branchstate = state { branchUpdated = True } }
|
Annex.changeState $ \s -> s { Annex.branchstate = state { branchUpdated = True } }
|
||||||
invalidateCache
|
invalidateCache
|
||||||
where
|
where
|
||||||
checkref ref = do
|
checkref ref = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
-- checking with log to see if there have been changes
|
-- checking with log to see if there have been changes
|
||||||
-- is less expensive than always merging
|
-- is less expensive than always merging
|
||||||
diffs <- liftIO $ Git.pipeRead g [
|
diffs <- liftIO $ Git.pipeRead g [
|
||||||
|
@ -189,14 +173,14 @@ update = do
|
||||||
- advises users not to directly modify the
|
- advises users not to directly modify the
|
||||||
- branch.
|
- branch.
|
||||||
-}
|
-}
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
liftIO $ Git.UnionMerge.merge g [ref]
|
liftIO $ Git.UnionMerge.merge g [ref]
|
||||||
return $ Just ref
|
return $ Just ref
|
||||||
|
|
||||||
{- Checks if a git ref exists. -}
|
{- Checks if a git ref exists. -}
|
||||||
refExists :: GitRef -> Annex Bool
|
refExists :: GitRef -> Annex Bool
|
||||||
refExists ref = do
|
refExists ref = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
liftIO $ Git.runBool g "show-ref"
|
liftIO $ Git.runBool g "show-ref"
|
||||||
[Param "--verify", Param "-q", Param ref]
|
[Param "--verify", Param "-q", Param ref]
|
||||||
|
|
||||||
|
@ -216,7 +200,7 @@ hasSomeBranch = not . null <$> siblingBranches
|
||||||
- from remotes. -}
|
- from remotes. -}
|
||||||
siblingBranches :: Annex [String]
|
siblingBranches :: Annex [String]
|
||||||
siblingBranches = do
|
siblingBranches = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
r <- liftIO $ Git.pipeRead g [Param "show-ref", Param name]
|
r <- liftIO $ Git.pipeRead g [Param "show-ref", Param name]
|
||||||
return $ map (last . words . L.unpack) (L.lines r)
|
return $ map (last . words . L.unpack) (L.lines r)
|
||||||
|
|
||||||
|
@ -253,7 +237,7 @@ get file = do
|
||||||
{- Lists all files on the branch. There may be duplicates in the list. -}
|
{- Lists all files on the branch. There may be duplicates in the list. -}
|
||||||
files :: Annex [FilePath]
|
files :: Annex [FilePath]
|
||||||
files = withIndexUpdate $ do
|
files = withIndexUpdate $ do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
bfiles <- liftIO $ Git.pipeNullSplit g
|
bfiles <- liftIO $ Git.pipeNullSplit g
|
||||||
[Params "ls-tree --name-only -r -z", Param fullname]
|
[Params "ls-tree --name-only -r -z", Param fullname]
|
||||||
jfiles <- getJournalledFiles
|
jfiles <- getJournalledFiles
|
||||||
|
@ -265,7 +249,7 @@ files = withIndexUpdate $ do
|
||||||
- avoids git needing to rewrite the index after every change. -}
|
- avoids git needing to rewrite the index after every change. -}
|
||||||
setJournalFile :: FilePath -> String -> Annex ()
|
setJournalFile :: FilePath -> String -> Annex ()
|
||||||
setJournalFile file content = do
|
setJournalFile file content = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
liftIO $ catch (write g) $ const $ do
|
liftIO $ catch (write g) $ const $ do
|
||||||
createDirectoryIfMissing True $ gitAnnexJournalDir g
|
createDirectoryIfMissing True $ gitAnnexJournalDir g
|
||||||
createDirectoryIfMissing True $ gitAnnexTmpDir g
|
createDirectoryIfMissing True $ gitAnnexTmpDir g
|
||||||
|
@ -281,7 +265,7 @@ setJournalFile file content = do
|
||||||
{- Gets any journalled content for a file in the branch. -}
|
{- Gets any journalled content for a file in the branch. -}
|
||||||
getJournalFile :: FilePath -> Annex (Maybe String)
|
getJournalFile :: FilePath -> Annex (Maybe String)
|
||||||
getJournalFile file = do
|
getJournalFile file = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
liftIO $ catch (liftM Just . readFileStrict $ journalFile g file)
|
liftIO $ catch (liftM Just . readFileStrict $ journalFile g file)
|
||||||
(const $ return Nothing)
|
(const $ return Nothing)
|
||||||
|
|
||||||
|
@ -292,7 +276,7 @@ getJournalledFiles = map fileJournal <$> getJournalFiles
|
||||||
{- List of existing journal files. -}
|
{- List of existing journal files. -}
|
||||||
getJournalFiles :: Annex [FilePath]
|
getJournalFiles :: Annex [FilePath]
|
||||||
getJournalFiles = do
|
getJournalFiles = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
fs <- liftIO $ catch (getDirectoryContents $ gitAnnexJournalDir g)
|
fs <- liftIO $ catch (getDirectoryContents $ gitAnnexJournalDir g)
|
||||||
(const $ return [])
|
(const $ return [])
|
||||||
return $ filter (`notElem` [".", ".."]) fs
|
return $ filter (`notElem` [".", ".."]) fs
|
||||||
|
@ -300,7 +284,7 @@ getJournalFiles = do
|
||||||
{- Stages the specified journalfiles. -}
|
{- Stages the specified journalfiles. -}
|
||||||
stageJournalFiles :: [FilePath] -> Annex ()
|
stageJournalFiles :: [FilePath] -> Annex ()
|
||||||
stageJournalFiles fs = do
|
stageJournalFiles fs = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
withIndex $ liftIO $ do
|
withIndex $ liftIO $ do
|
||||||
let dir = gitAnnexJournalDir g
|
let dir = gitAnnexJournalDir g
|
||||||
let paths = map (dir </>) fs
|
let paths = map (dir </>) fs
|
||||||
|
@ -346,9 +330,9 @@ fileJournal = replace "//" "_" . replace "_" "/"
|
||||||
- contention with other git-annex processes. -}
|
- contention with other git-annex processes. -}
|
||||||
lockJournal :: Annex a -> Annex a
|
lockJournal :: Annex a -> Annex a
|
||||||
lockJournal a = do
|
lockJournal a = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
let file = gitAnnexJournalLock g
|
let file = gitAnnexJournalLock g
|
||||||
liftIOOp (Control.Exception.Base.bracket (lock file) unlock) run
|
liftIOOp (Control.Exception.bracket (lock file) unlock) run
|
||||||
where
|
where
|
||||||
lock file = do
|
lock file = do
|
||||||
l <- createFile file stdFileMode
|
l <- createFile file stdFileMode
|
||||||
|
|
|
@ -9,17 +9,15 @@ module CatFile (
|
||||||
catFile
|
catFile
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.State
|
import AnnexCommon
|
||||||
|
|
||||||
import qualified Git.CatFile
|
import qualified Git.CatFile
|
||||||
import Types
|
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
|
|
||||||
catFile :: String -> FilePath -> Annex String
|
catFile :: String -> FilePath -> Annex String
|
||||||
catFile branch file = maybe startup go =<< Annex.getState Annex.catfilehandle
|
catFile branch file = maybe startup go =<< Annex.getState Annex.catfilehandle
|
||||||
where
|
where
|
||||||
startup = do
|
startup = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
h <- liftIO $ Git.CatFile.catFileStart g
|
h <- liftIO $ Git.CatFile.catFileStart g
|
||||||
Annex.changeState $ \s -> s { Annex.catfilehandle = Just h }
|
Annex.changeState $ \s -> s { Annex.catfilehandle = Just h }
|
||||||
go h
|
go h
|
||||||
|
|
|
@ -13,17 +13,14 @@ module CmdLine (
|
||||||
|
|
||||||
import System.IO.Error (try)
|
import System.IO.Error (try)
|
||||||
import System.Console.GetOpt
|
import System.Console.GetOpt
|
||||||
import Control.Monad.State (liftIO)
|
|
||||||
import Control.Monad (when)
|
|
||||||
|
|
||||||
|
import AnnexCommon
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import qualified AnnexQueue
|
import qualified AnnexQueue
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import Content
|
import Content
|
||||||
import Types
|
|
||||||
import Command
|
import Command
|
||||||
import Options
|
import Options
|
||||||
import Messages
|
|
||||||
import Init
|
import Init
|
||||||
|
|
||||||
{- Runs the passed command line. -}
|
{- Runs the passed command line. -}
|
||||||
|
|
27
Command.hs
27
Command.hs
|
@ -7,22 +7,11 @@
|
||||||
|
|
||||||
module Command where
|
module Command where
|
||||||
|
|
||||||
import Control.Monad.State (liftIO)
|
import AnnexCommon
|
||||||
import System.Directory
|
|
||||||
import System.Posix.Files
|
|
||||||
import Control.Monad (filterM, liftM)
|
|
||||||
import Control.Applicative
|
|
||||||
import Data.Maybe
|
|
||||||
|
|
||||||
import Types
|
|
||||||
import qualified Backend
|
import qualified Backend
|
||||||
import Messages
|
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import qualified Git.LsFiles as LsFiles
|
import qualified Git.LsFiles as LsFiles
|
||||||
import Utility
|
|
||||||
import Utility.Conditional
|
|
||||||
import Utility.Path
|
|
||||||
import Types.Key
|
import Types.Key
|
||||||
import Trust
|
import Trust
|
||||||
import LocationLog
|
import LocationLog
|
||||||
|
@ -98,7 +87,7 @@ isAnnexed file a = maybe (return Nothing) a =<< Backend.lookupFile file
|
||||||
|
|
||||||
notBareRepo :: Annex a -> Annex a
|
notBareRepo :: Annex a -> Annex a
|
||||||
notBareRepo a = do
|
notBareRepo a = do
|
||||||
whenM (Git.repoIsLocalBare <$> Annex.gitRepo) $
|
whenM (Git.repoIsLocalBare <$> gitRepo) $
|
||||||
error "You cannot run this subcommand in a bare repository."
|
error "You cannot run this subcommand in a bare repository."
|
||||||
a
|
a
|
||||||
|
|
||||||
|
@ -106,11 +95,11 @@ notBareRepo a = do
|
||||||
user's parameters, and prepare actions operating on them. -}
|
user's parameters, and prepare actions operating on them. -}
|
||||||
withFilesInGit :: (FilePath -> CommandStart) -> CommandSeek
|
withFilesInGit :: (FilePath -> CommandStart) -> CommandSeek
|
||||||
withFilesInGit a params = do
|
withFilesInGit a params = do
|
||||||
repo <- Annex.gitRepo
|
repo <- gitRepo
|
||||||
runFiltered a $ liftIO $ runPreserveOrder (LsFiles.inRepo repo) params
|
runFiltered a $ liftIO $ runPreserveOrder (LsFiles.inRepo repo) params
|
||||||
withAttrFilesInGit :: String -> ((FilePath, String) -> CommandStart) -> CommandSeek
|
withAttrFilesInGit :: String -> ((FilePath, String) -> CommandStart) -> CommandSeek
|
||||||
withAttrFilesInGit attr a params = do
|
withAttrFilesInGit attr a params = do
|
||||||
repo <- Annex.gitRepo
|
repo <- gitRepo
|
||||||
files <- liftIO $ runPreserveOrder (LsFiles.inRepo repo) params
|
files <- liftIO $ runPreserveOrder (LsFiles.inRepo repo) params
|
||||||
runFilteredGen a fst $ liftIO $ Git.checkAttr repo attr files
|
runFilteredGen a fst $ liftIO $ Git.checkAttr repo attr files
|
||||||
withNumCopies :: (FilePath -> Maybe Int -> CommandStart) -> CommandSeek
|
withNumCopies :: (FilePath -> Maybe Int -> CommandStart) -> CommandSeek
|
||||||
|
@ -119,7 +108,7 @@ withNumCopies a params = withAttrFilesInGit "annex.numcopies" go params
|
||||||
go (file, v) = a file (readMaybe v)
|
go (file, v) = a file (readMaybe v)
|
||||||
withBackendFilesInGit :: (BackendFile -> CommandStart) -> CommandSeek
|
withBackendFilesInGit :: (BackendFile -> CommandStart) -> CommandSeek
|
||||||
withBackendFilesInGit a params = do
|
withBackendFilesInGit a params = do
|
||||||
repo <- Annex.gitRepo
|
repo <- gitRepo
|
||||||
files <- liftIO $ runPreserveOrder (LsFiles.inRepo repo) params
|
files <- liftIO $ runPreserveOrder (LsFiles.inRepo repo) params
|
||||||
backendPairs a files
|
backendPairs a files
|
||||||
withFilesMissing :: (String -> CommandStart) -> CommandSeek
|
withFilesMissing :: (String -> CommandStart) -> CommandSeek
|
||||||
|
@ -128,7 +117,7 @@ withFilesMissing a params = runFiltered a $ liftIO $ filterM missing params
|
||||||
missing = liftM not . doesFileExist
|
missing = liftM not . doesFileExist
|
||||||
withFilesNotInGit :: (BackendFile -> CommandStart) -> CommandSeek
|
withFilesNotInGit :: (BackendFile -> CommandStart) -> CommandSeek
|
||||||
withFilesNotInGit a params = do
|
withFilesNotInGit a params = do
|
||||||
repo <- Annex.gitRepo
|
repo <- gitRepo
|
||||||
force <- Annex.getState Annex.force
|
force <- Annex.getState Annex.force
|
||||||
newfiles <- liftIO $ runPreserveOrder (LsFiles.notInRepo repo force) params
|
newfiles <- liftIO $ runPreserveOrder (LsFiles.notInRepo repo force) params
|
||||||
backendPairs a newfiles
|
backendPairs a newfiles
|
||||||
|
@ -138,7 +127,7 @@ withStrings :: (String -> CommandStart) -> CommandSeek
|
||||||
withStrings a params = return $ map a params
|
withStrings a params = return $ map a params
|
||||||
withFilesToBeCommitted :: (String -> CommandStart) -> CommandSeek
|
withFilesToBeCommitted :: (String -> CommandStart) -> CommandSeek
|
||||||
withFilesToBeCommitted a params = do
|
withFilesToBeCommitted a params = do
|
||||||
repo <- Annex.gitRepo
|
repo <- gitRepo
|
||||||
runFiltered a $
|
runFiltered a $
|
||||||
liftIO $ runPreserveOrder (LsFiles.stagedNotDeleted repo) params
|
liftIO $ runPreserveOrder (LsFiles.stagedNotDeleted repo) params
|
||||||
withFilesUnlocked :: (BackendFile -> CommandStart) -> CommandSeek
|
withFilesUnlocked :: (BackendFile -> CommandStart) -> CommandSeek
|
||||||
|
@ -148,7 +137,7 @@ withFilesUnlockedToBeCommitted = withFilesUnlocked' LsFiles.typeChangedStaged
|
||||||
withFilesUnlocked' :: (Git.Repo -> [FilePath] -> IO [FilePath]) -> (BackendFile -> CommandStart) -> CommandSeek
|
withFilesUnlocked' :: (Git.Repo -> [FilePath] -> IO [FilePath]) -> (BackendFile -> CommandStart) -> CommandSeek
|
||||||
withFilesUnlocked' typechanged a params = do
|
withFilesUnlocked' typechanged a params = do
|
||||||
-- unlocked files have changed type from a symlink to a regular file
|
-- unlocked files have changed type from a symlink to a regular file
|
||||||
repo <- Annex.gitRepo
|
repo <- gitRepo
|
||||||
typechangedfiles <- liftIO $ runPreserveOrder (typechanged repo) params
|
typechangedfiles <- liftIO $ runPreserveOrder (typechanged repo) params
|
||||||
unlockedfiles <- liftIO $ filterM notSymlink $
|
unlockedfiles <- liftIO $ filterM notSymlink $
|
||||||
map (\f -> Git.workTree repo ++ "/" ++ f) typechangedfiles
|
map (\f -> Git.workTree repo ++ "/" ++ f) typechangedfiles
|
||||||
|
|
|
@ -7,26 +7,17 @@
|
||||||
|
|
||||||
module Command.Add where
|
module Command.Add where
|
||||||
|
|
||||||
import Control.Monad.State (liftIO)
|
|
||||||
import Control.Monad (when)
|
|
||||||
import System.Posix.Files
|
|
||||||
import System.Directory
|
|
||||||
import Control.Exception.Control (handle)
|
import Control.Exception.Control (handle)
|
||||||
import Control.Exception.Base (throwIO)
|
import Control.Exception.Base (throwIO)
|
||||||
import Control.Exception.Extensible (IOException)
|
|
||||||
|
|
||||||
|
import AnnexCommon
|
||||||
import Command
|
import Command
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import qualified AnnexQueue
|
import qualified AnnexQueue
|
||||||
import qualified Backend
|
import qualified Backend
|
||||||
import LocationLog
|
import LocationLog
|
||||||
import Types
|
|
||||||
import Content
|
import Content
|
||||||
import Messages
|
|
||||||
import Utility.Conditional
|
|
||||||
import Utility.Touch
|
import Utility.Touch
|
||||||
import Utility.SafeCommand
|
|
||||||
import Locations
|
|
||||||
import Backend
|
import Backend
|
||||||
|
|
||||||
command :: [Command]
|
command :: [Command]
|
||||||
|
@ -72,7 +63,7 @@ undo file key e = do
|
||||||
-- fromAnnex could fail if the file ownership is weird
|
-- fromAnnex could fail if the file ownership is weird
|
||||||
tryharder :: IOException -> Annex ()
|
tryharder :: IOException -> Annex ()
|
||||||
tryharder _ = do
|
tryharder _ = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
liftIO $ renameFile (gitAnnexLocation g key) file
|
liftIO $ renameFile (gitAnnexLocation g key) file
|
||||||
|
|
||||||
cleanup :: FilePath -> Key -> Bool -> CommandCleanup
|
cleanup :: FilePath -> Key -> Bool -> CommandCleanup
|
||||||
|
|
|
@ -7,12 +7,9 @@
|
||||||
|
|
||||||
module Command.AddUrl where
|
module Command.AddUrl where
|
||||||
|
|
||||||
import Control.Monad.State
|
|
||||||
import Network.URI
|
import Network.URI
|
||||||
import Data.String.Utils
|
|
||||||
import Data.Maybe
|
|
||||||
import System.Directory
|
|
||||||
|
|
||||||
|
import AnnexCommon
|
||||||
import Command
|
import Command
|
||||||
import qualified Backend
|
import qualified Backend
|
||||||
import qualified Utility.Url as Url
|
import qualified Utility.Url as Url
|
||||||
|
@ -20,12 +17,8 @@ import qualified Remote.Web
|
||||||
import qualified Command.Add
|
import qualified Command.Add
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import qualified Backend.URL
|
import qualified Backend.URL
|
||||||
import Messages
|
|
||||||
import Content
|
import Content
|
||||||
import PresenceLog
|
import PresenceLog
|
||||||
import Locations
|
|
||||||
import Utility.Path
|
|
||||||
import Utility.Conditional
|
|
||||||
|
|
||||||
command :: [Command]
|
command :: [Command]
|
||||||
command = [repoCommand "addurl" (paramRepeating paramUrl) seek
|
command = [repoCommand "addurl" (paramRepeating paramUrl) seek
|
||||||
|
@ -51,7 +44,7 @@ perform url file = do
|
||||||
|
|
||||||
download :: String -> FilePath -> CommandPerform
|
download :: String -> FilePath -> CommandPerform
|
||||||
download url file = do
|
download url file = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
showAction $ "downloading " ++ url ++ " "
|
showAction $ "downloading " ++ url ++ " "
|
||||||
let dummykey = Backend.URL.fromUrl url
|
let dummykey = Backend.URL.fromUrl url
|
||||||
let tmp = gitAnnexTmpLocation g dummykey
|
let tmp = gitAnnexTmpLocation g dummykey
|
||||||
|
|
|
@ -7,9 +7,7 @@
|
||||||
|
|
||||||
module Command.ConfigList where
|
module Command.ConfigList where
|
||||||
|
|
||||||
import Control.Monad.State (liftIO)
|
import AnnexCommon
|
||||||
|
|
||||||
import Annex
|
|
||||||
import Command
|
import Command
|
||||||
import UUID
|
import UUID
|
||||||
|
|
||||||
|
@ -22,7 +20,7 @@ seek = [withNothing start]
|
||||||
|
|
||||||
start :: CommandStart
|
start :: CommandStart
|
||||||
start = do
|
start = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
u <- getUUID g
|
u <- getUUID g
|
||||||
liftIO $ putStrLn $ "annex.uuid=" ++ u
|
liftIO $ putStrLn $ "annex.uuid=" ++ u
|
||||||
stop
|
stop
|
||||||
|
|
|
@ -7,10 +7,10 @@
|
||||||
|
|
||||||
module Command.Describe where
|
module Command.Describe where
|
||||||
|
|
||||||
|
import AnnexCommon
|
||||||
import Command
|
import Command
|
||||||
import qualified Remote
|
import qualified Remote
|
||||||
import UUID
|
import UUID
|
||||||
import Messages
|
|
||||||
|
|
||||||
command :: [Command]
|
command :: [Command]
|
||||||
command = [repoCommand "describe" (paramPair paramRemote paramDesc) seek
|
command = [repoCommand "describe" (paramPair paramRemote paramDesc) seek
|
||||||
|
|
|
@ -7,14 +7,12 @@
|
||||||
|
|
||||||
module Command.Drop where
|
module Command.Drop where
|
||||||
|
|
||||||
|
import AnnexCommon
|
||||||
import Command
|
import Command
|
||||||
import qualified Remote
|
import qualified Remote
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import LocationLog
|
import LocationLog
|
||||||
import Types
|
|
||||||
import Content
|
import Content
|
||||||
import Messages
|
|
||||||
import Utility.Conditional
|
|
||||||
import Trust
|
import Trust
|
||||||
import Config
|
import Config
|
||||||
|
|
||||||
|
@ -71,9 +69,9 @@ dropKey key numcopiesM = do
|
||||||
| length have >= need = return True
|
| length have >= need = return True
|
||||||
| otherwise = do
|
| otherwise = do
|
||||||
let u = Remote.uuid r
|
let u = Remote.uuid r
|
||||||
let dup = u `elem` have
|
let duplicate = u `elem` have
|
||||||
haskey <- Remote.hasKey r key
|
haskey <- Remote.hasKey r key
|
||||||
case (dup, haskey) of
|
case (duplicate, haskey) of
|
||||||
(False, Right True) -> findcopies need (u:have) rs bad
|
(False, Right True) -> findcopies need (u:have) rs bad
|
||||||
(False, Left _) -> findcopies need have rs (r:bad)
|
(False, Left _) -> findcopies need have rs (r:bad)
|
||||||
_ -> findcopies need have rs bad
|
_ -> findcopies need have rs bad
|
||||||
|
|
|
@ -7,12 +7,11 @@
|
||||||
|
|
||||||
module Command.DropKey where
|
module Command.DropKey where
|
||||||
|
|
||||||
|
import AnnexCommon
|
||||||
import Command
|
import Command
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import LocationLog
|
import LocationLog
|
||||||
import Types
|
|
||||||
import Content
|
import Content
|
||||||
import Messages
|
|
||||||
|
|
||||||
command :: [Command]
|
command :: [Command]
|
||||||
command = [repoCommand "dropkey" (paramRepeating paramKey) seek
|
command = [repoCommand "dropkey" (paramRepeating paramKey) seek
|
||||||
|
|
|
@ -7,22 +7,16 @@
|
||||||
|
|
||||||
module Command.DropUnused where
|
module Command.DropUnused where
|
||||||
|
|
||||||
import Control.Monad.State (liftIO)
|
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import System.Directory
|
|
||||||
import Data.Maybe
|
|
||||||
|
|
||||||
|
import AnnexCommon
|
||||||
import Command
|
import Command
|
||||||
import Types
|
|
||||||
import Messages
|
|
||||||
import Locations
|
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import qualified Command.Drop
|
import qualified Command.Drop
|
||||||
import qualified Command.Move
|
import qualified Command.Move
|
||||||
import qualified Remote
|
import qualified Remote
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import Types.Key
|
import Types.Key
|
||||||
import Utility.Conditional
|
|
||||||
|
|
||||||
type UnusedMap = M.Map String Key
|
type UnusedMap = M.Map String Key
|
||||||
|
|
||||||
|
@ -67,14 +61,14 @@ perform key = maybe droplocal dropremote =<< Annex.getState Annex.fromremote
|
||||||
|
|
||||||
performOther :: (Git.Repo -> Key -> FilePath) -> Key -> CommandPerform
|
performOther :: (Git.Repo -> Key -> FilePath) -> Key -> CommandPerform
|
||||||
performOther filespec key = do
|
performOther filespec key = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
let f = filespec g key
|
let f = filespec g key
|
||||||
liftIO $ whenM (doesFileExist f) $ removeFile f
|
liftIO $ whenM (doesFileExist f) $ removeFile f
|
||||||
next $ return True
|
next $ return True
|
||||||
|
|
||||||
readUnusedLog :: FilePath -> Annex UnusedMap
|
readUnusedLog :: FilePath -> Annex UnusedMap
|
||||||
readUnusedLog prefix = do
|
readUnusedLog prefix = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
let f = gitAnnexUnusedLog prefix g
|
let f = gitAnnexUnusedLog prefix g
|
||||||
e <- liftIO $ doesFileExist f
|
e <- liftIO $ doesFileExist f
|
||||||
if e
|
if e
|
||||||
|
|
|
@ -7,11 +7,9 @@
|
||||||
|
|
||||||
module Command.Find where
|
module Command.Find where
|
||||||
|
|
||||||
import Control.Monad.State
|
import AnnexCommon
|
||||||
|
|
||||||
import Command
|
import Command
|
||||||
import Content
|
import Content
|
||||||
import Utility.Conditional
|
|
||||||
import Limit
|
import Limit
|
||||||
|
|
||||||
command :: [Command]
|
command :: [Command]
|
||||||
|
|
|
@ -7,16 +7,10 @@
|
||||||
|
|
||||||
module Command.Fix where
|
module Command.Fix where
|
||||||
|
|
||||||
import Control.Monad.State (liftIO)
|
import AnnexCommon
|
||||||
import System.Posix.Files
|
|
||||||
import System.Directory
|
|
||||||
|
|
||||||
import Command
|
import Command
|
||||||
import qualified AnnexQueue
|
import qualified AnnexQueue
|
||||||
import Utility.Path
|
|
||||||
import Utility.SafeCommand
|
|
||||||
import Content
|
import Content
|
||||||
import Messages
|
|
||||||
|
|
||||||
command :: [Command]
|
command :: [Command]
|
||||||
command = [repoCommand "fix" paramPaths seek
|
command = [repoCommand "fix" paramPaths seek
|
||||||
|
|
|
@ -7,18 +7,11 @@
|
||||||
|
|
||||||
module Command.FromKey where
|
module Command.FromKey where
|
||||||
|
|
||||||
import Control.Monad.State (liftIO)
|
import AnnexCommon
|
||||||
import System.Posix.Files
|
|
||||||
import System.Directory
|
|
||||||
import Control.Monad (unless)
|
|
||||||
|
|
||||||
import Command
|
import Command
|
||||||
import qualified AnnexQueue
|
import qualified AnnexQueue
|
||||||
import Utility.SafeCommand
|
|
||||||
import Content
|
import Content
|
||||||
import Messages
|
|
||||||
import Types.Key
|
import Types.Key
|
||||||
import Utility.Path
|
|
||||||
|
|
||||||
command :: [Command]
|
command :: [Command]
|
||||||
command = [repoCommand "fromkey" paramPath seek
|
command = [repoCommand "fromkey" paramPath seek
|
||||||
|
|
|
@ -7,25 +7,16 @@
|
||||||
|
|
||||||
module Command.Fsck where
|
module Command.Fsck where
|
||||||
|
|
||||||
import Control.Monad (when)
|
import AnnexCommon
|
||||||
import Control.Monad.State (liftIO)
|
|
||||||
import System.Directory
|
|
||||||
import System.Posix.Files
|
|
||||||
|
|
||||||
import Command
|
import Command
|
||||||
import qualified Annex
|
|
||||||
import qualified Remote
|
import qualified Remote
|
||||||
import qualified Types.Backend
|
import qualified Types.Backend
|
||||||
import qualified Types.Key
|
import qualified Types.Key
|
||||||
import UUID
|
import UUID
|
||||||
import Types
|
|
||||||
import Messages
|
|
||||||
import Content
|
import Content
|
||||||
import LocationLog
|
import LocationLog
|
||||||
import Locations
|
|
||||||
import Trust
|
import Trust
|
||||||
import Utility.DataUnits
|
import Utility.DataUnits
|
||||||
import Utility.Path
|
|
||||||
import Utility.FileMode
|
import Utility.FileMode
|
||||||
import Config
|
import Config
|
||||||
|
|
||||||
|
@ -54,7 +45,7 @@ perform key file backend numcopies = do
|
||||||
in this repository only. -}
|
in this repository only. -}
|
||||||
verifyLocationLog :: Key -> FilePath -> Annex Bool
|
verifyLocationLog :: Key -> FilePath -> Annex Bool
|
||||||
verifyLocationLog key file = do
|
verifyLocationLog key file = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
present <- inAnnex key
|
present <- inAnnex key
|
||||||
|
|
||||||
-- Since we're checking that a key's file is present, throw
|
-- Since we're checking that a key's file is present, throw
|
||||||
|
@ -98,7 +89,7 @@ fsckKey backend key file numcopies = do
|
||||||
- the key's metadata, if available. -}
|
- the key's metadata, if available. -}
|
||||||
checkKeySize :: Key -> Annex Bool
|
checkKeySize :: Key -> Annex Bool
|
||||||
checkKeySize key = do
|
checkKeySize key = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
let file = gitAnnexLocation g key
|
let file = gitAnnexLocation g key
|
||||||
present <- liftIO $ doesFileExist file
|
present <- liftIO $ doesFileExist file
|
||||||
case (present, Types.Key.keySize key) of
|
case (present, Types.Key.keySize key) of
|
||||||
|
|
|
@ -7,12 +7,11 @@
|
||||||
|
|
||||||
module Command.Get where
|
module Command.Get where
|
||||||
|
|
||||||
|
import AnnexCommon
|
||||||
import Command
|
import Command
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import qualified Remote
|
import qualified Remote
|
||||||
import Types
|
|
||||||
import Content
|
import Content
|
||||||
import Messages
|
|
||||||
import qualified Command.Move
|
import qualified Command.Move
|
||||||
|
|
||||||
command :: [Command]
|
command :: [Command]
|
||||||
|
|
|
@ -7,12 +7,9 @@
|
||||||
|
|
||||||
module Command.InAnnex where
|
module Command.InAnnex where
|
||||||
|
|
||||||
import Control.Monad.State (liftIO)
|
import AnnexCommon
|
||||||
import System.Exit
|
|
||||||
|
|
||||||
import Command
|
import Command
|
||||||
import Content
|
import Content
|
||||||
import Types
|
|
||||||
|
|
||||||
command :: [Command]
|
command :: [Command]
|
||||||
command = [repoCommand "inannex" (paramRepeating paramKey) seek
|
command = [repoCommand "inannex" (paramRepeating paramKey) seek
|
||||||
|
|
|
@ -7,10 +7,9 @@
|
||||||
|
|
||||||
module Command.Init where
|
module Command.Init where
|
||||||
|
|
||||||
|
import AnnexCommon
|
||||||
import Command
|
import Command
|
||||||
import qualified Annex
|
|
||||||
import UUID
|
import UUID
|
||||||
import Messages
|
|
||||||
import Init
|
import Init
|
||||||
|
|
||||||
command :: [Command]
|
command :: [Command]
|
||||||
|
@ -30,7 +29,7 @@ start ws = do
|
||||||
perform :: String -> CommandPerform
|
perform :: String -> CommandPerform
|
||||||
perform description = do
|
perform description = do
|
||||||
initialize
|
initialize
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
u <- getUUID g
|
u <- getUUID g
|
||||||
describeUUID u description
|
describeUUID u description
|
||||||
next $ return True
|
next $ return True
|
||||||
|
|
|
@ -8,18 +8,13 @@
|
||||||
module Command.InitRemote where
|
module Command.InitRemote where
|
||||||
|
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Control.Monad (when)
|
|
||||||
import Control.Monad.State (liftIO)
|
|
||||||
import Data.Maybe
|
|
||||||
import Data.String.Utils
|
|
||||||
|
|
||||||
|
import AnnexCommon
|
||||||
import Command
|
import Command
|
||||||
import qualified Remote
|
import qualified Remote
|
||||||
import qualified RemoteLog
|
import qualified RemoteLog
|
||||||
import qualified Types.Remote as R
|
import qualified Types.Remote as R
|
||||||
import Types
|
|
||||||
import UUID
|
import UUID
|
||||||
import Messages
|
|
||||||
|
|
||||||
command :: [Command]
|
command :: [Command]
|
||||||
command = [repoCommand "initremote"
|
command = [repoCommand "initremote"
|
||||||
|
|
|
@ -7,13 +7,9 @@
|
||||||
|
|
||||||
module Command.Lock where
|
module Command.Lock where
|
||||||
|
|
||||||
import Control.Monad.State (liftIO)
|
import AnnexCommon
|
||||||
import System.Directory
|
|
||||||
|
|
||||||
import Command
|
import Command
|
||||||
import Messages
|
|
||||||
import qualified AnnexQueue
|
import qualified AnnexQueue
|
||||||
import Utility.SafeCommand
|
|
||||||
import Backend
|
import Backend
|
||||||
|
|
||||||
command :: [Command]
|
command :: [Command]
|
||||||
|
|
|
@ -7,19 +7,12 @@
|
||||||
|
|
||||||
module Command.Map where
|
module Command.Map where
|
||||||
|
|
||||||
import Control.Monad.State (liftIO)
|
|
||||||
import Control.Exception.Extensible
|
import Control.Exception.Extensible
|
||||||
import System.Cmd.Utils
|
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Data.List.Utils
|
|
||||||
import Data.Maybe
|
|
||||||
|
|
||||||
|
import AnnexCommon
|
||||||
import Command
|
import Command
|
||||||
import qualified Annex
|
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import Messages
|
|
||||||
import Types
|
|
||||||
import Utility.SafeCommand
|
|
||||||
import UUID
|
import UUID
|
||||||
import Trust
|
import Trust
|
||||||
import Utility.Ssh
|
import Utility.Ssh
|
||||||
|
@ -36,7 +29,7 @@ seek = [withNothing start]
|
||||||
|
|
||||||
start :: CommandStart
|
start :: CommandStart
|
||||||
start = do
|
start = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
rs <- spider g
|
rs <- spider g
|
||||||
|
|
||||||
umap <- uuidMap
|
umap <- uuidMap
|
||||||
|
|
|
@ -7,9 +7,9 @@
|
||||||
|
|
||||||
module Command.Merge where
|
module Command.Merge where
|
||||||
|
|
||||||
|
import AnnexCommon
|
||||||
import Command
|
import Command
|
||||||
import qualified Branch
|
import qualified Branch
|
||||||
import Messages
|
|
||||||
|
|
||||||
command :: [Command]
|
command :: [Command]
|
||||||
command = [repoCommand "merge" paramNothing seek
|
command = [repoCommand "merge" paramNothing seek
|
||||||
|
|
|
@ -7,22 +7,11 @@
|
||||||
|
|
||||||
module Command.Migrate where
|
module Command.Migrate where
|
||||||
|
|
||||||
import Control.Monad.State (liftIO)
|
import AnnexCommon
|
||||||
import Control.Applicative
|
|
||||||
import System.Posix.Files
|
|
||||||
import System.Directory
|
|
||||||
import System.FilePath
|
|
||||||
import Data.Maybe
|
|
||||||
|
|
||||||
import Command
|
import Command
|
||||||
import qualified Annex
|
|
||||||
import qualified Backend
|
import qualified Backend
|
||||||
import qualified Types.Key
|
import qualified Types.Key
|
||||||
import Locations
|
|
||||||
import Types
|
|
||||||
import Content
|
import Content
|
||||||
import Messages
|
|
||||||
import Utility.Conditional
|
|
||||||
import qualified Command.Add
|
import qualified Command.Add
|
||||||
import Backend
|
import Backend
|
||||||
|
|
||||||
|
@ -53,7 +42,7 @@ upgradableKey key = isNothing $ Types.Key.keySize key
|
||||||
|
|
||||||
perform :: FilePath -> Key -> Backend Annex -> CommandPerform
|
perform :: FilePath -> Key -> Backend Annex -> CommandPerform
|
||||||
perform file oldkey newbackend = do
|
perform file oldkey newbackend = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
|
|
||||||
-- Store the old backend's cached key in the new backend
|
-- Store the old backend's cached key in the new backend
|
||||||
-- (the file can't be stored as usual, because it's already a symlink).
|
-- (the file can't be stored as usual, because it's already a symlink).
|
||||||
|
|
|
@ -7,18 +7,14 @@
|
||||||
|
|
||||||
module Command.Move where
|
module Command.Move where
|
||||||
|
|
||||||
import Control.Monad (when)
|
import AnnexCommon
|
||||||
|
|
||||||
import Command
|
import Command
|
||||||
import qualified Command.Drop
|
import qualified Command.Drop
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import LocationLog
|
import LocationLog
|
||||||
import Types
|
|
||||||
import Content
|
import Content
|
||||||
import qualified Remote
|
import qualified Remote
|
||||||
import UUID
|
import UUID
|
||||||
import Messages
|
|
||||||
import Utility.Conditional
|
|
||||||
|
|
||||||
command :: [Command]
|
command :: [Command]
|
||||||
command = [repoCommand "move" paramPaths seek
|
command = [repoCommand "move" paramPaths seek
|
||||||
|
@ -60,7 +56,7 @@ showMoveAction False file = showStart "copy" file
|
||||||
remoteHasKey :: Remote.Remote Annex -> Key -> Bool -> Annex ()
|
remoteHasKey :: Remote.Remote Annex -> Key -> Bool -> Annex ()
|
||||||
remoteHasKey remote key present = do
|
remoteHasKey remote key present = do
|
||||||
let remoteuuid = Remote.uuid remote
|
let remoteuuid = Remote.uuid remote
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
logChange g key remoteuuid status
|
logChange g key remoteuuid status
|
||||||
where
|
where
|
||||||
status = if present then InfoPresent else InfoMissing
|
status = if present then InfoPresent else InfoMissing
|
||||||
|
@ -76,7 +72,7 @@ remoteHasKey remote key present = do
|
||||||
-}
|
-}
|
||||||
toStart :: Remote.Remote Annex -> Bool -> FilePath -> CommandStart
|
toStart :: Remote.Remote Annex -> Bool -> FilePath -> CommandStart
|
||||||
toStart dest move file = isAnnexed file $ \(key, _) -> do
|
toStart dest move file = isAnnexed file $ \(key, _) -> do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
u <- getUUID g
|
u <- getUUID g
|
||||||
ishere <- inAnnex key
|
ishere <- inAnnex key
|
||||||
if not ishere || u == Remote.uuid dest
|
if not ishere || u == Remote.uuid dest
|
||||||
|
@ -126,7 +122,7 @@ toCleanup dest move key = do
|
||||||
-}
|
-}
|
||||||
fromStart :: Remote.Remote Annex -> Bool -> FilePath -> CommandStart
|
fromStart :: Remote.Remote Annex -> Bool -> FilePath -> CommandStart
|
||||||
fromStart src move file = isAnnexed file $ \(key, _) -> do
|
fromStart src move file = isAnnexed file $ \(key, _) -> do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
u <- getUUID g
|
u <- getUUID g
|
||||||
remotes <- Remote.keyPossibilities key
|
remotes <- Remote.keyPossibilities key
|
||||||
if u == Remote.uuid src || not (any (== src) remotes)
|
if u == Remote.uuid src || not (any (== src) remotes)
|
||||||
|
|
|
@ -7,15 +7,11 @@
|
||||||
|
|
||||||
module Command.RecvKey where
|
module Command.RecvKey where
|
||||||
|
|
||||||
import Control.Monad.State (liftIO)
|
import AnnexCommon
|
||||||
import System.Exit
|
|
||||||
|
|
||||||
import Command
|
import Command
|
||||||
import CmdLine
|
import CmdLine
|
||||||
import Content
|
import Content
|
||||||
import Utility.RsyncFile
|
import Utility.RsyncFile
|
||||||
import Utility.Conditional
|
|
||||||
import Types
|
|
||||||
|
|
||||||
command :: [Command]
|
command :: [Command]
|
||||||
command = [repoCommand "recvkey" paramKey seek
|
command = [repoCommand "recvkey" paramKey seek
|
||||||
|
|
|
@ -7,11 +7,11 @@
|
||||||
|
|
||||||
module Command.Semitrust where
|
module Command.Semitrust where
|
||||||
|
|
||||||
|
import AnnexCommon
|
||||||
import Command
|
import Command
|
||||||
import qualified Remote
|
import qualified Remote
|
||||||
import UUID
|
import UUID
|
||||||
import Trust
|
import Trust
|
||||||
import Messages
|
|
||||||
|
|
||||||
command :: [Command]
|
command :: [Command]
|
||||||
command = [repoCommand "semitrust" (paramRepeating paramRemote) seek
|
command = [repoCommand "semitrust" (paramRepeating paramRemote) seek
|
||||||
|
|
|
@ -7,17 +7,10 @@
|
||||||
|
|
||||||
module Command.SendKey where
|
module Command.SendKey where
|
||||||
|
|
||||||
import Control.Monad.State (liftIO)
|
import AnnexCommon
|
||||||
import System.Exit
|
|
||||||
|
|
||||||
import Locations
|
|
||||||
import qualified Annex
|
|
||||||
import Command
|
import Command
|
||||||
import Content
|
import Content
|
||||||
import Utility.RsyncFile
|
import Utility.RsyncFile
|
||||||
import Utility.Conditional
|
|
||||||
import Messages
|
|
||||||
import Types
|
|
||||||
|
|
||||||
command :: [Command]
|
command :: [Command]
|
||||||
command = [repoCommand "sendkey" paramKey seek
|
command = [repoCommand "sendkey" paramKey seek
|
||||||
|
@ -28,7 +21,7 @@ seek = [withKeys start]
|
||||||
|
|
||||||
start :: Key -> CommandStart
|
start :: Key -> CommandStart
|
||||||
start key = do
|
start key = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
let file = gitAnnexLocation g key
|
let file = gitAnnexLocation g key
|
||||||
whenM (inAnnex key) $
|
whenM (inAnnex key) $
|
||||||
liftIO $ rsyncServerSend file -- does not return
|
liftIO $ rsyncServerSend file -- does not return
|
||||||
|
|
|
@ -7,13 +7,10 @@
|
||||||
|
|
||||||
module Command.SetKey where
|
module Command.SetKey where
|
||||||
|
|
||||||
import Control.Monad.State (liftIO)
|
import AnnexCommon
|
||||||
|
|
||||||
import Command
|
import Command
|
||||||
import Utility.SafeCommand
|
|
||||||
import LocationLog
|
import LocationLog
|
||||||
import Content
|
import Content
|
||||||
import Messages
|
|
||||||
|
|
||||||
command :: [Command]
|
command :: [Command]
|
||||||
command = [repoCommand "setkey" paramPath seek
|
command = [repoCommand "setkey" paramPath seek
|
||||||
|
|
|
@ -8,25 +8,20 @@
|
||||||
module Command.Status where
|
module Command.Status where
|
||||||
|
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
||||||
import Control.Applicative
|
|
||||||
import Data.Maybe
|
|
||||||
import System.IO
|
|
||||||
import Data.List
|
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import qualified Data.Set as S
|
import qualified Data.Set as S
|
||||||
import Data.Set (Set)
|
import Data.Set (Set)
|
||||||
|
|
||||||
|
import AnnexCommon
|
||||||
import qualified Types.Backend as B
|
import qualified Types.Backend as B
|
||||||
import qualified Types.Remote as R
|
import qualified Types.Remote as R
|
||||||
import qualified Remote
|
import qualified Remote
|
||||||
import qualified Command.Unused
|
import qualified Command.Unused
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import Command
|
import Command
|
||||||
import Types
|
|
||||||
import Utility.DataUnits
|
import Utility.DataUnits
|
||||||
import Content
|
import Content
|
||||||
import Types.Key
|
import Types.Key
|
||||||
import Locations
|
|
||||||
import Backend
|
import Backend
|
||||||
import UUID
|
import UUID
|
||||||
import Remote
|
import Remote
|
||||||
|
|
|
@ -7,11 +7,11 @@
|
||||||
|
|
||||||
module Command.Trust where
|
module Command.Trust where
|
||||||
|
|
||||||
|
import AnnexCommon
|
||||||
import Command
|
import Command
|
||||||
import qualified Remote
|
import qualified Remote
|
||||||
import Trust
|
import Trust
|
||||||
import UUID
|
import UUID
|
||||||
import Messages
|
|
||||||
|
|
||||||
command :: [Command]
|
command :: [Command]
|
||||||
command = [repoCommand "trust" (paramRepeating paramRemote) seek
|
command = [repoCommand "trust" (paramRepeating paramRemote) seek
|
||||||
|
|
|
@ -7,25 +7,16 @@
|
||||||
|
|
||||||
module Command.Unannex where
|
module Command.Unannex where
|
||||||
|
|
||||||
import Control.Monad.State (liftIO)
|
import AnnexCommon
|
||||||
import Control.Monad (unless)
|
|
||||||
import System.Directory
|
|
||||||
import System.Posix.Files
|
|
||||||
|
|
||||||
import Command
|
import Command
|
||||||
import qualified Command.Drop
|
import qualified Command.Drop
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import qualified AnnexQueue
|
import qualified AnnexQueue
|
||||||
import Utility.SafeCommand
|
|
||||||
import Utility.Path
|
|
||||||
import Utility.FileMode
|
import Utility.FileMode
|
||||||
import LocationLog
|
import LocationLog
|
||||||
import Types
|
|
||||||
import Content
|
import Content
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import qualified Git.LsFiles as LsFiles
|
import qualified Git.LsFiles as LsFiles
|
||||||
import Messages
|
|
||||||
import Locations
|
|
||||||
|
|
||||||
command :: [Command]
|
command :: [Command]
|
||||||
command = [repoCommand "unannex" paramPaths seek "undo accidential add command"]
|
command = [repoCommand "unannex" paramPaths seek "undo accidential add command"]
|
||||||
|
@ -41,7 +32,7 @@ start file = isAnnexed file $ \(key, _) -> do
|
||||||
then do
|
then do
|
||||||
force <- Annex.getState Annex.force
|
force <- Annex.getState Annex.force
|
||||||
unless force $ do
|
unless force $ do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
staged <- liftIO $ LsFiles.staged g [Git.workTree g]
|
staged <- liftIO $ LsFiles.staged g [Git.workTree g]
|
||||||
unless (null staged) $
|
unless (null staged) $
|
||||||
error "This command cannot be run when there are already files staged for commit."
|
error "This command cannot be run when there are already files staged for commit."
|
||||||
|
@ -60,7 +51,7 @@ perform file key = do
|
||||||
|
|
||||||
cleanup :: FilePath -> Key -> CommandCleanup
|
cleanup :: FilePath -> Key -> CommandCleanup
|
||||||
cleanup file key = do
|
cleanup file key = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
|
|
||||||
liftIO $ removeFile file
|
liftIO $ removeFile file
|
||||||
liftIO $ Git.run g "rm" [Params "--quiet --", File file]
|
liftIO $ Git.run g "rm" [Params "--quiet --", File file]
|
||||||
|
|
|
@ -7,19 +7,14 @@
|
||||||
|
|
||||||
module Command.Uninit where
|
module Command.Uninit where
|
||||||
|
|
||||||
import Control.Monad.State (liftIO)
|
import AnnexCommon
|
||||||
import System.Directory
|
|
||||||
import System.Exit
|
|
||||||
|
|
||||||
import Command
|
import Command
|
||||||
import Utility.SafeCommand
|
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import qualified Command.Unannex
|
import qualified Command.Unannex
|
||||||
import Init
|
import Init
|
||||||
import qualified Branch
|
import qualified Branch
|
||||||
import Content
|
import Content
|
||||||
import Locations
|
|
||||||
|
|
||||||
command :: [Command]
|
command :: [Command]
|
||||||
command = [repoCommand "uninit" paramPaths seek
|
command = [repoCommand "uninit" paramPaths seek
|
||||||
|
@ -44,7 +39,7 @@ perform = next cleanup
|
||||||
|
|
||||||
cleanup :: CommandCleanup
|
cleanup :: CommandCleanup
|
||||||
cleanup = do
|
cleanup = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
uninitialize
|
uninitialize
|
||||||
mapM_ removeAnnex =<< getKeysPresent
|
mapM_ removeAnnex =<< getKeysPresent
|
||||||
liftIO $ removeDirectoryRecursive (gitAnnexDir g)
|
liftIO $ removeDirectoryRecursive (gitAnnexDir g)
|
||||||
|
|
|
@ -7,18 +7,10 @@
|
||||||
|
|
||||||
module Command.Unlock where
|
module Command.Unlock where
|
||||||
|
|
||||||
import Control.Monad.State (liftIO)
|
import AnnexCommon
|
||||||
import System.Directory hiding (copyFile)
|
|
||||||
|
|
||||||
import Command
|
import Command
|
||||||
import qualified Annex
|
|
||||||
import Types
|
|
||||||
import Messages
|
|
||||||
import Locations
|
|
||||||
import Content
|
import Content
|
||||||
import Utility.Conditional
|
|
||||||
import Utility.CopyFile
|
import Utility.CopyFile
|
||||||
import Utility.Path
|
|
||||||
import Utility.FileMode
|
import Utility.FileMode
|
||||||
|
|
||||||
command :: [Command]
|
command :: [Command]
|
||||||
|
@ -43,12 +35,12 @@ perform dest key = do
|
||||||
|
|
||||||
checkDiskSpace key
|
checkDiskSpace key
|
||||||
|
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
let src = gitAnnexLocation g key
|
let src = gitAnnexLocation g key
|
||||||
let tmpdest = gitAnnexTmpLocation g key
|
let tmpdest = gitAnnexTmpLocation g key
|
||||||
liftIO $ createDirectoryIfMissing True (parentDir tmpdest)
|
liftIO $ createDirectoryIfMissing True (parentDir tmpdest)
|
||||||
showAction "copying"
|
showAction "copying"
|
||||||
ok <- liftIO $ copyFile src tmpdest
|
ok <- liftIO $ copyFileExternal src tmpdest
|
||||||
if ok
|
if ok
|
||||||
then do
|
then do
|
||||||
liftIO $ do
|
liftIO $ do
|
||||||
|
|
|
@ -7,11 +7,11 @@
|
||||||
|
|
||||||
module Command.Untrust where
|
module Command.Untrust where
|
||||||
|
|
||||||
|
import AnnexCommon
|
||||||
import Command
|
import Command
|
||||||
import qualified Remote
|
import qualified Remote
|
||||||
import UUID
|
import UUID
|
||||||
import Trust
|
import Trust
|
||||||
import Messages
|
|
||||||
|
|
||||||
command :: [Command]
|
command :: [Command]
|
||||||
command = [repoCommand "untrust" (paramRepeating paramRemote) seek
|
command = [repoCommand "untrust" (paramRepeating paramRemote) seek
|
||||||
|
|
|
@ -9,23 +9,13 @@
|
||||||
|
|
||||||
module Command.Unused where
|
module Command.Unused where
|
||||||
|
|
||||||
import Control.Monad (filterM, unless, forM_)
|
|
||||||
import Control.Monad.State (liftIO)
|
|
||||||
import qualified Data.Set as S
|
import qualified Data.Set as S
|
||||||
import Data.Maybe
|
|
||||||
import System.FilePath
|
|
||||||
import System.Directory
|
|
||||||
import Data.List
|
|
||||||
import qualified Data.ByteString.Lazy.Char8 as L
|
import qualified Data.ByteString.Lazy.Char8 as L
|
||||||
|
|
||||||
|
import AnnexCommon
|
||||||
import Command
|
import Command
|
||||||
import Types
|
|
||||||
import Content
|
import Content
|
||||||
import Messages
|
|
||||||
import Locations
|
|
||||||
import Utility
|
|
||||||
import Utility.FileMode
|
import Utility.FileMode
|
||||||
import Utility.SafeCommand
|
|
||||||
import LocationLog
|
import LocationLog
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import qualified Git
|
import qualified Git
|
||||||
|
@ -92,7 +82,7 @@ checkRemoteUnused' r = do
|
||||||
|
|
||||||
writeUnusedFile :: FilePath -> [(Int, Key)] -> Annex ()
|
writeUnusedFile :: FilePath -> [(Int, Key)] -> Annex ()
|
||||||
writeUnusedFile prefix l = do
|
writeUnusedFile prefix l = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
liftIO $ viaTmp writeFile (gitAnnexUnusedLog prefix g) $
|
liftIO $ viaTmp writeFile (gitAnnexUnusedLog prefix g) $
|
||||||
unlines $ map (\(n, k) -> show n ++ " " ++ show k) l
|
unlines $ map (\(n, k) -> show n ++ " " ++ show k) l
|
||||||
|
|
||||||
|
@ -164,7 +154,7 @@ unusedKeys = do
|
||||||
excludeReferenced :: [Key] -> Annex [Key]
|
excludeReferenced :: [Key] -> Annex [Key]
|
||||||
excludeReferenced [] = return [] -- optimisation
|
excludeReferenced [] = return [] -- optimisation
|
||||||
excludeReferenced l = do
|
excludeReferenced l = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
c <- liftIO $ Git.pipeRead g [Param "show-ref"]
|
c <- liftIO $ Git.pipeRead g [Param "show-ref"]
|
||||||
removewith (getKeysReferenced : map getKeysReferencedInGit (refs c))
|
removewith (getKeysReferenced : map getKeysReferencedInGit (refs c))
|
||||||
(S.fromList l)
|
(S.fromList l)
|
||||||
|
@ -200,7 +190,7 @@ exclude smaller larger = S.toList $ remove larger $ S.fromList smaller
|
||||||
{- List of keys referenced by symlinks in the git repo. -}
|
{- List of keys referenced by symlinks in the git repo. -}
|
||||||
getKeysReferenced :: Annex [Key]
|
getKeysReferenced :: Annex [Key]
|
||||||
getKeysReferenced = do
|
getKeysReferenced = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
files <- liftIO $ LsFiles.inRepo g [Git.workTree g]
|
files <- liftIO $ LsFiles.inRepo g [Git.workTree g]
|
||||||
keypairs <- mapM Backend.lookupFile files
|
keypairs <- mapM Backend.lookupFile files
|
||||||
return $ map fst $ catMaybes keypairs
|
return $ map fst $ catMaybes keypairs
|
||||||
|
@ -209,7 +199,7 @@ getKeysReferenced = do
|
||||||
getKeysReferencedInGit :: String -> Annex [Key]
|
getKeysReferencedInGit :: String -> Annex [Key]
|
||||||
getKeysReferencedInGit ref = do
|
getKeysReferencedInGit ref = do
|
||||||
showAction $ "checking " ++ Git.refDescribe ref
|
showAction $ "checking " ++ Git.refDescribe ref
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
findkeys [] =<< liftIO (LsTree.lsTree g ref)
|
findkeys [] =<< liftIO (LsTree.lsTree g ref)
|
||||||
where
|
where
|
||||||
findkeys c [] = return c
|
findkeys c [] = return c
|
||||||
|
@ -232,17 +222,17 @@ staleKeysPrune dirspec present = do
|
||||||
contents <- staleKeys dirspec
|
contents <- staleKeys dirspec
|
||||||
|
|
||||||
let stale = contents `exclude` present
|
let stale = contents `exclude` present
|
||||||
let dup = contents `exclude` stale
|
let dups = contents `exclude` stale
|
||||||
|
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
let dir = dirspec g
|
let dir = dirspec g
|
||||||
liftIO $ forM_ dup $ \t -> removeFile $ dir </> keyFile t
|
liftIO $ forM_ dups $ \t -> removeFile $ dir </> keyFile t
|
||||||
|
|
||||||
return stale
|
return stale
|
||||||
|
|
||||||
staleKeys :: (Git.Repo -> FilePath) -> Annex [Key]
|
staleKeys :: (Git.Repo -> FilePath) -> Annex [Key]
|
||||||
staleKeys dirspec = do
|
staleKeys dirspec = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
let dir = dirspec g
|
let dir = dirspec g
|
||||||
exists <- liftIO $ doesDirectoryExist dir
|
exists <- liftIO $ doesDirectoryExist dir
|
||||||
if not exists
|
if not exists
|
||||||
|
|
|
@ -7,10 +7,10 @@
|
||||||
|
|
||||||
module Command.Upgrade where
|
module Command.Upgrade where
|
||||||
|
|
||||||
|
import AnnexCommon
|
||||||
import Command
|
import Command
|
||||||
import Upgrade
|
import Upgrade
|
||||||
import Version
|
import Version
|
||||||
import Messages
|
|
||||||
|
|
||||||
command :: [Command]
|
command :: [Command]
|
||||||
command = [standaloneCommand "upgrade" paramNothing seek
|
command = [standaloneCommand "upgrade" paramNothing seek
|
||||||
|
|
|
@ -7,10 +7,7 @@
|
||||||
|
|
||||||
module Command.Version where
|
module Command.Version where
|
||||||
|
|
||||||
import Control.Monad.State (liftIO)
|
import AnnexCommon
|
||||||
import Data.String.Utils
|
|
||||||
import Data.Maybe
|
|
||||||
|
|
||||||
import Command
|
import Command
|
||||||
import qualified Build.SysConfig as SysConfig
|
import qualified Build.SysConfig as SysConfig
|
||||||
import Version
|
import Version
|
||||||
|
|
|
@ -7,13 +7,10 @@
|
||||||
|
|
||||||
module Command.Whereis where
|
module Command.Whereis where
|
||||||
|
|
||||||
import Control.Monad
|
import AnnexCommon
|
||||||
|
|
||||||
import LocationLog
|
import LocationLog
|
||||||
import Command
|
import Command
|
||||||
import Messages
|
|
||||||
import Remote
|
import Remote
|
||||||
import Types
|
|
||||||
import Trust
|
import Trust
|
||||||
|
|
||||||
command :: [Command]
|
command :: [Command]
|
||||||
|
|
46
Common.hs
Normal file
46
Common.hs
Normal file
|
@ -0,0 +1,46 @@
|
||||||
|
module Common (
|
||||||
|
module Control.Monad,
|
||||||
|
module Control.Applicative,
|
||||||
|
module Control.Monad.State,
|
||||||
|
module Control.Exception.Extensible,
|
||||||
|
module Data.Maybe,
|
||||||
|
module Data.List,
|
||||||
|
module Data.String.Utils,
|
||||||
|
module System.Path,
|
||||||
|
module System.FilePath,
|
||||||
|
module System.Directory,
|
||||||
|
module System.Cmd.Utils,
|
||||||
|
module System.IO,
|
||||||
|
module System.Posix.Files,
|
||||||
|
module System.Posix.IO,
|
||||||
|
module System.Posix.Process,
|
||||||
|
module System.Exit,
|
||||||
|
module Utility,
|
||||||
|
module Utility.Conditional,
|
||||||
|
module Utility.SafeCommand,
|
||||||
|
module Utility.Path,
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Control.Monad hiding (join)
|
||||||
|
import Control.Applicative
|
||||||
|
import Control.Monad.State (liftIO)
|
||||||
|
import Control.Exception.Extensible (IOException)
|
||||||
|
|
||||||
|
import Data.Maybe
|
||||||
|
import Data.List
|
||||||
|
import Data.String.Utils
|
||||||
|
|
||||||
|
import System.Path
|
||||||
|
import System.FilePath
|
||||||
|
import System.Directory
|
||||||
|
import System.Cmd.Utils
|
||||||
|
import System.IO hiding (FilePath)
|
||||||
|
import System.Posix.Files
|
||||||
|
import System.Posix.IO
|
||||||
|
import System.Posix.Process hiding (executeFile)
|
||||||
|
import System.Exit
|
||||||
|
|
||||||
|
import Utility
|
||||||
|
import Utility.Conditional
|
||||||
|
import Utility.SafeCommand
|
||||||
|
import Utility.Path
|
15
Config.hs
15
Config.hs
|
@ -7,23 +7,16 @@
|
||||||
|
|
||||||
module Config where
|
module Config where
|
||||||
|
|
||||||
import Data.Maybe
|
import AnnexCommon
|
||||||
import Control.Monad.State (liftIO)
|
|
||||||
import Control.Applicative
|
|
||||||
import System.Cmd.Utils
|
|
||||||
|
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import Types
|
|
||||||
import Utility
|
|
||||||
import Utility.SafeCommand
|
|
||||||
|
|
||||||
type ConfigKey = String
|
type ConfigKey = String
|
||||||
|
|
||||||
{- Changes a git config setting in both internal state and .git/config -}
|
{- Changes a git config setting in both internal state and .git/config -}
|
||||||
setConfig :: ConfigKey -> String -> Annex ()
|
setConfig :: ConfigKey -> String -> Annex ()
|
||||||
setConfig k value = do
|
setConfig k value = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
liftIO $ Git.run g "config" [Param k, Param value]
|
liftIO $ Git.run g "config" [Param k, Param value]
|
||||||
-- re-read git config and update the repo's state
|
-- re-read git config and update the repo's state
|
||||||
g' <- liftIO $ Git.configRead g
|
g' <- liftIO $ Git.configRead g
|
||||||
|
@ -33,7 +26,7 @@ setConfig k value = do
|
||||||
- Failing that, tries looking for a global config option. -}
|
- Failing that, tries looking for a global config option. -}
|
||||||
getConfig :: Git.Repo -> ConfigKey -> String -> Annex String
|
getConfig :: Git.Repo -> ConfigKey -> String -> Annex String
|
||||||
getConfig r key def = do
|
getConfig r key def = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
let def' = Git.configGet g ("annex." ++ key) def
|
let def' = Git.configGet g ("annex." ++ key) def
|
||||||
return $ Git.configGet g (remoteConfig r key) def'
|
return $ Git.configGet g (remoteConfig r key) def'
|
||||||
|
|
||||||
|
@ -95,7 +88,7 @@ getNumCopies v =
|
||||||
where
|
where
|
||||||
use (Just n) = return n
|
use (Just n) = return n
|
||||||
use Nothing = do
|
use Nothing = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
return $ read $ Git.configGet g config "1"
|
return $ read $ Git.configGet g config "1"
|
||||||
config = "annex.numcopies"
|
config = "annex.numcopies"
|
||||||
|
|
||||||
|
|
34
Content.hs
34
Content.hs
|
@ -21,26 +21,14 @@ module Content (
|
||||||
saveState
|
saveState
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import System.Directory
|
import AnnexCommon
|
||||||
import Control.Monad.State (liftIO)
|
|
||||||
import System.Path
|
|
||||||
import Control.Monad
|
|
||||||
import System.Posix.Files
|
|
||||||
import System.FilePath
|
|
||||||
import Data.Maybe
|
|
||||||
|
|
||||||
import Types
|
|
||||||
import Locations
|
|
||||||
import LocationLog
|
import LocationLog
|
||||||
import UUID
|
import UUID
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import qualified AnnexQueue
|
import qualified AnnexQueue
|
||||||
import qualified Branch
|
import qualified Branch
|
||||||
import Utility
|
|
||||||
import Utility.Conditional
|
|
||||||
import Utility.StatFS
|
import Utility.StatFS
|
||||||
import Utility.Path
|
|
||||||
import Utility.FileMode
|
import Utility.FileMode
|
||||||
import Types.Key
|
import Types.Key
|
||||||
import Utility.DataUnits
|
import Utility.DataUnits
|
||||||
|
@ -49,14 +37,14 @@ import Config
|
||||||
{- Checks if a given key is currently present in the gitAnnexLocation. -}
|
{- Checks if a given key is currently present in the gitAnnexLocation. -}
|
||||||
inAnnex :: Key -> Annex Bool
|
inAnnex :: Key -> Annex Bool
|
||||||
inAnnex key = do
|
inAnnex key = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
when (Git.repoIsUrl g) $ error "inAnnex cannot check remote repo"
|
when (Git.repoIsUrl g) $ error "inAnnex cannot check remote repo"
|
||||||
liftIO $ doesFileExist $ gitAnnexLocation g key
|
liftIO $ doesFileExist $ gitAnnexLocation g key
|
||||||
|
|
||||||
{- Calculates the relative path to use to link a file to a key. -}
|
{- Calculates the relative path to use to link a file to a key. -}
|
||||||
calcGitLink :: FilePath -> Key -> Annex FilePath
|
calcGitLink :: FilePath -> Key -> Annex FilePath
|
||||||
calcGitLink file key = do
|
calcGitLink file key = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
cwd <- liftIO getCurrentDirectory
|
cwd <- liftIO getCurrentDirectory
|
||||||
let absfile = fromMaybe whoops $ absNormPath cwd file
|
let absfile = fromMaybe whoops $ absNormPath cwd file
|
||||||
return $ relPathDirToFile (parentDir absfile)
|
return $ relPathDirToFile (parentDir absfile)
|
||||||
|
@ -68,7 +56,7 @@ calcGitLink file key = do
|
||||||
- repository. -}
|
- repository. -}
|
||||||
logStatus :: Key -> LogStatus -> Annex ()
|
logStatus :: Key -> LogStatus -> Annex ()
|
||||||
logStatus key status = do
|
logStatus key status = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
u <- getUUID g
|
u <- getUUID g
|
||||||
logChange g key u status
|
logChange g key u status
|
||||||
|
|
||||||
|
@ -77,7 +65,7 @@ logStatus key status = do
|
||||||
- the annex as a key's content. -}
|
- the annex as a key's content. -}
|
||||||
getViaTmp :: Key -> (FilePath -> Annex Bool) -> Annex Bool
|
getViaTmp :: Key -> (FilePath -> Annex Bool) -> Annex Bool
|
||||||
getViaTmp key action = do
|
getViaTmp key action = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
let tmp = gitAnnexTmpLocation g key
|
let tmp = gitAnnexTmpLocation g key
|
||||||
|
|
||||||
-- Check that there is enough free disk space.
|
-- Check that there is enough free disk space.
|
||||||
|
@ -96,7 +84,7 @@ getViaTmp key action = do
|
||||||
|
|
||||||
prepTmp :: Key -> Annex FilePath
|
prepTmp :: Key -> Annex FilePath
|
||||||
prepTmp key = do
|
prepTmp key = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
let tmp = gitAnnexTmpLocation g key
|
let tmp = gitAnnexTmpLocation g key
|
||||||
liftIO $ createDirectoryIfMissing True (parentDir tmp)
|
liftIO $ createDirectoryIfMissing True (parentDir tmp)
|
||||||
return tmp
|
return tmp
|
||||||
|
@ -133,7 +121,7 @@ checkDiskSpace = checkDiskSpace' 0
|
||||||
|
|
||||||
checkDiskSpace' :: Integer -> Key -> Annex ()
|
checkDiskSpace' :: Integer -> Key -> Annex ()
|
||||||
checkDiskSpace' adjustment key = do
|
checkDiskSpace' adjustment key = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
r <- getConfig g "diskreserve" ""
|
r <- getConfig g "diskreserve" ""
|
||||||
let reserve = fromMaybe megabyte $ readSize dataUnits r
|
let reserve = fromMaybe megabyte $ readSize dataUnits r
|
||||||
stats <- liftIO $ getFileSystemStats (gitAnnexDir g)
|
stats <- liftIO $ getFileSystemStats (gitAnnexDir g)
|
||||||
|
@ -174,7 +162,7 @@ checkDiskSpace' adjustment key = do
|
||||||
-}
|
-}
|
||||||
moveAnnex :: Key -> FilePath -> Annex ()
|
moveAnnex :: Key -> FilePath -> Annex ()
|
||||||
moveAnnex key src = do
|
moveAnnex key src = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
let dest = gitAnnexLocation g key
|
let dest = gitAnnexLocation g key
|
||||||
let dir = parentDir dest
|
let dir = parentDir dest
|
||||||
e <- liftIO $ doesFileExist dest
|
e <- liftIO $ doesFileExist dest
|
||||||
|
@ -189,7 +177,7 @@ moveAnnex key src = do
|
||||||
|
|
||||||
withObjectLoc :: Key -> ((FilePath, FilePath) -> Annex a) -> Annex a
|
withObjectLoc :: Key -> ((FilePath, FilePath) -> Annex a) -> Annex a
|
||||||
withObjectLoc key a = do
|
withObjectLoc key a = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
let file = gitAnnexLocation g key
|
let file = gitAnnexLocation g key
|
||||||
let dir = parentDir file
|
let dir = parentDir file
|
||||||
a (dir, file)
|
a (dir, file)
|
||||||
|
@ -213,7 +201,7 @@ fromAnnex key dest = withObjectLoc key $ \(dir, file) -> liftIO $ do
|
||||||
- returns the file it was moved to. -}
|
- returns the file it was moved to. -}
|
||||||
moveBad :: Key -> Annex FilePath
|
moveBad :: Key -> Annex FilePath
|
||||||
moveBad key = do
|
moveBad key = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
let src = gitAnnexLocation g key
|
let src = gitAnnexLocation g key
|
||||||
let dest = gitAnnexBadDir g </> takeFileName src
|
let dest = gitAnnexBadDir g </> takeFileName src
|
||||||
liftIO $ do
|
liftIO $ do
|
||||||
|
@ -227,7 +215,7 @@ moveBad key = do
|
||||||
{- List of keys whose content exists in .git/annex/objects/ -}
|
{- List of keys whose content exists in .git/annex/objects/ -}
|
||||||
getKeysPresent :: Annex [Key]
|
getKeysPresent :: Annex [Key]
|
||||||
getKeysPresent = do
|
getKeysPresent = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
getKeysPresent' $ gitAnnexObjectDir g
|
getKeysPresent' $ gitAnnexObjectDir g
|
||||||
getKeysPresent' :: FilePath -> Annex [Key]
|
getKeysPresent' :: FilePath -> Annex [Key]
|
||||||
getKeysPresent' dir = do
|
getKeysPresent' dir = do
|
||||||
|
|
15
Crypto.hs
15
Crypto.hs
|
@ -30,26 +30,17 @@ import qualified Data.ByteString.Lazy.Char8 as L
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Data.ByteString.Lazy.UTF8 (fromString)
|
import Data.ByteString.Lazy.UTF8 (fromString)
|
||||||
import Data.Digest.Pure.SHA
|
import Data.Digest.Pure.SHA
|
||||||
import System.Cmd.Utils
|
|
||||||
import Data.String.Utils
|
|
||||||
import Data.List
|
|
||||||
import Data.Maybe
|
|
||||||
import System.IO
|
|
||||||
import System.Posix.IO
|
|
||||||
import System.Posix.Types
|
import System.Posix.Types
|
||||||
import System.Posix.Process
|
|
||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
import Control.Exception (finally)
|
import Control.Exception (finally)
|
||||||
import System.Exit
|
import System.Exit
|
||||||
import System.Environment
|
import System.Environment
|
||||||
|
|
||||||
import Types
|
import AnnexCommon
|
||||||
import Types.Key
|
import Types.Key
|
||||||
import Types.Remote
|
import Types.Remote
|
||||||
import Utility
|
|
||||||
import Utility.Base64
|
import Utility.Base64
|
||||||
import Utility.SafeCommand
|
|
||||||
import Types.Crypto
|
import Types.Crypto
|
||||||
|
|
||||||
{- The first half of a Cipher is used for HMAC; the remainder
|
{- The first half of a Cipher is used for HMAC; the remainder
|
||||||
|
@ -97,9 +88,9 @@ updateCipher :: RemoteConfig -> EncryptedCipher -> IO EncryptedCipher
|
||||||
updateCipher c encipher@(EncryptedCipher _ ks) = do
|
updateCipher c encipher@(EncryptedCipher _ ks) = do
|
||||||
ks' <- configKeyIds c
|
ks' <- configKeyIds c
|
||||||
cipher <- decryptCipher c encipher
|
cipher <- decryptCipher c encipher
|
||||||
encryptCipher cipher (combine ks ks')
|
encryptCipher cipher (merge ks ks')
|
||||||
where
|
where
|
||||||
combine (KeyIds a) (KeyIds b) = KeyIds $ a ++ b
|
merge (KeyIds a) (KeyIds b) = KeyIds $ a ++ b
|
||||||
|
|
||||||
describeCipher :: EncryptedCipher -> String
|
describeCipher :: EncryptedCipher -> String
|
||||||
describeCipher (EncryptedCipher _ (KeyIds ks)) =
|
describeCipher (EncryptedCipher _ (KeyIds ks)) =
|
||||||
|
|
16
Git.hs
16
Git.hs
|
@ -64,34 +64,20 @@ module Git (
|
||||||
prop_idempotent_deencode
|
prop_idempotent_deencode
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad (unless, when, liftM2)
|
|
||||||
import Control.Applicative
|
|
||||||
import System.Directory
|
|
||||||
import System.FilePath
|
|
||||||
import System.Posix.Directory
|
import System.Posix.Directory
|
||||||
import System.Posix.User
|
import System.Posix.User
|
||||||
import System.Posix.Process
|
|
||||||
import System.Path
|
|
||||||
import System.Cmd.Utils
|
|
||||||
import IO (bracket_, try)
|
import IO (bracket_, try)
|
||||||
import Data.String.Utils
|
|
||||||
import System.IO
|
|
||||||
import qualified Data.Map as M hiding (map, split)
|
import qualified Data.Map as M hiding (map, split)
|
||||||
import Network.URI
|
import Network.URI
|
||||||
import Data.Maybe
|
|
||||||
import Data.Char
|
import Data.Char
|
||||||
import Data.Word (Word8)
|
import Data.Word (Word8)
|
||||||
import Codec.Binary.UTF8.String (encode)
|
import Codec.Binary.UTF8.String (encode)
|
||||||
import Text.Printf
|
import Text.Printf
|
||||||
import Data.List (isInfixOf, isPrefixOf, isSuffixOf)
|
|
||||||
import System.Exit
|
import System.Exit
|
||||||
import System.Posix.Env (setEnv, unsetEnv, getEnv)
|
import System.Posix.Env (setEnv, unsetEnv, getEnv)
|
||||||
import qualified Data.ByteString.Lazy.Char8 as L
|
import qualified Data.ByteString.Lazy.Char8 as L
|
||||||
|
|
||||||
import Utility
|
import Common
|
||||||
import Utility.Path
|
|
||||||
import Utility.Conditional
|
|
||||||
import Utility.SafeCommand
|
|
||||||
|
|
||||||
{- There are two types of repositories; those on local disk and those
|
{- There are two types of repositories; those on local disk and those
|
||||||
- accessed via an URL. -}
|
- accessed via an URL. -}
|
||||||
|
|
|
@ -8,14 +8,12 @@
|
||||||
module GitAnnex where
|
module GitAnnex where
|
||||||
|
|
||||||
import System.Console.GetOpt
|
import System.Console.GetOpt
|
||||||
import Control.Monad.State (liftIO)
|
|
||||||
|
|
||||||
|
import AnnexCommon
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import CmdLine
|
import CmdLine
|
||||||
import Command
|
import Command
|
||||||
import Options
|
import Options
|
||||||
import Utility
|
|
||||||
import Types
|
|
||||||
import Types.TrustLevel
|
import Types.TrustLevel
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import qualified Remote
|
import qualified Remote
|
||||||
|
@ -122,7 +120,7 @@ options = commonOptions ++
|
||||||
setkey v = Annex.changeState $ \s -> s { Annex.defaultkey = Just v }
|
setkey v = Annex.changeState $ \s -> s { Annex.defaultkey = Just v }
|
||||||
setgitconfig :: String -> Annex ()
|
setgitconfig :: String -> Annex ()
|
||||||
setgitconfig v = do
|
setgitconfig v = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
g' <- liftIO $ Git.configStore g v
|
g' <- liftIO $ Git.configStore g v
|
||||||
Annex.changeState $ \s -> s { Annex.repo = g' }
|
Annex.changeState $ \s -> s { Annex.repo = g' }
|
||||||
|
|
||||||
|
|
14
Init.hs
14
Init.hs
|
@ -11,18 +11,10 @@ module Init (
|
||||||
uninitialize
|
uninitialize
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.State (liftIO)
|
import AnnexCommon
|
||||||
import Control.Monad (unless)
|
|
||||||
import System.Directory
|
|
||||||
|
|
||||||
import qualified Annex
|
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import qualified Branch
|
import qualified Branch
|
||||||
import Version
|
import Version
|
||||||
import Messages
|
|
||||||
import Types
|
|
||||||
import Utility
|
|
||||||
import Utility.Conditional
|
|
||||||
import UUID
|
import UUID
|
||||||
|
|
||||||
initialize :: Annex ()
|
initialize :: Annex ()
|
||||||
|
@ -73,12 +65,12 @@ gitPreCommitHookUnWrite = unlessBare $ do
|
||||||
|
|
||||||
unlessBare :: Annex () -> Annex ()
|
unlessBare :: Annex () -> Annex ()
|
||||||
unlessBare a = do
|
unlessBare a = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
unless (Git.repoIsLocalBare g) a
|
unless (Git.repoIsLocalBare g) a
|
||||||
|
|
||||||
preCommitHook :: Annex FilePath
|
preCommitHook :: Annex FilePath
|
||||||
preCommitHook = do
|
preCommitHook = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
return $ Git.gitDir g ++ "/hooks/pre-commit"
|
return $ Git.gitDir g ++ "/hooks/pre-commit"
|
||||||
|
|
||||||
preCommitScript :: String
|
preCommitScript :: String
|
||||||
|
|
6
Limit.hs
6
Limit.hs
|
@ -9,15 +9,13 @@ module Limit where
|
||||||
|
|
||||||
import Text.Regex.PCRE.Light.Char8
|
import Text.Regex.PCRE.Light.Char8
|
||||||
import System.Path.WildMatch
|
import System.Path.WildMatch
|
||||||
import Control.Applicative
|
|
||||||
import Data.Maybe
|
|
||||||
|
|
||||||
import Annex
|
import AnnexCommon
|
||||||
|
import qualified Annex
|
||||||
import qualified Utility.Matcher
|
import qualified Utility.Matcher
|
||||||
import qualified Remote
|
import qualified Remote
|
||||||
import qualified Backend
|
import qualified Backend
|
||||||
import LocationLog
|
import LocationLog
|
||||||
import Utility
|
|
||||||
import Content
|
import Content
|
||||||
|
|
||||||
type Limit = Utility.Matcher.Token (FilePath -> Annex Bool)
|
type Limit = Utility.Matcher.Token (FilePath -> Annex Bool)
|
||||||
|
|
|
@ -21,15 +21,10 @@ module LocationLog (
|
||||||
logFileKey
|
logFileKey
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import System.FilePath
|
import AnnexCommon
|
||||||
import Control.Applicative
|
|
||||||
import Data.Maybe
|
|
||||||
|
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import qualified Branch
|
import qualified Branch
|
||||||
import UUID
|
import UUID
|
||||||
import Types
|
|
||||||
import Locations
|
|
||||||
import PresenceLog
|
import PresenceLog
|
||||||
|
|
||||||
{- Log a change in the presence of a key's value in a repository. -}
|
{- Log a change in the presence of a key's value in a repository. -}
|
||||||
|
|
|
@ -26,13 +26,11 @@ module Locations (
|
||||||
prop_idempotent_fileKey
|
prop_idempotent_fileKey
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import System.FilePath
|
|
||||||
import Data.String.Utils
|
|
||||||
import Data.List
|
|
||||||
import Bits
|
import Bits
|
||||||
import Word
|
import Word
|
||||||
import Data.Hash.MD5
|
import Data.Hash.MD5
|
||||||
|
|
||||||
|
import Common
|
||||||
import Types
|
import Types
|
||||||
import Types.Key
|
import Types.Key
|
||||||
import qualified Git
|
import qualified Git
|
||||||
|
|
|
@ -23,11 +23,9 @@ module Messages (
|
||||||
setupConsole
|
setupConsole
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.State (liftIO)
|
|
||||||
import System.IO
|
|
||||||
import Data.String.Utils
|
|
||||||
import Text.JSON
|
import Text.JSON
|
||||||
|
|
||||||
|
import Common
|
||||||
import Types
|
import Types
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import qualified Messages.JSON as JSON
|
import qualified Messages.JSON as JSON
|
||||||
|
|
|
@ -9,10 +9,9 @@ module Options where
|
||||||
|
|
||||||
import System.Console.GetOpt
|
import System.Console.GetOpt
|
||||||
import System.Log.Logger
|
import System.Log.Logger
|
||||||
import Control.Monad.State (liftIO)
|
|
||||||
|
|
||||||
|
import AnnexCommon
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import Types
|
|
||||||
import Command
|
import Command
|
||||||
import Limit
|
import Limit
|
||||||
|
|
||||||
|
|
|
@ -26,11 +26,9 @@ import Data.Time.Clock.POSIX
|
||||||
import Data.Time
|
import Data.Time
|
||||||
import System.Locale
|
import System.Locale
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Control.Monad.State (liftIO)
|
|
||||||
import Control.Applicative
|
|
||||||
|
|
||||||
|
import AnnexCommon
|
||||||
import qualified Branch
|
import qualified Branch
|
||||||
import Types
|
|
||||||
|
|
||||||
data LogLine = LogLine {
|
data LogLine = LogLine {
|
||||||
date :: POSIXTime,
|
date :: POSIXTime,
|
||||||
|
|
16
Remote.hs
16
Remote.hs
|
@ -28,23 +28,17 @@ module Remote (
|
||||||
forceTrust
|
forceTrust
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.State (filterM)
|
|
||||||
import Data.List
|
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Data.String.Utils
|
|
||||||
import Data.Maybe
|
|
||||||
import Control.Applicative
|
|
||||||
import Text.JSON
|
import Text.JSON
|
||||||
import Text.JSON.Generic
|
import Text.JSON.Generic
|
||||||
|
|
||||||
import Types
|
import AnnexCommon
|
||||||
import Types.Remote
|
import Types.Remote
|
||||||
import UUID
|
import UUID
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import Config
|
import Config
|
||||||
import Trust
|
import Trust
|
||||||
import LocationLog
|
import LocationLog
|
||||||
import Messages
|
|
||||||
import RemoteLog
|
import RemoteLog
|
||||||
|
|
||||||
import qualified Remote.Git
|
import qualified Remote.Git
|
||||||
|
@ -110,7 +104,7 @@ byName' n = do
|
||||||
- and returns its UUID. Finds even remotes that are not configured in
|
- and returns its UUID. Finds even remotes that are not configured in
|
||||||
- .git/config. -}
|
- .git/config. -}
|
||||||
nameToUUID :: String -> Annex UUID
|
nameToUUID :: String -> Annex UUID
|
||||||
nameToUUID "." = getUUID =<< Annex.gitRepo -- special case for current repo
|
nameToUUID "." = getUUID =<< gitRepo -- special case for current repo
|
||||||
nameToUUID n = do
|
nameToUUID n = do
|
||||||
res <- byName' n
|
res <- byName' n
|
||||||
case res of
|
case res of
|
||||||
|
@ -135,7 +129,7 @@ nameToUUID n = do
|
||||||
- of the UUIDs. -}
|
- of the UUIDs. -}
|
||||||
prettyPrintUUIDs :: String -> [UUID] -> Annex String
|
prettyPrintUUIDs :: String -> [UUID] -> Annex String
|
||||||
prettyPrintUUIDs desc uuids = do
|
prettyPrintUUIDs desc uuids = do
|
||||||
here <- getUUID =<< Annex.gitRepo
|
here <- getUUID =<< gitRepo
|
||||||
m <- M.unionWith addname <$> uuidMap <*> remoteMap
|
m <- M.unionWith addname <$> uuidMap <*> remoteMap
|
||||||
maybeShowJSON [(desc, map (jsonify m here) uuids)]
|
maybeShowJSON [(desc, map (jsonify m here) uuids)]
|
||||||
return $ unwords $ map (\u -> "\t" ++ prettify m here u ++ "\n") uuids
|
return $ unwords $ map (\u -> "\t" ++ prettify m here u ++ "\n") uuids
|
||||||
|
@ -184,7 +178,7 @@ keyPossibilitiesTrusted = keyPossibilities' True
|
||||||
|
|
||||||
keyPossibilities' :: Bool -> Key -> Annex ([Remote Annex], [UUID])
|
keyPossibilities' :: Bool -> Key -> Annex ([Remote Annex], [UUID])
|
||||||
keyPossibilities' withtrusted key = do
|
keyPossibilities' withtrusted key = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
u <- getUUID g
|
u <- getUUID g
|
||||||
trusted <- if withtrusted then trustGet Trusted else return []
|
trusted <- if withtrusted then trustGet Trusted else return []
|
||||||
|
|
||||||
|
@ -204,7 +198,7 @@ keyPossibilities' withtrusted key = do
|
||||||
{- Displays known locations of a key. -}
|
{- Displays known locations of a key. -}
|
||||||
showLocations :: Key -> [UUID] -> Annex ()
|
showLocations :: Key -> [UUID] -> Annex ()
|
||||||
showLocations key exclude = do
|
showLocations key exclude = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
u <- getUUID g
|
u <- getUUID g
|
||||||
uuids <- keyLocations key
|
uuids <- keyLocations key
|
||||||
untrusteduuids <- trustGet UnTrusted
|
untrusteduuids <- trustGet UnTrusted
|
||||||
|
|
|
@ -8,30 +8,15 @@
|
||||||
module Remote.Bup (remote) where
|
module Remote.Bup (remote) where
|
||||||
|
|
||||||
import qualified Data.ByteString.Lazy.Char8 as L
|
import qualified Data.ByteString.Lazy.Char8 as L
|
||||||
import System.IO
|
|
||||||
import System.IO.Error
|
import System.IO.Error
|
||||||
import Control.Exception.Extensible (IOException)
|
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Control.Monad (when)
|
|
||||||
import Control.Monad.State (liftIO)
|
|
||||||
import System.Process
|
import System.Process
|
||||||
import System.Exit
|
|
||||||
import System.FilePath
|
|
||||||
import Data.Maybe
|
|
||||||
import Data.List.Utils
|
|
||||||
import System.Cmd.Utils
|
|
||||||
|
|
||||||
import Types
|
import AnnexCommon
|
||||||
import Types.Remote
|
import Types.Remote
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import qualified Annex
|
|
||||||
import UUID
|
import UUID
|
||||||
import Locations
|
|
||||||
import Config
|
import Config
|
||||||
import Utility
|
|
||||||
import Utility.Conditional
|
|
||||||
import Utility.SafeCommand
|
|
||||||
import Messages
|
|
||||||
import Utility.Ssh
|
import Utility.Ssh
|
||||||
import Remote.Helper.Special
|
import Remote.Helper.Special
|
||||||
import Remote.Helper.Encryptable
|
import Remote.Helper.Encryptable
|
||||||
|
@ -118,14 +103,14 @@ bupSplitParams r buprepo k src = do
|
||||||
|
|
||||||
store :: Git.Repo -> BupRepo -> Key -> Annex Bool
|
store :: Git.Repo -> BupRepo -> Key -> Annex Bool
|
||||||
store r buprepo k = do
|
store r buprepo k = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
let src = gitAnnexLocation g k
|
let src = gitAnnexLocation g k
|
||||||
params <- bupSplitParams r buprepo k (File src)
|
params <- bupSplitParams r buprepo k (File src)
|
||||||
liftIO $ boolSystem "bup" params
|
liftIO $ boolSystem "bup" params
|
||||||
|
|
||||||
storeEncrypted :: Git.Repo -> BupRepo -> (Cipher, Key) -> Key -> Annex Bool
|
storeEncrypted :: Git.Repo -> BupRepo -> (Cipher, Key) -> Key -> Annex Bool
|
||||||
storeEncrypted r buprepo (cipher, enck) k = do
|
storeEncrypted r buprepo (cipher, enck) k = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
let src = gitAnnexLocation g k
|
let src = gitAnnexLocation g k
|
||||||
params <- bupSplitParams r buprepo enck (Param "-")
|
params <- bupSplitParams r buprepo enck (Param "-")
|
||||||
liftIO $ catchBool $
|
liftIO $ catchBool $
|
||||||
|
|
|
@ -9,25 +9,14 @@ module Remote.Directory (remote) where
|
||||||
|
|
||||||
import qualified Data.ByteString.Lazy.Char8 as L
|
import qualified Data.ByteString.Lazy.Char8 as L
|
||||||
import System.IO.Error
|
import System.IO.Error
|
||||||
import Control.Exception.Extensible (IOException)
|
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Control.Monad (when)
|
|
||||||
import Control.Monad.State (liftIO)
|
|
||||||
import System.Directory hiding (copyFile)
|
|
||||||
import System.FilePath
|
|
||||||
import Data.Maybe
|
|
||||||
|
|
||||||
import Types
|
import AnnexCommon
|
||||||
|
import Utility.CopyFile
|
||||||
import Types.Remote
|
import Types.Remote
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import qualified Annex
|
|
||||||
import UUID
|
import UUID
|
||||||
import Locations
|
|
||||||
import Utility.CopyFile
|
|
||||||
import Config
|
import Config
|
||||||
import Utility
|
|
||||||
import Utility.Conditional
|
|
||||||
import Utility.Path
|
|
||||||
import Utility.FileMode
|
import Utility.FileMode
|
||||||
import Remote.Helper.Special
|
import Remote.Helper.Special
|
||||||
import Remote.Helper.Encryptable
|
import Remote.Helper.Encryptable
|
||||||
|
@ -82,14 +71,14 @@ dirKey d k = d </> hashDirMixed k </> f </> f
|
||||||
|
|
||||||
store :: FilePath -> Key -> Annex Bool
|
store :: FilePath -> Key -> Annex Bool
|
||||||
store d k = do
|
store d k = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
let src = gitAnnexLocation g k
|
let src = gitAnnexLocation g k
|
||||||
let dest = dirKey d k
|
let dest = dirKey d k
|
||||||
liftIO $ catchBool $ storeHelper dest $ copyFile src dest
|
liftIO $ catchBool $ storeHelper dest $ copyFileExternal src dest
|
||||||
|
|
||||||
storeEncrypted :: FilePath -> (Cipher, Key) -> Key -> Annex Bool
|
storeEncrypted :: FilePath -> (Cipher, Key) -> Key -> Annex Bool
|
||||||
storeEncrypted d (cipher, enck) k = do
|
storeEncrypted d (cipher, enck) k = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
let src = gitAnnexLocation g k
|
let src = gitAnnexLocation g k
|
||||||
let dest = dirKey d enck
|
let dest = dirKey d enck
|
||||||
liftIO $ catchBool $ storeHelper dest $ encrypt src dest
|
liftIO $ catchBool $ storeHelper dest $ encrypt src dest
|
||||||
|
@ -110,7 +99,7 @@ storeHelper dest a = do
|
||||||
return ok
|
return ok
|
||||||
|
|
||||||
retrieve :: FilePath -> Key -> FilePath -> Annex Bool
|
retrieve :: FilePath -> Key -> FilePath -> Annex Bool
|
||||||
retrieve d k f = liftIO $ copyFile (dirKey d k) f
|
retrieve d k f = liftIO $ copyFileExternal (dirKey d k) f
|
||||||
|
|
||||||
retrieveEncrypted :: FilePath -> (Cipher, Key) -> FilePath -> Annex Bool
|
retrieveEncrypted :: FilePath -> (Cipher, Key) -> FilePath -> Annex Bool
|
||||||
retrieveEncrypted d (cipher, enck) f =
|
retrieveEncrypted d (cipher, enck) f =
|
||||||
|
|
|
@ -8,26 +8,17 @@
|
||||||
module Remote.Git (remote) where
|
module Remote.Git (remote) where
|
||||||
|
|
||||||
import Control.Exception.Extensible
|
import Control.Exception.Extensible
|
||||||
import Control.Monad.State (liftIO)
|
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import System.Cmd.Utils
|
|
||||||
import System.Posix.Files
|
|
||||||
import System.IO
|
|
||||||
|
|
||||||
import Types
|
import AnnexCommon
|
||||||
import Types.Remote
|
|
||||||
import qualified Git
|
|
||||||
import qualified Annex
|
|
||||||
import Locations
|
|
||||||
import UUID
|
|
||||||
import Utility
|
|
||||||
import qualified Content
|
|
||||||
import Messages
|
|
||||||
import Utility.CopyFile
|
import Utility.CopyFile
|
||||||
import Utility.RsyncFile
|
import Utility.RsyncFile
|
||||||
import Utility.Ssh
|
import Utility.Ssh
|
||||||
import Utility.SafeCommand
|
import Types.Remote
|
||||||
import Utility.Path
|
import qualified Git
|
||||||
|
import qualified Annex
|
||||||
|
import UUID
|
||||||
|
import qualified Content
|
||||||
import qualified Utility.Url as Url
|
import qualified Utility.Url as Url
|
||||||
import Config
|
import Config
|
||||||
import Init
|
import Init
|
||||||
|
@ -42,7 +33,7 @@ remote = RemoteType {
|
||||||
|
|
||||||
list :: Annex [Git.Repo]
|
list :: Annex [Git.Repo]
|
||||||
list = do
|
list = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
return $ Git.remotes g
|
return $ Git.remotes g
|
||||||
|
|
||||||
gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex (Remote Annex)
|
gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex (Remote Annex)
|
||||||
|
@ -109,7 +100,7 @@ tryGitConfigRead r
|
||||||
|
|
||||||
store a = do
|
store a = do
|
||||||
r' <- a
|
r' <- a
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
let l = Git.remotes g
|
let l = Git.remotes g
|
||||||
let g' = Git.remotesAdd g $ exchange l r'
|
let g' = Git.remotesAdd g $ exchange l r'
|
||||||
Annex.changeState $ \s -> s { Annex.repo = g' }
|
Annex.changeState $ \s -> s { Annex.repo = g' }
|
||||||
|
@ -169,7 +160,7 @@ copyFromRemote r key file
|
||||||
copyToRemote :: Git.Repo -> Key -> Annex Bool
|
copyToRemote :: Git.Repo -> Key -> Annex Bool
|
||||||
copyToRemote r key
|
copyToRemote r key
|
||||||
| not $ Git.repoIsUrl r = do
|
| not $ Git.repoIsUrl r = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
let keysrc = gitAnnexLocation g key
|
let keysrc = gitAnnexLocation g key
|
||||||
-- run copy from perspective of remote
|
-- run copy from perspective of remote
|
||||||
liftIO $ onLocal r $ do
|
liftIO $ onLocal r $ do
|
||||||
|
@ -178,7 +169,7 @@ copyToRemote r key
|
||||||
Content.saveState
|
Content.saveState
|
||||||
return ok
|
return ok
|
||||||
| Git.repoIsSsh r = do
|
| Git.repoIsSsh r = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
let keysrc = gitAnnexLocation g key
|
let keysrc = gitAnnexLocation g key
|
||||||
rsyncHelper =<< rsyncParamsRemote r False key keysrc
|
rsyncHelper =<< rsyncParamsRemote r False key keysrc
|
||||||
| otherwise = error "copying to non-ssh repo not supported"
|
| otherwise = error "copying to non-ssh repo not supported"
|
||||||
|
@ -200,7 +191,7 @@ rsyncOrCopyFile r src dest = do
|
||||||
ss <- liftIO $ getFileStatus $ parentDir src
|
ss <- liftIO $ getFileStatus $ parentDir src
|
||||||
ds <- liftIO $ getFileStatus $ parentDir dest
|
ds <- liftIO $ getFileStatus $ parentDir dest
|
||||||
if deviceID ss == deviceID ds
|
if deviceID ss == deviceID ds
|
||||||
then liftIO $ copyFile src dest
|
then liftIO $ copyFileExternal src dest
|
||||||
else do
|
else do
|
||||||
params <- rsyncParams r
|
params <- rsyncParams r
|
||||||
rsyncHelper $ params ++ [Param src, Param dest]
|
rsyncHelper $ params ++ [Param src, Param dest]
|
||||||
|
|
|
@ -8,13 +8,11 @@
|
||||||
module Remote.Helper.Encryptable where
|
module Remote.Helper.Encryptable where
|
||||||
|
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Control.Monad.State (liftIO)
|
|
||||||
|
|
||||||
import Types
|
import AnnexCommon
|
||||||
import Types.Remote
|
import Types.Remote
|
||||||
import Crypto
|
import Crypto
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import Messages
|
|
||||||
import Config
|
import Config
|
||||||
|
|
||||||
{- Encryption setup for a remote. The user must specify whether to use
|
{- Encryption setup for a remote. The user must specify whether to use
|
||||||
|
|
|
@ -8,16 +8,11 @@
|
||||||
module Remote.Helper.Special where
|
module Remote.Helper.Special where
|
||||||
|
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Data.Maybe
|
|
||||||
import Data.String.Utils
|
|
||||||
import Control.Monad.State (liftIO)
|
|
||||||
|
|
||||||
import Types
|
import AnnexCommon
|
||||||
import Types.Remote
|
import Types.Remote
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import qualified Annex
|
|
||||||
import UUID
|
import UUID
|
||||||
import Utility.SafeCommand
|
|
||||||
|
|
||||||
{- Special remotes don't have a configured url, so Git.Repo does not
|
{- Special remotes don't have a configured url, so Git.Repo does not
|
||||||
- automatically generate remotes for them. This looks for a different
|
- automatically generate remotes for them. This looks for a different
|
||||||
|
@ -25,7 +20,7 @@ import Utility.SafeCommand
|
||||||
-}
|
-}
|
||||||
findSpecialRemotes :: String -> Annex [Git.Repo]
|
findSpecialRemotes :: String -> Annex [Git.Repo]
|
||||||
findSpecialRemotes s = do
|
findSpecialRemotes s = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
return $ map construct $ remotepairs g
|
return $ map construct $ remotepairs g
|
||||||
where
|
where
|
||||||
remotepairs r = M.toList $ M.filterWithKey match $ Git.configMap r
|
remotepairs r = M.toList $ M.filterWithKey match $ Git.configMap r
|
||||||
|
@ -35,7 +30,7 @@ findSpecialRemotes s = do
|
||||||
{- Sets up configuration for a special remote in .git/config. -}
|
{- Sets up configuration for a special remote in .git/config. -}
|
||||||
gitConfigSpecialRemote :: UUID -> RemoteConfig -> String -> String -> Annex ()
|
gitConfigSpecialRemote :: UUID -> RemoteConfig -> String -> String -> Annex ()
|
||||||
gitConfigSpecialRemote u c k v = do
|
gitConfigSpecialRemote u c k v = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
liftIO $ do
|
liftIO $ do
|
||||||
Git.run g "config" [Param (configsetting $ "annex-"++k), Param v]
|
Git.run g "config" [Param (configsetting $ "annex-"++k), Param v]
|
||||||
Git.run g "config" [Param (configsetting "annex-uuid"), Param u]
|
Git.run g "config" [Param (configsetting "annex-uuid"), Param u]
|
||||||
|
|
|
@ -8,31 +8,19 @@
|
||||||
module Remote.Hook (remote) where
|
module Remote.Hook (remote) where
|
||||||
|
|
||||||
import qualified Data.ByteString.Lazy.Char8 as L
|
import qualified Data.ByteString.Lazy.Char8 as L
|
||||||
import Control.Exception.Extensible (IOException)
|
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Control.Monad.State (liftIO)
|
|
||||||
import System.FilePath
|
|
||||||
import System.Posix.Process hiding (executeFile)
|
|
||||||
import System.Posix.IO
|
|
||||||
import System.IO
|
|
||||||
import System.IO.Error (try)
|
import System.IO.Error (try)
|
||||||
import System.Exit
|
import System.Exit
|
||||||
import Data.Maybe
|
|
||||||
|
|
||||||
import Types
|
import AnnexCommon
|
||||||
import Types.Remote
|
import Types.Remote
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import qualified Annex
|
|
||||||
import UUID
|
import UUID
|
||||||
import Locations
|
|
||||||
import Config
|
import Config
|
||||||
import Content
|
import Content
|
||||||
import Utility
|
|
||||||
import Utility.SafeCommand
|
|
||||||
import Remote.Helper.Special
|
import Remote.Helper.Special
|
||||||
import Remote.Helper.Encryptable
|
import Remote.Helper.Encryptable
|
||||||
import Crypto
|
import Crypto
|
||||||
import Messages
|
|
||||||
|
|
||||||
remote :: RemoteType Annex
|
remote :: RemoteType Annex
|
||||||
remote = RemoteType {
|
remote = RemoteType {
|
||||||
|
@ -86,7 +74,7 @@ hookEnv k f = Just $ fileenv f ++ keyenv
|
||||||
|
|
||||||
lookupHook :: String -> String -> Annex (Maybe String)
|
lookupHook :: String -> String -> Annex (Maybe String)
|
||||||
lookupHook hooktype hook =do
|
lookupHook hooktype hook =do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
command <- getConfig g hookname ""
|
command <- getConfig g hookname ""
|
||||||
if null command
|
if null command
|
||||||
then do
|
then do
|
||||||
|
@ -111,12 +99,12 @@ runHook hooktype hook k f a = maybe (return False) run =<< lookupHook hooktype h
|
||||||
|
|
||||||
store :: String -> Key -> Annex Bool
|
store :: String -> Key -> Annex Bool
|
||||||
store h k = do
|
store h k = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
runHook h "store" k (Just $ gitAnnexLocation g k) $ return True
|
runHook h "store" k (Just $ gitAnnexLocation g k) $ return True
|
||||||
|
|
||||||
storeEncrypted :: String -> (Cipher, Key) -> Key -> Annex Bool
|
storeEncrypted :: String -> (Cipher, Key) -> Key -> Annex Bool
|
||||||
storeEncrypted h (cipher, enck) k = withTmp enck $ \tmp -> do
|
storeEncrypted h (cipher, enck) k = withTmp enck $ \tmp -> do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
let f = gitAnnexLocation g k
|
let f = gitAnnexLocation g k
|
||||||
liftIO $ withEncryptedContent cipher (L.readFile f) $ \s -> L.writeFile tmp s
|
liftIO $ withEncryptedContent cipher (L.readFile f) $ \s -> L.writeFile tmp s
|
||||||
runHook h "store" enck (Just tmp) $ return True
|
runHook h "store" enck (Just tmp) $ return True
|
||||||
|
|
|
@ -8,32 +8,18 @@
|
||||||
module Remote.Rsync (remote) where
|
module Remote.Rsync (remote) where
|
||||||
|
|
||||||
import qualified Data.ByteString.Lazy.Char8 as L
|
import qualified Data.ByteString.Lazy.Char8 as L
|
||||||
import Control.Exception.Extensible (IOException)
|
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Control.Monad.State (liftIO)
|
|
||||||
import System.FilePath
|
|
||||||
import System.Directory
|
|
||||||
import System.Posix.Files
|
|
||||||
import System.Posix.Process
|
|
||||||
import Data.Maybe
|
|
||||||
|
|
||||||
import Types
|
import AnnexCommon
|
||||||
import Types.Remote
|
import Types.Remote
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import qualified Annex
|
|
||||||
import UUID
|
import UUID
|
||||||
import Locations
|
|
||||||
import Config
|
import Config
|
||||||
import Content
|
import Content
|
||||||
import Utility
|
|
||||||
import Utility.Conditional
|
|
||||||
import Remote.Helper.Special
|
import Remote.Helper.Special
|
||||||
import Remote.Helper.Encryptable
|
import Remote.Helper.Encryptable
|
||||||
import Crypto
|
import Crypto
|
||||||
import Messages
|
|
||||||
import Utility.RsyncFile
|
import Utility.RsyncFile
|
||||||
import Utility.SafeCommand
|
|
||||||
import Utility.Path
|
|
||||||
|
|
||||||
type RsyncUrl = String
|
type RsyncUrl = String
|
||||||
|
|
||||||
|
@ -106,12 +92,12 @@ rsyncKeyDir o k = rsyncUrl o </> hashDirMixed k </> shellEscape (keyFile k)
|
||||||
|
|
||||||
store :: RsyncOpts -> Key -> Annex Bool
|
store :: RsyncOpts -> Key -> Annex Bool
|
||||||
store o k = do
|
store o k = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
rsyncSend o k (gitAnnexLocation g k)
|
rsyncSend o k (gitAnnexLocation g k)
|
||||||
|
|
||||||
storeEncrypted :: RsyncOpts -> (Cipher, Key) -> Key -> Annex Bool
|
storeEncrypted :: RsyncOpts -> (Cipher, Key) -> Key -> Annex Bool
|
||||||
storeEncrypted o (cipher, enck) k = withTmp enck $ \tmp -> do
|
storeEncrypted o (cipher, enck) k = withTmp enck $ \tmp -> do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
let f = gitAnnexLocation g k
|
let f = gitAnnexLocation g k
|
||||||
liftIO $ withEncryptedContent cipher (L.readFile f) $ \s -> L.writeFile tmp s
|
liftIO $ withEncryptedContent cipher (L.readFile f) $ \s -> L.writeFile tmp s
|
||||||
rsyncSend o enck tmp
|
rsyncSend o enck tmp
|
||||||
|
@ -166,7 +152,7 @@ partialParams = Params "--no-inplace --partial --partial-dir=.rsync-partial"
|
||||||
- up trees for rsync. -}
|
- up trees for rsync. -}
|
||||||
withRsyncScratchDir :: (FilePath -> Annex Bool) -> Annex Bool
|
withRsyncScratchDir :: (FilePath -> Annex Bool) -> Annex Bool
|
||||||
withRsyncScratchDir a = do
|
withRsyncScratchDir a = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
pid <- liftIO getProcessID
|
pid <- liftIO getProcessID
|
||||||
let tmp = gitAnnexTmpDir g </> "rsynctmp" </> show pid
|
let tmp = gitAnnexTmpDir g </> "rsynctmp" </> show pid
|
||||||
nuke tmp
|
nuke tmp
|
||||||
|
|
|
@ -7,31 +7,21 @@
|
||||||
|
|
||||||
module Remote.S3 (remote) where
|
module Remote.S3 (remote) where
|
||||||
|
|
||||||
import Control.Exception.Extensible (IOException)
|
|
||||||
import Network.AWS.AWSConnection
|
import Network.AWS.AWSConnection
|
||||||
import Network.AWS.S3Object
|
import Network.AWS.S3Object
|
||||||
import Network.AWS.S3Bucket hiding (size)
|
import Network.AWS.S3Bucket hiding (size)
|
||||||
import Network.AWS.AWSResult
|
import Network.AWS.AWSResult
|
||||||
import qualified Data.ByteString.Lazy.Char8 as L
|
import qualified Data.ByteString.Lazy.Char8 as L
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Data.Maybe
|
|
||||||
import Data.List
|
|
||||||
import Data.Char
|
import Data.Char
|
||||||
import Data.String.Utils
|
|
||||||
import Control.Monad (when)
|
|
||||||
import Control.Monad.State (liftIO)
|
|
||||||
import System.Environment
|
import System.Environment
|
||||||
import System.Posix.Files
|
|
||||||
import System.Posix.Env (setEnv)
|
import System.Posix.Env (setEnv)
|
||||||
|
|
||||||
import Types
|
import AnnexCommon
|
||||||
import Types.Remote
|
import Types.Remote
|
||||||
import Types.Key
|
import Types.Key
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import qualified Annex
|
|
||||||
import UUID
|
import UUID
|
||||||
import Messages
|
|
||||||
import Locations
|
|
||||||
import Config
|
import Config
|
||||||
import Remote.Helper.Special
|
import Remote.Helper.Special
|
||||||
import Remote.Helper.Encryptable
|
import Remote.Helper.Encryptable
|
||||||
|
@ -123,7 +113,7 @@ s3Setup u c = handlehost $ M.lookup "host" c
|
||||||
|
|
||||||
store :: Remote Annex -> Key -> Annex Bool
|
store :: Remote Annex -> Key -> Annex Bool
|
||||||
store r k = s3Action r False $ \(conn, bucket) -> do
|
store r k = s3Action r False $ \(conn, bucket) -> do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
res <- liftIO $ storeHelper (conn, bucket) r k $ gitAnnexLocation g k
|
res <- liftIO $ storeHelper (conn, bucket) r k $ gitAnnexLocation g k
|
||||||
s3Bool res
|
s3Bool res
|
||||||
|
|
||||||
|
@ -132,7 +122,7 @@ storeEncrypted r (cipher, enck) k = s3Action r False $ \(conn, bucket) ->
|
||||||
-- To get file size of the encrypted content, have to use a temp file.
|
-- To get file size of the encrypted content, have to use a temp file.
|
||||||
-- (An alternative would be chunking to to a constant size.)
|
-- (An alternative would be chunking to to a constant size.)
|
||||||
withTmp enck $ \tmp -> do
|
withTmp enck $ \tmp -> do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
let f = gitAnnexLocation g k
|
let f = gitAnnexLocation g k
|
||||||
liftIO $ withEncryptedContent cipher (L.readFile f) $ \s -> L.writeFile tmp s
|
liftIO $ withEncryptedContent cipher (L.readFile f) $ \s -> L.writeFile tmp s
|
||||||
res <- liftIO $ storeHelper (conn, bucket) r enck tmp
|
res <- liftIO $ storeHelper (conn, bucket) r enck tmp
|
||||||
|
|
|
@ -10,21 +10,13 @@ module Remote.Web (
|
||||||
setUrl
|
setUrl
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.State (liftIO)
|
import AnnexCommon
|
||||||
import Control.Exception
|
|
||||||
import System.FilePath
|
|
||||||
|
|
||||||
import Types
|
|
||||||
import Types.Remote
|
import Types.Remote
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import qualified Annex
|
|
||||||
import Messages
|
|
||||||
import UUID
|
import UUID
|
||||||
import Config
|
import Config
|
||||||
import PresenceLog
|
import PresenceLog
|
||||||
import LocationLog
|
import LocationLog
|
||||||
import Locations
|
|
||||||
import Utility
|
|
||||||
import qualified Utility.Url as Url
|
import qualified Utility.Url as Url
|
||||||
|
|
||||||
type URLString = String
|
type URLString = String
|
||||||
|
@ -80,7 +72,7 @@ getUrls key = do
|
||||||
{- Records a change in an url for a key. -}
|
{- Records a change in an url for a key. -}
|
||||||
setUrl :: Key -> URLString -> LogStatus -> Annex ()
|
setUrl :: Key -> URLString -> LogStatus -> Annex ()
|
||||||
setUrl key url status = do
|
setUrl key url status = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
addLog (urlLog key) =<< logNow status url
|
addLog (urlLog key) =<< logNow status url
|
||||||
|
|
||||||
-- update location log to indicate that the web has the key, or not
|
-- update location log to indicate that the web has the key, or not
|
||||||
|
|
|
@ -15,14 +15,11 @@ module RemoteLog (
|
||||||
prop_idempotent_configEscape
|
prop_idempotent_configEscape
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Data.List
|
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Data.Maybe
|
|
||||||
import Data.Char
|
import Data.Char
|
||||||
import Control.Applicative
|
|
||||||
|
|
||||||
|
import AnnexCommon
|
||||||
import qualified Branch
|
import qualified Branch
|
||||||
import Types
|
|
||||||
import Types.Remote
|
import Types.Remote
|
||||||
import UUID
|
import UUID
|
||||||
|
|
||||||
|
|
4
Trust.hs
4
Trust.hs
|
@ -13,13 +13,11 @@ module Trust (
|
||||||
trustPartition
|
trustPartition
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.State
|
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Data.List
|
|
||||||
|
|
||||||
|
import AnnexCommon
|
||||||
import Types.TrustLevel
|
import Types.TrustLevel
|
||||||
import qualified Branch
|
import qualified Branch
|
||||||
import Types
|
|
||||||
import UUID
|
import UUID
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
|
|
||||||
|
|
|
@ -15,9 +15,10 @@ module Types.Key (
|
||||||
prop_idempotent_key_read_show
|
prop_idempotent_key_read_show
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Utility
|
|
||||||
import System.Posix.Types
|
import System.Posix.Types
|
||||||
|
|
||||||
|
import Common
|
||||||
|
|
||||||
{- A Key has a unique name, is associated with a key/value backend,
|
{- A Key has a unique name, is associated with a key/value backend,
|
||||||
- and may contain other optional metadata. -}
|
- and may contain other optional metadata. -}
|
||||||
data Key = Key {
|
data Key = Key {
|
||||||
|
|
12
UUID.hs
12
UUID.hs
|
@ -22,18 +22,12 @@ module UUID (
|
||||||
uuidLog
|
uuidLog
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.State
|
|
||||||
import Control.Applicative
|
|
||||||
import System.Cmd.Utils
|
|
||||||
import System.IO
|
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Data.Maybe
|
|
||||||
|
|
||||||
|
import AnnexCommon
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import qualified Branch
|
import qualified Branch
|
||||||
import Types
|
|
||||||
import Types.UUID
|
import Types.UUID
|
||||||
import qualified Annex
|
|
||||||
import qualified Build.SysConfig as SysConfig
|
import qualified Build.SysConfig as SysConfig
|
||||||
import Config
|
import Config
|
||||||
|
|
||||||
|
@ -60,7 +54,7 @@ genUUID = liftIO $ pOpen ReadFromPipe command params $ \h -> hGetLine h
|
||||||
-}
|
-}
|
||||||
getUUID :: Git.Repo -> Annex UUID
|
getUUID :: Git.Repo -> Annex UUID
|
||||||
getUUID r = do
|
getUUID r = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
|
|
||||||
let c = cached g
|
let c = cached g
|
||||||
let u = getUncachedUUID r
|
let u = getUncachedUUID r
|
||||||
|
@ -81,7 +75,7 @@ getUncachedUUID r = Git.configGet r configkey ""
|
||||||
{- Make sure that the repo has an annex.uuid setting. -}
|
{- Make sure that the repo has an annex.uuid setting. -}
|
||||||
prepUUID :: Annex ()
|
prepUUID :: Annex ()
|
||||||
prepUUID = do
|
prepUUID = do
|
||||||
u <- getUUID =<< Annex.gitRepo
|
u <- getUUID =<< gitRepo
|
||||||
when ("" == u) $ do
|
when ("" == u) $ do
|
||||||
uuid <- liftIO genUUID
|
uuid <- liftIO genUUID
|
||||||
setConfig configkey uuid
|
setConfig configkey uuid
|
||||||
|
|
|
@ -7,7 +7,7 @@
|
||||||
|
|
||||||
module Upgrade where
|
module Upgrade where
|
||||||
|
|
||||||
import Types
|
import AnnexCommon
|
||||||
import Version
|
import Version
|
||||||
import qualified Upgrade.V0
|
import qualified Upgrade.V0
|
||||||
import qualified Upgrade.V1
|
import qualified Upgrade.V1
|
||||||
|
|
|
@ -8,23 +8,15 @@
|
||||||
module Upgrade.V0 where
|
module Upgrade.V0 where
|
||||||
|
|
||||||
import System.IO.Error (try)
|
import System.IO.Error (try)
|
||||||
import System.Directory
|
|
||||||
import Control.Monad.State (liftIO)
|
|
||||||
import Control.Monad (filterM, forM_)
|
|
||||||
import System.Posix.Files
|
|
||||||
import System.FilePath
|
|
||||||
|
|
||||||
|
import AnnexCommon
|
||||||
import Content
|
import Content
|
||||||
import Types
|
|
||||||
import Locations
|
|
||||||
import qualified Annex
|
|
||||||
import Messages
|
|
||||||
import qualified Upgrade.V1
|
import qualified Upgrade.V1
|
||||||
|
|
||||||
upgrade :: Annex Bool
|
upgrade :: Annex Bool
|
||||||
upgrade = do
|
upgrade = do
|
||||||
showAction "v0 to v1"
|
showAction "v0 to v1"
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
|
|
||||||
-- do the reorganisation of the key files
|
-- do the reorganisation of the key files
|
||||||
let olddir = gitAnnexDir g
|
let olddir = gitAnnexDir g
|
||||||
|
|
|
@ -8,33 +8,19 @@
|
||||||
module Upgrade.V1 where
|
module Upgrade.V1 where
|
||||||
|
|
||||||
import System.IO.Error (try)
|
import System.IO.Error (try)
|
||||||
import System.Directory
|
|
||||||
import Control.Monad.State (liftIO)
|
|
||||||
import Control.Monad (filterM, forM_, unless)
|
|
||||||
import Control.Applicative
|
|
||||||
import System.Posix.Files
|
|
||||||
import System.FilePath
|
|
||||||
import Data.String.Utils
|
|
||||||
import System.Posix.Types
|
import System.Posix.Types
|
||||||
import Data.Maybe
|
|
||||||
import Data.Char
|
import Data.Char
|
||||||
|
|
||||||
|
import AnnexCommon
|
||||||
import Types.Key
|
import Types.Key
|
||||||
import Content
|
import Content
|
||||||
import Types
|
|
||||||
import Locations
|
|
||||||
import PresenceLog
|
import PresenceLog
|
||||||
import qualified Annex
|
|
||||||
import qualified AnnexQueue
|
import qualified AnnexQueue
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import qualified Git.LsFiles as LsFiles
|
import qualified Git.LsFiles as LsFiles
|
||||||
import Backend
|
import Backend
|
||||||
import Messages
|
|
||||||
import Version
|
import Version
|
||||||
import Utility
|
|
||||||
import Utility.FileMode
|
import Utility.FileMode
|
||||||
import Utility.SafeCommand
|
|
||||||
import Utility.Path
|
|
||||||
import qualified Upgrade.V2
|
import qualified Upgrade.V2
|
||||||
|
|
||||||
-- v2 adds hashing of filenames of content and location log files.
|
-- v2 adds hashing of filenames of content and location log files.
|
||||||
|
@ -64,7 +50,7 @@ upgrade :: Annex Bool
|
||||||
upgrade = do
|
upgrade = do
|
||||||
showAction "v1 to v2"
|
showAction "v1 to v2"
|
||||||
|
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
if Git.repoIsLocalBare g
|
if Git.repoIsLocalBare g
|
||||||
then do
|
then do
|
||||||
moveContent
|
moveContent
|
||||||
|
@ -96,7 +82,7 @@ moveContent = do
|
||||||
updateSymlinks :: Annex ()
|
updateSymlinks :: Annex ()
|
||||||
updateSymlinks = do
|
updateSymlinks = do
|
||||||
showAction "updating symlinks"
|
showAction "updating symlinks"
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
files <- liftIO $ LsFiles.inRepo g [Git.workTree g]
|
files <- liftIO $ LsFiles.inRepo g [Git.workTree g]
|
||||||
forM_ files fixlink
|
forM_ files fixlink
|
||||||
where
|
where
|
||||||
|
@ -117,7 +103,7 @@ moveLocationLogs = do
|
||||||
forM_ logkeys move
|
forM_ logkeys move
|
||||||
where
|
where
|
||||||
oldlocationlogs = do
|
oldlocationlogs = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
let dir = Upgrade.V2.gitStateDir g
|
let dir = Upgrade.V2.gitStateDir g
|
||||||
exists <- liftIO $ doesDirectoryExist dir
|
exists <- liftIO $ doesDirectoryExist dir
|
||||||
if exists
|
if exists
|
||||||
|
@ -126,7 +112,7 @@ moveLocationLogs = do
|
||||||
return $ mapMaybe oldlog2key contents
|
return $ mapMaybe oldlog2key contents
|
||||||
else return []
|
else return []
|
||||||
move (l, k) = do
|
move (l, k) = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
let dest = logFile2 g k
|
let dest = logFile2 g k
|
||||||
let dir = Upgrade.V2.gitStateDir g
|
let dir = Upgrade.V2.gitStateDir g
|
||||||
let f = dir </> l
|
let f = dir </> l
|
||||||
|
@ -220,7 +206,7 @@ lookupFile1 file = do
|
||||||
|
|
||||||
getKeyFilesPresent1 :: Annex [FilePath]
|
getKeyFilesPresent1 :: Annex [FilePath]
|
||||||
getKeyFilesPresent1 = do
|
getKeyFilesPresent1 = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
getKeyFilesPresent1' $ gitAnnexObjectDir g
|
getKeyFilesPresent1' $ gitAnnexObjectDir g
|
||||||
getKeyFilesPresent1' :: FilePath -> Annex [FilePath]
|
getKeyFilesPresent1' :: FilePath -> Annex [FilePath]
|
||||||
getKeyFilesPresent1' dir = do
|
getKeyFilesPresent1' dir = do
|
||||||
|
|
|
@ -7,21 +7,9 @@
|
||||||
|
|
||||||
module Upgrade.V2 where
|
module Upgrade.V2 where
|
||||||
|
|
||||||
import System.Directory
|
import AnnexCommon
|
||||||
import System.FilePath
|
|
||||||
import Control.Monad.State (unless, when, liftIO)
|
|
||||||
import Data.List
|
|
||||||
import Data.Maybe
|
|
||||||
|
|
||||||
import Types.Key
|
|
||||||
import Types
|
|
||||||
import qualified Annex
|
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import qualified Branch
|
import qualified Branch
|
||||||
import Messages
|
|
||||||
import Utility
|
|
||||||
import Utility.Conditional
|
|
||||||
import Utility.SafeCommand
|
|
||||||
import LocationLog
|
import LocationLog
|
||||||
import Content
|
import Content
|
||||||
|
|
||||||
|
@ -48,7 +36,7 @@ olddir g
|
||||||
upgrade :: Annex Bool
|
upgrade :: Annex Bool
|
||||||
upgrade = do
|
upgrade = do
|
||||||
showAction "v2 to v3"
|
showAction "v2 to v3"
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
let bare = Git.repoIsLocalBare g
|
let bare = Git.repoIsLocalBare g
|
||||||
|
|
||||||
Branch.create
|
Branch.create
|
||||||
|
@ -85,7 +73,7 @@ locationLogs repo = liftIO $ do
|
||||||
|
|
||||||
inject :: FilePath -> FilePath -> Annex ()
|
inject :: FilePath -> FilePath -> Annex ()
|
||||||
inject source dest = do
|
inject source dest = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
new <- liftIO (readFile $ olddir g </> source)
|
new <- liftIO (readFile $ olddir g </> source)
|
||||||
Branch.change dest $ \prev ->
|
Branch.change dest $ \prev ->
|
||||||
unlines $ nub $ lines prev ++ lines new
|
unlines $ nub $ lines prev ++ lines new
|
||||||
|
@ -114,7 +102,7 @@ push = do
|
||||||
Branch.update -- just in case
|
Branch.update -- just in case
|
||||||
showAction "pushing new git-annex branch to origin"
|
showAction "pushing new git-annex branch to origin"
|
||||||
showOutput
|
showOutput
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
liftIO $ Git.run g "push" [Param "origin", Param Branch.name]
|
liftIO $ Git.run g "push" [Param "origin", Param Branch.name]
|
||||||
_ -> do
|
_ -> do
|
||||||
-- no origin exists, so just let the user
|
-- no origin exists, so just let the user
|
||||||
|
|
|
@ -11,7 +11,6 @@ module Utility (
|
||||||
readMaybe,
|
readMaybe,
|
||||||
viaTmp,
|
viaTmp,
|
||||||
withTempFile,
|
withTempFile,
|
||||||
dirContains,
|
|
||||||
dirContents,
|
dirContents,
|
||||||
myHomeDir,
|
myHomeDir,
|
||||||
catchBool,
|
catchBool,
|
||||||
|
|
|
@ -5,7 +5,7 @@
|
||||||
- Licensed under the GNU GPL version 3 or higher.
|
- Licensed under the GNU GPL version 3 or higher.
|
||||||
-}
|
-}
|
||||||
|
|
||||||
module Utility.CopyFile (copyFile) where
|
module Utility.CopyFile (copyFileExternal) where
|
||||||
|
|
||||||
import System.Directory (doesFileExist, removeFile)
|
import System.Directory (doesFileExist, removeFile)
|
||||||
|
|
||||||
|
@ -15,8 +15,8 @@ import qualified Build.SysConfig as SysConfig
|
||||||
|
|
||||||
{- The cp command is used, because I hate reinventing the wheel,
|
{- The cp command is used, because I hate reinventing the wheel,
|
||||||
- and because this allows easy access to features like cp --reflink. -}
|
- and because this allows easy access to features like cp --reflink. -}
|
||||||
copyFile :: FilePath -> FilePath -> IO Bool
|
copyFileExternal :: FilePath -> FilePath -> IO Bool
|
||||||
copyFile src dest = do
|
copyFileExternal src dest = do
|
||||||
whenM (doesFileExist dest) $
|
whenM (doesFileExist dest) $
|
||||||
removeFile dest
|
removeFile dest
|
||||||
boolSystem "cp" [params, File src, File dest]
|
boolSystem "cp" [params, File src, File dest]
|
||||||
|
|
|
@ -7,8 +7,7 @@
|
||||||
|
|
||||||
module Version where
|
module Version where
|
||||||
|
|
||||||
import Types
|
import AnnexCommon
|
||||||
import qualified Annex
|
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import Config
|
import Config
|
||||||
|
|
||||||
|
@ -28,7 +27,7 @@ versionField = "annex.version"
|
||||||
|
|
||||||
getVersion :: Annex (Maybe Version)
|
getVersion :: Annex (Maybe Version)
|
||||||
getVersion = do
|
getVersion = do
|
||||||
g <- Annex.gitRepo
|
g <- gitRepo
|
||||||
let v = Git.configGet g versionField ""
|
let v = Git.configGet g versionField ""
|
||||||
if not $ null v
|
if not $ null v
|
||||||
then return $ Just v
|
then return $ Just v
|
||||||
|
|
|
@ -6,13 +6,11 @@
|
||||||
-}
|
-}
|
||||||
|
|
||||||
import System.Environment
|
import System.Environment
|
||||||
import Data.List
|
|
||||||
|
|
||||||
|
import AnnexCommon
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import CmdLine
|
import CmdLine
|
||||||
import Command
|
import Command
|
||||||
import Utility.Conditional
|
|
||||||
import Utility.SafeCommand
|
|
||||||
import Options
|
import Options
|
||||||
|
|
||||||
import qualified Command.ConfigList
|
import qualified Command.ConfigList
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
Name: git-annex
|
Name: git-annex
|
||||||
Version: 3.20110928
|
Version: 3.20110929
|
||||||
Cabal-Version: >= 1.6
|
Cabal-Version: >= 1.6
|
||||||
License: GPL
|
License: GPL
|
||||||
Maintainer: Joey Hess <joey@kitenet.net>
|
Maintainer: Joey Hess <joey@kitenet.net>
|
||||||
|
|
|
@ -6,10 +6,8 @@
|
||||||
-}
|
-}
|
||||||
|
|
||||||
import System.Environment
|
import System.Environment
|
||||||
import System.FilePath
|
|
||||||
import System.Directory
|
|
||||||
import Control.Monad (when)
|
|
||||||
|
|
||||||
|
import Common
|
||||||
import qualified Git.UnionMerge
|
import qualified Git.UnionMerge
|
||||||
import qualified Git
|
import qualified Git
|
||||||
|
|
||||||
|
|
8
test.hs
8
test.hs
|
@ -9,23 +9,19 @@ import Test.HUnit
|
||||||
import Test.HUnit.Tools
|
import Test.HUnit.Tools
|
||||||
import Test.QuickCheck
|
import Test.QuickCheck
|
||||||
|
|
||||||
import System.Directory
|
|
||||||
import System.Posix.Directory (changeWorkingDirectory)
|
import System.Posix.Directory (changeWorkingDirectory)
|
||||||
import System.Posix.Files
|
import System.Posix.Files
|
||||||
import IO (bracket_, bracket)
|
import IO (bracket_, bracket)
|
||||||
import Control.Monad (unless, when, filterM)
|
|
||||||
import Data.List
|
|
||||||
import System.IO.Error
|
import System.IO.Error
|
||||||
import System.Posix.Env
|
import System.Posix.Env
|
||||||
import qualified Control.Exception.Extensible as E
|
import qualified Control.Exception.Extensible as E
|
||||||
import Control.Exception (throw)
|
import Control.Exception (throw)
|
||||||
import Data.Maybe
|
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import System.Path (recurseDir)
|
|
||||||
import System.IO.HVFS (SystemFS(..))
|
import System.IO.HVFS (SystemFS(..))
|
||||||
|
|
||||||
import Utility.SafeCommand
|
import Common
|
||||||
|
|
||||||
|
import qualified Utility.SafeCommand
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import qualified Backend
|
import qualified Backend
|
||||||
import qualified Git
|
import qualified Git
|
||||||
|
|
Loading…
Reference in a new issue