diff --git a/Annex.hs b/Annex.hs --- a/Annex.hs +++ b/Annex.hs @@ -5,7 +5,7 @@ - Licensed under the GNU GPL version 3 or higher. -} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE GeneralizedNewtypeDeriving, PackageImports #-} module Annex ( Annex, @@ -40,12 +40,11 @@ import Common import qualified Git import qualified Git.Config -import Git.Types hiding (remotes) +import Annex.Direct.Fixup import Git.CatFile import Git.CheckAttr import Git.CheckIgnore import Git.SharedRepository -import Git.Config import qualified Git.Queue import Types.Backend import Types.GitConfig @@ -112,9 +111,9 @@ , useragent :: Maybe String } -newState :: Git.Repo -> AnnexState -newState r = AnnexState - { repo = if annexDirect c then fixupDirect r else r +newState :: GitConfig -> Git.Repo -> AnnexState +newState c r = AnnexState + { repo = r , gitconfig = c , backends = [] , remotes = [] @@ -145,13 +144,14 @@ , inodeschanged = Nothing , useragent = Nothing } - where - c = extractGitConfig r {- Makes an Annex state object for the specified git repo. - Ensures the config is read, if it was not already. -} new :: Git.Repo -> IO AnnexState -new = newState <$$> Git.Config.read +new r = do + r' <- Git.Config.read r + let c = extractGitConfig r' + newState c <$> if annexDirect c then fixupDirect r' else return r' {- Performs an action in the Annex monad from a starting state, - returning a new state. -} @@ -250,17 +250,3 @@ withCurrentState a = do s <- getState id return $ eval s a - -{- Direct mode repos have core.bare=true, but are not really bare. - - Fix up the Repo to be a non-bare repo, and arrange for git commands - - run by git-annex to be passed parameters that override this setting. -} -fixupDirect :: Git.Repo -> Git.Repo -fixupDirect r@(Repo { location = Local { gitdir = d, worktree = Nothing } }) = - r - { location = Local { gitdir = d ".git", worktree = Just d } - , gitGlobalOpts = gitGlobalOpts r ++ - [ Param "-c" - , Param $ coreBare ++ "=" ++ boolConfig False - ] - } -fixupDirect r = r diff --git a/Annex/Content.hs b/Annex/Content.hs --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -30,6 +30,7 @@ freezeContent, thawContent, dirKeys, + withObjectLoc, ) where import System.IO.Unsafe (unsafeInterleaveIO) diff --git a/Annex/Direct/Fixup.hs b/Annex/Direct/Fixup.hs new file mode 100644 --- /dev/null +++ b/Annex/Direct/Fixup.hs @@ -0,0 +1,31 @@ +{- git-annex direct mode guard fixup + - + - Copyright 2013 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Annex.Direct.Fixup where + +import Git.Types +import Git.Config +import qualified Git.Construct as Construct +import Utility.Path +import Utility.SafeCommand + +{- Direct mode repos have core.bare=true, but are not really bare. + - Fix up the Repo to be a non-bare repo, and arrange for git commands + - run by git-annex to be passed parameters that override this setting. -} +fixupDirect :: Repo -> IO Repo +fixupDirect r@(Repo { location = l@(Local { gitdir = d, worktree = Nothing }) }) = do + let r' = r + { location = l { worktree = Just (parentDir d) } + , gitGlobalOpts = gitGlobalOpts r ++ + [ Param "-c" + , Param $ coreBare ++ "=" ++ boolConfig False + ] + } + -- Recalc now that the worktree is correct. + rs' <- Construct.fromRemotes r' + return $ r' { remotes = rs' } +fixupDirect r = return r diff --git a/Annex/Exception.hs b/Annex/Exception.hs --- a/Annex/Exception.hs +++ b/Annex/Exception.hs @@ -10,6 +10,8 @@ - Licensed under the GNU GPL version 3 or higher. -} +{-# LANGUAGE PackageImports #-} + module Annex.Exception ( bracketIO, tryAnnex, diff --git a/Annex/Path.hs b/Annex/Path.hs new file mode 100644 --- /dev/null +++ b/Annex/Path.hs @@ -0,0 +1,34 @@ +{- git-annex program path + - + - Copyright 2013 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +{-# LANGUAGE CPP #-} + +module Annex.Path where + +import Common +import Config.Files +import System.Environment + +{- A fully qualified path to the currently running git-annex program. + - + - getExecutablePath is available since ghc 7.4.2. On OSs it supports + - well, it returns the complete path to the program. But, on other OSs, + - it might return just the basename. + -} +programPath :: IO (Maybe FilePath) +programPath = do +#if MIN_VERSION_base(4,6,0) + exe <- getExecutablePath + p <- if isAbsolute exe + then return exe + else readProgramFile +#else + p <- readProgramFile +#endif + -- In case readProgramFile returned just the command name, + -- fall back to finding it in PATH. + searchPath p diff --git a/Assistant.hs b/Assistant.hs --- a/Assistant.hs +++ b/Assistant.hs @@ -28,6 +28,8 @@ import Assistant.Threads.MountWatcher #endif import Assistant.Threads.NetWatcher +import Assistant.Threads.Upgrader +import Assistant.Threads.UpgradeWatcher import Assistant.Threads.TransferScanner import Assistant.Threads.TransferPoller import Assistant.Threads.ConfigMonitor @@ -150,6 +152,8 @@ , assist $ mountWatcherThread urlrenderer #endif , assist $ netWatcherThread + , assist $ upgraderThread urlrenderer + , assist $ upgradeWatcherThread urlrenderer , assist $ netWatcherFallbackThread , assist $ transferScannerThread urlrenderer , assist $ cronnerThread urlrenderer diff --git a/Assistant/Alert.hs b/Assistant/Alert.hs --- a/Assistant/Alert.hs +++ b/Assistant/Alert.hs @@ -15,6 +15,7 @@ import qualified Remote import Utility.Tense import Logs.Transfer +import Types.Distribution import Data.String import qualified Data.Text as T @@ -42,6 +43,7 @@ { buttonLabel = label , buttonUrl = url , buttonAction = if autoclose then Just close else Nothing + , buttonPrimary = True } #endif @@ -61,7 +63,7 @@ , alertIcon = Just ActivityIcon , alertCombiner = Nothing , alertName = Nothing - , alertButton = Nothing + , alertButtons = [] } warningAlert :: String -> String -> Alert @@ -77,11 +79,11 @@ , alertIcon = Just ErrorIcon , alertCombiner = Just $ dataCombiner $ \_old new -> new , alertName = Just $ WarningAlert name - , alertButton = Nothing + , alertButtons = [] } -errorAlert :: String -> AlertButton -> Alert -errorAlert msg button = Alert +errorAlert :: String -> [AlertButton] -> Alert +errorAlert msg buttons = Alert { alertClass = Error , alertHeader = Nothing , alertMessageRender = renderData @@ -93,7 +95,7 @@ , alertIcon = Just ErrorIcon , alertCombiner = Nothing , alertName = Nothing - , alertButton = Just button + , alertButtons = buttons } activityAlert :: Maybe TenseText -> [TenseChunk] -> Alert @@ -160,7 +162,7 @@ , alertIcon = Just ErrorIcon , alertName = Just SanityCheckFixAlert , alertCombiner = Just $ dataCombiner (++) - , alertButton = Nothing + , alertButtons = [] } where render alert = tenseWords $ alerthead : alertData alert ++ [alertfoot] @@ -172,7 +174,7 @@ { alertData = case mr of Nothing -> [ UnTensed $ T.pack $ "Consistency check in progress" ] Just r -> [ UnTensed $ T.pack $ "Consistency check of " ++ Remote.name r ++ " in progress"] - , alertButton = Just button + , alertButtons = [button] } showFscking :: UrlRenderer -> Maybe Remote -> IO (Either E.SomeException a) -> Assistant a @@ -204,7 +206,7 @@ ] , alertIcon = Just InfoIcon , alertPriority = High - , alertButton = Just button + , alertButtons = [button] , alertClosable = True , alertClass = Message , alertMessageRender = renderData @@ -215,7 +217,50 @@ , alertData = [] } -brokenRepositoryAlert :: AlertButton -> Alert +baseUpgradeAlert :: [AlertButton] -> TenseText -> Alert +baseUpgradeAlert buttons message = Alert + { alertHeader = Just message + , alertIcon = Just UpgradeIcon + , alertPriority = High + , alertButtons = buttons + , alertClosable = True + , alertClass = Message + , alertMessageRender = renderData + , alertCounter = 0 + , alertBlockDisplay = True + , alertName = Just UpgradeAlert + , alertCombiner = Just $ fullCombiner $ \new _old -> new + , alertData = [] + } + +canUpgradeAlert :: AlertPriority -> GitAnnexVersion -> AlertButton -> Alert +canUpgradeAlert priority version button = + (baseUpgradeAlert [button] $ fromString msg) + { alertPriority = priority + , alertData = [fromString $ " (version " ++ version ++ ")"] + } + where + msg = if priority >= High + then "An important upgrade of git-annex is available!" + else "An upgrade of git-annex is available." + +upgradeReadyAlert :: AlertButton -> Alert +upgradeReadyAlert button = baseUpgradeAlert [button] $ + fromString "A new version of git-annex has been installed." + +upgradingAlert :: Alert +upgradingAlert = activityAlert Nothing [ fromString "Upgrading git-annex" ] + +upgradeFinishedAlert :: Maybe AlertButton -> GitAnnexVersion -> Alert +upgradeFinishedAlert button version = + baseUpgradeAlert (maybe [] (:[]) button) $ fromString $ + "Finished upgrading git-annex to version " ++ version + +upgradeFailedAlert :: String -> Alert +upgradeFailedAlert msg = (errorAlert msg []) + { alertHeader = Just $ fromString "Upgrade failed." } + +brokenRepositoryAlert :: [AlertButton] -> Alert brokenRepositoryAlert = errorAlert "Serious problems have been detected with your repository. This needs your immediate attention!" repairingAlert :: String -> Alert @@ -228,7 +273,7 @@ pairingAlert button = baseActivityAlert { alertData = [ UnTensed "Pairing in progress" ] , alertPriority = High - , alertButton = Just button + , alertButtons = [button] } pairRequestReceivedAlert :: String -> AlertButton -> Alert @@ -244,7 +289,7 @@ , alertIcon = Just InfoIcon , alertName = Just $ PairAlert who , alertCombiner = Just $ dataCombiner $ \_old new -> new - , alertButton = Just button + , alertButtons = [button] } pairRequestAcknowledgedAlert :: String -> Maybe AlertButton -> Alert @@ -253,7 +298,7 @@ , alertPriority = High , alertName = Just $ PairAlert who , alertCombiner = Just $ dataCombiner $ \_old new -> new - , alertButton = button + , alertButtons = maybe [] (:[]) button } xmppNeededAlert :: AlertButton -> Alert @@ -261,7 +306,7 @@ { alertHeader = Just "Share with friends, and keep your devices in sync across the cloud." , alertIcon = Just TheCloud , alertPriority = High - , alertButton = Just button + , alertButtons = [button] , alertClosable = True , alertClass = Message , alertMessageRender = renderData @@ -280,7 +325,7 @@ ] , alertIcon = Just ErrorIcon , alertPriority = High - , alertButton = Just button + , alertButtons = [button] , alertClosable = True , alertClass = Message , alertMessageRender = renderData @@ -298,7 +343,7 @@ "\" has been emptied, and can now be removed." , alertIcon = Just InfoIcon , alertPriority = High - , alertButton = Just button + , alertButtons = [button] , alertClosable = True , alertClass = Message , alertMessageRender = renderData diff --git a/Assistant/Alert/Utility.hs b/Assistant/Alert/Utility.hs --- a/Assistant/Alert/Utility.hs +++ b/Assistant/Alert/Utility.hs @@ -87,7 +87,7 @@ { alertClass = if c == Activity then c' else c , alertPriority = Filler , alertClosable = True - , alertButton = Nothing + , alertButtons = [] , alertIcon = Just $ if success then SuccessIcon else ErrorIcon } where diff --git a/Assistant/NamedThread.hs b/Assistant/NamedThread.hs --- a/Assistant/NamedThread.hs +++ b/Assistant/NamedThread.hs @@ -82,7 +82,7 @@ (RestartThreadR name) runAssistant d $ void $ addAlert $ (warningAlert (fromThreadName name) msg) - { alertButton = Just button } + { alertButtons = [button] } #endif namedThreadId :: NamedThread -> Assistant (Maybe ThreadId) diff --git a/Assistant/Repair.hs b/Assistant/Repair.hs --- a/Assistant/Repair.hs +++ b/Assistant/Repair.hs @@ -46,7 +46,7 @@ unless ok $ do button <- mkAlertButton True (T.pack "Click Here") urlrenderer $ RepairRepositoryR u - void $ addAlert $ brokenRepositoryAlert button + void $ addAlert $ brokenRepositoryAlert [button] #endif return ok | otherwise = return False diff --git a/Assistant/Restart.hs b/Assistant/Restart.hs new file mode 100644 --- /dev/null +++ b/Assistant/Restart.hs @@ -0,0 +1,86 @@ +{- git-annex assistant restarting + - + - Copyright 2013 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +module Assistant.Restart where + +import Assistant.Common +import Assistant.Threads.Watcher +import Assistant.DaemonStatus +import Assistant.NamedThread +import Utility.ThreadScheduler +import Utility.NotificationBroadcaster +import Utility.Url +import qualified Git.Construct +import qualified Git.Config +import Config.Files +import qualified Annex +import qualified Git + +import Control.Concurrent +import System.Posix (getProcessID, signalProcess, sigTERM) +import System.Process (cwd) + +{- Before the assistant can be restarted, have to remove our + - gitAnnexUrlFile and our gitAnnexPidFile. Pausing the watcher is also + - a good idea, to avoid fighting when two assistants are running in the + - same repo. + -} +prepRestart :: Assistant () +prepRestart = do + liftIO . maybe noop (`throwTo` PauseWatcher) =<< namedThreadId watchThread + liftIO . nukeFile =<< liftAnnex (fromRepo gitAnnexUrlFile) + liftIO . nukeFile =<< liftAnnex (fromRepo gitAnnexPidFile) + +{- To finish a restart, send a global redirect to the new url + - to any web browsers that are displaying the webapp. + - + - Wait for browser to update before terminating this process. -} +postRestart :: URLString -> Assistant () +postRestart url = do + modifyDaemonStatus_ $ \status -> status { globalRedirUrl = Just url } + liftIO . sendNotification . globalRedirNotifier =<< getDaemonStatus + void $ liftIO $ forkIO $ do + threadDelaySeconds (Seconds 120) + signalProcess sigTERM =<< getProcessID + +runRestart :: Assistant URLString +runRestart = liftIO . newAssistantUrl + =<< liftAnnex (Git.repoLocation <$> Annex.gitRepo) + +{- Starts up the assistant in the repository, and waits for it to create + - a gitAnnexUrlFile. Waits for the assistant to be up and listening for + - connections by testing the url. -} +newAssistantUrl :: FilePath -> IO URLString +newAssistantUrl repo = do + startAssistant repo + geturl + where + geturl = do + r <- Git.Config.read =<< Git.Construct.fromPath repo + waiturl $ gitAnnexUrlFile r + waiturl urlfile = do + v <- tryIO $ readFile urlfile + case v of + Left _ -> delayed $ waiturl urlfile + Right url -> ifM (listening url) + ( return url + , delayed $ waiturl urlfile + ) + listening url = catchBoolIO $ fst <$> exists url [] Nothing + delayed a = do + threadDelay 100000 -- 1/10th of a second + a + +{- Returns once the assistant has daemonized, but possibly before it's + - listening for web connections. -} +startAssistant :: FilePath -> IO () +startAssistant repo = do + program <- readProgramFile + (_, _, _, pid) <- + createProcess $ + (proc program ["assistant"]) { cwd = Just repo } + void $ checkSuccessProcess pid diff --git a/Assistant/Threads/NetWatcher.hs b/Assistant/Threads/NetWatcher.hs --- a/Assistant/Threads/NetWatcher.hs +++ b/Assistant/Threads/NetWatcher.hs @@ -15,6 +15,7 @@ import Utility.ThreadScheduler import qualified Types.Remote as Remote import Assistant.DaemonStatus +import Utility.NotificationBroadcaster #if WITH_DBUS import Utility.DBus @@ -127,7 +128,9 @@ #endif handleConnection :: Assistant () -handleConnection = reconnectRemotes True =<< networkRemotes +handleConnection = do + liftIO . sendNotification . networkConnectedNotifier =<< getDaemonStatus + reconnectRemotes True =<< networkRemotes {- Network remotes to sync with. -} networkRemotes :: Assistant [Remote] diff --git a/Assistant/Threads/TransferWatcher.hs b/Assistant/Threads/TransferWatcher.hs --- a/Assistant/Threads/TransferWatcher.hs +++ b/Assistant/Threads/TransferWatcher.hs @@ -16,6 +16,7 @@ import qualified Remote import Control.Concurrent +import qualified Data.Map as M {- This thread watches for changes to the gitAnnexTransferDir, - and updates the DaemonStatus's map of ongoing transfers. -} @@ -88,6 +89,11 @@ Just t -> do debug [ "transfer finishing:", show t] minfo <- removeTransfer t + + -- Run transfer hook. + m <- transferHook <$> getDaemonStatus + maybe noop (\hook -> void $ liftIO $ forkIO $ hook t) + (M.lookup (transferKey t) m) finished <- asIO2 finishedTransfer void $ liftIO $ forkIO $ do diff --git a/Assistant/Threads/UpgradeWatcher.hs b/Assistant/Threads/UpgradeWatcher.hs new file mode 100644 --- /dev/null +++ b/Assistant/Threads/UpgradeWatcher.hs @@ -0,0 +1,109 @@ +{- git-annex assistant thread to detect when git-annex is upgraded + - + - Copyright 2013 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +{-# LANGUAGE CPP #-} + +module Assistant.Threads.UpgradeWatcher ( + upgradeWatcherThread +) where + +import Assistant.Common +import Assistant.Upgrade +import Utility.DirWatcher +import Utility.DirWatcher.Types +import Utility.ThreadScheduler +import Assistant.Types.UrlRenderer +import Assistant.Alert +import Assistant.DaemonStatus +#ifdef WITH_WEBAPP +import Assistant.WebApp.Types +import qualified Build.SysConfig +#endif + +import Control.Concurrent.MVar +import qualified Data.Text as T + +data WatcherState = InStartupScan | Started | Upgrading + deriving (Eq) + +upgradeWatcherThread :: UrlRenderer -> NamedThread +upgradeWatcherThread urlrenderer = namedThread "UpgradeWatcher" $ do + whenM (liftIO checkSuccessfulUpgrade) $ + showSuccessfulUpgrade urlrenderer + go =<< liftIO upgradeFlagFile + where + go Nothing = debug [ "cannot determine program path" ] + go (Just flagfile) = do + mvar <- liftIO $ newMVar InStartupScan + changed <- Just <$> asIO2 (changedFile urlrenderer mvar flagfile) + let hooks = mkWatchHooks + { addHook = changed + , delHook = changed + , addSymlinkHook = changed + , modifyHook = changed + , delDirHook = changed + } + let dir = parentDir flagfile + let depth = length (splitPath dir) + 1 + let nosubdirs f = length (splitPath f) == depth + void $ liftIO $ watchDir dir nosubdirs hooks (startup mvar) + -- Ignore bogus events generated during the startup scan. + startup mvar scanner = do + r <- scanner + void $ swapMVar mvar Started + return r + +changedFile :: UrlRenderer -> MVar WatcherState -> FilePath -> FilePath -> Maybe FileStatus -> Assistant () +changedFile urlrenderer mvar flagfile file _status + | flagfile /= file = noop + | otherwise = do + state <- liftIO $ readMVar mvar + when (state == Started) $ do + setstate Upgrading + ifM (liftIO upgradeSanityCheck) + ( handleUpgrade urlrenderer + , do + debug ["new version failed sanity check; not using"] + setstate Started + ) + where + setstate = void . liftIO . swapMVar mvar + +handleUpgrade :: UrlRenderer -> Assistant () +handleUpgrade urlrenderer = do + -- Wait 2 minutes for any final upgrade changes to settle. + -- (For example, other associated files may be being put into + -- place.) Not needed when using a distribution bundle, because + -- in that case git-annex handles the upgrade in a non-racy way. + liftIO $ unlessM usingDistribution $ + threadDelaySeconds (Seconds 120) + ifM autoUpgradeEnabled + ( do + debug ["starting automatic upgrade"] + unattendedUpgrade +#ifdef WITH_WEBAPP + , do + button <- mkAlertButton True (T.pack "Finish Upgrade") urlrenderer ConfigFinishUpgradeR + void $ addAlert $ upgradeReadyAlert button +#else + , noop +#endif + ) + +showSuccessfulUpgrade :: UrlRenderer -> Assistant () +showSuccessfulUpgrade urlrenderer = do +#ifdef WITH_WEBAPP + button <- ifM autoUpgradeEnabled + ( pure Nothing + , Just <$> mkAlertButton True + (T.pack "Enable Automatic Upgrades") + urlrenderer ConfigEnableAutomaticUpgradeR + ) + void $ addAlert $ upgradeFinishedAlert button Build.SysConfig.packageversion +#else + noop +#endif diff --git a/Assistant/Threads/Upgrader.hs b/Assistant/Threads/Upgrader.hs new file mode 100644 --- /dev/null +++ b/Assistant/Threads/Upgrader.hs @@ -0,0 +1,101 @@ +{- git-annex assistant thread to detect when upgrade is available + - + - Copyright 2013 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +{-# LANGUAGE CPP #-} + +module Assistant.Threads.Upgrader ( + upgraderThread +) where + +import Assistant.Common +import Assistant.Upgrade + +import Assistant.Types.UrlRenderer +import Assistant.DaemonStatus +import Assistant.Alert +import Utility.NotificationBroadcaster +import Utility.Tmp +import qualified Annex +import qualified Build.SysConfig +import qualified Utility.Url as Url +import qualified Annex.Url as Url +import qualified Git.Version +import Types.Distribution +#ifdef WITH_WEBAPP +import Assistant.WebApp.Types +#endif + +import Data.Time.Clock +import qualified Data.Text as T + +upgraderThread :: UrlRenderer -> NamedThread +upgraderThread urlrenderer = namedThread "Upgrader" $ + when (isJust Build.SysConfig.upgradelocation) $ do + {- Check for upgrade on startup, unless it was just + - upgraded. -} + unlessM (liftIO checkSuccessfulUpgrade) $ + checkUpgrade urlrenderer + h <- liftIO . newNotificationHandle False . networkConnectedNotifier =<< getDaemonStatus + go h =<< liftIO getCurrentTime + where + {- Wait for a network connection event. Then see if it's been + - half a day since the last upgrade check. If so, proceed with + - check. -} + go h lastchecked = do + liftIO $ waitNotification h + autoupgrade <- liftAnnex $ annexAutoUpgrade <$> Annex.getGitConfig + if autoupgrade == NoAutoUpgrade + then go h lastchecked + else do + now <- liftIO getCurrentTime + if diffUTCTime now lastchecked > halfday + then do + checkUpgrade urlrenderer + go h =<< liftIO getCurrentTime + else go h lastchecked + halfday = 12 * 60 * 60 + +checkUpgrade :: UrlRenderer -> Assistant () +checkUpgrade urlrenderer = do + debug [ "Checking if an upgrade is available." ] + go =<< getDistributionInfo + where + go Nothing = debug [ "Failed to check if upgrade is available." ] + go (Just d) = do + let installed = Git.Version.normalize Build.SysConfig.packageversion + let avail = Git.Version.normalize $ distributionVersion d + let old = Git.Version.normalize <$> distributionUrgentUpgrade d + if Just installed <= old + then canUpgrade High urlrenderer d + else if installed < avail + then canUpgrade Low urlrenderer d + else debug [ "No new version found." ] + +canUpgrade :: AlertPriority -> UrlRenderer -> GitAnnexDistribution -> Assistant () +canUpgrade urgency urlrenderer d = ifM autoUpgradeEnabled + ( startDistributionDownload d + , do +#ifdef WITH_WEBAPP + button <- mkAlertButton True (T.pack "Upgrade") urlrenderer (ConfigStartUpgradeR d) + void $ addAlert (canUpgradeAlert urgency (distributionVersion d) button) +#else + noop +#endif + ) + +getDistributionInfo :: Assistant (Maybe GitAnnexDistribution) +getDistributionInfo = do + ua <- liftAnnex Url.getUserAgent + liftIO $ withTmpFile "git-annex.tmp" $ \tmpfile h -> do + hClose h + ifM (Url.downloadQuiet distributionInfoUrl [] [] tmpfile ua) + ( readish <$> readFileStrict tmpfile + , return Nothing + ) + +distributionInfoUrl :: String +distributionInfoUrl = fromJust Build.SysConfig.upgradelocation ++ ".info" diff --git a/Assistant/Threads/WebApp.hs b/Assistant/Threads/WebApp.hs --- a/Assistant/Threads/WebApp.hs +++ b/Assistant/Threads/WebApp.hs @@ -30,6 +30,7 @@ import Assistant.WebApp.Configurators.Edit import Assistant.WebApp.Configurators.Delete import Assistant.WebApp.Configurators.Fsck +import Assistant.WebApp.Configurators.Upgrade import Assistant.WebApp.Documentation import Assistant.WebApp.Control import Assistant.WebApp.OtherRepos diff --git a/Assistant/Types/Alert.hs b/Assistant/Types/Alert.hs --- a/Assistant/Types/Alert.hs +++ b/Assistant/Types/Alert.hs @@ -31,6 +31,7 @@ | CloudRepoNeededAlert | SyncAlert | NotFsckedAlert + | UpgradeAlert deriving (Eq) {- The first alert is the new alert, the second is an old alert. @@ -49,10 +50,10 @@ , alertIcon :: Maybe AlertIcon , alertCombiner :: Maybe AlertCombiner , alertName :: Maybe AlertName - , alertButton :: Maybe AlertButton + , alertButtons :: [AlertButton] } -data AlertIcon = ActivityIcon | SyncIcon | SuccessIcon | ErrorIcon | InfoIcon | TheCloud +data AlertIcon = ActivityIcon | SyncIcon | SuccessIcon | ErrorIcon | InfoIcon | UpgradeIcon | TheCloud type AlertMap = M.Map AlertId Alert @@ -73,4 +74,5 @@ { buttonLabel :: Text , buttonUrl :: Text , buttonAction :: Maybe (AlertId -> IO ()) + , buttonPrimary :: Bool } diff --git a/Assistant/Types/DaemonStatus.hs b/Assistant/Types/DaemonStatus.hs --- a/Assistant/Types/DaemonStatus.hs +++ b/Assistant/Types/DaemonStatus.hs @@ -14,6 +14,7 @@ import Assistant.Types.ThreadName import Assistant.Types.NetMessager import Assistant.Types.Alert +import Utility.Url import Control.Concurrent.STM import Control.Concurrent.MVar @@ -55,18 +56,25 @@ , desynced :: S.Set UUID -- Pairing request that is in progress. , pairingInProgress :: Maybe PairingInProgress - -- Broadcasts notifications about all changes to the DaemonStatus + -- Broadcasts notifications about all changes to the DaemonStatus. , changeNotifier :: NotificationBroadcaster -- Broadcasts notifications when queued or current transfers change. , transferNotifier :: NotificationBroadcaster - -- Broadcasts notifications when there's a change to the alerts + -- Broadcasts notifications when there's a change to the alerts. , alertNotifier :: NotificationBroadcaster - -- Broadcasts notifications when the syncRemotes change + -- Broadcasts notifications when the syncRemotes change. , syncRemotesNotifier :: NotificationBroadcaster - -- Broadcasts notifications when the scheduleLog changes + -- Broadcasts notifications when the scheduleLog changes. , scheduleLogNotifier :: NotificationBroadcaster -- Broadcasts a notification once the startup sanity check has run. , startupSanityCheckNotifier :: NotificationBroadcaster + -- Broadcasts notifications when the network is connected. + , networkConnectedNotifier :: NotificationBroadcaster + -- Broadcasts notifications when a global redirect is needed. + , globalRedirNotifier :: NotificationBroadcaster + , globalRedirUrl :: Maybe URLString + -- Actions to run after a Key is transferred. + , transferHook :: M.Map Key (Transfer -> IO ()) -- When the XMPP client is connected, this will contain the XMPP -- address. , xmppClientID :: Maybe ClientID @@ -103,5 +111,9 @@ <*> newNotificationBroadcaster <*> newNotificationBroadcaster <*> newNotificationBroadcaster + <*> newNotificationBroadcaster + <*> newNotificationBroadcaster + <*> pure Nothing + <*> pure M.empty <*> pure Nothing <*> pure M.empty diff --git a/Assistant/Upgrade.hs b/Assistant/Upgrade.hs new file mode 100644 --- /dev/null +++ b/Assistant/Upgrade.hs @@ -0,0 +1,316 @@ +{- git-annex assistant upgrading + - + - Copyright 2013 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +{-# LANGUAGE CPP #-} + +module Assistant.Upgrade where + +import Assistant.Common +import Assistant.Restart +import qualified Annex +import Assistant.Alert +import Assistant.DaemonStatus +import Utility.Env +import Types.Distribution +import Logs.Transfer +import Logs.Web +import Logs.Presence +import Logs.Location +import Annex.Content +import qualified Backend +import qualified Types.Backend +import qualified Types.Key +import Assistant.TransferQueue +import Assistant.TransferSlots +import Remote (remoteFromUUID) +import Annex.Path +import Config.Files +import Utility.ThreadScheduler +import Utility.Tmp +import Utility.UserInfo +import qualified Utility.Lsof as Lsof + +import qualified Data.Map as M +import Data.Tuple.Utils + +{- Upgrade without interaction in the webapp. -} +unattendedUpgrade :: Assistant () +unattendedUpgrade = do + prepUpgrade + url <- runRestart + postUpgrade url + +prepUpgrade :: Assistant () +prepUpgrade = do + void $ addAlert upgradingAlert + void $ liftIO $ setEnv upgradedEnv "1" True + prepRestart + +postUpgrade :: URLString -> Assistant () +postUpgrade = postRestart + +autoUpgradeEnabled :: Assistant Bool +autoUpgradeEnabled = liftAnnex $ (==) AutoUpgrade . annexAutoUpgrade <$> Annex.getGitConfig + +checkSuccessfulUpgrade :: IO Bool +checkSuccessfulUpgrade = isJust <$> getEnv upgradedEnv + +upgradedEnv :: String +upgradedEnv = "GIT_ANNEX_UPGRADED" + +{- Start downloading the distribution key from the web. + - Install a hook that will be run once the download is complete, + - and finishes the upgrade. + - + - Creates the destination directory where the upgrade will be installed + - early, in order to check if another upgrade has happened (or is + - happending). On failure, the directory is removed. + -} +startDistributionDownload :: GitAnnexDistribution -> Assistant () +startDistributionDownload d = go =<< liftIO . newVersionLocation d =<< liftIO oldVersionLocation + where + go Nothing = debug ["Skipping redundant upgrade"] + go (Just dest) = do + liftAnnex $ setUrlPresent k u + hook <- asIO1 $ distributionDownloadComplete d dest cleanup + modifyDaemonStatus_ $ \s -> s + { transferHook = M.insert k hook (transferHook s) } + maybe noop (queueTransfer "upgrade" Next (Just f) t) + =<< liftAnnex (remoteFromUUID webUUID) + startTransfer t + k = distributionKey d + u = distributionUrl d + f = takeFileName u ++ " (for upgrade)" + t = Transfer + { transferDirection = Download + , transferUUID = webUUID + , transferKey = k + } + cleanup = liftAnnex $ do + removeAnnex k + setUrlMissing k u + logStatus k InfoMissing + +{- Called once the download is done. + - Passed an action that can be used to clean up the downloaded file. + - + - Fsck the key to verify the download. + -} +distributionDownloadComplete :: GitAnnexDistribution -> FilePath -> Assistant () -> Transfer -> Assistant () +distributionDownloadComplete d dest cleanup t + | transferDirection t == Download = do + debug ["finished downloading git-annex distribution"] + maybe (failedupgrade "bad download") go + =<< liftAnnex (withObjectLoc k fsckit (getM fsckit)) + | otherwise = cleanup + where + k = distributionKey d + fsckit f = case Backend.maybeLookupBackendName (Types.Key.keyBackendName k) of + Nothing -> return $ Just f + Just b -> case Types.Backend.fsckKey b of + Nothing -> return $ Just f + Just a -> ifM (a k f) + ( return $ Just f + , return Nothing + ) + go f = do + ua <- asIO $ upgradeToDistribution dest cleanup f + fa <- asIO1 failedupgrade + liftIO $ ua `catchNonAsync` (fa . show) + failedupgrade msg = do + void $ addAlert $ upgradeFailedAlert msg + cleanup + liftIO $ void $ tryIO $ removeDirectoryRecursive dest + +{- The upgrade method varies by OS. + - + - In general, find where the distribution was installed before, + - and unpack the new distribution next to it (in a versioned directory). + - Then update the programFile to point to the new version. + -} +upgradeToDistribution :: FilePath -> Assistant () -> FilePath -> Assistant () +upgradeToDistribution newdir cleanup distributionfile = do + liftIO $ createDirectoryIfMissing True newdir + (program, deleteold) <- unpack + changeprogram program + cleanup + prepUpgrade + url <- runRestart + {- At this point, the new assistant is fully running, so + - it's safe to delete the old version. -} + liftIO $ void $ tryIO deleteold + postUpgrade url + where + changeprogram program = liftIO $ do + unlessM (boolSystem program [Param "version"]) $ + error "New git-annex program failed to run! Not using." + pf <- programFile + liftIO $ writeFile pf program + +#ifdef darwin_HOST_OS + {- OS X uses a dmg, so mount it, and copy the contents into place. -} + unpack = liftIO $ do + olddir <- oldVersionLocation + withTmpDirIn (parentDir newdir) "git-annex.upgrade" $ \tmpdir -> do + void $ boolSystem "hdiutil" + [ Param "attach", File distributionfile + , Param "-mountpoint", File tmpdir + ] + void $ boolSystem "cp" + [ Param "-R" + , File $ tmpdir installBase "Contents" + , File $ newdir + ] + void $ boolSystem "hdiutil" + [ Param "eject" + , File tmpdir + ] + sanitycheck newdir + let deleteold = do + deleteFromManifest $ olddir "Contents" "MacOS" + makeorigsymlink olddir + return (newdir "Contents" "MacOS" "git-annex", deleteold) +#else + {- Linux uses a tarball (so could other POSIX systems), so + - untar it (into a temp directory) and move the directory + - into place. -} + unpack = liftIO $ do + olddir <- oldVersionLocation + withTmpDirIn (parentDir newdir) "git-annex.upgrade" $ \tmpdir -> do + let tarball = tmpdir "tar" + -- Cannot rely on filename extension, and this also + -- avoids problems if tar doesn't support transparent + -- decompression. + void $ boolSystem "sh" + [ Param "-c" + , Param $ "zcat < " ++ shellEscape distributionfile ++ + " > " ++ shellEscape tarball + ] + tarok <- boolSystem "tar" + [ Param "xf" + , Param tarball + , Param "--directory", File tmpdir + ] + unless tarok $ + error $ "failed to untar " ++ distributionfile + sanitycheck $ tmpdir installBase + installby rename newdir (tmpdir installBase) + let deleteold = do + deleteFromManifest olddir + makeorigsymlink olddir + return (newdir "git-annex", deleteold) + installby a dstdir srcdir = + mapM_ (\x -> a x (dstdir takeFileName x)) + =<< dirContents srcdir +#endif + sanitycheck dir = + unlessM (doesDirectoryExist dir) $ + error $ "did not find " ++ dir ++ " in " ++ distributionfile + makeorigsymlink olddir = do + let origdir = parentDir olddir installBase + nukeFile origdir + createSymbolicLink newdir origdir + +{- Finds where the old version was installed. -} +oldVersionLocation :: IO FilePath +oldVersionLocation = do +#ifdef darwin_HOST_OS + pdir <- parentDir <$> readProgramFile + let dirs = splitDirectories pdir + {- It will probably be deep inside a git-annex.app directory. -} + let olddir = case findIndex ("git-annex.app" `isPrefixOf`) dirs of + Nothing -> pdir + Just i -> joinPath (take (i + 1) dirs) +#else + olddir <- parentDir <$> readProgramFile +#endif + when (null olddir) $ + error $ "Cannot find old distribution bundle; not upgrading." + return olddir + +{- Finds a place to install the new version. + - Generally, put it in the parent directory of where the old version was + - installed, and use a version number in the directory name. + - If unable to write to there, instead put it in the home directory. + - + - The directory is created. If it already exists, returns Nothing. + -} +newVersionLocation :: GitAnnexDistribution -> FilePath -> IO (Maybe FilePath) +newVersionLocation d olddir = + trymkdir newloc $ do + home <- myHomeDir + trymkdir (home s) $ + return Nothing + where + s = installBase ++ "." ++ distributionVersion d + topdir = parentDir olddir + newloc = topdir s + trymkdir dir fallback = + (createDirectory dir >> return (Just dir)) + `catchIO` const fallback + +installBase :: String +installBase = "git-annex." ++ +#ifdef linux_HOST_OS + "linux" +#else +#ifdef darwin_HOST_OS + "app" +#else + "dir" +#endif +#endif + +deleteFromManifest :: FilePath -> IO () +deleteFromManifest dir = do + fs <- map (dir ) . lines <$> catchDefaultIO "" (readFile manifest) + mapM_ nukeFile fs + nukeFile manifest + removeEmptyRecursive dir + where + manifest = dir "git-annex.MANIFEST" + +removeEmptyRecursive :: FilePath -> IO () +removeEmptyRecursive dir = do + print ("remove", dir) + mapM_ removeEmptyRecursive =<< dirContents dir + void $ tryIO $ removeDirectory dir + +{- This is a file that the UpgradeWatcher can watch for modifications to + - detect when git-annex has been upgraded. + -} +upgradeFlagFile :: IO (Maybe FilePath) +upgradeFlagFile = ifM usingDistribution + ( Just <$> programFile + , programPath + ) + +{- Sanity check to see if an upgrade is complete and the program is ready + - to be run. -} +upgradeSanityCheck :: IO Bool +upgradeSanityCheck = ifM usingDistribution + ( doesFileExist =<< programFile + , do + -- Ensure that the program is present, and has no writers, + -- and can be run. This should handle distribution + -- upgrades, manual upgrades, etc. + v <- programPath + case v of + Nothing -> return False + Just program -> do + untilM (doesFileExist program <&&> nowriter program) $ + threadDelaySeconds (Seconds 60) + boolSystem program [Param "version"] + ) + where + nowriter f = null + . filter (`elem` [Lsof.OpenReadWrite, Lsof.OpenWriteOnly]) + . map snd3 + <$> Lsof.query [f] + +usingDistribution :: IO Bool +usingDistribution = isJust <$> getEnv "GIT_ANNEX_STANDLONE_ENV" diff --git a/Assistant/WebApp/Configurators/Local.hs b/Assistant/WebApp/Configurators/Local.hs --- a/Assistant/WebApp/Configurators/Local.hs +++ b/Assistant/WebApp/Configurators/Local.hs @@ -10,10 +10,10 @@ module Assistant.WebApp.Configurators.Local where import Assistant.WebApp.Common -import Assistant.WebApp.OtherRepos import Assistant.WebApp.Gpg import Assistant.WebApp.MakeRemote import Assistant.Sync +import Assistant.Restart import Init import qualified Git import qualified Git.Construct diff --git a/Assistant/WebApp/Configurators/Pairing.hs b/Assistant/WebApp/Configurators/Pairing.hs --- a/Assistant/WebApp/Configurators/Pairing.hs +++ b/Assistant/WebApp/Configurators/Pairing.hs @@ -249,6 +249,7 @@ tid <- liftIO myThreadId let selfdestruct = AlertButton { buttonLabel = "Cancel" + , buttonPrimary = True , buttonUrl = urlrender DashboardR , buttonAction = Just $ const $ do oncancel diff --git a/Assistant/WebApp/Configurators/Preferences.hs b/Assistant/WebApp/Configurators/Preferences.hs --- a/Assistant/WebApp/Configurators/Preferences.hs +++ b/Assistant/WebApp/Configurators/Preferences.hs @@ -19,6 +19,8 @@ import Config.Files import Utility.DataUnits import Git.Config +import Types.Distribution +import qualified Build.SysConfig import qualified Data.Text as T @@ -26,6 +28,7 @@ { diskReserve :: Text , numCopies :: Int , autoStart :: Bool + , autoUpgrade :: AutoUpgrade , debugEnabled :: Bool } @@ -37,6 +40,8 @@ "Number of copies" (Just $ numCopies def) <*> areq (checkBoxField `withNote` autostartnote) "Auto start" (Just $ autoStart def) + <*> areq (selectFieldList autoUpgradeChoices) + autoUpgradeLabel (Just $ autoUpgrade def) <*> areq (checkBoxField `withNote` debugnote) "Enable debug logging" (Just $ debugEnabled def) where @@ -45,6 +50,16 @@ debugnote = [whamlet|View Log|] autostartnote = [whamlet|Start the git-annex assistant at boot or on login.|] + autoUpgradeChoices :: [(Text, AutoUpgrade)] + autoUpgradeChoices = + [ ("ask me", AskUpgrade) + , ("enabled", AutoUpgrade) + , ("disabled", NoAutoUpgrade) + ] + autoUpgradeLabel + | isJust Build.SysConfig.upgradelocation = "Auto upgrade" + | otherwise = "Auto restart on upgrade" + positiveIntField = check isPositive intField where isPositive i @@ -68,12 +83,14 @@ <$> (T.pack . roughSize storageUnits False . annexDiskReserve <$> Annex.getGitConfig) <*> (annexNumCopies <$> Annex.getGitConfig) <*> inAutoStartFile + <*> (annexAutoUpgrade <$> Annex.getGitConfig) <*> (annexDebug <$> Annex.getGitConfig) storePrefs :: PrefsForm -> Annex () storePrefs p = do setConfig (annexConfig "diskreserve") (T.unpack $ diskReserve p) setConfig (annexConfig "numcopies") (show $ numCopies p) + setConfig (annexConfig "autoupgrade") (fromAutoUpgrade $ autoUpgrade p) unlessM ((==) <$> pure (autoStart p) <*> inAutoStartFile) $ do here <- fromRepo Git.repoPath liftIO $ if autoStart p diff --git a/Assistant/WebApp/Configurators/Upgrade.hs b/Assistant/WebApp/Configurators/Upgrade.hs new file mode 100644 --- /dev/null +++ b/Assistant/WebApp/Configurators/Upgrade.hs @@ -0,0 +1,48 @@ +{- git-annex assistant webapp upgrade UI + - + - Copyright 2013 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +{-# LANGUAGE CPP, QuasiQuotes, TemplateHaskell, OverloadedStrings #-} + +module Assistant.WebApp.Configurators.Upgrade where + +import Assistant.WebApp.Common +import Types.Distribution +import Assistant.Upgrade +import Assistant.Restart +import Config + +{- On Android, just point the user at the apk file to download. + - Installation will be handled by selecting the downloaded file. + - + - Otherwise, start the upgrade process, which will run fully + - noninteractively. + - -} +getConfigStartUpgradeR :: GitAnnexDistribution -> Handler Html +getConfigStartUpgradeR d = do +#ifdef ANDROID_SPLICES + let url = distributionUrl d + page "Upgrade" (Just Configuration) $ + $(widgetFile "configurators/upgrade/android") +#else + liftAssistant $ startDistributionDownload d + redirect DashboardR +#endif + +{- Finish upgrade by starting the new assistant in the same repository this + - one is running in, and redirecting to it. -} +getConfigFinishUpgradeR :: Handler Html +getConfigFinishUpgradeR = do + liftAssistant prepUpgrade + url <- liftAssistant runRestart + liftAssistant $ postUpgrade url + redirect url + +getConfigEnableAutomaticUpgradeR :: Handler Html +getConfigEnableAutomaticUpgradeR = do + liftAnnex $ setConfig (annexConfig "autoupgrade") + (fromAutoUpgrade AutoUpgrade) + redirect DashboardR diff --git a/Assistant/WebApp/Configurators/XMPP.hs b/Assistant/WebApp/Configurators/XMPP.hs --- a/Assistant/WebApp/Configurators/XMPP.hs +++ b/Assistant/WebApp/Configurators/XMPP.hs @@ -43,6 +43,7 @@ { buttonLabel = "Configure a Jabber account" , buttonUrl = urlrender XMPPConfigR , buttonAction = Just close + , buttonPrimary = True } #else xmppNeeded = return () diff --git a/Assistant/WebApp/Control.hs b/Assistant/WebApp/Control.hs --- a/Assistant/WebApp/Control.hs +++ b/Assistant/WebApp/Control.hs @@ -1,6 +1,6 @@ {- git-annex assistant webapp control - - - Copyright 2012 Joey Hess + - Copyright 2012, 2013 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -10,15 +10,17 @@ module Assistant.WebApp.Control where import Assistant.WebApp.Common -import Config.Files -import Utility.LogFile import Assistant.DaemonStatus import Assistant.Alert import Assistant.TransferSlots +import Assistant.Restart +import Utility.LogFile +import Utility.NotificationBroadcaster import Control.Concurrent import System.Posix (getProcessID, signalProcess, sigTERM) import qualified Data.Map as M +import qualified Data.Text as T getShutdownR :: Handler Html getShutdownR = page "Shutdown" Nothing $ @@ -36,27 +38,33 @@ - the transfer processes). -} ts <- M.keys . currentTransfers <$> getDaemonStatus mapM_ pauseTransfer ts - page "Shutdown" Nothing $ do - {- Wait 2 seconds before shutting down, to give the web - - page time to load in the browser. -} - void $ liftIO $ forkIO $ do - threadDelay 2000000 - signalProcess sigTERM =<< getProcessID - $(widgetFile "control/shutdownconfirmed") - -{- Quite a hack, and doesn't redirect the browser window. -} -getRestartR :: Handler Html -getRestartR = page "Restarting" Nothing $ do + webapp <- getYesod + let url = T.unpack $ yesodRender webapp (T.pack "") NotRunningR [] + {- Signal any other web browsers. -} + liftAssistant $ do + modifyDaemonStatus_ $ \status -> status { globalRedirUrl = Just url } + liftIO . sendNotification . globalRedirNotifier =<< getDaemonStatus + {- Wait 2 seconds before shutting down, to give the web + - page time to load in the browser. -} void $ liftIO $ forkIO $ do threadDelay 2000000 - program <- readProgramFile - unlessM (boolSystem "sh" [Param "-c", Param $ restartcommand program]) $ - error "restart failed" - $(widgetFile "control/restarting") - where - restartcommand program = program ++ " assistant --stop; exec " ++ - program ++ " webapp" + signalProcess sigTERM =<< getProcessID + redirect NotRunningR +{- Use a custom page to avoid putting long polling elements on it that will + - fail and cause the web browser to show an error once the webapp is + - truely stopped. -} +getNotRunningR :: Handler Html +getNotRunningR = customPage' False Nothing $ + $(widgetFile "control/notrunning") + +getRestartR :: Handler Html +getRestartR = do + liftAssistant prepRestart + url <- liftAssistant runRestart + liftAssistant $ postRestart url + redirect url + getRestartThreadR :: ThreadName -> Handler () getRestartThreadR name = do m <- liftAssistant $ startedThreads <$> getDaemonStatus @@ -67,9 +75,5 @@ getLogR = page "Logs" Nothing $ do logfile <- liftAnnex $ fromRepo gitAnnexLogFile logs <- liftIO $ listLogs logfile - logcontent <- liftIO $ concat <$> mapM readlog logs + logcontent <- liftIO $ concat <$> mapM readFileStrictAnyEncoding logs $(widgetFile "control/log") - where - readlog f = withFile f ReadMode $ \h -> do - fileEncoding h -- log may contain invalid utf-8 - hClose h `after` hGetContentsStrict h diff --git a/Assistant/WebApp/Notifications.hs b/Assistant/WebApp/Notifications.hs --- a/Assistant/WebApp/Notifications.hs +++ b/Assistant/WebApp/Notifications.hs @@ -50,7 +50,6 @@ let startdelay = Aeson.String (T.pack (show ms_startdelay)) let ident = Aeson.String tident #endif - addScript $ StaticR longpolling_js $(widgetFile "notifications/longpolling") {- Notifier urls are requested by the javascript, to avoid allocation @@ -82,6 +81,9 @@ where route nid = RepoListR nid reposelector +getNotifierGlobalRedirR :: Handler RepPlain +getNotifierGlobalRedirR = notifierUrl GlobalRedirR getGlobalRedirBroadcaster + getTransferBroadcaster :: Assistant NotificationBroadcaster getTransferBroadcaster = transferNotifier <$> getDaemonStatus @@ -93,3 +95,12 @@ getRepoListBroadcaster :: Assistant NotificationBroadcaster getRepoListBroadcaster = syncRemotesNotifier <$> getDaemonStatus + +getGlobalRedirBroadcaster :: Assistant NotificationBroadcaster +getGlobalRedirBroadcaster = globalRedirNotifier <$> getDaemonStatus + +getGlobalRedirR :: NotificationId -> Handler RepPlain +getGlobalRedirR nid = do + waitNotifier getGlobalRedirBroadcaster nid + maybe (getGlobalRedirR nid) (return . RepPlain . toContent . T.pack) + =<< globalRedirUrl <$> liftAssistant getDaemonStatus diff --git a/Assistant/WebApp/OtherRepos.hs b/Assistant/WebApp/OtherRepos.hs --- a/Assistant/WebApp/OtherRepos.hs +++ b/Assistant/WebApp/OtherRepos.hs @@ -12,14 +12,9 @@ import Assistant.Common import Assistant.WebApp.Types import Assistant.WebApp.Page -import qualified Git.Construct -import qualified Git.Config import Config.Files -import qualified Utility.Url as Url import Utility.Yesod - -import Control.Concurrent -import System.Process (cwd) +import Assistant.Restart getRepositorySwitcherR :: Handler Html getRepositorySwitcherR = page "Switch repository" Nothing $ do @@ -35,38 +30,7 @@ names <- mapM relHome gooddirs return $ sort $ zip names gooddirs -{- Starts up the assistant in the repository, and waits for it to create - - a gitAnnexUrlFile. Waits for the assistant to be up and listening for - - connections by testing the url. Once it's running, redirect to it. - -} getSwitchToRepositoryR :: FilePath -> Handler Html getSwitchToRepositoryR repo = do - liftIO $ startAssistant repo liftIO $ addAutoStartFile repo -- make this the new default repo - redirect =<< liftIO geturl - where - geturl = do - r <- Git.Config.read =<< Git.Construct.fromPath repo - waiturl $ gitAnnexUrlFile r - waiturl urlfile = do - v <- tryIO $ readFile urlfile - case v of - Left _ -> delayed $ waiturl urlfile - Right url -> ifM (listening url) - ( return url - , delayed $ waiturl urlfile - ) - listening url = catchBoolIO $ fst <$> Url.exists url [] Nothing - delayed a = do - threadDelay 100000 -- 1/10th of a second - a - -{- Returns once the assistant has daemonized, but possibly before it's - - listening for web connections. -} -startAssistant :: FilePath -> IO () -startAssistant repo = do - program <- readProgramFile - (_, _, _, pid) <- - createProcess $ - (proc program ["assistant"]) { cwd = Just repo } - void $ checkSuccessProcess pid + redirect =<< liftIO (newAssistantUrl repo) diff --git a/Assistant/WebApp/Page.hs b/Assistant/WebApp/Page.hs --- a/Assistant/WebApp/Page.hs +++ b/Assistant/WebApp/Page.hs @@ -50,7 +50,10 @@ {- A custom page, with no title or sidebar set. -} customPage :: Maybe NavBarItem -> Widget -> Handler Html -customPage navbaritem content = do +customPage = customPage' True + +customPage' :: Bool -> Maybe NavBarItem -> Widget -> Handler Html +customPage' with_longpolling navbaritem content = do webapp <- getYesod case cannotRun webapp of Nothing -> do @@ -62,6 +65,8 @@ addScript $ StaticR js_bootstrap_dropdown_js addScript $ StaticR js_bootstrap_modal_js addScript $ StaticR js_bootstrap_collapse_js + when with_longpolling $ + addScript $ StaticR longpolling_js $(widgetFile "page") giveUrlRenderer $(Hamlet.hamletFile $ hamletTemplate "bootstrap") Just msg -> error msg diff --git a/Assistant/WebApp/SideBar.hs b/Assistant/WebApp/SideBar.hs --- a/Assistant/WebApp/SideBar.hs +++ b/Assistant/WebApp/SideBar.hs @@ -50,6 +50,7 @@ let message = renderAlertMessage alert let messagelines = T.lines message let multiline = length messagelines > 1 + let buttons = zip (alertButtons alert) [1..] $(widgetFile "sidebar/alert") {- Called by client to get a sidebar display. @@ -79,16 +80,20 @@ getCloseAlert = liftAssistant . removeAlert {- When an alert with a button is clicked on, the button takes us here. -} -getClickAlert :: AlertId -> Handler () -getClickAlert i = do +getClickAlert :: AlertId -> Int -> Handler () +getClickAlert i bnum = do m <- alertMap <$> liftAssistant getDaemonStatus case M.lookup i m of - Just (Alert { alertButton = Just b }) -> do - {- Spawn a thread to run the action while redirecting. -} - case buttonAction b of - Nothing -> noop - Just a -> liftIO $ void $ forkIO $ a i - redirect $ buttonUrl b + Just (Alert { alertButtons = bs }) + | length bs >= bnum -> do + let b = bs !! (bnum - 1) + {- Spawn a thread to run the action + - while redirecting. -} + case buttonAction b of + Nothing -> noop + Just a -> liftIO $ void $ forkIO $ a i + redirect $ buttonUrl b + | otherwise -> redirectBack _ -> redirectBack htmlIcon :: AlertIcon -> Widget @@ -97,6 +102,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|☂|] diff --git a/Assistant/WebApp/Types.hs b/Assistant/WebApp/Types.hs --- a/Assistant/WebApp/Types.hs +++ b/Assistant/WebApp/Types.hs @@ -25,6 +25,7 @@ import Build.SysConfig (packageversion) import Types.ScheduledActivity import Assistant.WebApp.RepoId +import Types.Distribution import Yesod.Static import Text.Hamlet @@ -163,6 +164,10 @@ data RepoKey = RepoKey KeyId | NoRepoKey deriving (Read, Show, Eq, Ord) +instance PathPiece Bool where + toPathPiece = pack . show + fromPathPiece = readish . unpack + instance PathPiece RemovableDrive where toPathPiece = pack . show fromPathPiece = readish . unpack @@ -220,5 +225,9 @@ fromPathPiece = readish . unpack instance PathPiece RepoId where + toPathPiece = pack . show + fromPathPiece = readish . unpack + +instance PathPiece GitAnnexDistribution where toPathPiece = pack . show fromPathPiece = readish . unpack diff --git a/Assistant/WebApp/routes b/Assistant/WebApp/routes --- a/Assistant/WebApp/routes +++ b/Assistant/WebApp/routes @@ -9,6 +9,7 @@ /shutdown ShutdownR GET /shutdown/confirm ShutdownConfirmedR GET +/shutdown/complete NotRunningR GET /restart RestartR GET /restart/thread/#ThreadName RestartThreadR GET /log LogR GET @@ -21,6 +22,9 @@ /config/xmpp/needcloudrepo/#UUID NeedCloudRepoR GET /config/fsck ConfigFsckR GET POST /config/fsck/preferences ConfigFsckPreferencesR POST +/config/upgrade/start/#GitAnnexDistribution ConfigStartUpgradeR GET +/config/upgrade/finish ConfigFinishUpgradeR GET +/config/upgrade/automatically ConfigEnableAutomaticUpgradeR GET /config/addrepository AddRepositoryR GET /config/repository/new NewRepositoryR GET POST @@ -100,8 +104,11 @@ /repolist/#NotificationId/#RepoSelector RepoListR GET /notifier/repolist/#RepoSelector NotifierRepoListR GET +/globalredir/#NotificationId GlobalRedirR GET +/notifier/globalredir NotifierGlobalRedirR GET + /alert/close/#AlertId CloseAlert GET -/alert/click/#AlertId ClickAlert GET +/alert/click/#AlertId/#Int ClickAlert GET /filebrowser FileBrowserR GET POST /transfer/pause/#Transfer PauseTransferR GET POST diff --git a/Build/BundledPrograms.hs b/Build/BundledPrograms.hs --- a/Build/BundledPrograms.hs +++ b/Build/BundledPrograms.hs @@ -45,6 +45,11 @@ , SysConfig.sha512 , SysConfig.sha224 , SysConfig.sha384 +#ifdef linux_HOST_OS + -- used to unpack the tarball when upgrading + , Just "gunzip" + , Just "tar" +#endif -- nice and ionice are not included in the bundle; we rely on the -- system's own version, which may better match its kernel ] diff --git a/Build/Configure.hs b/Build/Configure.hs --- a/Build/Configure.hs +++ b/Build/Configure.hs @@ -7,7 +7,7 @@ import System.Process import Control.Applicative import System.FilePath -import System.Environment +import System.Environment (getArgs) import Data.Maybe import Control.Monad.IfElse import Data.Char @@ -17,11 +17,13 @@ import Utility.SafeCommand import Utility.Monad import Utility.ExternalSHA +import Utility.Env import qualified Git.Version tests :: [TestCase] tests = [ TestCase "version" getVersion + , TestCase "UPGRADE_LOCATION" getUpgradeLocation , TestCase "git" $ requireCmd "git" "git --version >/dev/null" , TestCase "git version" getGitVersion , testCp "cp_a" "-a" @@ -33,6 +35,7 @@ , TestCase "wget" $ testCmd "wget" "wget --version >/dev/null" , TestCase "bup" $ testCmd "bup" "bup --version >/dev/null" , TestCase "quvi" $ testCmd "quvi" "quvi --version >/dev/null" + , TestCase "newquvi" $ testCmd "newquvi" "quvi info >/dev/null" , TestCase "nice" $ testCmd "nice" "nice true >/dev/null" , TestCase "ionice" $ testCmd "ionice" "ionice -c3 true >/dev/null" , TestCase "gpg" $ maybeSelectCmd "gpg" @@ -90,6 +93,11 @@ cmd = "cp " ++ option cmdline = cmd ++ " " ++ testFile ++ " " ++ testFile ++ ".new" +getUpgradeLocation :: Test +getUpgradeLocation = do + e <- getEnv "UPGRADE_LOCATION" + return $ Config "upgradelocation" $ MaybeStringConfig e + getGitVersion :: Test getGitVersion = Config "gitversion" . StringConfig . show <$> Git.Version.installed @@ -130,4 +138,3 @@ ] overridden (Config k _) = k `elem` overridekeys overridekeys = map (\(Config k _) -> k) overrides - diff --git a/Build/DistributionUpdate.hs b/Build/DistributionUpdate.hs new file mode 100644 --- /dev/null +++ b/Build/DistributionUpdate.hs @@ -0,0 +1,64 @@ +{- 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. -} + +import Common.Annex +import Types.Distribution +import Build.Version +import Utility.UserInfo +import Utility.Path +import qualified Git.Construct +import qualified Annex +import Annex.Content +import Backend +import Git.Command + +import Data.Time.Clock + +main = do + state <- Annex.new =<< Git.Construct.fromPath =<< getRepoDir + Annex.eval state makeinfos + +makeinfos :: Annex () +makeinfos = do + basedir <- liftIO getRepoDir + version <- liftIO getChangelogVersion + now <- liftIO getCurrentTime + liftIO $ putStrLn $ "building info files for version " ++ version ++ " in " ++ basedir + fs <- liftIO $ dirContentsRecursiveSkipping (== "info") (basedir "git-annex") + forM_ fs $ \f -> do + v <- lookupFile f + case v of + Nothing -> noop + Just (k, _b) -> whenM (inAnnex k) $ do + liftIO $ putStrLn f + let infofile = f ++ ".info" + liftIO $ writeFile infofile $ show $ GitAnnexDistribution + { distributionUrl = mkUrl basedir f + , distributionKey = k + , distributionVersion = version + , distributionReleasedate = now + , distributionUrgentUpgrade = Nothing + } + void $ inRepo $ runBool [Param "add", Param infofile] + void $ inRepo $ runBool + [ Param "commit" + , Param "-m" + , Param $ "publishing git-annex " ++ version + ] + void $ inRepo $ runBool + [ Param "annex" + , Params "move --to website" + ] + void $ inRepo $ runBool + [ Param "annex" + , Params "sync" + ] + +getRepoDir :: IO FilePath +getRepoDir = do + home <- liftIO myHomeDir + return $ home "lib" "downloads" + +mkUrl :: FilePath -> FilePath -> String +mkUrl basedir f = "https://downloads.kitenet.net/" ++ relPathDirToFile basedir f diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,30 @@ +git-annex (5.20131127) unstable; urgency=low + + * webapp: Detect when upgrades are available, and upgrade if the user + desires. + (Only when git-annex is installed using the prebuilt binaries + from git-annex upstream, not from eg Debian.) + * assistant: Detect when the git-annex binary is modified or replaced, + and either prompt the user to restart the program, or automatically + restart it. + * annex.autoupgrade configures both the above upgrade behaviors. + * Added support for quvi 0.9. Slightly suboptimal due to limitations in its + interface compared with the old version. + * Bug fix: annex.version did not get set on automatic upgrade to v5 direct + mode repo, so the upgrade was performed repeatedly, slowing commands down. + * webapp: Fix bug that broke switching between local repositories + that use the new guarded direct mode. + * Android: Fix stripping of the git-annex binary. + * Android: Make terminal app show git-annex version number. + * Android: Re-enable XMPP support. + * reinject: Allow to be used in direct mode. + * Futher improvements to git repo repair. Has now been tested in tens + of thousands of intentionally damaged repos, and successfully + repaired them all. + * Allow use of --unused in bare repository. + + -- Joey Hess Wed, 27 Nov 2013 18:41:44 -0400 + git-annex (5.20131120) unstable; urgency=low * Fix Debian package to not try to run test suite, since haskell-tasty diff --git a/Command/ImportFeed.hs b/Command/ImportFeed.hs --- a/Command/ImportFeed.hs +++ b/Command/ImportFeed.hs @@ -106,7 +106,7 @@ liftIO $ withTmpFile "feed" $ \f h -> do fileEncoding h ifM (Url.download url [] [] f ua) - ( liftIO $ parseFeedString <$> hGetContentsStrict h + ( parseFeedString <$> hGetContentsStrict h , return Nothing ) diff --git a/Command/Reinject.hs b/Command/Reinject.hs --- a/Command/Reinject.hs +++ b/Command/Reinject.hs @@ -14,7 +14,7 @@ import qualified Command.Fsck def :: [Command] -def = [notDirect $ command "reinject" (paramPair "SRC" "DEST") seek +def = [command "reinject" (paramPair "SRC" "DEST") seek SectionUtility "sets content of annexed file"] seek :: [CommandSeek] diff --git a/Command/Upgrade.hs b/Command/Upgrade.hs --- a/Command/Upgrade.hs +++ b/Command/Upgrade.hs @@ -25,8 +25,4 @@ start = do showStart "upgrade" "." r <- upgrade False - ifM isDirect - ( setVersion directModeVersion - , setVersion defaultVersion - ) next $ next $ return r diff --git a/Git/Config.hs b/Git/Config.hs --- a/Git/Config.hs +++ b/Git/Config.hs @@ -110,8 +110,13 @@ -} updateLocation :: Repo -> IO Repo updateLocation r@(Repo { location = LocalUnknown d }) - | isBare r = updateLocation' r $ Local d Nothing - | otherwise = updateLocation' r $ Local (d ".git") (Just d) + | isBare r = ifM (doesDirectoryExist dotgit) + ( updateLocation' r $ Local dotgit Nothing + , updateLocation' r $ Local d Nothing + ) + | otherwise = updateLocation' r $ Local dotgit (Just d) + where + dotgit = (d ".git") updateLocation r@(Repo { location = l@(Local {}) }) = updateLocation' r l updateLocation r = return r diff --git a/Git/Fsck.hs b/Git/Fsck.hs --- a/Git/Fsck.hs +++ b/Git/Fsck.hs @@ -17,7 +17,6 @@ import Git import Git.Command import Git.Sha -import Git.CatFile import Utility.Batch import qualified Data.Set as S @@ -40,7 +39,7 @@ findBroken :: Bool -> Repo -> IO FsckResults findBroken batchmode r = do (output, fsckok) <- processTranscript command' (toCommand params') Nothing - let objs = parseFsckOutput output + let objs = findShas output badobjs <- findMissing objs r if S.null badobjs && not fsckok then return Nothing @@ -57,30 +56,23 @@ {- Finds objects that are missing from the git repsitory, or are corrupt. - - - Note that catting a corrupt object will cause cat-file to crash; - - this is detected and it's restarted. + - This does not use git cat-file --batch, because catting a corrupt + - object can cause it to crash, or to report incorrect size information.a -} findMissing :: [Sha] -> Repo -> IO MissingObjects -findMissing objs r = go objs [] =<< start +findMissing objs r = S.fromList <$> filterM (not <$$> present) objs where - start = catFileStart' False r - go [] c h = do - catFileStop h - return $ S.fromList c - go (o:os) c h = do - v <- tryIO $ isNothing <$> catObjectDetails h o - case v of - Left _ -> do - void $ tryIO $ catFileStop h - go os (o:c) =<< start - Right True -> go os (o:c) h - Right False -> go os c h + present o = either (const False) (const True) <$> tryIO (dump o) + dump o = runQuiet + [ Param "show" + , Param (show o) + ] r -parseFsckOutput :: String -> [Sha] -parseFsckOutput = catMaybes . map extractSha . concat . map words . lines +findShas :: String -> [Sha] +findShas = catMaybes . map extractSha . concat . map words . lines fsckParams :: Repo -> [CommandParam] -fsckParams = gitCommandLine +fsckParams = gitCommandLine $ [ Param "fsck" , Param "--no-dangling" , Param "--no-reflogs" diff --git a/Git/Objects.hs b/Git/Objects.hs --- a/Git/Objects.hs +++ b/Git/Objects.hs @@ -9,6 +9,7 @@ import Common import Git +import Git.Sha objectsDir :: Repo -> FilePath objectsDir r = localGitDir r "objects" @@ -16,12 +17,17 @@ packDir :: Repo -> FilePath packDir r = objectsDir r "pack" +packIdxFile :: FilePath -> FilePath +packIdxFile = flip replaceExtension "idx" + listPackFiles :: Repo -> IO [FilePath] listPackFiles r = filter (".pack" `isSuffixOf`) <$> catchDefaultIO [] (dirContents $ packDir r) -packIdxFile :: FilePath -> FilePath -packIdxFile = flip replaceExtension "idx" +listLooseObjectShas :: Repo -> IO [Sha] +listLooseObjectShas r = catchDefaultIO [] $ + mapMaybe (extractSha . concat . reverse . take 2 . reverse . splitDirectories) + <$> dirContentsRecursiveSkipping (== "pack") (objectsDir r) looseObjectFile :: Repo -> Sha -> FilePath looseObjectFile r sha = objectsDir r prefix rest diff --git a/Git/Repair.hs b/Git/Repair.hs --- a/Git/Repair.hs +++ b/Git/Repair.hs @@ -36,73 +36,38 @@ import qualified Git.Branch as Branch import Utility.Tmp import Utility.Rsync +import Utility.FileMode import qualified Data.Set as S import qualified Data.ByteString.Lazy as L import Data.Tuple.Utils -{- Given a set of bad objects found by git fsck, removes all - - corrupt objects, and returns a list of missing objects, - - which need to be found elsewhere to finish recovery. - - - - Since git fsck may crash on corrupt objects, and so not - - report the full set of corrupt or missing objects, - - this removes corrupt objects, and re-runs fsck, until it - - stabilizes. - - - - To remove corrupt objects, unpack all packs, and remove the packs - - (to handle corrupt packs), and remove loose object files. +{- Given a set of bad objects found by git fsck, which may not + - be complete, finds and removes all corrupt objects, and + - returns a list of missing objects, which need to be + - found elsewhere to finish recovery. -} -cleanCorruptObjects :: FsckResults -> Repo -> IO MissingObjects -cleanCorruptObjects mmissing r = check mmissing - where - check Nothing = do - putStrLn "git fsck found a problem but no specific broken objects. Perhaps a corrupt pack file?" - ifM (explodePacks r) - ( retry S.empty - , return S.empty - ) - check (Just bad) - | S.null bad = return S.empty - | otherwise = do - putStrLn $ unwords - [ "git fsck found" - , show (S.size bad) - , "broken objects." - ] - exploded <- explodePacks r - removed <- removeLoose r bad - if exploded || removed - then retry bad - else return bad - retry oldbad = do - putStrLn "Re-running git fsck to see if it finds more problems." - v <- findBroken False r - case v of - Nothing -> do - hPutStrLn stderr $ unwords - [ "git fsck found a problem, which was not corrected after removing" - , show (S.size oldbad) - , "corrupt objects." - ] - return S.empty - Just newbad -> do - removed <- removeLoose r newbad - let s = S.union oldbad newbad - if not removed || s == oldbad - then return s - else retry s +cleanCorruptObjects :: FsckResults -> Repo -> IO (Maybe MissingObjects) +cleanCorruptObjects fsckresults r = do + void $ explodePacks r + objs <- listLooseObjectShas r + bad <- findMissing objs r + void $ removeLoose r $ S.union bad (fromMaybe S.empty fsckresults) + -- Rather than returning the loose objects that were removed, re-run + -- fsck. Other missing objects may have been in the packs, + -- and this way fsck will find them. + findBroken False r removeLoose :: Repo -> MissingObjects -> IO Bool removeLoose r s = do - let fs = map (looseObjectFile r) (S.toList s) - count <- length <$> filterM doesFileExist fs - if (count > 0) + fs <- filterM doesFileExist (map (looseObjectFile r) (S.toList s)) + let count = length fs + if count > 0 then do putStrLn $ unwords - [ "removing" + [ "Removing" , show count - , "corrupt loose objects" + , "corrupt loose objects." ] mapM_ nukeFile fs return True @@ -118,57 +83,62 @@ mapM_ go packs return True where - go packfile = do + go packfile = withTmpFileIn (localGitDir r) "pack" $ \tmp _ -> do + moveFile packfile tmp + nukeFile $ packIdxFile packfile + allowRead tmp -- May fail, if pack file is corrupt. void $ tryIO $ - pipeWrite [Param "unpack-objects"] r $ \h -> - L.hPut h =<< L.readFile packfile - nukeFile packfile - nukeFile $ packIdxFile packfile + pipeWrite [Param "unpack-objects", Param "-r"] r $ \h -> + L.hPut h =<< L.readFile tmp {- Try to retrieve a set of missing objects, from the remotes of a - repository. Returns any that could not be retreived. - - + - - If another clone of the repository exists locally, which might not be a - remote of the repo being repaired, its path can be passed as a reference - repository. + + - Can also be run with Nothing, if it's not known which objects are + - missing, just that some are. (Ie, fsck failed badly.) -} -retrieveMissingObjects :: MissingObjects -> Maybe FilePath -> Repo -> IO MissingObjects +retrieveMissingObjects :: Maybe MissingObjects -> Maybe FilePath -> Repo -> IO (Maybe MissingObjects) retrieveMissingObjects missing referencerepo r - | S.null missing = return missing + | missing == Just S.empty = return $ Just S.empty | otherwise = withTmpDir "tmprepo" $ \tmpdir -> do unlessM (boolSystem "git" [Params "init", File tmpdir]) $ error $ "failed to create temp repository in " ++ tmpdir tmpr <- Config.read =<< Construct.fromAbsPath tmpdir stillmissing <- pullremotes tmpr (remotes r) fetchrefstags missing - if S.null stillmissing - then return stillmissing + if stillmissing == Just S.empty + then return $ Just S.empty else pullremotes tmpr (remotes r) fetchallrefs stillmissing where pullremotes tmpr [] fetchrefs stillmissing = case referencerepo of Nothing -> return stillmissing Just p -> ifM (fetchfrom p fetchrefs tmpr) ( do + void $ explodePacks tmpr void $ copyObjects tmpr r - findMissing (S.toList stillmissing) r + case stillmissing of + Nothing -> return $ Just S.empty + Just s -> Just <$> findMissing (S.toList s) r , return stillmissing ) - pullremotes tmpr (rmt:rmts) fetchrefs s - | S.null s = return s + pullremotes tmpr (rmt:rmts) fetchrefs ms + | ms == Just S.empty = return $ Just S.empty | otherwise = do - putStrLn $ "Trying to recover missing objects from remote " ++ repoDescribe rmt + putStrLn $ "Trying to recover missing objects from remote " ++ repoDescribe rmt ++ "." ifM (fetchfrom (repoLocation rmt) fetchrefs tmpr) ( do + void $ explodePacks tmpr void $ copyObjects tmpr r - stillmissing <- findMissing (S.toList s) r - pullremotes tmpr rmts fetchrefs stillmissing - , do - putStrLn $ unwords - [ "failed to fetch from remote" - , repoDescribe rmt - , "(will continue without it, but making this remote available may improve recovery)" - ] - pullremotes tmpr rmts fetchrefs s + case ms of + Nothing -> pullremotes tmpr rmts fetchrefs ms + Just s -> do + stillmissing <- findMissing (S.toList s) r + pullremotes tmpr rmts fetchrefs (Just stillmissing) + , pullremotes tmpr rmts fetchrefs ms ) fetchfrom fetchurl ps = runBool $ [ Param "fetch" @@ -182,7 +152,7 @@ fetchallrefs = [ Param "+*:*" ] {- Copies all objects from the src repository to the dest repository. - - This is done using rsync, so it copies all missing object, and all + - This is done using rsync, so it copies all missing objects, and all - objects they rely on. -} copyObjects :: Repo -> Repo -> IO Bool copyObjects srcr destr = rsync @@ -241,51 +211,44 @@ {- Gets all refs, including ones that are corrupt. - git show-ref does not output refs to commits that are directly - corrupted, so it is not used. + - + - Relies on packed refs being exploded before it's called. -} getAllRefs :: Repo -> IO [Ref] -getAllRefs r = do - packedrs <- mapMaybe parsePacked . lines - <$> catchDefaultIO "" (readFile $ packedRefsFile r) - loosers <- map toref <$> dirContentsRecursive refdir - return $ packedrs ++ loosers +getAllRefs r = map toref <$> dirContentsRecursive refdir where refdir = localGitDir r "refs" toref = Ref . relPathDirToFile (localGitDir r) +explodePackedRefsFile :: Repo -> IO () +explodePackedRefsFile r = do + let f = packedRefsFile r + whenM (doesFileExist f) $ do + rs <- mapMaybe parsePacked . lines + <$> catchDefaultIO "" (safeReadFile f) + forM_ rs makeref + nukeFile f + where + makeref (sha, ref) = do + let dest = localGitDir r ++ show ref + createDirectoryIfMissing True (parentDir dest) + unlessM (doesFileExist dest) $ + writeFile dest (show sha) + packedRefsFile :: Repo -> FilePath packedRefsFile r = localGitDir r "packed-refs" -parsePacked :: String -> Maybe Ref +parsePacked :: String -> Maybe (Sha, Ref) parsePacked l = case words l of (sha:ref:[]) - | isJust (extractSha sha) -> Just $ Ref ref + | isJust (extractSha sha) && Ref.legal True ref -> + Just (Ref sha, Ref ref) _ -> Nothing {- git-branch -d cannot be used to remove a branch that is directly - - pointing to a corrupt commit. However, it's tried first. -} + - pointing to a corrupt commit. -} nukeBranchRef :: Branch -> Repo -> IO () -nukeBranchRef b r = void $ usegit <||> byhand - where - usegit = runBool - [ Param "branch" - , Params "-r -d" - , Param $ show $ Ref.base b - ] r - byhand = do - nukeFile $ localGitDir r show b - whenM (doesFileExist packedrefs) $ - withTmpFile "packed-refs" $ \tmp h -> do - ls <- lines <$> readFile packedrefs - hPutStr h $ unlines $ - filter (not . skiprefline) ls - hClose h - renameFile tmp packedrefs - return True - skiprefline l = case parsePacked l of - Just packedref - | packedref == b -> True - _ -> False - packedrefs = packedRefsFile r +nukeBranchRef b r = nukeFile $ localGitDir r show b {- Finds the most recent commit to a branch that does not need any - of the missing objects. If the input branch is good as-is, returns it. @@ -444,51 +407,88 @@ | numitems > 10 = take 10 items ++ ["(and " ++ show (numitems - 10) ++ " more)"] | otherwise = items +{- Fix problems that would prevent repair from working at all + - + - A missing or corrupt .git/HEAD makes git not treat the repository as a + - git repo. If there is a git repo in a parent directory, it may move up + - the tree and use that one instead. So, cannot use `git show-ref HEAD` to + - test it. + - + - Explode the packed refs file, to simplify dealing with refs, and because + - fsck can complain about bad refs in it. + -} +preRepair :: Repo -> IO () +preRepair g = do + unlessM (validhead <$> catchDefaultIO "" (safeReadFile headfile)) $ do + nukeFile headfile + writeFile headfile "ref: refs/heads/master" + explodePackedRefsFile g + where + headfile = localGitDir g "HEAD" + validhead s = "ref: refs/" `isPrefixOf` s || isJust (extractSha s) + {- Put it all together. -} runRepair :: Bool -> Repo -> IO (Bool, MissingObjects, [Branch]) runRepair forced g = do + preRepair g putStrLn "Running git fsck ..." fsckresult <- findBroken False g if foundBroken fsckresult - then runRepairOf fsckresult forced Nothing g + then runRepair' fsckresult forced Nothing g else do putStrLn "No problems found." return (True, S.empty, []) -successfulRepair :: (Bool, MissingObjects, [Branch]) -> Bool -successfulRepair = fst3 - runRepairOf :: FsckResults -> Bool -> Maybe FilePath -> Repo -> IO (Bool, MissingObjects, [Branch]) runRepairOf fsckresult forced referencerepo g = do + preRepair g + runRepair' fsckresult forced referencerepo g + +runRepair' :: FsckResults -> Bool -> Maybe FilePath -> Repo -> IO (Bool, MissingObjects, [Branch]) +runRepair' fsckresult forced referencerepo g = do missing <- cleanCorruptObjects fsckresult g stillmissing <- retrieveMissingObjects missing referencerepo g - if S.null stillmissing - then if repoIsLocalBare g - then successfulfinish stillmissing [] - else ifM (checkIndex stillmissing g) - ( successfulfinish stillmissing [] - , do - putStrLn "No missing objects found, but the index file is corrupt!" - if forced - then corruptedindex - else needforce stillmissing - ) - else do - putStrLn $ unwords - [ show (S.size stillmissing) - , "missing objects could not be recovered!" - ] - if forced - then continuerepairs stillmissing - else unsuccessfulfinish stillmissing + case stillmissing of + Just s + | S.null s -> if repoIsLocalBare g + then successfulfinish S.empty [] + else ifM (checkIndex S.empty g) + ( successfulfinish s [] + , do + putStrLn "No missing objects found, but the index file is corrupt!" + if forced + then corruptedindex + else needforce S.empty + ) + | otherwise -> if forced + then ifM (checkIndex s g) + ( continuerepairs s + , corruptedindex + ) + else do + putStrLn $ unwords + [ show (S.size s) + , "missing objects could not be recovered!" + ] + unsuccessfulfinish s + Nothing + | forced -> ifM (pure (repoIsLocalBare g) <||> checkIndex S.empty g) + ( do + missing' <- cleanCorruptObjects Nothing g + case missing' of + Nothing -> return (False, S.empty, []) + Just stillmissing' -> continuerepairs stillmissing' + , corruptedindex + ) + | otherwise -> unsuccessfulfinish S.empty where continuerepairs stillmissing = do (remotebranches, goodcommits) <- removeTrackingBranches stillmissing emptyGoodCommits g unless (null remotebranches) $ putStrLn $ unwords - [ "removed" + [ "Removed" , show (length remotebranches) - , "remote tracking branches that referred to missing objects" + , "remote tracking branches that referred to missing objects." ] (resetbranches, deletedbranches, _) <- resetLocalBranches stillmissing goodcommits g displayList (map show resetbranches) @@ -528,8 +528,7 @@ successfulfinish stillmissing modifiedbranches = do mapM_ putStrLn [ "Successfully recovered repository!" - , "You should run \"git fsck\" to make sure, but it looks like" - , "everything was recovered ok." + , "You should run \"git fsck\" to make sure, but it looks like everything was recovered ok." ] return (True, stillmissing, modifiedbranches) unsuccessfulfinish stillmissing = do @@ -542,3 +541,11 @@ needforce stillmissing = do putStrLn "To force a recovery to a usable state, retry with the --force parameter." return (False, stillmissing, []) + +successfulRepair :: (Bool, MissingObjects, [Branch]) -> Bool +successfulRepair = fst3 + +safeReadFile :: FilePath -> IO String +safeReadFile f = do + allowRead f + readFileStrictAnyEncoding f diff --git a/Makefile b/Makefile --- a/Makefile +++ b/Makefile @@ -77,7 +77,7 @@ rm -rf tmp dist git-annex $(mans) configure *.tix .hpc \ doc/.ikiwiki html dist tags Build/SysConfig.hs build-stamp \ Setup Build/InstallDesktopFile Build/EvilSplicer \ - Build/Standalone Build/OSXMkLibs \ + Build/Standalone Build/OSXMkLibs Build/DistributionUpdate \ git-union-merge find . -name \*.o -exec rm {} \; find . -name \*.hi -exec rm {} \; @@ -133,6 +133,8 @@ sort "$(LINUXSTANDALONE_DEST)/libdirs.tmp" | uniq > "$(LINUXSTANDALONE_DEST)/libdirs" rm -f "$(LINUXSTANDALONE_DEST)/libdirs.tmp" + cd tmp/git-annex.linux && find . -type f > git-annex.MANIFEST + cd tmp/git-annex.linux && find . -type l >> git-annex.MANIFEST cd tmp && tar czf git-annex-standalone-$(shell dpkg --print-architecture).tar.gz git-annex.linux OSXAPP_DEST=tmp/build-dmg/git-annex.app @@ -157,19 +159,18 @@ install -d "$(OSXAPP_BASE)/templates" ./Build/OSXMkLibs $(OSXAPP_BASE) + cd $(OSXAPP_DEST) && find . -type f > Contents/MacOS/git-annex.MANIFEST + cd $(OSXAPP_DEST) && find . -type l >> Contents/MacOS/git-annex.MANIFEST rm -f tmp/git-annex.dmg hdiutil create -format UDBZ -srcfolder tmp/build-dmg \ -volname git-annex -o tmp/git-annex.dmg - # temporarily still create compressed image too - rm -f tmp/git-annex.dmg.bz2 - bzip2 --fast < tmp/git-annex.dmg > tmp/git-annex.dmg.bz2 -ANDROID_FLAGS?=-f-XMPP +ANDROID_FLAGS?= # Cross compile for Android. # Uses https://github.com/neurocyte/ghc-android android: Build/EvilSplicer echo "Running native build, to get TH splices.." - if [ ! -e dist/setup/setup ]; then $(CABAL) configure -f-Production -O0 $(ANDROID_FLAGS); fi + if [ ! -e dist/setup/setup ]; then $(CABAL) configure -f-Production -O0 $(ANDROID_FLAGS) -fAndroidSplice; fi mkdir -p tmp if ! $(CABAL) build --ghc-options=-ddump-splices 2> tmp/dump-splices; then tail tmp/dump-splices >&2; exit 1; fi echo "Setting up Android build tree.." @@ -188,7 +189,7 @@ sed -i 's/Build-type: Custom/Build-type: Simple/' tmp/androidtree/git-annex.cabal # Build just once, but link twice, for 2 different versions of Android. mkdir -p tmp/androidtree/dist/build/git-annex/4.0 tmp/androidtree/dist/build/git-annex/4.3 - if [ ! -e tmp/androidtree/dist/setup/setup ]; then \ + if [ ! -e tmp/androidtree/dist/setup-config ]; then \ cd tmp/androidtree && $$HOME/.ghc/$(shell cat standalone/android/abiversion)/arm-linux-androideabi/bin/cabal configure -fAndroid $(ANDROID_FLAGS); \ fi cd tmp/androidtree && $$HOME/.ghc/$(shell cat standalone/android/abiversion)/arm-linux-androideabi/bin/cabal build \ @@ -219,5 +220,9 @@ hdevtools: hdevtools --stop-server || true hdevtools check git-annex.hs -g -cpp -g -i -g -idist/build/git-annex/git-annex-tmp -g -i. -g -idist/build/autogen -g -Idist/build/autogen -g -Idist/build/git-annex/git-annex-tmp -g -IUtility -g -DWITH_TESTSUITE -g -DWITH_S3 -g -DWITH_ASSISTANT -g -DWITH_INOTIFY -g -DWITH_DBUS -g -DWITH_PAIRING -g -DWITH_XMPP -g -optP-include -g -optPdist/build/autogen/cabal_macros.h -g -odir -g dist/build/git-annex/git-annex-tmp -g -hidir -g dist/build/git-annex/git-annex-tmp -g -stubdir -g dist/build/git-annex/git-annex-tmp -g -threaded -g -Wall -g -XHaskell98 -g -XPackageImports + +distributionupdate: + ghc --make Build/DistributionUpdate + ./Build/DistributionUpdate .PHONY: git-annex git-union-merge git-recover-repository tags build-stamp diff --git a/Seek.hs b/Seek.hs --- a/Seek.hs +++ b/Seek.hs @@ -141,13 +141,15 @@ withKeyOptions :: (Key -> CommandStart) -> CommandSeek -> CommandSeek withKeyOptions keyop fallbackop params = do bare <- fromRepo Git.repoIsLocalBare - allkeys <- Annex.getFlag "all" <||> pure bare + allkeys <- Annex.getFlag "all" unused <- Annex.getFlag "unused" auto <- Annex.getState Annex.auto - case (allkeys , unused, auto ) of + case (allkeys || bare , unused, auto ) of (True , False , False) -> go loggedKeys (False , True , False) -> go unusedKeys - (True , True , _ ) -> error "Cannot use --all with --unused." + (True , True , _ ) + | bare && not allkeys -> go unusedKeys + | otherwise -> error "Cannot use --all with --unused." (False , False , _ ) -> fallbackop params (_ , _ , True ) | bare -> error "Cannot use --auto in a bare repository." diff --git a/Test.hs b/Test.hs --- a/Test.hs +++ b/Test.hs @@ -79,8 +79,8 @@ directenv <- prepare True let tests = testGroup "Tests" [ localOption (QuickCheckTests 1000) properties - , unitTests indirectenv "(indirect)" , unitTests directenv "(direct)" + , unitTests indirectenv "(indirect)" ] #else -- Windows is only going to use direct mode, so don't test twice. diff --git a/Types/Distribution.hs b/Types/Distribution.hs new file mode 100644 --- /dev/null +++ b/Types/Distribution.hs @@ -0,0 +1,38 @@ +{- Data type for a distribution of git-annex + - + - Copyright 2013 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Types.Distribution where + +import Types.Key +import Data.Time.Clock +import Git.Config (isTrue, boolConfig) + +data GitAnnexDistribution = GitAnnexDistribution + { distributionUrl :: String + , distributionKey :: Key + , distributionVersion :: GitAnnexVersion + , distributionReleasedate :: UTCTime + , distributionUrgentUpgrade :: Maybe GitAnnexVersion + } + deriving (Read, Show, Eq) + +type GitAnnexVersion = String + +data AutoUpgrade = AskUpgrade | AutoUpgrade | NoAutoUpgrade + deriving (Eq) + +toAutoUpgrade :: (Maybe String) -> AutoUpgrade +toAutoUpgrade Nothing = AskUpgrade +toAutoUpgrade (Just s) + | s == "ask" = AskUpgrade + | isTrue s == Just True = AutoUpgrade + | otherwise = NoAutoUpgrade + +fromAutoUpgrade :: AutoUpgrade -> String +fromAutoUpgrade AskUpgrade = "ask" +fromAutoUpgrade AutoUpgrade = boolConfig True +fromAutoUpgrade NoAutoUpgrade = boolConfig False diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs --- a/Types/GitConfig.hs +++ b/Types/GitConfig.hs @@ -17,6 +17,7 @@ import qualified Git.Config import Utility.DataUnits import Config.Cost +import Types.Distribution {- Main git-annex settings. Each setting corresponds to a git-config key - such as annex.foo -} @@ -42,6 +43,7 @@ , annexCrippledFileSystem :: Bool , annexLargeFiles :: Maybe String , annexFsckNudge :: Bool + , annexAutoUpgrade :: AutoUpgrade , coreSymlinks :: Bool , gcryptId :: Maybe String } @@ -70,6 +72,7 @@ , annexCrippledFileSystem = getbool (annex "crippledfilesystem") False , annexLargeFiles = getmaybe (annex "largefiles") , annexFsckNudge = getbool (annex "fscknudge") True + , annexAutoUpgrade = toAutoUpgrade $ getmaybe (annex "autoupgrade") , coreSymlinks = getbool "core.symlinks" True , gcryptId = getmaybe "core.gcrypt-id" } diff --git a/Upgrade.hs b/Upgrade.hs --- a/Upgrade.hs +++ b/Upgrade.hs @@ -1,6 +1,6 @@ {- git-annex upgrade support - - - Copyright 2010 Joey Hess + - Copyright 2010, 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -11,6 +11,7 @@ import Common.Annex import Annex.Version +import Config #ifndef mingw32_HOST_OS import qualified Upgrade.V0 import qualified Upgrade.V1 @@ -36,7 +37,14 @@ ok = return Nothing upgrade :: Bool -> Annex Bool -upgrade automatic = go =<< getVersion +upgrade automatic = do + upgraded <- go =<< getVersion + when upgraded $ + ifM isDirect + ( setVersion directModeVersion + , setVersion defaultVersion + ) + return upgraded where #ifndef mingw32_HOST_OS go (Just "0") = Upgrade.V0.upgrade diff --git a/Utility/FileMode.hs b/Utility/FileMode.hs --- a/Utility/FileMode.hs +++ b/Utility/FileMode.hs @@ -64,6 +64,10 @@ allowWrite :: FilePath -> IO () allowWrite f = modifyFileMode f $ addModes [ownerWriteMode] +{- Turns a file's owner read bit back on. -} +allowRead :: FilePath -> IO () +allowRead f = modifyFileMode f $ addModes [ownerReadMode] + {- Allows owner and group to read and write to a file. -} groupSharedModes :: [FileMode] groupSharedModes = diff --git a/Utility/Misc.hs b/Utility/Misc.hs --- a/Utility/Misc.hs +++ b/Utility/Misc.hs @@ -21,6 +21,9 @@ import Utility.Exception #endif +import Utility.FileSystemEncoding +import Utility.Monad + {- A version of hgetContents that is not lazy. Ensures file is - all read before it gets closed. -} hGetContentsStrict :: Handle -> IO String @@ -29,6 +32,13 @@ {- A version of readFile that is not lazy. -} readFileStrict :: FilePath -> IO String readFileStrict = readFile >=> \s -> length s `seq` return s + +{- Reads a file strictly, and using the FileSystemEncofing, so it will + - never crash on a badly encoded file. -} +readFileStrictAnyEncoding :: FilePath -> IO String +readFileStrictAnyEncoding f = withFile f ReadMode $ \h -> do + fileEncoding h + hClose h `after` hGetContentsStrict h {- Like break, but the item matching the condition is not included - in the second result list. diff --git a/Utility/Quvi.hs b/Utility/Quvi.hs --- a/Utility/Quvi.hs +++ b/Utility/Quvi.hs @@ -11,9 +11,13 @@ import Common import Utility.Url +import Build.SysConfig (newquvi) import Data.Aeson import Data.ByteString.Lazy.UTF8 (fromString) +import qualified Data.Map as M +import Network.URI (uriAuthority, uriRegName) +import Data.Char data Page = Page { pageTitle :: String @@ -25,6 +29,7 @@ , linkUrl :: URLString } deriving (Show) +{- JSON instances for quvi 0.4. -} instance FromJSON Page where parseJSON (Object v) = Page <$> v .: "page_title" @@ -37,6 +42,20 @@ <*> v .: "url" parseJSON _ = mzero +{- "enum" format used by quvi 0.9 -} +parseEnum :: String -> Maybe Page +parseEnum s = Page + <$> get "QUVI_MEDIA_PROPERTY_TITLE" + <*> ((:[]) <$> + ( Link + <$> get "QUVI_MEDIA_STREAM_PROPERTY_CONTAINER" + <*> get "QUVI_MEDIA_STREAM_PROPERTY_URL" + ) + ) + where + get = flip M.lookup m + m = M.fromList $ map (separate (== '=')) $ lines s + type Query a = [CommandParam] -> URLString -> IO a {- Throws an error when quvi is not installed. -} @@ -54,8 +73,11 @@ query ps url = flip catchNonAsync (const $ return Nothing) (query' ps url) query' :: Query (Maybe Page) -query' ps url = decode . fromString - <$> readProcess "quvi" (toCommand $ ps ++ [Param url]) +query' ps url + | newquvi = parseEnum + <$> readProcess "quvi" (toCommand $ [Param "dump", Param "-p", Param "enum"] ++ ps ++ [Param url]) + | otherwise = decode . fromString + <$> readProcess "quvi" (toCommand $ ps ++ [Param url]) queryLinks :: Query [URLString] queryLinks ps url = maybe [] (map linkUrl . pageLinks) <$> query ps url @@ -65,17 +87,47 @@ check :: Query Bool check ps url = maybe False (not . null . pageLinks) <$> query ps url -{- Checks if an url is supported by quvi, without hitting it, or outputting +{- Checks if an url is supported by quvi, as quickly as possible + - (without hitting it if possible), and without outputting - anything. Also returns False if quvi is not installed. -} supported :: URLString -> IO Bool -supported url = boolSystem "quvi" [Params "-v mute --support", Param url] +supported url + {- Use quvi-info to see if the url's domain is supported. + - If so, have to do a online verification of the url. -} + | newquvi = (firstlevel <&&> secondlevel) + `catchNonAsync` (\_ -> return False) + | otherwise = boolSystem "quvi" [Params "--verbosity mute --support", Param url] + where + firstlevel = case uriAuthority =<< parseURIRelaxed url of + Nothing -> return False + Just auth -> do + let domain = map toLower $ uriRegName auth + let basedomain = intercalate "." $ reverse $ take 2 $ reverse $ split "." domain + any (\h -> domain `isSuffixOf` h || basedomain `isSuffixOf` h) + . map (map toLower) <$> listdomains + secondlevel = snd <$> processTranscript "quvi" + (toCommand [Param "dump", Param "-o", Param url]) Nothing -quiet :: CommandParam -quiet = Params "-v quiet" +listdomains :: IO [String] +listdomains + | newquvi = concatMap (split ",") + . concatMap (drop 1 . words) + . filter ("domains: " `isPrefixOf`) . lines + <$> readProcess "quvi" + (toCommand [Param "info", Param "-p", Param "domains"]) + | otherwise = return [] -noredir :: CommandParam -noredir = Params "-e -resolve" +{- Disables progress, but not information output. -} +quiet :: CommandParam +quiet + -- Cannot use quiet as it now disables informational output. + -- No way to disable progress. + | newquvi = Params "--verbosity verbose" + | otherwise = Params "--verbosity quiet" {- Only return http results, not streaming protocols. -} httponly :: CommandParam -httponly = Params "-c http" +httponly + -- No way to do it with 0.9? + | newquvi = Params "" + | otherwise = Params "-c http" diff --git a/Utility/Tmp.hs b/Utility/Tmp.hs --- a/Utility/Tmp.hs +++ b/Utility/Tmp.hs @@ -62,7 +62,7 @@ withTmpDirIn tmpdir template = bracket create remove where remove d = whenM (doesDirectoryExist d) $ - return () -- removeDirectoryRecursive d + removeDirectoryRecursive d create = do createDirectoryIfMissing True tmpdir makenewdir (tmpdir template) (0 :: Int) diff --git a/Utility/Url.hs b/Utility/Url.hs --- a/Utility/Url.hs +++ b/Utility/Url.hs @@ -14,7 +14,8 @@ checkBoth, exists, download, - downloadQuiet + downloadQuiet, + parseURIRelaxed ) where import Common diff --git a/debian/changelog b/debian/changelog --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,30 @@ +git-annex (5.20131127) unstable; urgency=low + + * webapp: Detect when upgrades are available, and upgrade if the user + desires. + (Only when git-annex is installed using the prebuilt binaries + from git-annex upstream, not from eg Debian.) + * assistant: Detect when the git-annex binary is modified or replaced, + and either prompt the user to restart the program, or automatically + restart it. + * annex.autoupgrade configures both the above upgrade behaviors. + * Added support for quvi 0.9. Slightly suboptimal due to limitations in its + interface compared with the old version. + * Bug fix: annex.version did not get set on automatic upgrade to v5 direct + mode repo, so the upgrade was performed repeatedly, slowing commands down. + * webapp: Fix bug that broke switching between local repositories + that use the new guarded direct mode. + * Android: Fix stripping of the git-annex binary. + * Android: Make terminal app show git-annex version number. + * Android: Re-enable XMPP support. + * reinject: Allow to be used in direct mode. + * Futher improvements to git repo repair. Has now been tested in tens + of thousands of intentionally damaged repos, and successfully + repaired them all. + * Allow use of --unused in bare repository. + + -- Joey Hess Wed, 27 Nov 2013 18:41:44 -0400 + git-annex (5.20131120) unstable; urgency=low * Fix Debian package to not try to run test suite, since haskell-tasty diff --git a/doc/assistant/downloadupgrade.png b/doc/assistant/downloadupgrade.png new file mode 100644 Binary files /dev/null and b/doc/assistant/downloadupgrade.png differ diff --git a/doc/assistant/upgradecomplete.png b/doc/assistant/upgradecomplete.png new file mode 100644 Binary files /dev/null and b/doc/assistant/upgradecomplete.png differ diff --git a/doc/bugs/Assistant_has_created_155_semitrusted_repositories.mdwn b/doc/bugs/Assistant_has_created_155_semitrusted_repositories.mdwn new file mode 100644 --- /dev/null +++ b/doc/bugs/Assistant_has_created_155_semitrusted_repositories.mdwn @@ -0,0 +1,191 @@ +### Please describe the problem. +git annex status reports 160 semitrusted repositories. Four of them are the ones I created (only via webapp, I think I never edited any git-annex config file). One is 00000000-0000-0000-0000-000000000001 -- web + and although I do not know what it is, it is not something new. The remaining 155 appeared spontaneously after several Gb of data (mostly many small files) were added to an Annex (in an 'archive' directory) operated in direct mode by the assistant. + + + +### What steps will reproduce the problem? +Add several Gb of files was enough to trigger this problem, but I did not try to reproduce it. It happened the day I installed the 4.20131106~bpo70+1 version. + +### What version of git-annex are you using? On what operating system? + +4.20131106~bpo70+1 on debian squeeze (7.2), with git 1.8.4.rc3. + + +### Please provide any additional information below. +May be related or not: at some point the webapp displayed two warning boxes. One of them held a message that I did not wirte down and proposed to "Restart the thread". This apparently worked since the box disappeared. The other warning box indicated "NetWatcherFallback crashed: unknown response from git cat-file" and proposed to restart the thread. Trying to "restart the thread" via the provided button just did not trigger any response of the webapp which seemed dead at that point. + +In spite of the git annex status shown below, the webapp still shows only the expected four repositories. + +Output of git annex status (hostname and xmpp account name were edited away): +[[!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 +repository mode: direct +trusted repositories: +0 +semitrusted repositories: 160 + 00000000-0000-0000-0000-000000000001 -- web + 0ab193eb-0c76-4559-a93c-2e30ed8630a8 -- someMachineIown_datadir (archive) + 1384784127.91222s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384784164.437824s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384784176.944372s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384784179.254498s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384785147.558938s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384785147.717223s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384785159.041203s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384785159.199504s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384785185.79485s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384785187.318128s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384785215.236504s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384785215.389096s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384785313.539843s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384785313.701305s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384785315.596206s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384785344.184461s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384785348.192805s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384785402.70316s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384785406.524044s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384785446.074236s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384873605.313126s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384873697.029999s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384873761.687234s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384873774.608376s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384926279.456728s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384926368.736s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384926454.99433s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384926494.152645s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384926504.438232s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384934790.89717s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384934848.757067s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384934899.087168s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384934908.238587s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384948772.14552s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384948805.441196s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384948813.397132s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384948921.45481s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384948924.855852s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384949073.988946s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384949082.298976s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384949399.608138s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384949581.12213s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384949583.9923s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384949700.22807s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384949765.484768s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384955202.85962s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384955230.953995s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384955402.534938s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384955457.1885s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384955524.603709s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384955611.891061s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384955677.84592s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384955689.293082s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384955894.057476s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384955910.723021s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384955914.732132s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384955968.717875s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384955969.634658s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384956004.284925s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384956029.567195s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384956188.628995s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384956379.844701s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384956381.613833s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384956387.923418s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384956395.418701s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384956408.792928s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384956504.019733s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384956519.578085s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384956524.419783s -- 1 391b0557-dc68-4e40-b6d0-da3033588753 + 1384965891.562742s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384965891.815119s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384965903.355602s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384965905.276128s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384965978.806653s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384965979.393089s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384966097.495566s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384966097.704474s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384966154.97658s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384966156.967406s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384966233.310488s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384966233.522324s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384966241.284523s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384966241.475381s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384966301.688497s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384966303.427685s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384966392.875983s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384966393.38718s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384966404.708568s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384966406.441164s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384966553.557387s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384966555.752786s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384966653.725847s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384966654.23288s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384966695.201885s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384966695.689398s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384966784.556877s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384966786.574886s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384966791.446852s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384966793.218318s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384966884.335685s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384966886.147083s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384967054.857465s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384967055.158871s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384967190.980027s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384967193.176584s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384967328.93796s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384967330.428095s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384967526.127311s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384967526.588491s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384967627.132549s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384967627.685201s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384967686.283694s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384967686.728086s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384967768.270887s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384967768.58402s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384967769.245615s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384967771.122238s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384967813.8197s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384967814.168477s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384967915.243469s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384967917.020051s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384968031.757775s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384968032.190452s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384968035.733635s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384968036.03299s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384968144.555556s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384968144.714535s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384968150.090148s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384968150.820567s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384968304.393177s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384968304.613624s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384968604.499519s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384968604.813256s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384968702.566939s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384968704.427767s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384968725.375289s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384968725.939271s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384968798.402904s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384968798.659754s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384969055.285004s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384969055.715448s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384969159.885115s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384969162.382266s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384969184.633052s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384969185.413769s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384969374.791849s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384969377.497842s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384969475.469111s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384969489.697737s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384969492.087023s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384969492.58214s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384969784.725195s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384969786.49773s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 1384969814.984624s -- 1 0ab193eb-0c76-4559-a93c-2e30ed8630a8 + 1384969815.397676s -- 0 391b0557-dc68-4e40-b6d0-da3033588753 + 391b0557-dc68-4e40-b6d0-da3033588753 -- here (client) + 668ef9d8-68c6-484e-89e5-06634d590a11 -- rsync.net_datadir_annex (transfer) + b0d3c000-0ac9-4a05-aef4-47f826d5c759 -- user.name (client) + + +# End of transcript or log. +"""]] diff --git a/doc/bugs/Finding_an_Unused_file.mdwn b/doc/bugs/Finding_an_Unused_file.mdwn --- a/doc/bugs/Finding_an_Unused_file.mdwn +++ b/doc/bugs/Finding_an_Unused_file.mdwn @@ -146,7 +146,7 @@ """]] > If `git log -S` does not find the key, then it was not used for any -> commit currently in the git repository. Which is certianly possible; +> commit currently in the git repository. Which is certainly possible; > for example `git annex add file; git rm file`. > > This is a dup of [[todo/wishlist: option to print more info with 'unused']]; [[done]] --[[Joey]] diff --git a/doc/bugs/Git_annex_add_fails_on_read-only_files.mdwn b/doc/bugs/Git_annex_add_fails_on_read-only_files.mdwn new file mode 100644 --- /dev/null +++ b/doc/bugs/Git_annex_add_fails_on_read-only_files.mdwn @@ -0,0 +1,37 @@ +### Please describe the problem. + +Git annex cannot add/import files in folders without w or x permission + +Note that (as stated in the comments) this might not be a bug. The problem might somewhere within Git, because Git does not manage file permissions very well. I was just hoping that I could import large directory trees into git-annex with a simple call to "git annex import"; now it seems I have to fix their permissions first. + +### What steps will reproduce the problem? + + $ cd /tmp + $ mkdir -p folder/subfolder + $ echo "some text" > folder/subfolder/some_file.txt + $ chmod 500 folder/subfolder + $ mkdir annex + $ cd annex + $ git init + $ git annex init "Testing git annex" + $ git annex import ../folder + Fails + $ chmod 600 ../folder/subfolder + $ git annex import ../folder + Fails + $ chmod 700 ../folder/subfolder + $ git annex import ../folder + Works. Subfolder now has 755 permissions + +### What version of git-annex are you using? On what operating system? + + git-annex version: 4.20131106 + build flags: Assistant Webapp Pairing Testsuite S3 WebDAV Inotify DBus XMPP 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 glacier hook + local repository version: 3 + default repository version: 3 + supported repository versions: 3 4 + upgrade supported from repository versions: 0 1 2 + + git version 1.8.4.3 diff --git a/doc/bugs/Lost_S3_Remote/comment_1_6e80e6db6671581d471fc9a54181c04c._comment b/doc/bugs/Lost_S3_Remote/comment_1_6e80e6db6671581d471fc9a54181c04c._comment --- a/doc/bugs/Lost_S3_Remote/comment_1_6e80e6db6671581d471fc9a54181c04c._comment +++ b/doc/bugs/Lost_S3_Remote/comment_1_6e80e6db6671581d471fc9a54181c04c._comment @@ -6,5 +6,5 @@ content=""" Despite `status` listing S3 support, your git-annex is actually built with S3stub, probably because it failed to find the necessary S3 module at build time. Rebuild git-annex and watch closely, you'll see \"** building without S3 support\". Look above that for the error and fix it. -It was certianly a bug that it showed S3 as supported when built without it. I've fixed that. +It was certainly a bug that it showed S3 as supported when built without it. I've fixed that. """]] diff --git a/doc/bugs/Too_many_open_files.mdwn b/doc/bugs/Too_many_open_files.mdwn new file mode 100644 --- /dev/null +++ b/doc/bugs/Too_many_open_files.mdwn @@ -0,0 +1,55 @@ +### Please describe the problem. + +The transferrer crashes after a while due to too many open files + +### What steps will reproduce the problem? + +Have a huge annex. Connect two local machines, one with the huge annex, the other one without. Let them copy files… + +### What version of git-annex are you using? On what operating system? + +latest version +git-annex version: 5.20131117-gbd514dc +build flags: Assistant Webapp Pairing Testsuite S3 WebDAV FsEvents XMPP 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 glacier hook + +on Mac OS X 10.9 + +### 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 + +[2013-11-22 10:49:19 CET] Transferrer: Downloaded oktaeder.png +[2013-11-22 10:49:19 CET] Transferrer: Downloaded oktaeder.png +[2013-11-22 10:49:19 CET] Transferrer: Downloaded oktaeder.png +[2013-11-22 10:49:20 CET] Transferrer: Downloaded klett-cover-neu.jpg +[2013-11-22 10:49:20 CET] Transferrer: Downloaded klett-cover-neu.jpg +[2013-11-22 10:49:20 CET] Transferrer: Downloaded kara-worl..ditor.gif +git-annex: runInteractiveProcess: pipe: Too many open files +Committer crashed: lsof: createProcess: resource exhausted (Too many open files) +[2013-11-22 10:49:20 CET] Committer: warning Committer crashed: lsof: createProcess: resource exhausted (Too many open files) +[2013-11-22 10:49:20 CET] Transferrer: Downloaded kara-worl..ditor.gif +[2013-11-22 10:49:20 CET] Transferrer: Downloaded kara-worl..ditor.gif +[2013-11-22 10:49:20 CET] Transferrer: Downloaded image1.png +[2013-11-22 10:49:21 CET] Transferrer: Downloaded image1.png +[2013-11-22 10:49:21 CET] Transferrer: Downloaded image.png +[2013-11-22 10:49:21 CET] Transferrer: Downloaded image.png +[2013-11-22 10:49:21 CET] Transferrer: Downloaded ikoseder.png +[2013-11-22 10:49:21 CET] Transferrer: Downloaded ikoseder.png +[2013-11-22 10:49:22 CET] Transferrer: Downloaded ikoseder.png +[2013-11-22 10:49:22 CET] Transferrer: Downloaded ikosaeder.jpg +git-annex: runInteractiveProcess: pipe: Too many open files +ok +(Recording state in git...) +git-annex: socket: resource exhausted (Too many open files) +[2013-11-22 10:49:22 CET] Transferrer: Downloaded ikosaeder.jpg +Transferrer crashed: getCurrentDirectory: resource exhausted (Too many open files) +[2013-11-22 10:49:22 CET] Transferrer: warning Transferrer crashed: getCurrentDirectory: resource exhausted (Too many open files) +git-annex: runInteractiveProcess: pipe: Too many open files +git-annex: runInteractiveProcess: pipe: Too many open files + +# End of transcript or log. +"""]] diff --git a/doc/bugs/direct_mode_sync_should_avoid_git_commit.mdwn b/doc/bugs/direct_mode_sync_should_avoid_git_commit.mdwn new file mode 100644 --- /dev/null +++ b/doc/bugs/direct_mode_sync_should_avoid_git_commit.mdwn @@ -0,0 +1,5 @@ +Per forum post linking to this bug, git commit can be very slow when run in a filesystem without symlink support, and seems to be reading the content of files just in order to show typechanged messages in the status. + +So, git annex sync should stop using git commit when in direct mode, and instead manually make its own commit. Git.Branch.commit and Git.Branch.update should be able to easily be used for this. + +PS: this page was created elsewhere, and therefore not listed in bugs page diff --git a/doc/bugs/git-annex_does_not_install_on_windows_without_admin_rights.mdwn b/doc/bugs/git-annex_does_not_install_on_windows_without_admin_rights.mdwn new file mode 100644 --- /dev/null +++ b/doc/bugs/git-annex_does_not_install_on_windows_without_admin_rights.mdwn @@ -0,0 +1,19 @@ +### Please describe the problem. + +Installing on Windows requires installing git followed by git-annex. Installing the former works without admin rights, but the latter cannot be installed afterwards. + +### What steps will reproduce the problem? + +1. Create a Windows account without admin rights +2. Install git +3. Install git-annex + +### What version of git-annex are you using? On what operating system? + +Latest release on MS Windows. + +### Please provide any additional information below. + + +Installing git creates read-only directories that cannot be used by the git-annex install afterwards. Without admin rights, the read-only flag of the git dir cannot be altered. + diff --git a/doc/bugs/git_annex_indirect_can_fail_catastrophically.mdwn b/doc/bugs/git_annex_indirect_can_fail_catastrophically.mdwn --- a/doc/bugs/git_annex_indirect_can_fail_catastrophically.mdwn +++ b/doc/bugs/git_annex_indirect_can_fail_catastrophically.mdwn @@ -70,7 +70,7 @@ Any update on this? Why is `-a` used here? -- [[anarcat]] -> -a is not really the problem. You certianly do usually want +> -a is not really the problem. You certainly do usually want > to commit your changes before converting to direct mode. > > [[done]]; now when this happens it catches the exception and diff --git a/doc/bugs/repair_fails_when_home_on_seperate_partition.mdwn b/doc/bugs/repair_fails_when_home_on_seperate_partition.mdwn new file mode 100644 --- /dev/null +++ b/doc/bugs/repair_fails_when_home_on_seperate_partition.mdwn @@ -0,0 +1,60 @@ +### Please describe the problem. + + +### What steps will reproduce the problem? + +(1) Place a broken repo on a different mount point than the root partition. + +(2) Run + git annex repair. + +### What version of git-annex are you using? On what operating system? + + 5.20131118-gc7e5cde on Ubuntu 12.04 + +### 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 + +$ git annex repair --force + +Running git fsck ... +git fsck found 74 broken objects. +Unpacking all pack files. +Unpacking objects: 100% (2307/2307), done. +Unpacking objects: 100% (241565/241565), done. +Re-running git fsck to see if it finds more problems. +Initialized empty Git repository in /tmp/tmprepo.0/.git/ +Trying to recover missing objects from remote pi.fritz.box__var_lib_store_annex +Trying to recover missing objects from remote pi.fritz.box__var_lib_store_annex +74 missing objects could not be recovered! + + +Deleted remote branch pi.fritz.box__var_lib_store_annex/master (was dffa056). +error: Could not read 4e01bbdc7ce31247ad66ab13ca46925ac2c8db9a +fatal: Failed to traverse parents of commit 718525a48b4d6b3404eda5e189332d73c968a2be +Deleted remote branch pi.fritz.box__var_lib_store_annex/synced/git-annex (was 718525a). +Deleted remote branch pi.fritz.box__var_lib_store_annex/synced/master (was 9aedf69). +Deleted remote branch pi.fritz.box_annex/synced/master (was 92b1042). +Deleted remote branch store/master (was b059380). +removed 5 remote tracking branches that referred to missing objects +fatal: bad object refs/heads/git-annex +fatal: bad object refs/heads/git-annex +fatal: bad object refs/heads/git-annex +error: remote branch 'git-annex' not found. + +git-annex: /tmp/packed-refs19813: rename: unsupported operation (Invalid cross-device link) +failed +git-annex: repair: 1 failed + + +# End of transcript or log. +"""]] + +> Thanks for reporting. As far as I can see, this was fixed +> accidentially, when I rewrote the packed refs file handling code to not +> re-write the file. It had been using a temp file, and renaming it, thus +> the problem. I checked the repair code and can find no other probems +> of this sort currently in it. [[done]] --[[Joey]] diff --git a/doc/bugs/test_failures_on_window_for_5.20131118.mdwn b/doc/bugs/test_failures_on_window_for_5.20131118.mdwn new file mode 100644 --- /dev/null +++ b/doc/bugs/test_failures_on_window_for_5.20131118.mdwn @@ -0,0 +1,20 @@ +### Please describe the problem. + +git annex test reports failures + +### What steps will reproduce the problem? + +running git annex test (from standard cmd, with: git version: 1.7.11.msysgit.1) + +### What version of git-annex are you using? On what operating system? + +5.20131118 from installers + +### Please provide any additional information below. + +operating system: + +windows XP, NTFS = 1 FAIL +windows 7, NTFS = 2 FAILs + +see attachment for full log of git annex test output diff --git a/doc/bugs/utf8/comment_13_7044d2c5bb1c91ee37eb9868963a1ff2._comment b/doc/bugs/utf8/comment_13_7044d2c5bb1c91ee37eb9868963a1ff2._comment --- a/doc/bugs/utf8/comment_13_7044d2c5bb1c91ee37eb9868963a1ff2._comment +++ b/doc/bugs/utf8/comment_13_7044d2c5bb1c91ee37eb9868963a1ff2._comment @@ -37,5 +37,5 @@ copy foo (checking foo...) [2013-07-27 16:40:42 EDT] call: ssh [\"-T\",\"fozz@git-annex-markdown.lang.speechmarks.com-fozz_phone.2Dannex.IdWwlXHtSsjVUMcq\",\"git-annex-shell 'inannex' '' 'SHA256E-s29--093429efb0d1427753d1f038f5279ec4df66785a1b2429b3fa5e3a01bcb75bd8' --uuid 111\"] -So, I don't understand how this could have happened. Although my recent changes mean it'll use a 62 byte path max on Android now, which certianly should avoid the problem, even if there's some actual bug here that I cannot reproduce. +So, I don't understand how this could have happened. Although my recent changes mean it'll use a 62 byte path max on Android now, which certainly should avoid the problem, even if there's some actual bug here that I cannot reproduce. """]] diff --git a/doc/builds.mdwn b/doc/builds.mdwn --- a/doc/builds.mdwn +++ b/doc/builds.mdwn @@ -9,8 +9,8 @@

Android

-

OSX Mountain Lion

-

OSX Lion