webapp and assistant glacier support

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
new 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.