summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--CmdLine.hs5
-rw-r--r--Command/Map.hs2
-rw-r--r--Command/RecvKey.hs24
-rw-r--r--Command/SendKey.hs18
-rw-r--r--Fields.hs32
-rw-r--r--GitAnnex.hs2
-rw-r--r--GitAnnexShell.hs38
-rw-r--r--Logs/Transfer.hs20
-rw-r--r--Option.hs1
-rw-r--r--Remote/Git.hs35
-rw-r--r--Remote/Helper/Ssh.hs23
-rw-r--r--Utility/Daemon.hs55
-rw-r--r--Utility/Directory.hs5
-rw-r--r--Utility/Misc.hs10
-rw-r--r--Utility/RsyncFile.hs11
-rw-r--r--debian/changelog1
-rw-r--r--doc/design/assistant/syncing.mdwn3
-rw-r--r--doc/git-annex-shell.mdwn8
-rw-r--r--doc/install/Fedora.mdwn4
19 files changed, 205 insertions, 92 deletions
diff --git a/CmdLine.hs b/CmdLine.hs
index 910f228b6..edbe5e107 100644
--- a/CmdLine.hs
+++ b/CmdLine.hs
@@ -30,8 +30,8 @@ type Params = [String]
type Flags = [Annex ()]
{- Runs the passed command line. -}
-dispatch :: Bool -> Params -> [Command] -> [Option] -> String -> IO Git.Repo -> IO ()
-dispatch fuzzyok allargs allcmds commonoptions header getgitrepo = do
+dispatch :: Bool -> Params -> [Command] -> [Option] -> [(String, String)] -> String -> IO Git.Repo -> IO ()
+dispatch fuzzyok allargs allcmds commonoptions fields header getgitrepo = do
setupConsole
r <- E.try getgitrepo :: IO (Either E.SomeException Git.Repo)
case r of
@@ -40,6 +40,7 @@ dispatch fuzzyok allargs allcmds commonoptions header getgitrepo = do
state <- Annex.new g
(actions, state') <- Annex.run state $ do
checkfuzzy
+ forM_ fields $ \(f, v) -> Annex.setField f v
sequence_ flags
prepCommand cmd params
tryRun state' cmd $ [startup] ++ actions ++ [shutdown $ cmdoneshot cmd]
diff --git a/Command/Map.hs b/Command/Map.hs
index 86e9609a7..65e28945f 100644
--- a/Command/Map.hs
+++ b/Command/Map.hs
@@ -203,7 +203,7 @@ tryScan r
Git.Config.hRead r
configlist =
- onRemote r (pipedconfig, Nothing) "configlist" []
+ onRemote r (pipedconfig, Nothing) "configlist" [] []
manualconfiglist = do
sshparams <- sshToRepo r [Param sshcmd]
liftIO $ pipedconfig "ssh" sshparams
diff --git a/Command/RecvKey.hs b/Command/RecvKey.hs
index 9744a56d4..ce8bff997 100644
--- a/Command/RecvKey.hs
+++ b/Command/RecvKey.hs
@@ -12,6 +12,7 @@ import Command
import CmdLine
import Annex.Content
import Utility.RsyncFile
+import Logs.Transfer
def :: [Command]
def = [oneShot $ command "recvkey" paramKey seek
@@ -21,14 +22,15 @@ seek :: [CommandSeek]
seek = [withKeys start]
start :: Key -> CommandStart
-start key = do
- whenM (inAnnex key) $ error "key is already present in annex"
-
- ok <- getViaTmp key (liftIO . rsyncServerReceive)
- if ok
- then do
- -- forcibly quit after receiving one key,
- -- and shutdown cleanly
- _ <- shutdown True
- liftIO exitSuccess
- else liftIO exitFailure
+start key = ifM (inAnnex key)
+ ( error "key is already present in annex"
+ , fieldTransfer Download key $ do
+ ifM (getViaTmp key $ liftIO . rsyncServerReceive)
+ ( do
+ -- forcibly quit after receiving one key,
+ -- and shutdown cleanly
+ _ <- shutdown True
+ liftIO exitSuccess
+ , liftIO exitFailure
+ )
+ )
diff --git a/Command/SendKey.hs b/Command/SendKey.hs
index 686a31caa..5eca70d24 100644
--- a/Command/SendKey.hs
+++ b/Command/SendKey.hs
@@ -1,6 +1,6 @@
{- git-annex command
-
- - Copyright 2010 Joey Hess <joey@kitenet.net>
+ - Copyright 2010,2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@@ -11,6 +11,7 @@ import Common.Annex
import Command
import Annex.Content
import Utility.RsyncFile
+import Logs.Transfer
def :: [Command]
def = [oneShot $ command "sendkey" paramKey seek
@@ -20,9 +21,12 @@ seek :: [CommandSeek]
seek = [withKeys start]
start :: Key -> CommandStart
-start key = do
- file <- inRepo $ gitAnnexLocation key
- whenM (inAnnex key) $
- liftIO $ rsyncServerSend file -- does not return
- warning "requested key is not present"
- liftIO exitFailure
+start key = ifM (inAnnex key)
+ ( fieldTransfer Upload key $ do
+ file <- inRepo $ gitAnnexLocation key
+ liftIO $ ifM (rsyncServerSend file)
+ ( exitSuccess , exitFailure )
+ , do
+ warning "requested key is not present"
+ liftIO exitFailure
+ )
diff --git a/Fields.hs b/Fields.hs
new file mode 100644
index 000000000..38427ad05
--- /dev/null
+++ b/Fields.hs
@@ -0,0 +1,32 @@
+{- git-annex fields
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Fields where
+
+import Common.Annex
+import qualified Annex
+
+import Data.Char
+
+{- A field, stored in Annex state, with a value sanity checker. -}
+data Field = Field
+ { fieldName :: String
+ , fieldCheck :: String -> Bool
+ }
+
+remoteUUID :: Field
+remoteUUID = Field "remoteuuid" $
+ -- does it look like a UUID?
+ all (\c -> isAlphaNum c || c == '-')
+
+associatedFile :: Field
+associatedFile = Field "associatedfile" $ \f ->
+ -- is the file a safe relative filename?
+ not (isAbsolute f) && not ("../" `isPrefixOf` f)
+
+getField :: Field -> Annex (Maybe String)
+getField = Annex.getField . fieldName
diff --git a/GitAnnex.hs b/GitAnnex.hs
index 748a9b23e..7b1fa5986 100644
--- a/GitAnnex.hs
+++ b/GitAnnex.hs
@@ -145,4 +145,4 @@ header :: String
header = "Usage: git-annex command [option ..]"
run :: [String] -> IO ()
-run args = dispatch True args cmds options header Git.CurrentRepo.get
+run args = dispatch True args cmds options [] header Git.CurrentRepo.get
diff --git a/GitAnnexShell.hs b/GitAnnexShell.hs
index 663303713..15be51180 100644
--- a/GitAnnexShell.hs
+++ b/GitAnnexShell.hs
@@ -16,6 +16,7 @@ import CmdLine
import Command
import Annex.UUID
import qualified Option
+import Fields
import qualified Command.ConfigList
import qualified Command.InAnnex
@@ -47,7 +48,7 @@ cmds = map adddirparam $ cmds_readonly ++ cmds_notreadonly
options :: [OptDescr (Annex ())]
options = Option.common ++
- [ Option [] ["uuid"] (ReqArg checkuuid paramUUID) "repository uuid"
+ [ Option [] ["uuid"] (ReqArg checkuuid paramUUID) "local repository uuid"
]
where
checkuuid expected = getUUID >>= check
@@ -83,21 +84,40 @@ builtins = map cmdname cmds
builtin :: String -> String -> [String] -> IO ()
builtin cmd dir params = do
checkNotReadOnly cmd
- dispatch False (cmd : filterparams params) cmds options header $
+ let (params', fieldparams) = partitionParams params
+ let fields = filter checkField $ parseFields fieldparams
+ dispatch False (cmd : params') cmds options fields header $
Git.Construct.repoAbsPath dir >>= Git.Construct.fromAbsPath
external :: [String] -> IO ()
external params = do
checkNotLimited
- unlessM (boolSystem "git-shell" $ map Param $ "-c":filterparams params) $
+ unlessM (boolSystem "git-shell" $ map Param $ "-c":fst (partitionParams params)) $
error "git-shell failed"
--- Drop all args after "--".
--- These tend to be passed by rsync and not useful.
-filterparams :: [String] -> [String]
-filterparams [] = []
-filterparams ("--":_) = []
-filterparams (a:as) = a:filterparams as
+{- Parameters between two -- markers are field settings, in the form:
+ - field=value field=value
+ -
+ - Parameters after the last -- are ignored, these tend to be passed by
+ - rsync and not be useful.
+ -}
+partitionParams :: [String] -> ([String], [String])
+partitionParams params
+ | length segments < 2 = (segments !! 0, [])
+ | otherwise = (segments !! 0, segments !! 1)
+ where
+ segments = segment (== "--") params
+
+parseFields :: [String] -> [(String, String)]
+parseFields = map (separate (== '='))
+
+{- Only allow known fields to be set, ignore others.
+ - Make sure that field values make sense. -}
+checkField :: (String, String) -> Bool
+checkField (field, value)
+ | field == fieldName remoteUUID = fieldCheck remoteUUID value
+ | field == fieldName associatedFile = fieldCheck associatedFile value
+ | otherwise = False
failure :: IO ()
failure = error $ "bad parameters\n\n" ++ usage header cmds options
diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs
index 526241f93..dc9283306 100644
--- a/Logs/Transfer.hs
+++ b/Logs/Transfer.hs
@@ -12,6 +12,7 @@ import Annex.Perms
import Annex.Exception
import qualified Git
import Types.Remote
+import qualified Fields
import Control.Concurrent
import System.Posix.Types
@@ -26,7 +27,12 @@ data Transfer = Transfer
}
deriving (Show, Eq, Ord)
-{- Information about a Transfer, stored in the transfer information file. -}
+{- Information about a Transfer, stored in the transfer information file.
+ -
+ - Note that the associatedFile may not correspond to a file in the local
+ - git repository. It's some file, possibly relative to some directory,
+ - of some repository, that was acted on to initiate the transfer.
+ -}
data TransferInfo = TransferInfo
{ startedTime :: UTCTime
, transferPid :: Maybe ProcessID
@@ -54,6 +60,12 @@ upload u key file a = transfer (Transfer Upload u key) file a
download :: UUID -> Key -> AssociatedFile -> Annex a -> Annex a
download u key file a = transfer (Transfer Download u key) file a
+fieldTransfer :: Direction -> Key -> Annex a -> Annex a
+fieldTransfer direction key a = do
+ afile <- Fields.getField Fields.associatedFile
+ maybe a (\u -> transfer (Transfer direction (toUUID u) key) afile a)
+ =<< Fields.getField Fields.remoteUUID
+
{- Runs a transfer action. Creates and locks the transfer information file
- while the action is running. Will throw an error if the transfer is
- already in progress.
@@ -158,10 +170,8 @@ readTransferInfo pid s =
<*> pure (Just pid)
<*> pure Nothing
<*> pure Nothing
- <*> pure filename
+ <*> pure (if null filename then Nothing else Just filename)
_ -> Nothing
where
(bits, filebits) = splitAt 1 $ lines s
- filename
- | null filebits = Nothing
- | otherwise = Just $ join "\n" filebits
+ filename = join "\n" filebits
diff --git a/Option.hs b/Option.hs
index 1bac2cd05..967cd3e07 100644
--- a/Option.hs
+++ b/Option.hs
@@ -76,4 +76,3 @@ field short opt paramdesc description =
{- The flag or field name used for an option. -}
name :: Option -> String
name (Option _ o _ _) = Prelude.head o
-
diff --git a/Remote/Git.hs b/Remote/Git.hs
index 0b839c9a5..d80f580fc 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -31,6 +31,7 @@ import Utility.TempFile
import Config
import Init
import Types.Key
+import qualified Fields
remote :: RemoteType
remote = RemoteType {
@@ -111,7 +112,7 @@ guardUsable r onerr a
tryGitConfigRead :: Git.Repo -> Annex Git.Repo
tryGitConfigRead r
| not $ M.null $ Git.config r = return r -- already read
- | Git.repoIsSsh r = store $ onRemote r (pipedconfig, r) "configlist" []
+ | Git.repoIsSsh r = store $ onRemote r (pipedconfig, r) "configlist" [] []
| Git.repoIsHttp r = do
headers <- getHttpHeaders
store $ safely $ geturlconfig headers
@@ -171,7 +172,7 @@ inAnnex r key
v -> return v
checkremote = do
showAction $ "checking " ++ Git.repoDescribe r
- onRemote r (check, unknown) "inannex" [Param (show key)]
+ onRemote r (check, unknown) "inannex" [Param (show key)] []
where
check c p = dispatch <$> safeSystem c p
dispatch ExitSuccess = Right True
@@ -218,6 +219,7 @@ dropKey r key
[ Params "--quiet --force"
, Param $ show key
]
+ []
{- Tries to copy a key's content from a remote's annex to a file. -}
copyFromRemote :: Git.Repo -> Key -> AssociatedFile -> FilePath -> Annex Bool
@@ -231,7 +233,7 @@ copyFromRemote r key file dest
loc <- inRepo $ gitAnnexLocation key
upload u key file $
rsyncOrCopyFile params loc dest
- | Git.repoIsSsh r = rsyncHelper =<< rsyncParamsRemote r True key dest
+ | Git.repoIsSsh r = rsyncHelper =<< rsyncParamsRemote r True key dest file
| Git.repoIsHttp r = Annex.Content.downloadUrl (keyUrls r key) dest
| otherwise = error "copying from non-ssh, non-http repo not supported"
@@ -263,7 +265,7 @@ copyToRemote r key file
(rsyncOrCopyFile params keysrc)
| Git.repoIsSsh r = commitOnCleanup r $ do
keysrc <- inRepo $ gitAnnexLocation key
- rsyncHelper =<< rsyncParamsRemote r False key keysrc
+ rsyncHelper =<< rsyncParamsRemote r False key keysrc file
| otherwise = error "copying to non-ssh repo not supported"
rsyncHelper :: [CommandParam] -> Annex Bool
@@ -290,23 +292,26 @@ rsyncOrCopyFile rsyncparams src dest =
{- Generates rsync parameters that ssh to the remote and asks it
- to either receive or send the key's content. -}
-rsyncParamsRemote :: Git.Repo -> Bool -> Key -> FilePath -> Annex [CommandParam]
-rsyncParamsRemote r sending key file = do
+rsyncParamsRemote :: Git.Repo -> Bool -> Key -> FilePath -> AssociatedFile -> Annex [CommandParam]
+rsyncParamsRemote r sending key file afile = do
+ u <- getUUID
+ let fields = (Fields.remoteUUID, fromUUID u)
+ : maybe [] (\f -> [(Fields.associatedFile, f)]) afile
Just (shellcmd, shellparams) <- git_annex_shell r
(if sending then "sendkey" else "recvkey")
- [ Param $ show key
- -- Command is terminated with "--", because
- -- rsync will tack on its own options afterwards,
- -- and they need to be ignored.
- , Param "--"
- ]
+ [ Param $ show key ]
+ fields
-- Convert the ssh command into rsync command line.
let eparam = rsyncShell (Param shellcmd:shellparams)
o <- rsyncParams r
if sending
- then return $ o ++ eparam ++ [dummy, File file]
- else return $ o ++ eparam ++ [File file, dummy]
+ then return $ o ++ rsyncopts eparam dummy (File file)
+ else return $ o ++ rsyncopts eparam (File file) dummy
where
+ rsyncopts ps source dest
+ | end ps == [dashdash] = ps ++ [source, dest]
+ | otherwise = ps ++ [dashdash, source, dest]
+ dashdash = Param "--"
-- The rsync shell parameter controls where rsync
-- goes, so the source/dest parameter can be a dummy value,
-- that just enables remote rsync mode.
@@ -333,7 +338,7 @@ commitOnCleanup r a = go `after` a
Annex.Branch.commit "update"
| otherwise = void $ do
Just (shellcmd, shellparams) <-
- git_annex_shell r "commit" []
+ git_annex_shell r "commit" [] []
-- Throw away stderr, since the remote may not
-- have a new enough git-annex shell to
-- support committing.
diff --git a/Remote/Helper/Ssh.hs b/Remote/Helper/Ssh.hs
index f6742b89f..4434bc65d 100644
--- a/Remote/Helper/Ssh.hs
+++ b/Remote/Helper/Ssh.hs
@@ -1,6 +1,6 @@
{- git-annex remote access with ssh
-
- - Copyright 2011 Joey Hess <joey@kitenet.net>
+ - Copyright 2011.2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@@ -13,6 +13,7 @@ import qualified Git.Url
import Config
import Annex.UUID
import Annex.Ssh
+import Fields
{- Generates parameters to ssh to a repository's host and run a command.
- Caller is responsible for doing any neccessary shellEscaping of the
@@ -25,9 +26,9 @@ sshToRepo repo sshcmd = do
{- Generates parameters to run a git-annex-shell command on a remote
- repository. -}
-git_annex_shell :: Git.Repo -> String -> [CommandParam] -> Annex (Maybe (FilePath, [CommandParam]))
-git_annex_shell r command params
- | not $ Git.repoIsUrl r = return $ Just (shellcmd, shellopts)
+git_annex_shell :: Git.Repo -> String -> [CommandParam] -> [(Field, String)] -> Annex (Maybe (FilePath, [CommandParam]))
+git_annex_shell r command params fields
+ | not $ Git.repoIsUrl r = return $ Just (shellcmd, shellopts ++ fieldopts)
| Git.repoIsSsh r = do
uuid <- getRepoUUID r
sshparams <- sshToRepo r [Param $ sshcmd uuid ]
@@ -39,9 +40,16 @@ git_annex_shell r command params
shellopts = Param command : File dir : params
sshcmd uuid = unwords $
shellcmd : map shellEscape (toCommand shellopts) ++
- uuidcheck uuid
+ uuidcheck uuid ++
+ map shellEscape (toCommand fieldopts)
uuidcheck NoUUID = []
uuidcheck (UUID u) = ["--uuid", u]
+ fieldopts
+ | null fields = []
+ | otherwise = fieldsep : map fieldopt fields ++ [fieldsep]
+ fieldsep = Param "--"
+ fieldopt (field, value) = Param $
+ fieldName field ++ "=" ++ value
{- Uses a supplied function (such as boolSystem) to run a git-annex-shell
- command on a remote.
@@ -53,9 +61,10 @@ onRemote
-> (FilePath -> [CommandParam] -> IO a, a)
-> String
-> [CommandParam]
+ -> [(Field, String)]
-> Annex a
-onRemote r (with, errorval) command params = do
- s <- git_annex_shell r command params
+onRemote r (with, errorval) command params fields = do
+ s <- git_annex_shell r command params fields
case s of
Just (c, ps) -> liftIO $ with c ps
Nothing -> return errorval
diff --git a/Utility/Daemon.hs b/Utility/Daemon.hs
index 192340cef..f36a761d0 100644
--- a/Utility/Daemon.hs
+++ b/Utility/Daemon.hs
@@ -27,7 +27,7 @@ daemonize logfd pidfile changedirectory a = do
_ <- forkProcess child2
out
child2 = do
- maybe noop (lockPidFile True alreadyrunning) pidfile
+ maybe noop (lockPidFile alreadyrunning) pidfile
when changedirectory $
setCurrentDirectory "/"
nullfd <- openFd "/dev/null" ReadOnly Nothing defaultFileFlags
@@ -42,31 +42,44 @@ daemonize logfd pidfile changedirectory a = do
alreadyrunning = error "Daemon is already running."
out = exitImmediately ExitSuccess
-lockPidFile :: Bool -> IO () -> FilePath -> IO ()
-lockPidFile write onfailure file = do
- fd <- openFd file ReadWrite (Just stdFileMode)
- defaultFileFlags { trunc = write }
- locked <- catchMaybeIO $ setLock fd (locktype, AbsoluteSeek, 0, 0)
- case locked of
- Nothing -> onfailure
- _ -> when write $ void $
- fdWrite fd =<< show <$> getProcessID
+{- Locks the pid file, with an exclusive, non-blocking lock.
+ - Runs an action on failure. On success, writes the pid to the file,
+ - fully atomically. -}
+lockPidFile :: IO () -> FilePath -> IO ()
+lockPidFile onfailure file = do
+ fd <- openFd file ReadWrite (Just stdFileMode) defaultFileFlags
+ locked <- catchMaybeIO $ setLock fd (WriteLock, AbsoluteSeek, 0, 0)
+ fd' <- openFd newfile ReadWrite (Just stdFileMode) defaultFileFlags
+ { trunc = True }
+ locked' <- catchMaybeIO $ setLock fd' (WriteLock, AbsoluteSeek, 0, 0)
+ case (locked, locked') of
+ (Nothing, _) -> onfailure
+ (_, Nothing) -> onfailure
+ _ -> do
+ _ <- fdWrite fd' =<< show <$> getProcessID
+ renameFile newfile file
+ closeFd fd
where
- locktype
- | write = WriteLock
- | otherwise = ReadLock
+ newfile = file ++ ".new"
{- Stops the daemon.
-
- The pid file is used to get the daemon's pid.
-
- - To guard against a stale pid, try to take a nonblocking shared lock
- - of the pid file. If this *fails*, the daemon must be running,
- - and have the exclusive lock, so the pid file is trustworthy.
+ - To guard against a stale pid, check the lock of the pid file,
+ - and compare the process that has it locked with the file content.
-}
stopDaemon :: FilePath -> IO ()
-stopDaemon pidfile = lockPidFile False go pidfile
- where
- go = do
- pid <- readish <$> readFile pidfile
- maybe noop (signalProcess sigTERM) pid
+stopDaemon pidfile = do
+ fd <- openFd pidfile ReadOnly (Just stdFileMode) defaultFileFlags
+ locked <- getLock fd (ReadLock, AbsoluteSeek, 0, 0)
+ p <- readish <$> readFile pidfile
+ case (locked, p) of
+ (Nothing, _) -> noop
+ (_, Nothing) -> noop
+ (Just (pid, _), Just pid')
+ | pid == pid' -> signalProcess sigTERM pid
+ | otherwise -> error $
+ "stale pid in " ++ pidfile ++
+ " (got " ++ show pid' ++
+ "; expected" ++ show pid ++ " )"
diff --git a/Utility/Directory.hs b/Utility/Directory.hs
index 2f2960a9d..057da6087 100644
--- a/Utility/Directory.hs
+++ b/Utility/Directory.hs
@@ -35,14 +35,15 @@ dirContents :: FilePath -> IO [FilePath]
dirContents d = map (d </>) . filter (not . dirCruft) <$> getDirectoryContents d
{- Gets files in a directory, and then its subdirectories, recursively,
- - and lazily. -}
+ - and lazily. If the directory does not exist, no exception is thrown,
+ - instead, [] is returned. -}
dirContentsRecursive :: FilePath -> IO [FilePath]
dirContentsRecursive topdir = dirContentsRecursive' topdir [""]
dirContentsRecursive' :: FilePath -> [FilePath] -> IO [FilePath]
dirContentsRecursive' _ [] = return []
dirContentsRecursive' topdir (dir:dirs) = unsafeInterleaveIO $ do
- (files, dirs') <- collect [] [] =<< dirContents (topdir </> dir)
+ (files, dirs') <- collect [] [] =<< catchDefaultIO (dirContents (topdir </> dir)) []
files' <- dirContentsRecursive' topdir (dirs' ++ dirs)
return (files ++ files')
where
diff --git a/Utility/Misc.hs b/Utility/Misc.hs
index 3ac5ca5c0..3b359139b 100644
--- a/Utility/Misc.hs
+++ b/Utility/Misc.hs
@@ -35,3 +35,13 @@ separate c l = unbreak $ break c l
{- Breaks out the first line. -}
firstLine :: String-> String
firstLine = takeWhile (/= '\n')
+
+{- Splits a list into segments that are delimited by items matching
+ - a predicate. (The delimiters are not included in the segments.) -}
+segment :: (a -> Bool) -> [a] -> [[a]]
+segment p l = map reverse $ go [] [] l
+ where
+ go c r [] = reverse $ c:r
+ go c r (i:is)
+ | p i = go [] (c:r) is
+ | otherwise = go (i:c) r is
diff --git a/Utility/RsyncFile.hs b/Utility/RsyncFile.hs
index db9057843..075e91d23 100644
--- a/Utility/RsyncFile.hs
+++ b/Utility/RsyncFile.hs
@@ -22,9 +22,9 @@ rsyncShell command = [Param "-e", Param $ unwords $ map escape (toCommand comman
- string is a single quote. -}
escape s = "'" ++ join "''" (split "'" s) ++ "'"
-{- Runs rsync in server mode to send a file, and exits. -}
-rsyncServerSend :: FilePath -> IO ()
-rsyncServerSend file = rsyncExec $
+{- Runs rsync in server mode to send a file. -}
+rsyncServerSend :: FilePath -> IO Bool
+rsyncServerSend file = rsync $
rsyncServerParams ++ [Param "--sender", File file]
{- Runs rsync in server mode to receive a file. -}
@@ -47,11 +47,8 @@ rsyncServerParams =
rsync :: [CommandParam] -> IO Bool
rsync = boolSystem "rsync"
-rsyncExec :: [CommandParam] -> IO ()
-rsyncExec params = executeFile "rsync" True (toCommand params) Nothing
-
{- Checks if an rsync url involves the remote shell (ssh or rsh).
- - Use of such urls with rsync or rsyncExec requires additional shell
+ - Use of such urls with rsync requires additional shell
- escaping. -}
rsyncUrlIsShell :: String -> Bool
rsyncUrlIsShell s
diff --git a/debian/changelog b/debian/changelog
index c279614ca..33c850861 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -3,6 +3,7 @@ git-annex (3.20120630) UNRELEASED; urgency=low
* get, move, copy: Now refuse to do anything when the requested file
transfer is already in progress by another process.
* status: Lists transfers that are currently in progress.
+ * Fix passing --uuid to git-annex-shell.
-- Joey Hess <joeyh@debian.org> Sun, 01 Jul 2012 15:04:37 -0400
diff --git a/doc/design/assistant/syncing.mdwn b/doc/design/assistant/syncing.mdwn
index 5476b56f1..e3fdca316 100644
--- a/doc/design/assistant/syncing.mdwn
+++ b/doc/design/assistant/syncing.mdwn
@@ -7,8 +7,7 @@ all the other git clones, at both the git level and the key/value level.
**done**
* locking for the files, so redundant transfer races can be detected,
and failed transfers noticed **done**
-* transfer info for git-annex-shell (problem: how to add a switch
- with the necessary info w/o breaking backwards compatability?)
+* transfer info for git-annex-shell **done**
* update files as transfers proceed. See [[progressbars]]
(updating for downloads is easy; for uploads is hard)
* add Transfer queue TChan
diff --git a/doc/git-annex-shell.mdwn b/doc/git-annex-shell.mdwn
index 00c68ff3a..20a9d3d37 100644
--- a/doc/git-annex-shell.mdwn
+++ b/doc/git-annex-shell.mdwn
@@ -61,6 +61,14 @@ to git-annex-shell are:
git-annex uses this to specify the UUID of the repository it was expecting
git-annex-shell to access, as a sanity check.
+* -- fields=val fields=val.. --
+
+ Additional fields may be specified this way, to retain compatability with
+ past versions of git-annex-shell (that ignore these, but would choke
+ on new dashed options).
+
+ Currently used fields include remoteuuid= and associatedfile=
+
# HOOK
After content is received or dropped from the repository by git-annex-shell,
diff --git a/doc/install/Fedora.mdwn b/doc/install/Fedora.mdwn
index 50f1d7818..8aacbb3b0 100644
--- a/doc/install/Fedora.mdwn
+++ b/doc/install/Fedora.mdwn
@@ -15,4 +15,6 @@ cabal install --bindir=$HOME/bin
Note: You can't just use `cabal install git-annex`, because Fedora does
not yet ship ghc 7.4.
-[Status of getting a Fedora package](https://bugzilla.redhat.com/show_bug.cgi?id=662259)
+* [Status of getting a Fedora package](https://bugzilla.redhat.com/show_bug.cgi?id=662259)a
+* [Koji build for F17](http://koji.fedoraproject.org/koji/buildinfo?buildID=328654)
+* [Koji build for F16](http://koji.fedoraproject.org/koji/buildinfo?buildID=328656)
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-04 17:11:00 +0000