summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Assistant/MakeRemote.hs41
-rw-r--r--Git/Construct.hs50
-rw-r--r--Git/Remote.hs59
-rw-r--r--Logs/Transfer.hs2
-rw-r--r--Logs/Transitions.hs5
-rw-r--r--Remote/Directory.hs9
-rw-r--r--Remote/GCrypt.hs13
-rw-r--r--Remote/Git.hs10
-rw-r--r--Remote/Glacier.hs8
-rw-r--r--Remote/Helper/Chunked.hs8
-rw-r--r--Remote/Helper/Hooks.hs6
-rw-r--r--Remote/Helper/Ssh.hs8
-rw-r--r--Remote/Hook.hs2
-rw-r--r--Remote/List.hs2
-rw-r--r--Remote/Rsync.hs4
-rw-r--r--Remote/WebDAV.hs6
-rw-r--r--Types/StandardGroups.hs2
-rw-r--r--Upgrade/V1.hs2
-rw-r--r--debian/changelog1
-rw-r--r--doc/assistant/rsync.net.encryption.pngbin0 -> 40504 bytes
-rw-r--r--doc/devblog/day_22__gcrypt_on_rsync.net.mdwn20
21 files changed, 157 insertions, 101 deletions
diff --git a/Assistant/MakeRemote.hs b/Assistant/MakeRemote.hs
index 4b0a4c7d9..8a93e359b 100644
--- a/Assistant/MakeRemote.hs
+++ b/Assistant/MakeRemote.hs
@@ -14,6 +14,7 @@ import qualified Types.Remote as R
import qualified Remote
import Remote.List
import qualified Remote.Rsync as Rsync
+import qualified Remote.GCrypt as GCrypt
import qualified Git
import qualified Git.Command
import qualified Command.InitRemote
@@ -23,6 +24,8 @@ import Git.Remote
import Config
import Config.Cost
import Creds
+import Assistant.Gpg
+import Utility.Gpg (KeyId)
import qualified Data.Text as T
import qualified Data.Map as M
@@ -31,7 +34,8 @@ import qualified Data.Map as M
makeSshRemote :: Bool -> SshData -> Maybe Cost -> Assistant Remote
makeSshRemote forcersync sshdata mcost = do
r <- liftAnnex $
- addRemote $ maker (sshRepoName sshdata) sshurl
+ addRemote $ maker (sshRepoName sshdata)
+ (sshUrl forcersync sshdata)
liftAnnex $ maybe noop (setRemoteCost r) mcost
syncRemote r
return r
@@ -40,17 +44,20 @@ makeSshRemote forcersync sshdata mcost = do
maker
| rsync = makeRsyncRemote
| otherwise = makeGitRemote
- sshurl = T.unpack $ T.concat $
- if rsync
- then [u, h, T.pack ":", sshDirectory sshdata, T.pack "/"]
- else [T.pack "ssh://", u, h, d, T.pack "/"]
- where
- u = maybe (T.pack "") (\v -> T.concat [v, T.pack "@"]) $ sshUserName sshdata
- h = sshHostName sshdata
- d
- | T.pack "/" `T.isPrefixOf` sshDirectory sshdata = sshDirectory sshdata
- | T.pack "~/" `T.isPrefixOf` sshDirectory sshdata = T.concat [T.pack "/", sshDirectory sshdata]
- | otherwise = T.concat [T.pack "/~/", sshDirectory sshdata]
+
+{- Generates a ssh or rsync url from a SshData. -}
+sshUrl :: Bool -> SshData -> String
+sshUrl forcersync sshdata = T.unpack $ T.concat $
+ if (forcersync || rsyncOnly sshdata)
+ then [u, h, T.pack ":", sshDirectory sshdata, T.pack "/"]
+ else [T.pack "ssh://", u, h, d, T.pack "/"]
+ where
+ u = maybe (T.pack "") (\v -> T.concat [v, T.pack "@"]) $ sshUserName sshdata
+ h = sshHostName sshdata
+ d
+ | T.pack "/" `T.isPrefixOf` sshDirectory sshdata = sshDirectory sshdata
+ | T.pack "~/" `T.isPrefixOf` sshDirectory sshdata = T.concat [T.pack "/", sshDirectory sshdata]
+ | otherwise = T.concat [T.pack "/~/", sshDirectory sshdata]
{- Runs an action that returns a name of the remote, and finishes adding it. -}
addRemote :: Annex RemoteName -> Annex Remote
@@ -74,6 +81,16 @@ makeRsyncRemote name location = makeRemote name location $ const $ void $
, ("type", "rsync")
]
+{- Inits a gcrypt special remote, and returns its name. -}
+makeGCryptRemote :: RemoteName -> String -> KeyId -> Annex RemoteName
+makeGCryptRemote remotename location keyid =
+ initSpecialRemote remotename GCrypt.remote $ M.fromList
+ [ ("type", "gcrypt")
+ , ("gitrepo", location)
+ , configureEncryption HybridEncryption
+ , ("keyid", keyid)
+ ]
+
type SpecialRemoteMaker = RemoteName -> RemoteType -> R.RemoteConfig -> Annex RemoteName
{- Inits a new special remote. The name is used as a suggestion, but
diff --git a/Git/Construct.hs b/Git/Construct.hs
index 35c77e9d2..377ddeeae 100644
--- a/Git/Construct.hs
+++ b/Git/Construct.hs
@@ -23,8 +23,6 @@ module Git.Construct (
checkForRepo,
) where
-{-# LANGUAGE CPP #-}
-
#ifndef mingw32_HOST_OS
import System.Posix.User
#else
@@ -36,6 +34,7 @@ import Network.URI
import Common
import Git.Types
import Git
+import Git.Remote
import qualified Git.Url as Url
import Utility.UserInfo
@@ -143,51 +142,10 @@ remoteNamedFromKey k = remoteNamed basename
{- Constructs a new Repo for one of a Repo's remotes using a given
- location (ie, an url). -}
fromRemoteLocation :: String -> Repo -> IO Repo
-fromRemoteLocation s repo = gen $ calcloc s
+fromRemoteLocation s repo = gen $ parseRemoteLocation s repo
where
- gen v
-#ifdef mingw32_HOST_OS
- | dosstyle v = fromRemotePath (dospath v) repo
-#endif
- | scpstyle v = fromUrl $ scptourl v
- | urlstyle v = fromUrl v
- | otherwise = fromRemotePath v repo
- -- insteadof config can rewrite remote location
- calcloc l
- | null insteadofs = l
- | otherwise = replacement ++ drop (length bestvalue) l
- where
- replacement = drop (length prefix) $
- take (length bestkey - length suffix) bestkey
- (bestkey, bestvalue) = maximumBy longestvalue insteadofs
- longestvalue (_, a) (_, b) = compare b a
- insteadofs = filterconfig $ \(k, v) ->
- startswith prefix k &&
- endswith suffix k &&
- startswith v l
- filterconfig f = filter f $
- concatMap splitconfigs $ M.toList $ fullconfig repo
- splitconfigs (k, vs) = map (\v -> (k, v)) vs
- (prefix, suffix) = ("url." , ".insteadof")
- urlstyle v = isURI v || ":" `isInfixOf` v && "//" `isInfixOf` v
- -- git remotes can be written scp style -- [user@]host:dir
- -- but foo::bar is a git-remote-helper location instead
- scpstyle v = ":" `isInfixOf` v
- && not ("//" `isInfixOf` v)
- && not ("::" `isInfixOf` v)
- scptourl v = "ssh://" ++ host ++ slash dir
- where
- (host, dir) = separate (== ':') v
- slash d | d == "" = "/~/" ++ d
- | "/" `isPrefixOf` d = d
- | "~" `isPrefixOf` d = '/':d
- | otherwise = "/~/" ++ d
-#ifdef mingw32_HOST_OS
- -- git on Windows will write a path to .git/config with "drive:",
- -- which is not to be confused with a "host:"
- dosstyle = hasDrive
- dospath = fromInternalGitPath
-#endif
+ gen (RemotePath p) = fromRemotePath p repo
+ gen (RemoteUrl u) = fromUrl u
{- Constructs a Repo from the path specified in the git remotes of
- another Repo. -}
diff --git a/Git/Remote.hs b/Git/Remote.hs
index e853e53cb..3dc6d9e45 100644
--- a/Git/Remote.hs
+++ b/Git/Remote.hs
@@ -5,6 +5,8 @@
- Licensed under the GNU GPL version 3 or higher.
-}
+{-# LANGUAGE CPP #-}
+
module Git.Remote where
import Common
@@ -13,6 +15,8 @@ import qualified Git.Command
import qualified Git.BuildVersion
import Data.Char
+import qualified Data.Map as M
+import Network.URI
type RemoteName = String
@@ -48,3 +52,58 @@ remove remotename = Git.Command.run
else "remove"
, Param remotename
]
+
+data RemoteLocation = RemoteUrl String | RemotePath FilePath
+
+remoteLocationIsUrl :: RemoteLocation -> Bool
+remoteLocationIsUrl (RemoteUrl _) = True
+remoteLocationIsUrl _ = False
+
+{- Determines if a given remote location is an url, or a local
+ - path. Takes the repository's insteadOf configuration into account. -}
+parseRemoteLocation :: String -> Repo -> RemoteLocation
+parseRemoteLocation s repo = ret $ calcloc s
+ where
+ ret v
+#ifdef mingw32_HOST_OS
+ | dosstyle v = RemotePath (dospath v)
+#endif
+ | scpstyle v = RemoteUrl (scptourl v)
+ | urlstyle v = RemoteUrl v
+ | otherwise = RemotePath v
+ -- insteadof config can rewrite remote location
+ calcloc l
+ | null insteadofs = l
+ | otherwise = replacement ++ drop (length bestvalue) l
+ where
+ replacement = drop (length prefix) $
+ take (length bestkey - length suffix) bestkey
+ (bestkey, bestvalue) = maximumBy longestvalue insteadofs
+ longestvalue (_, a) (_, b) = compare b a
+ insteadofs = filterconfig $ \(k, v) ->
+ startswith prefix k &&
+ endswith suffix k &&
+ startswith v l
+ filterconfig f = filter f $
+ concatMap splitconfigs $ M.toList $ fullconfig repo
+ splitconfigs (k, vs) = map (\v -> (k, v)) vs
+ (prefix, suffix) = ("url." , ".insteadof")
+ urlstyle v = isURI v || ":" `isInfixOf` v && "//" `isInfixOf` v
+ -- git remotes can be written scp style -- [user@]host:dir
+ -- but foo::bar is a git-remote-helper location instead
+ scpstyle v = ":" `isInfixOf` v
+ && not ("//" `isInfixOf` v)
+ && not ("::" `isInfixOf` v)
+ scptourl v = "ssh://" ++ host ++ slash dir
+ where
+ (host, dir) = separate (== ':') v
+ slash d | d == "" = "/~/" ++ d
+ | "/" `isPrefixOf` d = d
+ | "~" `isPrefixOf` d = '/':d
+ | otherwise = "/~/" ++ d
+#ifdef mingw32_HOST_OS
+ -- git on Windows will write a path to .git/config with "drive:",
+ -- which is not to be confused with a "host:"
+ dosstyle = hasDrive
+ dospath = fromInternalGitPath
+#endif
diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs
index 9bde51f40..24fb940d5 100644
--- a/Logs/Transfer.hs
+++ b/Logs/Transfer.hs
@@ -265,7 +265,7 @@ getFailedTransfers u = catMaybes <$> (liftIO . getpairs =<< concat <$> findfiles
clearFailedTransfers :: UUID -> Annex [(Transfer, TransferInfo)]
clearFailedTransfers u = do
failed <- getFailedTransfers u
- mapM_ removeFailedTransfer $ map fst failed
+ mapM_ (removeFailedTransfer . fst) failed
return failed
removeFailedTransfer :: Transfer -> Annex ()
diff --git a/Logs/Transitions.hs b/Logs/Transitions.hs
index 783ce5090..6e5dc0dc9 100644
--- a/Logs/Transitions.hs
+++ b/Logs/Transitions.hs
@@ -82,6 +82,5 @@ transitionList = map transition . S.elems
{- Typically ran with Annex.Branch.change, but we can't import Annex.Branch
- here since it depends on this module. -}
recordTransitions :: (FilePath -> (String -> String) -> Annex ()) -> Transitions -> Annex ()
-recordTransitions changer t = do
- changer transitionsLog $
- showTransitions . S.union t . parseTransitionsStrictly "local"
+recordTransitions changer t = changer transitionsLog $
+ showTransitions . S.union t . parseTransitionsStrictly "local"
diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index 1c09e0e3c..a4bd22829 100644
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -12,7 +12,6 @@ module Remote.Directory (remote) where
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString as S
import qualified Data.Map as M
-import qualified Control.Exception as E
import Data.Int
import Common.Annex
@@ -109,7 +108,7 @@ withCheckedFiles check (Just _) d k a = go $ locations d k
ifM (check chunkcount)
( do
chunks <- listChunks f <$> readFile chunkcount
- ifM (all id <$> mapM check chunks)
+ ifM (and <$> mapM check chunks)
( a chunks , return False )
, go fs
)
@@ -159,7 +158,7 @@ storeSplit' :: MeterUpdate -> Int64 -> [FilePath] -> [S.ByteString] -> [FilePath
storeSplit' _ _ [] _ _ = error "ran out of dests"
storeSplit' _ _ _ [] c = return $ reverse c
storeSplit' meterupdate chunksize (d:dests) bs c = do
- bs' <- E.bracket (openFile d WriteMode) hClose $
+ bs' <- withFile d WriteMode $
feed zeroBytesProcessed chunksize bs
storeSplit' meterupdate chunksize dests bs' (d:c)
where
@@ -206,7 +205,7 @@ retrieve :: FilePath -> ChunkSize -> Key -> AssociatedFile -> FilePath -> MeterU
retrieve d chunksize k _ f p = metered (Just p) k $ \meterupdate ->
liftIO $ withStoredFiles chunksize d k $ \files ->
catchBoolIO $ do
- meteredWriteFileChunks meterupdate f files $ L.readFile
+ meteredWriteFileChunks meterupdate f files L.readFile
return True
retrieveEncrypted :: FilePath -> ChunkSize -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool
@@ -217,7 +216,7 @@ retrieveEncrypted d chunksize (cipher, enck) k f p = metered (Just p) k $ \meter
readBytes $ meteredWriteFile meterupdate f
return True
where
- feeder files h = forM_ files $ \file -> L.hPut h =<< L.readFile file
+ feeder files h = forM_ files $ L.hPut h <=< L.readFile
retrieveCheap :: FilePath -> ChunkSize -> Key -> FilePath -> Annex Bool
retrieveCheap _ (Just _) _ _ = return False -- no cheap retrieval for chunks
diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs
index 5e8102652..fe0632943 100644
--- a/Remote/GCrypt.hs
+++ b/Remote/GCrypt.hs
@@ -76,7 +76,7 @@ gen gcryptr u c gc = do
-- correctly.
resetup gcryptid r = do
let u' = genUUIDInNameSpace gCryptNameSpace gcryptid
- v <- (M.lookup u' <$> readRemoteLog)
+ v <- M.lookup u' <$> readRemoteLog
case (Git.remoteName gcryptr, v) of
(Just remotename, Just c') -> do
setGcryptEncryption c' remotename
@@ -149,8 +149,11 @@ rsyncTransport r
where
loc = Git.repoLocation r
sshtransport (host, path) = do
+ let rsyncpath = if "/~/" `isPrefixOf` path
+ then drop 3 path
+ else path
opts <- sshCachingOptions (host, Nothing) []
- return (rsyncShell $ Param "ssh" : opts, host ++ ":" ++ path, AccessShell)
+ return (rsyncShell $ Param "ssh" : opts, host ++ ":" ++ rsyncpath, AccessShell)
othertransport = return ([], loc, AccessDirect)
noCrypto :: Annex a
@@ -186,14 +189,14 @@ gCryptSetup mu c = go $ M.lookup "gitrepo" c
void $ inRepo $ Git.Command.runBool
[ Param "push"
, Param remotename
- , Param $ show $ Annex.Branch.fullname
+ , Param $ show Annex.Branch.fullname
]
g <- inRepo Git.Config.reRead
case Git.GCrypt.remoteRepoId g (Just remotename) of
Nothing -> error "unable to determine gcrypt-id of remote"
Just gcryptid -> do
let u = genUUIDInNameSpace gCryptNameSpace gcryptid
- if Just u == mu || mu == Nothing
+ if Just u == mu || isNothing mu
then do
method <- setupRepo gcryptid =<< inRepo (Git.Construct.fromRemoteLocation gitrepo)
gitConfigSpecialRemote u c' "gcrypt" (fromAccessMethod method)
@@ -246,7 +249,7 @@ setupRepo gcryptid r
ok <- liftIO $ rsync $ rsynctransport ++
[ Params "--recursive"
, Param $ tmp ++ "/"
- , Param $ rsyncurl
+ , Param rsyncurl
]
unless ok $
error "Failed to connect to remote to set it up."
diff --git a/Remote/Git.hs b/Remote/Git.hs
index 6876ec4b4..7083de667 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -209,7 +209,7 @@ tryGitConfigRead r
Nothing -> return r
Just n -> do
whenM (inRepo $ Git.Command.runBool [Param "fetch", Param "--quiet", Param n]) $
- set_ignore $ "does not have git-annex installed"
+ set_ignore "does not have git-annex installed"
return r
set_ignore msg = case Git.remoteName r of
@@ -326,7 +326,7 @@ copyFromRemote' r key file dest
: maybe [] (\f -> [(Fields.associatedFile, f)]) file
Just (cmd, params) <- Ssh.git_annex_shell (repo r) "transferinfo"
[Param $ key2file key] fields
- v <- liftIO $ (newEmptySV :: IO (MSampleVar Integer))
+ v <- liftIO (newEmptySV :: IO (MSampleVar Integer))
tid <- liftIO $ forkIO $ void $ tryIO $ do
bytes <- readSV v
p <- createProcess $
@@ -337,7 +337,7 @@ copyFromRemote' r key file dest
hClose $ stderrHandle p
let h = stdinHandle p
let send b = do
- hPutStrLn h $ show b
+ hPrint h b
hFlush h
send bytes
forever $
@@ -414,7 +414,7 @@ rsyncOrCopyFile rsyncparams src dest p =
#else
ifM (sameDeviceIds src dest) (docopy, dorsync)
where
- sameDeviceIds a b = (==) <$> (getDeviceId a) <*> (getDeviceId b)
+ sameDeviceIds a b = (==) <$> getDeviceId a <*> getDeviceId b
getDeviceId f = deviceID <$> liftIO (getFileStatus $ parentDir f)
docopy = liftIO $ bracket
(forkIO $ watchfilesize zeroBytesProcessed)
@@ -450,7 +450,7 @@ commitOnCleanup r a = go `after` a
-- Throw away stderr, since the remote may not
-- have a new enough git-annex shell to
-- support committing.
- liftIO $ catchMaybeIO $ do
+ liftIO $ catchMaybeIO $
withQuietOutput createProcessSuccess $
proc shellcmd $
toCommand shellparams
diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs
index ecdc6a656..3726c7083 100644
--- a/Remote/Glacier.hs
+++ b/Remote/Glacier.hs
@@ -98,7 +98,7 @@ store r k _f p
storeHelper r k $ streamMeteredFile src meterupdate
storeEncrypted :: Remote -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
-storeEncrypted r (cipher, enck) k p = sendAnnex k (void $ remove r enck) $ \src -> do
+storeEncrypted r (cipher, enck) k p = sendAnnex k (void $ remove r enck) $ \src ->
metered (Just p) k $ \meterupdate ->
storeHelper r enck $ \h ->
encrypt (getGpgEncParams r) cipher (feedFile src)
@@ -209,7 +209,7 @@ checkPresent r k = do
]
glacierAction :: Remote -> [CommandParam] -> Annex Bool
-glacierAction r params = runGlacier (config r) (uuid r) params
+glacierAction r = runGlacier (config r) (uuid r)
runGlacier :: RemoteConfig -> UUID -> [CommandParam] -> Annex Bool
runGlacier c u params = go =<< glacierEnv c u
@@ -222,7 +222,7 @@ glacierParams :: RemoteConfig -> [CommandParam] -> [CommandParam]
glacierParams c params = datacenter:params
where
datacenter = Param $ "--region=" ++
- (fromJust $ M.lookup "datacenter" c)
+ fromJust (M.lookup "datacenter" c)
glacierEnv :: RemoteConfig -> UUID -> Annex (Maybe [(String, String)])
glacierEnv c u = go =<< getRemoteCredPairFor "glacier" c creds
@@ -282,7 +282,7 @@ jobList r keys = go =<< glacierEnv (config r) (uuid r)
enckeys <- forM keys $ \k ->
maybe k snd <$> cipherKey (config r) k
let keymap = M.fromList $ zip enckeys keys
- let convert = catMaybes . map (`M.lookup` keymap)
+ let convert = mapMaybe (`M.lookup` keymap)
return (convert succeeded, convert failed)
parse c [] = c
diff --git a/Remote/Helper/Chunked.hs b/Remote/Helper/Chunked.hs
index 46678de70..c4cec37ea 100644
--- a/Remote/Helper/Chunked.hs
+++ b/Remote/Helper/Chunked.hs
@@ -68,7 +68,7 @@ storeChunks key tmp dest chunksize storer recorder finalizer = either onerr retu
where
go = do
stored <- storer tmpdests
- when (chunksize /= Nothing) $ do
+ when (isNothing chunksize) $ do
let chunkcount = basef ++ chunkCount
recorder chunkcount (show $ length stored)
finalizer tmp dest
@@ -79,7 +79,7 @@ storeChunks key tmp dest chunksize storer recorder finalizer = either onerr retu
basef = tmp ++ keyFile key
tmpdests
- | chunksize == Nothing = [basef]
+ | isNothing chunksize = [basef]
| otherwise = map (basef ++ ) chunkStream
{- Given a list of destinations to use, chunks the data according to the
@@ -123,5 +123,5 @@ storeChunked chunksize dests storer content = either onerr return
meteredWriteFileChunks :: MeterUpdate -> FilePath -> [v] -> (v -> IO L.ByteString) -> IO ()
meteredWriteFileChunks meterupdate dest chunks feeder =
withBinaryFile dest WriteMode $ \h ->
- forM_ chunks $ \c ->
- meteredWrite meterupdate h =<< feeder c
+ forM_ chunks $
+ meteredWrite meterupdate h <=< feeder
diff --git a/Remote/Helper/Hooks.hs b/Remote/Helper/Hooks.hs
index 7c2bf68ca..665da1e10 100644
--- a/Remote/Helper/Hooks.hs
+++ b/Remote/Helper/Hooks.hs
@@ -35,8 +35,8 @@ addHooks' r starthook stophook = r'
{ storeKey = \k f p -> wrapper $ storeKey r k f p
, retrieveKeyFile = \k f d p -> wrapper $ retrieveKeyFile r k f d p
, retrieveKeyFileCheap = \k f -> wrapper $ retrieveKeyFileCheap r k f
- , removeKey = \k -> wrapper $ removeKey r k
- , hasKey = \k -> wrapper $ hasKey r k
+ , removeKey = wrapper . removeKey r
+ , hasKey = wrapper . hasKey r
}
where
wrapper = runHooks r' starthook stophook
@@ -45,7 +45,7 @@ runHooks :: Remote -> Maybe String -> Maybe String -> Annex a -> Annex a
runHooks r starthook stophook a = do
dir <- fromRepo gitAnnexRemotesDir
let lck = dir </> remoteid ++ ".lck"
- whenM (not . any (== lck) . M.keys <$> getPool) $ do
+ whenM (notElem lck . M.keys <$> getPool) $ do
liftIO $ createDirectoryIfMissing True dir
firstrun lck
a
diff --git a/Remote/Helper/Ssh.hs b/Remote/Helper/Ssh.hs
index c71572434..82c7c3896 100644
--- a/Remote/Helper/Ssh.hs
+++ b/Remote/Helper/Ssh.hs
@@ -125,9 +125,9 @@ rsyncParamsRemote r direction key file afile = do
-- Convert the ssh command into rsync command line.
let eparam = rsyncShell (Param shellcmd:shellparams)
let o = rsyncParams r
- if direction == Download
- then return $ o ++ rsyncopts eparam dummy (File file)
- else return $ o ++ rsyncopts eparam (File file) dummy
+ return $ if direction == Download
+ then o ++ rsyncopts eparam dummy (File file)
+ else o ++ rsyncopts eparam (File file) dummy
where
rsyncopts ps source dest
| end ps == [dashdash] = ps ++ [source, dest]
@@ -143,6 +143,6 @@ rsyncParamsRemote r direction key file afile = do
-- --inplace to resume partial files
rsyncParams :: Remote -> [CommandParam]
-rsyncParams r = [Params "--progress --inplace"] ++
+rsyncParams r = Params "--progress --inplace" :
map Param (remoteAnnexRsyncOptions $ gitconfig r)
diff --git a/Remote/Hook.hs b/Remote/Hook.hs
index ba20f3566..21d02c19d 100644
--- a/Remote/Hook.hs
+++ b/Remote/Hook.hs
@@ -93,7 +93,7 @@ lookupHook hookname action = do
command <- getConfig (annexConfig hook) ""
if null command
then do
- fallback <- getConfig (annexConfig $ hookfallback) ""
+ fallback <- getConfig (annexConfig hookfallback) ""
if null fallback
then do
warning $ "missing configuration for " ++ hook ++ " or " ++ hookfallback
diff --git a/Remote/List.hs b/Remote/List.hs
index 271ee8794..d53b92912 100644
--- a/Remote/List.hs
+++ b/Remote/List.hs
@@ -80,7 +80,7 @@ remoteListRefresh = do
remoteList
{- Generates a Remote. -}
-remoteGen :: (M.Map UUID RemoteConfig) -> RemoteType -> Git.Repo -> Annex (Maybe Remote)
+remoteGen :: M.Map UUID RemoteConfig -> RemoteType -> Git.Repo -> Annex (Maybe Remote)
remoteGen m t r = do
u <- getRepoUUID r
g <- fromRepo id
diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs
index 76b786ec7..673f7661f 100644
--- a/Remote/Rsync.hs
+++ b/Remote/Rsync.hs
@@ -86,7 +86,7 @@ gen r u c gc = do
then Just $ rsyncUrl o
else Nothing
, readonly = False
- , globallyAvailable = not $ islocal
+ , globallyAvailable = not islocal
, remotetype = remote
}
@@ -262,7 +262,7 @@ rsyncRetrieve o k dest callback =
, File dest
]
-rsyncRemote :: RsyncOpts -> (Maybe MeterUpdate) -> [CommandParam] -> Annex Bool
+rsyncRemote :: RsyncOpts -> Maybe MeterUpdate -> [CommandParam] -> Annex Bool
rsyncRemote o callback params = do
showOutput -- make way for progress bar
ifM (liftIO $ (maybe rsync rsyncProgress callback) ps)
diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs
index 97a6d96f9..ef4a5ed58 100644
--- a/Remote/WebDAV.hs
+++ b/Remote/WebDAV.hs
@@ -181,9 +181,9 @@ checkPresent r k = davAction r noconn go
- or perhaps this was an intermittent error. -}
onerr url = do
v <- davUrlExists url user pass
- if v == Right True
- then return $ Left $ "failed to read " ++ url
- else return v
+ return $ if v == Right True
+ then Left $ "failed to read " ++ url
+ else v
withStoredFiles
:: Remote
diff --git a/Types/StandardGroups.hs b/Types/StandardGroups.hs
index 30b882282..2d977a357 100644
--- a/Types/StandardGroups.hs
+++ b/Types/StandardGroups.hs
@@ -77,7 +77,7 @@ preferredContent ClientGroup = lastResort $
preferredContent TransferGroup = lastResort $
"not (inallgroup=client and copies=client:2) and (" ++ preferredContent ClientGroup ++ ")"
preferredContent BackupGroup = "include=*"
-preferredContent IncrementalBackupGroup = lastResort $
+preferredContent IncrementalBackupGroup = lastResort
"include=* and (not copies=incrementalbackup:1)"
preferredContent SmallArchiveGroup = lastResort $
"(include=*/archive/* or include=archive/*) and (" ++ preferredContent FullArchiveGroup ++ ")"
diff --git a/Upgrade/V1.hs b/Upgrade/V1.hs
index 9793f04e8..688f4c571 100644
--- a/Upgrade/V1.hs
+++ b/Upgrade/V1.hs
@@ -107,7 +107,7 @@ moveLocationLogs = do
dir <- fromRepo Upgrade.V2.gitStateDir
ifM (liftIO $ doesDirectoryExist dir)
( mapMaybe oldlog2key
- <$> (liftIO $ getDirectoryContents dir)
+ <$> liftIO (getDirectoryContents dir)
, return []
)
move (l, k) = do
diff --git a/debian/changelog b/debian/changelog
index 5588923c2..7c05434e4 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -17,6 +17,7 @@ git-annex (4.20130921) UNRELEASED; urgency=low
the user running the conversion.
* add, import, assistant: Better preserve the mtime of symlinks,
when when adding content that gets deduplicated.
+ * webapp: Support storing encrypted git repositories on rsync.net.
-- Joey Hess <joeyh@debian.org> Sun, 22 Sep 2013 19:42:29 -0400
diff --git a/doc/assistant/rsync.net.encryption.png b/doc/assistant/rsync.net.encryption.png
new file mode 100644
index 000000000..ec751d10d
--- /dev/null
+++ b/doc/assistant/rsync.net.encryption.png
Binary files differ
diff --git a/doc/devblog/day_22__gcrypt_on_rsync.net.mdwn b/doc/devblog/day_22__gcrypt_on_rsync.net.mdwn
new file mode 100644
index 000000000..b827efc13
--- /dev/null
+++ b/doc/devblog/day_22__gcrypt_on_rsync.net.mdwn
@@ -0,0 +1,20 @@
+Being still a little unsure of the UI and complexity
+for configuring gcrypt on ssh servers, I thought I'd start today with the
+special case of gcrypt on rsync.net. Since rsync.net allows running some git
+commands, gcrypt can be used to make encrypted git repositories on it.
+
+Here's the UI I came up with. It's complicated a bit by needing to explain
+the tradeoffs between the rsync and gcrypt special remotes.
+
+[[!img /assistant/rsync.net.encryption.png]]
+
+This works fine, but I did not get a chance to add support for enabling
+existing gcrypt repos on rsync.net. Anyway, most of the changes to make
+this work will also make it easier to add general support for gcrypt on ssh
+servers.
+
+Also spent a while fixing a bug in git-remote-gcrypt. Oddly
+`gpg --list-keys --fast-list --fingerprint` does not show the fingerprints
+of some keys.
+
+Today's work was sponsored by Thomas Djärv.
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-02 18:35:19 +0000