webapp and assistant glacier support

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. -}
+ - numcopies settings. If it's known to be present on a particular remote,
-handleDrops :: Bool -> Key -> AssociatedFile -> Assistant ()
+ -  -}
-handleDrops _ _ Nothing = noop
+handleDrops :: Bool -> Key -> AssociatedFile -> Maybe Remote -> Assistant ()
-handleDrops fromhere key f = do
+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' :: [UUID] -> [Remote] -> Bool -> Key -> AssociatedFile -> Maybe Remote -> Annex ()
-handleDrops' _ _ _ _ Nothing = noop
+handleDrops' _ _ _ _ Nothing _ = noop
-handleDrops' locs rs fromhere key (Just f)
+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

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

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
 

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 =

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

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.AWS
-import Assistant.WebApp.Configurators.S3
-#endif
 #ifdef WITH_WEBDAV
 import Assistant.WebApp.Configurators.WebDAV
 #endif

Assistant/WebApp/Configurators.hs

@@ -176,6 +176,7 @@ repoList reposelector
 #ifdef WITH_S3
 			Just "S3" -> val True EnableS3R
 #endif
+			Just "glacier" -> val True EnableGlacierR
 #ifdef WITH_WEBDAV
 			Just "webdav" -> val True EnableWebDAVR
 #endif

Assistant/WebApp/Configurators/AWS.hs

