diff options
-rw-r--r-- | Assistant/Drop.hs | 19 | ||||
-rw-r--r-- | Assistant/Threads/TransferScanner.hs | 2 | ||||
-rw-r--r-- | Assistant/Threads/TransferWatcher.hs | 8 | ||||
-rw-r--r-- | Assistant/Threads/Transferrer.hs | 9 | ||||
-rw-r--r-- | Assistant/Threads/Watcher.hs | 2 | ||||
-rw-r--r-- | Assistant/Threads/WebApp.hs | 4 | ||||
-rw-r--r-- | Command/Drop.hs | 21 | ||||
-rw-r--r-- | Command/DropUnused.hs | 2 | ||||
-rw-r--r-- | Types/StandardGroups.hs | 18 | ||||
-rw-r--r-- | debian/changelog | 6 | ||||
-rw-r--r-- | doc/assistant.mdwn | 2 | ||||
-rw-r--r-- | doc/assistant/repogroup.png | bin | 0 -> 10986 bytes | |||
-rw-r--r-- | doc/bugs/glacier_with_assistant_bugs.mdwn | 7 | ||||
-rw-r--r-- | doc/design/assistant/transfer_control.mdwn | 3 | ||||
-rw-r--r-- | doc/preferred_content.mdwn | 23 |
15 files changed, 77 insertions, 49 deletions
diff --git a/Assistant/Drop.hs b/Assistant/Drop.hs index 66e738a6f..4551f49ba 100644 --- a/Assistant/Drop.hs +++ b/Assistant/Drop.hs @@ -19,18 +19,19 @@ import Annex.Wanted import Config {- Drop from local and/or remote when allowed by the preferred content and - - numcopies settings. -} -handleDrops :: Bool -> Key -> AssociatedFile -> Assistant () -handleDrops _ _ Nothing = noop -handleDrops fromhere key f = do + - numcopies settings. If it's known to be present on a particular remote, + - -} +handleDrops :: Bool -> Key -> AssociatedFile -> Maybe Remote -> Assistant () +handleDrops _ _ Nothing _ = noop +handleDrops fromhere key f knownpresentremote = do syncrs <- syncDataRemotes <$> getDaemonStatus liftAnnex $ do locs <- loggedLocations key - handleDrops' locs syncrs fromhere key f + handleDrops' locs syncrs fromhere key f knownpresentremote -handleDrops' :: [UUID] -> [Remote] -> Bool -> Key -> AssociatedFile -> Annex () -handleDrops' _ _ _ _ Nothing = noop -handleDrops' locs rs fromhere key (Just f) +handleDrops' :: [UUID] -> [Remote] -> Bool -> Key -> AssociatedFile -> Maybe Remote -> Annex () +handleDrops' _ _ _ _ Nothing _ = noop +handleDrops' locs rs fromhere key (Just f) knownpresentremote | fromhere = do n <- getcopies if checkcopies n @@ -59,7 +60,7 @@ handleDrops' locs rs fromhere key (Just f) ) dropl n = checkdrop n Nothing $ \numcopies -> - Command.Drop.startLocal f numcopies key + Command.Drop.startLocal f numcopies key knownpresentremote dropr r n = checkdrop n (Just $ Remote.uuid r) $ \numcopies -> Command.Drop.startRemote f numcopies key r diff --git a/Assistant/Threads/TransferScanner.hs b/Assistant/Threads/TransferScanner.hs index 918a266c7..6cbb5cc89 100644 --- a/Assistant/Threads/TransferScanner.hs +++ b/Assistant/Threads/TransferScanner.hs @@ -119,7 +119,7 @@ expensiveScan rs = unless onlyweb $ do locs <- loggedLocations key present <- inAnnex key - handleDrops' locs syncrs present key (Just f) + handleDrops' locs syncrs present key (Just f) Nothing let slocs = S.fromList locs let use a = return $ catMaybes $ map (a key slocs) syncrs diff --git a/Assistant/Threads/TransferWatcher.hs b/Assistant/Threads/TransferWatcher.hs index 7deafb14d..6f040ba91 100644 --- a/Assistant/Threads/TransferWatcher.hs +++ b/Assistant/Threads/TransferWatcher.hs @@ -102,11 +102,11 @@ onDel file = case parseTransferFile file of threadDelay 10000000 -- 10 seconds finished t minfo -{- Queue uploads of files we successfully downloaded, spreading them +{- Queue uploads of files downloaded to us, spreading them - out to other reachable remotes. - - Downloading a file may have caused a remote to not want it; - - so drop it from the remote. + - so check for drops from remotes. - - Uploading a file may cause the local repo, or some other remote to not - want it; handle that too. @@ -115,9 +115,9 @@ finishedTransfer :: Transfer -> Maybe TransferInfo -> Assistant () finishedTransfer t (Just info) | transferDirection t == Download = whenM (liftAnnex $ inAnnex $ transferKey t) $ do - handleDrops False (transferKey t) (associatedFile info) + handleDrops False (transferKey t) (associatedFile info) Nothing queueTransfersMatching (/= transferUUID t) Later (transferKey t) (associatedFile info) Upload - | otherwise = handleDrops True (transferKey t) (associatedFile info) + | otherwise = handleDrops True (transferKey t) (associatedFile info) Nothing finishedTransfer _ _ = noop diff --git a/Assistant/Threads/Transferrer.hs b/Assistant/Threads/Transferrer.hs index 1d23487fa..5c7056568 100644 --- a/Assistant/Threads/Transferrer.hs +++ b/Assistant/Threads/Transferrer.hs @@ -13,6 +13,7 @@ import Assistant.TransferQueue import Assistant.TransferSlots import Assistant.Alert import Assistant.Commits +import Assistant.Drop import Logs.Transfer import Logs.Location import Annex.Content @@ -65,6 +66,10 @@ startTransfer program t info = case (transferRemote info, associatedFile info) o - so there's no point in bothering the user about - those. The assistant should recover. - + - After a successful upload, handle dropping it from + - here, if desired. In this case, the remote it was + - uploaded to is known to have it. + - - Also, after a successful transfer, the location - log has changed. Indicate that a commit has been - made, in order to queue a push of the git-annex @@ -74,6 +79,10 @@ startTransfer program t info = case (transferRemote info, associatedFile info) o whenM (liftIO $ (==) ExitSuccess <$> waitForProcess pid) $ do void $ addAlert $ makeAlertFiller True $ transferFileAlert direction True file + unless isdownload $ + handleDrops True (transferKey t) + (associatedFile info) + (Just remote) recordCommit where params = diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs index e56e47aea..f7e4e2df2 100644 --- a/Assistant/Threads/Watcher.hs +++ b/Assistant/Threads/Watcher.hs @@ -187,7 +187,7 @@ onAddSymlink file filestatus = go =<< liftAnnex (Backend.lookupFile file) if present then queueTransfers Next key (Just file) Upload else queueTransfers Next key (Just file) Download - handleDrops present key (Just file) + handleDrops present key (Just file) Nothing | otherwise = noop onDel :: Handler diff --git a/Assistant/Threads/WebApp.hs b/Assistant/Threads/WebApp.hs index 9108c9307..cbe0e4aac 100644 --- a/Assistant/Threads/WebApp.hs +++ b/Assistant/Threads/WebApp.hs @@ -21,9 +21,7 @@ import Assistant.WebApp.Configurators.Edit import Assistant.WebApp.Configurators.Local import Assistant.WebApp.Configurators.Ssh import Assistant.WebApp.Configurators.Pairing -#ifdef WITH_S3 -import Assistant.WebApp.Configurators.S3 -#endif +import Assistant.WebApp.Configurators.AWS #ifdef WITH_WEBDAV import Assistant.WebApp.Configurators.WebDAV #endif diff --git a/Command/Drop.hs b/Command/Drop.hs index 6c210b1e1..e7b52124f 100644 --- a/Command/Drop.hs +++ b/Command/Drop.hs @@ -34,29 +34,32 @@ start :: Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart start from file (key, _) = autoCopiesWith file key (>) $ \numcopies -> stopUnless (checkAuto $ wantDrop (Remote.uuid <$> from) (Just file)) $ case from of - Nothing -> startLocal file numcopies key + Nothing -> startLocal file numcopies key Nothing Just remote -> do u <- getUUID if Remote.uuid remote == u - then startLocal file numcopies key + then startLocal file numcopies key Nothing else startRemote file numcopies key remote -startLocal :: FilePath -> Maybe Int -> Key -> CommandStart -startLocal file numcopies key = stopUnless (inAnnex key) $ do +startLocal :: FilePath -> Maybe Int -> Key -> Maybe Remote -> CommandStart +startLocal file numcopies key knownpresentremote = stopUnless (inAnnex key) $ do showStart "drop" file - next $ performLocal key numcopies + next $ performLocal key numcopies knownpresentremote startRemote :: FilePath -> Maybe Int -> Key -> Remote -> CommandStart startRemote file numcopies key remote = do showStart ("drop " ++ Remote.name remote) file next $ performRemote key numcopies remote -performLocal :: Key -> Maybe Int -> CommandPerform -performLocal key numcopies = lockContent key $ do +performLocal :: Key -> Maybe Int -> Maybe Remote -> CommandPerform +performLocal key numcopies knownpresentremote = lockContent key $ do (remotes, trusteduuids) <- Remote.keyPossibilitiesTrusted key + let trusteduuids' = case knownpresentremote of + Nothing -> trusteduuids + Just r -> nub (Remote.uuid r:trusteduuids) untrusteduuids <- trustGet UnTrusted - let tocheck = Remote.remotesWithoutUUID remotes (trusteduuids++untrusteduuids) - stopUnless (canDropKey key numcopies trusteduuids tocheck []) $ do + let tocheck = Remote.remotesWithoutUUID remotes (trusteduuids'++untrusteduuids) + stopUnless (canDropKey key numcopies trusteduuids' tocheck []) $ do whenM (inAnnex key) $ removeAnnex key next $ cleanupLocal key diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs index 00c0eec12..95af062f5 100644 --- a/Command/DropUnused.hs +++ b/Command/DropUnused.hs @@ -34,7 +34,7 @@ perform key = maybe droplocal dropremote =<< Remote.byName =<< from showAction $ "from " ++ Remote.name r ok <- Remote.removeKey r key next $ Command.Drop.cleanupRemote key r ok - droplocal = Command.Drop.performLocal key (Just 0) -- force drop + droplocal = Command.Drop.performLocal key (Just 0) Nothing -- force drop from = Annex.getField $ Option.name Command.Drop.fromOption performOther :: (Key -> Git.Repo -> FilePath) -> Key -> CommandPerform diff --git a/Types/StandardGroups.hs b/Types/StandardGroups.hs index 1739c2059..c1ea1fd99 100644 --- a/Types/StandardGroups.hs +++ b/Types/StandardGroups.hs @@ -7,31 +7,35 @@ module Types.StandardGroups where -data StandardGroup = ClientGroup | TransferGroup | ArchiveGroup | BackupGroup +data StandardGroup = ClientGroup | TransferGroup | BackupGroup | SmallArchiveGroup | FullArchiveGroup deriving (Eq, Ord, Enum, Bounded, Show) fromStandardGroup :: StandardGroup -> String fromStandardGroup ClientGroup = "client" fromStandardGroup TransferGroup = "transfer" -fromStandardGroup ArchiveGroup = "archive" fromStandardGroup BackupGroup = "backup" +fromStandardGroup SmallArchiveGroup = "smallarchive" +fromStandardGroup FullArchiveGroup = "archive" toStandardGroup :: String -> Maybe StandardGroup toStandardGroup "client" = Just ClientGroup toStandardGroup "transfer" = Just TransferGroup -toStandardGroup "archive" = Just ArchiveGroup toStandardGroup "backup" = Just BackupGroup +toStandardGroup "smallarchive" = Just SmallArchiveGroup +toStandardGroup "archive" = Just FullArchiveGroup toStandardGroup _ = Nothing descStandardGroup :: StandardGroup -> String descStandardGroup ClientGroup = "client: a repository on your computer" descStandardGroup TransferGroup = "transfer: distributes files to clients" -descStandardGroup ArchiveGroup = "archive: collects files that are not archived elsewhere" -descStandardGroup BackupGroup = "backup: collects all files" +descStandardGroup BackupGroup = "backup: backs up all files" +descStandardGroup SmallArchiveGroup = "small archive: archives files located in \"archive\" directories" +descStandardGroup FullArchiveGroup = "full archive: archives all files not archived elsewhere" {- See doc/preferred_content.mdwn for explanations of these expressions. -} preferredContent :: StandardGroup -> String -preferredContent ClientGroup = "exclude=*/archive/*" +preferredContent ClientGroup = "exclude=*/archive/* and exclude=archive/*" preferredContent TransferGroup = "not (inallgroup=client and copies=client:2) and " ++ preferredContent ClientGroup -preferredContent ArchiveGroup = "not copies=archive:1" preferredContent BackupGroup = "" -- all content is preferred +preferredContent SmallArchiveGroup = "(include=*/archive/* or include=archive/*) and " ++ preferredContent FullArchiveGroup +preferredContent FullArchiveGroup = "not (copies=archive:1 or copies=smallarchive:1)" diff --git a/debian/changelog b/debian/changelog index 44fd9cf16..21bba4230 100644 --- a/debian/changelog +++ b/debian/changelog @@ -16,6 +16,12 @@ git-annex (3.20121113) UNRELEASED; urgency=low * Allow controlling whether login credentials for S3 and webdav are committed to the repository, by setting embedcreds=yes|no when running initremote. + * Added smallarchive repository group, that only archives files that are + in archive directories. + * assistant: Fixed handling of toplevel archive directory and + client repository group. + * assistant: Apply preferred content settings when a new symlink + is created, or a symlink gets renamed. Made archive directories work. -- Joey Hess <joeyh@debian.org> Tue, 13 Nov 2012 13:17:07 -0400 diff --git a/doc/assistant.mdwn b/doc/assistant.mdwn index 549434207..003269817 100644 --- a/doc/assistant.mdwn +++ b/doc/assistant.mdwn @@ -35,6 +35,8 @@ interface to add repositories and control the git-annex assistant. Follow the [[pairing_walkthrough]]. * Want to share a synchronised folder with a friend? Follow the [[share_with_a_friend_walkthrough]]. +* Want to archive data to a drive or the cloud? + Follow the [[archival_walkthrough]] ## command line startup diff --git a/doc/assistant/repogroup.png b/doc/assistant/repogroup.png Binary files differnew file mode 100644 index 000000000..ac5aabd89 --- /dev/null +++ b/doc/assistant/repogroup.png diff --git a/doc/bugs/glacier_with_assistant_bugs.mdwn b/doc/bugs/glacier_with_assistant_bugs.mdwn index 4605a03b2..59f9118be 100644 --- a/doc/bugs/glacier_with_assistant_bugs.mdwn +++ b/doc/bugs/glacier_with_assistant_bugs.mdwn @@ -1,8 +1,3 @@ -When a file is moved to an archive directory, the assistant uploads it to -glacier correctly, but then fails to drop it locally, unless it was -started with `--trust-glacier`. - -Since it just uploaded the file, it should be able to drop it, without -needing to trust glacier's inventory. Note that `git annex move` works. +Need to handle retrying downloads of files from glacier after 4 hours. [[!tag /design/assistant]] diff --git a/doc/design/assistant/transfer_control.mdwn b/doc/design/assistant/transfer_control.mdwn index ad5578c50..c21c4a170 100644 --- a/doc/design/assistant/transfer_control.mdwn +++ b/doc/design/assistant/transfer_control.mdwn @@ -19,6 +19,9 @@ something smart with such remotes. log is not updated in time, it will fail to drop unwanted content. (There's a 10 second sleep there now to avoid the race, but that's hardly a fix.) +* When a file is renamed into an archive directory, it's not immediately + transferred to archive remotes. (Next expensive scan does successfully + cause the transfer to happen). ### dropping no longer preferred content diff --git a/doc/preferred_content.mdwn b/doc/preferred_content.mdwn index ac2cd1ecf..499cf628e 100644 --- a/doc/preferred_content.mdwn +++ b/doc/preferred_content.mdwn @@ -92,7 +92,7 @@ to "standard", and put it in one of these groups: All content is preferred, unless it's in a "archive" directory. -`exclude=*/archive/*` +`exclude=*/archive/* and exclude=archive/*` ### transfer @@ -104,7 +104,7 @@ USB drive used in a sneakernet. The preferred content expression for these causes them to get and retain data until all clients have a copy. -`not (inallgroup=client and copies=client:2) and exclude=*/archive/*` +`not (inallgroup=client and copies=client:2) and exclude=*/archive/* and exclude=archive/*` The "copies=client:2" part of the above handles the case where there is only one client repository. It makes a transfer repository @@ -112,17 +112,24 @@ speculatively prefer content in this case, even though it as of yet has nowhere to transfer it to. Presumably, another client repository will be added later. -### archive +### backup + +All content is preferred. + +### small archive + +Only prefers content that's located in an "archive" directory, and +only if it's not already been archived somewhere else. + +`(include=*/archive/* or include=archive/*) and not (copies=archive:1 or copies=smallarchive:1)` + +### full archive All content is preferred, unless it's already been archived somewhere else. -`not copies=archive:1` +`not (copies=archive:1 or copies=smallarchive:1)` Note that if you want to archive multiple copies (not a bad idea!), you should instead configure all your archive repositories with a version of the above preferred content expression with a larger number of copies. - -### backup - -All content is preferred. |