diff --git a/Annex/Environment.hs b/Annex/Environment.hs index f22c5f2d49..4b8d384642 100644 --- a/Annex/Environment.hs +++ b/Annex/Environment.hs @@ -56,10 +56,12 @@ checkEnvironmentIO = #endif {- Runs an action that commits to the repository, and if it fails, - - sets user.email to a dummy value and tries the action again. -} + - sets user.email and user.name to a dummy value and tries the action again. -} ensureCommit :: Annex a -> Annex a ensureCommit a = either retry return =<< tryAnnex a where retry _ = do - setConfig (ConfigKey "user.email") =<< liftIO myUserName + name <- liftIO myUserName + setConfig (ConfigKey "user.name") name + setConfig (ConfigKey "user.email") name a diff --git a/Annex/Index.hs b/Annex/Index.hs index a1b2442fc2..af0cab45e4 100644 --- a/Annex/Index.hs +++ b/Annex/Index.hs @@ -9,6 +9,7 @@ module Annex.Index ( withIndexFile, + addGitEnv, ) where import qualified Control.Exception as E @@ -23,24 +24,30 @@ import Annex.Exception withIndexFile :: FilePath -> Annex a -> Annex a withIndexFile f a = do g <- gitRepo -#ifdef __ANDROID__ - {- This should not be necessary on Android, but there is some - - weird getEnvironment breakage. See - - https://github.com/neurocyte/ghc-android/issues/7 - - Use getEnv to get some key environment variables that - - git expects to have. -} - let keyenv = words "USER PATH GIT_EXEC_PATH HOSTNAME HOME" - let getEnvPair k = maybe Nothing (\v -> Just (k, v)) <$> getEnv k - e <- liftIO $ catMaybes <$> forM keyenv getEnvPair - let e' = ("GIT_INDEX_FILE", f):e -#else - e <- liftIO getEnvironment - let e' = addEntry "GIT_INDEX_FILE" f e -#endif - let g' = g { gitEnv = Just e' } + g' <- liftIO $ addGitEnv g "GIT_INDEX_FILE" f r <- tryAnnex $ do Annex.changeState $ \s -> s { Annex.repo = g' } a Annex.changeState $ \s -> s { Annex.repo = (Annex.repo s) { gitEnv = gitEnv g} } either E.throw return r + +addGitEnv :: Repo -> String -> String -> IO Repo +addGitEnv g var val = do + e <- maybe copyenv return (gitEnv g) + let e' = addEntry var val e + return $ g { gitEnv = Just e' } + where + copyenv = do +#ifdef __ANDROID__ + {- This should not be necessary on Android, but there is some + - weird getEnvironment breakage. See + - https://github.com/neurocyte/ghc-android/issues/7 + - Use getEnv to get some key environment variables that + - git expects to have. -} + let keyenv = words "USER PATH GIT_EXEC_PATH HOSTNAME HOME" + let getEnvPair k = maybe Nothing (\v -> Just (k, v)) <$> getEnv k + liftIO $ catMaybes <$> forM keyenv getEnvPair +#else + liftIO getEnvironment +#endif diff --git a/Annex/Init.hs b/Annex/Init.hs index 0cb41872ca..637b130ee8 100644 --- a/Annex/Init.hs +++ b/Annex/Init.hs @@ -11,6 +11,7 @@ module Annex.Init ( ensureInitialized, isInitialized, initialize, + initialize', uninitialize, probeCrippledFileSystem, ) where @@ -60,6 +61,17 @@ genDescription Nothing = do initialize :: Maybe String -> Annex () initialize mdescription = do prepUUID + initialize' + + u <- getUUID + {- This will make the first commit to git, so ensure git is set up + - properly to allow commits when running it. -} + ensureCommit $ do + Annex.Branch.create + describeUUID u =<< genDescription mdescription + +initialize' :: Annex () +initialize' = do checkFifoSupport checkCrippledFileSystem unlessM isBare $ @@ -75,12 +87,6 @@ initialize mdescription = do switchHEADBack ) createInodeSentinalFile - u <- getUUID - {- This will make the first commit to git, so ensure git is set up - - properly to allow commits when running it. -} - ensureCommit $ do - Annex.Branch.create - describeUUID u =<< genDescription mdescription uninitialize :: Annex () uninitialize = do diff --git a/Annex/Ssh.hs b/Annex/Ssh.hs index bd10a40d40..1594801217 100644 --- a/Annex/Ssh.hs +++ b/Annex/Ssh.hs @@ -1,6 +1,6 @@ {- git-annex ssh interface, with connection caching - - - Copyright 2012,2013 Joey Hess + - Copyright 2012-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -11,19 +11,29 @@ module Annex.Ssh ( sshCachingOptions, sshCacheDir, sshReadPort, + forceSshCleanup, + sshCachingEnv, + sshCachingTo, + inRepoWithSshCachingTo, + runSshCaching, ) where import qualified Data.Map as M import Data.Hash.MD5 import System.Process (cwd) +import System.Exit import Common.Annex import Annex.LockPool import qualified Build.SysConfig as SysConfig import qualified Annex +import qualified Git +import qualified Git.Url import Config +import Config.Files import Utility.Env import Types.CleanupActions +import Annex.Index (addGitEnv) #ifndef mingw32_HOST_OS import Annex.Perms #endif @@ -31,22 +41,13 @@ import Annex.Perms {- Generates parameters to ssh to a given host (or user@host) on a given - port, with connection caching. -} sshCachingOptions :: (String, Maybe Integer) -> [CommandParam] -> Annex [CommandParam] -sshCachingOptions (host, port) opts = do - Annex.addCleanup SshCachingCleanup sshCleanup - go =<< sshInfo (host, port) +sshCachingOptions (host, port) opts = go =<< sshInfo (host, port) where go (Nothing, params) = ret params go (Just socketfile, params) = do - cleanstale - liftIO $ createDirectoryIfMissing True $ parentDir socketfile - lockFile $ socket2lock socketfile + prepSocket socketfile ret params ret ps = return $ ps ++ opts ++ portParams port ++ [Param "-T"] - -- If the lock pool is empty, this is the first ssh of this - -- run. There could be stale ssh connections hanging around - -- from a previous git-annex run that was interrupted. - cleanstale = whenM (not . any isLock . M.keys <$> getPool) - sshCleanup {- Returns a filename to use for a ssh connection caching socket, and - parameters to enable ssh connection caching. -} @@ -102,28 +103,50 @@ sshCacheDir where gettmpdir = liftIO $ getEnv "GIT_ANNEX_TMP_DIR" usetmpdir tmpdir = liftIO $ catchMaybeIO $ do - createDirectoryIfMissing True tmpdir - return tmpdir + let socktmp = tmpdir "ssh" + createDirectoryIfMissing True socktmp + return socktmp portParams :: Maybe Integer -> [CommandParam] portParams Nothing = [] portParams (Just port) = [Param "-p", Param $ show port] -{- Stop any unused ssh processes. -} -sshCleanup :: Annex () -sshCleanup = go =<< sshCacheDir +{- Prepare to use a socket file. Locks a lock file to prevent + - other git-annex processes from stopping the ssh on this socket. -} +prepSocket :: FilePath -> Annex () +prepSocket socketfile = do + -- If the lock pool is empty, this is the first ssh of this + -- run. There could be stale ssh connections hanging around + -- from a previous git-annex run that was interrupted. + whenM (not . any isLock . M.keys <$> getPool) + sshCleanup + -- Cleanup at end of this run. + Annex.addCleanup SshCachingCleanup sshCleanup + + liftIO $ createDirectoryIfMissing True $ parentDir socketfile + lockFile $ socket2lock socketfile + +enumSocketFiles :: Annex [FilePath] +enumSocketFiles = go =<< sshCacheDir + where + go Nothing = return [] + go (Just dir) = liftIO $ filter (not . isLock) + <$> catchDefaultIO [] (dirContents dir) + +{- Stop any unused ssh connection caching processes. -} +sshCleanup :: Annex () +sshCleanup = mapM_ cleanup =<< enumSocketFiles where - go Nothing = noop - go (Just dir) = do - sockets <- liftIO $ filter (not . isLock) - <$> catchDefaultIO [] (dirContents dir) - forM_ sockets cleanup cleanup socketfile = do #ifndef mingw32_HOST_OS -- Drop any shared lock we have, and take an -- exclusive lock, without blocking. If the lock -- succeeds, nothing is using this ssh, and it can -- be stopped. + -- + -- After ssh is stopped cannot remove the lock file; + -- other processes may be waiting on our exclusive + -- lock to use it. let lockfile = socket2lock socketfile unlockFile lockfile mode <- annexFileMode @@ -133,24 +156,28 @@ sshCleanup = go =<< sshCacheDir setLock fd (WriteLock, AbsoluteSeek, 0, 0) case v of Left _ -> noop - Right _ -> stopssh socketfile + Right _ -> forceStopSsh socketfile liftIO $ closeFd fd #else - stopssh socketfile + forceStopSsh socketfile #endif - stopssh socketfile = do - let (dir, base) = splitFileName socketfile - let params = sshConnectionCachingParams base - -- "ssh -O stop" is noisy on stderr even with -q - void $ liftIO $ catchMaybeIO $ - withQuietOutput createProcessSuccess $ - (proc "ssh" $ toCommand $ - [ Params "-O stop" - ] ++ params ++ [Param "localhost"]) - { cwd = Just dir } - liftIO $ nukeFile socketfile - -- Cannot remove the lock file; other processes may - -- be waiting on our exclusive lock to use it. + +{- Stop all ssh connection caching processes, even when they're in use. -} +forceSshCleanup :: Annex () +forceSshCleanup = mapM_ forceStopSsh =<< enumSocketFiles + +forceStopSsh :: FilePath -> Annex () +forceStopSsh socketfile = do + let (dir, base) = splitFileName socketfile + let params = sshConnectionCachingParams base + -- "ssh -O stop" is noisy on stderr even with -q + void $ liftIO $ catchMaybeIO $ + withQuietOutput createProcessSuccess $ + (proc "ssh" $ toCommand $ + [ Params "-O stop" + ] ++ params ++ [Param "localhost"]) + { cwd = Just dir } + liftIO $ nukeFile socketfile {- This needs to be as short as possible, due to limitations on the length - of the path to a socket file. At the same time, it needs to be unique @@ -199,3 +226,50 @@ sshReadPort params = (port, reverse args) aux (p,ps) (q:rest) | "-p" `isPrefixOf` q = aux (readPort $ drop 2 q, ps) rest | otherwise = aux (p,q:ps) rest readPort p = fmap fst $ listToMaybe $ reads p + +{- When this env var is set, git-annex runs ssh with parameters + - to use the socket file that the env var contains. + - + - This is a workaround for GiT_SSH not being able to contain + - additional parameters to pass to ssh. -} +sshCachingEnv :: String +sshCachingEnv = "GIT_ANNEX_SSHCACHING" + +{- Enables ssh caching for git push/pull to a particular + - remote git repo. (Can safely be used on non-ssh remotes.) + - + - Like inRepo, the action is run with the local git repo. + - But here it's a modified version, with gitEnv to set GIT_SSH=git-annex, + - and sshCachingEnv set so that git-annex will know what socket + - file to use. -} +inRepoWithSshCachingTo :: Git.Repo -> (Git.Repo -> IO a) -> Annex a +inRepoWithSshCachingTo remote a = + liftIO . a =<< sshCachingTo remote =<< gitRepo + +{- To make any git commands be run with ssh caching enabled, + - alters the local Git.Repo's gitEnv to set GIT_SSH=git-annex, + - and set sshCachingEnv so that git-annex will know what socket + - file to use. -} +sshCachingTo :: Git.Repo -> Git.Repo -> Annex Git.Repo +sshCachingTo remote g + | not (Git.repoIsUrl remote) || Git.repoIsHttp remote = uncached + | otherwise = case Git.Url.hostuser remote of + Nothing -> uncached + Just host -> do + (msockfile, _) <- sshInfo (host, Git.Url.port remote) + case msockfile of + Nothing -> return g + Just sockfile -> do + command <- liftIO readProgramFile + prepSocket sockfile + liftIO $ do + g' <- addGitEnv g sshCachingEnv sockfile + addGitEnv g' "GIT_SSH" command + where + uncached = return g + +runSshCaching :: [String] -> String -> IO () +runSshCaching args sockfile = do + let args' = toCommand (sshConnectionCachingParams sockfile) ++ args + let p = proc "ssh" args' + exitWith =<< waitForProcess . processHandle =<< createProcess p diff --git a/Annex/UUID.hs b/Annex/UUID.hs index 4e274503bf..5ed8876891 100644 --- a/Annex/UUID.hs +++ b/Annex/UUID.hs @@ -21,6 +21,7 @@ module Annex.UUID ( gCryptNameSpace, removeRepoUUID, storeUUID, + storeUUIDIn, setUUID, ) where @@ -70,7 +71,7 @@ getRepoUUID r = do where updatecache u = do g <- gitRepo - when (g /= r) $ storeUUID cachekey u + when (g /= r) $ storeUUIDIn cachekey u cachekey = remoteConfig r "uuid" removeRepoUUID :: Annex () @@ -84,10 +85,13 @@ getUncachedUUID = toUUID . Git.Config.get key "" {- Make sure that the repo has an annex.uuid setting. -} prepUUID :: Annex () prepUUID = whenM ((==) NoUUID <$> getUUID) $ - storeUUID configkey =<< liftIO genUUID + storeUUID =<< liftIO genUUID -storeUUID :: ConfigKey -> UUID -> Annex () -storeUUID configfield = setConfig configfield . fromUUID +storeUUID :: UUID -> Annex () +storeUUID = storeUUIDIn configkey + +storeUUIDIn :: ConfigKey -> UUID -> Annex () +storeUUIDIn configfield = setConfig configfield . fromUUID {- Only sets the configkey in the Repo; does not change .git/config -} setUUID :: Git.Repo -> UUID -> IO Git.Repo diff --git a/Annex/View.hs b/Annex/View.hs index 7c187befd2..5cf21cdfec 100644 --- a/Annex/View.hs +++ b/Annex/View.hs @@ -348,7 +348,7 @@ applyView' mkviewedfile getfilemetadata view = do void clean where genviewedfiles = viewedFiles view mkviewedfile -- enables memoization - go uh hasher f (Just (k, _)) = do + go uh hasher f (Just k) = do metadata <- getCurrentMetaData k let metadata' = getfilemetadata f `unionMetaData` metadata forM_ (genviewedfiles f metadata') $ \fv -> do diff --git a/Assistant.hs b/Assistant.hs index 67398f23b8..b5caceac2d 100644 --- a/Assistant.hs +++ b/Assistant.hs @@ -21,6 +21,7 @@ import Assistant.Threads.Pusher import Assistant.Threads.Merger import Assistant.Threads.TransferWatcher import Assistant.Threads.Transferrer +import Assistant.Threads.RemoteControl import Assistant.Threads.SanityChecker import Assistant.Threads.Cronner import Assistant.Threads.ProblemFixer @@ -147,6 +148,7 @@ startDaemon assistant foreground startdelay cannotrun listenhost startbrowser = , assist $ transferWatcherThread , assist $ transferPollerThread , assist $ transfererThread + , assist $ remoteControlThread , assist $ daemonStatusThread , assist $ sanityCheckerDailyThread urlrenderer , assist $ sanityCheckerHourlyThread diff --git a/Assistant/Alert.hs b/Assistant/Alert.hs index 192952f56b..745694f59a 100644 --- a/Assistant/Alert.hs +++ b/Assistant/Alert.hs @@ -16,6 +16,7 @@ import qualified Remote import Utility.Tense import Logs.Transfer import Types.Distribution +import Git.Types (RemoteName) import Data.String import qualified Data.Text as T @@ -117,11 +118,14 @@ commitAlert :: Alert commitAlert = activityAlert Nothing [Tensed "Committing" "Committed", "changes to git"] -showRemotes :: [Remote] -> TenseChunk -showRemotes = UnTensed . T.intercalate ", " . map (T.pack . Remote.name) +showRemotes :: [RemoteName] -> TenseChunk +showRemotes = UnTensed . T.intercalate ", " . map T.pack syncAlert :: [Remote] -> Alert -syncAlert rs = baseActivityAlert +syncAlert = syncAlert' . map Remote.name + +syncAlert' :: [RemoteName] -> Alert +syncAlert' rs = baseActivityAlert { alertName = Just SyncAlert , alertHeader = Just $ tenseWords [Tensed "Syncing" "Synced", "with", showRemotes rs] @@ -130,7 +134,12 @@ syncAlert rs = baseActivityAlert } syncResultAlert :: [Remote] -> [Remote] -> Alert -syncResultAlert succeeded failed = makeAlertFiller (not $ null succeeded) $ +syncResultAlert succeeded failed = syncResultAlert' + (map Remote.name succeeded) + (map Remote.name failed) + +syncResultAlert' :: [RemoteName] -> [RemoteName] -> Alert +syncResultAlert' succeeded failed = makeAlertFiller (not $ null succeeded) $ baseActivityAlert { alertName = Just SyncAlert , alertHeader = Just $ tenseWords msg @@ -320,10 +329,10 @@ pairRequestAcknowledgedAlert who button = baseActivityAlert , alertButtons = maybeToList button } -xmppNeededAlert :: AlertButton -> Alert -xmppNeededAlert button = Alert +connectionNeededAlert :: AlertButton -> Alert +connectionNeededAlert button = Alert { alertHeader = Just "Share with friends, and keep your devices in sync across the cloud." - , alertIcon = Just TheCloud + , alertIcon = Just ConnectionIcon , alertPriority = High , alertButtons = [button] , alertClosable = True @@ -331,7 +340,7 @@ xmppNeededAlert button = Alert , alertMessageRender = renderData , alertCounter = 0 , alertBlockDisplay = True - , alertName = Just $ XMPPNeededAlert + , alertName = Just ConnectionNeededAlert , alertCombiner = Just $ dataCombiner $ \_old new -> new , alertData = [] } diff --git a/Assistant/DaemonStatus.hs b/Assistant/DaemonStatus.hs index eb842b7847..35f8fc8564 100644 --- a/Assistant/DaemonStatus.hs +++ b/Assistant/DaemonStatus.hs @@ -26,6 +26,7 @@ import Data.Time.Clock.POSIX import Data.Time import System.Locale import qualified Data.Map as M +import qualified Data.Set as S import qualified Data.Text as T getDaemonStatus :: Assistant DaemonStatus @@ -78,6 +79,15 @@ updateSyncRemotes = do M.filter $ \alert -> alertName alert /= Just CloudRepoNeededAlert +changeCurrentlyConnected :: (S.Set UUID -> S.Set UUID) -> Assistant () +changeCurrentlyConnected sm = do + modifyDaemonStatus_ $ \ds -> ds + { currentlyConnectedRemotes = sm (currentlyConnectedRemotes ds) + } + v <- currentlyConnectedRemotes <$> getDaemonStatus + debug [show v] + liftIO . sendNotification =<< syncRemotesNotifier <$> getDaemonStatus + updateScheduleLog :: Assistant () updateScheduleLog = liftIO . sendNotification =<< scheduleLogNotifier <$> getDaemonStatus diff --git a/Assistant/Install.hs b/Assistant/Install.hs index 883ca484c6..afbe5b9c09 100644 --- a/Assistant/Install.hs +++ b/Assistant/Install.hs @@ -30,8 +30,8 @@ standaloneAppBase = getEnv "GIT_ANNEX_APP_BASE" {- The standalone app does not have an installation process. - So when it's run, it needs to set up autostarting of the assistant - - daemon, as well as writing the programFile, and putting a - - git-annex-shell wrapper into ~/.ssh + - daemon, as well as writing the programFile, and putting the + - git-annex-shell and git-annex-wrapper wrapper scripts into ~/.ssh - - Note that this is done every time it's started, so if the user moves - it around, the paths this sets up won't break. @@ -59,30 +59,35 @@ ensureInstalled = go =<< standaloneAppBase #endif installAutoStart program autostartfile - {- This shim is only updated if it doesn't - - already exist with the right content. -} sshdir <- sshDir - let shim = sshdir "git-annex-shell" - let runshell var = "exec " ++ base "runshell" ++ - " git-annex-shell -c \"" ++ var ++ "\"" - let content = unlines + let runshell var = "exec " ++ base "runshell " ++ var + let rungitannexshell var = runshell $ "git-annex-shell -c \"" ++ var ++ "\"" + + installWrapper (sshdir "git-annex-shell") $ unlines [ shebang_local , "set -e" , "if [ \"x$SSH_ORIGINAL_COMMAND\" != \"x\" ]; then" - , runshell "$SSH_ORIGINAL_COMMAND" + , rungitannexshell "$SSH_ORIGINAL_COMMAND" , "else" - , runshell "$@" + , rungitannexshell "$@" , "fi" ] - - curr <- catchDefaultIO "" $ readFileStrict shim - when (curr /= content) $ do - createDirectoryIfMissing True (parentDir shim) - viaTmp writeFile shim content - modifyFileMode shim $ addModes [ownerExecuteMode] + installWrapper (sshdir "git-annex-wrapper") $ unlines + [ shebang_local + , "set -e" + , runshell "\"$@\"" + ] installNautilus program +installWrapper :: FilePath -> String -> IO () +installWrapper file content = do + curr <- catchDefaultIO "" $ readFileStrict file + when (curr /= content) $ do + createDirectoryIfMissing True (parentDir file) + viaTmp writeFile file content + modifyFileMode file $ addModes [ownerExecuteMode] + installNautilus :: FilePath -> IO () #ifdef linux_HOST_OS installNautilus program = do diff --git a/Assistant/Monad.hs b/Assistant/Monad.hs index 7c28c7f6fd..350e3d33ba 100644 --- a/Assistant/Monad.hs +++ b/Assistant/Monad.hs @@ -43,6 +43,7 @@ import Assistant.Types.RepoProblem import Assistant.Types.Buddies import Assistant.Types.NetMessager import Assistant.Types.ThreadName +import Assistant.Types.RemoteControl newtype Assistant a = Assistant { mkAssistant :: ReaderT AssistantData IO a } deriving ( @@ -68,6 +69,7 @@ data AssistantData = AssistantData , branchChangeHandle :: BranchChangeHandle , buddyList :: BuddyList , netMessager :: NetMessager + , remoteControl :: RemoteControl } newAssistantData :: ThreadState -> DaemonStatusHandle -> IO AssistantData @@ -86,6 +88,7 @@ newAssistantData st dstatus = AssistantData <*> newBranchChangeHandle <*> newBuddyList <*> newNetMessager + <*> newRemoteControl runAssistant :: AssistantData -> Assistant a -> IO a runAssistant d a = runReaderT (mkAssistant a) d diff --git a/Assistant/RemoteControl.hs b/Assistant/RemoteControl.hs new file mode 100644 index 0000000000..86d13cc567 --- /dev/null +++ b/Assistant/RemoteControl.hs @@ -0,0 +1,21 @@ +{- git-annex assistant RemoteDaemon control + - + - Copyright 2014 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Assistant.RemoteControl ( + sendRemoteControl, + RemoteDaemon.Consumed(..) +) where + +import Assistant.Common +import qualified RemoteDaemon.Types as RemoteDaemon + +import Control.Concurrent + +sendRemoteControl :: RemoteDaemon.Consumed -> Assistant () +sendRemoteControl msg = do + clicker <- getAssistant remoteControl + liftIO $ writeChan clicker msg diff --git a/Assistant/Sync.hs b/Assistant/Sync.hs index fc95419ab8..c748f6e1ac 100644 --- a/Assistant/Sync.hs +++ b/Assistant/Sync.hs @@ -15,6 +15,7 @@ import Assistant.Alert import Assistant.Alert.Utility import Assistant.DaemonStatus import Assistant.ScanRemotes +import Assistant.RemoteControl import qualified Command.Sync import Utility.Parallel import qualified Git @@ -258,6 +259,7 @@ changeSyncable Nothing enable = do changeSyncable (Just r) True = do liftAnnex $ changeSyncFlag r True syncRemote r + sendRemoteControl RELOAD changeSyncable (Just r) False = do liftAnnex $ changeSyncFlag r False updateSyncRemotes diff --git a/Assistant/Threads/NetWatcher.hs b/Assistant/Threads/NetWatcher.hs index 0b009647c1..9dd6178229 100644 --- a/Assistant/Threads/NetWatcher.hs +++ b/Assistant/Threads/NetWatcher.hs @@ -15,13 +15,13 @@ import Assistant.Sync import Utility.ThreadScheduler import qualified Types.Remote as Remote import Assistant.DaemonStatus +import Assistant.RemoteControl import Utility.NotificationBroadcaster #if WITH_DBUS import Utility.DBus import DBus.Client import DBus -import Data.Word (Word32) import Assistant.NetMessager #else #ifdef linux_HOST_OS @@ -44,8 +44,9 @@ netWatcherThread = thread noop - while (despite the local network staying up), are synced with - periodically. - - - Note that it does not call notifyNetMessagerRestart, because - - it doesn't know that the network has changed. + - Note that it does not call notifyNetMessagerRestart, or + - signal the RemoteControl, because it doesn't know that the + - network has changed. -} netWatcherFallbackThread :: NamedThread netWatcherFallbackThread = namedThread "NetWatcherFallback" $ @@ -61,16 +62,22 @@ dbusThread = do where go client = ifM (checkNetMonitor client) ( do - listenNMConnections client <~> handleconn - listenWicdConnections client <~> handleconn + callback <- asIO1 connchange + liftIO $ do + listenNMConnections client callback + listenWicdConnections client callback , do liftAnnex $ warning "No known network monitor available through dbus; falling back to polling" ) - handleconn = do + connchange False = do + debug ["detected network disconnection"] + sendRemoteControl LOSTNET + connchange True = do debug ["detected network connection"] notifyNetMessagerRestart handleConnection + sendRemoteControl RESUME onerr e _ = do liftAnnex $ warning $ "lost dbus connection; falling back to polling (" ++ show e ++ ")" @@ -95,37 +102,64 @@ checkNetMonitor client = do networkmanager = "org.freedesktop.NetworkManager" wicd = "org.wicd.daemon" -{- Listens for new NetworkManager connections. -} -listenNMConnections :: Client -> IO () -> IO () -listenNMConnections client callback = - listen client matcher $ \event -> - when (Just True == anyM activeconnection (signalBody event)) $ - callback +{- Listens for NetworkManager connections and diconnections. + - + - Connection example (once fully connected): + - [Variant {"ActivatingConnection": Variant (ObjectPath "/"), "PrimaryConnection": Variant (ObjectPath "/org/freedesktop/NetworkManager/ActiveConnection/34"), "State": Variant 70}] + - + - Disconnection example: + - [Variant {"ActiveConnections": Variant []}] + -} +listenNMConnections :: Client -> (Bool -> IO ()) -> IO () +listenNMConnections client setconnected = + listen client matcher $ \event -> mapM_ handle + (map dictionaryItems $ mapMaybe fromVariant $ signalBody event) where matcher = matchAny - { matchInterface = Just "org.freedesktop.NetworkManager.Connection.Active" + { matchInterface = Just "org.freedesktop.NetworkManager" , matchMember = Just "PropertiesChanged" } - nm_connection_activated = toVariant (2 :: Word32) - nm_state_key = toVariant ("State" :: String) - activeconnection v = do - m <- fromVariant v - vstate <- lookup nm_state_key $ dictionaryItems m - state <- fromVariant vstate - return $ state == nm_connection_activated + nm_active_connections_key = toVariant ("ActiveConnections" :: String) + nm_activatingconnection_key = toVariant ("ActivatingConnection" :: String) + noconnections = Just $ toVariant $ toVariant ([] :: [ObjectPath]) + rootconnection = Just $ toVariant $ toVariant $ objectPath_ "/" + handle m + | lookup nm_active_connections_key m == noconnections = + setconnected False + | lookup nm_activatingconnection_key m == rootconnection = + setconnected True + | otherwise = noop -{- Listens for new Wicd connections. -} -listenWicdConnections :: Client -> IO () -> IO () -listenWicdConnections client callback = - listen client matcher $ \event -> +{- Listens for Wicd connections and disconnections. + - + - Connection example: + - ConnectResultsSent: + - Variant "success" + - + - Diconnection example: + - StatusChanged + - [Variant 0, Variant [Varient ""]] + -} +listenWicdConnections :: Client -> (Bool -> IO ()) -> IO () +listenWicdConnections client setconnected = do + listen client connmatcher $ \event -> when (any (== wicd_success) (signalBody event)) $ - callback + setconnected True + listen client statusmatcher $ \event -> handle (signalBody event) where - matcher = matchAny + connmatcher = matchAny { matchInterface = Just "org.wicd.daemon" , matchMember = Just "ConnectResultsSent" } + statusmatcher = matchAny + { matchInterface = Just "org.wicd.daemon" + , matchMember = Just "StatusChanged" + } wicd_success = toVariant ("success" :: String) + wicd_disconnected = toVariant [toVariant ("" :: String)] + handle status + | any (== wicd_disconnected) status = setconnected False + | otherwise = noop #endif diff --git a/Assistant/Threads/RemoteControl.hs b/Assistant/Threads/RemoteControl.hs new file mode 100644 index 0000000000..317efe4124 --- /dev/null +++ b/Assistant/Threads/RemoteControl.hs @@ -0,0 +1,122 @@ +{- git-annex assistant communication with remotedaemon + - + - Copyright 2014 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Assistant.Threads.RemoteControl where + +import Assistant.Common +import RemoteDaemon.Types +import Config.Files +import Utility.Batch +import Utility.SimpleProtocol +import Assistant.Alert +import Assistant.Alert.Utility +import Assistant.DaemonStatus +import qualified Git +import qualified Git.Types as Git +import qualified Remote +import qualified Types.Remote as Remote + +import Control.Concurrent +import Control.Concurrent.Async +import System.Process (std_in, std_out) +import Network.URI +import qualified Data.Map as M +import qualified Data.Set as S + +remoteControlThread :: NamedThread +remoteControlThread = namedThread "RemoteControl" $ do + program <- liftIO readProgramFile + (cmd, params) <- liftIO $ toBatchCommand + (program, [Param "remotedaemon"]) + let p = proc cmd (toCommand params) + (Just toh, Just fromh, _, pid) <- liftIO $ createProcess p + { std_in = CreatePipe + , std_out = CreatePipe + } + + urimap <- liftIO . newMVar =<< liftAnnex getURIMap + + controller <- asIO $ remoteControllerThread toh + responder <- asIO $ remoteResponderThread fromh urimap + + -- run controller and responder until the remotedaemon dies + liftIO $ void $ tryNonAsync $ controller `concurrently` responder + debug ["remotedaemon exited"] + liftIO $ forceSuccessProcess p pid + +-- feed from the remoteControl channel into the remotedaemon +remoteControllerThread :: Handle -> Assistant () +remoteControllerThread toh = do + clicker <- getAssistant remoteControl + forever $ do + msg <- liftIO $ readChan clicker + debug [show msg] + liftIO $ do + hPutStrLn toh $ unwords $ formatMessage msg + hFlush toh + +-- read status messages emitted by the remotedaemon and handle them +remoteResponderThread :: Handle -> MVar (M.Map URI Remote) -> Assistant () +remoteResponderThread fromh urimap = go M.empty + where + go syncalerts = do + l <- liftIO $ hGetLine fromh + debug [l] + case parseMessage l of + Just (CONNECTED uri) -> changeconnected S.insert uri + Just (DISCONNECTED uri) -> changeconnected S.delete uri + Just (SYNCING uri) -> withr uri $ \r -> + if M.member (Remote.uuid r) syncalerts + then go syncalerts + else do + i <- addAlert $ syncAlert [r] + go (M.insert (Remote.uuid r) i syncalerts) + Just (DONESYNCING uri status) -> withr uri $ \r -> + case M.lookup (Remote.uuid r) syncalerts of + Nothing -> cont + Just i -> do + let (succeeded, failed) = if status + then ([r], []) + else ([], [r]) + updateAlertMap $ mergeAlert i $ + syncResultAlert succeeded failed + go (M.delete (Remote.uuid r) syncalerts) + Just (WARNING (RemoteURI uri) msg) -> do + void $ addAlert $ + warningAlert ("RemoteControl "++ show uri) msg + cont + Nothing -> do + debug ["protocol error from remotedaemon: ", l] + cont + where + cont = go syncalerts + withr uri = withRemote uri urimap cont + changeconnected sm uri = withr uri $ \r -> do + changeCurrentlyConnected $ sm $ Remote.uuid r + cont + +getURIMap :: Annex (M.Map URI Remote) +getURIMap = Remote.remoteMap' id (mkk . Git.location . Remote.repo) + where + mkk (Git.Url u) = Just u + mkk _ = Nothing + +withRemote + :: RemoteURI + -> MVar (M.Map URI Remote) + -> Assistant a + -> (Remote -> Assistant a) + -> Assistant a +withRemote (RemoteURI uri) remotemap noremote a = do + m <- liftIO $ readMVar remotemap + case M.lookup uri m of + Just r -> a r + Nothing -> do + {- Reload map, in case a new remote has been added. -} + m' <- liftAnnex getURIMap + void $ liftIO $ swapMVar remotemap $ m' + maybe noremote a (M.lookup uri m') diff --git a/Assistant/Threads/TransferScanner.hs b/Assistant/Threads/TransferScanner.hs index 6df9b1e183..daced8d21b 100644 --- a/Assistant/Threads/TransferScanner.hs +++ b/Assistant/Threads/TransferScanner.hs @@ -151,7 +151,7 @@ expensiveScan urlrenderer rs = unless onlyweb $ batch <~> do enqueue f (r, t) = queueTransferWhenSmall "expensive scan found missing object" (Just f) t r - findtransfers f unwanted (key, _) = do + findtransfers f unwanted key = do {- The syncable remotes may have changed since this - scan began. -} syncrs <- syncDataRemotes <$> getDaemonStatus diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs index 97ccf083e8..0ed1bd22f9 100644 --- a/Assistant/Threads/Watcher.hs +++ b/Assistant/Threads/Watcher.hs @@ -271,7 +271,7 @@ onAddSymlink :: Bool -> Handler onAddSymlink isdirect file filestatus = unlessIgnored file $ do linktarget <- liftIO (catchMaybeIO $ readSymbolicLink file) kv <- liftAnnex (Backend.lookupFile file) - onAddSymlink' linktarget (fmap fst kv) isdirect file filestatus + onAddSymlink' linktarget kv isdirect file filestatus onAddSymlink' :: Maybe String -> Maybe Key -> Bool -> Handler onAddSymlink' linktarget mk isdirect file filestatus = go mk diff --git a/Assistant/Threads/XMPPClient.hs b/Assistant/Threads/XMPPClient.hs index ab4de9257f..39b0459b7b 100644 --- a/Assistant/Threads/XMPPClient.hs +++ b/Assistant/Threads/XMPPClient.hs @@ -42,17 +42,20 @@ xmppClientThread urlrenderer = namedThread "XMPPClient" $ restartableClient . xmppClient urlrenderer =<< getAssistant id {- Runs the client, handing restart events. -} -restartableClient :: (XMPPCreds -> IO ()) -> Assistant () +restartableClient :: (XMPPCreds -> UUID -> IO ()) -> Assistant () restartableClient a = forever $ go =<< liftAnnex getXMPPCreds where go Nothing = waitNetMessagerRestart go (Just creds) = do - tid <- liftIO $ forkIO $ a creds + xmppuuid <- maybe NoUUID Remote.uuid . headMaybe + . filter Remote.isXMPPRemote . syncRemotes + <$> getDaemonStatus + tid <- liftIO $ forkIO $ a creds xmppuuid waitNetMessagerRestart liftIO $ killThread tid -xmppClient :: UrlRenderer -> AssistantData -> XMPPCreds -> IO () -xmppClient urlrenderer d creds = +xmppClient :: UrlRenderer -> AssistantData -> XMPPCreds -> UUID -> IO () +xmppClient urlrenderer d creds xmppuuid = retry (runclient creds) =<< getCurrentTime where liftAssistant = runAssistant d @@ -68,8 +71,11 @@ xmppClient urlrenderer d creds = liftAssistant $ updateBuddyList (const noBuddies) <<~ buddyList void client - liftAssistant $ modifyDaemonStatus_ $ \s -> s - { xmppClientID = Nothing } + liftAssistant $ do + modifyDaemonStatus_ $ \s -> s + { xmppClientID = Nothing } + changeCurrentlyConnected $ S.delete xmppuuid + now <- getCurrentTime if diffUTCTime now starttime > 300 then do @@ -87,6 +93,7 @@ xmppClient urlrenderer d creds = inAssistant $ do modifyDaemonStatus_ $ \s -> s { xmppClientID = Just $ xmppJID creds } + changeCurrentlyConnected $ S.insert xmppuuid debug ["connected", logJid selfjid] lasttraffic <- liftIO $ atomically . newTMVar =<< getCurrentTime diff --git a/Assistant/Types/Alert.hs b/Assistant/Types/Alert.hs index 19fe55e6e2..9fd33c7a21 100644 --- a/Assistant/Types/Alert.hs +++ b/Assistant/Types/Alert.hs @@ -26,7 +26,7 @@ data AlertName | SanityCheckFixAlert | WarningAlert String | PairAlert String - | XMPPNeededAlert + | ConnectionNeededAlert | RemoteRemovalAlert String | CloudRepoNeededAlert | SyncAlert @@ -54,7 +54,7 @@ data Alert = Alert , alertButtons :: [AlertButton] } -data AlertIcon = ActivityIcon | SyncIcon | SuccessIcon | ErrorIcon | InfoIcon | UpgradeIcon | TheCloud +data AlertIcon = ActivityIcon | SyncIcon | SuccessIcon | ErrorIcon | InfoIcon | UpgradeIcon | ConnectionIcon type AlertMap = M.Map AlertId Alert diff --git a/Assistant/Types/DaemonStatus.hs b/Assistant/Types/DaemonStatus.hs index a618c700d7..2adad2828e 100644 --- a/Assistant/Types/DaemonStatus.hs +++ b/Assistant/Types/DaemonStatus.hs @@ -52,6 +52,8 @@ data DaemonStatus = DaemonStatus , syncDataRemotes :: [Remote] -- Are we syncing to any cloud remotes? , syncingToCloudRemote :: Bool + -- Set of uuids of remotes that are currently connected. + , currentlyConnectedRemotes :: S.Set UUID -- List of uuids of remotes that we may have gotten out of sync with. , desynced :: S.Set UUID -- Pairing request that is in progress. @@ -104,6 +106,7 @@ newDaemonStatus = DaemonStatus <*> pure [] <*> pure False <*> pure S.empty + <*> pure S.empty <*> pure Nothing <*> newNotificationBroadcaster <*> newNotificationBroadcaster diff --git a/Assistant/Types/RemoteControl.hs b/Assistant/Types/RemoteControl.hs new file mode 100644 index 0000000000..523cd8b8dd --- /dev/null +++ b/Assistant/Types/RemoteControl.hs @@ -0,0 +1,16 @@ +{- git-annex assistant RemoteDaemon control + - + - Copyright 2014 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Assistant.Types.RemoteControl where + +import qualified RemoteDaemon.Types as RemoteDaemon +import Control.Concurrent + +type RemoteControl = Chan RemoteDaemon.Consumed + +newRemoteControl :: IO RemoteControl +newRemoteControl = newChan diff --git a/Assistant/WebApp/Configurators.hs b/Assistant/WebApp/Configurators.hs index 625546dfee..1978e52efc 100644 --- a/Assistant/WebApp/Configurators.hs +++ b/Assistant/WebApp/Configurators.hs @@ -39,6 +39,14 @@ makeMiscRepositories = $(widgetFile "configurators/addrepository/misc") makeCloudRepositories :: Widget makeCloudRepositories = $(widgetFile "configurators/addrepository/cloud") +makeXMPPConnection :: Widget +makeXMPPConnection = $(widgetFile "configurators/addrepository/xmppconnection") + +makeSshRepository :: Widget +makeSshRepository = $(widgetFile "configurators/addrepository/ssh") + +makeConnectionRepositories :: Widget +makeConnectionRepositories = $(widgetFile "configurators/addrepository/connection") + makeArchiveRepositories :: Widget makeArchiveRepositories = $(widgetFile "configurators/addrepository/archive") - diff --git a/Assistant/WebApp/Configurators/Delete.hs b/Assistant/WebApp/Configurators/Delete.hs index 8d72853d2e..093ccda2ba 100644 --- a/Assistant/WebApp/Configurators/Delete.hs +++ b/Assistant/WebApp/Configurators/Delete.hs @@ -39,13 +39,21 @@ notCurrentRepo uuid a = do go Nothing = error "Unknown UUID" go (Just _) = a +handleXMPPRemoval :: UUID -> Handler Html -> Handler Html +handleXMPPRemoval uuid nonxmpp = do + remote <- fromMaybe (error "unknown remote") + <$> liftAnnex (Remote.remoteFromUUID uuid) + if Remote.isXMPPRemote remote + then deletionPage $ $(widgetFile "configurators/delete/xmpp") + else nonxmpp + getDisableRepositoryR :: UUID -> Handler Html -getDisableRepositoryR uuid = notCurrentRepo uuid $ do +getDisableRepositoryR uuid = notCurrentRepo uuid $ handleXMPPRemoval uuid $ do void $ liftAssistant $ disableRemote uuid redirect DashboardR getDeleteRepositoryR :: UUID -> Handler Html -getDeleteRepositoryR uuid = notCurrentRepo uuid $ +getDeleteRepositoryR uuid = notCurrentRepo uuid $ handleXMPPRemoval uuid $ do deletionPage $ do reponame <- liftAnnex $ Remote.prettyUUID uuid $(widgetFile "configurators/delete/start") diff --git a/Assistant/WebApp/Configurators/Edit.hs b/Assistant/WebApp/Configurators/Edit.hs index f005e17792..22483dd024 100644 --- a/Assistant/WebApp/Configurators/Edit.hs +++ b/Assistant/WebApp/Configurators/Edit.hs @@ -11,11 +11,12 @@ module Assistant.WebApp.Configurators.Edit where import Assistant.WebApp.Common import Assistant.WebApp.Gpg +import Assistant.WebApp.Configurators import Assistant.DaemonStatus import Assistant.WebApp.MakeRemote (uniqueRemoteName) -import Assistant.WebApp.Configurators.XMPP (xmppNeeded) import Assistant.ScanRemotes import Assistant.Sync +import Assistant.Alert import qualified Assistant.WebApp.Configurators.AWS as AWS import qualified Assistant.WebApp.Configurators.IA as IA #ifdef WITH_S3 @@ -183,7 +184,7 @@ getEditNewCloudRepositoryR :: UUID -> Handler Html getEditNewCloudRepositoryR = postEditNewCloudRepositoryR postEditNewCloudRepositoryR :: UUID -> Handler Html -postEditNewCloudRepositoryR uuid = xmppNeeded >> editForm True (RepoUUID uuid) +postEditNewCloudRepositoryR uuid = connectionNeeded >> editForm True (RepoUUID uuid) editForm :: Bool -> RepoId -> Handler Html editForm new (RepoUUID uuid) = page "Edit repository" (Just Configuration) $ do @@ -275,3 +276,23 @@ getUpgradeRepositoryR r = go =<< liftAnnex (repoIdRemote r) liftAssistant updateSyncRemotes liftAssistant $ syncRemote rmt redirect DashboardR + +{- If there is no currently connected remote, display an alert suggesting + - to set up one. -} +connectionNeeded :: Handler () +connectionNeeded = whenM noconnection $ do + urlrender <- getUrlRender + void $ liftAssistant $ do + close <- asIO1 removeAlert + addAlert $ connectionNeededAlert $ AlertButton + { buttonLabel = "Connnect" + , buttonUrl = urlrender ConnectionNeededR + , buttonAction = Just close + , buttonPrimary = True + } + where + noconnection = S.null . currentlyConnectedRemotes <$> liftAssistant getDaemonStatus + +getConnectionNeededR :: Handler Html +getConnectionNeededR = page "Connection needed" (Just Configuration) $ do + $(widgetFile "configurators/needconnection") diff --git a/Assistant/WebApp/Configurators/Ssh.hs b/Assistant/WebApp/Configurators/Ssh.hs index 90a8c520fd..d5bde622f3 100644 --- a/Assistant/WebApp/Configurators/Ssh.hs +++ b/Assistant/WebApp/Configurators/Ssh.hs @@ -24,6 +24,7 @@ import Git.Types (RemoteName) import qualified Remote.GCrypt as GCrypt import Annex.UUID import Logs.UUID +import Assistant.RemoteControl #ifdef mingw32_HOST_OS import Utility.Tmp @@ -155,7 +156,7 @@ postEnableSshGCryptR :: UUID -> Handler Html postEnableSshGCryptR u = whenGcryptInstalled $ enableSpecialSshRemote getsshinput enableRsyncNetGCrypt enablegcrypt u where - enablegcrypt sshdata _ = prepSsh True sshdata $ \sshdata' -> + enablegcrypt sshdata _ = prepSsh False sshdata $ \sshdata' -> sshConfigurator $ checkExistingGCrypt sshdata' $ error "Expected to find an encrypted git repository, but did not." @@ -194,6 +195,16 @@ enableSpecialSshRemote getsshinput rsyncnetsetup genericsetup u = do description <- liftAnnex $ T.pack <$> prettyUUID u $(widgetFile "configurators/ssh/enable") +{- To deal with git-annex and possibly even git and rsync not being + - available in the remote server's PATH, when git-annex was installed + - from the standalone tarball etc, look for a ~/.ssh/git-annex-wrapper + - and if it's there, use it to run a command. -} +wrapCommand :: String -> String +wrapCommand cmd = "if [ -x " ++ commandWrapper ++ " ]; then " ++ commandWrapper ++ " " ++ cmd ++ "; else " ++ cmd ++ "; fi" + +commandWrapper :: String +commandWrapper = "~/.ssh/git-annex-wrapper" + {- Test if we can ssh into the server. - - Two probe attempts are made. First, try sshing in using the existing @@ -203,8 +214,11 @@ enableSpecialSshRemote getsshinput rsyncnetsetup genericsetup u = do - - Once logged into the server, probe to see if git-annex-shell, - git, and rsync are available. + - - Note that, ~/.ssh/git-annex-shell may be - present, while git-annex-shell is not in PATH. + - Also, git and rsync may not be in PATH; as long as the commandWrapper + - is present, assume it is able to be used to run them. - - Also probe to see if there is already a git repository at the location - with either an annex-uuid or a gcrypt-id set. (If not, returns NoUUID.) @@ -235,6 +249,7 @@ testServer sshinput@(SshInput { inputHostname = Just hn }) = do , checkcommand "git" , checkcommand "rsync" , checkcommand shim + , checkcommand commandWrapper , getgitconfig (T.unpack <$> inputDirectory sshinput) ] knownhost <- knownHost hn @@ -257,6 +272,8 @@ testServer sshinput@(SshInput { inputHostname = Just hn }) = do , (shim, GitAnnexShellCapable) , ("git", GitCapable) , ("rsync", RsyncCapable) + , (commandWrapper, GitCapable) + , (commandWrapper, RsyncCapable) ] u = fromMaybe NoUUID $ headMaybe $ mapMaybe finduuid $ map (separate (== '=')) $ lines s @@ -275,7 +292,7 @@ testServer sshinput@(SshInput { inputHostname = Just hn }) = do checkcommand c = "if which " ++ c ++ "; then " ++ report c ++ "; fi" token r = "git-annex-probe " ++ r - report r = "echo " ++ token r + report r = "echo " ++ shellEscape (token r) shim = "~/.ssh/git-annex-shell" getgitconfig (Just d) | not (null d) = "cd " ++ shellEscape d ++ " && git config --list" @@ -294,7 +311,8 @@ showSshErr :: String -> Handler Html showSshErr msg = sshConfigurator $ $(widgetFile "configurators/ssh/error") -{- The UUID will be NoUUID when the repository does not already exist. -} +{- The UUID will be NoUUID when the repository does not already exist, + - or was not a git-annex repository before. -} getConfirmSshR :: SshData -> UUID -> Handler Html getConfirmSshR sshdata u | u == NoUUID = handlenew @@ -328,8 +346,9 @@ getRetrySshR sshdata = do s <- liftIO $ testServer $ mkSshInput sshdata redirect $ either (const $ ConfirmSshR sshdata NoUUID) (uncurry ConfirmSshR) s +{- Making a new git repository. -} getMakeSshGitR :: SshData -> Handler Html -getMakeSshGitR sshdata = prepSsh False sshdata makeSshRepo +getMakeSshGitR sshdata = prepSsh True sshdata makeSshRepo getMakeSshRsyncR :: SshData -> Handler Html getMakeSshRsyncR sshdata = prepSsh False (rsyncOnly sshdata) makeSshRepo @@ -341,7 +360,7 @@ getMakeSshGCryptR :: SshData -> RepoKey -> Handler Html getMakeSshGCryptR sshdata NoRepoKey = whenGcryptInstalled $ withNewSecretKey $ getMakeSshGCryptR sshdata . RepoKey getMakeSshGCryptR sshdata (RepoKey keyid) = whenGcryptInstalled $ - prepSsh True sshdata $ makeGCryptRepo keyid + prepSsh False sshdata $ makeGCryptRepo keyid {- Detect if the user entered a location with an existing, known - gcrypt repository, and enable it. Otherwise, runs the action. -} @@ -373,18 +392,18 @@ combineExistingGCrypt sshdata u = do {- Sets up remote repository for ssh, or directory for rsync. -} prepSsh :: Bool -> SshData -> (SshData -> Handler Html) -> Handler Html -prepSsh newgcrypt sshdata a +prepSsh needsinit sshdata a | needsPubKey sshdata = do keypair <- liftIO genSshKeyPair sshdata' <- liftIO $ setupSshKeyPair keypair sshdata - prepSsh' newgcrypt sshdata sshdata' (Just keypair) a + prepSsh' needsinit sshdata sshdata' (Just keypair) a | sshPort sshdata /= 22 = do sshdata' <- liftIO $ setSshConfig sshdata [] - prepSsh' newgcrypt sshdata sshdata' Nothing a - | otherwise = prepSsh' newgcrypt sshdata sshdata Nothing a + prepSsh' needsinit sshdata sshdata' Nothing a + | otherwise = prepSsh' needsinit sshdata sshdata Nothing a prepSsh' :: Bool -> SshData -> SshData -> Maybe SshKeyPair -> (SshData -> Handler Html) -> Handler Html -prepSsh' newgcrypt origsshdata sshdata keypair a = sshSetup +prepSsh' needsinit origsshdata sshdata keypair a = sshSetup [ "-p", show (sshPort origsshdata) , genSshHost (sshHostName origsshdata) (sshUserName origsshdata) , remoteCommand @@ -394,8 +413,14 @@ prepSsh' newgcrypt origsshdata sshdata keypair a = sshSetup remoteCommand = shellWrap $ intercalate "&&" $ catMaybes [ Just $ "mkdir -p " ++ shellEscape remotedir , Just $ "cd " ++ shellEscape remotedir - , if rsynconly then Nothing else Just "if [ ! -d .git ]; then git init --bare --shared && git config receive.denyNonFastforwards false; fi" - , if rsynconly || newgcrypt then Nothing else Just "git annex init" + , if rsynconly then Nothing else Just $ unwords + [ "if [ ! -d .git ]; then" + , wrapCommand "git init --bare --shared" + , "&&" + , wrapCommand "git config receive.denyNonFastforwards" + , ";fi" + ] + , if needsinit then Just (wrapCommand "git annex init") else Nothing , if needsPubKey origsshdata then addAuthorizedKeysCommand (hasCapability origsshdata GitAnnexShellCapable) remotedir . sshPubKey <$> keypair else Nothing @@ -403,11 +428,21 @@ prepSsh' newgcrypt origsshdata sshdata keypair a = sshSetup rsynconly = onlyCapability origsshdata RsyncCapable makeSshRepo :: SshData -> Handler Html -makeSshRepo sshdata = setupCloudRemote TransferGroup Nothing $ - makeSshRemote sshdata +makeSshRepo sshdata + | onlyCapability sshdata RsyncCapable = setupCloudRemote TransferGroup Nothing go + | otherwise = makeSshRepoConnection go + where + go = makeSshRemote sshdata + +makeSshRepoConnection :: Annex RemoteName -> Handler Html +makeSshRepoConnection a = setupRemote postsetup TransferGroup Nothing a + where + postsetup u = do + liftAssistant $ sendRemoteControl RELOAD + redirect $ EditNewRepositoryR u makeGCryptRepo :: KeyId -> SshData -> Handler Html -makeGCryptRepo keyid sshdata = setupCloudRemote TransferGroup Nothing $ +makeGCryptRepo keyid sshdata = makeSshRepoConnection $ makeGCryptRemote (sshRepoName sshdata) (genSshUrl sshdata) keyid getAddRsyncNetR :: Handler Html diff --git a/Assistant/WebApp/Configurators/XMPP.hs b/Assistant/WebApp/Configurators/XMPP.hs index e7ba6c0736..047e86a76f 100644 --- a/Assistant/WebApp/Configurators/XMPP.hs +++ b/Assistant/WebApp/Configurators/XMPP.hs @@ -25,6 +25,9 @@ import Assistant.WebApp.RepoList import Assistant.WebApp.Configurators import Assistant.XMPP #endif +import qualified Git.Remote +import Remote.List +import Creds #ifdef WITH_XMPP import Network.Protocol.XMPP @@ -32,23 +35,6 @@ import Network import qualified Data.Text as T #endif -{- Displays an alert suggesting to configure XMPP. -} -xmppNeeded :: Handler () -#ifdef WITH_XMPP -xmppNeeded = whenM (isNothing <$> liftAnnex getXMPPCreds) $ do - urlrender <- getUrlRender - void $ liftAssistant $ do - close <- asIO1 removeAlert - addAlert $ xmppNeededAlert $ AlertButton - { buttonLabel = "Configure a Jabber account" - , buttonUrl = urlrender XMPPConfigR - , buttonAction = Just close - , buttonPrimary = True - } -#else -xmppNeeded = return () -#endif - {- When appropriate, displays an alert suggesting to configure a cloud repo - to suppliment an XMPP remote. -} checkCloudRepos :: UrlRenderer -> Remote -> Assistant () @@ -219,5 +205,22 @@ testXMPP creds = do showport (UnixSocket s) = s #endif +getDisconnectXMPPR :: Handler Html +getDisconnectXMPPR = do +#ifdef WITH_XMPP + rs <- filter Remote.isXMPPRemote . syncRemotes + <$> liftAssistant getDaemonStatus + liftAnnex $ do + mapM_ (inRepo . Git.Remote.remove . Remote.name) rs + void remoteListRefresh + removeCreds xmppCredsFile + liftAssistant $ do + updateSyncRemotes + notifyNetMessagerRestart + redirect DashboardR +#else + xmppPage $ $(widgetFile "configurators/xmpp/disabled") +#endif + xmppPage :: Widget -> Handler Html xmppPage = page "Jabber" (Just Configuration) diff --git a/Assistant/WebApp/MakeRemote.hs b/Assistant/WebApp/MakeRemote.hs index 749fbd5282..f088b34f05 100644 --- a/Assistant/WebApp/MakeRemote.hs +++ b/Assistant/WebApp/MakeRemote.hs @@ -26,12 +26,18 @@ import Utility.Yesod {- Runs an action that creates or enables a cloud remote, - and finishes setting it up, then starts syncing with it, - - and finishes by displaying the page to edit it. -} + - and finishes by displaying the page to edit it. + - + - This includes displaying the connectionNeeded nudge if appropariate. + -} setupCloudRemote :: StandardGroup -> Maybe Cost -> Annex RemoteName -> Handler a -setupCloudRemote defaultgroup mcost name = do - r <- liftAnnex $ addRemote name +setupCloudRemote = setupRemote $ redirect . EditNewCloudRepositoryR + +setupRemote :: (UUID -> Handler a) -> StandardGroup -> Maybe Cost -> Annex RemoteName -> Handler a +setupRemote postsetup defaultgroup mcost getname = do + r <- liftAnnex $ addRemote getname liftAnnex $ do setStandardGroup (Remote.uuid r) defaultgroup maybe noop (Config.setRemoteCost (Remote.repo r)) mcost liftAssistant $ syncRemote r - redirect $ EditNewCloudRepositoryR $ Remote.uuid r + postsetup $ Remote.uuid r diff --git a/Assistant/WebApp/RepoList.hs b/Assistant/WebApp/RepoList.hs index 6a93cb4b9b..1d9165976a 100644 --- a/Assistant/WebApp/RepoList.hs +++ b/Assistant/WebApp/RepoList.hs @@ -33,9 +33,10 @@ import qualified Data.Text as T import Data.Function import Control.Concurrent -type RepoList = [(RepoDesc, RepoId, Actions)] +type RepoList = [(RepoDesc, RepoId, CurrentlyConnected, Actions)] type RepoDesc = String +type CurrentlyConnected = Bool {- Actions that can be performed on a repo in the list. -} data Actions @@ -192,13 +193,19 @@ repoList reposelector where getconfig k = M.lookup k =<< M.lookup u m val iscloud r = Just (iscloud, (RepoUUID u, DisabledRepoActions $ r u)) - list l = liftAnnex $ + list l = do + cc <- currentlyConnectedRemotes <$> liftAssistant getDaemonStatus forM (nubBy ((==) `on` fst) l) $ \(repoid, actions) -> - (,,) - <$> describeRepoId repoid + (,,,) + <$> liftAnnex (describeRepoId repoid) <*> pure repoid + <*> pure (getCurrentlyConnected repoid cc) <*> pure actions +getCurrentlyConnected :: RepoId -> S.Set UUID -> CurrentlyConnected +getCurrentlyConnected (RepoUUID u) cc = S.member u cc +getCurrentlyConnected _ _ = False + getEnableSyncR :: RepoId -> Handler () getEnableSyncR = flipSync True diff --git a/Assistant/WebApp/SideBar.hs b/Assistant/WebApp/SideBar.hs index 2c33ec86fb..a8f08501dd 100644 --- a/Assistant/WebApp/SideBar.hs +++ b/Assistant/WebApp/SideBar.hs @@ -103,8 +103,7 @@ htmlIcon InfoIcon = bootstrapIcon "info-sign" htmlIcon SuccessIcon = bootstrapIcon "ok" htmlIcon ErrorIcon = bootstrapIcon "exclamation-sign" htmlIcon UpgradeIcon = bootstrapIcon "arrow-up" --- utf-8 umbrella (utf-8 cloud looks too stormy) -htmlIcon TheCloud = [whamlet|☂|] +htmlIcon ConnectionIcon = bootstrapIcon "signal" bootstrapIcon :: Text -> Widget bootstrapIcon name = [whamlet||] diff --git a/Assistant/WebApp/routes b/Assistant/WebApp/routes index 44e07c6dba..dbdaabe1ec 100644 --- a/Assistant/WebApp/routes +++ b/Assistant/WebApp/routes @@ -20,6 +20,8 @@ /config/xmpp/for/self XMPPConfigForPairSelfR GET POST /config/xmpp/for/frield XMPPConfigForPairFriendR GET POST /config/xmpp/needcloudrepo/#UUID NeedCloudRepoR GET +/config/xmpp/disconnect DisconnectXMPPR GET +/config/needconnection ConnectionNeededR GET /config/fsck ConfigFsckR GET POST /config/fsck/preferences ConfigFsckPreferencesR POST /config/upgrade/start/#GitAnnexDistribution ConfigStartUpgradeR GET diff --git a/Assistant/XMPP/Git.hs b/Assistant/XMPP/Git.hs index ab34dce1e8..36ada5c08a 100644 --- a/Assistant/XMPP/Git.hs +++ b/Assistant/XMPP/Git.hs @@ -74,7 +74,7 @@ makeXMPPGitRemote :: String -> JID -> UUID -> Assistant Bool makeXMPPGitRemote buddyname jid u = do remote <- liftAnnex $ addRemote $ makeGitRemote buddyname $ gitXMPPLocation jid - liftAnnex $ storeUUID (remoteConfig (Remote.repo remote) "uuid") u + liftAnnex $ storeUUIDIn (remoteConfig (Remote.repo remote) "uuid") u liftAnnex $ void remoteListRefresh remote' <- liftAnnex $ fromMaybe (error "failed to add remote") <$> Remote.byName (Just buddyname) diff --git a/Backend.hs b/Backend.hs index 38314687a5..dded0d0055 100644 --- a/Backend.hs +++ b/Backend.hs @@ -1,6 +1,6 @@ {- git-annex key/value backends - - - Copyright 2010,2013 Joey Hess + - Copyright 2010-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -10,6 +10,7 @@ module Backend ( orderedList, genKey, lookupFile, + getBackend, isAnnexLink, chooseBackend, lookupBackendName, @@ -74,7 +75,7 @@ genKey' (b:bs) source = do | c == '\n' = '_' | otherwise = c -{- Looks up the key and backend corresponding to an annexed file, +{- Looks up the key corresponding to an annexed file, - by examining what the file links to. - - In direct mode, there is often no link on disk, in which case @@ -82,7 +83,7 @@ genKey' (b:bs) source = do - on disk still takes precedence over what was committed to git in direct - mode. -} -lookupFile :: FilePath -> Annex (Maybe (Key, Backend)) +lookupFile :: FilePath -> Annex (Maybe Key) lookupFile file = do mkey <- isAnnexLink file case mkey of @@ -92,14 +93,15 @@ lookupFile file = do , return Nothing ) where - makeret k = let bname = keyBackendName k in - case maybeLookupBackendName bname of - Just backend -> return $ Just (k, backend) - Nothing -> do - warning $ - "skipping " ++ file ++ - " (unknown backend " ++ bname ++ ")" - return Nothing + makeret k = return $ Just k + +getBackend :: FilePath -> Key -> Annex (Maybe Backend) +getBackend file k = let bname = keyBackendName k in + case maybeLookupBackendName bname of + Just backend -> return $ Just backend + Nothing -> do + warning $ "skipping " ++ file ++ " (unknown backend " ++ bname ++ ")" + return Nothing {- Looks up the backend that should be used for a file. - That can be configured on a per-file basis in the gitattributes file. -} diff --git a/Build/Configure.hs b/Build/Configure.hs index 116a44215f..c5e3b9735e 100644 --- a/Build/Configure.hs +++ b/Build/Configure.hs @@ -7,6 +7,7 @@ import Control.Applicative import System.Environment (getArgs) import Control.Monad.IfElse import Control.Monad +import System.IO import Build.TestConfig import Build.Version @@ -62,7 +63,11 @@ shaTestCases l = map make l key = "sha" ++ show n search [] = return Nothing search (c:cmds) = do + putStr $ "(" ++ c + hFlush stdout sha <- externalSHA c n "/dev/null" + putStr $ ":" ++ show sha ++ ")" + hFlush stdout if sha == Right knowngood then return $ Just c else search cmds diff --git a/Build/DistributionUpdate.hs b/Build/DistributionUpdate.hs index a681ec2edd..3a4c550b02 100644 --- a/Build/DistributionUpdate.hs +++ b/Build/DistributionUpdate.hs @@ -1,6 +1,9 @@ {- Builds distributon info files for each git-annex release in a directory - tree, which must itself be part of a git-annex repository. Only files - - that are present have their info file created. -} + - that are present have their info file created. + - + - Also gpg signs the files. + -} import Common.Annex import Types.Distribution @@ -15,6 +18,10 @@ import Git.Command import Data.Time.Clock +-- git-annex distribution signing key (for Joey Hess) +signingKey :: String +signingKey = "89C809CB" + main = do state <- Annex.new =<< Git.Construct.fromPath =<< getRepoDir Annex.eval state makeinfos @@ -36,7 +43,7 @@ makeinfos = do v <- lookupFile f case v of Nothing -> noop - Just (k, _b) -> whenM (inAnnex k) $ do + Just k -> whenM (inAnnex k) $ do liftIO $ putStrLn f let infofile = f ++ ".info" liftIO $ writeFile infofile $ show $ GitAnnexDistribution @@ -46,7 +53,9 @@ makeinfos = do , distributionReleasedate = now , distributionUrgentUpgrade = Nothing } - void $ inRepo $ runBool [Param "add", Param infofile] + void $ inRepo $ runBool [Param "add", File infofile] + signFile infofile + signFile f void $ inRepo $ runBool [ Param "commit" , Param "-m" @@ -81,3 +90,14 @@ getRepoDir = do mkUrl :: FilePath -> FilePath -> String mkUrl basedir f = "https://downloads.kitenet.net/" ++ relPathDirToFile basedir f + +signFile :: FilePath -> Annex () +signFile f = do + void $ liftIO $ boolSystem "gpg" + [ Param "-a" + , Param $ "--default-key=" ++ signingKey + , Param "--sign" + , File f + ] + liftIO $ rename (f ++ ".asc") (f ++ ".sig") + void $ inRepo $ runBool [Param "add", File (f ++ ".sig")] diff --git a/Build/make-sdist.sh b/Build/make-sdist.sh index 9503345327..6e1ddae626 100755 --- a/Build/make-sdist.sh +++ b/Build/make-sdist.sh @@ -9,11 +9,12 @@ mkdir --parents dist/$sdist_dir find . \( -name .git -or -name dist -or -name cabal-dev \) -prune \ -or -not -name \\*.orig -not -type d -print \ -| perl -ne "print unless length >= 100 - length q{$sdist_dir}" \ -| xargs cp --parents --target-directory dist/$sdist_dir + | perl -ne "print unless length >= 100 - length q{$sdist_dir}" \ + | grep -v ':' \ + | xargs cp --parents --target-directory dist/$sdist_dir cd dist -tar -caf $sdist_dir.tar.gz $sdist_dir +tar --format=ustar -caf $sdist_dir.tar.gz $sdist_dir # Check that tarball can be unpacked by cabal. # It's picky about tar longlinks etc. diff --git a/CmdLine/GitAnnex.hs b/CmdLine/GitAnnex.hs index 9f6eb5ff09..c37e44a2db 100644 --- a/CmdLine/GitAnnex.hs +++ b/CmdLine/GitAnnex.hs @@ -1,6 +1,6 @@ {- git-annex main program - - - Copyright 2010-2013 Joey Hess + - Copyright 2010-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -12,6 +12,8 @@ module CmdLine.GitAnnex where import qualified Git.CurrentRepo import CmdLine import Command +import Utility.Env +import Annex.Ssh import qualified Command.Add import qualified Command.Unannex @@ -47,6 +49,7 @@ import qualified Command.Unlock import qualified Command.Lock import qualified Command.PreCommit import qualified Command.Find +import qualified Command.FindRef import qualified Command.Whereis import qualified Command.List import qualified Command.Log @@ -55,6 +58,7 @@ import qualified Command.Info import qualified Command.Status import qualified Command.Migrate import qualified Command.Uninit +import qualified Command.Reinit import qualified Command.NumCopies import qualified Command.Trust import qualified Command.Untrust @@ -123,6 +127,7 @@ cmds = concat , Command.Reinject.def , Command.Unannex.def , Command.Uninit.def + , Command.Reinit.def , Command.PreCommit.def , Command.NumCopies.def , Command.Trust.def @@ -154,6 +159,7 @@ cmds = concat , Command.DropUnused.def , Command.AddUnused.def , Command.Find.def + , Command.FindRef.def , Command.Whereis.def , Command.List.def , Command.Log.def @@ -193,4 +199,5 @@ run args = do #ifdef WITH_EKG _ <- forkServer "localhost" 4242 #endif - dispatch True args cmds gitAnnexOptions [] header Git.CurrentRepo.get + maybe (dispatch True args cmds gitAnnexOptions [] header Git.CurrentRepo.get) + (runSshCaching args) =<< getEnv sshCachingEnv diff --git a/CmdLine/Seek.hs b/CmdLine/Seek.hs index abbe52af85..431b2e118d 100644 --- a/CmdLine/Seek.hs +++ b/CmdLine/Seek.hs @@ -19,6 +19,8 @@ import qualified Annex import qualified Git import qualified Git.Command import qualified Git.LsFiles as LsFiles +import qualified Git.LsTree as LsTree +import Git.FilePath import qualified Limit import CmdLine.Option import CmdLine.Action @@ -49,6 +51,20 @@ withFilesNotInGit skipdotfiles a params go l = seekActions $ prepFiltered a $ return $ concat $ segmentPaths params l +withFilesInRefs :: (FilePath -> Key -> CommandStart) -> CommandSeek +withFilesInRefs a = mapM_ go + where + go r = do + matcher <- Limit.getMatcher + l <- inRepo $ LsTree.lsTree (Git.Ref r) + forM_ l $ \i -> do + let f = getTopFilePath $ LsTree.file i + v <- catKey (Git.Ref $ LsTree.sha i) (LsTree.mode i) + case v of + Nothing -> noop + Just k -> whenM (matcher $ MatchingKey k) $ + void $ commandAction $ a f k + withPathContents :: ((FilePath, FilePath) -> CommandStart) -> CommandSeek withPathContents a params = seekActions $ map a . concat <$> liftIO (mapM get params) diff --git a/CmdLine/Usage.hs b/CmdLine/Usage.hs index 1d0bba9543..6e0a1ca805 100644 --- a/CmdLine/Usage.hs +++ b/CmdLine/Usage.hs @@ -93,6 +93,8 @@ paramFormat :: String paramFormat = "FORMAT" paramFile :: String paramFile = "FILE" +paramRef :: String +paramRef = "REF" paramGroup :: String paramGroup = "GROUP" paramExpression :: String diff --git a/Command.hs b/Command.hs index 3faa4053c9..fc440f2919 100644 --- a/Command.hs +++ b/Command.hs @@ -70,11 +70,11 @@ stopUnless :: Annex Bool -> Annex (Maybe a) -> Annex (Maybe a) stopUnless c a = ifM c ( a , stop ) {- Modifies an action to only act on files that are already annexed, - - and passes the key and backend on to it. -} -whenAnnexed :: (FilePath -> (Key, Backend) -> Annex (Maybe a)) -> FilePath -> Annex (Maybe a) + - and passes the key on to it. -} +whenAnnexed :: (FilePath -> Key -> Annex (Maybe a)) -> FilePath -> Annex (Maybe a) whenAnnexed a file = ifAnnexed file (a file) (return Nothing) -ifAnnexed :: FilePath -> ((Key, Backend) -> Annex a) -> Annex a -> Annex a +ifAnnexed :: FilePath -> (Key -> Annex a) -> Annex a -> Annex a ifAnnexed file yes no = maybe no yes =<< Backend.lookupFile file isBareRepo :: Annex Bool diff --git a/Command/Add.hs b/Command/Add.hs index f9e2b33421..46a8731519 100644 --- a/Command/Add.hs +++ b/Command/Add.hs @@ -73,7 +73,7 @@ start file = ifAnnexed file addpresent add | otherwise -> do showStart "add" file next $ perform file - addpresent (key, _) = ifM isDirect + addpresent key = ifM isDirect ( ifM (goodContent key file) ( stop , add ) , fixup key ) diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index b108be5078..7ffb869973 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -96,7 +96,7 @@ performQuvi :: Bool -> URLString -> URLString -> FilePath -> CommandPerform performQuvi relaxed pageurl videourl file = ifAnnexed file addurl geturl where quviurl = setDownloader pageurl QuviDownloader - addurl (key, _backend) = next $ cleanup quviurl file key Nothing + addurl key = next $ cleanup quviurl file key Nothing geturl = next $ addUrlFileQuvi relaxed quviurl videourl file #endif @@ -130,7 +130,7 @@ perform :: Bool -> URLString -> FilePath -> CommandPerform perform relaxed url file = ifAnnexed file addurl geturl where geturl = next $ addUrlFile relaxed url file - addurl (key, _backend) + addurl key | relaxed = do setUrlPresent key url next $ return True diff --git a/Command/Copy.hs b/Command/Copy.hs index 29606061d2..ae254aae21 100644 --- a/Command/Copy.hs +++ b/Command/Copy.hs @@ -30,9 +30,9 @@ seek ps = do {- A copy is just a move that does not delete the source file. - However, --auto mode avoids unnecessary copies, and avoids getting or - sending non-preferred content. -} -start :: Maybe Remote -> Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart -start to from file (key, backend) = stopUnless shouldCopy $ - Command.Move.start to from False file (key, backend) +start :: Maybe Remote -> Maybe Remote -> FilePath -> Key -> CommandStart +start to from file key = stopUnless shouldCopy $ + Command.Move.start to from False file key where shouldCopy = checkAuto (check <||> numCopiesCheck file key (<)) check = case to of diff --git a/Command/Direct.hs b/Command/Direct.hs index 47f622a81a..9727549b63 100644 --- a/Command/Direct.hs +++ b/Command/Direct.hs @@ -47,7 +47,7 @@ perform = do void $ liftIO clean next cleanup where - go = whenAnnexed $ \f (k, _) -> do + go = whenAnnexed $ \f k -> do r <- toDirectGen k f case r of Nothing -> noop diff --git a/Command/Drop.hs b/Command/Drop.hs index 269c4c26be..4bac07a533 100644 --- a/Command/Drop.hs +++ b/Command/Drop.hs @@ -34,8 +34,8 @@ seek ps = do from <- getOptionField dropFromOption Remote.byNameWithUUID withFilesInGit (whenAnnexed $ start from) ps -start :: Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart -start from file (key, _) = checkDropAuto from file key $ \numcopies -> +start :: Maybe Remote -> FilePath -> Key -> CommandStart +start from file key = checkDropAuto from file key $ \numcopies -> stopUnless (checkAuto $ wantDrop False (Remote.uuid <$> from) (Just key) (Just file)) $ case from of Nothing -> startLocal (Just file) numcopies key Nothing @@ -78,12 +78,18 @@ performRemote :: Key -> AssociatedFile -> NumCopies -> Remote -> CommandPerform performRemote key afile numcopies remote = lockContent key $ do -- Filter the remote it's being dropped from out of the lists of -- places assumed to have the key, and places to check. - -- When the local repo has the key, that's one additional copy. + -- When the local repo has the key, that's one additional copy, + -- as long asthe local repo is not untrusted. (remotes, trusteduuids) <- Remote.keyPossibilitiesTrusted key present <- inAnnex key u <- getUUID - let have = filter (/= uuid) $ - if present then u:trusteduuids else trusteduuids + trusteduuids' <- if present + then ifM ((<= SemiTrusted) <$> lookupTrust u) + ( pure (u:trusteduuids) + , pure trusteduuids + ) + else pure trusteduuids + let have = filter (/= uuid) trusteduuids' untrusteduuids <- trustGet UnTrusted let tocheck = filter (/= remote) $ Remote.remotesWithoutUUID remotes (have++untrusteduuids) diff --git a/Command/Find.hs b/Command/Find.hs index c6a32a9449..c800933f93 100644 --- a/Command/Find.hs +++ b/Command/Find.hs @@ -19,8 +19,10 @@ import Utility.DataUnits import Types.Key def :: [Command] -def = [noCommit $ noMessages $ withOptions [formatOption, print0Option, jsonOption] $ - command "find" paramPaths seek SectionQuery "lists available files"] +def = [mkCommand $ command "find" paramPaths seek SectionQuery "lists available files"] + +mkCommand :: Command -> Command +mkCommand = noCommit . noMessages . withOptions [formatOption, print0Option, jsonOption] formatOption :: Option formatOption = fieldOption [] "format" paramFormat "control format of output" @@ -39,8 +41,8 @@ seek ps = do format <- getFormat withFilesInGit (whenAnnexed $ start format) ps -start :: Maybe Utility.Format.Format -> FilePath -> (Key, Backend) -> CommandStart -start format file (key, _) = do +start :: Maybe Utility.Format.Format -> FilePath -> Key -> CommandStart +start format file key = do -- only files inAnnex are shown, unless the user has requested -- others via a limit whenM (limited <||> inAnnex key) $ diff --git a/Command/FindRef.hs b/Command/FindRef.hs new file mode 100644 index 0000000000..26007f7c03 --- /dev/null +++ b/Command/FindRef.hs @@ -0,0 +1,20 @@ +{- git-annex command + - + - Copyright 2014 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Command.FindRef where + +import Command +import qualified Command.Find as Find + +def :: [Command] +def = [Find.mkCommand $ command "findref" paramRef seek SectionPlumbing + "lists files in a git ref"] + +seek :: CommandSeek +seek refs = do + format <- Find.getFormat + Find.start format `withFilesInRefs` refs diff --git a/Command/Fix.hs b/Command/Fix.hs index f730226e30..0c2bf59424 100644 --- a/Command/Fix.hs +++ b/Command/Fix.hs @@ -26,8 +26,8 @@ seek :: CommandSeek seek = withFilesInGit $ whenAnnexed start {- Fixes the symlink to an annexed file. -} -start :: FilePath -> (Key, Backend) -> CommandStart -start file (key, _) = do +start :: FilePath -> Key -> CommandStart +start file key = do link <- inRepo $ gitAnnexLink file key stopUnless ((/=) (Just link) <$> liftIO (catchMaybeIO $ readSymbolicLink file)) $ do showStart "fix" file diff --git a/Command/Fsck.hs b/Command/Fsck.hs index 88a9915c41..a17662d62e 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -104,12 +104,16 @@ getIncremental = do resetStartTime return True -start :: Maybe Remote -> Incremental -> FilePath -> (Key, Backend) -> CommandStart -start from inc file (key, backend) = do - numcopies <- getFileNumCopies file - case from of - Nothing -> go $ perform key file backend numcopies - Just r -> go $ performRemote key file backend numcopies r +start :: Maybe Remote -> Incremental -> FilePath -> Key -> CommandStart +start from inc file key = do + v <- Backend.getBackend file key + case v of + Nothing -> stop + Just backend -> do + numcopies <- getFileNumCopies file + case from of + Nothing -> go $ perform key file backend numcopies + Just r -> go $ performRemote key file backend numcopies r where go = runFsck inc file key diff --git a/Command/Get.hs b/Command/Get.hs index bef4667240..d0be200185 100644 --- a/Command/Get.hs +++ b/Command/Get.hs @@ -31,8 +31,8 @@ seek ps = do (withFilesInGit $ whenAnnexed $ start from) ps -start :: Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart -start from file (key, _) = start' expensivecheck from key (Just file) +start :: Maybe Remote -> FilePath -> Key -> CommandStart +start from file key = start' expensivecheck from key (Just file) where expensivecheck = checkAuto (numCopiesCheck file key (<) <||> wantGet False (Just key) (Just file)) diff --git a/Command/ImportFeed.hs b/Command/ImportFeed.hs index 6a374de1b0..29f2fb148c 100644 --- a/Command/ImportFeed.hs +++ b/Command/ImportFeed.hs @@ -194,7 +194,7 @@ performDownload relaxed cache todownload = case location todownload of in d show n ++ "_" ++ base tryanother = makeunique url (n + 1) file alreadyexists = liftIO $ isJust <$> catchMaybeIO (getSymbolicLinkStatus f) - checksameurl (k, _) = ifM (elem url <$> getUrls k) + checksameurl k = ifM (elem url <$> getUrls k) ( return Nothing , tryanother ) diff --git a/Command/Indirect.hs b/Command/Indirect.hs index c0dd57959b..acf40c974e 100644 --- a/Command/Indirect.hs +++ b/Command/Indirect.hs @@ -74,7 +74,7 @@ perform = do case r of Just s | isSymbolicLink s -> void $ flip whenAnnexed f $ - \_ (k, _) -> do + \_ k -> do removeInodeCache k removeAssociatedFiles k return Nothing diff --git a/Command/Info.hs b/Command/Info.hs index 11ed98cd9c..63bc92bbe1 100644 --- a/Command/Info.hs +++ b/Command/Info.hs @@ -70,7 +70,7 @@ data StatInfo = StatInfo type StatState = StateT StatInfo Annex def :: [Command] -def = [noCommit $ withOptions [jsonOption] $ +def = [noCommit $ dontCheck repoExists $ withOptions [jsonOption] $ command "info" paramPaths seek SectionQuery "shows general information about the annex"] diff --git a/Command/List.hs b/Command/List.hs index 1fa2064050..d038d6deb5 100644 --- a/Command/List.hs +++ b/Command/List.hs @@ -60,8 +60,8 @@ getList = ifM (Annex.getFlag $ optionName allrepos) printHeader :: [(UUID, RemoteName, TrustLevel)] -> Annex () printHeader l = liftIO $ putStrLn $ header $ map (\(_, n, t) -> (n, t)) l -start :: [(UUID, RemoteName, TrustLevel)] -> FilePath -> (Key, Backend) -> CommandStart -start l file (key, _) = do +start :: [(UUID, RemoteName, TrustLevel)] -> FilePath -> Key -> CommandStart +start l file key = do ls <- S.fromList <$> keyLocations key liftIO $ putStrLn $ format (map (\(u, _, t) -> (t, S.member u ls)) l) file stop diff --git a/Command/Log.hs b/Command/Log.hs index 84583a93a8..b0109f1179 100644 --- a/Command/Log.hs +++ b/Command/Log.hs @@ -64,9 +64,15 @@ seek ps = do Annex.getField (optionName o) use o v = [Param ("--" ++ optionName o), Param v] -start :: M.Map UUID String -> TimeZone -> [CommandParam] -> Bool -> - FilePath -> (Key, Backend) -> CommandStart -start m zone os gource file (key, _) = do +start + :: M.Map UUID String + -> TimeZone + -> [CommandParam] + -> Bool + -> FilePath + -> Key + -> CommandStart +start m zone os gource file key = do showLog output =<< readLog <$> getLog key os -- getLog produces a zombie; reap it liftIO reapZombies diff --git a/Command/MetaData.hs b/Command/MetaData.hs index d932315ab8..38f9b85228 100644 --- a/Command/MetaData.hs +++ b/Command/MetaData.hs @@ -63,8 +63,8 @@ seek ps = do (withFilesInGit (whenAnnexed $ start now getfield modmeta)) ps -start :: POSIXTime -> Maybe MetaField -> [ModMeta] -> FilePath -> (Key, Backend) -> CommandStart -start now f ms file (k, _) = start' (Just file) now f ms k +start :: POSIXTime -> Maybe MetaField -> [ModMeta] -> FilePath -> Key -> CommandStart +start now f ms file = start' (Just file) now f ms startKeys :: POSIXTime -> Maybe MetaField -> [ModMeta] -> Key -> CommandStart startKeys = start' Nothing diff --git a/Command/Migrate.hs b/Command/Migrate.hs index c14c07bddb..18e6e0748f 100644 --- a/Command/Migrate.hs +++ b/Command/Migrate.hs @@ -25,15 +25,19 @@ def = [notDirect $ seek :: CommandSeek seek = withFilesInGit $ whenAnnexed start -start :: FilePath -> (Key, Backend) -> CommandStart -start file (key, oldbackend) = do - exists <- inAnnex key - newbackend <- choosebackend =<< chooseBackend file - if (newbackend /= oldbackend || upgradableKey oldbackend key) && exists - then do - showStart "migrate" file - next $ perform file key oldbackend newbackend - else stop +start :: FilePath -> Key -> CommandStart +start file key = do + v <- Backend.getBackend file key + case v of + Nothing -> stop + Just oldbackend -> do + exists <- inAnnex key + newbackend <- choosebackend =<< chooseBackend file + if (newbackend /= oldbackend || upgradableKey oldbackend key) && exists + then do + showStart "migrate" file + next $ perform file key oldbackend newbackend + else stop where choosebackend Nothing = Prelude.head <$> orderedList choosebackend (Just backend) = return backend diff --git a/Command/Mirror.hs b/Command/Mirror.hs index 4a7a8dd991..4e9a85009a 100644 --- a/Command/Mirror.hs +++ b/Command/Mirror.hs @@ -31,8 +31,8 @@ seek ps = do (withFilesInGit $ whenAnnexed $ start to from) ps -start :: Maybe Remote -> Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart -start to from file (key, _backend) = startKey to from (Just file) key +start :: Maybe Remote -> Maybe Remote -> FilePath -> Key -> CommandStart +start to from file key = startKey to from (Just file) key startKey :: Maybe Remote -> Maybe Remote -> Maybe FilePath -> Key -> CommandStart startKey to from afile key = do diff --git a/Command/Move.hs b/Command/Move.hs index 206a875b7c..396ea4afce 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -33,8 +33,8 @@ seek ps = do (withFilesInGit $ whenAnnexed $ start to from True) ps -start :: Maybe Remote -> Maybe Remote -> Bool -> FilePath -> (Key, Backend) -> CommandStart -start to from move file (key, _) = start' to from move (Just file) key +start :: Maybe Remote -> Maybe Remote -> Bool -> FilePath -> Key -> CommandStart +start to from move file key = start' to from move (Just file) key startKey :: Maybe Remote -> Maybe Remote -> Bool -> Key -> CommandStart startKey to from move = start' to from move Nothing diff --git a/Command/ReKey.hs b/Command/ReKey.hs index 805300f9f8..2919a09e92 100644 --- a/Command/ReKey.hs +++ b/Command/ReKey.hs @@ -29,7 +29,7 @@ start :: (FilePath, String) -> CommandStart start (file, keyname) = ifAnnexed file go stop where newkey = fromMaybe (error "bad key") $ file2key keyname - go (oldkey, _) + go oldkey | oldkey == newkey = stop | otherwise = do showStart "rekey" file diff --git a/Command/Reinit.hs b/Command/Reinit.hs new file mode 100644 index 0000000000..0fc1e8314f --- /dev/null +++ b/Command/Reinit.hs @@ -0,0 +1,38 @@ +{- git-annex command + - + - Copyright 2014 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Command.Reinit where + +import Common.Annex +import Command +import Annex.Init +import Annex.UUID +import Types.UUID +import qualified Remote + +def :: [Command] +def = [dontCheck repoExists $ + command "reinit" (paramUUID ++ " or " ++ paramDesc) seek SectionUtility ""] + +seek :: CommandSeek +seek = withWords start + +start :: [String] -> CommandStart +start ws = do + showStart "reinit" s + next $ perform s + where + s = unwords ws + +perform :: String -> CommandPerform +perform s = do + u <- if isUUID s + then return $ toUUID s + else Remote.nameToUUID s + storeUUID u + initialize' + next $ return True diff --git a/Command/Reinject.hs b/Command/Reinject.hs index 1609c60974..a516fe93ce 100644 --- a/Command/Reinject.hs +++ b/Command/Reinject.hs @@ -12,6 +12,7 @@ import Command import Logs.Location import Annex.Content import qualified Command.Fsck +import qualified Backend def :: [Command] def = [command "reinject" (paramPair "SRC" "DEST") seek @@ -33,16 +34,20 @@ start (src:dest:[]) next $ whenAnnexed (perform src) dest start _ = error "specify a src file and a dest file" -perform :: FilePath -> FilePath -> (Key, Backend) -> CommandPerform -perform src _dest (key, backend) = +perform :: FilePath -> FilePath -> Key -> CommandPerform +perform src dest key = do {- Check the content before accepting it. -} - ifM (Command.Fsck.checkKeySizeOr reject key src - <&&> Command.Fsck.checkBackendOr reject backend key src) - ( do - unlessM move $ error "mv failed!" - next $ cleanup key - , error "not reinjecting" - ) + v <- Backend.getBackend dest key + case v of + Nothing -> stop + Just backend -> + ifM (Command.Fsck.checkKeySizeOr reject key src + <&&> Command.Fsck.checkBackendOr reject backend key src) + ( do + unlessM move $ error "mv failed!" + next $ cleanup key + , error "not reinjecting" + ) where -- the file might be on a different filesystem, -- so mv is used rather than simply calling diff --git a/Command/RmUrl.hs b/Command/RmUrl.hs index 3f304b76ed..e961575a3a 100644 --- a/Command/RmUrl.hs +++ b/Command/RmUrl.hs @@ -20,7 +20,7 @@ seek :: CommandSeek seek = withPairs start start :: (FilePath, String) -> CommandStart -start (file, url) = flip whenAnnexed file $ \_ (key, _) -> do +start (file, url) = flip whenAnnexed file $ \_ key -> do showStart "rmurl" file next $ next $ cleanup url key diff --git a/Command/Sync.hs b/Command/Sync.hs index a4004736a2..a5d6d46f1d 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -21,7 +21,6 @@ import qualified Git.LsFiles as LsFiles import qualified Git.Branch import qualified Git.Ref import qualified Git -import qualified Types.Remote import qualified Remote.Git import Config import Annex.Wanted @@ -32,6 +31,7 @@ import Logs.Location import Annex.Drop import Annex.UUID import Annex.AutoMerge +import Annex.Ssh import Control.Concurrent.MVar @@ -113,11 +113,11 @@ syncRemotes rs = ifM (Annex.getState Annex.fast) ( nub <$> pickfast , wanted ) | null rs = filterM good =<< concat . Remote.byCost <$> available | otherwise = listed listed = catMaybes <$> mapM (Remote.byName . Just) rs - available = filter (remoteAnnexSync . Types.Remote.gitconfig) + available = filter (remoteAnnexSync . Remote.gitconfig) . filter (not . Remote.isXMPPRemote) <$> Remote.remoteList good r - | Remote.gitSyncableRemote r = Remote.Git.repoAvail $ Types.Remote.repo r + | Remote.gitSyncableRemote r = Remote.Git.repoAvail $ Remote.repo r | otherwise = return True fastest = fromMaybe [] . headMaybe . Remote.byCost @@ -201,7 +201,7 @@ pullRemote remote branch = do stopUnless fetch $ next $ mergeRemote remote branch where - fetch = inRepo $ Git.Command.runBool + fetch = inRepoWithSshCachingTo (Remote.repo remote) $ Git.Command.runBool [Param "fetch", Param $ Remote.name remote] {- The remote probably has both a master and a synced/master branch. @@ -227,14 +227,15 @@ pushRemote _remote Nothing = stop pushRemote remote (Just branch) = go =<< needpush where needpush - | remoteAnnexReadOnly (Types.Remote.gitconfig remote) = return False + | remoteAnnexReadOnly (Remote.gitconfig remote) = return False | otherwise = anyM (newer remote) [syncBranch branch, Annex.Branch.name] go False = stop go True = do showStart "push" (Remote.name remote) next $ next $ do showOutput - ok <- inRepo $ pushBranch remote branch + ok <- inRepoWithSshCachingTo (Remote.repo remote) $ + pushBranch remote branch unless ok $ do warning $ unwords [ "Pushing to " ++ Remote.name remote ++ " failed." ] showLongNote "(non-fast-forward problems can be solved by setting receive.denyNonFastforwards to false in the remote's git config)" @@ -337,8 +338,8 @@ seekSyncContent rs = do (\v -> void (liftIO (tryPutMVar mvar ())) >> syncFile rs f v) noop -syncFile :: [Remote] -> FilePath -> (Key, Backend) -> Annex () -syncFile rs f (k, _) = do +syncFile :: [Remote] -> FilePath -> Key -> Annex () +syncFile rs f k = do locs <- loggedLocations k let (have, lack) = partition (\r -> Remote.uuid r `elem` locs) rs @@ -367,7 +368,7 @@ syncFile rs f (k, _) = do next $ next $ getViaTmp k $ \dest -> getKeyFile' k (Just f) dest have wantput r - | Remote.readonly r || remoteAnnexReadOnly (Types.Remote.gitconfig r) = return False + | Remote.readonly r || remoteAnnexReadOnly (Remote.gitconfig r) = return False | otherwise = wantSend True (Just k) (Just f) (Remote.uuid r) handleput lack = ifM (inAnnex k) ( map put <$> filterM wantput lack diff --git a/Command/Unannex.hs b/Command/Unannex.hs index 3da7c2a411..daa14ce855 100644 --- a/Command/Unannex.hs +++ b/Command/Unannex.hs @@ -58,8 +58,8 @@ wrapUnannex a = ifM isDirect then void (liftIO cleanup) >> return True else void (liftIO cleanup) >> return False -start :: FilePath -> (Key, Backend) -> CommandStart -start file (key, _) = stopUnless (inAnnex key) $ do +start :: FilePath -> Key -> CommandStart +start file key = stopUnless (inAnnex key) $ do showStart "unannex" file next $ ifM isDirect ( performDirect file key @@ -75,7 +75,16 @@ cleanupIndirect :: FilePath -> Key -> CommandCleanup cleanupIndirect file key = do src <- calcRepo $ gitAnnexLocation key ifM (Annex.getState Annex.fast) - ( hardlinkfrom src + ( do + -- Only make a hard link if the annexed file does not + -- already have other hard links pointing at it. + -- This avoids unannexing (and uninit) ending up + -- hard linking files together, which would be + -- surprising. + s <- liftIO $ getFileStatus src + if linkCount s > 1 + then copyfrom src + else hardlinkfrom src , copyfrom src ) where diff --git a/Command/Uninit.hs b/Command/Uninit.hs index 5b2adf0bd1..0f06281561 100644 --- a/Command/Uninit.hs +++ b/Command/Uninit.hs @@ -8,6 +8,7 @@ module Command.Uninit where import Common.Annex +import qualified Annex import Command import qualified Git import qualified Git.Command @@ -37,12 +38,13 @@ check = do seek :: CommandSeek seek ps = do withFilesNotInGit False (whenAnnexed startCheckIncomplete) ps + Annex.changeState $ \s -> s { Annex.fast = True } withFilesInGit (whenAnnexed Command.Unannex.start) ps finish {- git annex symlinks that are not checked into git could be left by an - interrupted add. -} -startCheckIncomplete :: FilePath -> (Key, Backend) -> CommandStart +startCheckIncomplete :: FilePath -> Key -> CommandStart startCheckIncomplete file _ = error $ unlines [ file ++ " points to annexed content, but is not checked into git." , "Perhaps this was left behind by an interrupted git annex add?" diff --git a/Command/Unlock.hs b/Command/Unlock.hs index 4cfe393074..0070410a67 100644 --- a/Command/Unlock.hs +++ b/Command/Unlock.hs @@ -25,8 +25,8 @@ seek = withFilesInGit $ whenAnnexed start {- The unlock subcommand replaces the symlink with a copy of the file's - content. -} -start :: FilePath -> (Key, Backend) -> CommandStart -start file (key, _) = do +start :: FilePath -> Key -> CommandStart +start file key = do showStart "unlock" file next $ perform file key diff --git a/Command/Unused.hs b/Command/Unused.hs index 3e844e5a8b..5815bbf298 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -250,7 +250,7 @@ withKeysReferenced' mdir initial a = do x <- Backend.lookupFile f case x of Nothing -> go v fs - Just (k, _) -> do + Just k -> do !v' <- a k f v go v' fs @@ -294,7 +294,7 @@ withKeysReferencedInGitRef a ref = do forM_ ts $ tKey lookAtWorkingTree >=> maybe noop a liftIO $ void clean where - tKey True = fmap fst <$$> Backend.lookupFile . getTopFilePath . DiffTree.file + tKey True = Backend.lookupFile . getTopFilePath . DiffTree.file tKey False = fileKey . takeFileName . decodeBS <$$> catFile ref . getTopFilePath . DiffTree.file diff --git a/Command/WebApp.hs b/Command/WebApp.hs index 91c9afcd0f..5256e8bb81 100644 --- a/Command/WebApp.hs +++ b/Command/WebApp.hs @@ -65,7 +65,7 @@ start' allowauto listenhost = do stop where go = do - cannotrun <- needsUpgrade . fromMaybe (error "no version") =<< getVersion + cannotrun <- needsUpgrade . fromMaybe (error "annex.version is not set.. seems this repository has not been initialized by git-annex") =<< getVersion browser <- fromRepo webBrowser f <- liftIO . absPath =<< fromRepo gitAnnexHtmlShim listenhost' <- if isJust listenhost @@ -98,7 +98,7 @@ start' allowauto listenhost = do checkshim f = liftIO $ doesFileExist f {- When run without a repo, start the first available listed repository in - - the autostart file. If not, it's our first time being run! -} + - the autostart file. If none, it's our first time being run! -} startNoRepo :: CmdParams -> IO () startNoRepo _ = do -- FIXME should be able to reuse regular getopt, but @@ -107,13 +107,18 @@ startNoRepo _ = do let listenhost = headMaybe $ map (snd . separate (== '=')) $ filter ("--listen=" `isPrefixOf`) args - dirs <- liftIO $ filterM doesDirectoryExist =<< readAutoStartFile - case dirs of - [] -> firstRun listenhost - (d:_) -> do + go listenhost =<< liftIO (filterM doesDirectoryExist =<< readAutoStartFile) + where + go listenhost [] = firstRun listenhost + go listenhost (d:ds) = do + v <- tryNonAsync $ do setCurrentDirectory d - state <- Annex.new =<< Git.CurrentRepo.get - void $ Annex.eval state $ do + Annex.new =<< Git.CurrentRepo.get + case v of + Left e -> do + warningIO $ "unable to start webapp in " ++ d ++ ": " ++ show e + go listenhost ds + Right state -> void $ Annex.eval state $ do whenM (fromRepo Git.repoIsLocalBare) $ error $ d ++ " is a bare git repository, cannot run the webapp in it" callCommandAction $ diff --git a/Command/Whereis.hs b/Command/Whereis.hs index 387ffebc95..d2c27eb9bf 100644 --- a/Command/Whereis.hs +++ b/Command/Whereis.hs @@ -27,8 +27,8 @@ seek ps = do (withFilesInGit $ whenAnnexed $ start m) ps -start :: M.Map UUID Remote -> FilePath -> (Key, Backend) -> CommandStart -start remotemap file (key, _) = start' remotemap key (Just file) +start :: M.Map UUID Remote -> FilePath -> Key -> CommandStart +start remotemap file key = start' remotemap key (Just file) startKeys :: M.Map UUID Remote -> Key -> CommandStart startKeys remotemap key = start' remotemap key Nothing diff --git a/Creds.hs b/Creds.hs index 0586f20703..7273ed966b 100644 --- a/Creds.hs +++ b/Creds.hs @@ -14,6 +14,7 @@ module Creds ( getEnvCredPair, writeCacheCreds, readCacheCreds, + removeCreds, ) where import Common.Annex @@ -138,3 +139,9 @@ decodeCredPair :: Creds -> Maybe CredPair decodeCredPair creds = case lines creds of l:p:[] -> Just (l, p) _ -> Nothing + +removeCreds :: FilePath -> Annex () +removeCreds file = do + d <- fromRepo gitAnnexCredsDir + let f = d file + liftIO $ nukeFile f diff --git a/Git/GCrypt.hs b/Git/GCrypt.hs index 156441daeb..fb99cf6199 100644 --- a/Git/GCrypt.hs +++ b/Git/GCrypt.hs @@ -16,8 +16,11 @@ import qualified Git.Config as Config import qualified Git.Command as Command import Utility.Gpg +urlScheme :: String +urlScheme = "gcrypt:" + urlPrefix :: String -urlPrefix = "gcrypt::" +urlPrefix = urlScheme ++ ":" isEncrypted :: Repo -> Bool isEncrypted Repo { location = Url url } = urlPrefix `isPrefixOf` show url diff --git a/Limit.hs b/Limit.hs index b46ff1a06f..9ac849bcec 100644 --- a/Limit.hs +++ b/Limit.hs @@ -234,10 +234,10 @@ limitSize vs s = case readSize dataUnits s of Nothing -> Left "bad size" Just sz -> Right $ go sz where - go sz _ (MatchingFile fi) = lookupFile fi >>= check fi sz + go sz _ (MatchingFile fi) = lookupFileKey fi >>= check fi sz go sz _ (MatchingKey key) = checkkey sz key checkkey sz key = return $ keySize key `vs` Just sz - check _ sz (Just (key, _)) = checkkey sz key + check _ sz (Just key) = checkkey sz key check fi sz Nothing = do filesize <- liftIO $ catchMaybeIO $ fromIntegral . fileSize @@ -272,11 +272,8 @@ addTimeLimit s = do liftIO $ exitWith $ ExitFailure 101 else return True -lookupFile :: FileInfo -> Annex (Maybe (Key, Backend)) -lookupFile = Backend.lookupFile . relFile - lookupFileKey :: FileInfo -> Annex (Maybe Key) -lookupFileKey = (fst <$>) <$$> Backend.lookupFile . relFile +lookupFileKey = Backend.lookupFile . relFile checkKey :: (Key -> Annex Bool) -> MatchInfo -> Annex Bool checkKey a (MatchingFile fi) = lookupFileKey fi >>= maybe (return False) a diff --git a/Makefile b/Makefile index 5c474e9ca1..cbc369572a 100644 --- a/Makefile +++ b/Makefile @@ -253,7 +253,7 @@ hdevtools: distributionupdate: git pull cabal configure - ghc --make Build/DistributionUpdate -XPackageImports + ghc --make Build/DistributionUpdate -XPackageImports -optP-include -optPdist/build/autogen/cabal_macros.h ./Build/DistributionUpdate .PHONY: git-annex git-union-merge git-recover-repository tags build-stamp diff --git a/Remote.hs b/Remote.hs index 0f31b99b29..da33e195e5 100644 --- a/Remote.hs +++ b/Remote.hs @@ -22,6 +22,7 @@ module Remote ( remoteList, gitSyncableRemote, remoteMap, + remoteMap', uuidDescriptions, byName, byNameOnly, @@ -64,9 +65,19 @@ import Git.Types (RemoteName) import qualified Git {- Map from UUIDs of Remotes to a calculated value. -} -remoteMap :: (Remote -> a) -> Annex (M.Map UUID a) -remoteMap c = M.fromList . map (\r -> (uuid r, c r)) . - filter (\r -> uuid r /= NoUUID) <$> remoteList +remoteMap :: (Remote -> v) -> Annex (M.Map UUID v) +remoteMap mkv = remoteMap' mkv mkk + where + mkk r = case uuid r of + NoUUID -> Nothing + u -> Just u + +remoteMap' :: Ord k => (Remote -> v) -> (Remote -> Maybe k) -> Annex (M.Map k v) +remoteMap' mkv mkk = M.fromList . mapMaybe mk <$> remoteList + where + mk r = case mkk r of + Nothing -> Nothing + Just k -> Just (k, mkv r) {- Map of UUIDs of remotes and their descriptions. - The names of Remotes are added to suppliment any description that has diff --git a/Remote/Git.hs b/Remote/Git.hs index 209312d674..83964e1803 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -312,7 +312,7 @@ copyFromRemote r key file dest _p = copyFromRemote' r key file dest copyFromRemote' :: Remote -> Key -> AssociatedFile -> FilePath -> Annex Bool copyFromRemote' r key file dest | not $ Git.repoIsUrl (repo r) = guardUsable (repo r) False $ do - let params = Ssh.rsyncParams r Download + params <- Ssh.rsyncParams r Download u <- getUUID -- run copy from perspective of remote onLocal r $ do @@ -411,7 +411,7 @@ copyToRemote r key file p -- the remote's Annex, but it needs access to the current -- Annex monad's state. checksuccessio <- Annex.withCurrentState checksuccess - let params = Ssh.rsyncParams r Upload + params <- Ssh.rsyncParams r Upload u <- getUUID -- run copy from perspective of remote onLocal r $ ifM (Annex.Content.inAnnex key) diff --git a/Remote/Helper/Ssh.hs b/Remote/Helper/Ssh.hs index 8de88953f6..6848f7212a 100644 --- a/Remote/Helper/Ssh.hs +++ b/Remote/Helper/Ssh.hs @@ -21,6 +21,7 @@ import Utility.Metered import Utility.Rsync import Types.Remote import Logs.Transfer +import Config {- Generates parameters to ssh to a repository's host and run a command. - Caller is responsible for doing any neccessary shellEscaping of the @@ -122,7 +123,7 @@ rsyncParamsRemote direct r direction key file afile = do fields -- Convert the ssh command into rsync command line. let eparam = rsyncShell (Param shellcmd:shellparams) - let o = rsyncParams r direction + o <- rsyncParams r direction return $ if direction == Download then o ++ rsyncopts eparam dummy (File file) else o ++ rsyncopts eparam (File file) dummy @@ -140,9 +141,19 @@ rsyncParamsRemote direct r direction key file afile = do dummy = Param "dummy:" -- --inplace to resume partial files -rsyncParams :: Remote -> Direction -> [CommandParam] -rsyncParams r direction = Params "--progress --inplace" : - map Param (remoteAnnexRsyncOptions gc ++ dps) +-- +-- Only use --perms when not on a crippled file system, as rsync +-- will fail trying to restore file perms onto a filesystem that does not +-- support them. +rsyncParams :: Remote -> Direction -> Annex [CommandParam] +rsyncParams r direction = do + crippled <- crippledFileSystem + return $ map Param $ catMaybes + [ Just "--progress" + , Just "--inplace" + , if crippled then Nothing else Just "--perms" + ] + ++ remoteAnnexRsyncOptions gc ++ dps where dps | direction == Download = remoteAnnexRsyncDownloadOptions gc diff --git a/RemoteDaemon/Common.hs b/RemoteDaemon/Common.hs index 29aeb00d3b..e844e2c887 100644 --- a/RemoteDaemon/Common.hs +++ b/RemoteDaemon/Common.hs @@ -20,7 +20,7 @@ import Annex.CatFile import Control.Concurrent -- Runs an Annex action. Long-running actions should be avoided, --- since only one liftAnnex can be running at a time, amoung all +-- since only one liftAnnex can be running at a time, across all -- transports. liftAnnex :: TransportHandle -> Annex a -> IO a liftAnnex (TransportHandle _ annexstate) a = do diff --git a/RemoteDaemon/Core.hs b/RemoteDaemon/Core.hs index b32be98ef4..60a4d5ceb7 100644 --- a/RemoteDaemon/Core.hs +++ b/RemoteDaemon/Core.hs @@ -18,6 +18,7 @@ import qualified Git.Types as Git import qualified Git.CurrentRepo import Utility.SimpleProtocol import Config +import Annex.Ssh import Control.Concurrent.Async import Control.Concurrent @@ -60,17 +61,24 @@ runController ichan ochan = do cmd <- readChan ichan case cmd of RELOAD -> do - liftAnnex h reloadConfig - m' <- genRemoteMap h ochan + h' <- updateTransportHandle h + m' <- genRemoteMap h' ochan let common = M.intersection m m' let new = M.difference m' m let old = M.difference m m' - stoprunning old + broadcast STOP old unless paused $ startrunning new - go h paused (M.union common new) + go h' paused (M.union common new) + LOSTNET -> do + -- force close all cached ssh connections + -- (done here so that if there are multiple + -- ssh remotes, it's only done once) + liftAnnex h forceSshCleanup + broadcast LOSTNET m + go h True m PAUSE -> do - stoprunning m + broadcast STOP m go h True m RESUME -> do when paused $ @@ -89,14 +97,14 @@ runController ichan ochan = do startrunning m = forM_ (M.elems m) startrunning' startrunning' (transport, _) = void $ async transport - -- Ask the transport nicely to stop. - stoprunning m = forM_ (M.elems m) stoprunning' - stoprunning' (_, c) = writeChan c STOP + broadcast msg m = forM_ (M.elems m) send + where + send (_, c) = writeChan c msg -- Generates a map with a transport for each supported remote in the git repo, -- except those that have annex.sync = false genRemoteMap :: TransportHandle -> Chan Emitted -> IO RemoteMap -genRemoteMap h@(TransportHandle g _) ochan = +genRemoteMap h@(TransportHandle g _) ochan = M.fromList . catMaybes <$> mapM gen (Git.remotes g) where gen r = case Git.location r of @@ -106,7 +114,7 @@ genRemoteMap h@(TransportHandle g _) ochan = ichan <- newChan :: IO (Chan Consumed) return $ Just ( r - , (transport r (Git.repoDescribe r) h ichan ochan, ichan) + , (transport r (RemoteURI u) h ichan ochan, ichan) ) _ -> return Nothing _ -> return Nothing @@ -116,3 +124,10 @@ genTransportHandle = do annexstate <- newMVar =<< Annex.new =<< Git.CurrentRepo.get g <- Annex.repo <$> readMVar annexstate return $ TransportHandle g annexstate + +updateTransportHandle :: TransportHandle -> IO TransportHandle +updateTransportHandle h@(TransportHandle _g annexstate) = do + g' <- liftAnnex h $ do + reloadConfig + Annex.fromRepo id + return (TransportHandle g' annexstate) diff --git a/RemoteDaemon/Transport.hs b/RemoteDaemon/Transport.hs index 1bac7f8778..09118ca8b8 100644 --- a/RemoteDaemon/Transport.hs +++ b/RemoteDaemon/Transport.hs @@ -9,6 +9,7 @@ module RemoteDaemon.Transport where import RemoteDaemon.Types import qualified RemoteDaemon.Transport.Ssh +import qualified Git.GCrypt import qualified Data.Map as M @@ -18,4 +19,5 @@ type TransportScheme = String remoteTransports :: M.Map TransportScheme Transport remoteTransports = M.fromList [ ("ssh:", RemoteDaemon.Transport.Ssh.transport) + , (Git.GCrypt.urlScheme, RemoteDaemon.Transport.Ssh.transport) ] diff --git a/RemoteDaemon/Transport/Ssh.hs b/RemoteDaemon/Transport/Ssh.hs index 557a3dce90..ba03a25893 100644 --- a/RemoteDaemon/Transport/Ssh.hs +++ b/RemoteDaemon/Transport/Ssh.hs @@ -8,65 +8,117 @@ module RemoteDaemon.Transport.Ssh (transport) where import Common.Annex +import Annex.Ssh import RemoteDaemon.Types import RemoteDaemon.Common import Remote.Helper.Ssh import qualified RemoteDaemon.Transport.Ssh.Types as SshRemote import Utility.SimpleProtocol +import qualified Git import Git.Command +import Utility.ThreadScheduler import Control.Concurrent.Chan import Control.Concurrent.Async -import System.Process (std_in, std_out) +import System.Process (std_in, std_out, std_err) transport :: Transport -transport r remotename transporthandle ichan ochan = do +transport r url h@(TransportHandle g s) ichan ochan = do + -- enable ssh connection caching wherever inLocalRepo is called + g' <- liftAnnex h $ sshCachingTo r g + transport' r url (TransportHandle g' s) ichan ochan + +transport' :: Transport +transport' r url transporthandle ichan ochan = do + v <- liftAnnex transporthandle $ git_annex_shell r "notifychanges" [] [] case v of Nothing -> noop - Just (cmd, params) -> go cmd (toCommand params) + Just (cmd, params) -> robustly 1 $ + connect cmd (toCommand params) where - go cmd params = do - (Just toh, Just fromh, _, pid) <- createProcess (proc cmd params) + connect cmd params = do + (Just toh, Just fromh, Just errh, pid) <- + createProcess (proc cmd params) { std_in = CreatePipe , std_out = CreatePipe + , std_err = CreatePipe } - let shutdown = do - hClose toh - hClose fromh - void $ waitForProcess pid - send DISCONNECTED + -- Run all threads until one finishes and get the status + -- of the first to finish. Cancel the rest. + status <- catchDefaultIO (Right ConnectionClosed) $ + handlestderr errh + `race` handlestdout fromh + `race` handlecontrol - let fromshell = forever $ do - l <- hGetLine fromh - case parseMessage l of - Just SshRemote.READY -> send CONNECTED - Just (SshRemote.CHANGED shas) -> - whenM (checkNewShas transporthandle shas) $ - fetch - Nothing -> shutdown + send (DISCONNECTED url) + hClose toh + hClose fromh + void $ waitForProcess pid - -- The only control message that matters is STOP. - -- - -- Note that a CHANGED control message is not handled; - -- we don't push to the ssh remote. The assistant - -- and git-annex sync both handle pushes, so there's no - -- need to do it here. - let handlecontrol = forever $ do - msg <- readChan ichan - case msg of - STOP -> ioError (userError "done") - _ -> noop + return $ either (either id id) id status - -- Run both threads until one finishes. - void $ tryIO $ concurrently fromshell handlecontrol - shutdown - - send msg = writeChan ochan (msg remotename) + send msg = writeChan ochan msg fetch = do - send SYNCING + send (SYNCING url) ok <- inLocalRepo transporthandle $ - runBool [Param "fetch", Param remotename] - send (DONESYNCING ok) + runBool [Param "fetch", Param $ Git.repoDescribe r] + send (DONESYNCING url ok) + + handlestdout fromh = do + l <- hGetLine fromh + case parseMessage l of + Just SshRemote.READY -> do + send (CONNECTED url) + handlestdout fromh + Just (SshRemote.CHANGED shas) -> do + whenM (checkNewShas transporthandle shas) $ + fetch + handlestdout fromh + -- avoid reconnect on protocol error + Nothing -> return Stopping + + handlecontrol = do + msg <- readChan ichan + case msg of + STOP -> return Stopping + LOSTNET -> return Stopping + _ -> handlecontrol + + -- Old versions of git-annex-shell that do not support + -- the notifychanges command will exit with a not very useful + -- error message. Detect that error, and avoid reconnecting. + -- Propigate all stderr. + handlestderr errh = do + s <- hGetSomeString errh 1024 + hPutStr stderr s + hFlush stderr + if "git-annex-shell: git-shell failed" `isInfixOf` s + then do + send $ WARNING url $ unwords + [ "Remote", Git.repoDescribe r + , "needs its git-annex upgraded" + , "to 5.20140405 or newer" + ] + return Stopping + else handlestderr errh + +data Status = Stopping | ConnectionClosed + +{- Make connection robustly, with exponentioal backoff on failure. -} +robustly :: Int -> IO Status -> IO () +robustly backoff a = handle =<< catchDefaultIO ConnectionClosed a + where + handle Stopping = return () + handle ConnectionClosed = do + threadDelaySeconds (Seconds backoff) + robustly increasedbackoff a + + increasedbackoff + | b2 > maxbackoff = maxbackoff + | otherwise = b2 + where + b2 = backoff * 2 + maxbackoff = 3600 -- one hour diff --git a/RemoteDaemon/Types.hs b/RemoteDaemon/Types.hs index 025c602df0..0a72695343 100644 --- a/RemoteDaemon/Types.hs +++ b/RemoteDaemon/Types.hs @@ -10,38 +10,51 @@ module RemoteDaemon.Types where +import Common import qualified Annex import qualified Git.Types as Git import qualified Utility.SimpleProtocol as Proto +import Network.URI import Control.Concurrent +-- The URI of a remote is used to uniquely identify it (names change..) +newtype RemoteURI = RemoteURI URI + deriving (Show) + -- A Transport for a particular git remote consumes some messages -- from a Chan, and emits others to another Chan. -type Transport = RemoteRepo -> RemoteName -> TransportHandle -> Chan Consumed -> Chan Emitted -> IO () +type Transport = RemoteRepo -> RemoteURI -> TransportHandle -> Chan Consumed -> Chan Emitted -> IO () type RemoteRepo = Git.Repo type LocalRepo = Git.Repo -- All Transports share a single AnnexState MVar +-- +-- Different TransportHandles may have different versions of the LocalRepo. +-- (For example, the ssh transport modifies it to enable ssh connection +-- caching.) data TransportHandle = TransportHandle LocalRepo (MVar Annex.AnnexState) -- Messages that the daemon emits. data Emitted - = CONNECTED RemoteName - | DISCONNECTED RemoteName - | SYNCING RemoteName - | DONESYNCING Bool RemoteName + = CONNECTED RemoteURI + | DISCONNECTED RemoteURI + | SYNCING RemoteURI + | DONESYNCING RemoteURI Bool + | WARNING RemoteURI String + deriving (Show) -- Messages that the deamon consumes. data Consumed = PAUSE + | LOSTNET | RESUME | CHANGED RefList | RELOAD | STOP + deriving (Show) -type RemoteName = String type RefList = [Git.Ref] instance Proto.Sendable Emitted where @@ -51,11 +64,14 @@ instance Proto.Sendable Emitted where ["DISCONNECTED", Proto.serialize remote] formatMessage (SYNCING remote) = ["SYNCING", Proto.serialize remote] - formatMessage (DONESYNCING status remote) = - ["DONESYNCING", Proto.serialize status, Proto.serialize remote] + formatMessage (DONESYNCING remote status) = + ["DONESYNCING", Proto.serialize remote, Proto.serialize status] + formatMessage (WARNING remote message) = + ["WARNING", Proto.serialize remote, Proto.serialize message] instance Proto.Sendable Consumed where formatMessage PAUSE = ["PAUSE"] + formatMessage LOSTNET = ["LOSTNET"] formatMessage RESUME = ["RESUME"] formatMessage (CHANGED refs) =["CHANGED", Proto.serialize refs] formatMessage RELOAD = ["RELOAD"] @@ -66,16 +82,22 @@ instance Proto.Receivable Emitted where parseCommand "DISCONNECTED" = Proto.parse1 DISCONNECTED parseCommand "SYNCING" = Proto.parse1 SYNCING parseCommand "DONESYNCING" = Proto.parse2 DONESYNCING + parseCommand "WARNING" = Proto.parse2 WARNING parseCommand _ = Proto.parseFail instance Proto.Receivable Consumed where parseCommand "PAUSE" = Proto.parse0 PAUSE + parseCommand "LOSTNET" = Proto.parse0 LOSTNET parseCommand "RESUME" = Proto.parse0 RESUME parseCommand "CHANGED" = Proto.parse1 CHANGED parseCommand "RELOAD" = Proto.parse0 RELOAD parseCommand "STOP" = Proto.parse0 STOP parseCommand _ = Proto.parseFail +instance Proto.Serializable RemoteURI where + serialize (RemoteURI u) = show u + deserialize = RemoteURI <$$> parseURI + instance Proto.Serializable [Char] where serialize = id deserialize = Just diff --git a/Test.hs b/Test.hs index 8fbaf1d944..55546d08be 100644 --- a/Test.hs +++ b/Test.hs @@ -164,6 +164,7 @@ properties = localOption (QuickCheckTests 1000) $ testGroup "QuickCheck" , testProperty "prop_parse_show_TrustLog" Logs.Trust.prop_parse_show_TrustLog , testProperty "prop_hashes_stable" Utility.Hash.prop_hashes_stable , testProperty "prop_schedule_roundtrips" Utility.Scheduled.prop_schedule_roundtrips + , testProperty "prop_past_sane" Utility.Scheduled.prop_past_sane , testProperty "prop_duration_roundtrips" Utility.HumanTime.prop_duration_roundtrips , testProperty "prop_metadata_sane" Types.MetaData.prop_metadata_sane , testProperty "prop_metadata_serialize" Types.MetaData.prop_metadata_serialize @@ -711,7 +712,7 @@ test_unused env = intmpclonerepoInDirect env $ do (sort expectedkeys) (sort unusedkeys) findkey f = do r <- Backend.lookupFile f - return $ fst $ fromJust r + return $ fromJust r test_describe :: TestEnv -> Assertion test_describe env = intmpclonerepo env $ do @@ -1232,7 +1233,7 @@ test_crypto env = do (c,k) <- annexeval $ do uuid <- Remote.nameToUUID "foo" rs <- Logs.Remote.readRemoteLog - Just (k,_) <- Backend.lookupFile annexedfile + Just k <- Backend.lookupFile annexedfile return (fromJust $ M.lookup uuid rs, k) let key = if scheme `elem` ["hybrid","pubkey"] then Just $ Utility.Gpg.KeyIds [Utility.Gpg.testKeyId] @@ -1499,7 +1500,7 @@ checklocationlog f expected = do thisuuid <- annexeval Annex.UUID.getUUID r <- annexeval $ Backend.lookupFile f case r of - Just (k, _) -> do + Just k -> do uuids <- annexeval $ Remote.keyLocations k assertEqual ("bad content in location log for " ++ f ++ " key " ++ Types.Key.key2file k ++ " uuid " ++ show thisuuid) expected (thisuuid `elem` uuids) @@ -1507,9 +1508,9 @@ checklocationlog f expected = do checkbackend :: FilePath -> Types.Backend -> Assertion checkbackend file expected = do - r <- annexeval $ Backend.lookupFile file - let b = snd $ fromJust r - assertEqual ("backend for " ++ file) expected b + b <- annexeval $ maybe (return Nothing) (Backend.getBackend file) + =<< Backend.lookupFile file + assertEqual ("backend for " ++ file) (Just expected) b inlocationlog :: FilePath -> Assertion inlocationlog f = checklocationlog f True diff --git a/Types/UUID.hs b/Types/UUID.hs index 8a304dffab..df38840598 100644 --- a/Types/UUID.hs +++ b/Types/UUID.hs @@ -8,6 +8,8 @@ module Types.UUID where import qualified Data.Map as M +import qualified Data.UUID as U +import Data.Maybe -- A UUID is either an arbitrary opaque string, or UUID info may be missing. data UUID = NoUUID | UUID String @@ -21,4 +23,7 @@ toUUID :: String -> UUID toUUID [] = NoUUID toUUID s = UUID s +isUUID :: String -> Bool +isUUID = isJust . U.fromString + type UUIDMap = M.Map UUID String diff --git a/Utility/Process.hs b/Utility/Process.hs index 1945e4b9da..3f93dc2fcd 100644 --- a/Utility/Process.hs +++ b/Utility/Process.hs @@ -31,6 +31,7 @@ module Utility.Process ( stdinHandle, stdoutHandle, stderrHandle, + processHandle, devNull, ) where @@ -313,6 +314,9 @@ bothHandles :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> (Han bothHandles (Just hin, Just hout, _, _) = (hin, hout) bothHandles _ = error "expected bothHandles" +processHandle :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> ProcessHandle +processHandle (_, _, _, pid) = pid + {- Debugging trace for a CreateProcess. -} debugProcess :: CreateProcess -> IO () debugProcess p = do diff --git a/Utility/Scheduled.hs b/Utility/Scheduled.hs index 1b25cb4c70..d3ae06203e 100644 --- a/Utility/Scheduled.hs +++ b/Utility/Scheduled.hs @@ -1,6 +1,6 @@ {- scheduled activities - - - Copyright 2013 Joey Hess + - Copyright 2013-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -14,6 +14,7 @@ module Utility.Scheduled ( MonthDay, YearDay, nextTime, + calcNextTime, startTime, fromSchedule, fromScheduledTime, @@ -22,7 +23,8 @@ module Utility.Scheduled ( toRecurrance, toSchedule, parseSchedule, - prop_schedule_roundtrips + prop_schedule_roundtrips, + prop_past_sane, ) where import Utility.Data @@ -66,8 +68,8 @@ data ScheduledTime type Hour = Int type Minute = Int -{- Next time a Schedule should take effect. The NextTimeWindow is used - - when a Schedule is allowed to start at some point within the window. -} +-- | Next time a Schedule should take effect. The NextTimeWindow is used +-- when a Schedule is allowed to start at some point within the window. data NextTime = NextTimeExactly LocalTime | NextTimeWindow LocalTime LocalTime @@ -83,8 +85,8 @@ nextTime schedule lasttime = do tz <- getTimeZone now return $ calcNextTime schedule lasttime $ utcToLocalTime tz now -{- Calculate the next time that fits a Schedule, based on the - - last time it occurred, and the current time. -} +-- | Calculate the next time that fits a Schedule, based on the +-- last time it occurred, and the current time. calcNextTime :: Schedule -> Maybe LocalTime -> LocalTime -> Maybe NextTime calcNextTime schedule@(Schedule recurrance scheduledtime) lasttime currenttime | scheduledtime == AnyTime = do @@ -97,10 +99,10 @@ calcNextTime schedule@(Schedule recurrance scheduledtime) lasttime currenttime findfromtoday anytime = findfrom recurrance afterday today where today = localDay currenttime - afterday = sameaslastday || toolatetoday + afterday = sameaslastrun || toolatetoday toolatetoday = not anytime && localTimeOfDay currenttime >= nexttime - sameaslastday = lastday == Just today - lastday = localDay <$> lasttime + sameaslastrun = lastrun == Just today + lastrun = localDay <$> lasttime nexttime = case scheduledtime of AnyTime -> TimeOfDay 0 0 0 SpecificTime h m -> TimeOfDay h m 0 @@ -120,21 +122,19 @@ calcNextTime schedule@(Schedule recurrance scheduledtime) lasttime currenttime | otherwise -> Just $ exactly candidate Weekly Nothing | afterday -> skip 1 - | otherwise -> case (wday <$> lastday, wday candidate) of + | otherwise -> case (wday <$> lastrun, wday candidate) of (Nothing, _) -> Just $ window candidate (addDays 6 candidate) (Just old, curr) | old == curr -> Just $ window candidate (addDays 6 candidate) | otherwise -> skip 1 Monthly Nothing | afterday -> skip 1 - | maybe True (\old -> mday candidate > mday old && mday candidate >= (mday old `mod` minmday)) lastday -> - -- Window only covers current month, - -- in case there is a Divisible requirement. + | maybe True (candidate `oneMonthPast`) lastrun -> Just $ window candidate (endOfMonth candidate) | otherwise -> skip 1 Yearly Nothing | afterday -> skip 1 - | maybe True (\old -> ynum candidate > ynum old && yday candidate >= (yday old `mod` minyday)) lastday -> + | maybe True (candidate `oneYearPast`) lastrun -> Just $ window candidate (endOfYear candidate) | otherwise -> skip 1 Weekly (Just w) @@ -176,6 +176,18 @@ calcNextTime schedule@(Schedule recurrance scheduledtime) lasttime currenttime getday = localDay . startTime divisible n v = v `rem` n == 0 +-- Check if the new Day occurs one month or more past the old Day. +oneMonthPast :: Day -> Day -> Bool +new `oneMonthPast` old = fromGregorian y (m+1) d <= new + where + (y,m,d) = toGregorian old + +-- Check if the new Day occurs one year or more past the old Day. +oneYearPast :: Day -> Day -> Bool +new `oneYearPast` old = fromGregorian (y+1) m d <= new + where + (y,m,d) = toGregorian old + endOfMonth :: Day -> Day endOfMonth day = let (y,m,_d) = toGregorian day @@ -200,17 +212,13 @@ yday = snd . toOrdinalDate ynum :: Day -> Int ynum = fromIntegral . fst . toOrdinalDate -{- Calendar max and mins. -} +-- Calendar max values. maxyday :: Int maxyday = 366 -- with leap days -minyday :: Int -minyday = 365 maxwnum :: Int maxwnum = 53 -- some years have more than 52 maxmday :: Int maxmday = 31 -minmday :: Int -minmday = 28 maxmnum :: Int maxmnum = 12 maxwday :: Int @@ -362,3 +370,27 @@ instance Arbitrary Recurrance where prop_schedule_roundtrips :: Schedule -> Bool prop_schedule_roundtrips s = toSchedule (fromSchedule s) == Just s + +prop_past_sane :: Bool +prop_past_sane = and + [ all (checksout oneMonthPast) (mplus1 ++ yplus1) + , all (not . (checksout oneMonthPast)) (map swap (mplus1 ++ yplus1)) + , all (checksout oneYearPast) yplus1 + , all (not . (checksout oneYearPast)) (map swap yplus1) + ] + where + mplus1 = -- new date old date, 1+ months before it + [ (fromGregorian 2014 01 15, fromGregorian 2013 12 15) + , (fromGregorian 2014 01 15, fromGregorian 2013 02 15) + , (fromGregorian 2014 02 15, fromGregorian 2013 01 15) + , (fromGregorian 2014 03 01, fromGregorian 2013 01 15) + , (fromGregorian 2014 03 01, fromGregorian 2013 12 15) + , (fromGregorian 2015 01 01, fromGregorian 2010 01 01) + ] + yplus1 = -- new date old date, 1+ years before it + [ (fromGregorian 2014 01 15, fromGregorian 2012 01 16) + , (fromGregorian 2014 01 15, fromGregorian 2013 01 14) + , (fromGregorian 2022 12 31, fromGregorian 2000 01 01) + ] + checksout cmp (new, old) = new `cmp` old + swap (a,b) = (b,a) diff --git a/debian/changelog b/debian/changelog index 2bb3d13921..847597fca1 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,45 @@ +git-annex (5.20140421) unstable; urgency=medium + + * assistant: Now detects immediately when other repositories push + changes to a ssh remote, and pulls. + ** XMPP is no longer needed in this configuration! ** + This requires the remote server have git-annex-shell with + notifychanges support (>= 5.20140405) + * webapp: Show a network signal icon next to ssh and xmpp remotes that + it's currently connected with. + * webapp: Rework xmpp nudge to prompt for either xmpp or a ssh remote + to be set up. + * sync, assistant, remotedaemon: Use ssh connection caching for git pushes + and pulls. + * remotedaemon: When network connection is lost, close all cached ssh + connections. + * Improve handling of monthly/yearly scheduling. + * Avoid depending on shakespeare except for when building the webapp. + * uninit: Avoid making unncessary copies of files. + * info: Allow use in a repository where annex.uuid is not set. + * reinit: New command that can initialize a new repository using + the configuration of a previously known repository. + Useful if a repository got deleted and you want + to clone it back the way it was. + * drop --from: When local repository is untrusted, its copy of a file does + not count. + * Bring back rsync -p, but only when git-annex is running on a non-crippled + file system. This is a better approach to fix #700282 while not + unncessarily losing file permissions on non-crippled systems. + * webapp: Start even if the current directory is listed in + ~/.config/git-annex/autostart but no longer has a git repository in it. + * findref: New command, like find but shows files in a specified git ref. + * webapp: Fix UI for removing XMPP connection. + * When init detects that git is not configured to commit, and sets + user.email to work around the problem, also make it set user.name. + * webapp: Support using git-annex on a remote server, which was installed + from the standalone tarball or OSX app, and so does not have + git-annex in PATH (and may also not have git or rsync in PATH). + * standalone tarball, OSX app: Install a ~/.ssh/git-annex-wrapper, which + can be used to run git-annex, git, rsync, etc. + + -- Joey Hess Sun, 20 Apr 2014 19:43:14 -0400 + git-annex (5.20140412) unstable; urgency=high * Last release didn't quite fix the high cpu issue in all cases, this should. diff --git a/debian/control b/debian/control index 42fd39bb45..91d92d3b31 100644 --- a/debian/control +++ b/debian/control @@ -34,6 +34,7 @@ Build-Depends: libghc-yesod-static-dev [i386 amd64 kfreebsd-i386 kfreebsd-amd64 powerpc sparc], libghc-yesod-default-dev [i386 amd64 kfreebsd-amd64 powerpc sparc], libghc-hamlet-dev [i386 amd64 kfreebsd-i386 kfreebsd-amd64 powerpc sparc], + libghc-shakespeare-dev [i386 amd64 kfreebsd-i386 kfreebsd-amd64 powerpc sparc], libghc-clientsession-dev [i386 amd64 kfreebsd-i386 kfreebsd-amd64 powerpc sparc], libghc-warp-dev [i386 amd64 kfreebsd-i386 kfreebsd-amd64 powerpc sparc], libghc-warp-tls-dev [i386 amd64 kfreebsd-i386 kfreebsd-amd64 powerpc sparc], diff --git a/doc/automatic_conflict_resolution/comment_6_8a0860fee88f5954918305f055a39d8d._comment b/doc/automatic_conflict_resolution/comment_6_8a0860fee88f5954918305f055a39d8d._comment new file mode 100644 index 0000000000..4e9493d129 --- /dev/null +++ b/doc/automatic_conflict_resolution/comment_6_8a0860fee88f5954918305f055a39d8d._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawn3p4i4lk_zMilvjnJ9sS6g2nerpgz0Fjc" + nickname="Matthias" + subject="auto conflict resolution master branch" + date="2014-04-13T17:48:19Z" + content=""" +@joeyh: This must be a misunderstanding of what I want. I use version 5.20140320. I can't find a workflow where \"git annex merge\" changes my master branch, it only updates the git-annex branch. + +Thinking again of it after some time, I am basically fine with \"git annex sync\". The only thing I am uncomfortable with is that the automatic merge is pushed without review. +"""]] diff --git a/doc/automatic_conflict_resolution/comment_7_3d2250cc26036b8532faa980065e20d0._comment b/doc/automatic_conflict_resolution/comment_7_3d2250cc26036b8532faa980065e20d0._comment new file mode 100644 index 0000000000..9f49021da5 --- /dev/null +++ b/doc/automatic_conflict_resolution/comment_7_3d2250cc26036b8532faa980065e20d0._comment @@ -0,0 +1,23 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.191" + subject="comment 7" + date="2014-04-17T20:00:22Z" + content=""" +@Matthias, here is an example of git-annex merge updating the master branch from the synced/master branch that was pushed to it earlier: + +
+joey@darkstar:~/tmp/test/2>git annex merge
+merge git-annex (merging synced/git-annex into git-annex...)
+ok
+merge synced/master 
+Updating 7942eee..1f3422e
+Fast-forward
+ new_file | 1 +
+ 1 file changed, 1 insertion(+)
+ create mode 120000 new_file
+ok
+
+ +If you are having trouble with it somehow, I'd suggest filing a bug report. +"""]] diff --git a/doc/automatic_conflict_resolution/comment_8_ef474c258ce8e0ebc6485c1366ae6315._comment b/doc/automatic_conflict_resolution/comment_8_ef474c258ce8e0ebc6485c1366ae6315._comment new file mode 100644 index 0000000000..81f089b114 --- /dev/null +++ b/doc/automatic_conflict_resolution/comment_8_ef474c258ce8e0ebc6485c1366ae6315._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawn3p4i4lk_zMilvjnJ9sS6g2nerpgz0Fjc" + nickname="Matthias" + subject="auto conflict resolution" + date="2014-04-19T17:26:11Z" + content=""" +Thanks Joey, I could construct a scenario where the auto-conflict-resolution was applied in the master branch. +"""]] diff --git a/doc/bugs/Android___91__Terminal_session_finished__93__.mdwn b/doc/bugs/Android___91__Terminal_session_finished__93__.mdwn new file mode 100644 index 0000000000..0eb3a2d0bc --- /dev/null +++ b/doc/bugs/Android___91__Terminal_session_finished__93__.mdwn @@ -0,0 +1,33 @@ +### Please describe the problem. + +Launching the Git Annex app on Android, the shell just reads: +[[!format sh """ +[Terminal session finished] +"""]] + +Attempting to launch /data/data/ga.androidterm/runshell via the adb shell does also not work: +[[!format sh """ +/system/bin/sh: /data/data/ga.androidterm/runshell: not found +"""]] + +Listing the contents of that directory from the git annex terminal appears to confirm this: +[[!format sh """ +u0_a172@android:/data/data/ga.androidterm $ ls +cache +lib +shared_prefs +"""]] + +Following the instructions for the similar issue here [[http://git-annex.branchable.com/Android/oldcomments/#comment-4c5a944c1288ddd46108969a4c664584]]: +[[!format sh """ +u0_a172@android:/ $ ls -ld /data/data/ga.androidterm +drwxr-x--x u0_a172 u0_a172 2014-04-20 11:12 ga.androidterm +"""]] + +### What version of git-annex are you using? On what operating system? + +version 5.20140413 of the Git Annex app (tested using the daily build and regular build). + +Samsung Galaxy Tab 3 (GT-P5210) running Android 4.2.2 (without root access). + +> [[done|dup]] --[[Joey]] diff --git a/doc/bugs/Android___91__Terminal_session_finished__93__/comment_1_31af3e5226430a4e94de58c0e33bd22b._comment b/doc/bugs/Android___91__Terminal_session_finished__93__/comment_1_31af3e5226430a4e94de58c0e33bd22b._comment new file mode 100644 index 0000000000..73f7b05ca7 --- /dev/null +++ b/doc/bugs/Android___91__Terminal_session_finished__93__/comment_1_31af3e5226430a4e94de58c0e33bd22b._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.191" + subject="comment 1" + date="2014-04-20T17:16:50Z" + content=""" +From the git-annex terminal, try to run: + +/data/data/ga.androidterm/lib/lib.start.so + +Paste me any output.. +"""]] diff --git a/doc/bugs/Android___91__Terminal_session_finished__93__/comment_2_a5bcbd2f85283e29e237e9850cd8109a._comment b/doc/bugs/Android___91__Terminal_session_finished__93__/comment_2_a5bcbd2f85283e29e237e9850cd8109a._comment new file mode 100644 index 0000000000..01cc337304 --- /dev/null +++ b/doc/bugs/Android___91__Terminal_session_finished__93__/comment_2_a5bcbd2f85283e29e237e9850cd8109a._comment @@ -0,0 +1,22 @@ +[[!comment format=mdwn + username="cbaines" + ip="86.166.14.171" + subject="comment 2" + date="2014-04-20T19:40:11Z" + content=""" +When I run that, I get: +[[!format sh \"\"\" +/system/bin/sh: /data/data/ga.androidterm/lib/lib.start.so: not found +\"\"\"]] + +Which makes some sense, as the file is not there. The following files can be found under /data/data/ga.androidterm: +[[!format sh \"\"\" +/data/data/ga.androidterm/cache/com.android.renderscript.cache/ <- empty directory +/data/data/ga.androidterm/lib/libga-androidterm4.so +/data/data/ga.androidterm/shared_prefs/ga.androidterm_preferences.xml +\"\"\"]] + +I tried running libga-androidterm4.so, but I just got Segmentation fault back. + +I also tried using logcat to see if I could see anything obvious going wrong when running the app for the first time after installation, but I could not see anything obvious in the logs (there was a lot of noise, so I might of missed something), will anything useful appear with the use of a filter? +"""]] diff --git a/doc/bugs/Android___91__Terminal_session_finished__93__/comment_3_965efa6736dcff4d7010ea5533f31a59._comment b/doc/bugs/Android___91__Terminal_session_finished__93__/comment_3_965efa6736dcff4d7010ea5533f31a59._comment new file mode 100644 index 0000000000..ed3d369083 --- /dev/null +++ b/doc/bugs/Android___91__Terminal_session_finished__93__/comment_3_965efa6736dcff4d7010ea5533f31a59._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="cbaines" + ip="86.166.14.171" + subject="comment 3" + date="2014-04-20T19:50:12Z" + content=""" +Looking at the contents of the apk for the x86 architecture (which this tablet is), would you expect that file to be there? That file only appears in the /lib/armeabi and not /lib/x86 ? +"""]] diff --git a/doc/bugs/Android___91__Terminal_session_finished__93__/comment_4_90a0be2296b4a1d8c1708423666c9619._comment b/doc/bugs/Android___91__Terminal_session_finished__93__/comment_4_90a0be2296b4a1d8c1708423666c9619._comment new file mode 100644 index 0000000000..12fd901bcb --- /dev/null +++ b/doc/bugs/Android___91__Terminal_session_finished__93__/comment_4_90a0be2296b4a1d8c1708423666c9619._comment @@ -0,0 +1,31 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.191" + subject="comment 4" + date="2014-04-20T19:55:59Z" + content=""" +Ok, so the git-annex.apk ships several libraries (and pseudo-libraries), and it seems your version of Android only installed the one that is really an Android java application. I don't know why. + +Here's the full list of files that are supposed to be installed in the lib dir. If you can find something about them in the logs, that might help. + +I suppose it's possible they were installed to some other location in the android file system (which might be hard to find w/o root.. You could check if git-annex in the app list has a larger installed size than the size of libga-androidterm4.so, that might give a hint. + +
+lib.busybox.so
+lib.git-annex.so
+lib.git-shell.so
+lib.git-upload-pack.so
+lib.git.so
+lib.git.tar.gz.so
+lib.gpg.so
+lib.rsync.so
+lib.runshell.so
+lib.ssh-keygen.so
+lib.ssh.so
+lib.start.so
+lib.version.so
+libga-androidterm4.so
+
+ +(I just installed the 5.20140414-gb70cd37 autobuild on an android device and it worked ok.) +"""]] diff --git a/doc/bugs/Android___91__Terminal_session_finished__93__/comment_5_be4b720293992f75b9cc3e8f6687fb87._comment b/doc/bugs/Android___91__Terminal_session_finished__93__/comment_5_be4b720293992f75b9cc3e8f6687fb87._comment new file mode 100644 index 0000000000..2d82bb7b51 --- /dev/null +++ b/doc/bugs/Android___91__Terminal_session_finished__93__/comment_5_be4b720293992f75b9cc3e8f6687fb87._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="cbaines" + ip="86.166.14.171" + subject="comment 5" + date="2014-04-20T20:20:55Z" + content=""" +I'm guessing you missed my last comment regarding the architecture. Sorry I did not pick this up earlier, but it only came to mind when I had a poke around in the apk? +"""]] diff --git a/doc/bugs/Android___91__Terminal_session_finished__93__/comment_6_8e439138c97b8853ab2b6f96f6111568._comment b/doc/bugs/Android___91__Terminal_session_finished__93__/comment_6_8e439138c97b8853ab2b6f96f6111568._comment new file mode 100644 index 0000000000..40404029e9 --- /dev/null +++ b/doc/bugs/Android___91__Terminal_session_finished__93__/comment_6_8e439138c97b8853ab2b6f96f6111568._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.191" + subject="comment 6" + date="2014-04-20T20:58:22Z" + content=""" +Yes, that fully explains it. git-annex is a native program and for android it's only built for arm. +"""]] diff --git a/doc/bugs/Android___91__Terminal_session_finished__93__/comment_7_6142516d816f78c724e22737aa3bca53._comment b/doc/bugs/Android___91__Terminal_session_finished__93__/comment_7_6142516d816f78c724e22737aa3bca53._comment new file mode 100644 index 0000000000..d6ce0fe3a9 --- /dev/null +++ b/doc/bugs/Android___91__Terminal_session_finished__93__/comment_7_6142516d816f78c724e22737aa3bca53._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.191" + subject="comment 7" + date="2014-04-20T20:59:35Z" + content=""" +So, this is a dup of [[todo/Not_working_on_Android-x86]] +"""]] diff --git a/doc/bugs/Drop_--from_always_trusts_local_repository.mdwn b/doc/bugs/Drop_--from_always_trusts_local_repository.mdwn new file mode 100644 index 0000000000..53bdda3328 --- /dev/null +++ b/doc/bugs/Drop_--from_always_trusts_local_repository.mdwn @@ -0,0 +1,46 @@ +### Please describe the problem. + +The command `git annex drop --from` always trusts the local repository, even if +it is marked as untrusted. + + +### What steps will reproduce the problem? +[[!format sh """ +mkdir t u; cd t; git init; git commit --allow-empty -m "Initial commit"; git annex init "Trusted"; date > file; git annex add file; git commit -m "Add file"; cd ../u; git init; git remote add t ../t; git fetch t; git merge t/master; git annex init "Untrusted"; git annex untrust .; git annex get file; cd ../t; git remote add u ../u; git fetch u; cd .. +"""]] + +Create two repositories, *t* (trusted) and *u* (untrusted). A file is in both +repositories. When performing `git annex drop file` in repository *t*, `git +annex` will abort because there are not enough copies. But when performing `git +annex drop --from t file` in *u*, git annex will delete the copy. + + +### What version of git-annex are you using? On what operating system? + +Bug was introduced with 6c31e3a8 and still exists in current master (d955cfe7). + + +### Please provide any additional information below. + +The following change seems to solve the problem. (First time working with +Haskell, please excuse the crude code.) + +[[!format diff """ +diff --git a/Command/Drop.hs b/Command/Drop.hs +index 269c4c2..09ea99a 100644 +--- a/Command/Drop.hs ++++ b/Command/Drop.hs +@@ -82,8 +82,9 @@ performRemote key afile numcopies remote = lockContent key $ do + (remotes, trusteduuids) <- Remote.keyPossibilitiesTrusted key + present <- inAnnex key + u <- getUUID ++ level <- lookupTrust u + let have = filter (/= uuid) $ +- if present then u:trusteduuids else trusteduuids ++ if present && level <= SemiTrusted then u:trusteduuids else trusteduuids + untrusteduuids <- trustGet UnTrusted + let tocheck = filter (/= remote) $ + Remote.remotesWithoutUUID remotes (have++untrusteduuids) +"""]] + +> [[fixed|done]] --[[Joey]] diff --git a/doc/bugs/fatal:_Out_of_memory__63___mmap_failed:_No_error.mdwn b/doc/bugs/fatal:_Out_of_memory__63___mmap_failed:_No_error.mdwn new file mode 100644 index 0000000000..d4bb7bede8 --- /dev/null +++ b/doc/bugs/fatal:_Out_of_memory__63___mmap_failed:_No_error.mdwn @@ -0,0 +1,31 @@ +### Please describe the problem. + +When adding files, the error + + fatal: Out of memory? mmap failed: No error + +appears + + +### What steps will reproduce the problem? + +In Windows, I have a directory with 8GB and 333.820 files (of course, in different directory, the big one is probably the Android SDK). + +### What version of git-annex are you using? On what operating system? + +Windows 8. + + $ git annex version + git-annex version: 5.20140411-gda795e0 + build flags: Assistant Webapp Webapp-secure Pairing Testsuite S3 WebDAV DNS Feeds Quvi TDFA CryptoHash + key/value backends: SHA256E SHA1E SHA512E SHA224E SHA384E SKEIN256E SKEIN512E SHA256 SHA1 SHA512 SHA224 SHA384 SKEIN256 SKEIN512 WORM URL + remote types: git gcrypt S3 bup directory rsync web webdav tahoe glacier hook external + local repository version: 5 + supported repository version: 5 + upgrade supported from repository versions: 2 3 4 + + +### Please provide any additional information below. + + +> closing as not a git-annex bug at all, but a git bug. [[done]] --[[Joey]] diff --git a/doc/bugs/fatal:_Out_of_memory__63___mmap_failed:_No_error/comment_1_3bc14a8b093ebb2c0571f5a554ef8cf3._comment b/doc/bugs/fatal:_Out_of_memory__63___mmap_failed:_No_error/comment_1_3bc14a8b093ebb2c0571f5a554ef8cf3._comment new file mode 100644 index 0000000000..bf120c20ab --- /dev/null +++ b/doc/bugs/fatal:_Out_of_memory__63___mmap_failed:_No_error/comment_1_3bc14a8b093ebb2c0571f5a554ef8cf3._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.191" + subject="comment 1" + date="2014-04-17T17:25:29Z" + content=""" +That error message is a git error message (from git's `wrapper.c`), not a git-annex error message. + +It's quite possible that git does not scale to as many file on Windows as it does on Unix, and git is known to not scale particularly well to vast numbers of files even on unix, although running out of memory is not the typical failure mode there. + +I think you should file a bug report on git. +"""]] diff --git a/doc/bugs/git-annex_branch_shows_commit_with_looong_commitlog.mdwn b/doc/bugs/git-annex_branch_shows_commit_with_looong_commitlog.mdwn new file mode 100644 index 0000000000..1af2b77a25 --- /dev/null +++ b/doc/bugs/git-annex_branch_shows_commit_with_looong_commitlog.mdwn @@ -0,0 +1,72 @@ +### Please describe the problem. + +I have found a really weird commit in my git-annex branch: + + * a59dd1c update (il y a 8 heures) + * 57f887a update (recovery from race) (recovery from race) (recovery from race) [...] + +it repeats that for a looong time. about 12 000 times, to be more precise: + +[[!format sh """ +anarcat@marcos:video$ git show 57f887a | wc + 5 12686 88850 +"""]] + +### What steps will reproduce the problem? + +Now i have absolutely no idea how I managed that. I got through some pretty dark moments last night trying various levels of git-annex voodoo (including a duplicate repo which was rsync'd to a backup drive so the unique identifier applied to two distinct paths), so I have no idea exactly what happened here. + +### What version of git-annex are you using? On what operating system? + +debian jessie amd64 5.20140412 + +### Please provide any additional information below. + +[[!format sh """ +anarcat@marcos:video$ git show 57f887a | tail -c 100 +very from race) (recovery from race) (recovery from race) (recovery from race) (recovery from race) +anarcat@marcos:video$ git show 57f887a | head -c 512 +commit 57f887a9d766829d00832ad1ee23b2785212d055 +Author: Antoine Beaupré +Date: Sat Apr 19 01:48:18 2014 -0400 + + update (recovery from race) (recovery from race) (recovery from race) (recovery from race) (recovery from race) (recovery from race) (recovery from race) (recovery from race) (recovery from race) (recovery from race) (recovery from race) (recovery from race) (recovery from race) (recovery from race) (recovery from race) (recovery from race) (recovery from race) (recovery +"""]] + +that's 80KB for only one commit here - maybe that should be cleaned up? --[[anarcat]] + +Ah! more information: it seems that 01:48 was the moment i shutdown the assistant in yet another panic... + +[[!format sh """ +anarcat@marcos:video$ ls -al .git/annex/daemon.log* +-rw-r--r-- 1 anarcat anarcat 17075 avril 19 09:28 .git/annex/daemon.log +-rw-r--r-- 1 anarcat anarcat 128367 avril 19 01:48 .git/annex/daemon.log.1 +"""]] + +an extract from that second logfile: + +[[!format sh """ +19/Apr/2014:01:31:38 -0400 [Error#yesod-core] unknown response from git cat-file ("9a73bf01-ed01-450d-a0ab-f20fff47ed32 encryption=none name=stephc rsyncurl=192.168.0.104:video/ type=rsync timestamp=1397865844.925354s","refs/heads/git-annex:remote.log") @(yesod-core-1.2.3:Yesod.Core.Class.Yesod ./Yesod/Core/Class/Yesod.hs:471:5) +19/Apr/2014:01:31:50 -0400 [Error#yesod-core] unknown response from git cat-file ("fe428a7a-25a2-4c2e-b01f-315c490cbe45 encryption=none name=myrsync rsyncurl=/home/anarcat/video/ type=rsync timestamp=1397868063.038898s","refs/heads/git-annex:remote.log") @(yesod-core-1.2.3:Yesod.Core.Class.Yesod ./Yesod/Core/Class/Yesod.hs:471:5) +19/Apr/2014:01:31:57 -0400 [Error#yesod-core] unknown response from git cat-file ("","refs/heads/git-annex:remote.log") @(yesod-core-1.2.3:Yesod.Core.Class.Yesod ./Yesod/Core/Class/Yesod.hs:471:5) +[2014-04-19 01:32:03 EDT] TransferScanner: Syncing with test, mnt +Depuis /mnt/video + * [nouvelle branche] synced/git-annex -> test/synced/git-annex + * [nouvelle branche] synced/master -> test/synced/master +fatal: 'mnt' does not appear to be a git repository +fatal: Could not read from remote repository. + +Please make sure you have the correct access rights +and the repository exists. +Already up-to-date. +[2014-04-19 01:32:21 EDT] main: warning git-annex has been shut down + +(Recording state in git...) +(Recording state in git...) +(Recording state in git...) +(Recording state in git...) +"""]] + +the last line repeats about 4000 times. + +i would love to paste the daemon.log.1 file, but it seems like it containts encryption credentials... which i have no idea how to get rid of or change. diff --git a/doc/bugs/git-annex_branch_shows_commit_with_looong_commitlog/comment_1_b83888a98075125dd043f323c99da03b._comment b/doc/bugs/git-annex_branch_shows_commit_with_looong_commitlog/comment_1_b83888a98075125dd043f323c99da03b._comment new file mode 100644 index 0000000000..75bfd73685 --- /dev/null +++ b/doc/bugs/git-annex_branch_shows_commit_with_looong_commitlog/comment_1_b83888a98075125dd043f323c99da03b._comment @@ -0,0 +1,25 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.191" + subject="comment 1" + date="2014-04-20T17:11:02Z" + content=""" +Is there one commit with this long message, or 12 thousand commits each adding another (recovery from race) to the pyramid? + +
+ - Also safely handles a race that can occur if a change is being pushed
+ - into the branch at the same time. When the race happens, the commit will
+ - be made on top of the newly pushed change, but without the index file
+ - being updated to include it. The result is that the newly pushed
+ - change is reverted. This race is detected and another commit made
+ - to fix it.
+
+ +If there is only one message, then it must have tried 12k times to commit to the git-annex branch and each time something else pushed or commited to the git-annex branch and overwrote its commit. This seems statistically unlikely. (Also there's locking to prevent multiple local git-annex processes from committing at the same time.) + +There have been a few other unexplained reports of this race detection code repeatedly triggering. + +> \"shutdown the assistant in yet another panic\" + +This implies some hasty, perhaps unusual shutdown method, and some unusual situation. I think you could tell me more about what was going on. +"""]] diff --git a/doc/bugs/git-annex_branch_shows_commit_with_looong_commitlog/comment_2_4a7d824b6e75693cf47f6efbf2c99e2e._comment b/doc/bugs/git-annex_branch_shows_commit_with_looong_commitlog/comment_2_4a7d824b6e75693cf47f6efbf2c99e2e._comment new file mode 100644 index 0000000000..0eeabf070d --- /dev/null +++ b/doc/bugs/git-annex_branch_shows_commit_with_looong_commitlog/comment_2_4a7d824b6e75693cf47f6efbf2c99e2e._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="https://id.koumbit.net/anarcat" + ip="72.0.72.144" + subject="comment 2" + date="2014-04-20T23:58:00Z" + content=""" +this was a single commit. + +i am not sure i can extract much more information from my memory: details are hazy as i was working late on a problem that night... sorry! +"""]] diff --git a/doc/bugs/git-annex_clears_files__39___og+r_permissions_when_rsync_transfer_is_interrupted_and_resumed.mdwn b/doc/bugs/git-annex_clears_files__39___og+r_permissions_when_rsync_transfer_is_interrupted_and_resumed.mdwn new file mode 100644 index 0000000000..2e86f488de --- /dev/null +++ b/doc/bugs/git-annex_clears_files__39___og+r_permissions_when_rsync_transfer_is_interrupted_and_resumed.mdwn @@ -0,0 +1,47 @@ +### Please describe the problem. + +umask is 022 on both hosts +If one does ls -lL on source repo, the files are shown 644. + +Now, "git annex get" from a clone done over ssh generally preserves 644 ... except if the transfer (rsync) is interrupted, and then resumed. +In fact, looks like the temp files in .git/annex/tmp have the og+r bits cleared during the resumed transfer. + +So this is inconsistent: I don't see why permissions should be different, depending whether or not there was an interruption in the transfer. +Plus, og+r permissions can actually be important for setups like serving contents using Samba. + +### What steps will reproduce the problem? + + cd dir1 + git init + git annex init + touch a + truncate -s 10G b + git annex add . + git commit -m 'new' + + git clone localhost:/path/to/dir1 dir2 + cd dir2 + git annex get + ctrl^c + git annex get + ls -lL + ... see different perms + + + +### What version of git-annex are you using? On what operating system? + +git-annex version: 5.20140411-gda795e0 +Linux + +### Please provide any additional information below. + +[[!format sh """ +# If you can, paste a complete transcript of the problem occurring here. +# If the problem is with the git-annex assistant, paste in .git/annex/daemon.log + + +# End of transcript or log. +"""]] + +> [[fixed|done]]; brought back -p on non-crippled file systems --[[Joey]] diff --git a/doc/bugs/git-annex_clears_files__39___og+r_permissions_when_rsync_transfer_is_interrupted_and_resumed/comment_1_0fc5c7251ead7a0fbbcd357a8bc53f05._comment b/doc/bugs/git-annex_clears_files__39___og+r_permissions_when_rsync_transfer_is_interrupted_and_resumed/comment_1_0fc5c7251ead7a0fbbcd357a8bc53f05._comment new file mode 100644 index 0000000000..48069eebdb --- /dev/null +++ b/doc/bugs/git-annex_clears_files__39___og+r_permissions_when_rsync_transfer_is_interrupted_and_resumed/comment_1_0fc5c7251ead7a0fbbcd357a8bc53f05._comment @@ -0,0 +1,18 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.191" + subject="comment 1" + date="2014-04-17T18:32:40Z" + content=""" +(I think you forgot to mention you were using direct mode.) + +Like git, git-annex does not preserve file permissions. If you want to ensure that a group or everyone can read file in a git repository, you have to use the core.sharedRepository git configuration. git-annex will also honor that. + +git-annex will try to preserve the execute bit, since git does support that single permission bit. But even this cannot be guaranteed. (Eg, when using special remotes which have no concept of file permissions.) + +Interrupting rsync and resuming it does cause rsync to not transfer through permissions. This is rsync's normal behavior when not using -p. git-annex used to use rsync -p to preserve whatever file permissions there were. However, , and then [[!commit f92eaf631509d02491c1b0ebfbb15145f80df797]]. + +It looks like I could preserve the execute bit across interrupt and resume by using rsync's --executability option. + +Or, I could use the -p when git-annex is running in a non-crippled filesystem. +"""]] diff --git a/doc/bugs/git-annex_clears_files__39___og+r_permissions_when_rsync_transfer_is_interrupted_and_resumed/comment_2_992c1a51d0300bd676cb431688efa524._comment b/doc/bugs/git-annex_clears_files__39___og+r_permissions_when_rsync_transfer_is_interrupted_and_resumed/comment_2_992c1a51d0300bd676cb431688efa524._comment new file mode 100644 index 0000000000..f32a4a70fa --- /dev/null +++ b/doc/bugs/git-annex_clears_files__39___og+r_permissions_when_rsync_transfer_is_interrupted_and_resumed/comment_2_992c1a51d0300bd676cb431688efa524._comment @@ -0,0 +1,13 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawln3ckqKx0x_xDZMYwa9Q1bn4I06oWjkog" + nickname="Michael" + subject="comment 2" + date="2014-04-17T21:19:10Z" + content=""" +Hi Joey, + +In fact, this is indirect mode on Linux, ext4. +I'm less worried about preserving +x mode (though I can see why it would be useful). Here I'm referring to plain \"group\" and \"other\" read permissions being cleared. + +And I just did a test with a standalone rsync, using rsync -P localhost:file file2 and interrupting it, the partial (and final after resume) file2 still is 644 (and not 600 like in git-annex case). +"""]] diff --git a/doc/bugs/git-annex_clears_files__39___og+r_permissions_when_rsync_transfer_is_interrupted_and_resumed/comment_3_3001a11839eff6a4c3a9f12096b29704._comment b/doc/bugs/git-annex_clears_files__39___og+r_permissions_when_rsync_transfer_is_interrupted_and_resumed/comment_3_3001a11839eff6a4c3a9f12096b29704._comment new file mode 100644 index 0000000000..b365baa752 --- /dev/null +++ b/doc/bugs/git-annex_clears_files__39___og+r_permissions_when_rsync_transfer_is_interrupted_and_resumed/comment_3_3001a11839eff6a4c3a9f12096b29704._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawln3ckqKx0x_xDZMYwa9Q1bn4I06oWjkog" + nickname="Michael" + subject="comment 3" + date="2014-04-17T21:19:59Z" + content=""" +I think -p on non-crippled does make sense, and -E does too for crippled. +"""]] diff --git a/doc/bugs/git-annex_clears_files__39___og+r_permissions_when_rsync_transfer_is_interrupted_and_resumed/comment_4_a13abb45b9a94d275177641db0538765._comment b/doc/bugs/git-annex_clears_files__39___og+r_permissions_when_rsync_transfer_is_interrupted_and_resumed/comment_4_a13abb45b9a94d275177641db0538765._comment new file mode 100644 index 0000000000..919adc2e7b --- /dev/null +++ b/doc/bugs/git-annex_clears_files__39___og+r_permissions_when_rsync_transfer_is_interrupted_and_resumed/comment_4_a13abb45b9a94d275177641db0538765._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawln3ckqKx0x_xDZMYwa9Q1bn4I06oWjkog" + nickname="Michael" + subject="comment 4" + date="2014-04-17T21:22:16Z" + content=""" +s/and not 600/and not 400/ + +In my ideal case I'd like to see indirect git-annex to set files to 444 (if umask in destination doesn't prevent that otherwise). +"""]] diff --git a/doc/bugs/git-annex_clears_files__39___og+r_permissions_when_rsync_transfer_is_interrupted_and_resumed/comment_5_faac2d48950307ce245f0da501ace730._comment b/doc/bugs/git-annex_clears_files__39___og+r_permissions_when_rsync_transfer_is_interrupted_and_resumed/comment_5_faac2d48950307ce245f0da501ace730._comment new file mode 100644 index 0000000000..57db29c8ab --- /dev/null +++ b/doc/bugs/git-annex_clears_files__39___og+r_permissions_when_rsync_transfer_is_interrupted_and_resumed/comment_5_faac2d48950307ce245f0da501ace730._comment @@ -0,0 +1,9 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawln3ckqKx0x_xDZMYwa9Q1bn4I06oWjkog" + nickname="Michael" + subject="comment 5" + date="2014-04-17T21:32:35Z" + content=""" +core.sharedRepository does fix things here. Thanks Joey! +I'm all set for my use case. +"""]] diff --git a/doc/bugs/git-annex_clears_files__39___og+r_permissions_when_rsync_transfer_is_interrupted_and_resumed/comment_6_7df03eee7d5dc5a7ed0c9abef5053788._comment b/doc/bugs/git-annex_clears_files__39___og+r_permissions_when_rsync_transfer_is_interrupted_and_resumed/comment_6_7df03eee7d5dc5a7ed0c9abef5053788._comment new file mode 100644 index 0000000000..bfed27fb48 --- /dev/null +++ b/doc/bugs/git-annex_clears_files__39___og+r_permissions_when_rsync_transfer_is_interrupted_and_resumed/comment_6_7df03eee7d5dc5a7ed0c9abef5053788._comment @@ -0,0 +1,17 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawln3ckqKx0x_xDZMYwa9Q1bn4I06oWjkog" + nickname="Michael" + subject="comment 6" + date="2014-04-18T18:32:22Z" + content=""" +One issue (bug) still remains: git annex does respect + +sharedRepository = world + +but not + +sharedRepository = 0644 + +In the later case, with indirect mode, files end up with 400 permissions. + +"""]] diff --git a/doc/bugs/git-annex_fails_to_initialize_under_Windows/comment_3_7aeeccd6c4bd97224980a2752e0f8ba8._comment b/doc/bugs/git-annex_fails_to_initialize_under_Windows/comment_3_7aeeccd6c4bd97224980a2752e0f8ba8._comment new file mode 100644 index 0000000000..aa4d513f8f --- /dev/null +++ b/doc/bugs/git-annex_fails_to_initialize_under_Windows/comment_3_7aeeccd6c4bd97224980a2752e0f8ba8._comment @@ -0,0 +1,14 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.191" + subject="comment 3" + date="2014-04-17T21:08:36Z" + content=""" +@ayutheos, can you confirm that running this git command fails the same way? + +git checkout -B annex/direct/master + +What version of git do you have installed? + +(Note to self: This checkout happens when enabling direct mode.. Works for me in a new git repo made on FAT. This repo does not have a .git/index file, and the error message \"fatal: index file open failed: Invalid argument\" comes from git when it tries to read the index file.) +"""]] diff --git a/doc/bugs/git-annex_fails_to_initialize_under_Windows/comment_4_12b6ed59c8b7ded6b6b9150b32e58ce4._comment b/doc/bugs/git-annex_fails_to_initialize_under_Windows/comment_4_12b6ed59c8b7ded6b6b9150b32e58ce4._comment new file mode 100644 index 0000000000..5ba16a0cbd --- /dev/null +++ b/doc/bugs/git-annex_fails_to_initialize_under_Windows/comment_4_12b6ed59c8b7ded6b6b9150b32e58ce4._comment @@ -0,0 +1,17 @@ +[[!comment format=mdwn + username="ayutheos" + ip="49.125.229.80" + subject="comment 4" + date="2014-04-19T03:13:17Z" + content=""" +I'm using git version 1.8.4.msysgit.0 on Windows 7 64-bit. + +I took a screenshot of git annex init command at [[http://i.imgur.com/YV9vean.png]] + +I deleted both the .git and .t folders before re-trying to initialise git annex. However when initialising git annex the 2nd time, folder .t was not created. + +Folder `D:\pictures` is an existing folder. + + + +"""]] diff --git a/doc/bugs/git-annex_fails_to_initialize_under_Windows/comment_5_f975059733fca678e93b791b2a250535._comment b/doc/bugs/git-annex_fails_to_initialize_under_Windows/comment_5_f975059733fca678e93b791b2a250535._comment new file mode 100644 index 0000000000..319cb3617b --- /dev/null +++ b/doc/bugs/git-annex_fails_to_initialize_under_Windows/comment_5_f975059733fca678e93b791b2a250535._comment @@ -0,0 +1,13 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.191" + subject="comment 5" + date="2014-04-20T18:35:39Z" + content=""" +You might want to try upgrading to msysgit 1.9.0, which is the one I am using for windows development. + +So, your screenshot shows that git checkout -B annex/direct/master worked ok when you ran it, but then when git-annex init failed, it was running +the same command, only with a -q also. The -q is only quiet mode, shouldn't matter. + +(The .t folder is created when running git-annex test, so not relevant.) +"""]] diff --git a/doc/bugs/protocol_mismatch_after_interrupt.mdwn b/doc/bugs/protocol_mismatch_after_interrupt.mdwn new file mode 100644 index 0000000000..837690eac8 --- /dev/null +++ b/doc/bugs/protocol_mismatch_after_interrupt.mdwn @@ -0,0 +1,31 @@ +### Please describe the problem. + +git annex now fails to transfer a fail with: `protocol version mismatch -- is your shell clean?` + +### What steps will reproduce the problem? + +start a transfer, then switch between your wireless and wired connexions (I am using network-manager), then interrupt the transfer with control-c. + +### What version of git-annex are you using? On what operating system? + +on my side: 5.20140306~bpo70 on debian wheezy amd64 + +on the other side: 4.20130815 on ubuntu saucy i386 + +### Please provide any additional information below. + +[[!format sh """ +anarcat@angela:video$ git annex copy --to t films/foo.mkv +copy films/foo.mkv (checking t...) (to t...) +protocol version mismatch -- is your shell clean? +(see the rsync man page for an explanation) +rsync error: protocol incompatibility (code 2) at compat.c(174) [sender=3.0.9] + + rsync failed -- run git annex again to resume file transfer +failed +git-annex: copy: 1 failed +"""]] + +workaround: `cd .git/annex/; mv transfer transfer.old` on the other side. + +-- [[anarcat]] diff --git a/doc/bugs/protocol_mismatch_after_interrupt/comment_1_415de83053dc61a64cf2e301223f1916._comment b/doc/bugs/protocol_mismatch_after_interrupt/comment_1_415de83053dc61a64cf2e301223f1916._comment new file mode 100644 index 0000000000..6247cf42ef --- /dev/null +++ b/doc/bugs/protocol_mismatch_after_interrupt/comment_1_415de83053dc61a64cf2e301223f1916._comment @@ -0,0 +1,11 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.191" + subject="comment 1" + date="2014-04-20T16:52:15Z" + content=""" +Last time rsync seemed to fail like this it was really the remote git-annex-shell failing on an encoding problem: +[[!commit 0b12db64d834979d49ed378235b0c19b34e4a4d6]] + +It seems I would need to see the transfer info files you moved out of the way to say more. Or you could copy the back, reproduce the problem, find the git-annex-shell command that is being run (using --debug), and see if you can run it on the remote system and reproduce the problem there without rsync in the picture, in order to get the actual error message. +"""]] diff --git a/doc/bugs/remote_not_showing_up_in_webapp/comment_2_10638e99e2e11460f99266f56adbc1db._comment b/doc/bugs/remote_not_showing_up_in_webapp/comment_2_10638e99e2e11460f99266f56adbc1db._comment new file mode 100644 index 0000000000..fb2976657e --- /dev/null +++ b/doc/bugs/remote_not_showing_up_in_webapp/comment_2_10638e99e2e11460f99266f56adbc1db._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="https://id.koumbit.net/anarcat" + ip="72.0.72.144" + subject="comment 2" + date="2014-04-19T04:26:57Z" + content=""" +i hit that thing again, utterly confused. it happens all the time with my laptop, which has access to my workstation, but not the other way around. so from the POV of my laptop, things make sense somehow, but from the workstation, the laptop doesn't show up at all, and when there's a transfer, it says it's into the unknown. + +really confusing... surely there's a way to show the remote name at least... +"""]] diff --git a/doc/design/assistant/polls/Android_default_directory.mdwn b/doc/design/assistant/polls/Android_default_directory.mdwn index 869aedf4b5..6d5a07ee3c 100644 --- a/doc/design/assistant/polls/Android_default_directory.mdwn +++ b/doc/design/assistant/polls/Android_default_directory.mdwn @@ -4,4 +4,4 @@ Same as the desktop webapp, users will be able to enter a directory they want the first time they run it, but to save typing on android, anything that gets enough votes will be included in a list of choices as well. -[[!poll open=yes expandable=yes 66 "/sdcard/annex" 6 "Whole /sdcard" 6 "DCIM directory (photos and videos only)" 1 "Same as for regular git-annex. ~/annex/"]] +[[!poll open=yes expandable=yes 66 "/sdcard/annex" 6 "Whole /sdcard" 7 "DCIM directory (photos and videos only)" 1 "Same as for regular git-annex. ~/annex/"]] diff --git a/doc/design/assistant/polls/prioritizing_special_remotes.mdwn b/doc/design/assistant/polls/prioritizing_special_remotes.mdwn index c6dbb376cb..a87a674ba4 100644 --- a/doc/design/assistant/polls/prioritizing_special_remotes.mdwn +++ b/doc/design/assistant/polls/prioritizing_special_remotes.mdwn @@ -6,7 +6,7 @@ locally paired systems, and remote servers with rsync. Help me prioritize my work: What special remote would you most like to use with the git-annex assistant? -[[!poll open=yes 16 "Amazon S3 (done)" 12 "Amazon Glacier (done)" 9 "Box.com (done)" 71 "My phone (or MP3 player)" 25 "Tahoe-LAFS" 10 "OpenStack SWIFT" 33 "Google Drive"]] +[[!poll open=yes 16 "Amazon S3 (done)" 12 "Amazon Glacier (done)" 9 "Box.com (done)" 72 "My phone (or MP3 player)" 25 "Tahoe-LAFS" 10 "OpenStack SWIFT" 33 "Google Drive"]] This poll is ordered with the options I consider easiest to build listed first. Mostly because git-annex already supports them and they diff --git a/doc/design/assistant/telehash.mdwn b/doc/design/assistant/telehash.mdwn index 3b427b42f0..2ecf9ec718 100644 --- a/doc/design/assistant/telehash.mdwn +++ b/doc/design/assistant/telehash.mdwn @@ -83,7 +83,7 @@ Advantages: exchange protocols implemented in such a daemon to allow SSH-less transfers. * Security holes in telehash would not need to compromise the entire - git-annex. gathd could be sandboxed in one way or another. + git-annex. daemon could be sandboxed in one way or another. Disadvantages: diff --git a/doc/design/git-remote-daemon.mdwn b/doc/design/git-remote-daemon.mdwn index 6b8e0646ff..270ceaa472 100644 --- a/doc/design/git-remote-daemon.mdwn +++ b/doc/design/git-remote-daemon.mdwn @@ -69,40 +69,44 @@ the webapp. ## emitted messages -* `CONNECTED $remote` +* `CONNECTED uri` Sent when a connection has been made with a remote. -* `DISCONNECTED $remote` +* `DISCONNECTED uri` Sent when connection with a remote has been lost. -* `SYNCING $remote` +* `SYNCING uri` Indicates that a pull or a push with a remote is in progress. Always followed by DONESYNCING. -* `DONESYNCING 1|0 $remote` +* `DONESYNCING uri 1|0` Indicates that syncing with a remote is done, and either succeeded (1) or failed (0). +* `WARNING uri string` + + A message to display to the user about a remote. + ## consumed messages * `PAUSE` - This indicates that the network connection has gone down, - or the user has requested a pause. + The user has requested a pause. git-remote-daemon should close connections and idle. - Affects all remotes. +* `LOSTNET` + + The network connection has been lost. + git-remote-daemon should close connections and idle. * `RESUME` - This indicates that the network connection has come back up, or the user - has asked it to run again. Start back up network connections. - - Affects all remotes. + Undoes PAUSE or LOSTNET. + Start back up network connections. * `CHANGED ref ...` @@ -133,9 +137,9 @@ encryption. Encryption is not part of this design. (XMPP does not do end-to-end encryption, but might be supported transitionally.) -Ditto for authentication that we're talking to who we indend to talk to. -Any public key data etc used for authenticion is part of the remote's -configuration (or hidden away in a secure chmodded file, if neccesary). +Ditto for authentication that we're talking to who we intend to talk to. +Any public key data etc used for authentication is part of the remote's +configuration (or hidden away in a secure chmodded file, if necessary). This design does not concern itself with authenticating the remote node, it just takes the auth token and uses it. @@ -158,15 +162,7 @@ over stdio to inform when refs on the remote have changed. No pushing is done for CHANGED, since git handles ssh natively. -TODO: - -* Remote system might not be available. Find a smart way to detect it, - ideally w/o generating network traffic. One way might be to check - if the ssh connection caching control socket exists, for example. -* Remote system might be available, and connection get lost. Should - reconnect, but needs to avoid bad behavior (ie, constant reconnect - attempts.) -* Detect if old system had a too old git-annex-shell and avoid bad behavior +TODO: test! ## telehash diff --git a/doc/devblog/day_133__db_and_bugfixes.mdwn b/doc/devblog/day_133__db_and_bugfixes.mdwn index b844708dc8..5ba1df20e6 100644 --- a/doc/devblog/day_133__db_and_bugfixes.mdwn +++ b/doc/devblog/day_133__db_and_bugfixes.mdwn @@ -4,7 +4,7 @@ several stages, starting with using it for generating views, and ending(?) with using it for direct mode file mappings. Not sure I'm ready to dive into that yet, so instead spent the rest of the -day working on small bugfixes and improvemnts. Only two significant ones.. +day working on small bugfixes and improvements. Only two significant ones.. Made the webapp use a constant time string comparison (from `securemem`) to check if its auth token is valid. This could help avoid a potential diff --git a/doc/devblog/day_149__signal.mdwn b/doc/devblog/day_149__signal.mdwn index 7327c679c9..2bcb01a728 100644 --- a/doc/devblog/day_149__signal.mdwn +++ b/doc/devblog/day_149__signal.mdwn @@ -1,8 +1,8 @@ [[!meta title="day 150 signal"]] The git-remote-daemon now robustly handles loss of signal, with -reconnection backoffs. And it detects if the remote ssh server has a too -old version of git-annex-shell and the webapp will display a warning +reconnection backoffs. And it detects if the remote ssh server has too +old a version of git-annex-shell and the webapp will display a warning message. [[!img /assistant/connection.png]] diff --git a/doc/devblog/day_151__birthday_bug.mdwn b/doc/devblog/day_151__birthday_bug.mdwn new file mode 100644 index 0000000000..251bfb935f --- /dev/null +++ b/doc/devblog/day_151__birthday_bug.mdwn @@ -0,0 +1,18 @@ +Pushed out a new release today, fixing two important bugs, followed by a +second release which fixed the bugs harder. + +Automatic upgrading was broken on OSX. The webapp will tell you upgrading +failed, and you'll need to manually download the .dmg and install it. + +With help from Maximiliano Curia, finally tracked down a bug I have been +chasing for a while where the assistant would start using a lot of CPU +while not seeming to be busy doing anything. Turned out to be triggered by +a scheduled fsck that was configured to run once a month with no particular +day specified. + +That bug turned out to affect users who first scheduled such a fsck job +after the 11th day of the month. So I expedited putting a release out to +avoid anyone else running into it starting tomorrow. + +(Oddly, the 11th day of this month also happens to be my birthday. I did not +expect to have to cut 2 releases today..) diff --git a/doc/devblog/day_152__more_ssh_connection_caching.mdwn b/doc/devblog/day_152__more_ssh_connection_caching.mdwn new file mode 100644 index 0000000000..ad472b5e55 --- /dev/null +++ b/doc/devblog/day_152__more_ssh_connection_caching.mdwn @@ -0,0 +1,37 @@ +Made ssh connection caching be used in several more places. `git annex +sync` will use it when pushing/pulling to a remote, as will the assistant. +And `git-annex remotedaemon` also uses connection caching. So, when +a push lands on a ssh remote, the assistant will immediately notice it, and +pull down the change over the same TCP connection used for the +notifications. + +This was a bit of a pain to do. Had to set `GIT_SSH=git-annex` and then +when git invokes git-annex as ssh, it runs ssh with the connection caching +parameters. + +Also, improved the network-manager and wicd code, so it detects when a +connection has gone down. That propagates through to the remote-daemon, +which closes all ssh connections. I need to also find out how to detect +network connections/disconnections on OSX.. + +Otherwise, the remote-control branch seems ready to be merged. But I want +to test it for a while first. + +---- + +Followed up on yesterday's bug with writing some test cases for +Utility.Scheduled, which led to some more bug fixes. Luckily nothing +I need to rush out a release over. In the end, the code got a lot +simpler and clearer. + +[[!format haskell """ +-- Check if the new Day occurs one month or more past the old Day. +oneMonthPast :: Day -> Day -> Bool +new `oneMonthPast` old = fromGregorian y (m+1) d <= new + where + (y,m,d) = toGregorian old +"""]] + +------- + +Today's work was sponsored by Asbjørn Sloth Tønnesen. diff --git a/doc/devblog/day_153__remotedaemon_has_landed.mdwn b/doc/devblog/day_153__remotedaemon_has_landed.mdwn new file mode 100644 index 0000000000..5033b32b25 --- /dev/null +++ b/doc/devblog/day_153__remotedaemon_has_landed.mdwn @@ -0,0 +1,10 @@ +After fixing a few bugs in the `remotecontrol` branch, It's landed in +`master`. Try a daily build today, and see if the assistant can keep in +sync using nothing more than a remote ssh repository! + +So, now all the groundwork for telehash is laid too. I only need a +telehash library to start developing on top of. Development on telehash-c +is continuing, but I'm more excited that +[htelehash](https://github.com/alanz/htelehash/tree/v2) +has been revived and is being updated to the v2 protocol, seemingly quite +quickly. diff --git a/doc/devblog/day_153__remotedaemon_has_landed/comment_1_f19ae6b3d6f33a68e4ffe0c32f788745._comment b/doc/devblog/day_153__remotedaemon_has_landed/comment_1_f19ae6b3d6f33a68e4ffe0c32f788745._comment new file mode 100644 index 0000000000..5ff090ffde --- /dev/null +++ b/doc/devblog/day_153__remotedaemon_has_landed/comment_1_f19ae6b3d6f33a68e4ffe0c32f788745._comment @@ -0,0 +1,13 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawkC0W3ZQERUaTkHoks6k68Tsp1tz510nGo" + nickname="Georg" + subject=" remotedaemon in pre-built tarballs" + date="2014-04-17T07:40:25Z" + content=""" +Hi Joey, + +can you tell me when the pre-built Linux tarballs will include the remotedaemon? +Are they updated on a daily basis? + +Best regards, Georg +"""]] diff --git a/doc/devblog/day_153__remotedaemon_has_landed/comment_2_fbf0c50f772e958af638d2b72dac73f5._comment b/doc/devblog/day_153__remotedaemon_has_landed/comment_2_fbf0c50f772e958af638d2b72dac73f5._comment new file mode 100644 index 0000000000..5f81fde5cf --- /dev/null +++ b/doc/devblog/day_153__remotedaemon_has_landed/comment_2_fbf0c50f772e958af638d2b72dac73f5._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.191" + subject="comment 2" + date="2014-04-17T19:31:30Z" + content=""" +The daily builds are updated on a daily basis, so already include it. + +The release builds are updated on each release, and so do not. +"""]] diff --git a/doc/devblog/day_154__catching_up.mdwn b/doc/devblog/day_154__catching_up.mdwn new file mode 100644 index 0000000000..7c49a788e2 --- /dev/null +++ b/doc/devblog/day_154__catching_up.mdwn @@ -0,0 +1,13 @@ +Worked through message backlog today. Got it down from around 70 to just +37. Was able to fix some bugs, including making the webapp start up more +robustly in some misconfigurations. + +Added a new `findref` command which may be useful in a git `update` hook to +deny pushes of refs if the annexed content has not been sent first. + +---- + +BTW, I also added a new `reinit` command a few days ago, which can be +useful if you're cloning back a deleted repository. + +Also a few days ago, I made `uninit` a *lot* faster. diff --git a/doc/devblog/day_155__missing_bits.mdwn b/doc/devblog/day_155__missing_bits.mdwn new file mode 100644 index 0000000000..aa8fd9d4ee --- /dev/null +++ b/doc/devblog/day_155__missing_bits.mdwn @@ -0,0 +1,27 @@ +Sometimes you don't notice something is missing for a long time until +it suddenly demands attention. Like today. + +Seems the webapp never had a way to stop using XMPP and delete the XMPP +password. So I added one. + +The new support for instantly noticing changes on a ssh remote forgot to +start up a connection to a new remote after it was created. Fixed that. + +(While doing some testing on Android for unrelated reasons, I noticed that +my android tablet was pushing photos to a ssh server and my laptop +immediately noticed and downloaded them from tere, which is an excellent +demo. I will deploy this on my trip in Brazil next week. Yes, I'm spending +2 weeks in Brazil with git-annex users; more on this later.) + +Finally, it turns out that "installing" git-annex from the standalone +tarball, or DMG, on a server didn't make it usable by the webapp. Because +git-annex shell is not in PATH on the server, and indeed git and rsync may +not be in PATH either if they were installed with the git-annex bundle. +Fixed this by making the bundle install a ~/.ssh/git-annex-wrapper, which +the webapp will detect and use. + +Also, quite a lot of other bug chasing activity. + +---- + +Today's work was sponsored by Thomas Koch. diff --git a/doc/devblog/day_155__missing_bits/comment_1_76424498600ba603946035efffb88023._comment b/doc/devblog/day_155__missing_bits/comment_1_76424498600ba603946035efffb88023._comment new file mode 100644 index 0000000000..d9ee528e0a --- /dev/null +++ b/doc/devblog/day_155__missing_bits/comment_1_76424498600ba603946035efffb88023._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://id.koumbit.net/anarcat" + ip="72.0.72.144" + subject="comment 1" + date="2014-04-20T23:58:51Z" + content=""" +thanks! +"""]] diff --git a/doc/encryption/comment_2_f19c9bb519a7017f0731fd0e8780ed74._comment b/doc/encryption/comment_2_f19c9bb519a7017f0731fd0e8780ed74._comment deleted file mode 100644 index bf43303830..0000000000 --- a/doc/encryption/comment_2_f19c9bb519a7017f0731fd0e8780ed74._comment +++ /dev/null @@ -1,22 +0,0 @@ -[[!comment format=mdwn - username="https://openid.stackexchange.com/user/e65e6d0e-58ba-41de-84cc-1f2ba54cf574" - nickname="Mica Semrick" - subject="Encrypt with pub or sub?" - date="2014-04-08T03:56:36Z" - content=""" -Forgive me, I'm a bit new to PGP. - -I do: - - $ gpg --list-keys - /home/user/.gnupg/pubring.gpg - ------------------------------ - pub 2048R/41363A6A 2014-04-03 - uid A Guy (git-annex key) - sub 2048R/77998J8TDY 2014-04-03 - -and see the pub and the sub key. - -When I init a new special remote and want encryption, should I give the init command the pub or the sub key? Or does git annex sort that out itself? - -"""]] diff --git a/doc/forum/Big_repository_vs._multiple_small.mdwn b/doc/forum/Big_repository_vs._multiple_small.mdwn new file mode 100644 index 0000000000..c77dd02a55 --- /dev/null +++ b/doc/forum/Big_repository_vs._multiple_small.mdwn @@ -0,0 +1,8 @@ +I am new to git (but extensively used SVN). + +In SVN I could have a big fat repository but only check out sub-trees is it. +Is that also common in git(-annex) / recommended? + +E.g., should I create a big-fat repos with all data I have (personal data, music, videos, ...) and check out only the appropriate subtress or create a repository for each purpose? E.g., one for Fotos, Music, OnTheGoData, ebooks, ... + +What happens if I have a git-annex repository checked out at my laptop (say, d:\Files) and within it, check out another one (e.g. d:\Files\Library)? diff --git a/doc/forum/Big_repository_vs._multiple_small/comment_1_8e21ee3c674ef6e595bdab53dd5c2356._comment b/doc/forum/Big_repository_vs._multiple_small/comment_1_8e21ee3c674ef6e595bdab53dd5c2356._comment new file mode 100644 index 0000000000..707a1cca6e --- /dev/null +++ b/doc/forum/Big_repository_vs._multiple_small/comment_1_8e21ee3c674ef6e595bdab53dd5c2356._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://me.yahoo.com/a/FHnTlSBo1eCGJRwueeKeB6.RCaPbGMPr5jxx8A--#ce0d8" + nickname="Hamza" + subject="comment 1" + date="2014-04-14T15:32:34Z" + content=""" +In my setup I have one repository for each category (photos documents videos) it is faster then single giant repository plus it makes sharing with other people easier since you can let people clone one category at a time. +"""]] diff --git a/doc/forum/Big_repository_vs._multiple_small/comment_2_656c62351502492d20e8490242e51169._comment b/doc/forum/Big_repository_vs._multiple_small/comment_2_656c62351502492d20e8490242e51169._comment new file mode 100644 index 0000000000..22fa765428 --- /dev/null +++ b/doc/forum/Big_repository_vs._multiple_small/comment_2_656c62351502492d20e8490242e51169._comment @@ -0,0 +1,14 @@ +[[!comment format=mdwn + username="divB" + ip="128.12.90.218" + subject="comment 2" + date="2014-04-15T18:23:13Z" + content=""" +Thank you, that's a good point! + +Does this also mean that a repository in git(-annex) is \"all or nothing\"? + +For example, I cannot share/clone parts of it? Or define access rights within a repository? + +With SVN for example, I have a big repository \"university\" and it contains all stuff of projects/research. Each individual directory is only shared with the persons whom I worked together in this particular project. In short: In git, this should not be that way, right? +"""]] diff --git a/doc/forum/Big_repository_vs._multiple_small/comment_3_e9c44ea364513f090844f46af2ea46a1._comment b/doc/forum/Big_repository_vs._multiple_small/comment_3_e9c44ea364513f090844f46af2ea46a1._comment new file mode 100644 index 0000000000..063260ba10 --- /dev/null +++ b/doc/forum/Big_repository_vs._multiple_small/comment_3_e9c44ea364513f090844f46af2ea46a1._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://id.clacke.se/" + nickname="Claes" + subject="comment 3" + date="2014-04-17T14:04:31Z" + content=""" +Yeah, git does not have the concept of checking out subdirectories that subversion does. You could, however, have different branches with different content that live in the same repo and therefore share the same git-annex backend, so there could be overlap between what files are in what branch without them using up much extra disk space. +"""]] diff --git a/doc/forum/Big_repository_vs._multiple_small/comment_4_82e13580426dc648688e4c26e7ed91ec._comment b/doc/forum/Big_repository_vs._multiple_small/comment_4_82e13580426dc648688e4c26e7ed91ec._comment new file mode 100644 index 0000000000..e79e19814a --- /dev/null +++ b/doc/forum/Big_repository_vs._multiple_small/comment_4_82e13580426dc648688e4c26e7ed91ec._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://me.yahoo.com/a/FHnTlSBo1eCGJRwueeKeB6.RCaPbGMPr5jxx8A--#ce0d8" + nickname="Hamza" + subject="comment 4" + date="2014-04-18T09:16:44Z" + content=""" +with git you can not checkout parts of a repo it is all or nothing but with annex you can download your files dir by dir. When you clone you get symlinks for all files but only the files you want are downloaded. +"""]] diff --git a/doc/forum/Big_repository_vs._multiple_small/comment_5_632aceb71dc6a4a9a4bb03de25a9b21a._comment b/doc/forum/Big_repository_vs._multiple_small/comment_5_632aceb71dc6a4a9a4bb03de25a9b21a._comment new file mode 100644 index 0000000000..182263f397 --- /dev/null +++ b/doc/forum/Big_repository_vs._multiple_small/comment_5_632aceb71dc6a4a9a4bb03de25a9b21a._comment @@ -0,0 +1,23 @@ +[[!comment format=mdwn + username="divB" + ip="74.61.144.53" + subject="comment 5" + date="2014-04-19T05:38:43Z" + content=""" +Thanks! + +But what to my question regarding checking out a repository within a repository? + +I will most likely have a \"home\" repository which I would check out at first level. + +Then, within one directory I would like to (only locally!) check out another, such as \"Library\". + +Something like mount ... to mount one FS within another mount point. + +For SVN I think there exist externals for that ... + +Does this work? + + + +"""]] diff --git a/doc/forum/Corrupt_Repository_Invalid_Object.mdwn b/doc/forum/Corrupt_Repository_Invalid_Object.mdwn new file mode 100644 index 0000000000..af6d8e3538 --- /dev/null +++ b/doc/forum/Corrupt_Repository_Invalid_Object.mdwn @@ -0,0 +1,10 @@ +One of my repositories got corrupted. I am not exactly sure how it happened (was running a series of commands) but I think I accidentally ran regular mv instead of git mv. To fix it I deleted the moved file then checkout the original link however this did not fixed the problem. I ended up with a corrupted repo. Now running any command ends with the following error, + + ga sync + (merging origin/git-annex origin/synced/git-annex into git-annex...) + (Recording state in git...) + error: invalid object 040000 6ad564920e3d78d31c9456f5be3869a0319f9f08 for'3fd/d44' + fatal: git-write-tree: error building trees + git-annex: failed to read sha from git write-tree + +Was wondering how to fix this? I did run git fsck and git annex fsck but non fixed the problem. diff --git a/doc/forum/Corrupt_Repository_Invalid_Object/comment_1_b7fd4b6212b50400342931e70684b96c._comment b/doc/forum/Corrupt_Repository_Invalid_Object/comment_1_b7fd4b6212b50400342931e70684b96c._comment new file mode 100644 index 0000000000..a62e6d345c --- /dev/null +++ b/doc/forum/Corrupt_Repository_Invalid_Object/comment_1_b7fd4b6212b50400342931e70684b96c._comment @@ -0,0 +1,14 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.191" + subject="comment 1" + date="2014-04-17T19:47:54Z" + content=""" +git is complaining about one of the files in `.git/objects` being missing or corrupt. + +It's not likely that some accidental command you ran caused this. More likely a disk error or an unclean shutdown could have left the repository in this state. + +You can try running `git annex repair` which should be able to repair git repositories with this kind of damage. + +Or you can just `git clone` the repository from any other place you have it and move over .git/annex/objects and .git/config to the new repository, discarding the damaged one. +"""]] diff --git a/doc/forum/Starting_assistant_from_CLI.mdwn b/doc/forum/Starting_assistant_from_CLI.mdwn new file mode 100644 index 0000000000..8a4bc3d1bf --- /dev/null +++ b/doc/forum/Starting_assistant_from_CLI.mdwn @@ -0,0 +1,9 @@ +I am unable to start the git-annex assistant/webapp. + +I use OpenBox as desktop manager and the assistant/webapp is not available through the menu. + +Trying to use the CLI, all my attempts fail with a message saying that it(?) is not a git repository!? Since the video show that on first start the assistant/webapp allows a choice of a directory and then creates it, I am not sure as to what git initialized directory does the assistant/webapp requires in this instance. And I also guess that means invoking the webapp from that directory rather than from the directory that contains the standalone git-annex. + +Any help would be appreciated as git-annex really seems to be the app I am looking for. :) + +Thanks diff --git a/doc/forum/Starting_assistant_from_CLI/comment_1_afd51ddb0f1bb3cac528e1d96829ef83._comment b/doc/forum/Starting_assistant_from_CLI/comment_1_afd51ddb0f1bb3cac528e1d96829ef83._comment new file mode 100644 index 0000000000..05c7a12d40 --- /dev/null +++ b/doc/forum/Starting_assistant_from_CLI/comment_1_afd51ddb0f1bb3cac528e1d96829ef83._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="https://me.yahoo.com/a/FHnTlSBo1eCGJRwueeKeB6.RCaPbGMPr5jxx8A--#ce0d8" + nickname="Hamza" + subject="comment 1" + date="2014-04-14T15:35:17Z" + content=""" +running, + + git annex webapp + +should launch the web app. +"""]] diff --git a/doc/forum/Starting_assistant_from_CLI/comment_2_76c34c00cf2065809b15a594023a688b._comment b/doc/forum/Starting_assistant_from_CLI/comment_2_76c34c00cf2065809b15a594023a688b._comment new file mode 100644 index 0000000000..d0ce4b28fe --- /dev/null +++ b/doc/forum/Starting_assistant_from_CLI/comment_2_76c34c00cf2065809b15a594023a688b._comment @@ -0,0 +1,11 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawlqL3QbH6hrzf4XT-OW5IcMj6zSrMWl2dg" + nickname="Michel" + subject="comment 2" + date="2014-04-14T22:45:23Z" + content=""" +Unfortunately, no, I tried this and many other variants, (I tried again just now, to be sure, and I still get the \"git-annex: Not in a git repository.\" message. + +Thanks for trying to help. It is very much appreciated. + +"""]] diff --git a/doc/forum/Starting_assistant_from_CLI/comment_3_f7826867f78b1adbfc2dad2fad4d6720._comment b/doc/forum/Starting_assistant_from_CLI/comment_3_f7826867f78b1adbfc2dad2fad4d6720._comment new file mode 100644 index 0000000000..fbe70c4038 --- /dev/null +++ b/doc/forum/Starting_assistant_from_CLI/comment_3_f7826867f78b1adbfc2dad2fad4d6720._comment @@ -0,0 +1,17 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.191" + subject="comment 3" + date="2014-04-17T20:48:56Z" + content=""" +Yes, the webapp is supposed to be able to be started from anywhere. + +1. If you make a git annex repository and run `git annex webapp` from inside it, it'll start up the webapp on that repository. +2. If `~/.config/git-annex/autostart` lists some git repositories, the webapp will start up in the first listed one. +3. Otherwise, the webapp will walk you through making a new repository. + +Most likely problem then is #2. If you used the webapp once, say in ~/annex and then deleted ~/annex/.git directory, it would try to start up in ~/annex, but it's no longer a git repository so it cannot start. This was a bug, so I've fixed it. +You could work around that problem by deleting `~/.config/git-annex/autostart` too. + +If it's some other problem, you can work around it by going the #1 route and making a git repository by hand (\"git init annex; cd annex; git annex init\") and running the webapp in there. +"""]] diff --git a/doc/forum/Starting_assistant_from_CLI/comment_4_fa7055a232a1dcb743db47308f7acf0b._comment b/doc/forum/Starting_assistant_from_CLI/comment_4_fa7055a232a1dcb743db47308f7acf0b._comment new file mode 100644 index 0000000000..4eea29c5fd --- /dev/null +++ b/doc/forum/Starting_assistant_from_CLI/comment_4_fa7055a232a1dcb743db47308f7acf0b._comment @@ -0,0 +1,14 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawlqL3QbH6hrzf4XT-OW5IcMj6zSrMWl2dg" + nickname="Michel" + subject="comment 4" + date="2014-04-18T00:20:47Z" + content=""" +Thank you. + +The problem was indeed with having a file containing a non-existent ~/.config/git-annex/autostart. + +I can now continue my evaluation of what looks like a very fine and useful piece of software. + +Thanks again for the help. +"""]] diff --git a/doc/forum/best_practices_for_importing_photos__63__.mdwn b/doc/forum/best_practices_for_importing_photos__63__.mdwn new file mode 100644 index 0000000000..2f57f3b35e --- /dev/null +++ b/doc/forum/best_practices_for_importing_photos__63__.mdwn @@ -0,0 +1,13 @@ +What are everyone's tips for importing photos to make best use of metadata and views? + +Let's assume there's no need to be compatible with a photo manager app, but we may be importing lots of duplicates, and while content deduplication is great, I'd like to avoid naming problems too. + +Do you bother to rename your photos? + +Do you use EXIF metadata as git-annex metadata? Selectively or wholesale, with all the redundant tags in EXIF? + +If you do use a photo manager app, do you need to do anything special to make that work? + +Thanks for your responses everyone! + +-mike diff --git a/doc/forum/best_practices_for_importing_photos__63__/comment_1_37f0ae4b552ec2a4a144ddcdc17c8453._comment b/doc/forum/best_practices_for_importing_photos__63__/comment_1_37f0ae4b552ec2a4a144ddcdc17c8453._comment new file mode 100644 index 0000000000..3d17874ad5 --- /dev/null +++ b/doc/forum/best_practices_for_importing_photos__63__/comment_1_37f0ae4b552ec2a4a144ddcdc17c8453._comment @@ -0,0 +1,19 @@ +[[!comment format=mdwn + username="Xyem" + ip="178.79.137.64" + subject="comment 1" + date="2014-04-15T14:25:04Z" + content=""" +git-annex's metadata and views made me stop hopping between programs (digikam, tagsistant etc.) to organise my photos (I had even just started working on my own FUSE tagging filesystem which was effectively going to be tagsistant, but with a git-annex'y backend). + +As usual, my method is probably a little odd :) + +Photos are 'git import'ed into a $(uuidgen) directory (so no worries about filename collisions) and tagged with media=Photograph and tag=untagged. Then I go through them and add relevant tags (one of which is \"xbmc\", no prizes for guessing how that works with the views :]) and move them into a more appropriate directory structure, using gqview and its \"sort manager\". This is really nice and fast, due to it only copying/moving symlinks! + +One thing I'm considering doing it putting a shim between git-annex and gqview, so that it generates entries in the sort manager which are appropriate for the current view. So, for example, if the view is location=*, the sort manager would have: + + location=Malta + location=York + +While it wouldn't get updated if I create new tags (by creating directories in the view), it would save a lot of time creating them every time the view changes. +"""]] diff --git a/doc/forum/best_practices_for_importing_photos__63__/comment_2_7f96f0fe0fc073321bd7c5bbd9048425._comment b/doc/forum/best_practices_for_importing_photos__63__/comment_2_7f96f0fe0fc073321bd7c5bbd9048425._comment new file mode 100644 index 0000000000..349ee432a3 --- /dev/null +++ b/doc/forum/best_practices_for_importing_photos__63__/comment_2_7f96f0fe0fc073321bd7c5bbd9048425._comment @@ -0,0 +1,11 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.191" + subject="comment 2" + date="2014-04-17T20:11:59Z" + content=""" +It seems to me that there is a lot of cruft in EXIF that I would not want to bloat my git-annex branch with storing. That's why [[tips/automatically_adding_metadata]] imports only the listed fields. It's easy to add fields later and re-run the metadata importer on your existing files. + +I have not gotten as far as having any best practices to share. :) + +"""]] diff --git a/doc/forum/git_annex_assistant_-_Changing_repository_information/comment_1_cde71a410200a7478180748fdcde0352._comment b/doc/forum/git_annex_assistant_-_Changing_repository_information/comment_1_cde71a410200a7478180748fdcde0352._comment new file mode 100644 index 0000000000..fa0c615173 --- /dev/null +++ b/doc/forum/git_annex_assistant_-_Changing_repository_information/comment_1_cde71a410200a7478180748fdcde0352._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.191" + subject="comment 1" + date="2014-04-17T20:59:43Z" + content=""" +This information is stored on the git-annex branch, and so it is synced between repositories with the rest of git-annex's data. You only need to change it in one place.. But it's also fine to change it in multiple places if necessary. +"""]] diff --git a/doc/forum/new_linux_arm_tarball_build/comment_10_5f9735ec62478c99b8c814055206cff0._comment b/doc/forum/new_linux_arm_tarball_build/comment_10_5f9735ec62478c99b8c814055206cff0._comment new file mode 100644 index 0000000000..eb3995eb15 --- /dev/null +++ b/doc/forum/new_linux_arm_tarball_build/comment_10_5f9735ec62478c99b8c814055206cff0._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmH9ARM62C6zcEpzh2muCs4wq-GkLRntgQ" + nickname="Randy" + subject="raspbian" + date="2014-04-16T10:59:10Z" + content=""" +This works fairly well for me on Raspian. However I am getting the same error as Justin. + + ERROR: ld.so: object '/usr/lib/arm-linux-gnueabihf/libcofi_rpi.so' from /etc/ld.so.preload cannot be preloaded: ignored. + +I'm ignoring the errors for now, but it's a lot of noise that actually makes it slightly difficult to see the important output. +"""]] diff --git a/doc/forum/new_linux_arm_tarball_build/comment_11_859c44046b00fe885f6878cfe0e46360._comment b/doc/forum/new_linux_arm_tarball_build/comment_11_859c44046b00fe885f6878cfe0e46360._comment new file mode 100644 index 0000000000..7be8a67316 --- /dev/null +++ b/doc/forum/new_linux_arm_tarball_build/comment_11_859c44046b00fe885f6878cfe0e46360._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.191" + subject="comment 11" + date="2014-04-17T19:39:41Z" + content=""" +I can't see any good way to prevent ld-linux.so from preloading things listed in `/etc/ld.so.preload`. I don't know why raspbian wants to preload that -- probably for optimisation purposes? + +I could modify the ld-linux.so shipped in the git-annex tarball, but that way lies pointless complication.. +"""]] diff --git a/doc/forum/new_linux_arm_tarball_build/comment_12_35ade68d62e95036344ad33db3279c21._comment b/doc/forum/new_linux_arm_tarball_build/comment_12_35ade68d62e95036344ad33db3279c21._comment new file mode 100644 index 0000000000..ba6468a3f6 --- /dev/null +++ b/doc/forum/new_linux_arm_tarball_build/comment_12_35ade68d62e95036344ad33db3279c21._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmH9ARM62C6zcEpzh2muCs4wq-GkLRntgQ" + nickname="Randy" + subject="comment 12" + date="2014-04-18T13:38:13Z" + content=""" +There is no need to modify anything here. The errors were mostly just confusing at first and made me wonder if it was working properly. It is indeed working perfectly! Thanks!!! +"""]] diff --git a/doc/forum/sync_stages_deletions_on_remote.mdwn b/doc/forum/sync_stages_deletions_on_remote.mdwn new file mode 100644 index 0000000000..73a51d0b0a --- /dev/null +++ b/doc/forum/sync_stages_deletions_on_remote.mdwn @@ -0,0 +1,72 @@ +I'm having an issue with 2 repos: one on my laptop, the other on my NAS. Both are in indirect mode, running Arch Linux, and have the latest Git version. Laptop has git-annex 5.20140411-gda795e0, NAS has 5.20140319-g9aa31b7 (from prebuilt tarballs). + +The issue is quite simple. When I `git-annex add` new files on my laptop, commit them, and then `git-annex sync` them, they show up as staged for deletion on my NAS. + + laptop $ git annex add some-file + laptop $ git commit -m "Add some-file" + laptop $ git annex sync + commit ok + pull ds413j + ok + push ds413j + Counting objects: 133, done. + Delta compression using up to 8 threads. + Compressing objects: 100% (78/78), done. + Writing objects: 100% (80/80), 10.64 KiB | 0 bytes/s, done. + Total 80 (delta 12), reused 0 (delta 0) + To ssh://**/** + 1dcd188..8ef4249 git-annex -> synced/git-annex + c0f45a6..21711d6 master -> synced/master + ok + laptop $ ssh $NAS + nas $ git status + On branch master + Changes to be committed: + (use "git reset HEAD ..." to unstage) + + deleted: some-file + + nas $ + +If I run `git annex sync` on the NAS, it will create a new commit that deletes that file. So I have to play with `git reset`/`git checkout` by hand to make sure that the new file won't be deleted. + +I'm not sure when this started, but I think it was after I did some stupid mistake (`git checkout -B master synced/master`, kill a `git annex sync` with Ctrl+C, or something else that even resulted in my non-bare repo to have "bare=true" in .git/config...). And I haven't yet been able to fix this. + +Any idea what can have caused this, how to fix it, and how to prevent it from happening again in the future? + +.git/config on NAS: + + [core] + repositoryformatversion = 0 + filemode = true + logallrefupdates = true + [annex] + uuid = d54ae60a-1f59-403c-923f-32ea3bf2d00f + version = 5 + diskreserve = 1 megabyte + autoupgrade = ask + debug = false + +.git/config on laptop: + + [core] + repositoryformatversion = 0 + filemode = true + bare = false + logallrefupdates = true + [branch "master"] + [annex] + uuid = f20cb506-945d-4c78-af1a-0aa884bb899b + version = 5 + diskreserve = 20 gigabytes + autoupgrade = ask + debug = false + expireunused = 7d + genmetadata = true + [push] + default = matching + [remote "ds413j"] + url = ssh://**/** + fetch = +refs/heads/*:refs/remotes/ds413j/* + annex-uuid = d54ae60a-1f59-403c-923f-32ea3bf2d00f + annex-sync = true diff --git a/doc/forum/sync_stages_deletions_on_remote/comment_1_2b639066095e450c2d9be3b2775d24b3._comment b/doc/forum/sync_stages_deletions_on_remote/comment_1_2b639066095e450c2d9be3b2775d24b3._comment new file mode 100644 index 0000000000..24495fd024 --- /dev/null +++ b/doc/forum/sync_stages_deletions_on_remote/comment_1_2b639066095e450c2d9be3b2775d24b3._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://schnouki.net/" + nickname="Schnouki" + subject="comment 1" + date="2014-04-17T12:16:41Z" + content=""" +Here's the output of `git annex sync --debug` (for a different commit): +"""]] diff --git a/doc/forum/sync_stages_deletions_on_remote/comment_2_da5775526a2a476b6ead1cd1a735b8bd._comment b/doc/forum/sync_stages_deletions_on_remote/comment_2_da5775526a2a476b6ead1cd1a735b8bd._comment new file mode 100644 index 0000000000..a3076faf7c --- /dev/null +++ b/doc/forum/sync_stages_deletions_on_remote/comment_2_da5775526a2a476b6ead1cd1a735b8bd._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.191" + subject="comment 2" + date="2014-04-17T19:28:59Z" + content=""" +`git annex sync` will push changes to your NAS, but this does not cause the work tree there to be updated. You must be running some command on the NAS that gets it work tree into the state you show. You need to tell us what that command is, since it seems to be where things are going wrong. Maybe you're running the git-annex assistant on the NAS, or maybe you run `git annex sync` on the NAS. +"""]] diff --git a/doc/forum/taskwarrior/comment_2_4b3d70501763f6d36c927ae37bbd33c2._comment b/doc/forum/taskwarrior/comment_2_4b3d70501763f6d36c927ae37bbd33c2._comment new file mode 100644 index 0000000000..ec6bcb9529 --- /dev/null +++ b/doc/forum/taskwarrior/comment_2_4b3d70501763f6d36c927ae37bbd33c2._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://me.yahoo.com/a/FHnTlSBo1eCGJRwueeKeB6.RCaPbGMPr5jxx8A--#ce0d8" + nickname="Hamza" + subject="comment 2" + date="2014-04-14T15:27:48Z" + content=""" +Using direct mode would replace symlinks with actual files. +"""]] diff --git a/doc/forum/tips:_special__95__remotes__47__hook_with_tahoe-lafs/comment_9_2592749c2f02b3e151896e31acba359b._comment b/doc/forum/tips:_special__95__remotes__47__hook_with_tahoe-lafs/comment_9_2592749c2f02b3e151896e31acba359b._comment new file mode 100644 index 0000000000..ba58643b97 --- /dev/null +++ b/doc/forum/tips:_special__95__remotes__47__hook_with_tahoe-lafs/comment_9_2592749c2f02b3e151896e31acba359b._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmsz4weoPXV2oEtv3zpo9dOxn_SEPz-7Iw" + nickname="Zooko" + subject="more notes about Tahoe-LAFS performance" + date="2014-04-21T07:18:06Z" + content=""" +In case anyone is reading this thread: https://github.com/zooko/tahoe-lafs/blob/3c13c138cf09e83d2f8001888e2a7de85564d406/docs/frontends/key-value-store.rst +"""]] diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 03e05d934e..d5408a2ae9 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -845,6 +845,17 @@ subdirectories). repository, and remove all of git-annex's other data, leaving you with a git repository plus the previously annexed files. +* `reinit uuid|description` + + Normally, initializing a repository generates a new, unique identifier + (UUID) for that repository. Occasionally it may be useful to reuse a + UUID -- for example, if a repository got deleted, and you're + setting it back up. + + Use this with caution; it can be confusing to have two existing + repositories with the same UUID. Also, you will probably want to run + a fsck. + # PLUMBING COMMANDS * `pre-commit [path ...]` @@ -916,6 +927,14 @@ subdirectories). With `--force`, even files whose content is not currently available will be rekeyed. Use with caution. +* `findref [ref]` + + This is similar to the find command, but instead of finding files in the + current work tree, it finds files in the specified git ref. + + Most MATCHING OPTIONS can be used with findref, to limit the files it + finds. However, the --include and --exclude options will not work. + * `test` This runs git-annex's built-in test suite. @@ -924,7 +943,7 @@ subdirectories). * `remotedaemon` - Detects when remotes have changed and fetches from them. + Detects when network remotes have received git pushes and fetches from them. * `xmppgit` diff --git a/doc/news/version_5.20140306.mdwn b/doc/news/version_5.20140306.mdwn deleted file mode 100644 index ef302495b9..0000000000 --- a/doc/news/version_5.20140306.mdwn +++ /dev/null @@ -1,34 +0,0 @@ -git-annex 5.20140306 released with [[!toggle text="these changes"]] -[[!toggleable text=""" - * sync: Fix bug in direct mode that caused a file that was not - checked into git to be deleted when there was a conflicting - merge with a remote. - * webapp: Now supports HTTPS. - * webapp: No longer supports a port specified after --listen, since - it was buggy, and that use case is better supported by setting up HTTPS. - * annex.listen can be configured, instead of using --listen - * annex.startupscan can be set to false to disable the assistant's startup - scan. - * Probe for quvi version at run time. - * webapp: Filter out from Switch Repository list any - repositories listed in autostart file that don't have a - git directory anymore. (Or are bare) - * webapp: Refuse to start in a bare git repository. - * assistant --autostart: Refuse to start in a bare git repository. - * webapp: Don't list the public repository group when editing a - git repository; it only makes sense for special remotes. - * view, vfilter: Add support for filtering tags and values out of a view, - using !tag and field!=value. - * vadd: Allow listing multiple desired values for a field. - * view: Refuse to enter a view when no branch is currently checked out. - * metadata: To only set a field when it's not already got a value, use - -s field?=value - * Run .git/hooks/pre-commit-annex whenever a commit is made. - * sync: Automatically resolve merge conflict between and annexed file - and a regular git file. - * glacier: Pass --region to glacier checkpresent. - * webdav: When built with a new enough haskell DAV (0.6), disable - the http response timeout, which was only 5 seconds. - * webapp: Include no-pty in ssh authorized\_keys lines. - * assistant: Smarter log file rotation, which takes free disk space - into account."""]] \ No newline at end of file diff --git a/doc/news/version_5.20140412.mdwn b/doc/news/version_5.20140412.mdwn new file mode 100644 index 0000000000..7e9267a613 --- /dev/null +++ b/doc/news/version_5.20140412.mdwn @@ -0,0 +1,3 @@ +git-annex 5.20140412 released with [[!toggle text="these changes"]] +[[!toggleable text=""" + * Last release didn't quite fix the high cpu issue in all cases, this should."""]] \ No newline at end of file diff --git a/doc/preferred_content/standard_groups.mdwn b/doc/preferred_content/standard_groups.mdwn index dd73b669ff..2a6241669b 100644 --- a/doc/preferred_content/standard_groups.mdwn +++ b/doc/preferred_content/standard_groups.mdwn @@ -13,7 +13,7 @@ any repository that can will back it up.) All content is wanted, unless it's for a file in a "archive" directory, which has reached an archive repository, or is unused. -`(((exclude=*/archive/* and exclude=archive/*) or (not (copies=archive:1 or copies=smallarchive:1))) and not unused) or roughlylackingcopies=1` +`(((exclude=*/archive/* and exclude=archive/*) or (not (copies=archive:1 or copies=smallarchive:1))) and not unused) or approxlackingcopies=1` ### transfer diff --git a/doc/tips/automatically_adding_metadata/comment_3_02e5314f827d17d482343e8f22c42fd9._comment b/doc/tips/automatically_adding_metadata/comment_3_02e5314f827d17d482343e8f22c42fd9._comment new file mode 100644 index 0000000000..644ece527d --- /dev/null +++ b/doc/tips/automatically_adding_metadata/comment_3_02e5314f827d17d482343e8f22c42fd9._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.191" + subject="comment 3" + date="2014-04-17T20:15:07Z" + content=""" +@anarcat, I have modified [[pre-commit-annex]] so if it's passed already annexed files, it'll extract their metadata. + +So this can be used to add metadata to files added before you installed the hook, or if you've configured more fields to be extracted. +"""]] diff --git a/doc/tips/automatically_adding_metadata/pre-commit-annex b/doc/tips/automatically_adding_metadata/pre-commit-annex index f300bd7313..fe818d0320 100755 --- a/doc/tips/automatically_adding_metadata/pre-commit-annex +++ b/doc/tips/automatically_adding_metadata/pre-commit-annex @@ -1,6 +1,11 @@ #!/bin/sh +# # This script can be used to add git-annex metadata to files when they're -# committed. +# committed. It is typically installed as .git/hooks/pre-commit-annex +# +# You can also run this script by hand, passing it the names of files +# already checked into git-annex, and it will extract/refresh the git-annex +# metadata from the files. # # Copyright 2014 Joey Hess # License: GPL-3+ @@ -12,8 +17,6 @@ if [ -z "$want" ]; then exit 0 fi -echo "$want" - case "$(git config --bool metadata.overwrite || true)" in true) overwrite=1 @@ -46,7 +49,8 @@ fi IFS=" " -for f in $(git diff-index --name-only --cached $against); do + +process () { if [ -e "$f" ]; then for l in $(extract "$f" | egrep "$want"); do field="${l%% - *}" @@ -54,4 +58,14 @@ for f in $(git diff-index --name-only --cached $against); do addmeta "$f" "$field" "$value" done fi -done +} + +if [ -n "$*" ]; then + for f in $@; do + process "$f" + done +else + for f in $(git diff-index --name-only --cached $against); do + process "$f" + done +fi diff --git a/doc/tips/file_manager_integration.mdwn b/doc/tips/file_manager_integration.mdwn index 1a1a557fcb..3fea3e98ce 100644 --- a/doc/tips/file_manager_integration.mdwn +++ b/doc/tips/file_manager_integration.mdwn @@ -91,10 +91,10 @@ Edit this page and add instructions! If your file manager can run a command on a file, it should be easy to integrate git-annex with it. A simple script will suffice: - #!/bun/sh + #!/bin/sh git-annex get --notify-start --notify-finish -- "$@" The --notify-start and --notify-stop options make git-annex display a desktop notification. This is useful to give the user an indication that their action took effect. Desktop notifications are currently only -implenented for Linux. +implemented for Linux. diff --git a/doc/tips/flickrannex/comment_14_c728f10074d194efa8b2c60e97d275e7._comment b/doc/tips/flickrannex/comment_14_c728f10074d194efa8b2c60e97d275e7._comment new file mode 100644 index 0000000000..f625d6bc00 --- /dev/null +++ b/doc/tips/flickrannex/comment_14_c728f10074d194efa8b2c60e97d275e7._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="https://id.koumbit.net/anarcat" + ip="72.0.72.144" + subject="great job on that plugin!" + date="2014-04-15T04:47:17Z" + content=""" +it's pretty awesome to have 1TB of free storage like that out there... but for storing photos, it could be improved - I filed a few bugs on the github repo here: + +https://github.com/TobiasTheViking/flickrannex/issues/created_by/anarcat?state=open + +thanks! +"""]] diff --git a/doc/tips/googledriveannex/comment_3_e7ba5620c0946874f0ae1287f99d1177._comment b/doc/tips/googledriveannex/comment_3_e7ba5620c0946874f0ae1287f99d1177._comment new file mode 100644 index 0000000000..c80dbf01f9 --- /dev/null +++ b/doc/tips/googledriveannex/comment_3_e7ba5620c0946874f0ae1287f99d1177._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.191" + subject="comment 3" + date="2014-04-17T20:58:41Z" + content=""" +@Mesut, I think you're doing everything right. It can take a long time for the highly secure gpg key to be generated. Sit tight and let it finish, or you can pass --fast to generate a key that is a tiny bit less secure. +"""]] diff --git a/doc/tips/googledriveannex/comment_4_239091adaea6ae39fa9a4d9719667a98._comment b/doc/tips/googledriveannex/comment_4_239091adaea6ae39fa9a4d9719667a98._comment new file mode 100644 index 0000000000..7c96750456 --- /dev/null +++ b/doc/tips/googledriveannex/comment_4_239091adaea6ae39fa9a4d9719667a98._comment @@ -0,0 +1,41 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmp1ThsNNAbSn46ju-gwFELfStlhl8usJo" + nickname="donkeyicydragon" + subject="Googledrive annex on second repository" + date="2014-04-19T20:45:23Z" + content=""" +Hi Johnny, + +I wrote a patch for googledriveannex that fixed this problem for me. First you add the google drive special remote in repo1 then you clone repo1 into repo2. In repo2 you do \"git annex enableremote googldrivespecialremotename\" and it should work. +The problem was that the init method, that is called by git annex when a special remote is first created but also when it is enabled somewhere else, did not factor in the possibility that it had already been created. +I will simultaneously submit the patch to the author of the special remote plugin but here it is for you to quickly get going: + + diff --git a/git-annex-remote-googledrive b/git-annex-remote-googledrive + index 49cd917..c8e70f3 100755 + --- a/git-annex-remote-googledrive + +++ b/git-annex-remote-googledrive + @@ -330,13 +330,16 @@ def initremote(line): + oauth = os.getenv(\"OAUTH\") or \"\" + encryption = common.getConfig(\"encryption\") + myfolder = common.getConfig(\"folder\") + - stored_creds = sys.modules[\"__main__\"].login({\"oauth\": oauth}) + - if len(myfolder) and stored_creds: + - common.sprint('SETCONFIG myfolder ' + myfolder + '') + - common.sprint('SETCONFIG stored_creds ' + json.dumps(stored_creds) + '') + - common.sprint('INITREMOTE-SUCCESS') + + if not common.getConfig(\"stored_creds\"): + + stored_creds = sys.modules[\"__main__\"].login({\"oauth\": oauth}) + + if len(myfolder) and stored_creds: + + common.sprint('SETCONFIG myfolder ' + myfolder + '') + + common.sprint('SETCONFIG stored_creds ' + json.dumps(stored_creds) + '') + + common.sprint('INITREMOTE-SUCCESS') + + else: + + common.sprint('INITREMOTE-FAILURE You need to set OAUTH environment variables and folder and encryption parameters when running initremote.') + else: + - common.sprint('INITREMOTE-FAILURE You need to set OAUTH environment variables and folder and encryption parameters when running initremote.') + + common.sprint('INITREMOTE-SUCCESS') + common.log(\"Done\") + + def prepare(line): + -- +"""]] diff --git a/doc/tips/using_Amazon_S3/comment_3_32acba030c2ad252e2f7027075e4303e._comment b/doc/tips/using_Amazon_S3/comment_3_32acba030c2ad252e2f7027075e4303e._comment new file mode 100644 index 0000000000..e83ade0c74 --- /dev/null +++ b/doc/tips/using_Amazon_S3/comment_3_32acba030c2ad252e2f7027075e4303e._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="annexuser" + ip="64.71.7.82" + subject="Altering AWS credentials" + date="2014-04-15T21:59:43Z" + content=""" +If I revoke old AWS credentials and create new ones, how would I inform git-annex of the change to `AWS_ACCESS_KEY_ID` and `AWS_SECRET_ACCESS_KEY`? +"""]] diff --git a/doc/tips/using_Amazon_S3/comment_4_92df5a9f923beafba55a1c455728112e._comment b/doc/tips/using_Amazon_S3/comment_4_92df5a9f923beafba55a1c455728112e._comment new file mode 100644 index 0000000000..5bcf34b74d --- /dev/null +++ b/doc/tips/using_Amazon_S3/comment_4_92df5a9f923beafba55a1c455728112e._comment @@ -0,0 +1,13 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.191" + subject="comment 4" + date="2014-04-17T19:44:55Z" + content=""" +You can use `git annex enableremote` to change an existing remote's configuration. So this should work: + + # export AWS_ACCESS_KEY_ID=\"newRANDOMGOBBLDEYGOOK\" + # export AWS_SECRET_ACCESS_KEY=\"news3kr1t\" + # git annex enableremote cloud + +"""]] diff --git a/doc/tips/using_gitolite_with_git-annex.mdwn b/doc/tips/using_gitolite_with_git-annex.mdwn index 746b6b17f5..31f34c6fb0 100644 --- a/doc/tips/using_gitolite_with_git-annex.mdwn +++ b/doc/tips/using_gitolite_with_git-annex.mdwn @@ -9,12 +9,73 @@ file contents, but not change anything. First, you need new enough versions: -* gitolite 2.2 is needed -- this version contains a git-annex-shell ADC - and supports "ua" ADCs. Alternatively, gitoline g3 also recently added - support for git-annex. +* the current `master` branch of gitolite works with git-annex (tested 2014-04-19), + but v3.5.3 and earlier v3.x require use of the `git-annex` branch. +* gitolite 2.2 also works -- this version contains a git-annex-shell ADC + and supports "ua" ADCs. * git-annex 3.20111016 or newer needs to be installed on the gitolite server. Don't install an older version, it wouldn't be secure! +### Instructions for gitolite `master` branch + +To setup gitolite to work with git-annex, you can follow the instructions on the gitolite website, +and just add `'git-annex-shell ua',` to the ENABLE list in `~/.gitolite.rc`. + +Here are more detailed instructions: + +1: Create a `git` user + +
+sudo adduser \
+   --system \
+   --shell /bin/bash \
+   --gecos 'git version control' \
+   --group \
+   --disabled-password \
+   --home /home/git git
+
+ +2: Copy a public SSH key for the user you want to be the gitolite administrator. +In the instructions below, I placed the key in a file named `/home/git/me.pub`. + +3: Clone and install gitolite + +First switch to the `git` user (e.g. `sudo su - git`) and then run: + +
+cd
+git clone https://github.com/sitaramc/gitolite.git
+mkdir -p bin
+./gitolite/install -ln
+
+ +4: Add `~/bin` to `PATH` + +Make sure that `~/bin` is in the `PATH`, since that's where gitolite installed its binary. Do something like this: + +
+echo 'export PATH=/home/git/bin:$PATH' >> .profile
+export PATH=/home/git/bin:$PATH
+
+ +5: Configure gitolite + +Edit `~/.gitolite.rc` to enable the git-annex-shell command. +Find the `ENABLE` list and add this line in there somewhere: + +
+'git-annex-shell ua',
+
+ +Now run gitolite's setup: + +
+gitolite setup -pk me.pub
+rm me.pub
+
+ +### Instructions for gitolite 2.2 + And here's how to set it up. The examples are for gitolite as installed on Debian with apt-get, but the changes described can be made to any gitolite installation, just with different paths. @@ -38,13 +99,6 @@ cd /usr/local/lib/gitolite/adc/ua/ cp gitolite/contrib/adc/git-annex-shell . -If using gitolite g3, an additional setup step is needed: -In the ENABLE list in the rc file, add an entry like this: - -
-	'git-annex-shell ua',
-
- Now all gitolite repositories can be used with git-annex just as any ssh remote normally would be used. For example: diff --git a/doc/tips/using_gitolite_with_git-annex/comment_21_d2feaaf22d41413048dabf706d1b267e._comment b/doc/tips/using_gitolite_with_git-annex/comment_21_d2feaaf22d41413048dabf706d1b267e._comment new file mode 100644 index 0000000000..2746ee41b8 --- /dev/null +++ b/doc/tips/using_gitolite_with_git-annex/comment_21_d2feaaf22d41413048dabf706d1b267e._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawn26WQjIP5fnMgQF_L_k3Q3UrR5v8mjRTY" + nickname="Ellis" + subject="Worked for me, updated wiki" + date="2014-04-19T09:41:11Z" + content=""" +I tried the `master` branch of gitolite today on my server, and it works fine! Updated the wiki with the commands I used to setup gitolite. +"""]] diff --git a/doc/todo/A_Way_To_Extract_Previous_Versions_of_a_File_From_a_Direct_Repo.mdwn b/doc/todo/A_Way_To_Extract_Previous_Versions_of_a_File_From_a_Direct_Repo.mdwn new file mode 100644 index 0000000000..00f500d100 --- /dev/null +++ b/doc/todo/A_Way_To_Extract_Previous_Versions_of_a_File_From_a_Direct_Repo.mdwn @@ -0,0 +1 @@ +One problem I keep having when using a direct repo is that in order to get to the previous versions of a file you have to convert that repo to indirect and then checkout previous commits this becomes problematic when the repo in question is large conversion takes a long time and applications gets confused if there are open files from the repo as they go from actual files to symlinks. Is it possible to have a separate annex command that will checkout a previous version of a file to a different directory so we can replace/inspect it. diff --git a/doc/todo/LIst_of_Available_Remotes_in_Webapp/comment_1_23fe2f3cd44c4357a385452dcd5eedef._comment b/doc/todo/LIst_of_Available_Remotes_in_Webapp/comment_1_23fe2f3cd44c4357a385452dcd5eedef._comment new file mode 100644 index 0000000000..9e22dafca3 --- /dev/null +++ b/doc/todo/LIst_of_Available_Remotes_in_Webapp/comment_1_23fe2f3cd44c4357a385452dcd5eedef._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.191" + subject="comment 1" + date="2014-04-17T20:54:18Z" + content=""" +I chose to make the webapp only show available remotes when it knows how to enable them. So it will show S3 special remotes, Box.com special remotes, etc. This avoids cluttering up the display of a shared repository with a list of all of your friend's removable drives, for example. + +I would like to make the webapp smarter about handling repositories on remote ssh servers. As long as the server name is in the global DNS, the webapp could easily walk the user through setting up such a remote. The missing piece is that nothing is logged in remotes.log for these remotes, and so the assistant doesn't know the server name. +"""]] diff --git a/doc/todo/Not_working_on_Android-x86/comment_3_6b609af60bf1c477139e40eba5cb0c4e._comment b/doc/todo/Not_working_on_Android-x86/comment_3_6b609af60bf1c477139e40eba5cb0c4e._comment new file mode 100644 index 0000000000..e4ac8f820d --- /dev/null +++ b/doc/todo/Not_working_on_Android-x86/comment_3_6b609af60bf1c477139e40eba5cb0c4e._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="209.250.56.191" + subject="comment 3" + date="2014-04-20T21:01:50Z" + content=""" +Samsung Galaxy Tab 3 (GT-P5210) also needs this. + +Each new git-annex builder takes me days to set up, and is an ongoing drain to keep running. I would much rather walk someone else through setting one up, unless this becomes a very common architecture for android. +"""]] diff --git a/doc/todo/Time_Stamping_of_Events_in_Webapp.mdwn b/doc/todo/Time_Stamping_of_Events_in_Webapp.mdwn index a1f3fe6ea2..0762f47ba2 100644 --- a/doc/todo/Time_Stamping_of_Events_in_Webapp.mdwn +++ b/doc/todo/Time_Stamping_of_Events_in_Webapp.mdwn @@ -1 +1,3 @@ Currently events happening in the webapp (sync upload etc. on the right) has no time stamp thus user has no way to tell when was the last sync happened. Which is problematic when not using XMPP and repos lag behind. + +> [[dup|done]] of --[[Joey]] diff --git a/doc/todo/allow_removing_jabber_configuration.mdwn b/doc/todo/allow_removing_jabber_configuration.mdwn new file mode 100644 index 0000000000..62370258d5 --- /dev/null +++ b/doc/todo/allow_removing_jabber_configuration.mdwn @@ -0,0 +1,5 @@ +right now it is unclear through the webapp how to unconfigure a jabber +account, which is especially critical considering the password needs to be +stored in the clear (where?). -- [[anarcat]] + +> [[fixed|done]] --[[Joey]] diff --git a/doc/todo/build_a_user_guide.mdwn b/doc/todo/build_a_user_guide.mdwn new file mode 100644 index 0000000000..97414391bd --- /dev/null +++ b/doc/todo/build_a_user_guide.mdwn @@ -0,0 +1,3 @@ +there's a lot of good documentation on this wiki, but it's hard to find sometimes. it's also unclear if we should look in the [[git-annex]] manpage or elsewhere in the wiki or where. this is a typical problem with the use of wikis for documentation: it's there, but hard to find. it doesn't mean a wiki shouldn't be used but, as with any user manual, special care needs to be taken about structure, organisation and making sure the manual is exhaustive. + +a good example of this problem is [[todo/document_standard_groups_more_extensively_in_the_UI]]. --[[anarcat]] diff --git a/doc/todo/do_not_bug_me_about_intermediate_files.mdwn b/doc/todo/do_not_bug_me_about_intermediate_files.mdwn new file mode 100644 index 0000000000..6cb71b5b57 --- /dev/null +++ b/doc/todo/do_not_bug_me_about_intermediate_files.mdwn @@ -0,0 +1,7 @@ +[[!meta title="--notify-finish operates on a per-file, not per-process basis"]] + +so this is another UX pickyness, but it seems important to me. + +i like the new desktop notifications, but they are little too verbose. when i choose "git annex get" on the folder, if there's a lot of files, it will flood me with all the files being transfered in a mostly incomprehensible list of files being transfered. + +what i would expect is more: "starting transfer of folder X", "transfer of folder X finished!", only two message per item i chose. this is especially a problem with DVD backups, which have a bunch of small files (screenshots, .nfos and so on) and large video files - so it seems the thing has finished transfering, while it's only partly done. --[[anarcat]] diff --git a/doc/todo/document_standard_groups_more_extensively_in_the_UI.mdwn b/doc/todo/document_standard_groups_more_extensively_in_the_UI.mdwn new file mode 100644 index 0000000000..1e9afdef90 --- /dev/null +++ b/doc/todo/document_standard_groups_more_extensively_in_the_UI.mdwn @@ -0,0 +1,14 @@ +i have been using git-annex for a while now, yet I still can't quite wrap my head around [[preferred_content/standard groups]], especially how they are documented in about/repogroups in the assistant web interface. i have repeatedly synced files where they shouldn't have been synced (usually by setting the repo as "client" or "transfer") and also destroyed files I wanted to keep by setting it to "unwanted" (actually, that was by pressing the "delete" button on the repo, which i didn't expect to drop the files on the remote...) + +i have been able to understand a lot of what's going on by trial and error and by decrypting the [[preferred_content]] expressions on the wiki. + +it seems to me the [[preferred_content/standard groups]] wiki page and the `about/repogroups` URL in the assistant should be merged: + + 1. the assistant should be more explicit: maybe it should have examples of what will happen in some cases to give an idea. maybe "stories" like "a transfer repo is for when you have two client repos that can't talk to each other, so you use a transfer repo, e.g. a portable hard drive, to transfer files between them". having the actual, current [[preferred_content]] expressions from the [[preferred_content/standard groups]] groups page would also help, maybe in a smaller font to not scare people of + 2. the [[preferred_content/standard groups]] wiki page should be expanded to include narratives like the ones that are in the `about/repogroups` page of the assistant. that way people looking at the software from the outside can understand the mechanics better + +ideally, that documentation would be the one and the same so that a change on one side would reflect on the other. + +in fact, having an inline manual in the assistant would be a must: we want this thing to work offline, so it should be able to access this wiki, or whatever of it is shipped with git-annex. + +that way we wouldn't have this kind of inconsistencies... more generally, maybe we could even [[build a user guide]]! -- [[anarcat]] diff --git a/doc/todo/sharedRepository_mode_not_supported_by_git-annex.mdwn b/doc/todo/sharedRepository_mode_not_supported_by_git-annex.mdwn new file mode 100644 index 0000000000..85005dbc1b --- /dev/null +++ b/doc/todo/sharedRepository_mode_not_supported_by_git-annex.mdwn @@ -0,0 +1,7 @@ +git's core.SharedRepository is supported by git-annex, but only +with the group/all/world/everybody settings. core.SharedRepository=0644 +etc is not supported. + +There's no insormountable reason why not, Joey just hates umask mode math +stuff and nobody has sent a patch. Note that Annex.Content.freezeContent +should remove the write bit from files, no matter what. diff --git a/doc/todo/wishlist:_disable_automatic_commits.mdwn b/doc/todo/wishlist:_disable_automatic_commits.mdwn index 14c1317969..03ed40211a 100644 --- a/doc/todo/wishlist:_disable_automatic_commits.mdwn +++ b/doc/todo/wishlist:_disable_automatic_commits.mdwn @@ -7,8 +7,8 @@ history. Some motivating reasons: * manual choice of which files to annex (based on predicted usage) could be useful, e.g. a repo might contain a 4MB PDF which you want available in *every* remote even without `git annex get`, and also some 2MB images which are only required in some remotes -> This particular case is now catered to by the "manual" repository group -> in preferred content settings. --[[Joey]] +> This particular case is now catered to by the ["manual" repository group](/preferred_content/standard_groups/) +> in [[preferred content]] settings. --[[Joey]] Obviously this needs to be configurable at least per repository, and ideally perhaps even per remote, since usage habits can vary from machine diff --git a/doc/users/tobiastheviking.mdwn b/doc/users/tobiastheviking.mdwn index 0629e34a9a..31398dae90 100644 --- a/doc/users/tobiastheviking.mdwn +++ b/doc/users/tobiastheviking.mdwn @@ -2,19 +2,12 @@ Tobias Ussing See: -[[https://github.com/TobiasTheViking/flickrannex/]] - -[[https://github.com/TobiasTheViking/imapannex]] - -[[https://github.com/TobiasTheViking/dropboxannex]] - -[[https://github.com/TobiasTheViking/skydriveannex]] - -[[https://github.com/TobiasTheViking/googledriveannex]] - -[[https://github.com/TobiasTheViking/owncloudannex]] - -[[https://github.com/TobiasTheViking/megaannex]] - -[[http://git-annex.branchable.com/forum/nntp__47__usenet_special_remote/]] +* [[tips/flickrannex]] - [[https://github.com/TobiasTheViking/flickrannex/]] +* [[tips/imapannex]] - [[https://github.com/TobiasTheViking/imapannex]] +* [[tips/dropboxannex]] - [[https://github.com/TobiasTheViking/dropboxannex]] +* [[tips/skydriveannex]] - [[https://github.com/TobiasTheViking/skydriveannex]] +* [[tips/googledriveannex]] - [[https://github.com/TobiasTheViking/googledriveannex]] +* [[tips/owncloudannex]] - [[https://github.com/TobiasTheViking/owncloudannex]] +* [[tips/megaannex]] - [[https://github.com/TobiasTheViking/megaannex]] +* [[forum/nntp__47__usenet_special_remote/]] diff --git a/git-annex.cabal b/git-annex.cabal index 105d8d5947..ebb93b04c6 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -1,5 +1,5 @@ Name: git-annex -Version: 5.20140412 +Version: 5.20140421 Cabal-Version: >= 1.8 License: GPL-3 Maintainer: Joey Hess @@ -101,7 +101,7 @@ Executable git-annex base (>= 4.5 && < 4.9), monad-control, MonadCatchIO-transformers, IfElse, text, QuickCheck >= 2.1, bloomfilter, edit-distance, process, SafeSemaphore, uuid, random, dlist, unix-compat, async, stm (>= 2.3), - data-default, case-insensitive, shakespeare + data-default, case-insensitive CC-Options: -Wall GHC-Options: -Wall Extensions: PackageImports @@ -192,7 +192,8 @@ Executable git-annex yesod, yesod-default, yesod-static, yesod-form, yesod-core, http-types, transformers, wai, wai-logger, warp, warp-tls, blaze-builder, crypto-api, hamlet, clientsession, - template-haskell, data-default, aeson, network-conduit + template-haskell, data-default, aeson, network-conduit, + shakespeare CPP-Options: -DWITH_WEBAPP if flag(Webapp) && flag (Webapp-secure) Build-Depends: warp-tls (>= 1.4), securemem, byteable diff --git a/standalone/linux/skel/runshell b/standalone/linux/skel/runshell index 4481b0d7f0..73703358d3 100755 --- a/standalone/linux/skel/runshell +++ b/standalone/linux/skel/runshell @@ -34,11 +34,26 @@ if [ ! -e "$HOME/.ssh/git-annex-shell" ]; then ( echo "#!/bin/sh" echo "set -e" + echo "if [ \"x\$SSH_ORIGINAL_COMMAND\" != \"x\" ]; then" echo "exec $base/runshell git-annex-shell -c \"\$SSH_ORIGINAL_COMMAND\"" + echo "else" + echo "exec $base/runshell git-annex-shell -c \"\$@\"" + echo "fi" ) > "$HOME/.ssh/git-annex-shell" chmod +x "$HOME/.ssh/git-annex-shell" fi +# And this shim is used by the webapp when adding a remote ssh server. +if [ ! -e "$HOME/.ssh/git-annex-wrapper" ]; then + mkdir "$HOME/.ssh" >/dev/null 2>&1 || true + ( + echo "#!/bin/sh" + echo "set -e" + echo "exec $base/runshell \"\$@\"" + ) > "$HOME/.ssh/git-annex-wrapper" + chmod +x "$HOME/.ssh/git-annex-wrapper" +fi + # Put our binaries first, to avoid issues with out of date or incompatable # system binaries. ORIG_PATH="$PATH" diff --git a/standalone/osx/git-annex.app/Contents/MacOS/runshell b/standalone/osx/git-annex.app/Contents/MacOS/runshell index 9f1457e250..c5d689c6e1 100755 --- a/standalone/osx/git-annex.app/Contents/MacOS/runshell +++ b/standalone/osx/git-annex.app/Contents/MacOS/runshell @@ -36,11 +36,26 @@ if [ ! -e "$HOME/.ssh/git-annex-shell" ]; then ( echo "#!/bin/sh" echo "set -e" + echo "if [ \"x\$SSH_ORIGINAL_COMMAND\" != \"x\" ]; then" echo "exec $base/runshell git-annex-shell -c \"\$SSH_ORIGINAL_COMMAND\"" + echo "else" + echo "exec $base/runshell git-annex-shell -c \"\$@\"" + echo "fi" ) > "$HOME/.ssh/git-annex-shell" chmod +x "$HOME/.ssh/git-annex-shell" fi +# And this shim is used by the webapp when adding a remote ssh server. +if [ ! -e "$HOME/.ssh/git-annex-wrapper" ]; then + mkdir "$HOME/.ssh" >/dev/null 2>&1 || true + ( + echo "#!/bin/sh" + echo "set -e" + echo "exec $base/runshell \"\$@\"" + ) > "$HOME/.ssh/git-annex-wrapper" + chmod +x "$HOME/.ssh/git-annex-wrapper" +fi + # Put our binaries first, to avoid issues with out of date or incompatable # system binaries. ORIG_PATH="$PATH" diff --git a/templates/configurators/addrepository/cloud.hamlet b/templates/configurators/addrepository/cloud.hamlet index 22d42fc0a8..c5dad16a4f 100644 --- a/templates/configurators/addrepository/cloud.hamlet +++ b/templates/configurators/addrepository/cloud.hamlet @@ -18,9 +18,4 @@

Good choice for professional quality storage. -

- - Remote server -

- Set up a repository on a remote server using # - ssh. +^{makeSshRepository} diff --git a/templates/configurators/addrepository/connection.hamlet b/templates/configurators/addrepository/connection.hamlet new file mode 100644 index 0000000000..fc111b0653 --- /dev/null +++ b/templates/configurators/addrepository/connection.hamlet @@ -0,0 +1,3 @@ +^{makeXMPPConnection} + +^{makeSshRepository} diff --git a/templates/configurators/addrepository/misc.hamlet b/templates/configurators/addrepository/misc.hamlet index 5f0cc6be97..79b1937e07 100644 --- a/templates/configurators/addrepository/misc.hamlet +++ b/templates/configurators/addrepository/misc.hamlet @@ -7,17 +7,7 @@ SneakerNet # between computers. -

- - Share with your other devices -

- Keep files in sync between your devices running git-annex. - -

- - Share with a friend -

- Combine your repository with a friend's repository, and share your files. +^{makeXMPPConnection}

@@ -31,3 +21,5 @@ Add another repository

Make another repository on your computer. + +^{makeSshRepository} diff --git a/templates/configurators/addrepository/ssh.hamlet b/templates/configurators/addrepository/ssh.hamlet new file mode 100644 index 0000000000..c41ad1117b --- /dev/null +++ b/templates/configurators/addrepository/ssh.hamlet @@ -0,0 +1,6 @@ +

+ + Remote server +

+ Set up a repository on a remote server using # + ssh. diff --git a/templates/configurators/addrepository/xmppconnection.hamlet b/templates/configurators/addrepository/xmppconnection.hamlet new file mode 100644 index 0000000000..2fae69deeb --- /dev/null +++ b/templates/configurators/addrepository/xmppconnection.hamlet @@ -0,0 +1,11 @@ +

+ + Share with your other devices +

+ Keep files in sync between your devices running git-annex. + +

+ + Share with a friend +

+ Combine your repository with a friend's repository, and share your files. diff --git a/templates/configurators/delete/xmpp.hamlet b/templates/configurators/delete/xmpp.hamlet new file mode 100644 index 0000000000..62bd1d9cd5 --- /dev/null +++ b/templates/configurators/delete/xmpp.hamlet @@ -0,0 +1,10 @@ +

+

+ Disconnecting from Jabber +

+ This won't delete the repository or repositories at the other end + of the Jabber connection, but it will disconnect from them, and stop + using Jabber. +

+ + Disconnect diff --git a/templates/configurators/needconnection.hamlet b/templates/configurators/needconnection.hamlet new file mode 100644 index 0000000000..4cb9dc5de0 --- /dev/null +++ b/templates/configurators/needconnection.hamlet @@ -0,0 +1,12 @@ +

+

+ Connection needed +

+ In order to quickly sync with other repositories, # + a direct connection is needed to another git-annex. # +

+ You don't currently seem to have such a connection configured -- # + or if you do, it's not currently connected! +

+ Add a connection + ^{makeConnectionRepositories} diff --git a/templates/configurators/xmpp.hamlet b/templates/configurators/xmpp.hamlet index e07fcd6982..0f4b0d20d1 100644 --- a/templates/configurators/xmpp.hamlet +++ b/templates/configurators/xmpp.hamlet @@ -25,6 +25,8 @@