@@ -0,0 +1,177 @@
+{- git-annex assistant webapp configurators for Amazon AWS services
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU AGPL version 3 or higher.
+ -}
+
+{-# LANGUAGE CPP, TypeFamilies, QuasiQuotes, MultiParamTypeClasses, TemplateHaskell, OverloadedStrings, RankNTypes #-}
+
+module Assistant.WebApp.Configurators.AWS where
+
+import Assistant.Common
+import Assistant.MakeRemote
+import Assistant.Sync
+import Assistant.WebApp
+import Assistant.WebApp.Types
+import Assistant.WebApp.SideBar
+import Utility.Yesod
+#ifdef WITH_S3
+import qualified Remote.S3 as S3
+#endif
+import qualified Remote.Glacier as Glacier
+import qualified Remote.Helper.AWS as AWS
+import Logs.Remote
+import qualified Remote
+import Types.Remote (RemoteConfig)
+import Types.StandardGroups
+import Logs.PreferredContent
+
+import Yesod
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Map as M
+
+awsConfigurator :: Widget -> Handler RepHtml
+awsConfigurator a = bootstrap (Just Config) $ do
+	sideBarDisplay
+	setTitle "Add an Amazon repository"
+	a
+
+glacierConfigurator :: Widget -> Handler RepHtml
+glacierConfigurator a = do
+	ifM (liftIO $ inPath "glacier")
+		( awsConfigurator a
+		, awsConfigurator needglaciercli
+		)
+  where
+	needglaciercli = $(widgetFile "configurators/needglaciercli")
+
+data StorageClass = StandardRedundancy | ReducedRedundancy
+	deriving (Eq, Enum, Bounded)
+
+instance Show StorageClass where
+	show StandardRedundancy = "STANDARD" 
+	show ReducedRedundancy = "REDUCED_REDUNDANCY"
+
+data AWSInput = AWSInput
+	{ accessKeyID :: Text
+	, secretAccessKey :: Text
+	-- Free form text for datacenter because Amazon adds new ones.
+	, datacenter :: Text
+	-- Only used for S3, not Glacier.
+	, storageClass :: StorageClass
+	, repoName :: Text
+	}
+
+data AWSCreds = AWSCreds Text Text
+
+extractCreds :: AWSInput -> AWSCreds
+extractCreds i = AWSCreds (accessKeyID i) (secretAccessKey i)
+
+s3InputAForm :: AForm WebApp WebApp AWSInput
+s3InputAForm = AWSInput
+	<$> areq textField "Access Key ID" Nothing
+	<*> areq passwordField "Secret Access Key" Nothing
+	<*> areq textField "Datacenter" (Just "US")
+	<*> areq (selectFieldList storageclasses) "Storage class" (Just StandardRedundancy)
+	<*> areq textField "Repository name" (Just "S3")
+  where
+	storageclasses :: [(Text, StorageClass)]
+	storageclasses =
+		[ ("Standard redundancy", StandardRedundancy)
+		, ("Reduced redundancy (costs less)", ReducedRedundancy)
+		]
+
+glacierInputAForm :: AForm WebApp WebApp AWSInput
+glacierInputAForm = AWSInput
+	<$> areq textField "Access Key ID" Nothing
+	<*> areq passwordField "Secret Access Key" Nothing
+	<*> areq textField "Datacenter" (Just "us-east-1")
+	<*> pure StandardRedundancy
+	<*> areq textField "Repository name" (Just "glacier")
+
+awsCredsAForm :: AForm WebApp WebApp AWSCreds
+awsCredsAForm = AWSCreds
+	<$> areq textField "Access Key ID" Nothing
+	<*> areq passwordField "Secret Access Key" Nothing
+
+getAddS3R :: Handler RepHtml
+#ifdef WITH_S3
+getAddS3R = awsConfigurator $ do
+	((result, form), enctype) <- lift $
+		runFormGet $ renderBootstrap s3InputAForm
+	case result of
+		FormSuccess input -> lift $ do
+			let name = T.unpack $ repoName input
+			makeAWSRemote S3.remote (extractCreds input) name setgroup $ M.fromList
+				[ ("encryption", "shared")
+				, ("type", "S3")
+				, ("datacenter", T.unpack $ datacenter input)
+				, ("storageclass", show $ storageClass input)
+				]
+		_ -> do
+			let authtoken = webAppFormAuthToken
+			$(widgetFile "configurators/adds3")
+  where
+	setgroup r = runAnnex () $
+		setStandardGroup (Remote.uuid r) TransferGroup
+#else
+getAddS3R = error "S3 not supported by this build"
+#endif
+
+getAddGlacierR :: Handler RepHtml
+getAddGlacierR = glacierConfigurator $ do
+	((result, form), enctype) <- lift $
+		runFormGet $ renderBootstrap glacierInputAForm
+	case result of
+		FormSuccess input -> lift $ do
+			let name = T.unpack $ repoName input
+			makeAWSRemote Glacier.remote (extractCreds input) name setgroup $ M.fromList
+				[ ("encryption", "shared")
+				, ("type", "glacier")
+				, ("datacenter", T.unpack $ datacenter input)
+				]
+		_ -> do
+			let authtoken = webAppFormAuthToken
+			$(widgetFile "configurators/addglacier")
+  where
+	setgroup r = runAnnex () $
+		setStandardGroup (Remote.uuid r) SmallArchiveGroup
+
+getEnableS3R :: UUID -> Handler RepHtml
+#ifdef WITH_S3
+getEnableS3R = awsConfigurator . enableAWSRemote S3.remote
+#else
+getEnableS3R _ = error "S3 not supported by this build"
+#endif
+
+getEnableGlacierR :: UUID -> Handler RepHtml
+getEnableGlacierR = glacierConfigurator . enableAWSRemote Glacier.remote
+
+enableAWSRemote :: RemoteType -> UUID -> Widget
+enableAWSRemote remotetype uuid = do
+	((result, form), enctype) <- lift $
+		runFormGet $ renderBootstrap awsCredsAForm
+	case result of
+		FormSuccess creds -> lift $ do
+			m <- runAnnex M.empty readRemoteLog
+			let name = fromJust $ M.lookup "name" $
+				fromJust $ M.lookup uuid m
+			makeAWSRemote remotetype creds name (const noop) M.empty
+		_ -> do
+			let authtoken = webAppFormAuthToken
+			description <- lift $ runAnnex "" $
+				T.pack . concat <$> Remote.prettyListUUIDs [uuid]
+			$(widgetFile "configurators/enableaws")
+
+makeAWSRemote :: RemoteType -> AWSCreds -> String -> (Remote -> Handler ()) -> RemoteConfig -> Handler ()
+makeAWSRemote remotetype (AWSCreds ak sk) name setup config = do
+	remotename <- runAnnex name $ fromRepo $ uniqueRemoteName name 0
+	liftIO $ AWS.setCredsEnv (T.unpack ak, T.unpack sk)
+	r <- liftAssistant $ liftAnnex $ addRemote $ do
+		makeSpecialRemote name remotetype config
+		return remotename
+	setup r
+	liftAssistant $ syncNewRemote r
+	redirect $ EditNewCloudRepositoryR $ Remote.uuid r

Assistant/WebApp/Configurators/S3.hs

@@ -1,123 +0,0 @@
-{- git-annex assistant webapp configurator for Amazon S3
- -
- - Copyright 2012 Joey Hess <joey@kitenet.net>
- -
- - Licensed under the GNU AGPL version 3 or higher.
- -}
-
-{-# LANGUAGE TypeFamilies, QuasiQuotes, MultiParamTypeClasses, TemplateHaskell, OverloadedStrings, RankNTypes #-}
-
-module Assistant.WebApp.Configurators.S3 where
-
-import Assistant.Common
-import Assistant.MakeRemote
-import Assistant.Sync
-import Assistant.WebApp
-import Assistant.WebApp.Types
-import Assistant.WebApp.SideBar
-import Utility.Yesod
-import qualified Remote.S3 as S3
-import qualified Remote.Helper.AWS as AWS
-import Logs.Remote
-import qualified Remote
-import Types.Remote (RemoteConfig)
-import Types.StandardGroups
-import Logs.PreferredContent
-
-import Yesod
-import Data.Text (Text)
-import qualified Data.Text as T
-import qualified Data.Map as M
-
-s3Configurator :: Widget -> Handler RepHtml
-s3Configurator a = bootstrap (Just Config) $ do
-	sideBarDisplay
-	setTitle "Add an Amazon S3 repository"
-	a
-
-data StorageClass = StandardRedundancy | ReducedRedundancy
-	deriving (Eq, Enum, Bounded)
-
-instance Show StorageClass where
-	show StandardRedundancy = "STANDARD" 
-	show ReducedRedundancy = "REDUCED_REDUNDANCY"
-
-data S3Input = S3Input
-	{ accessKeyID :: Text
-	, secretAccessKey :: Text
-	-- Free form text for datacenter because Amazon adds new ones.
-	, datacenter :: Text
-	, storageClass :: StorageClass
-	, repoName :: Text
-	}
-
-data S3Creds = S3Creds Text Text
-
-extractCreds :: S3Input -> S3Creds
-extractCreds i = S3Creds (accessKeyID i) (secretAccessKey i)
-
-s3InputAForm :: AForm WebApp WebApp S3Input
-s3InputAForm = S3Input
-	<$> areq textField "Access Key ID" Nothing
-	<*> areq passwordField "Secret Access Key" Nothing
-	<*> areq textField "Datacenter" (Just "US")
-	<*> areq (selectFieldList storageclasses) "Storage class" (Just StandardRedundancy)
-	<*> areq textField "Repository name" (Just "S3")
-  where
-	storageclasses :: [(Text, StorageClass)]
-	storageclasses =
-		[ ("Standard redundancy", StandardRedundancy)
-		, ("Reduced redundancy (costs less)", ReducedRedundancy)
-		]
-
-s3CredsAForm :: AForm WebApp WebApp S3Creds
-s3CredsAForm = S3Creds
-	<$> areq textField "Access Key ID" Nothing
-	<*> areq passwordField "Secret Access Key" Nothing
-
-getAddS3R :: Handler RepHtml
-getAddS3R = s3Configurator $ do
-	((result, form), enctype) <- lift $
-		runFormGet $ renderBootstrap s3InputAForm
-	case result of
-		FormSuccess s3input -> lift $ do
-			let name = T.unpack $ repoName s3input
-			makeS3Remote (extractCreds s3input) name setgroup $ M.fromList
-				[ ("encryption", "shared")
-				, ("type", "S3")
-				, ("datacenter", T.unpack $ datacenter s3input)
-				, ("storageclass", show $ storageClass s3input)
-				]
-		_ -> do
-			let authtoken = webAppFormAuthToken
-			$(widgetFile "configurators/adds3")
-  where
-	setgroup r = runAnnex () $
-		setStandardGroup (Remote.uuid r) TransferGroup
-
-getEnableS3R :: UUID -> Handler RepHtml
-getEnableS3R uuid = s3Configurator $ do
-	((result, form), enctype) <- lift $
-		runFormGet $ renderBootstrap s3CredsAForm
-	case result of
-		FormSuccess s3creds -> lift $ do
-			m <- runAnnex M.empty readRemoteLog
-			let name = fromJust $ M.lookup "name" $
-				fromJust $ M.lookup uuid m
-			makeS3Remote s3creds name (const noop) M.empty
-		_ -> do
-			let authtoken = webAppFormAuthToken
-			description <- lift $ runAnnex "" $
-				T.pack . concat <$> Remote.prettyListUUIDs [uuid]
-			$(widgetFile "configurators/enables3")
-
-makeS3Remote :: S3Creds -> String -> (Remote -> Handler ()) -> RemoteConfig -> Handler ()
-makeS3Remote (S3Creds ak sk) name setup config = do
-	remotename <- runAnnex name $ fromRepo $ uniqueRemoteName name 0
-	liftIO $ AWS.setCredsEnv (T.unpack ak, T.unpack sk)
-	r <- liftAssistant $ liftAnnex $ addRemote $ do
-		makeSpecialRemote name S3.remote config
-		return remotename
-	setup r
-	liftAssistant $ syncNewRemote r
-	redirect $ EditNewCloudRepositoryR $ Remote.uuid r

Assistant/WebApp/routes

@@ -25,6 +25,7 @@
 /config/repository/add/ssh/make/rsync/#SshData MakeSshRsyncR GET
 /config/repository/add/cloud/rsync.net AddRsyncNetR GET
 /config/repository/add/cloud/S3 AddS3R GET
+/config/repository/add/cloud/glacier AddGlacierR GET
 /config/repository/add/cloud/box.com AddBoxComR GET
 
 /config/repository/pair/local/start StartLocalPairR GET
@@ -38,6 +39,7 @@
 /config/repository/enable/rsync/#UUID EnableRsyncR GET
 /config/repository/enable/directory/#UUID EnableDirectoryR GET
 /config/repository/enable/S3/#UUID EnableS3R GET
+/config/repository/enable/glacier/#UUID EnableGlacierR GET
 /config/repository/enable/webdav/#UUID EnableWebDAVR GET
 
 /transfers/#NotificationId TransfersR GET

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 :: FilePath -> Maybe Int -> Key -> Maybe Remote -> CommandStart
-startLocal file numcopies key = stopUnless (inAnnex key) $ do
+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 -> Maybe Int -> Maybe Remote -> CommandPerform
-performLocal key numcopies = lockContent key $ do
+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)
+	let tocheck = Remote.remotesWithoutUUID remotes (trusteduuids'++untrusteduuids)
-	stopUnless (canDropKey key numcopies trusteduuids tocheck []) $ do
+	stopUnless (canDropKey key numcopies trusteduuids' tocheck []) $ do
 		whenM (inAnnex key) $ removeAnnex key
 		next $ cleanupLocal key
 

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

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: backs up all files"
-descStandardGroup BackupGroup = "backup: collects 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)"

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
 

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
 

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
+Need to handle retrying downloads of files from glacier after 4 hours.
-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.
 
 [[!tag /design/assistant]]

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
 

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.

templates/configurators/addglacier.hamlet

@@ -0,0 +1,40 @@
+<div .span9 .hero-unit>
+  <h2>
+    Adding an Amazon Glacier repository
+  <p>
+    <a href="http://aws.amazon.com/glacier/">Amazon Glacier</a> is an #
+    offline cloud storage provider. It takes several hours for requested #
+    files to be retrieved from Glacier, making it mostly suitable for #
+    backups and long-term data archival. #
+    <a href="http://aws.amazon.com/glacier/pricing/">
+      Pricing details
+  <p>
+    <i .icon-warning-sign></i> By default, only files you place in #
+    "archive" directories will be archived in Amazon Glacier. #
+    You will be charged by Amazon for data #
+    uploaded to Glacier, as well as data downloaded from Glacier, and a #
+    monthly fee for data storage.
+  <p>
+    All data will be encrypted before being sent to Amazon Glacier.
+  <p>
+    When you sign up to Amazon Glacier, they provide you with an Access #
+    Key ID, and a Secret Access Key. You will need to enter both below. #
+    These access keys will be stored in a file that only you can #
+    access. #
+    <a href="https://portal.aws.amazon.com/gp/aws/securityCredentials#id_block">
+      Look up your access keys
+  <p>
+    <form .form-horizontal enctype=#{enctype}>
+      <fieldset>
+        ^{form}
+        ^{authtoken}
+        <div .form-actions>
+          <button .btn .btn-primary type=submit onclick="$('#workingmodal').modal('show');">
+            Add Glacier repository
+<div .modal .fade #workingmodal>
+  <div .modal-header>
+    <h3>
+      Making repository ...
+  <div .modal-body>
+    <p>
+      Setting up your Amazon Glacier repository. This could take a minute.

templates/configurators/enableaws.hamlet

@@ -2,14 +2,14 @@
   <h2>
     Enabling #{description}
   <p>
-    To use this Amazon S3 repository, you need an Access Key ID, and a #
+    To use this Amazon repository, you need an Access Key ID, and a #
     Secret Access Key. These access keys will be stored in a file that #
     only you can access.
   <p>
-    If this repository uses your Amazon S3 account, you can #
+    If this repository uses your Amazon account, you can #
     <a href="https://portal.aws.amazon.com/gp/aws/securityCredentials#id_block">
       look up your access keys. #
-    If this repository uses someone else's Amazon S3 account, they #
+    If this repository uses someone else's Amazon account, they #
     can generate access keys for you, using their #
     <a href="https://console.aws.amazon.com/iam/home">
       IAM Management Console.
@@ -20,11 +20,11 @@
         ^{authtoken}
         <div .form-actions>
           <button .btn .btn-primary type=submit onclick="$('#workingmodal').modal('show');">
-            Enable S3 repository
+            Enable Amazon repository
 <div .modal .fade #workingmodal>
   <div .modal-header>
     <h3>
       Enabling repository ...
   <div .modal-body>
     <p>
-      Enabling this Amazon S3 repository. This could take a minute.
+      Enabling this Amazon repository. This could take a minute.

templates/configurators/needglaciercli.hamlet

@@ -0,0 +1,10 @@
+<div .span9 .hero-unit>
+  <h2>
+    Need glacier-cli
+  <p>
+    To use Amazon Glacier, you need to install #
+    <a href="https://github.com/basak/glacier-cli">
+      glacier-cli
+  <p>
+    <a .btn .btn-primary .btn-large href="">
+      Retry

templates/configurators/repositories/cloud.hamlet

@@ -1,3 +1,9 @@
+<h3>
+  <a href="@{AddBoxComR}">
+    <i .icon-plus-sign></i> Box.com
+<p>
+  Provides <b>free</b> cloud storage for small amounts of data.
+
 <h3>
   <a href="@{AddRsyncNetR}">
     <i .icon-plus-sign></i> Rsync.net
@@ -8,19 +14,14 @@
   <a href="@{AddS3R}">
     <i .icon-plus-sign></i> Amazon S3
 <p>
-  Good choice for professional storage quality and low prices.
+  Good choice for professional quality storage.
 
 <h3>
+  <a href="@{AddGlacierR}">
     <i .icon-plus-sign></i> Amazon Glacier
 <p>
   Low cost offline data archival.
 
-<h3>
-  <a href="@{AddBoxComR}">
-    <i .icon-plus-sign></i> Box.com
-<p>
-  Provides <b>free</b> cloud storage for small amounts of data.
-
 <h3>
   <a href="@{AddSshR}">
     <i .icon-plus-sign></i> Remote server