packages feed

git-annex 4.20130314 → 4.20130323

raw patch · 205 files changed

+2689/−937 lines, 205 filesbinary-added

Files

Annex/Content.hs view
@@ -276,10 +276,6 @@  - In direct mode, it's possible for the file to change as it's being sent.  - If this happens, runs the rollback action and returns False. The  - rollback action should remove the data that was transferred.- -- - Note that the returned action is, in some cases, run in the Annex monad- - of the remote that is receiving the object, rather than the sender.- - So it cannot rely on Annex state, particular   -} sendAnnex :: Key -> Annex () -> (FilePath -> Annex Bool) -> Annex Bool sendAnnex key rollback sendobject = go =<< prepSendAnnex key@@ -299,6 +295,10 @@  -  - In direct mode, it's possible for the file to change as it's being sent,  - and the check detects this case and returns False.+ -+ - Note that the returned check action is, in some cases, run in the+ - Annex monad of the remote that is receiving the object, rather than+ - the sender. So it cannot rely on Annex state.  -} prepSendAnnex :: Key -> Annex (Maybe (FilePath, Annex Bool)) prepSendAnnex key = withObjectLoc key indirect direct
Annex/Content/Direct.hs view
@@ -150,12 +150,8 @@ compareInodeCaches x y 	| compareStrong x y = return True 	| otherwise = ifM inodesChanged-		( do-			liftIO $ print ("compareInodeCaches weak")-			return $ compareWeak x y-		, do-			liftIO $ print ("compareInodeCaches no inode change but cache not match")-			return False+		( return $ compareWeak x y+		, return False 		)  compareInodeCachesWith :: Annex InodeComparisonType@@ -175,11 +171,9 @@ 		scache <- liftIO . genInodeCache 			=<< fromRepo gitAnnexInodeSentinal 		scached <- readInodeSentinalFile-		liftIO $ print (scache, scached) 		let changed = case (scache, scached) of 			(Just c1, Just c2) -> not $ compareStrong c1 c2 			_ -> True-		liftIO $ print changed 		Annex.changeState $ \s -> s { Annex.inodeschanged = Just changed } 		return changed
Assistant.hs view
@@ -157,6 +157,7 @@ import qualified Utility.Daemon import Utility.LogFile import Utility.ThreadScheduler+import qualified Build.SysConfig as SysConfig  stopDaemon :: Annex () stopDaemon = liftIO . Utility.Daemon.stopDaemon =<< fromRepo gitAnnexPidFile@@ -198,6 +199,7 @@ 				=<< newAssistantData st dstatus  	go webappwaiter = do+		notice ["starting", desc, "version", SysConfig.packageversion] #ifdef WITH_WEBAPP 		d <- getAssistant id 		urlrenderer <- liftIO newUrlRenderer
Assistant/Alert.hs view
@@ -34,6 +34,8 @@ 	| WarningAlert String 	| PairAlert String 	| XMPPNeededAlert+	| CloudRepoNeededAlert+	| SyncAlert 	deriving (Eq)  {- The first alert is the new alert, the second is an old alert.@@ -236,32 +238,30 @@ 	[Tensed "Committing" "Committed", "changes to git"]  showRemotes :: [Remote] -> TenseChunk-showRemotes = UnTensed . T.unwords . map (T.pack . Remote.name)--pushAlert :: [Remote] -> Alert-pushAlert rs = activityAlert Nothing-	[Tensed "Syncing" "Synced", "with", showRemotes rs]--pushRetryAlert :: [Remote] -> Alert-pushRetryAlert rs = activityAlert-	(Just $ tenseWords [Tensed "Retrying" "Retried", "sync"])-	["with", showRemotes rs]+showRemotes = UnTensed . T.intercalate ", " . map (T.pack . Remote.name)  syncAlert :: [Remote] -> Alert syncAlert rs = baseActivityAlert-	{ alertHeader = Just $ tenseWords+	{ alertName = Just SyncAlert+	, alertHeader = Just $ tenseWords 		[Tensed "Syncing" "Synced", "with", showRemotes rs]-	, alertData = [] 	, alertPriority = Low 	} -scanAlert :: [Remote] -> Alert-scanAlert rs = baseActivityAlert-	{ alertHeader = Just $ tenseWords-		[Tensed "Scanning" "Scanned", showRemotes rs]-	, alertBlockDisplay = True-	, alertPriority = Low-	}+syncResultAlert :: [Remote] -> [Remote] -> Alert+syncResultAlert succeeded failed = makeAlertFiller (not $ null succeeded) $+	baseActivityAlert+		{ alertName = Just SyncAlert+		, alertHeader = Just $ tenseWords msg+		}+  where+  	msg+		| null succeeded = ["Failed to sync with", showRemotes failed]+		| null failed = ["Synced with", showRemotes succeeded]+		| otherwise =+			[ "Synced with", showRemotes succeeded+			, "but not with", showRemotes failed+			]  sanityCheckAlert :: Alert sanityCheckAlert = activityAlert@@ -329,6 +329,24 @@ 	, alertMessageRender = tenseWords 	, alertBlockDisplay = True 	, alertName = Just $ XMPPNeededAlert+	, alertCombiner = Just $ dataCombiner $ \_old new -> new+	, alertData = []+	}++cloudRepoNeededAlert :: Maybe String -> AlertButton -> Alert+cloudRepoNeededAlert friendname button = Alert+	{ alertHeader = Just $ fromString $ unwords+		[ "Unable to download files from"+		, (fromMaybe "your other devices" friendname) ++ "."+		]+	, alertIcon = Just ErrorIcon+	, alertPriority = High+	, alertButton = Just button+	, alertClosable = True+	, alertClass = Message+	, alertMessageRender = tenseWords+	, alertBlockDisplay = True+	, alertName = Just $ CloudRepoNeededAlert 	, alertCombiner = Just $ dataCombiner $ \_old new -> new 	, alertData = [] 	}
Assistant/DaemonStatus.hs view
@@ -43,7 +43,8 @@ 		sendNotification $ changeNotifier s 		return b -{- Returns a function that updates the lists of syncable remotes. -}+{- Returns a function that updates the lists of syncable remotes+ - and other associated information. -} calcSyncRemotes :: Annex (DaemonStatus -> DaemonStatus) calcSyncRemotes = do 	rs <- filter (remoteAnnexSync . Remote.gitconfig) .@@ -51,17 +52,29 @@ 	alive <- trustExclude DeadTrusted (map Remote.uuid rs) 	let good r = Remote.uuid r `elem` alive 	let syncable = filter good rs+	let nonxmpp = filter (not . isXMPPRemote) syncable+ 	return $ \dstatus -> dstatus 		{ syncRemotes = syncable-		, syncGitRemotes = filter (not . Remote.specialRemote) syncable-		, syncDataRemotes = filter (not . isXMPPRemote) syncable+		, syncGitRemotes =+			filter (not . Remote.specialRemote) syncable+		, syncDataRemotes = nonxmpp+		, syncingToCloudRemote = any iscloud nonxmpp 		}+  where+  	iscloud r = not (Remote.readonly r) && Remote.globallyAvailable r  {- Updates the sycRemotes list from the list of all remotes in Annex state. -} updateSyncRemotes :: Assistant () updateSyncRemotes = do 	modifyDaemonStatus_ =<< liftAnnex calcSyncRemotes-	liftIO . sendNotification =<< syncRemotesNotifier <$> getDaemonStatus+	status <- getDaemonStatus+	liftIO $ sendNotification $ syncRemotesNotifier status++	when (syncingToCloudRemote status) $+		updateAlertMap $+			M.filter $ \alert ->+				alertName alert /= Just CloudRepoNeededAlert  {- Load any previous daemon status file, and store it in a MVar for this  - process to use as its DaemonStatus. Also gets current transfer status. -}
Assistant/Monad.hs view
@@ -13,6 +13,7 @@ 	newAssistantData, 	runAssistant, 	getAssistant,+	LiftAnnex, 	liftAnnex, 	(<~>), 	(<<~),@@ -34,6 +35,7 @@ import Assistant.Types.ScanRemotes import Assistant.Types.TransferQueue import Assistant.Types.TransferSlots+import Assistant.Types.TransferrerPool import Assistant.Types.Pushes import Assistant.Types.BranchChange import Assistant.Types.Commits@@ -61,6 +63,7 @@ 	, scanRemoteMap :: ScanRemoteMap 	, transferQueue :: TransferQueue 	, transferSlots :: TransferSlots+	, transferrerPool :: TransferrerPool 	, failedPushMap :: FailedPushMap 	, commitChan :: CommitChan 	, changeChan :: ChangeChan@@ -77,6 +80,7 @@ 	<*> newScanRemoteMap 	<*> newTransferQueue 	<*> newTransferSlots+	<*> newTransferrerPool 	<*> newFailedPushMap 	<*> newCommitChan 	<*> newChangeChan@@ -90,13 +94,18 @@ getAssistant :: (AssistantData -> a) -> Assistant a getAssistant = reader +{- Using a type class for lifting into the annex monad allows+ - easily lifting to it from multiple different monads. -}+class LiftAnnex m where+	liftAnnex :: Annex a -> m a+ {- Runs an action in the git-annex monad. Note that the same monad state  - is shared amoung all assistant threads, so only one of these can run at  - a time. Therefore, long-duration actions should be avoided. -}-liftAnnex :: Annex a -> Assistant a-liftAnnex a = do-	st <- reader threadState-	liftIO $ runThreadState st a+instance LiftAnnex Assistant where+	liftAnnex a = do+		st <- reader threadState+		liftIO $ runThreadState st a  {- Runs an IO action, passing it an IO action that runs an Assistant action. -} (<~>) :: (IO a -> IO b) -> Assistant a -> Assistant b
Assistant/Sync.hs view
@@ -48,31 +48,27 @@ reconnectRemotes notifypushes rs = void $ do 	modifyDaemonStatus_ $ \s -> s 		{ desynced = S.union (S.fromList $ map Remote.uuid xmppremotes) (desynced s) }-	if null normalremotes-		then go-		else alertWhile (syncAlert normalremotes) go+	syncAction rs (const go)   where 	gitremotes = filter (notspecialremote . Remote.repo) rs-	(xmppremotes, normalremotes) = partition isXMPPRemote gitremotes-	nonxmppremotes = snd $ partition isXMPPRemote rs+	(xmppremotes, nonxmppremotes) = partition isXMPPRemote rs 	notspecialremote r 		| Git.repoIsUrl r = True 		| Git.repoIsLocal r = True+		| Git.repoIsLocalUnknown r = True 		| otherwise = False 	sync (Just branch) = do-		diverged <- snd <$> manualPull (Just branch) gitremotes+		(failedpull, diverged) <- manualPull (Just branch) gitremotes 		now <- liftIO getCurrentTime-		ok <- pushToRemotes' now notifypushes gitremotes-		return (ok, diverged)+		failedpush <- pushToRemotes' now notifypushes gitremotes+		return (nub $ failedpull ++ failedpush, diverged) 	{- No local branch exists yet, but we can try pulling. -}-	sync Nothing = do-		diverged <- snd <$> manualPull Nothing gitremotes-		return (True, diverged)+	sync Nothing = manualPull Nothing gitremotes 	go = do-		(ok, diverged) <- sync+		(failed, diverged) <- sync 			=<< liftAnnex (inRepo Git.Branch.current) 		addScanRemotes diverged nonxmppremotes-		return ok+		return failed  {- Updates the local sync branch, then pushes it to all remotes, in  - parallel, along with the git-annex branch. This is the same@@ -96,16 +92,14 @@  - fallback mode, where our push is guarenteed to succeed if the remote is  - reachable. If the fallback fails, the push is queued to be retried  - later.+ -+ - Returns any remotes that it failed to push to.  -}-pushToRemotes :: Bool -> [Remote] -> Assistant Bool+pushToRemotes :: Bool -> [Remote] -> Assistant [Remote] pushToRemotes notifypushes remotes = do-	now <- liftIO $ getCurrentTime-	let nonxmppremotes = snd $ partition isXMPPRemote remotes-	let go = pushToRemotes' now notifypushes remotes-	if null nonxmppremotes-		then go-		else alertWhile (pushAlert nonxmppremotes) go-pushToRemotes' :: UTCTime -> Bool -> [Remote] -> Assistant Bool+	now <- liftIO getCurrentTime+	syncAction remotes (pushToRemotes' now notifypushes)+pushToRemotes' :: UTCTime -> Bool -> [Remote] -> Assistant [Remote] pushToRemotes' now notifypushes remotes = do 	(g, branch, u) <- liftAnnex $ do 		Annex.Branch.commit "update"@@ -119,8 +113,8 @@ 		sendNetMessage $ Pushing (getXMPPClientID r) CanPush 	return ret   where-	go _ Nothing _ _ _ = return True -- no branch, so nothing to do-	go _ _ _ _ [] = return True -- no remotes, so nothing to do+	go _ Nothing _ _ _ = return [] -- no branch, so nothing to do+	go _ _ _ _ [] = return [] -- no remotes, so nothing to do 	go shouldretry (Just branch) g u rs =  do 		debug ["pushing to", show rs] 		liftIO $ Command.Sync.updateBranch (Command.Sync.syncBranch branch) g@@ -131,7 +125,7 @@ 				when notifypushes $ 					sendNetMessage $ NotifyPush $ 						map Remote.uuid succeeded-				return True+				return failed 			else if shouldretry 				then retry branch g u failed 				else fallback branch g u failed@@ -154,30 +148,55 @@ 		when (notifypushes && (not $ null succeeded)) $ 			sendNetMessage $ NotifyPush $ 				map Remote.uuid succeeded-		return $ null failed+		return failed 		 	push g branch remote = Command.Sync.pushBranch remote branch g -{- Manually pull from remotes and merge their branches. Returns the results- - of all the pulls, and whether the git-annex branches of the remotes and- - local had divierged before the pull.+{- Displays an alert while running an action that syncs with some remotes,+ - and returns any remotes that it failed to sync with.  -- - After pulling from the normal git remotes, requests pushes from any XMPP- - remotes. However, those pushes will run asynchronously, so their+ - XMPP remotes are handled specially; since the action can only start+ - an async process for them, they are not included in the alert, but are+ - still passed to the action.+ -}+syncAction :: [Remote] -> ([Remote] -> Assistant [Remote]) -> Assistant [Remote]+syncAction rs a+	| null nonxmppremotes = a rs+	| otherwise = do+		i <- addAlert $ syncAlert nonxmppremotes+		failed <- a rs+		let failed' = filter (Git.repoIsLocalUnknown . Remote.repo) failed+		let succeeded = filter (`notElem` failed) nonxmppremotes+		updateAlertMap $ mergeAlert i $+			syncResultAlert succeeded failed'+		return failed+  where+	nonxmppremotes = filter (not . isXMPPRemote) rs++{- Manually pull from remotes and merge their branches. Returns any+ - remotes that it failed to pull from, and a Bool indicating+ - whether the git-annex branches of the remotes and local had+ - diverged before the pull.+ -+ - After pulling from the normal git remotes, requests pushes from any+ - XMPP remotes. However, those pushes will run asynchronously, so their  - results are not included in the return data.  -}-manualPull :: Maybe Git.Ref -> [Remote] -> Assistant ([Bool], Bool)+manualPull :: Maybe Git.Ref -> [Remote] -> Assistant ([Remote], Bool) manualPull currentbranch remotes = do 	g <- liftAnnex gitRepo 	let (xmppremotes, normalremotes) = partition isXMPPRemote remotes-	results <- liftIO $ forM normalremotes $ \r ->-		Git.Command.runBool [Param "fetch", Param $ Remote.name r] g+	failed <- liftIO $ forM normalremotes $ \r ->+		ifM (Git.Command.runBool [Param "fetch", Param $ Remote.name r] g)+			( return Nothing+			, return $ Just r+			) 	haddiverged <- liftAnnex Annex.Branch.forceUpdate 	forM_ normalremotes $ \r -> 		liftAnnex $ Command.Sync.mergeRemote r currentbranch 	forM_ xmppremotes $ \r -> 		sendNetMessage $ Pushing (getXMPPClientID r) PushRequest-	return (results, haddiverged)+	return (catMaybes failed, haddiverged)  {- Start syncing a newly added remote, using a background thread. -} syncNewRemote :: Remote -> Assistant ()
Assistant/Threads/Committer.hs view
@@ -317,7 +317,7 @@ 			) 		whenM (pure DirWatcher.eventsCoalesce <||> isDirect) $ do 			stageSymlink file =<< hashSymlink link-			showEndOk+		showEndOk 		return $ Just $ finishedChange change key  	{- Check that the keysource's keyFilename still exists,
Assistant/Threads/MountWatcher.hs view
@@ -157,7 +157,7 @@ handleMount dir = do 	debug ["detected mount of", dir] 	rs <- filter (Git.repoIsLocal . Remote.repo) <$> remotesUnder dir-	reconnectRemotes True rs+	reconnectRemotes True $ filter (not . remoteAnnexIgnore . Remote.gitconfig) rs  {- Finds remotes located underneath the mount point.  -
Assistant/Threads/NetWatcher.hs view
@@ -128,4 +128,4 @@ {- Finds network remotes. -} networkRemotes :: Assistant [Remote] networkRemotes = liftAnnex $-	filter (isNothing . Remote.localpath) <$> remoteList+	filter (isNothing . Remote.localpath) <$> enabledRemoteList
Assistant/Threads/Pusher.hs view
@@ -11,7 +11,6 @@ import Assistant.Commits import Assistant.Types.Commits import Assistant.Pushes-import Assistant.Alert import Assistant.DaemonStatus import Assistant.Sync import Utility.ThreadScheduler@@ -25,8 +24,7 @@ 	topush <- getFailedPushesBefore (fromIntegral halfhour) 	unless (null topush) $ do 		debug ["retrying", show (length topush), "failed pushes"]-		void $ alertWhile (pushRetryAlert topush) $-			pushToRemotes True topush+		void $ pushToRemotes True topush   where 	halfhour = 1800
Assistant/Threads/TransferScanner.hs view
@@ -12,7 +12,6 @@ import Assistant.ScanRemotes import Assistant.TransferQueue import Assistant.DaemonStatus-import Assistant.Alert import Assistant.Drop import Assistant.Sync import Logs.Transfer@@ -21,6 +20,7 @@ import qualified Remote import qualified Types.Remote as Remote import Utility.ThreadScheduler+import Utility.NotificationBroadcaster import qualified Git.LsFiles as LsFiles import qualified Backend import Annex.Content@@ -37,8 +37,10 @@ 	go S.empty   where 	go scanned = do+		scanrunning False 		liftIO $ threadDelaySeconds (Seconds 2) 		(rs, infos) <- unzip <$> getScanRemote+		scanrunning True 		if any fullScan infos || any (`S.notMember` scanned) rs 			then do 				expensiveScan rs@@ -46,6 +48,11 @@ 			else do 				mapM_ failedTransferScan rs 				go scanned+	scanrunning b = do+		ds <- modifyDaemonStatus $ \s -> +			(s { transferScanRunning = b }, s)+		liftIO $ sendNotification $ transferNotifier ds+		 	{- All git remotes are synced, and all available remotes 	 - are scanned in full on startup, for multiple reasons, including: 	 -@@ -100,15 +107,13 @@ expensiveScan :: [Remote] -> Assistant () expensiveScan rs = unless onlyweb $ do 	debug ["starting scan of", show visiblers]-	void $ alertWhile (scanAlert visiblers) $ do-		g <- liftAnnex gitRepo-		(files, cleanup) <- liftIO $ LsFiles.inRepo [] g-		forM_ files $ \f -> do-			ts <- maybe (return []) (findtransfers f)-				=<< liftAnnex (Backend.lookupFile f)-			mapM_ (enqueue f) ts-		void $ liftIO cleanup-		return True+	g <- liftAnnex gitRepo+	(files, cleanup) <- liftIO $ LsFiles.inRepo [] g+	forM_ files $ \f -> do+		ts <- maybe (return []) (findtransfers f)+			=<< liftAnnex (Backend.lookupFile f)+		mapM_ (enqueue f) ts+	void $ liftIO cleanup 	debug ["finished scan of", show visiblers]   where 	onlyweb = all (== webUUID) $ map Remote.uuid rs
Assistant/Threads/Transferrer.hs view
@@ -14,23 +14,23 @@ import Assistant.Alert import Assistant.Commits import Assistant.Drop+import Assistant.TransferrerPool import Logs.Transfer import Logs.Location import Annex.Content import qualified Remote-import Types.Key+import qualified Types.Remote as Remote+import qualified Git import Locations.UserConfig import Assistant.Threads.TransferWatcher import Annex.Wanted -import System.Process (create_group)- {- Dispatches transfers from the queue. -} transfererThread :: NamedThread transfererThread = namedThread "Transferrer" $ do 	program <- liftIO readProgramFile-	forever $ inTransferSlot $-		maybe (return Nothing) (uncurry $ startTransfer program)+	forever $ inTransferSlot program $+		maybe (return Nothing) (uncurry $ genTransfer) 			=<< getNextTransfer notrunning   where 	{- Skip transfers that are already running. -}@@ -38,50 +38,54 @@  {- By the time this is called, the daemonstatus's currentTransfers map should  - already have been updated to include the transfer. -}-startTransfer-	:: FilePath-	-> Transfer-	-> TransferInfo-	-> Assistant (Maybe (Transfer, TransferInfo, Assistant ()))-startTransfer program t info = case (transferRemote info, associatedFile info) of-	(Just remote, Just file) -> ifM (liftAnnex $ shouldTransfer t info)-		( do-			debug [ "Transferring:" , describeTransfer t info ]-			notifyTransfer-			return $ Just (t, info, transferprocess remote file)-		, do-			debug [ "Skipping unnecessary transfer:",-				describeTransfer t info ]+genTransfer :: Transfer -> TransferInfo -> TransferGenerator+genTransfer t info = case (transferRemote info, associatedFile info) of+	(Just remote, Just file) +		| Git.repoIsLocalUnknown (Remote.repo remote) -> do+			-- optimisation for removable drives not plugged in+			liftAnnex $ recordFailedTransfer t info 			void $ removeTransfer t-			finishedTransfer t (Just info) 			return Nothing-		)+		| otherwise -> ifM (liftAnnex $ shouldTransfer t info)+			( do+				debug [ "Transferring:" , describeTransfer t info ]+				notifyTransfer+				return $ Just (t, info, go remote file)+			, do+				debug [ "Skipping unnecessary transfer:",+					describeTransfer t info ]+				void $ removeTransfer t+				finishedTransfer t (Just info)+				return Nothing+			) 	_ -> return Nothing   where 	direction = transferDirection t 	isdownload = direction == Download -	transferprocess remote file = void $ do-		(_, _, _, pid)-			<- liftIO $ createProcess-				(proc program $ toCommand params)-					{ create_group = True }-		{- Alerts are only shown for successful transfers.-		 - Transfers can temporarily fail for many reasons,-		 - 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-		 - branch out to remotes that did not participate-		 - in the transfer.-		 -}-		whenM (liftIO $ (==) ExitSuccess <$> waitForProcess pid) $ do+	{- Alerts are only shown for successful transfers.+	 - Transfers can temporarily fail for many reasons,+	 - 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+	 - branch out to remotes that did not participate+	 - in the transfer.+	 -+	 - If the process failed, it could have crashed,+	 - so remove the transfer from the list of current+	 - transfers, just in case it didn't stop+	 - in a way that lets the TransferWatcher do its+	 - usual cleanup.+	 -}+	go remote file transferrer = ifM (liftIO $ performTransfer transferrer t $ associatedFile info)+		( do 			void $ addAlert $ makeAlertFiller True $ 				transferFileAlert direction True file 			unless isdownload $@@ -90,19 +94,9 @@ 					True (transferKey t) 					(associatedFile info) 					(Just remote)-			recordCommit-	  where-		params =-			[ Param "transferkey"-			, Param "--quiet"-			, Param $ key2file $ transferKey t-			, Param $ if isdownload-				then "--from"-				else "--to"-			, Param $ Remote.name remote-			, Param "--file"-			, File file-			]+			void $ recordCommit+		, void $ removeTransfer t+		)  {- Called right before a transfer begins, this is a last chance to avoid  - unnecessary transfers.
Assistant/Threads/WebApp.hs view
@@ -57,7 +57,6 @@ 		<*> (pack <$> genRandomToken) 		<*> getreldir 		<*> pure $(embed "static")-		<*> newWebAppState 		<*> pure postfirstrun 		<*> pure noannex 	setUrlRenderer urlrenderer $ yesodRender webapp (pack "")
Assistant/Threads/XMPPClient.hs view
@@ -1,6 +1,6 @@ {- git-annex XMPP client  -- - Copyright 2012 Joey Hess <joey@kitenet.net>+ - Copyright 2012, 2013 Joey Hess <joey@kitenet.net>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -19,7 +19,7 @@ import qualified Remote import Utility.ThreadScheduler import Assistant.WebApp (UrlRenderer, renderUrl)-import Assistant.WebApp.Types+import Assistant.WebApp.Types hiding (liftAssistant) import Assistant.Alert import Assistant.Pairing import Assistant.XMPP.Git@@ -33,10 +33,6 @@ import qualified Git.Branch import Data.Time.Clock -{- Whether to include verbose protocol dump in debug output. -}-protocolDebug :: Bool-protocolDebug = False- xmppClientThread :: UrlRenderer -> NamedThread xmppClientThread urlrenderer = namedThread "XMPPClient" $ 	restartableClient . xmppClient urlrenderer =<< getAssistant id@@ -96,8 +92,8 @@  	receivenotifications selfjid = forever $ do 		l <- decodeStanza selfjid <$> getStanza-		when protocolDebug $-			inAssistant $ debug ["received:", show l]+		inAssistant $ debug+			["received:", show $ map sanitizeXMPPEvent l] 		mapM_ (handle selfjid) l  	handle selfjid (PresenceMessage p) = do@@ -111,7 +107,7 @@ 	handle _ (GotNetMessage m@(Pushing _ pushstage)) 		| isPushInitiation pushstage = inAssistant $ 			unlessM (queueNetPushMessage m) $ -				void $ forkIO <~> handlePushInitiation m+				void $ forkIO <~> handlePushInitiation urlrenderer m 		| otherwise = void $ inAssistant $ queueNetPushMessage m 	handle _ (Ignorable _) = noop 	handle _ (Unknown _) = noop@@ -122,8 +118,13 @@ 		(stored, sent) <- inAssistant $ 			checkImportantNetMessages (formatJID (baseJID jid), c) 		forM_ (S.toList $ S.difference stored sent) $ \msg -> do-			inAssistant $ debug ["sending to new client:", show c, show msg]-			a <- inAssistant $ convertNetMsg (readdressNetMessage msg c) selfjid+			let msg' = readdressNetMessage msg c+			inAssistant $ debug+				[ "sending to new client:"+				, show c+				, show $ sanitizeNetMessage msg'+				]+			a <- inAssistant $ convertNetMsg msg' selfjid 			a 			inAssistant $ sentImportantNetMessage msg c 	resendImportantMessages _ _ = noop@@ -136,6 +137,10 @@ 	| ProtocolError ReceivedStanza 	deriving Show +sanitizeXMPPEvent :: XMPPEvent -> XMPPEvent+sanitizeXMPPEvent (GotNetMessage m) = GotNetMessage $ sanitizeNetMessage m+sanitizeXMPPEvent v = v+ {- Decodes an XMPP stanza into one or more events. -} decodeStanza :: JID -> ReceivedStanza -> [XMPPEvent] decodeStanza selfjid s@(ReceivedPresence p)@@ -173,24 +178,24 @@ relayNetMessage :: JID -> Assistant (XMPP ()) relayNetMessage selfjid = do 	msg <- waitNetMessage-	when protocolDebug $-		debug ["sending:", show msg]-	handleImportant msg-	convert msg+	debug ["sending:", show $ sanitizeNetMessage msg]+	a1 <- handleImportant msg+	a2 <- convert msg+	return (a1 >> a2)   where 	handleImportant msg = case parseJID =<< isImportantNetMessage msg of 		Just tojid-			| tojid == baseJID tojid ->+			| tojid == baseJID tojid -> do 				storeImportantNetMessage msg (formatJID tojid) $ 					\c -> (baseJID <$> parseJID c) == Just tojid-		_ -> noop+				return $ putStanza presenceQuery+		_ -> return noop 	convert (Pushing c pushstage) = withOtherClient selfjid c $ \tojid -> do 		if tojid == baseJID tojid 			then do 				clients <- maybe [] (S.toList . buddyAssistants) 					<$> getBuddy (genBuddyKey tojid) <<~ buddyList-				when protocolDebug $-					debug ["exploded undirected message to clients", show clients]+				debug ["exploded undirected message to clients", show clients] 				return $ forM_ (clients) $ \(Client jid) -> 					putStanza $ pushMessage pushstage jid selfjid 			else return $ putStanza $ pushMessage pushstage tojid selfjid@@ -251,7 +256,7 @@  	pullone [] _ = noop 	pullone (r:rs) branch =-		unlessM (all id . fst <$> manualPull branch [r]) $+		unlessM (null . fst <$> manualPull branch [r]) $ 			pullone rs branch  pairMsgReceived :: UrlRenderer -> PairStage -> UUID -> JID -> JID -> Assistant ()@@ -274,7 +279,8 @@ 		finishXMPPPairing theirjid theiruuid 	-- Show an alert to let the user decide if they want to pair. 	showalert = do-		let route = ConfirmXMPPPairR (PairKey theiruuid $ formatJID theirjid)+		let route = ConfirmXMPPPairFriendR $+			PairKey theiruuid $ formatJID theirjid 		url <- liftIO $ renderUrl urlrenderer route [] 		close <- asIO1 removeAlert 		void $ addAlert $ pairRequestReceivedAlert (T.unpack $ buddyName theirjid)
Assistant/TransferSlots.hs view
@@ -11,28 +11,30 @@ import Utility.ThreadScheduler import Assistant.Types.TransferSlots import Assistant.DaemonStatus+import Assistant.TransferrerPool+import Assistant.Types.TransferrerPool import Logs.Transfer  import qualified Control.Exception as E import Control.Concurrent import qualified Control.Concurrent.MSemN as MSemN -type TransferGenerator = Assistant (Maybe (Transfer, TransferInfo, Assistant ()))+type TransferGenerator = Assistant (Maybe (Transfer, TransferInfo, Transferrer -> Assistant ()))  {- Waits until a transfer slot becomes available, then runs a  - TransferGenerator, and then runs the transfer action in its own thread.   -}-inTransferSlot :: TransferGenerator -> Assistant ()-inTransferSlot gen = do+inTransferSlot :: FilePath -> TransferGenerator -> Assistant ()+inTransferSlot program gen = do 	flip MSemN.wait 1 <<~ transferSlots-	runTransferThread =<< gen+	runTransferThread program =<< gen  {- Runs a TransferGenerator, and its transfer action,  - without waiting for a slot to become available. -}-inImmediateTransferSlot :: TransferGenerator -> Assistant ()-inImmediateTransferSlot gen = do+inImmediateTransferSlot :: FilePath -> TransferGenerator -> Assistant ()+inImmediateTransferSlot program gen = do 	flip MSemN.signal (-1) <<~ transferSlots-	runTransferThread =<< gen+	runTransferThread program =<< gen  {- Runs a transfer action, in an already allocated transfer slot.  - Once it finishes, frees the transfer slot.@@ -44,19 +46,22 @@  - then pausing the thread until a ResumeTransfer exception is raised,  - then rerunning the action.  -}-runTransferThread :: Maybe (Transfer, TransferInfo, Assistant ()) -> Assistant ()-runTransferThread Nothing = flip MSemN.signal 1 <<~ transferSlots-runTransferThread (Just (t, info, a)) = do+runTransferThread :: FilePath -> Maybe (Transfer, TransferInfo, Transferrer -> Assistant ()) -> Assistant ()+runTransferThread _ Nothing = flip MSemN.signal 1 <<~ transferSlots+runTransferThread program (Just (t, info, a)) = do 	d <- getAssistant id-	aio <- asIO a-	tid <- liftIO $ forkIO $ runTransferThread' d aio+	aio <- asIO1 a+	tid <- liftIO $ forkIO $ runTransferThread' program d aio 	updateTransferInfo t $ info { transferTid = Just tid } -runTransferThread' :: AssistantData -> IO () -> IO ()-runTransferThread' d a = go+runTransferThread' :: FilePath -> AssistantData -> (Transferrer -> IO ()) -> IO ()+runTransferThread' program d run = go   where-	go = catchPauseResume a-	pause = catchPauseResume $ runEvery (Seconds 86400) noop+	go = catchPauseResume $+		withTransferrer program (transferrerPool d)+			run+	pause = catchPauseResume $+		runEvery (Seconds 86400) noop 	{- Note: This must use E.try, rather than E.catch. 	 - When E.catch is used, and has called go in its exception 	 - handler, Control.Concurrent.throwTo will block sometimes
+ Assistant/TransferrerPool.hs view
@@ -0,0 +1,83 @@+{- A pool of "git-annex transferkeys" processes+ -+ - Copyright 2013 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Assistant.TransferrerPool where++import Assistant.Common+import Assistant.Types.TransferrerPool+import Logs.Transfer+import qualified Command.TransferKeys as T++import Control.Concurrent.STM+import System.Process (create_group)+import Control.Exception (throw)+import Control.Concurrent+import Types.Remote (AssociatedFile)++{- Runs an action with a Transferrer from the pool. -}+withTransferrer :: FilePath -> TransferrerPool -> (Transferrer -> IO a) -> IO a+withTransferrer program pool a = do+	t <- maybe (mkTransferrer program) (checkTransferrer program)+		=<< atomically (tryReadTChan pool)+	v <- tryNonAsync $ a t+	unlessM (putback t) $+		void $ forkIO $ stopTransferrer t+	either throw return v+  where+  	putback t = atomically $ ifM (isEmptyTChan pool)+		( do+			writeTChan pool t+			return True+		, return False+		)++{- Requests that a Transferrer perform a Transfer, and waits for it to+ - finish. -}+performTransfer :: Transferrer -> Transfer -> AssociatedFile -> IO Bool+performTransfer transferrer t f = catchBoolIO $ do+	T.sendRequest t f (transferrerWrite transferrer)+	T.readResponse (transferrerRead transferrer)++{- Starts a new git-annex transferkeys process, setting up a pipe+ - that will be used to communicate with it. -}+mkTransferrer :: FilePath -> IO Transferrer+mkTransferrer program = do+	(myread, twrite) <- createPipe+	(tread, mywrite) <- createPipe+	mapM_ (\fd -> setFdOption fd CloseOnExec True) [myread, mywrite]+	let params =+		[ Param "transferkeys"+		, Param "--readfd", Param $ show tread+		, Param "--writefd", Param $ show twrite+		]+	{- It's put into its own group so that the whole group can be+	 - killed to stop a transfer. -}+	(_, _, _, pid) <- createProcess (proc program $ toCommand params)+		{ create_group = True }+	closeFd twrite+	closeFd tread+	myreadh <- fdToHandle myread+	mywriteh <- fdToHandle mywrite+	fileEncoding myreadh+	fileEncoding mywriteh+	return $ Transferrer+		{ transferrerRead = myreadh+		, transferrerWrite = mywriteh+		, transferrerHandle = pid+		}++{- Checks if a Transferrer is still running. If not, makes a new one. -}+checkTransferrer :: FilePath -> Transferrer -> IO Transferrer+checkTransferrer program t = maybe (return t) (const $ mkTransferrer program)+	=<< getProcessExitCode (transferrerHandle t)++{- Closing the fds will stop the transferrer. -}+stopTransferrer :: Transferrer -> IO ()+stopTransferrer t = do+	hClose $ transferrerRead t+	hClose $ transferrerWrite t+	void $ waitForProcess $ transferrerHandle t
Assistant/Types/DaemonStatus.hs view
@@ -35,6 +35,8 @@ 	, sanityCheckRunning :: Bool 	-- Last time the sanity checker ran 	, lastSanityCheck :: Maybe POSIXTime+	-- True when a scan for file transfers is running+	, transferScanRunning :: Bool 	-- Currently running file content transfers 	, currentTransfers :: TransferMap 	-- Messages to display to the user.@@ -46,6 +48,8 @@ 	, syncGitRemotes :: [Remote] 	-- Ordered list of remotes to sync data with 	, syncDataRemotes :: [Remote]+	-- Are we syncing to any cloud remotes?+	, syncingToCloudRemote :: Bool 	-- List of uuids of remotes that we may have gotten out of sync with. 	, desynced :: S.Set UUID 	-- Pairing request that is in progress.@@ -75,12 +79,14 @@ 	<*> pure Nothing 	<*> pure False 	<*> pure Nothing+	<*> pure False 	<*> pure M.empty 	<*> pure M.empty 	<*> pure firstAlertId 	<*> pure [] 	<*> pure [] 	<*> pure []+	<*> pure False 	<*> pure S.empty 	<*> pure Nothing 	<*> newNotificationBroadcaster
Assistant/Types/NetMessager.hs view
@@ -14,6 +14,7 @@ import Control.Concurrent.STM import Control.Concurrent.MSampleVar import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as B8 import qualified Data.Set as S import qualified Data.Map as M @@ -59,6 +60,16 @@ readdressNetMessage (PairingNotification stage _ uuid) c = PairingNotification stage c uuid readdressNetMessage (Pushing _ stage) c = Pushing c stage readdressNetMessage m _ = m++{- Convert a NetMessage to something that can be logged. -}+sanitizeNetMessage :: NetMessage -> NetMessage+sanitizeNetMessage (Pushing c stage) = Pushing c $ case stage of+	ReceivePackOutput _ -> ReceivePackOutput elided+	SendPackOutput _ -> SendPackOutput elided+	s -> s+  where+  	elided = B8.pack "<elided>"+sanitizeNetMessage m = m  {- Things that initiate either side of a push, but do not actually send data. -} isPushInitiation :: PushStage -> Bool
+ Assistant/Types/TransferrerPool.hs view
@@ -0,0 +1,23 @@+{- A pool of "git-annex transferkeys" processes+ -+ - Copyright 2013 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Assistant.Types.TransferrerPool where++import Common.Annex++import Control.Concurrent.STM++type TransferrerPool = TChan Transferrer++data Transferrer = Transferrer+	{ transferrerRead :: Handle+	, transferrerWrite :: Handle+	, transferrerHandle :: ProcessHandle+	}++newTransferrerPool :: IO TransferrerPool+newTransferrerPool = newTChanIO
Assistant/WebApp.hs view
@@ -1,57 +1,26 @@ {- git-annex assistant webapp core  -- - Copyright 2012 Joey Hess <joey@kitenet.net>+ - Copyright 2012, 2013 Joey Hess <joey@kitenet.net>  -  - Licensed under the GNU AGPL version 3 or higher.  -} -{-# LANGUAGE TypeFamilies, QuasiQuotes, MultiParamTypeClasses, TemplateHaskell, OverloadedStrings, RankNTypes #-}+{-# LANGUAGE TypeFamilies, QuasiQuotes, MultiParamTypeClasses #-}+{-# LANGUAGE TemplateHaskell, OverloadedStrings, RankNTypes #-}  module Assistant.WebApp where  import Assistant.WebApp.Types-import Assistant.Common hiding (liftAnnex)-import qualified Assistant.Monad as Assistant+import Assistant.Common import Utility.NotificationBroadcaster import Utility.Yesod  import Yesod import Data.Text (Text)-import Control.Concurrent.STM import Control.Concurrent--inFirstRun :: Handler Bool-inFirstRun = isNothing . relDir <$> getYesod--newWebAppState :: IO (TMVar WebAppState)-newWebAppState = atomically $ newTMVar $ WebAppState { showIntro = True }--getWebAppState :: forall sub. GHandler sub WebApp WebAppState-getWebAppState = liftIO . atomically . readTMVar =<< webAppState <$> getYesod--modifyWebAppState :: forall sub. (WebAppState -> WebAppState) -> GHandler sub WebApp ()-modifyWebAppState a = go =<< webAppState <$> getYesod-  where-	go s = liftIO $ atomically $ do-		v <- takeTMVar s-		putTMVar s $ a v--{- Runs an Annex action from the webapp.- -- - When the webapp is run outside a git-annex repository, the fallback- - value is returned.- -}-liftAnnexOr :: forall sub a. a -> Annex a -> GHandler sub WebApp a-liftAnnexOr fallback a = ifM (noAnnex <$> getYesod)-	( return fallback-	, liftAssistant $ Assistant.liftAnnex a-	)--liftAnnex :: forall sub a. Annex a -> GHandler sub WebApp a-liftAnnex = liftAnnexOr $ error "internal runAnnex"--liftAssistant :: forall sub a. (Assistant a) -> GHandler sub WebApp a-liftAssistant a = liftIO . flip runAssistant a =<< assistantData <$> getYesod+import qualified Network.Wai as W+import qualified Data.ByteString.Char8 as S8+import qualified Data.Text as T  waitNotifier :: forall sub. (Assistant NotificationBroadcaster) -> NotificationId -> GHandler sub WebApp () waitNotifier getbroadcaster nid = liftAssistant $ do@@ -87,6 +56,9 @@ setUrlRenderer :: UrlRenderer -> (UrlRenderFunc) -> IO () setUrlRenderer = putMVar +inFirstRun :: Handler Bool+inFirstRun = isNothing . relDir <$> getYesod+ {- Blocks until the webapp is running and has called setUrlRenderer. -} renderUrl :: UrlRenderer -> Route WebApp -> [(Text, Text)] -> IO Text renderUrl urlrenderer route params = do@@ -96,9 +68,7 @@ {- Redirects back to the referring page, or if there's none, DashboardR -} redirectBack :: Handler () redirectBack = do-	clearUltDest-	setUltDestReferer-	redirectUltDest DashboardR--controlMenu :: Widget-controlMenu = $(widgetFile "controlmenu")+	mr <- lookup "referer" . W.requestHeaders <$> waiRequest+	case mr of+		Nothing -> redirect DashboardR+		Just r -> redirect $ T.pack $ S8.unpack r
Assistant/WebApp/Common.hs view
@@ -7,7 +7,7 @@  module Assistant.WebApp.Common (module X) where -import Assistant.Common as X hiding (liftAnnex)+import Assistant.Common as X import Assistant.WebApp as X import Assistant.WebApp.Page as X import Assistant.WebApp.Form as X
Assistant/WebApp/Configurators.hs view
@@ -10,7 +10,7 @@ module Assistant.WebApp.Configurators where  import Assistant.WebApp.Common-import Assistant.WebApp.Configurators.Local+import Assistant.WebApp.RepoList #ifdef WITH_XMPP import Assistant.XMPP.Client #endif@@ -18,12 +18,23 @@ {- The main configuration screen. -} getConfigurationR :: Handler RepHtml getConfigurationR = ifM (inFirstRun)-	( getFirstRepositoryR+	( redirect FirstRepositoryR 	, page "Configuration" (Just Configuration) $ do #ifdef WITH_XMPP-		xmppconfigured <- lift $ liftAnnex $ isJust <$> getXMPPCreds+		xmppconfigured <- liftAnnex $ isJust <$> getXMPPCreds #else 		let xmppconfigured = False #endif 		$(widgetFile "configurators/main") 	)++getAddRepositoryR :: Handler RepHtml+getAddRepositoryR = page "Add Repository" (Just Configuration) $ do+	let repolist = repoListDisplay mainRepoSelector+	$(widgetFile "configurators/addrepository")++makeMiscRepositories :: Widget+makeMiscRepositories = $(widgetFile "configurators/addrepository/misc")++makeCloudRepositories :: Bool -> Widget+makeCloudRepositories onlyTransfer = $(widgetFile "configurators/addrepository/cloud")
Assistant/WebApp/Configurators/AWS.hs view
@@ -108,10 +108,13 @@ 	defregion = Just $ AWS.defaultRegion service  getAddS3R :: Handler RepHtml+getAddS3R = postAddS3R++postAddS3R :: Handler RepHtml #ifdef WITH_S3-getAddS3R = awsConfigurator $ do+postAddS3R = awsConfigurator $ do 	((result, form), enctype) <- lift $-		runFormGet $ renderBootstrap s3InputAForm+		runFormPost $ renderBootstrap s3InputAForm 	case result of 		FormSuccess input -> lift $ do 			let name = T.unpack $ repoName input@@ -126,13 +129,16 @@ 	setgroup r = liftAnnex $ 		setStandardGroup (Remote.uuid r) TransferGroup #else-getAddS3R = error "S3 not supported by this build"+postAddS3R = error "S3 not supported by this build" #endif  getAddGlacierR :: Handler RepHtml-getAddGlacierR = glacierConfigurator $ do+getAddGlacierR = postAddGlacierR++postAddGlacierR :: Handler RepHtml+postAddGlacierR = glacierConfigurator $ do 	((result, form), enctype) <- lift $-		runFormGet $ renderBootstrap glacierInputAForm+		runFormPost $ renderBootstrap glacierInputAForm 	case result of 		FormSuccess input -> lift $ do 			let name = T.unpack $ repoName input@@ -143,23 +149,29 @@ 				] 		_ -> $(widgetFile "configurators/addglacier")   where-	setgroup r = liftAnnex $+	setgroup r = liftAnnex $  		setStandardGroup (Remote.uuid r) SmallArchiveGroup  getEnableS3R :: UUID -> Handler RepHtml+getEnableS3R = postEnableS3R++postEnableS3R :: UUID -> Handler RepHtml #ifdef WITH_S3-getEnableS3R = awsConfigurator . enableAWSRemote S3.remote+postEnableS3R = awsConfigurator . enableAWSRemote S3.remote #else-getEnableS3R _ = error "S3 not supported by this build"+postEnableS3R _ = error "S3 not supported by this build" #endif  getEnableGlacierR :: UUID -> Handler RepHtml-getEnableGlacierR = glacierConfigurator . enableAWSRemote Glacier.remote+getEnableGlacierR = postEnableGlacierR +postEnableGlacierR :: UUID -> Handler RepHtml+postEnableGlacierR = glacierConfigurator . enableAWSRemote Glacier.remote+ enableAWSRemote :: RemoteType -> UUID -> Widget enableAWSRemote remotetype uuid = do 	((result, form), enctype) <- lift $-		runFormGet $ renderBootstrap awsCredsAForm+		runFormPost $ renderBootstrap awsCredsAForm 	case result of 		FormSuccess creds -> lift $ do 			m <- liftAnnex readRemoteLog@@ -167,7 +179,7 @@ 				fromJust $ M.lookup uuid m 			makeAWSRemote remotetype creds name (const noop) M.empty 		_ -> do-			description <- lift $ liftAnnex $+			description <- liftAnnex $ 				T.pack . concat <$> Remote.prettyListUUIDs [uuid] 			$(widgetFile "configurators/enableaws")
Assistant/WebApp/Configurators/Edit.hs view
@@ -109,26 +109,35 @@ 	help = [whamlet|<a href="@{RepoGroupR}">What's this?</a>|]  getEditRepositoryR :: UUID -> Handler RepHtml-getEditRepositoryR = editForm False+getEditRepositoryR = postEditRepositoryR +postEditRepositoryR :: UUID -> Handler RepHtml+postEditRepositoryR = editForm False+ getEditNewRepositoryR :: UUID -> Handler RepHtml-getEditNewRepositoryR = editForm True+getEditNewRepositoryR = postEditNewRepositoryR +postEditNewRepositoryR :: UUID -> Handler RepHtml+postEditNewRepositoryR = editForm True+ getEditNewCloudRepositoryR :: UUID -> Handler RepHtml-getEditNewCloudRepositoryR uuid = xmppNeeded >> editForm True uuid+getEditNewCloudRepositoryR = postEditNewCloudRepositoryR +postEditNewCloudRepositoryR :: UUID -> Handler RepHtml+postEditNewCloudRepositoryR uuid = xmppNeeded >> editForm True uuid+ editForm :: Bool -> UUID -> Handler RepHtml editForm new uuid = page "Configure repository" (Just Configuration) $ do-	mremote <- lift $ liftAnnex $ Remote.remoteFromUUID uuid-	curr <- lift $ liftAnnex $ getRepoConfig uuid mremote+	mremote <- liftAnnex $ Remote.remoteFromUUID uuid+	curr <- liftAnnex $ getRepoConfig uuid mremote 	lift $ checkarchivedirectory curr 	((result, form), enctype) <- lift $-		runFormGet $ renderBootstrap $ editRepositoryAForm curr+		runFormPost $ renderBootstrap $ editRepositoryAForm curr 	case result of 		FormSuccess input -> lift $ do 			checkarchivedirectory input 			setRepoConfig uuid mremote curr input-			redirect RepositoriesR+			redirect DashboardR 		_ -> showform form enctype curr   where 	showform form enctype curr = do
Assistant/WebApp/Configurators/Local.hs view
@@ -31,10 +31,12 @@ import Annex.UUID import Types.StandardGroups import Logs.PreferredContent+import Logs.UUID import Utility.UserInfo import Config  import qualified Data.Text as T+import qualified Data.Map as M import Data.Char import System.Posix.Directory @@ -127,9 +129,11 @@  {- Making the first repository, when starting the webapp for the first time. -} getFirstRepositoryR :: Handler RepHtml-getFirstRepositoryR = page "Getting started" (Just Configuration) $ do+getFirstRepositoryR = postFirstRepositoryR+postFirstRepositoryR :: Handler RepHtml+postFirstRepositoryR = page "Getting started" (Just Configuration) $ do 	path <- liftIO . defaultRepositoryPath =<< lift inFirstRun-	((res, form), enctype) <- lift $ runFormGet $ newRepositoryForm path+	((res, form), enctype) <- lift $ runFormPost $ newRepositoryForm path 	case res of 		FormSuccess (RepositoryPath p) -> lift $ 			startFullAssistant $ T.unpack p@@ -138,9 +142,11 @@ {- Adding a new local repository, which may be entirely separate, or may  - be connected to the current repository. -} getNewRepositoryR :: Handler RepHtml-getNewRepositoryR = page "Add another repository" (Just Configuration) $ do+getNewRepositoryR = postNewRepositoryR+postNewRepositoryR :: Handler RepHtml+postNewRepositoryR = page "Add another repository" (Just Configuration) $ do 	home <- liftIO myHomeDir-	((res, form), enctype) <- lift $ runFormGet $ newRepositoryForm home+	((res, form), enctype) <- lift $ runFormPost $ newRepositoryForm home 	case res of 		FormSuccess (RepositoryPath p) -> do 			let path = T.unpack p@@ -165,16 +171,12 @@   where 	remotename = takeFileName newrepopath -data RemovableDrive = RemovableDrive -	{ diskFree :: Maybe Integer-	, mountPoint :: Text-	}-	deriving (Show, Eq, Ord)--selectDriveForm :: [RemovableDrive] -> Maybe RemovableDrive -> Form RemovableDrive-selectDriveForm drives def = renderBootstrap $ RemovableDrive+selectDriveForm :: [RemovableDrive] -> Form RemovableDrive+selectDriveForm drives = renderBootstrap $ RemovableDrive 	<$> pure Nothing-	<*> areq (selectFieldList pairs) "Select drive:" (mountPoint <$> def)+	<*> areq (selectFieldList pairs) "Select drive:" Nothing+	<*> areq textField "Use this directory on the drive:"+		(Just $ T.pack gitAnnexAssistantDefaultDir)   where 	pairs = zip (map describe drives) (map mountPoint drives) 	describe drive = case diskFree drive of@@ -187,24 +189,56 @@ 				, "free)" 				] -{- Adding a removable drive.- -- - The repo may already exist, when adding removable media- - that has already been used elsewhere.- -}+removableDriveRepository :: RemovableDrive -> FilePath+removableDriveRepository drive =+	T.unpack (mountPoint drive) </> T.unpack (driveRepoPath drive)++{- Adding a removable drive. -} getAddDriveR :: Handler RepHtml-getAddDriveR = page "Add a removable drive" (Just Configuration) $ do+getAddDriveR = postAddDriveR+postAddDriveR :: Handler RepHtml+postAddDriveR = page "Add a removable drive" (Just Configuration) $ do 	removabledrives <- liftIO $ driveList 	writabledrives <- liftIO $ 		filterM (canWrite . T.unpack . mountPoint) removabledrives-	((res, form), enctype) <- lift $ runFormGet $-		selectDriveForm (sort writabledrives) Nothing+	((res, form), enctype) <- lift $ runFormPost $+		selectDriveForm (sort writabledrives) 	case res of-		FormSuccess (RemovableDrive { mountPoint = d }) -> lift $-			make (T.unpack d) >>= redirect . EditNewRepositoryR+		FormSuccess drive -> lift $ redirect $ ConfirmAddDriveR drive 		_ -> $(widgetFile "configurators/adddrive")++{- The repo may already exist, when adding removable media+ - that has already been used elsewhere. If so, check+ - the UUID of the repo and see if it's one we know. If not,+ - the user must confirm the repository merge. -}+getConfirmAddDriveR :: RemovableDrive -> Handler RepHtml+getConfirmAddDriveR drive = do+	ifM (needconfirm)+		( page "Combine repositories?" (Just Configuration) $+			$(widgetFile "configurators/adddrive/confirm")+		, do+			getFinishAddDriveR drive+		)   where-	make mountpoint = do+  	dir = removableDriveRepository drive+	needconfirm = ifM (liftIO $ doesDirectoryExist dir)+		( liftAnnex $ do+			mu <- liftIO $ catchMaybeIO $+				inDir dir $ getUUID+			case mu of+				Nothing -> return False+				Just driveuuid -> not .+					M.member driveuuid <$> uuidMap+		, return False+		)++cloneModal :: Widget+cloneModal = $(widgetFile "configurators/adddrive/clonemodal")++getFinishAddDriveR :: RemovableDrive -> Handler RepHtml+getFinishAddDriveR drive = make >>= redirect . EditNewRepositoryR+  where+  	make = do 		liftIO $ createDirectoryIfMissing True dir 		isnew <- liftIO $ makeRepo dir True 		u <- liftIO $ initRepo isnew False dir $ Just remotename@@ -212,9 +246,9 @@ 		liftAnnex $ setStandardGroup u TransferGroup 		syncRemote r 		return u-	  where-		dir = mountpoint </> gitAnnexAssistantDefaultDir-		remotename = takeFileName mountpoint+  	mountpoint = T.unpack (mountPoint drive)+	dir = removableDriveRepository drive+	remotename = takeFileName mountpoint  {- Each repository is made a remote of the other.  - Next call syncRemote to get them in sync. -}@@ -227,7 +261,7 @@  getEnableDirectoryR :: UUID -> Handler RepHtml getEnableDirectoryR uuid = page "Enable a repository" (Just Configuration) $ do-	description <- lift $ liftAnnex $+	description <- liftAnnex $ 		T.pack . concat <$> prettyListUUIDs [uuid] 	$(widgetFile "configurators/enabledirectory") @@ -239,6 +273,7 @@ 	gen dir = RemovableDrive 		<$> getDiskFree dir 		<*> pure (T.pack dir)+		<*> pure (T.pack gitAnnexAssistantDefaultDir) 	-- filter out some things that are surely not removable drives 	sane Mntent { mnt_dir = dir, mnt_fsname = dev } 		{- We want real disks like /dev/foo, not
Assistant/WebApp/Configurators/Pairing.hs view
@@ -12,6 +12,7 @@  import Assistant.Pairing import Assistant.WebApp.Common+import Assistant.WebApp.Configurators import Assistant.Types.Buddies #ifdef WITH_PAIRING import Assistant.Pairing.Network@@ -24,7 +25,6 @@ import Annex.UUID #endif #ifdef WITH_XMPP-import Assistant.XMPP import Assistant.XMPP.Client import Assistant.XMPP.Buddies import Assistant.XMPP.Git@@ -49,54 +49,95 @@ import qualified Data.Set as S #endif -getStartXMPPPairR :: Handler RepHtml+getStartXMPPPairFriendR :: Handler RepHtml #ifdef WITH_XMPP-getStartXMPPPairR = ifM (isJust <$> liftAnnex getXMPPCreds)+getStartXMPPPairFriendR = ifM (isJust <$> liftAnnex getXMPPCreds) 	( do 		{- Ask buddies to send presence info, to get 		 - the buddy list populated. -} 		liftAssistant $ sendNetMessage QueryPresence 		pairPage $-			$(widgetFile "configurators/pairing/xmpp/prompt")-	, redirect XMPPR -- go get XMPP configured, then come back+			$(widgetFile "configurators/pairing/xmpp/friend/prompt")+	, do+		-- go get XMPP configured, then come back+		setUltDestCurrent+		redirect XMPPR 	) #else-getStartXMPPPairR = noXMPPPairing+getStartXMPPPairFriendR = noXMPPPairing  noXMPPPairing :: Handler RepHtml noXMPPPairing = noPairing "XMPP" #endif -{- Does pairing with an XMPP buddy, or with other clients sharing an- - XMPP account. -}-getRunningXMPPPairR :: BuddyKey -> Handler RepHtml+getStartXMPPPairSelfR :: Handler RepHtml #ifdef WITH_XMPP-getRunningXMPPPairR bid = do+getStartXMPPPairSelfR = go =<< liftAnnex getXMPPCreds+  where+  	go Nothing = do+		-- go get XMPP configured, then come back+		setUltDestCurrent+		redirect XMPPR+	go (Just creds) = do+		{- Ask buddies to send presence info, to get+		 - the buddy list populated. -}+		liftAssistant $ sendNetMessage QueryPresence+		let account = xmppJID creds+		pairPage $+			$(widgetFile "configurators/pairing/xmpp/self/prompt")+#else+getStartXMPPPairSelfR = noXMPPPairing++noXMPPPairing :: Handler RepHtml+noXMPPPairing = noPairing "XMPP"+#endif++getRunningXMPPPairFriendR :: BuddyKey -> Handler RepHtml+getRunningXMPPPairFriendR = sendXMPPPairRequest . Just++getRunningXMPPPairSelfR :: Handler RepHtml+getRunningXMPPPairSelfR = sendXMPPPairRequest Nothing++{- Sends a XMPP pair request, to a buddy or to self. -}+sendXMPPPairRequest :: Maybe BuddyKey -> Handler RepHtml+#ifdef WITH_XMPP+sendXMPPPairRequest mbid = do+	bid <- maybe getself return mbid 	buddy <- liftAssistant $ getBuddy bid <<~ buddyList 	go $ S.toList . buddyAssistants <$> buddy   where 	go (Just (clients@((Client exemplar):_))) = do-		creds <- liftAnnex getXMPPCreds-		let ourjid = fromJust $ parseJID =<< xmppJID <$> creds-		let samejid = baseJID ourjid == baseJID exemplar 		u <- liftAnnex getUUID 		liftAssistant $ forM_ clients $ \(Client c) -> sendNetMessage $ 			PairingNotification PairReq (formatJID c) u-		xmppPairEnd True $ if samejid then Nothing else Just exemplar-	-- A buddy could have logged out, or the XMPP client restarted,-	-- and there be no clients to message; handle unforseen by going back.-	go _ = redirect StartXMPPPairR+		xmppPairStatus True $+			if selfpair then Nothing else Just exemplar+	go _+		{- Nudge the user to turn on their other device. -}+		| selfpair = do+			liftAssistant $ sendNetMessage QueryPresence+			pairPage $+				$(widgetFile "configurators/pairing/xmpp/self/retry")+		{- Buddy could have logged out, etc.+		 - Go back to buddy list. -}+		| otherwise = redirect StartXMPPPairFriendR+	selfpair = isNothing mbid+	getself = maybe (error "XMPP not configured")+			(return . BuddyKey . xmppJID)+				=<< liftAnnex getXMPPCreds #else-getRunningXMPPPairR _ = noXMPPPairing+sendXMPPPairRequest _ = noXMPPPairing #endif  {- Starts local pairing. -} getStartLocalPairR :: Handler RepHtml+getStartLocalPairR = postStartLocalPairR+postStartLocalPairR :: Handler RepHtml #ifdef WITH_PAIRING-getStartLocalPairR = promptSecret Nothing $+postStartLocalPairR = promptSecret Nothing $ 	startLocalPairing PairReq noop pairingAlert Nothing #else-getStartLocalPairR = noLocalPairing+postStartLocalPairR = noLocalPairing  noLocalPairing :: Handler RepHtml noLocalPairing = noPairing "local"@@ -106,8 +147,10 @@  - authorized key first so that the originating host can immediately sync  - with us. -} getFinishLocalPairR :: PairMsg -> Handler RepHtml+getFinishLocalPairR = postFinishLocalPairR+postFinishLocalPairR :: PairMsg -> Handler RepHtml #ifdef WITH_PAIRING-getFinishLocalPairR msg = promptSecret (Just msg) $ \_ secret -> do+postFinishLocalPairR msg = promptSecret (Just msg) $ \_ secret -> do 	repodir <- lift $ repoPath <$> liftAnnex gitRepo 	liftIO $ setup repodir 	startLocalPairing PairAck (cleanup repodir) alert uuid "" secret@@ -118,23 +161,23 @@ 		remoteSshPubKey $ pairMsgData msg 	uuid = Just $ pairUUID $ pairMsgData msg #else-getFinishLocalPairR _ = noLocalPairing+postFinishLocalPairR _ = noLocalPairing #endif -getConfirmXMPPPairR :: PairKey -> Handler RepHtml+getConfirmXMPPPairFriendR :: PairKey -> Handler RepHtml #ifdef WITH_XMPP-getConfirmXMPPPairR pairkey@(PairKey _ t) = case parseJID t of+getConfirmXMPPPairFriendR pairkey@(PairKey _ t) = case parseJID t of 	Nothing -> error "bad JID" 	Just theirjid -> pairPage $ do 		let name = buddyName theirjid-		$(widgetFile "configurators/pairing/xmpp/confirm")+		$(widgetFile "configurators/pairing/xmpp/friend/confirm") #else-getConfirmXMPPPairR _ = noXMPPPairing+getConfirmXMPPPairFriendR _ = noXMPPPairing #endif -getFinishXMPPPairR :: PairKey -> Handler RepHtml+getFinishXMPPPairFriendR :: PairKey -> Handler RepHtml #ifdef WITH_XMPP-getFinishXMPPPairR (PairKey theiruuid t) = case parseJID t of+getFinishXMPPPairFriendR (PairKey theiruuid t) = case parseJID t of 	Nothing -> error "bad JID" 	Just theirjid -> do 		selfuuid <- liftAnnex getUUID@@ -142,20 +185,17 @@ 			sendNetMessage $ 				PairingNotification PairAck (formatJID theirjid) selfuuid 			finishXMPPPairing theirjid theiruuid-		xmppPairEnd False $ Just theirjid+		xmppPairStatus False $ Just theirjid #else getFinishXMPPPairR _ = noXMPPPairing #endif +{- Displays a page indicating pairing status and + - prompting to set up cloud repositories. -} #ifdef WITH_XMPP-xmppPairEnd :: Bool -> Maybe JID -> Handler RepHtml-xmppPairEnd inprogress theirjid = pairPage $ do+xmppPairStatus :: Bool -> Maybe JID -> Handler RepHtml+xmppPairStatus inprogress theirjid = pairPage $ do 	let friend = buddyName <$> theirjid-	let cloudrepolist = repoListDisplay $ RepoSelector-		{ onlyCloud = True-		, onlyConfigured = False-		, includeHere = False-		} 	$(widgetFile "configurators/pairing/xmpp/end") #endif @@ -184,10 +224,10 @@ 	urlrender <- lift getUrlRender 	reldir <- fromJust . relDir <$> lift getYesod -	sendrequests <- lift $ liftAssistant $ asIO2 $ mksendrequests urlrender+	sendrequests <- liftAssistant $ asIO2 $ mksendrequests urlrender 	{- Generating a ssh key pair can take a while, so do it in the 	 - background. -}-	thread <- lift $ liftAssistant $ asIO $ do+	thread <- liftAssistant $ asIO $ do 		keypair <- liftIO $ genSshKeyPair 		pairdata <- liftIO $ PairData 			<$> getHostname@@ -230,7 +270,7 @@ promptSecret :: Maybe PairMsg -> (Text -> Secret -> Widget) -> Handler RepHtml promptSecret msg cont = pairPage $ do 	((result, form), enctype) <- lift $-		runFormGet $ renderBootstrap $+		runFormPost $ renderBootstrap $ 			InputSecret <$> aopt textField "Secret phrase" Nothing 	case result of 		FormSuccess v -> do
Assistant/WebApp/Configurators/Preferences.hs view
@@ -8,7 +8,8 @@ {-# LANGUAGE QuasiQuotes, TemplateHaskell, OverloadedStrings #-}  module Assistant.WebApp.Configurators.Preferences (-	getPreferencesR+	getPreferencesR,+	postPreferencesR ) where  import Assistant.WebApp.Common@@ -82,10 +83,12 @@ 		if debugEnabled p then DEBUG else WARNING  getPreferencesR :: Handler RepHtml-getPreferencesR = page "Preferences" (Just Configuration) $ do+getPreferencesR = postPreferencesR+postPreferencesR :: Handler RepHtml+postPreferencesR = page "Preferences" (Just Configuration) $ do 	((result, form), enctype) <- lift $ do 		current <- liftAnnex getPrefs-		runFormGet $ renderBootstrap $ prefsAForm current+		runFormPost $ renderBootstrap $ prefsAForm current 	case result of 		FormSuccess new -> lift $ do 			liftAnnex $ storePrefs new
Assistant/WebApp/Configurators/Ssh.hs view
@@ -49,6 +49,14 @@ 	, rsyncOnly = False 	} +mkSshInput :: SshData -> SshInput+mkSshInput s = SshInput+	{ inputHostname = Just $ sshHostName s+	, inputUsername = sshUserName s+	, inputDirectory = Just $ sshDirectory s+	, inputPort = sshPort s+	}+ sshInputAForm :: (Field WebApp WebApp Text) -> SshInput -> AForm WebApp WebApp SshInput sshInputAForm hostnamefield def = SshInput 	<$> aopt check_hostname "Host name" (Just $ inputHostname def)@@ -89,10 +97,12 @@ usable UsableSshInput = True  getAddSshR :: Handler RepHtml-getAddSshR = sshConfigurator $ do+getAddSshR = postAddSshR+postAddSshR :: Handler RepHtml+postAddSshR = sshConfigurator $ do 	u <- liftIO $ T.pack <$> myUserName 	((result, form), enctype) <- lift $-		runFormGet $ renderBootstrap $ sshInputAForm textField $+		runFormPost $ renderBootstrap $ sshInputAForm textField $ 			SshInput Nothing (Just u) Nothing 22 	case result of 		FormSuccess sshinput -> do@@ -104,6 +114,9 @@   where 	showform form enctype status = $(widgetFile "configurators/ssh/add") +sshTestModal :: Widget+sshTestModal = $(widgetFile "configurators/ssh/testmodal")+ {- To enable an existing rsync special remote, parse the SshInput from  - its rsyncurl, and display a form whose only real purpose is to check  - if ssh public keys need to be set up. From there, we can proceed with@@ -113,12 +126,14 @@  - remotes, and so their configuration is not shared between repositories.  -} getEnableRsyncR :: UUID -> Handler RepHtml-getEnableRsyncR u = do+getEnableRsyncR = postEnableRsyncR+postEnableRsyncR :: UUID -> Handler RepHtml+postEnableRsyncR u = do 	m <- fromMaybe M.empty . M.lookup u <$> liftAnnex readRemoteLog 	case (parseSshRsyncUrl =<< M.lookup "rsyncurl" m, M.lookup "name" m) of 		(Just sshinput, Just reponame) -> sshConfigurator $ do 			((result, form), enctype) <- lift $-				runFormGet $ renderBootstrap $ sshInputAForm textField sshinput+				runFormPost $ renderBootstrap $ sshInputAForm textField sshinput 			case result of 				FormSuccess sshinput' 					| isRsyncNet (inputHostname sshinput') ->@@ -133,7 +148,7 @@ 		_ -> redirect AddSshR   where 	showform form enctype status = do-		description <- lift $ liftAnnex $+		description <- liftAnnex $ 			T.pack . concat <$> prettyListUUIDs [u] 		$(widgetFile "configurators/ssh/enable") 	enable sshdata = lift $ redirect $ ConfirmSshR $@@ -243,6 +258,11 @@ getConfirmSshR sshdata = sshConfigurator $ 	$(widgetFile "configurators/ssh/confirm") +getRetrySshR :: SshData -> Handler ()+getRetrySshR sshdata = do+	s <- liftIO $ testServer $ mkSshInput sshdata+	redirect $ either (const $ ConfirmSshR sshdata) ConfirmSshR s+ getMakeSshGitR :: SshData -> Handler RepHtml getMakeSshGitR = makeSsh False setupGroup @@ -284,8 +304,10 @@ 	redirect $ EditNewCloudRepositoryR $ Remote.uuid r  getAddRsyncNetR :: Handler RepHtml-getAddRsyncNetR = do-	((result, form), enctype) <- runFormGet $+getAddRsyncNetR = postAddRsyncNetR+postAddRsyncNetR :: Handler RepHtml+postAddRsyncNetR = do+	((result, form), enctype) <- runFormPost $ 		renderBootstrap $ sshInputAForm hostnamefield $ 			SshInput Nothing Nothing Nothing 22 	let showform status = page "Add a Rsync.net repository" (Just Configuration) $
Assistant/WebApp/Configurators/WebDAV.hs view
@@ -59,10 +59,12 @@ 	<*> pure NoEncryption -- not used!  getAddBoxComR :: Handler RepHtml+getAddBoxComR = postAddBoxComR+postAddBoxComR :: Handler RepHtml #ifdef WITH_WEBDAV-getAddBoxComR = boxConfigurator $ do+postAddBoxComR = boxConfigurator $ do 	((result, form), enctype) <- lift $-		runFormGet $ renderBootstrap boxComAForm+		runFormPost $ renderBootstrap boxComAForm 	case result of 		FormSuccess input -> lift $  			makeWebDavRemote "box.com" (toCredPair input) setgroup $ M.fromList@@ -80,12 +82,14 @@ 	setgroup r = liftAnnex $ 		setStandardGroup (Remote.uuid r) TransferGroup #else-getAddBoxComR = error "WebDAV not supported by this build"+postAddBoxComR = error "WebDAV not supported by this build" #endif  getEnableWebDAVR :: UUID -> Handler RepHtml+getEnableWebDAVR = postEnableWebDAVR+postEnableWebDAVR :: UUID -> Handler RepHtml #ifdef WITH_WEBDAV-getEnableWebDAVR uuid = do+postEnableWebDAVR uuid = do 	m <- liftAnnex readRemoteLog 	let c = fromJust $ M.lookup uuid m 	let name = fromJust $ M.lookup "name" c@@ -103,16 +107,16 @@   where 	showform name url = do 		((result, form), enctype) <- lift $-			runFormGet $ renderBootstrap webDAVCredsAForm+			runFormPost $ renderBootstrap webDAVCredsAForm 		case result of 			FormSuccess input -> lift $ 				makeWebDavRemote name (toCredPair input) (const noop) M.empty 			_ -> do-				description <- lift $ liftAnnex $+				description <- liftAnnex $ 					T.pack . concat <$> Remote.prettyListUUIDs [uuid] 				$(widgetFile "configurators/enablewebdav") #else-getEnableWebDAVR _ = error "WebDAV not supported by this build"+postEnableWebDAVR _ = error "WebDAV not supported by this build" #endif  #ifdef WITH_WEBDAV
Assistant/WebApp/Configurators/XMPP.hs view
@@ -13,6 +13,7 @@ import Assistant.WebApp.Common import Assistant.WebApp.Notifications import Utility.NotificationBroadcaster+import qualified Remote #ifdef WITH_XMPP import Assistant.XMPP.Client import Assistant.XMPP.Buddies@@ -21,6 +22,9 @@ import Assistant.Alert import Assistant.DaemonStatus import Utility.SRV+import Assistant.WebApp.RepoList+import Assistant.WebApp.Configurators+import Assistant.XMPP #endif  #ifdef WITH_XMPP@@ -30,7 +34,7 @@ import Control.Exception (SomeException) #endif -{- Displays an alert suggesting to configure XMPP, with a button. -}+{- Displays an alert suggesting to configure XMPP. -} xmppNeeded :: Handler () #ifdef WITH_XMPP xmppNeeded = whenM (isNothing <$> liftAnnex getXMPPCreds) $ do@@ -46,12 +50,56 @@ xmppNeeded = return () #endif +{- Displays an alert suggesting to configure a cloud repo+ - to suppliment an XMPP remote. -}+cloudRepoNeeded :: UrlRenderer -> UUID -> Assistant ()+#ifdef WITH_XMPP+cloudRepoNeeded urlrenderer for = do+	buddyname <- getBuddyName for+	url <- liftIO $ renderUrl urlrenderer (NeedCloudRepoR for) []+	close <- asIO1 removeAlert+	void $ addAlert $ cloudRepoNeededAlert buddyname $ AlertButton+		{ buttonLabel = "Add a cloud repository"+		, buttonUrl = url+		, buttonAction = Just close+		}+#else+cloudRepoNeeded = return ()+#endif++{- Returns the name of the friend corresponding to a+ - repository's UUID, but not if it's our name. -}+getBuddyName :: UUID -> Assistant (Maybe String)+getBuddyName u = go =<< getclientjid+  where+	go Nothing = return Nothing+	go (Just myjid) = (T.unpack . buddyName <$>)+		. headMaybe +		. filter (\j -> baseJID j /= baseJID myjid)+		. map fst+		. filter (\(_, r) -> Remote.uuid r == u)+		<$> getXMPPRemotes+	getclientjid = maybe Nothing parseJID . xmppClientID+		<$> getDaemonStatus++getNeedCloudRepoR :: UUID -> Handler RepHtml+#ifdef WITH_XMPP+getNeedCloudRepoR for = page "Cloud repository needed" (Just Configuration) $ do+	buddyname <- liftAssistant $ getBuddyName for+	$(widgetFile "configurators/xmpp/needcloudrepo")+#else+needCloudRepoR = xmppPage $+	$(widgetFile "configurators/xmpp/disabled")+#endif+ getXMPPR :: Handler RepHtml+getXMPPR = postXMPPR+postXMPPR :: Handler RepHtml #ifdef WITH_XMPP-getXMPPR = xmppPage $ do+postXMPPR = xmppPage $ do 	((result, form), enctype) <- lift $ do 		oldcreds <- liftAnnex getXMPPCreds-		runFormGet $ renderBootstrap $ xmppAForm $+		runFormPost $ renderBootstrap $ xmppAForm $ 			creds2Form <$> oldcreds 	let showform problem = $(widgetFile "configurators/xmpp") 	case result of@@ -62,7 +110,7 @@ 	storecreds creds = do 		void $ liftAnnex $ setXMPPCreds creds 		liftAssistant notifyNetMessagerRestart-		redirect StartXMPPPairR+		redirectUltDest DashboardR #else getXMPPR = xmppPage $ 	$(widgetFile "configurators/xmpp/disabled")@@ -83,10 +131,10 @@ buddyListDisplay = do 	autoUpdate ident NotifierBuddyListR (10 :: Int) (10 :: Int) #ifdef WITH_XMPP-	myjid <- lift $ liftAssistant $ xmppClientID <$> getDaemonStatus-	buddies <- lift $ liftAssistant $ do-		rs <- filter isXMPPRemote . syncGitRemotes <$> getDaemonStatus-		let pairedwith = catMaybes $ map (parseJID . getXMPPClientID) rs+	myjid <- liftAssistant $ xmppClientID <$> getDaemonStatus+	let isself (BuddyKey b) = Just b == myjid+	buddies <- liftAssistant $ do+		pairedwith <- map fst <$> getXMPPRemotes 		catMaybes . map (buddySummary pairedwith) 			<$> (getBuddyList <<~ buddyList) 	$(widgetFile "configurators/xmpp/buddylist")@@ -95,6 +143,13 @@ 	ident = "buddylist"  #ifdef WITH_XMPP++getXMPPRemotes :: Assistant [(JID, Remote)]+getXMPPRemotes = catMaybes . map pair . filter isXMPPRemote . syncGitRemotes+	<$> getDaemonStatus+  where+  	pair r = maybe Nothing (\jid -> Just (jid, r)) $+		parseJID $ getXMPPClientID r  data XMPPForm = XMPPForm 	{ formJID :: Text
Assistant/WebApp/Control.hs view
@@ -52,7 +52,7 @@  getLogR :: Handler RepHtml getLogR = page "Logs" Nothing $ do-	logfile <- lift $ liftAnnex $ fromRepo gitAnnexLogFile+	logfile <- liftAnnex $ fromRepo gitAnnexLogFile 	logs <- liftIO $ listLogs logfile 	logcontent <- liftIO $ concat <$> mapM readFile logs 	$(widgetFile "control/log")
Assistant/WebApp/DashBoard.hs view
@@ -11,9 +11,10 @@  import Assistant.WebApp.Common import Assistant.WebApp.Utility-import Assistant.WebApp.Notifications import Assistant.WebApp.RepoList+import Assistant.WebApp.Notifications import Assistant.TransferQueue+import Assistant.DaemonStatus import Utility.NotificationBroadcaster import Logs.Transfer import Utility.Percentage@@ -33,15 +34,14 @@ transfersDisplay warnNoScript = do 	webapp <- lift getYesod 	current <- lift $ M.toList <$> getCurrentTransfers-	queued <- lift $ take 10 <$> liftAssistant getTransferQueue+	queued <- take 10 <$> liftAssistant getTransferQueue 	autoUpdate ident NotifierTransfersR (10 :: Int) (10 :: Int) 	let transfers = simplifyTransfers $ current ++ queued-	if null transfers-		then ifM (lift $ showIntro <$> getWebAppState)-			( introDisplay ident-			, $(widgetFile "dashboard/transfers")-			)-		else $(widgetFile "dashboard/transfers")+	let transfersrunning = not $ null transfers+	scanrunning <- if transfersrunning+		then return False+		else liftAssistant $ transferScanRunning <$> getDaemonStatus+	$(widgetFile "dashboard/transfers")   where 	ident = "transfers" 	isrunning info = not $@@ -74,7 +74,9 @@ {- The main dashboard. -} dashboard :: Bool -> Widget dashboard warnNoScript = do-	let content = transfersDisplay warnNoScript+	let repolist = repoListDisplay $+		mainRepoSelector { nudgeAddMore = True }+	let transferlist = transfersDisplay warnNoScript 	$(widgetFile "dashboard/main")  getDashboardR :: Handler RepHtml
Assistant/WebApp/Page.hs view
@@ -19,18 +19,16 @@ import Text.Hamlet import Data.Text (Text) -data NavBarItem = DashBoard | Repositories | Configuration | About+data NavBarItem = DashBoard | Configuration | About 	deriving (Eq, Ord, Enum, Bounded)  navBarName :: NavBarItem -> Text navBarName DashBoard = "Dashboard"-navBarName Repositories = "Repositories" navBarName Configuration = "Configuration" navBarName About = "About"  navBarRoute :: NavBarItem -> Route WebApp navBarRoute DashBoard = DashboardR-navBarRoute Repositories = RepositoriesR navBarRoute Configuration = ConfigurationR navBarRoute About = AboutR @@ -67,3 +65,6 @@ 	hamletToRepHtml $(hamletFile $ hamletTemplate "bootstrap")   where 	navdetails i = (navBarName i, navBarRoute i, Just i == navbaritem)++controlMenu :: Widget+controlMenu = $(widgetFile "controlmenu")
Assistant/WebApp/RepoList.hs view
@@ -1,6 +1,6 @@ {- git-annex assistant webapp repository list  -- - Copyright 2012 Joey Hess <joey@kitenet.net>+ - Copyright 2012,2013 Joey Hess <joey@kitenet.net>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -30,36 +30,6 @@ import qualified Data.Set as S import qualified Data.Text as T -{- An intro message, list of repositories, and nudge to make more. -}-introDisplay :: Text -> Widget-introDisplay ident = do-	webapp <- lift getYesod-	repolist <- lift $ repoList $ RepoSelector-		{ onlyCloud = False-		, onlyConfigured = True-		, includeHere = False-		}-	let n = length repolist-	let numrepos = show n-	$(widgetFile "configurators/intro")-	lift $ modifyWebAppState $ \s -> s { showIntro = False }--makeMiscRepositories :: Widget-makeMiscRepositories = $(widgetFile "configurators/repositories/misc")--makeCloudRepositories :: Bool -> Widget-makeCloudRepositories onlyTransfer = $(widgetFile "configurators/repositories/cloud")--{- Lists known repositories, followed by options to add more. -}-getRepositoriesR :: Handler RepHtml-getRepositoriesR = page "Repositories" (Just Repositories) $ do-	let repolist = repoListDisplay $ RepoSelector-		{ onlyCloud = False-		, onlyConfigured = False-		, includeHere = True-		}-	$(widgetFile "configurators/repositories")- data Actions 	= DisabledRepoActions 		{ setupRepoLink :: Route WebApp }@@ -93,7 +63,7 @@ notSyncing _ = True  {- Called by client to get a list of repos, that refreshes- - when new repos as added.+ - when new repos are added.  -  - Returns a div, which will be inserted into the calling page.  -}@@ -103,6 +73,23 @@ 	p <- widgetToPageContent $ repoListDisplay reposelector 	hamletToRepHtml $ [hamlet|^{pageBody p}|] +mainRepoSelector :: RepoSelector+mainRepoSelector = RepoSelector+	{ onlyCloud = False+	, onlyConfigured = False+	, includeHere = True+	, nudgeAddMore = False+	}++{- List of cloud repositories, configured and not. -}+cloudRepoList :: Widget+cloudRepoList = repoListDisplay $ RepoSelector+	{ onlyCloud = True+	, onlyConfigured = False+	, includeHere = False+	, nudgeAddMore = False+	}+ repoListDisplay :: RepoSelector -> Widget repoListDisplay reposelector = do 	autoUpdate ident (NotifierRepoListR reposelector) (10 :: Int) (10 :: Int)@@ -112,17 +99,16 @@ 	addScript $ StaticR jquery_ui_sortable_js  	repolist <- lift $ repoList reposelector--	$(widgetFile "configurators/repositories/list")+	let addmore = nudgeAddMore reposelector+	let nootherrepos = length repolist < 2 +	$(widgetFile "repolist")   where 	ident = "repolist" --- (num, name, uuid, actions)-type RepoList = [(String, String, UUID, Actions)]+type RepoList = [(String, UUID, Actions)] -{- A numbered list of known repositories,- - with actions that can be taken on them. -}+{- A list of known repositories, with actions that can be taken on them. -} repoList :: RepoSelector -> Handler RepoList repoList reposelector 	| onlyConfigured reposelector = list =<< configured@@ -179,12 +165,10 @@ 		val iscloud r = Just (iscloud, (u, DisabledRepoActions $ r u)) 	list l = liftAnnex $ do 		let l' = nubBy (\x y -> fst x == fst y) l-		l'' <- zip3-			<$> pure counter-			<*> Remote.prettyListUUIDs (map fst l')+		l'' <- zip+			<$> Remote.prettyListUUIDs (map fst l') 			<*> pure l'-		return $ map (\(num, name, (uuid, actions)) -> (num, name, uuid, actions)) l''-	counter = map show ([1..] :: [Int])+		return $ map (\(name, (uuid, actions)) -> (name, uuid, actions)) l''  getEnableSyncR :: UUID -> Handler () getEnableSyncR = flipSync True@@ -196,23 +180,23 @@ flipSync enable uuid = do 	mremote <- liftAnnex $ Remote.remoteFromUUID uuid 	changeSyncable mremote enable-	redirect RepositoriesR+	redirectBack  getRepositoriesReorderR :: Handler () getRepositoriesReorderR = do 	{- Get uuid of the moved item, and the list it was moved within. -} 	moved <- fromjs <$> runInputGet (ireq textField "moved") 	list <- map fromjs <$> lookupGetParams "list[]"-	void $ liftAnnex $ do-		remote <- fromMaybe (error "Unknown UUID") <$>-			Remote.remoteFromUUID moved+	liftAnnex $ go list =<< Remote.remoteFromUUID moved+	liftAssistant updateSyncRemotes+  where+	go _ Nothing = noop+  	go list (Just remote) = do 		rs <- catMaybes <$> mapM Remote.remoteFromUUID list 		forM_ (reorderCosts remote rs) $ \(r, newcost) -> 			when (Remote.cost r /= newcost) $ 				setRemoteCost r newcost-		remoteListRefresh-	liftAssistant updateSyncRemotes-  where+		void remoteListRefresh   	fromjs = toUUID . T.unpack  reorderCosts :: Remote -> [Remote] -> [(Remote, Cost)]
Assistant/WebApp/Types.hs view
@@ -7,6 +7,7 @@  {-# LANGUAGE TypeFamilies, QuasiQuotes, MultiParamTypeClasses #-} {-# LANGUAGE TemplateHaskell, OverloadedStrings, RankNTypes #-}+{-# LANGUAGE FlexibleInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-}  module Assistant.WebApp.Types where@@ -26,7 +27,6 @@ import Yesod.Static import Text.Hamlet import Data.Text (Text, pack, unpack)-import Control.Concurrent.STM  publicFiles "static" @@ -37,7 +37,6 @@ 	, secretToken :: Text 	, relDir :: Maybe FilePath 	, getStatic :: Static-	, webAppState :: TMVar WebAppState 	, postFirstRun :: Maybe (IO String) 	, noAnnex :: Bool 	}@@ -73,28 +72,63 @@ instance RenderMessage WebApp FormMessage where 	renderMessage _ _ = defaultFormMessage -type Form x = Html -> MForm WebApp WebApp (FormResult x, Widget)+{- Runs an Annex action from the webapp.+ -+ - When the webapp is run outside a git-annex repository, the fallback+ - value is returned.+ -}+liftAnnexOr :: forall sub a. a -> Annex a -> GHandler sub WebApp a+liftAnnexOr fallback a = ifM (noAnnex <$> getYesod)+	( return fallback+	, liftAssistant $ liftAnnex a+	) -data WebAppState = WebAppState-	{ showIntro :: Bool -- should the into message be displayed?-	}+instance LiftAnnex (GHandler sub WebApp) where+	liftAnnex = liftAnnexOr $ error "internal runAnnex" +instance LiftAnnex (GWidget WebApp WebApp) where+	liftAnnex = lift . liftAnnex++class LiftAssistant m where+	liftAssistant :: Assistant a -> m a++instance LiftAssistant (GHandler sub WebApp) where+	liftAssistant a = liftIO . flip runAssistant a+		=<< assistantData <$> getYesod++instance LiftAssistant (GWidget WebApp WebApp) where+	liftAssistant = lift . liftAssistant++type Form x = Html -> MForm WebApp WebApp (FormResult x, Widget)+ data RepoSelector = RepoSelector 	{ onlyCloud :: Bool 	, onlyConfigured :: Bool 	, includeHere :: Bool+	, nudgeAddMore :: Bool 	} 	deriving (Read, Show, Eq)  data RepoListNotificationId = RepoListNotificationId NotificationId RepoSelector 	deriving (Read, Show, Eq) +data RemovableDrive = RemovableDrive +	{ diskFree :: Maybe Integer+	, mountPoint :: Text+	, driveRepoPath :: Text+	}+	deriving (Read, Show, Eq, Ord)+ {- Only needed to work around old-yesod bug that emits a warning message  - when a route has two parameters. -} data FilePathAndUUID = FilePathAndUUID FilePath UUID 	deriving (Read, Show, Eq)  instance PathPiece FilePathAndUUID where+	toPathPiece = pack . show+	fromPathPiece = readish . unpack++instance PathPiece RemovableDrive where 	toPathPiece = pack . show 	fromPathPiece = readish . unpack
Assistant/WebApp/Utility.hs view
@@ -7,8 +7,7 @@  module Assistant.WebApp.Utility where -import Assistant.Common hiding (liftAnnex)-import Assistant.WebApp+import Assistant.Common import Assistant.WebApp.Types import Assistant.DaemonStatus import Assistant.TransferQueue@@ -118,8 +117,8 @@ 		liftIO $ throwTo tid ResumeTransfer 	start info = liftAssistant $ do 		program <- liftIO readProgramFile-		inImmediateTransferSlot $-			Transferrer.startTransfer program t info+		inImmediateTransferSlot program $+			Transferrer.genTransfer t info  getCurrentTransfers :: Handler TransferMap getCurrentTransfers = currentTransfers <$> liftAssistant getDaemonStatus
Assistant/WebApp/routes view
@@ -1,8 +1,5 @@ / DashboardR GET HEAD -/repositories RepositoriesR GET-/repositories/reorder RepositoriesReorderR GET- /noscript NoScriptR GET /noscript/auto NoScriptAutoR GET @@ -17,43 +14,54 @@ /log LogR GET  /config ConfigurationR GET-/config/preferences PreferencesR GET-/config/xmpp XMPPR GET+/config/preferences PreferencesR GET POST+/config/xmpp XMPPR GET POST+/config/xmpp/needcloudrepo/#UUID NeedCloudRepoR GET -/config/repository/new/first FirstRepositoryR GET-/config/repository/new NewRepositoryR GET+/config/addrepository AddRepositoryR GET+/config/repository/new/first FirstRepositoryR GET POST+/config/repository/new NewRepositoryR GET POST /config/repository/switcher RepositorySwitcherR GET /config/repository/switchto/#FilePath SwitchToRepositoryR GET /config/repository/combine/#FilePathAndUUID CombineRepositoryR GET-/config/repository/edit/#UUID EditRepositoryR GET-/config/repository/edit/new/#UUID EditNewRepositoryR GET-/config/repository/edit/new/cloud/#UUID EditNewCloudRepositoryR GET+/config/repository/edit/#UUID EditRepositoryR GET POST+/config/repository/edit/new/#UUID EditNewRepositoryR GET POST+/config/repository/edit/new/cloud/#UUID EditNewCloudRepositoryR GET POST /config/repository/sync/disable/#UUID DisableSyncR GET /config/repository/sync/enable/#UUID EnableSyncR GET -/config/repository/add/drive AddDriveR GET-/config/repository/add/ssh AddSshR GET+/config/repository/add/drive AddDriveR GET POST+/config/repository/add/drive/confirm/#RemovableDrive ConfirmAddDriveR GET+/config/repository/add/drive/finish/#RemovableDrive FinishAddDriveR GET+/config/repository/add/ssh AddSshR GET POST /config/repository/add/ssh/confirm/#SshData ConfirmSshR GET+/config/repository/add/ssh/retry/#SshData RetrySshR GET /config/repository/add/ssh/make/git/#SshData MakeSshGitR GET /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/add/cloud/rsync.net AddRsyncNetR GET POST+/config/repository/add/cloud/S3 AddS3R GET POST+/config/repository/add/cloud/glacier AddGlacierR GET POST+/config/repository/add/cloud/box.com AddBoxComR GET POST -/config/repository/pair/local/start StartLocalPairR GET+/config/repository/pair/local/start StartLocalPairR GET POST /config/repository/pair/local/running/#SecretReminder RunningLocalPairR GET-/config/repository/pair/local/finish/#PairMsg FinishLocalPairR GET-/config/repository/pair/xmpp/start StartXMPPPairR GET-/config/repository/pair/xmpp/running/#BuddyKey RunningXMPPPairR GET-/config/repository/pair/xmpp/accept/#PairKey ConfirmXMPPPairR GET-/config/repository/pair/xmpp/finish/#PairKey FinishXMPPPairR GET+/config/repository/pair/local/finish/#PairMsg FinishLocalPairR GET POST -/config/repository/enable/rsync/#UUID EnableRsyncR GET+/config/repository/pair/xmpp/self/start StartXMPPPairSelfR GET+/config/repository/pair/xmpp/self/running RunningXMPPPairSelfR GET++/config/repository/pair/xmpp/friend/start StartXMPPPairFriendR GET+/config/repository/pair/xmpp/friend/running/#BuddyKey RunningXMPPPairFriendR GET+/config/repository/pair/xmpp/friend/accept/#PairKey ConfirmXMPPPairFriendR GET+/config/repository/pair/xmpp/friend/finish/#PairKey FinishXMPPPairFriendR GET++/config/repository/enable/rsync/#UUID EnableRsyncR GET POST /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+/config/repository/enable/S3/#UUID EnableS3R GET POST+/config/repository/enable/glacier/#UUID EnableGlacierR GET POST+/config/repository/enable/webdav/#UUID EnableWebDAVR GET POST++/config/repository/reorder RepositoriesReorderR GET  /transfers/#NotificationId TransfersR GET /notifier/transfers NotifierTransfersR GET
Assistant/XMPP.hs view
@@ -52,8 +52,9 @@ 	extractGitAnnexTag = headMaybe . filter isGitAnnexTag . messagePayloads  instance GitAnnexTaggable Presence where+	-- always mark extended away and set presence priority to negative 	insertGitAnnexTag p elt = p-		{ presencePayloads = negativePriority : elt : presencePayloads p }+		{ presencePayloads = extendedAway : negativePriority : elt : presencePayloads p } 	extractGitAnnexTag = headMaybe . filter isGitAnnexTag . presencePayloads  data GitAnnexTagInfo = GitAnnexTagInfo@@ -203,6 +204,10 @@ 		, elementAttributes = [] 		, elementNodes = [] 		}++{- Add to a presence to mark its client as extended away. -}+extendedAway :: Element+extendedAway = Element "show" [] [NodeContent $ ContentText "xa"]  {- Add to a presence to give it a negative priority. -} negativePriority :: Element
Assistant/XMPP/Git.hs view
@@ -5,6 +5,8 @@  - Licensed under the GNU GPL version 3 or higher.  -} +{-# LANGUAGE CPP #-}+ module Assistant.XMPP.Git where  import Assistant.Common@@ -29,6 +31,10 @@ import Remote.List import Utility.FileMode import Utility.Shell+#ifdef WITH_WEBAPP+import Assistant.WebApp (UrlRenderer)+import Assistant.WebApp.Configurators.XMPP+#endif  import Network.Protocol.XMPP import qualified Data.Text as T@@ -80,8 +86,8 @@  -  - We listen at the other end of the pipe and relay to and from XMPP.  -}-xmppPush :: ClientID -> (Git.Repo -> IO Bool) -> Assistant Bool-xmppPush cid gitpush = runPush SendPack cid handleDeferred $ do+xmppPush :: ClientID -> (Git.Repo -> IO Bool) -> (NetMessage -> Assistant ()) -> Assistant Bool+xmppPush cid gitpush handledeferred = runPush SendPack cid handledeferred $ do 	sendNetMessage $ Pushing cid StartingPush  	(Fd inf, writepush) <- liftIO createPipe@@ -201,8 +207,8 @@  {- Relays git receive-pack stdin and stdout via XMPP, as well as propigating  - its exit status to XMPP. -}-xmppReceivePack :: ClientID -> Assistant Bool-xmppReceivePack cid = runPush ReceivePack cid handleDeferred $ do+xmppReceivePack :: ClientID -> (NetMessage -> Assistant ()) -> Assistant Bool+xmppReceivePack cid handledeferred = runPush ReceivePack cid handledeferred $ do 	repodir <- liftAnnex $ fromRepo repoPath 	let p = (proc "git" ["receive-pack", repodir]) 		{ std_in = CreatePipe@@ -250,11 +256,11 @@   where 	matching loc r = repoIsUrl r && repoLocation r == loc -handlePushInitiation :: NetMessage -> Assistant ()-handlePushInitiation (Pushing cid CanPush) =+handlePushInitiation :: UrlRenderer -> NetMessage -> Assistant ()+handlePushInitiation _ (Pushing cid CanPush) = 	unlessM (null <$> xmppRemotes cid) $  		sendNetMessage $ Pushing cid PushRequest-handlePushInitiation (Pushing cid PushRequest) =+handlePushInitiation urlrenderer (Pushing cid PushRequest) = 	go =<< liftAnnex (inRepo Git.Branch.current)   where 	go Nothing = noop@@ -266,17 +272,32 @@ 			<*> getUUID 		liftIO $ Command.Sync.updateBranch (Command.Sync.syncBranch branch) g 		selfjid <- ((T.unpack <$>) . xmppClientID) <$> getDaemonStatus-		forM_ rs $ \r -> alertWhile (syncAlert [r]) $-			xmppPush cid $ taggedPush u selfjid branch r-handlePushInitiation (Pushing cid StartingPush) = do+		forM_ rs $ \r -> do+			void $ alertWhile (syncAlert [r]) $+				xmppPush cid+					(taggedPush u selfjid branch r)+					(handleDeferred urlrenderer)+			checkCloudRepos urlrenderer r+handlePushInitiation urlrenderer (Pushing cid StartingPush) = do 	rs <- xmppRemotes cid-	unless (null rs) $+	unless (null rs) $ do 		void $ alertWhile (syncAlert rs) $-			xmppReceivePack cid-handlePushInitiation _ = noop+			xmppReceivePack cid (handleDeferred urlrenderer)+		mapM_ (checkCloudRepos urlrenderer) rs+handlePushInitiation _ _ = noop -handleDeferred :: NetMessage -> Assistant ()+handleDeferred :: UrlRenderer -> NetMessage -> Assistant () handleDeferred = handlePushInitiation++checkCloudRepos :: UrlRenderer -> Remote -> Assistant ()+-- TODO only display if needed+checkCloudRepos urlrenderer r =+#ifdef WITH_WEBAPP+	unlessM (syncingToCloudRemote <$> getDaemonStatus) $+		cloudRepoNeeded urlrenderer (Remote.uuid r)+#else+	noop+#endif  writeChunk :: Handle -> B.ByteString -> IO () writeChunk h b = do
CHANGELOG view
@@ -1,3 +1,43 @@+git-annex (4.20130323) unstable; urgency=low++  * webapp: Repository list is now included in the dashboard, and other+    UI tweaks.+  * webapp: Improved UI for pairing your own devices together using XMPP.+  * webapp: Display an alert when there are XMPP remotes, and a cloud+    transfer repository needs to be configured.+  * Add incrementalbackup repository group.+  * webapp: Encourage user to install git-annex on a server when adding+    a ssh server, rather than just funneling them through to rsync.+  * xmpp: --debug now enables a sanitized dump of the XMPP protocol+  * xmpp: Try harder to detect presence of clients when there's a git push+    to send.+  * xmpp: Re-enable XA flag, since disabling it did not turn out to help+    with the problems Google Talk has with not always sending presence+    messages to clients.+  * map: Combine duplicate repositories, for a nicer looking map.+  * Fix several bugs caused by a bad Ord instance for Remote.+  * webapp: Switch all forms to POST.+  * assistant: Avoid syncing with annex-ignored remotes when reconnecting+    to the network, or connecting a drive.+  * assistant: Fix OSX bug that prevented committing changed files to a+    repository when in indirect mode.+  * webapp: Improved alerts displayed when syncing with remotes, and +    when syncing with a remote fails.+  * webapp: Force wrap long filenames in transfer display.+  * assistant: The ConfigMonitor left one zombie behind each time+    it checked for changes, now fixed.+  * get, copy, move: Display an error message when an identical transfer+    is already in progress, rather than failing with no indication why.+  * assistant: Several optimisations to file transfers.+  * OSX app and standalone Linux tarball now both support being added to+    PATH; no need to use runshell to start git-annex.+  * webapp: When adding a removable drive, you can now specify the+    directory inside it to use.+  * webapp: Confirm whether user wants to combine repositories when+    adding a removable drive that already has a repository on it.++ -- Joey Hess <joeyh@debian.org>  Fri, 22 Mar 2013 18:54:05 -0400+ git-annex (4.20130314) unstable; urgency=low    * Bugfix: git annex add, when ran without any file or directory specified,
Command/Map.hs view
@@ -35,7 +35,7 @@  start :: CommandStart start = do-	rs <- spider =<< gitRepo+	rs <- combineSame <$> (spider =<< gitRepo)  	umap <- uuidMap 	trusted <- trustGet Trusted@@ -77,7 +77,7 @@ 	| otherwise = "localhost"  basehostname :: Git.Repo -> String-basehostname r = Prelude.head $ split "." $ hostname r+basehostname r = fromMaybe "" $ headMaybe $ split "." $ hostname r  {- A name to display for a repo. Uses the name from uuid.log if available,  - or the remote name if not. -}@@ -236,3 +236,11 @@ 	sshnote = do 		showAction "sshing" 		showOutput++{- Spidering can find multiple paths to the same repo, so this is used+ - to combine (really remove) duplicate repos with the same UUID. -}+combineSame :: [Git.Repo] -> [Git.Repo]+combineSame = map snd . nubBy sameuuid . map pair+  where+	sameuuid (u1, _) (u2, _) = u1 == u2 && u1 /= NoUUID+	pair r = (getUncachedUUID r, r)
Command/TransferKey.hs view
@@ -1,4 +1,5 @@-{- git-annex command, used internally by assistant+{- git-annex command, used internally by old versions of assistant;+ - kept around for now so running daemons don't break when upgraded  -  - Copyright 2012 Joey Hess <joey@kitenet.net>  -
+ Command/TransferKeys.hs view
@@ -0,0 +1,141 @@+{- git-annex command, used internally by assistant+ -+ - Copyright 2012, 2013 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}++module Command.TransferKeys where++import Common.Annex+import Command+import Annex.Content+import Logs.Location+import Logs.Transfer+import qualified Remote+import Types.Remote (AssociatedFile)+import Types.Key+import qualified Option++data TransferRequest = TransferRequest Direction Remote Key AssociatedFile++def :: [Command]+def = [withOptions options $+	command "transferkeys" paramNothing seek "plumbing; transfers keys"]++options :: [Option]+options = [readFdOption, writeFdOption]++readFdOption :: Option+readFdOption = Option.field [] "readfd" paramNumber "read from this fd"++writeFdOption :: Option+writeFdOption = Option.field [] "writefd" paramNumber "write to this fd"++seek :: [CommandSeek]+seek = [withField readFdOption convertFd $ \readh ->+	withField writeFdOption convertFd $ \writeh ->+	withNothing $ start readh writeh]++convertFd :: Maybe String -> Annex (Maybe Handle)+convertFd Nothing = return Nothing+convertFd (Just s) = liftIO $ do+	case readish s of+		Nothing -> error "bad fd"+		Just fd -> Just <$> fdToHandle fd++start :: Maybe Handle -> Maybe Handle -> CommandStart+start readh writeh = do+	runRequests (fromMaybe stdin readh) (fromMaybe stdout writeh) runner+	stop+  where+	runner (TransferRequest direction remote key file)+		| direction == Upload = +			upload (Remote.uuid remote) key file forwardRetry $ \p -> do+				ok <- Remote.storeKey remote key file p+				when ok $+					Remote.logStatus remote key InfoPresent+				return ok+		| otherwise = download (Remote.uuid remote) key file forwardRetry $+			getViaTmp key $ Remote.retrieveKeyFile remote key file++runRequests+	:: Handle+	-> Handle+	-> (TransferRequest -> Annex Bool)+	-> Annex ()+runRequests readh writeh a = do+	liftIO $ do+		hSetBuffering readh NoBuffering+		fileEncoding readh+		fileEncoding writeh+	go =<< readrequests+  where+  	go (d:u:k:f:rest) = do+		case (deserialize d, deserialize u, deserialize k, deserialize f) of+			(Just direction, Just uuid, Just key, Just file) -> do+				mremote <- Remote.remoteFromUUID uuid+				case mremote of+					Nothing -> sendresult False+					Just remote -> sendresult =<< a+						(TransferRequest direction remote key file)+			_ -> sendresult False+		go rest+	go [] = return ()+	go _ = error "transferkeys protocol error"++	readrequests = liftIO $ split fieldSep <$> hGetContents readh+	sendresult b = liftIO $ do+		hPutStrLn writeh $ serialize b+		hFlush writeh++sendRequest :: Transfer -> AssociatedFile -> Handle -> IO ()+sendRequest t f h = do+	hPutStr h $ join fieldSep+		[ serialize (transferDirection t)+		, serialize (transferUUID t)+		, serialize (transferKey t)+		, serialize f+		, "" -- adds a trailing null+		]+	hFlush h++readResponse :: Handle -> IO Bool+readResponse h = fromMaybe False . deserialize <$> hGetLine h++fieldSep :: String+fieldSep = "\0"++class Serialized a where+	serialize :: a -> String+	deserialize :: String -> Maybe a++instance Serialized Bool where+	serialize True = "1"+	serialize False = "0"+	deserialize "1" = Just True+	deserialize "0" = Just False+	deserialize _ = Nothing++instance Serialized Direction where+	serialize Upload = "u"+	serialize Download = "d"+	deserialize "u" = Just Upload+	deserialize "d" = Just Download+	deserialize _ = Nothing++instance Serialized AssociatedFile where+	serialize (Just f) = f+	serialize Nothing = ""+	deserialize "" = Just Nothing+	deserialize f = Just $ Just f++instance Serialized UUID where+	serialize = fromUUID+	deserialize = Just . toUUID++instance Serialized Key where+	serialize = key2file+	deserialize = file2key
Config/Cost.hs view
@@ -42,7 +42,7 @@  - position longer than the list.  -} insertCostAfter :: [Cost] -> Int -> [Cost]-insertCostAfter [] _ = error "insertCostAfter: empty list"+insertCostAfter [] _ = [] insertCostAfter l pos 	| pos < 0 = costBetween 0 (l !! 0) : l 	| nextpos > maxpos = l ++ [1 + l !! maxpos]
Git/Command.hs view
@@ -94,6 +94,12 @@   where 	sep = "\0" +pipeNullSplitStrict :: [CommandParam] -> Repo -> IO [String]+pipeNullSplitStrict params repo = do+	s <- pipeReadStrict params repo+	return $ filter (not . null) $ split sep s+  where+	sep = "\0"  pipeNullSplitZombie :: [CommandParam] -> Repo -> IO [String] pipeNullSplitZombie params repo = leaveZombie <$> pipeNullSplit params repo
Git/LsTree.hs view
@@ -29,15 +29,17 @@ 	, file :: FilePath 	} deriving Show -{- Lists the complete contents of a tree. -}+{- Lists the complete contents of a tree, with lazy output. -} lsTree :: Ref -> Repo -> IO [TreeItem]-lsTree t repo = map parseLsTree <$>-	pipeNullSplitZombie [Params "ls-tree --full-tree -z -r --", File $ show t] repo+lsTree t repo = map parseLsTree <$> pipeNullSplitZombie ps repo+  where+  	ps = [Params "ls-tree --full-tree -z -r --", File $ show t]  {- Lists specified files in a tree. -} lsTreeFiles :: Ref -> [FilePath] -> Repo -> IO [TreeItem]-lsTreeFiles t fs repo = map parseLsTree <$>-	pipeNullSplitZombie ([Params "ls-tree -z --", File $ show t] ++ map File fs) repo+lsTreeFiles t fs repo = map parseLsTree <$> pipeNullSplitStrict ps repo+  where+  	ps = [Params "ls-tree -z --", File $ show t] ++ map File fs  {- Parses a line of ls-tree output.  - (The --long format is not currently supported.) -}
GitAnnex.hs view
@@ -31,6 +31,7 @@ import qualified Command.FromKey import qualified Command.DropKey import qualified Command.TransferKey+import qualified Command.TransferKeys import qualified Command.ReKey import qualified Command.Reinject import qualified Command.Fix@@ -110,6 +111,7 @@ 	, Command.FromKey.def 	, Command.DropKey.def 	, Command.TransferKey.def+	, Command.TransferKeys.def 	, Command.ReKey.def 	, Command.Fix.def 	, Command.Fsck.def
Logs/Transfer.hs view
@@ -113,29 +113,30 @@ 	info <- liftIO $ startTransferInfo file 	(meter, tfile, metervar) <- mkProgressUpdater t info 	mode <- annexFileMode+	fd <- liftIO $ prep tfile mode info 	ok <- retry info metervar $-		bracketIO (prep tfile mode info) (cleanup tfile) (a meter)-	unless ok $ failed info+		bracketIO (return fd) (cleanup tfile) (a meter)+	unless ok $ recordFailedTransfer t info 	return ok   where-	prep tfile mode info = catchMaybeIO $ do-		fd <- openFd (transferLockFile tfile) ReadWrite (Just mode)-			defaultFileFlags { trunc = True }-		locked <- catchMaybeIO $-			setLock fd (WriteLock, AbsoluteSeek, 0, 0)-		when (locked == Nothing) $-			error $ "transfer already in progress"-		writeTransferInfoFile info tfile-		return fd+	prep tfile mode info = do+		mfd <- catchMaybeIO $+			openFd (transferLockFile tfile) ReadWrite (Just mode)+				defaultFileFlags { trunc = True }+		case mfd of+			Nothing -> return mfd+			Just fd -> do+				locked <- catchMaybeIO $+					setLock fd (WriteLock, AbsoluteSeek, 0, 0)+				when (locked == Nothing) $+					error $ "transfer already in progress"+				void $ tryIO $ writeTransferInfoFile info tfile+				return mfd 	cleanup _ Nothing = noop 	cleanup tfile (Just fd) = do 		void $ tryIO $ removeFile tfile 		void $ tryIO $ removeFile $ transferLockFile tfile 		closeFd fd-	failed info = do-		failedtfile <- fromRepo $ failedTransferFile t-		createAnnexDirectory $ takeDirectory failedtfile-		liftIO $ writeTransferInfoFile info failedtfile 	retry oldinfo metervar run = do 		v <- tryAnnex run 		case v of@@ -235,6 +236,12 @@ removeFailedTransfer t = do 	f <- fromRepo $ failedTransferFile t 	liftIO $ void $ tryIO $ removeFile f++recordFailedTransfer :: Transfer -> TransferInfo -> Annex ()+recordFailedTransfer t info = do+	failedtfile <- fromRepo $ failedTransferFile t+	createAnnexDirectory $ takeDirectory failedtfile+	liftIO $ writeTransferInfoFile info failedtfile  {- The transfer information file to use for a given Transfer. -} transferFile :: Transfer -> Git.Repo -> FilePath
Makefile view
@@ -117,7 +117,7 @@ 	cd tmp && tar czf git-annex-standalone-$(shell dpkg --print-architecture).tar.gz git-annex.linux  OSXAPP_DEST=tmp/build-dmg/git-annex.app-OSXAPP_BASE=$(OSXAPP_DEST)/Contents/MacOS+OSXAPP_BASE=$(OSXAPP_DEST)/Contents/MacOS/bundle osxapp: 	$(MAKE) git-annex @@ -163,7 +163,7 @@ fast: dist/caballog 	@$$(grep 'ghc --make' dist/caballog | head -n 1 | sed -e 's/-package-id [^ ]*//g' -e 's/-hide-all-packages//') -O0 	@ln -sf dist/build/git-annex/git-annex git-annex-	@$(MAKE) tags >/dev/null 2>&1+	@$(MAKE) tags >/dev/null 2>&1 &  dist/caballog: git-annex.cabal 	$(CABAL) configure -f"-Production" -O0
Remote.hs view
@@ -45,6 +45,7 @@ import Text.JSON import Text.JSON.Generic import Data.Tuple+import Data.Ord  import Common.Annex import Types.Remote@@ -208,7 +209,7 @@ 	allremotes <- enabledRemoteList 	let validremotes = remotesWithUUID allremotes validuuids -	return (sort validremotes, validtrusteduuids)+	return (sortBy (comparing cost) validremotes, validtrusteduuids)  {- Displays known locations of a key. -} showLocations :: Key -> [UUID] -> String -> Annex ()@@ -249,7 +250,7 @@  {- Orders remotes by cost, with ones with the lowest cost grouped together. -} byCost :: [Remote] -> [[Remote]]-byCost = map snd . sort . M.toList . costmap+byCost = map snd . sortBy (comparing fst) . M.toList . costmap   where 	costmap = M.fromListWith (++) . map costpair 	costpair r = (cost r, [r])
Remote/Bup.hs view
@@ -67,6 +67,7 @@ 			then Just buprepo 			else Nothing 		, remotetype = remote+		, globallyAvailable = not $ bupLocal buprepo 		, readonly = False 		} 	return $ encryptableRemote c
Remote/Directory.hs view
@@ -57,6 +57,7 @@ 			gitconfig = gc, 			localpath = Just dir, 			readonly = False,+			globallyAvailable = False, 			remotetype = remote 		}   where
Remote/Git.hs view
@@ -111,6 +111,7 @@ 			, repo = r 			, gitconfig = gc 			, readonly = Git.repoIsHttp r+			, globallyAvailable = not $ Git.repoIsLocal r || Git.repoIsLocalUnknown r 			, remotetype = remote 			}
Remote/Glacier.hs view
@@ -63,6 +63,7 @@ 			gitconfig = gc, 			localpath = Nothing, 			readonly = False,+			globallyAvailable = True, 			remotetype = remote 		}
Remote/Hook.hs view
@@ -52,6 +52,7 @@ 			repo = r, 			gitconfig = gc, 			readonly = False,+			globallyAvailable = False, 			remotetype = remote 		}   where
Remote/Rsync.hs view
@@ -60,14 +60,16 @@ 			, config = M.empty 			, repo = r 			, gitconfig = gc-			, localpath = if rsyncUrlIsPath $ rsyncUrl o+			, localpath = if islocal 				then Just $ rsyncUrl o 				else Nothing 			, readonly = False+			, globallyAvailable = not $ islocal 			, remotetype = remote 			}   where 	o = RsyncOpts url opts escape+	islocal = rsyncUrlIsPath $ rsyncUrl o 	url = fromMaybe (error "missing rsyncurl") $ remoteAnnexRsyncUrl gc 	opts = map Param $ filter safe $ remoteAnnexRsyncOptions gc 	escape = M.lookup "shellescape" c /= Just "no"
Remote/S3.hs view
@@ -62,6 +62,7 @@ 			gitconfig = gc, 			localpath = Nothing, 			readonly = False,+			globallyAvailable = True, 			remotetype = remote 		}
Remote/Web.hs view
@@ -54,6 +54,7 @@ 		localpath = Nothing, 		repo = r, 		readonly = True,+		globallyAvailable = True, 		remotetype = remote 	}
Remote/WebDAV.hs view
@@ -69,6 +69,7 @@ 			gitconfig = gc, 			localpath = Nothing, 			readonly = False,+			globallyAvailable = True, 			remotetype = remote 		}
Types/Remote.hs view
@@ -74,6 +74,8 @@ 	localpath :: Maybe FilePath, 	-- a Remote can be known to be readonly 	readonly :: Bool,+	-- a Remote can be globally available. (Ie, "in the cloud".)+	globallyAvailable :: Bool, 	-- the type of the remote 	remotetype :: RemoteTypeA a }@@ -85,6 +87,5 @@ instance Eq (RemoteA a) where 	x == y = uuid x == uuid y --- order remotes by cost instance Ord (RemoteA a) where-	compare = comparing cost+	compare = comparing uuid
Types/StandardGroups.hs view
@@ -11,6 +11,7 @@ 	= ClientGroup 	| TransferGroup 	| BackupGroup+	| IncrementalBackupGroup 	| SmallArchiveGroup 	| FullArchiveGroup 	| SourceGroup@@ -21,6 +22,7 @@ fromStandardGroup ClientGroup = "client" fromStandardGroup TransferGroup = "transfer" fromStandardGroup BackupGroup = "backup"+fromStandardGroup IncrementalBackupGroup = "incrementalbackup" fromStandardGroup SmallArchiveGroup = "smallarchive" fromStandardGroup FullArchiveGroup = "archive" fromStandardGroup SourceGroup = "source"@@ -30,6 +32,7 @@ toStandardGroup "client" = Just ClientGroup toStandardGroup "transfer" = Just TransferGroup toStandardGroup "backup" = Just BackupGroup+toStandardGroup "incrementalbackup" = Just IncrementalBackupGroup toStandardGroup "smallarchive" = Just SmallArchiveGroup toStandardGroup "archive" = Just FullArchiveGroup toStandardGroup "source" = Just SourceGroup@@ -39,7 +42,8 @@ descStandardGroup :: StandardGroup -> String descStandardGroup ClientGroup = "client: a repository on your computer" descStandardGroup TransferGroup = "transfer: distributes files to clients"-descStandardGroup BackupGroup = "backup: backs up all files"+descStandardGroup BackupGroup = "full backup: backs up all files"+descStandardGroup IncrementalBackupGroup = "incremental backup: backs up files not backed up elsewhere" descStandardGroup SmallArchiveGroup = "small archive: archives files located in \"archive\" directories" descStandardGroup FullArchiveGroup = "full archive: archives all files not archived elsewhere" descStandardGroup SourceGroup = "file source: moves files on to other repositories"@@ -50,6 +54,7 @@ preferredContent ClientGroup = "exclude=*/archive/* and exclude=archive/*" preferredContent TransferGroup = "not (inallgroup=client and copies=client:2) and " ++ preferredContent ClientGroup preferredContent BackupGroup = "include=*"+preferredContent IncrementalBackupGroup = "include=* and (not copies=incrementalbackup:1)" preferredContent SmallArchiveGroup = "(include=*/archive/* or include=archive/*) and " ++ preferredContent FullArchiveGroup preferredContent FullArchiveGroup = "not (copies=archive:1 or copies=smallarchive:1)" preferredContent SourceGroup = "not (copies=1)"
Utility/DirWatcher.hs view
@@ -47,10 +47,10 @@  - OTOH, with kqueue, often only one event is received, indicating the most  - recent state of the file. -} eventsCoalesce :: Bool-#if (WITH_INOTIFY || WITH_FSEVENTS)+#if WITH_INOTIFY eventsCoalesce = False #else-#if WITH_KQUEUE+#if (WITH_KQUEUE || WITH_FSEVENTS) eventsCoalesce = True #else eventsCoalesce = undefined
Utility/ThreadScheduler.hs view
@@ -14,7 +14,6 @@  import Control.Concurrent import System.Posix.Signals-import Data.Time.Clock #ifndef __ANDROID__ import System.Posix.Terminal #endif
debian/changelog view
@@ -1,3 +1,43 @@+git-annex (4.20130323) unstable; urgency=low++  * webapp: Repository list is now included in the dashboard, and other+    UI tweaks.+  * webapp: Improved UI for pairing your own devices together using XMPP.+  * webapp: Display an alert when there are XMPP remotes, and a cloud+    transfer repository needs to be configured.+  * Add incrementalbackup repository group.+  * webapp: Encourage user to install git-annex on a server when adding+    a ssh server, rather than just funneling them through to rsync.+  * xmpp: --debug now enables a sanitized dump of the XMPP protocol+  * xmpp: Try harder to detect presence of clients when there's a git push+    to send.+  * xmpp: Re-enable XA flag, since disabling it did not turn out to help+    with the problems Google Talk has with not always sending presence+    messages to clients.+  * map: Combine duplicate repositories, for a nicer looking map.+  * Fix several bugs caused by a bad Ord instance for Remote.+  * webapp: Switch all forms to POST.+  * assistant: Avoid syncing with annex-ignored remotes when reconnecting+    to the network, or connecting a drive.+  * assistant: Fix OSX bug that prevented committing changed files to a+    repository when in indirect mode.+  * webapp: Improved alerts displayed when syncing with remotes, and +    when syncing with a remote fails.+  * webapp: Force wrap long filenames in transfer display.+  * assistant: The ConfigMonitor left one zombie behind each time+    it checked for changes, now fixed.+  * get, copy, move: Display an error message when an identical transfer+    is already in progress, rather than failing with no indication why.+  * assistant: Several optimisations to file transfers.+  * OSX app and standalone Linux tarball now both support being added to+    PATH; no need to use runshell to start git-annex.+  * webapp: When adding a removable drive, you can now specify the+    directory inside it to use.+  * webapp: Confirm whether user wants to combine repositories when+    adding a removable drive that already has a repository on it.++ -- Joey Hess <joeyh@debian.org>  Fri, 22 Mar 2013 18:54:05 -0400+ git-annex (4.20130314) unstable; urgency=low    * Bugfix: git annex add, when ran without any file or directory specified,
+ doc/assistant/.release_notes.mdwn.swp view

binary file changed (absent → 20480 bytes)

doc/assistant/archival_walkthrough.mdwn view
@@ -26,3 +26,7 @@ content from the archive.  Note that retrieving data from Amazon Glacier takes 4 to 5 hours.++### screencast++[[!inline feeds=no template=bare pages=videos/git-annex_assistant_archiving]]
+ doc/assistant/cloudnudge.png view

binary file changed (absent → 7332 bytes)

+ doc/assistant/dashboard.png view

binary file changed (absent → 41061 bytes)

doc/bugs/Allow_syncing_to_a_specific_directory_on_a_USB_remote.mdwn view
@@ -1,9 +1,30 @@-This follows up to the [comment made by Laszlo](http://git-annex.branchable.com/design/assistant/polls/what_is_preventing_me_from_using_git-annex_assistant/#comment-f26d3b6b45bb66601ecfaa883ace161c) on the [recent poll](http://git-annex.branchable.com/design/assistant/polls/what_is_preventing_me_from_using_git-annex_assistant/).+This follows up to the [comment made by+Laszlo](http://git-annex.branchable.com/design/assistant/polls/what_is_preventing_me_from_using_git-annex_assistant/#comment-f26d3b6b45bb66601ecfaa883ace161c)+on the [recent+poll](http://git-annex.branchable.com/design/assistant/polls/what_is_preventing_me_from_using_git-annex_assistant/). -I too need to be able to select the directory on the remote drive that the annex will be synced to.+I too need to be able to select the directory on the remote drive that the+annex will be synced to. -If I just add a remote drive via the web app, it syncs the repository to `/mnt/usb/annex`, and it looks like it just creates a bare repository in that folder. I need the repository to be synced to something like `/mnt/usb/subfolder/myspecifiedfoldername` and I need that remote to be a full repository.+If I just add a remote drive via the web app, it syncs the repository to+`/mnt/usb/annex`, and it looks like it just creates a bare repository in+that folder. I need the repository to be synced to something like+`/mnt/usb/subfolder/myspecifiedfoldername` and I need that remote to be a+full repository. -My use case is that I use the USB drive to keep annexes in sync between two computers. I have multiple annexes that need to be synced between the two computers, and none of them are in a directory called `annex`. I also need to be able to plug the drive into other computers and access the files directly, without doing a `git clone` or anything like that. I have all of this setup and working fine with just plain old git annex, but the web app does not seem to support creating new repositories with this workflow.+My use case is that I use the USB drive to keep annexes in sync between two+computers. I have multiple annexes that need to be synced between the two+computers, and none of them are in a directory called `annex`. I also need+to be able to plug the drive into other computers and access the files+directly, without doing a `git clone` or anything like that. I have all of+this setup and working fine with just plain old git annex, but the web app+does not seem to support creating new repositories with this workflow. -I think it makes a lot of sense to allow the web application to add a new remote that is simply a directory. People like me could specify the path of the directory to be on the mounted USB drive. Others may want to add a remote that is a mounted network share or something like that.+I think it makes a lot of sense to allow the web application to add a new+remote that is simply a directory. People like me could specify the path of+the directory to be on the mounted USB drive. Others may want to add a+remote that is a mounted network share or something like that.++> [[done]], the webapp now has a "Add another repository" option,+> and you can just enter the path to whatever place you like inside a USB+> drive.  --[[Joey]]
doc/bugs/Assistant_dropping_from_backup_repo.mdwn view
@@ -21,3 +21,8 @@ * The files that the Assistant started trying to drop were, I believe, the first (alphabetically) files in my repository to contain non-ascii characters in their file names (some French accented letters)  Thanks.++> The non-ascii characters are the giveaway: For 1 version, git-annex used+> a regex library that failed to ever match non-ascii characters. So it+> thought backup repos, which match "*" with a regex, wanted no such files.+> This is [[fixed|done]]. --[[Joey]]
doc/bugs/Assistant_uses_obsolete_GDU_volume_monitor.mdwn view
@@ -24,3 +24,5 @@ ### What version of git-annex are you using? On what operating system?  git-annex 3.20130102 on Linux 3.7.1, GNOME 3.7++> [[done]] --[[Joey]]
doc/bugs/Cannot_clone_an_annex.mdwn view
@@ -65,3 +65,5 @@  It looks like I'll have to rollback my ZFS snapshots and start over, but I'm wondering: how was I even able to create this situation?++> [[Done]]; user error. --[[Joey]]
+ doc/bugs/Cannot_copy_to_a_git-annex_remote.mdwn view
@@ -0,0 +1,14 @@+What steps will reproduce the problem?++I really have no way to reproduce.  I have these two annex repository, both living on CentOS 6.3 machines, using SSH to copy from one to the other.  Everything has always worked fine, and I've copied hundreds of gigabytes and tens of thousands of files so far without a problem.++What is the expected output? What do you see instead?++I do "git copy --to storage FILE" and it says "Copying FILE... failed".  That's it.++How do I fix things so that I can copy again?  Nothing that I tried had any effect on the problem.++Thanks!++> Thanks to Jim's smart correlation of this with another bug, I've fixed+> them both. [[done]] --[[Joey]]
+ doc/bugs/Compile_needs_more_than_1.5gb_of_memory.mdwn view
@@ -0,0 +1,16 @@+What steps will reproduce the problem?++> cabal install git-annex++What is the expected output? What do you see instead?++> I would expect a working git-annex on my little linode. I have a linode 768 and trouble building the latest version. The process get's killed because of an out of memory condition.++What version of git-annex are you using? On what operating system?++> git-annex version: 4.20130314+> Ubuntu 12.04++Please provide any additional information below.++[[done]]
doc/bugs/Crash_when_adding_jabber_account_.mdwn view
@@ -28,3 +28,5 @@ On dmesg:  [45773.212717] git-annex[26779]: segfault at b724e840 ip 09699150 sp b4cfd038 error 7 in git-annex[8048000+1762000] +[[!tag /design/assistant]]+> [[done]], see comments --[[Joey]]
doc/bugs/Creating_an_encrypted_S3_does_not_check_for_presence_of_GPG.mdwn view
@@ -15,3 +15,4 @@  Please provide any additional information below. +[[!tag /design/assistant/OSX]]
doc/bugs/It_is_very_easy_to_turn_git-annex_into_a_zombie.mdwn view
@@ -21,3 +21,5 @@  Please provide any additional information below. +[[!meta title="strange OSX behavior when killed"]]+[[!tag /design/assistant/OSX unreproducible]]
− doc/bugs/OSX_app_issues/comment_4_4cda124b57ddc87645d5822f14ed5c59._comment 
@@ -1,8 +0,0 @@-[[!comment format=mdwn- username="https://www.google.com/accounts/o8/id?id=AItOawkBTVYS5lTecuenAB01eHgfUxE20vWVpU4"- nickname="Peng"- subject="Large Mountain Loin package size"- date="2012-12-28T22:17:43Z"- content="""-I see that git-annex package file is 489.9MB on Mac Mountain Loin (git-annex.dmg.bz2). The file git-annex.dmg.bz2 is only of size 24M. Is there any way to reduce the package size?-"""]]
− doc/bugs/OSX_app_issues/comment_5_0d1df34f83a8dac9c438d93806236818._comment 
@@ -1,8 +0,0 @@-[[!comment format=mdwn- username="http://joeyh.name/"- ip="2001:4978:f:21a::2"- subject="comment 5"- date="2013-01-02T19:52:28Z"- content="""-The build for today's release is 24 mb.-"""]]
− doc/bugs/OSX_app_issues/comment_6_bc44d5aea5f77e331a32913ada293730._comment 
@@ -1,27 +0,0 @@-[[!comment format=mdwn- username="https://www.jsilence.org/"- nickname="jsilence"- subject="Setting up a repository fails on OSX 10.6"- date="2013-01-05T11:17:18Z"- content="""-I installed Haskell via MacPorts and managed to compile git-annex as described via cabal.--On the initial start, git-annex webapp starts just fine and the webapp opens in the browser. When I try to configure a local repository, the webapp crashes.--    1 jsilence@zeo ~ % git-annex webapp-    (Recording state in git...)-    WebApp crashed: watch mode is not available on this system-    -    Launching web browser on file:///var/folders/6b/6bWnFAnbFXSPCLPvCnKNrE+++TI/-Tmp-/webapp1003.html-    jsilence@zeo ~ % --\"watch mode is not suported\" suggests that lsof is not in the PATH. lsof resides in /usr/sbin and can be found just fine:--    jsilence@zeo ~ % which lsof-    /usr/sbin/lsof--Any help would be appreciated.---jsl--"""]]
− doc/bugs/OSX_app_issues/comment_7_acd73cc5c4caa88099e2d2f19947aadf._comment 
@@ -1,8 +0,0 @@-[[!comment format=mdwn- username="http://joeyh.name/"- ip="4.152.108.211"- subject="comment 7"- date="2013-01-05T17:48:52Z"- content="""-@jsilence, this problem does not involve lsof. There was a typo in the cabal file that prevented cabal building it with hfsevents. I'm releasing a new version to cabal with this typo fixed.-"""]]
doc/bugs/Provide_64-bit_standalone_build.mdwn view
@@ -1,1 +1,6 @@ The 32-bit standalone build appears to require two libraries (lib32-libyaml and lib32-gsasl) that are not available on Arch Linux. [See the comments on the AUR package](https://aur.archlinux.org/packages/git-annex-bin/). I'd appreciate it if you could bring back the 64-bit build.++> [[done]], based on <https://aur.archlinux.org/packages/git-annex-bin/>+> they are managing with what I am providing. Also, Arch Linux has a+> proper build of git-annex from source, so I'm not going to worry about+> git-annex-bin, the rationalle for which I don't even understand. --[[Joey]]
doc/bugs/Remote_repositories_have_to_be_setup_encrypted.mdwn view
@@ -23,3 +23,5 @@     Release:	12.04     Codename:	precise +[[!meta title="webapp does not allow disabling encryption on rsync special remotes"]]+[[!tag /design/assistant]]
doc/bugs/Renamed_special_remote_cannot_be_reactivated_by_the_webapp.mdwn view
@@ -26,3 +26,5 @@ * rename `metaarray` to `ma` again using the webapp  Perhaps the renaming of the remote not surviving clones is unavoidable, but the webapp should be able to cope with the situation.  Thanks.++[[!tag /design/assistant]]
doc/bugs/Rsync_encrypted_remote_asks_for_ssh_key_password_for_each_file.mdwn view
@@ -24,3 +24,4 @@ Please provide any additional information below.  +[[!meta title="rsync special remote does not use ssh connection caching"]]
@@ -45,3 +45,7 @@     Description:	Ubuntu 12.04.1 LTS     Release:	12.04     Codename:	precise++> [[done]]; the webapp now detects when XMPP pairing has been used but no+> transfer remote is available, and prompts the user to create one.+> --[[Joey]]
doc/bugs/The_webapp_doesn__39__t_allow_deleting_repositories.mdwn view
@@ -19,3 +19,5 @@     Description:	Ubuntu 12.04.1 LTS     Release:	12.04     Codename:	precise++[[!tag /design/assistant]]
doc/bugs/Tries_to_upload_to_remote_although_remote_is_dead.mdwn view
@@ -48,4 +48,4 @@  Please provide any additional information below. -+[[!tag /design/assistant unreproducible]]
+ doc/bugs/WEBDAV_443.mdwn view
@@ -0,0 +1,304 @@+What steps will reproduce the problem?++```+WEBDAV_USERNAME=pradermecker@yahoo.ca WEBDAV_PASSWORD=xxxxxx git annex initremote box.com type=webdav url=https://www.box.com/dav/git-annex chunksize=75mb encryption=none+```++What is the expected output? What do you see instead?++I have: +```+git-annex: WebDAV failed to write file: FailedConnectionException "www.box.com" 443: user error+```+# What version of git-annex are you using? On what operating system?++```+git-annex version: 4.20130314+local repository version: 3+default repository version: 3+supported repository versions: 3 4+upgrade supported from repository versions: 0 1 2+build flags: Assistant Webapp Pairing Testsuite S3 WebDAV Inotify DBus XMPP DNS+```+Archlinux 64: https://aur.archlinux.org/packages/git-annex/++# Please provide any additional information below.++1. Try my password a couple of time. It works with Chrome, Firefox or cadaver+2. I am using a zsh shell and try exporting both env. variables+3. git-annex test has errors++### Error in:   git-annex add:1           +sha1foodup: openFile: does not exist (No such file or directory)+Cases: 3  Tried: 2  Errors: 2  Failures: 0warning: remote HEAD refers to nonexistent ref, unable to checkout.++git-annex: dir/foo: getFileStatus: does not exist (No such file or directory)+### Failure in: git-annex add:2           +add of subdir failed+Cases: 3  Tried: 3  Errors: 2  Failures: 1+----------------------------------------------------------------------+reinject+Cases: 1  Tried: 0  Errors: 0  Failures: 0warning: remote HEAD refers to nonexistent ref, unable to checkout.++git-annex: sha1foo not found+### Failure in: git-annex reinject/fromkey+reinject failed+Cases: 1  Tried: 1  Errors: 0  Failures: 1+----------------------------------------------------------------------+unannex+Cases: 2  Tried: 0  Errors: 0  Failures: 0warning: remote HEAD refers to nonexistent ref, unable to checkout.++### Error in:   git-annex unannex:0:no content+foo: getSymbolicLinkStatus: does not exist (No such file or directory)+Cases: 2  Tried: 1  Errors: 1  Failures: 0warning: remote HEAD refers to nonexistent ref, unable to checkout.++git-annex: foo not found+### Error in:   git-annex unannex:1:with content+foo: getSymbolicLinkStatus: does not exist (No such file or directory)+Cases: 2  Tried: 2  Errors: 2  Failures: 0+----------------------------------------------------------------------+drop+Cases: 3  Tried: 0  Errors: 0  Failures: 0warning: remote HEAD refers to nonexistent ref, unable to checkout.++git-annex: foo not found+git-annex: foo not found+### Failure in: git-annex drop:0:no remotes+drop wrongly succeeded with no known copy of file+Cases: 3  Tried: 1  Errors: 0  Failures: 1warning: remote HEAD refers to nonexistent ref, unable to checkout.++git-annex: foo not found+### Error in:   git-annex drop:1:with remote+foo: getSymbolicLinkStatus: does not exist (No such file or directory)+Cases: 3  Tried: 2  Errors: 1  Failures: 1warning: remote HEAD refers to nonexistent ref, unable to checkout.++git-annex: foo not found+### Error in:   git-annex drop:2:untrusted remote+foo: getSymbolicLinkStatus: does not exist (No such file or directory)+Cases: 3  Tried: 3  Errors: 2  Failures: 1+----------------------------------------------------------------------+get+Cases: 1  Tried: 0  Errors: 0  Failures: 0warning: remote HEAD refers to nonexistent ref, unable to checkout.++### Error in:   git-annex get             +foo: openFile: does not exist (No such file or directory)+Cases: 1  Tried: 1  Errors: 1  Failures: 0+----------------------------------------------------------------------+move+Cases: 1  Tried: 0  Errors: 0  Failures: 0warning: remote HEAD refers to nonexistent ref, unable to checkout.++### Error in:   git-annex move            +foo: getSymbolicLinkStatus: does not exist (No such file or directory)+Cases: 1  Tried: 1  Errors: 1  Failures: 0+----------------------------------------------------------------------+copy+Cases: 1  Tried: 0  Errors: 0  Failures: 0warning: remote HEAD refers to nonexistent ref, unable to checkout.++### Error in:   git-annex copy            +foo: getSymbolicLinkStatus: does not exist (No such file or directory)+Cases: 1  Tried: 1  Errors: 1  Failures: 0+----------------------------------------------------------------------+lock+Cases: 1  Tried: 0  Errors: 0  Failures: 0warning: remote HEAD refers to nonexistent ref, unable to checkout.++### Error in:   git-annex unlock/lock     +foo: getSymbolicLinkStatus: does not exist (No such file or directory)+Cases: 1  Tried: 1  Errors: 1  Failures: 0+----------------------------------------------------------------------+edit+Cases: 2  Tried: 0  Errors: 0  Failures: 0warning: remote HEAD refers to nonexistent ref, unable to checkout.++git-annex: foo not found+### Error in:   git-annex edit/commit:0   +foo: getSymbolicLinkStatus: does not exist (No such file or directory)+Cases: 2  Tried: 1  Errors: 1  Failures: 0warning: remote HEAD refers to nonexistent ref, unable to checkout.++git-annex: foo not found+### Error in:   git-annex edit/commit:1   +foo: getSymbolicLinkStatus: does not exist (No such file or directory)+Cases: 2  Tried: 2  Errors: 2  Failures: 0+----------------------------------------------------------------------+fix+Cases: 1  Tried: 0  Errors: 0  Failures: 0warning: remote HEAD refers to nonexistent ref, unable to checkout.++### Error in:   git-annex fix             +foo: getSymbolicLinkStatus: does not exist (No such file or directory)+Cases: 1  Tried: 1  Errors: 1  Failures: 0+----------------------------------------------------------------------+trust+Cases: 1  Tried: 0  Errors: 0  Failures: 0warning: remote HEAD refers to nonexistent ref, unable to checkout.++Cases: 1  Tried: 1  Errors: 0  Failures: 0+----------------------------------------------------------------------+fsck+Cases: 4  Tried: 0  Errors: 0  Failures: 0warning: remote HEAD refers to nonexistent ref, unable to checkout.++### Failure in: git-annex fsck:0          +fsck failed to fail with numcopies unsatisfied+Cases: 4  Tried: 2  Errors: 0  Failures: 1warning: remote HEAD refers to nonexistent ref, unable to checkout.++git-annex: foo not found+### Failure in: git-annex fsck:2          +fsck failed to fail with content only available in untrusted (current) repository+Cases: 4  Tried: 3  Errors: 0  Failures: 2warning: remote HEAD refers to nonexistent ref, unable to checkout.++git-annex: foo not found+git-annex: sha1foo not found+### Failure in: git-annex fsck:3          +fsck failed to fail with content not replicated to enough non-untrusted repositories+Cases: 4  Tried: 4  Errors: 0  Failures: 3+----------------------------------------------------------------------+migrate+Cases: 2  Tried: 0  Errors: 0  Failures: 0warning: remote HEAD refers to nonexistent ref, unable to checkout.++### Error in:   git-annex migrate:0       +foo: getSymbolicLinkStatus: does not exist (No such file or directory)+Cases: 2  Tried: 1  Errors: 1  Failures: 0warning: remote HEAD refers to nonexistent ref, unable to checkout.++### Error in:   git-annex migrate:1       +foo: getSymbolicLinkStatus: does not exist (No such file or directory)+Cases: 2  Tried: 2  Errors: 2  Failures: 0+----------------------------------------------------------------------+ unused+Cases: 1  Tried: 0  Errors: 0  Failures: 0warning: remote HEAD refers to nonexistent ref, unable to checkout.++git-annex: foo not found+git-annex: sha1foo not found+fatal: pathspec 'foo' did not match any files+### Failure in: git-annex unused/dropunused+git rm failed+Cases: 1  Tried: 1  Errors: 0  Failures: 1+----------------------------------------------------------------------+describe+Cases: 1  Tried: 0  Errors: 0  Failures: 0warning: remote HEAD refers to nonexistent ref, unable to checkout.++Cases: 1  Tried: 1  Errors: 0  Failures: 0+----------------------------------------------------------------------+find+Cases: 1  Tried: 0  Errors: 0  Failures: 0warning: remote HEAD refers to nonexistent ref, unable to checkout.++### Error in:   git-annex find            +foo: getSymbolicLinkStatus: does not exist (No such file or directory)+Cases: 1  Tried: 1  Errors: 1  Failures: 0+----------------------------------------------------------------------+merge+Cases: 1  Tried: 0  Errors: 0  Failures: 0warning: remote HEAD refers to nonexistent ref, unable to checkout.++Cases: 1  Tried: 1  Errors: 0  Failures: 0+----------------------------------------------------------------------+status+Cases: 1  Tried: 0  Errors: 0  Failures: 0warning: remote HEAD refers to nonexistent ref, unable to checkout.++{"command":"status","supported backends":["SHA256E","SHA1E","SHA512E","SHA224E","SHA384E","SHA256","SHA1","SHA512","SHA224","SHA384","WORM","URL"],"supported remote types":["git","S3","bup","directory","rsync","web","webdav","glacier","hook"],"repository mode":"indirect","trusted repositories":[],"semitrusted repositories":[{"uuid":"00000000-0000-0000-0000-000000000001","description":"web","here":false},{"uuid":"80db3ccc-8c73-4279-b803-1b02c91dd158","description":".t/tmprepo0","here":true},{"uuid":"c01ef662-caa7-46d1-95de-544bee8b08f1","description":"origin (test repo)","here":false}],"untrusted repositories":[],"dead repositories":[],"available local disk space":"75 gigabytes (+1 megabyte reserved)","local annex keys":0,"local annex size":"0 bytes","known annex keys":0,"known annex size":"0 bytes","bloom filter size":"16 mebibytes (0% full)","success":true}+Cases: 1  Tried: 1  Errors: 0  Failures: 0+----------------------------------------------------------------------+version+Cases: 1  Tried: 0  Errors: 0  Failures: 0warning: remote HEAD refers to nonexistent ref, unable to checkout.++git-annex version: 4.20130314+local repository version: 3+default repository version: 3+supported repository versions: 3 4+upgrade supported from repository versions: 0 1 2+build flags: Assistant Webapp Pairing Testsuite S3 WebDAV Inotify DBus XMPP DNS+Cases: 1  Tried: 1  Errors: 0  Failures: 0+----------------------------------------------------------------------+sync+Cases: 1  Tried: 0  Errors: 0  Failures: 0warning: remote HEAD refers to nonexistent ref, unable to checkout.++# On branch master+#+# Initial commit+#+nothing to commit (create/copy files and use "git add" to track)+### Failure in: git-annex sync            +sync failed+Cases: 1  Tried: 1  Errors: 0  Failures: 1+----------------------------------------------------------------------+sync regression+Cases: 1  Tried: 0  Errors: 0  Failures: 0warning: remote HEAD refers to nonexistent ref, unable to checkout.++warning: remote HEAD refers to nonexistent ref, unable to checkout.++warning: remote HEAD refers to nonexistent ref, unable to checkout.++git-annex: foo not found+git-annex: foo not found+git-annex: foo not found+# On branch master+#+# Initial commit+#+nothing to commit (create/copy files and use "git add" to track)+### Failure in: git-annex sync_regression +sync failed+Cases: 1  Tried: 1  Errors: 0  Failures: 1+----------------------------------------------------------------------+map+Cases: 1  Tried: 0  Errors: 0  Failures: 0warning: remote HEAD refers to nonexistent ref, unable to checkout.++Cases: 1  Tried: 1  Errors: 0  Failures: 0+----------------------------------------------------------------------+uninit+Cases: 1  Tried: 0  Errors: 0  Failures: 0warning: remote HEAD refers to nonexistent ref, unable to checkout.++### Error in:   git-annex uninit          +foo: getSymbolicLinkStatus: does not exist (No such file or directory)+Cases: 1  Tried: 1  Errors: 1  Failures: 0+----------------------------------------------------------------------+upgrade+Cases: 1  Tried: 0  Errors: 0  Failures: 0warning: remote HEAD refers to nonexistent ref, unable to checkout.++Cases: 1  Tried: 1  Errors: 0  Failures: 0+----------------------------------------------------------------------+whereis+Cases: 1  Tried: 0  Errors: 0  Failures: 0warning: remote HEAD refers to nonexistent ref, unable to checkout.++### Error in:   git-annex whereis         +foo: getSymbolicLinkStatus: does not exist (No such file or directory)+Cases: 1  Tried: 1  Errors: 1  Failures: 0+----------------------------------------------------------------------+hook remote+Cases: 1  Tried: 0  Errors: 0  Failures: 0warning: remote HEAD refers to nonexistent ref, unable to checkout.++git-annex: foo not found+### Error in:   git-annex hook remote     +foo: getSymbolicLinkStatus: does not exist (No such file or directory)+Cases: 1  Tried: 1  Errors: 1  Failures: 0+----------------------------------------------------------------------+directory remote+Cases: 1  Tried: 0  Errors: 0  Failures: 0warning: remote HEAD refers to nonexistent ref, unable to checkout.++git-annex: foo not found+### Error in:   git-annex directory remote+foo: getSymbolicLinkStatus: does not exist (No such file or directory)+Cases: 1  Tried: 1  Errors: 1  Failures: 0+----------------------------------------------------------------------+rsync remote+Cases: 1  Tried: 0  Errors: 0  Failures: 0warning: remote HEAD refers to nonexistent ref, unable to checkout.++git-annex: foo not found+### Error in:   git-annex rsync remote    +foo: getSymbolicLinkStatus: does not exist (No such file or directory)+Cases: 1  Tried: 1  Errors: 1  Failures: 0+----------------------------------------------------------------------+bup remote+Cases: 1  Tried: 0  Errors: 0  Failures: 0warning: remote HEAD refers to nonexistent ref, unable to checkout.++Cases: 1  Tried: 1  Errors: 0  Failures: 0+----------------------------------------------------------------------+crypto+Cases: 1  Tried: 0  Errors: 0  Failures: 0warning: remote HEAD refers to nonexistent ref, unable to checkout.++git-annex: foo not found+### Error in:   git-annex crypto          +foo: getSymbolicLinkStatus: does not exist (No such file or directory)+Cases: 1  Tried: 1  Errors: 1  Failures: 0+----------------------------------------------------------------------+Some tests failed!+  (This could be due to a bug in git-annex, or an incompatability+   with utilities, such as git, installed on this system.)++> (The test suite output suggests to me that it was run on a system+> that does not support symlinks, and may be broken in some other way+> as well, but is not relevant to this bug report.)+> --[[Joey]]
+ doc/bugs/WEBDAV_443/comment_10_9ee2c5ed44295455af890caee7b06f1a._comment view
@@ -0,0 +1,18 @@+[[!comment format=mdwn+ username="https://pradermecker.myopenid.com/"+ ip="195.244.162.7"+ subject="comment 10"+ date="2013-03-18T15:47:19Z"+ content="""+Ok, I will try that.++For your information, I have rebuild the aur package inside a VM using the latest master. All tests passed.++Now I get a new error message with WEBDAV saying:++```+git-annex: WebDAV failed to write file: \"Conflict\": user error+```++As a note the current aur build is rather cumbersome because it needs to rebuild a lot of packages using cabal. I believe this is due to a few missing dependencies in the Arch repos [haskell-core] and [haskell-web] such as uuid, SafeSemaphore or c2hs.+"""]]
+ doc/bugs/WEBDAV_443/comment_11_863a7d315212c9a8ab8f6fafa5d1b7f5._comment view
@@ -0,0 +1,8 @@+[[!comment format=mdwn+ username="https://pradermecker.myopenid.com/"+ ip="195.244.162.7"+ subject="comment 11"+ date="2013-03-18T16:24:52Z"+ content="""+FYI, it is a bit heavy for me to try the standalone version as it is 32 bits only (I am on 64-bits)+"""]]
+ doc/bugs/WEBDAV_443/comment_12_c17a4e23011e0a917dbe0ecf7e9f0cb5._comment view
@@ -0,0 +1,8 @@+[[!comment format=mdwn+ username="http://joeyh.name/"+ nickname="joey"+ subject="comment 12"+ date="2013-03-18T16:33:31Z"+ content="""+The standalone version works on either architecture, it does not depend on any system libraries, thus the name \"standalone\".+"""]]
+ doc/bugs/WEBDAV_443/comment_13_3414416ff455d2fd1a7c7e7c4554b54d._comment view
@@ -0,0 +1,11 @@+[[!comment format=mdwn+ username="https://pradermecker.myopenid.com/"+ ip="195.244.162.7"+ subject="comment 13"+ date="2013-03-18T16:39:58Z"+ content="""+I actually don't know if it has something to do with 32 or 64 bits but with the standalone I have got:+/opt/git-annex.linux/runshell: line 69: /opt/git-annex.linux/bin/git-annex-shell: No such file or directory++I have tried both the aur standalone and directly downloading the tarball.+"""]]
+ doc/bugs/WEBDAV_443/comment_14_e1da141eefb0445c217e5f5c119356da._comment view
@@ -0,0 +1,8 @@+[[!comment format=mdwn+ username="http://joeyh.name/"+ nickname="joey"+ subject="comment 14"+ date="2013-03-18T16:54:02Z"+ content="""+Given that line 69 of runshell is a newline, and that runshell does not ever try to run git-annex-shell, I wonder what you downloaded exactly...+"""]]
+ doc/bugs/WEBDAV_443/comment_15_41c3134bcc222b97bf183559723713d9._comment view
@@ -0,0 +1,27 @@+[[!comment format=mdwn+ username="https://pradermecker.myopenid.com/"+ ip="195.244.162.7"+ subject="comment 15"+ date="2013-03-18T19:07:31Z"+ content="""+Euh. I actually feel stupid enough with this but ...++I have try first with your link and it gives me:++```+./runshell: line 75: /home/vagrant/programs/git-annex.linux/bin/sh: No such file or directory+```++As I told you I then try the AUR package : https://aur.archlinux.org/packages/git-annex-standalone/++And it does give me the same error on line 69.++It is the same line (3 lines before the end):++```+exec \"$cmd\" \"$@\"+```++I really don't get it because the file is there ... and the first sanity checks of the script have pass.++"""]]
+ doc/bugs/WEBDAV_443/comment_16_89621b526065b5bef753ce75db1af7b5._comment view
@@ -0,0 +1,14 @@+[[!comment format=mdwn+ username="https://pradermecker.myopenid.com/"+ ip="195.244.162.7"+ subject="comment 16"+ date="2013-03-18T19:31:42Z"+ content="""+Actually it is even worse ...++With your link, line 75 is actually 2 lines below (sh).++So same command (runshell), same error, different places (I guess it is always the last line executed) ...++Is it supposed to work fine in 64 bits also ?+"""]]
+ doc/bugs/WEBDAV_443/comment_17_131a1b65c8008cf9f02c93d4fb75720b._comment view
@@ -0,0 +1,10 @@+[[!comment format=mdwn+ username="http://joeyh.name/"+ nickname="joey"+ subject="comment 7"+ date="2013-03-18T23:05:26Z"+ content="""+The standalone linux tarball will work on 64 or 32 bit systems, as long as they are capable of linking 32 bit elf executables. I cannot test if Arch Linux is incapable of this.++I'm getting a bit tired of wild tangents, can we you just find someplace, be it a Debian chroot or whatever, to run the standalone linux tarball and test if DAV works there?+"""]]
+ doc/bugs/WEBDAV_443/comment_18_b4f894a0b9ebb84ab73f6ffcf0778090._comment view
@@ -0,0 +1,29 @@+[[!comment format=mdwn+ username="https://pradermecker.myopenid.com/"+ ip="195.244.162.7"+ subject="It works !"+ date="2013-03-19T10:40:31Z"+ content="""+Sorry for the wild tangents.++It is now working. I am not sure what went wrong.++For the record here are the steps I took (all using the Git annex UI):++* Set up removable media -> OK+* Set up remote SSH -> missing lsof -> install it -> everything OK+* Set up S3  -> had issue with time -> solve it with ntp -> everything OK+* Try again WebDav -> \"Conflict\" message -> try using another dir -> everything OK++There might be a \"cleanup after error problem\" somewhere that would explain the conflict message I have received.++Again for the record, I made it works inside a VM using the AUR \"git-annex 4.20130314-1\" (not the standalone). The only change I made on the PKGBUILD was to install everything with cabal except for the packages in the [haskell-core] Arch repo. I know you are not aware with Arch but basically I choose not to rely on the [haskell-web] Arch repo.++I will try again at home on my laptop and I will try the standalone as well.++Thanks you so much for the wonderful product !++Cheers+++"""]]
+ doc/bugs/WEBDAV_443/comment_1_c6572ca1eaaf89b01c0ed99a4058412f._comment view
@@ -0,0 +1,10 @@+[[!comment format=mdwn+ username="http://joeyh.name/"+ nickname="joey"+ subject="comment 1"+ date="2013-03-16T15:35:05Z"+ content="""+The i386 standalone build for 4.20130314, which is IIRC repackaged by Arch linux, was made using a known broken webdav library. I've since updated that build to use a new version of webdav. Since it only affected that one build, I do not plan to do a full re-release with a new version number.++Probably Arch needs to update their package.+"""]]
+ doc/bugs/WEBDAV_443/comment_2_a357969cde382a91e13920ee1e9f711c._comment view
@@ -0,0 +1,8 @@+[[!comment format=mdwn+ username="https://pradermecker.myopenid.com/"+ ip="81.244.205.197"+ subject="Thanks"+ date="2013-03-16T15:46:45Z"+ content="""+Thanks for your quick comment ! I was about to get crazy trying my password again and again ;-)+"""]]
+ doc/bugs/WEBDAV_443/comment_3_213815d6b827d467c60f3e8af925813b._comment view
@@ -0,0 +1,14 @@+[[!comment format=mdwn+ username="http://joeyh.name/"+ nickname="joey"+ subject="comment 3"+ date="2013-03-17T21:07:50Z"+ content="""+Seems that I misdiagnosed this. The error message from the bad TLS library was about a had certificate, not \"user error\" (which, confusingly, does not mean what user error normally means!).++Also, I see you reported this at <https://aur.archlinux.org/packages/git-annex/>, so you're using that build and not the \"git-annex-bin\" build at <https://aur.archlinux.org/packages.php?ID=63503>. The Arch Linux build that's done from source couldn't be affected by the Debian-spefific TLS bug anyway.++I am reopening this bug report. ++Now, FailedConnectionException could be any of several things, but I noticed that someone else (perhaps cooindidentially using Arch Linux) reported the same error message here: [[Proxy_support]]. I wonder if you perhaps also have a http proxy that could be causing trouble.+"""]]
+ doc/bugs/WEBDAV_443/comment_4_b775be4b722fc7124d9fbe2d5d01cc9f._comment view
@@ -0,0 +1,22 @@+[[!comment format=mdwn+ username="http://joeyh.name/"+ nickname="joey"+ subject="comment 4"+ date="2013-03-17T21:19:20Z"+ content="""+Digging into your error message a bit more, it looks like this is not a http proxy (or if it is, it's letting some connections through). ++git-annex is testing the box.com WebDAV server, by performing 3 actions:++1. Creating the requested subdirectory on it, in your case \"git-annex\". +2. Creating an empty file to that directory, named \"git-annex-test\"+3. Deleting the file.++Step 2 is failing. Which sort of suggests step 1 succeeded, but who knows..++So, if you go look at your files on box.com, do you have a git-annex directory?++Does git-annex/git-annex-test exist?++Does it also fail if you use a different directory, like https://www.box.com/dav/git-annex2 ?+"""]]
+ doc/bugs/WEBDAV_443/comment_5_c4ea745da437e56b2426d1c2c00dfcec._comment view
@@ -0,0 +1,17 @@+[[!comment format=mdwn+ username="https://pradermecker.myopenid.com/"+ ip="81.244.157.3"+ subject="comment 5"+ date="2013-03-17T22:03:22Z"+ content="""+No there is no directory created on box.com. I have actually tried with other names without success. I did even try to create the directory myself and use this one but it makes no difference.++I am not sure to understand what 443 means.++To be sure it is not a local config problem on my computer, I have tried to put a file to box using cadaver: cadaver works just fine (create dir, upload, delete file).++After your comment, I actually rebuild the package using master. I still have the same error with WebDav but now all tests pass (git annex test)++Let me know if you need me to do further investigation. Thanks.++"""]]
+ doc/bugs/WEBDAV_443/comment_6_ef05c0ae88fee9c626922c6064ffdf1e._comment view
@@ -0,0 +1,8 @@+[[!comment format=mdwn+ username="https://pradermecker.myopenid.com/"+ ip="81.244.157.3"+ subject="comment 6"+ date="2013-03-17T22:07:06Z"+ content="""+I have also tried with the gui and got the same error.+"""]]
+ doc/bugs/WEBDAV_443/comment_7_eecabe8d5ed564cb540450770ca7d0b6._comment view
@@ -0,0 +1,8 @@+[[!comment format=mdwn+ username="http://joeyh.name/"+ nickname="joey"+ subject="comment 7"+ date="2013-03-18T00:18:52Z"+ content="""+443 is the port used for https.+"""]]
+ doc/bugs/WEBDAV_443/comment_8_7f77ba8ebd90186d3b3949ae529ba393._comment view
@@ -0,0 +1,12 @@+[[!comment format=mdwn+ username="https://pradermecker.myopenid.com/"+ ip="195.244.162.7"+ subject="comment 8"+ date="2013-03-18T08:33:04Z"+ content="""+Yes, of course, I know about 443.++I was just surprised to see it in the error message (where as a code my mind was expecting a http error code).++What I meant is that I don't really see how it fits in the current error message.+"""]]
+ doc/bugs/WEBDAV_443/comment_9_87ebdc92b48d672964fb3f248c53600f._comment view
@@ -0,0 +1,9 @@+[[!comment format=mdwn+ username="http://joeyh.name/"+ nickname="joey"+ subject="comment 9"+ date="2013-03-18T15:04:00Z"+ content="""+I think what you need to do is try installing the [Linux standalone tarball](http://downloads.kitenet.net/git-annex/linux/current/) and see if it works with WebDAV. We need to rule out this being a bad build on the Arch side. The Linux standalone tarball works with box.com for me.++"""]]
doc/bugs/WebDAV_HandshakeFailed_.mdwn view
@@ -3,3 +3,5 @@     git-annex: HandshakeFailed (Error_Protocol ("certificate rejected: certificate is not allowed to sign another certificate",True,CertificateUnknown))  Running git-annex version: 3.20130207++> Got that bug fixed in Debian and all builds updated. [[done]] --[[Joey]]
doc/bugs/__91__webapp__93___pause_syncing_with_specific_repository.mdwn view
@@ -3,3 +3,6 @@ In a red bubble it says: "Synced with rose 60justin"  That verbage is the same if they all succeed. The only difference is the red instead of green. Would be nice to know exactly which machine to kick (if I didn't already know, eg I was syncing only with repositories not under my control).++> Fixed alert display. Webapp has allowed pausing syncing with a repository+> for a while. [[done]] --[[Joey]]
+ doc/bugs/assistant_-_GTalk_collision.mdwn view
@@ -0,0 +1,17 @@+##What steps will reproduce the problem?++Follow the [share with a friend walkthrough](http://git-annex.branchable.com/assistant/share_with_a_friend_walkthrough/).  I use my Google Talk account to pair with myself.  With the assistant running, log in to Google Talk on the web interface and set your status 'Invisible'.++##What is the expected output? What do you see instead?++I expect to remain invisible, but I get the following warning: "Oops! You are not invisible because you're logged into Google Talk from another client, device or location that doesn't support invisibility."++##What version of git-annex are you using? On what operating system?++4.20130314 on Linux.++##Please provide any additional information below.++Syncing between the repositories works ok.++[[!tag /design/assistant]]
doc/bugs/assistant_does_not_list_remote___39__origin__39__.mdwn view
@@ -22,3 +22,5 @@ I am sorry if I am missing the point. I checked the docs, however without much success.  [[!tag /design/assistant]]++[[done]]
+ doc/bugs/cannot_add_file__44___get___34__user_error__34__.mdwn view
@@ -0,0 +1,32 @@+What steps will reproduce the problem?++I can reproduce it locally:++    % annex -d add Eigene\ Bilder/+    [2013-03-19 15:44:01 CET] read: git ["--git-dir=/Users/fschulze/Bilder/.git","--work-tree=/Users/fschulze/Bilder","ls-files","--others","--exclude-standard","-z","--","Eigene Bilder/"]+    [2013-03-19 15:44:01 CET] read: git ["--git-dir=/Users/fschulze/Bilder/.git","--work-tree=/Users/fschulze/Bilder","diff","--name-only","--diff-filter=T","-z","--","Eigene Bilder/"]+    add Eigene Bilder/20070311/Bild023.jpg [2013-03-19 15:44:01 CET] chat: git ["--git-dir=/Users/fschulze/Bilder/.git","--work-tree=/Users/fschulze/Bilder","check-attr","-z","--    stdin","annex.backend","annex.numcopies","--"]+    (checksum...) [2013-03-19 15:44:01 CET] read: sha512sum ["/Users/fschulze/Bilder/.git/annex/tmp/Bild02366551.jpg"]++git-annex: user error (sha512sum ["/Users/fschulze/Bilder/.git/annex/tmp/Bild02366551.jpg"] exited 127)+failed++What is the expected output? What do you see instead?++The file isn't added.++What version of git-annex are you using? On what operating system?++OS X from dmg++    git-annex version: 4.20130314+    local repository version: 3+    default repository version: 3+    supported repository versions: 3 4+    upgrade supported from repository versions: 0 1 2+    build flags: Assistant Webapp Pairing Testsuite S3 WebDAV FsEvents XMPP DNS++> The OSX app is now changed so that git-annex is a wrapper+> script using runshell. This allows putting `git-annex.app/Contents/MacOS`+> into PATH and using git-annex, and it will find all the libraries and+> utilities bundled with it. [[done]] --[[Joey]]
doc/bugs/creating_a_remote_server_repository.mdwn view
@@ -21,4 +21,4 @@ Please provide any additional information below.  [[!tag /design/assistant]]-[[!meta title="ssh password prompting"]]+[[!meta title="ssh password prompting issue with assistant"]]
doc/bugs/get_failed__44___but_remote_has_the_file.mdwn view
@@ -33,3 +33,8 @@     upgrade supported from repository versions: 0 1 2  How should I debug this?++> [[done]], in c6fbed48 I had made some changes to allow transfers+> to work from readonly filesystems, but a too broad error trapping+> hid the "transfer already in progress" error it is supposed to display+> in this case. --[[Joey]]
doc/bugs/git-annex:_Not_in_a_git_repository._.mdwn view
@@ -17,3 +17,6 @@ Please provide any additional information below.  Its working if i start `git-annex webapp` as root. I had the same error on previous version.++> I've made some improvements. Think this was user error. [[done]]+> --[[Joey]]
+ doc/bugs/host_with_rysnc_installed__44___not_recognized.mdwn view
@@ -0,0 +1,15 @@+What steps will reproduce the problem?+Set up a remote server using ssh to a FreeNAS box++What is the expected output? What do you see instead?+Neither rsync nor git-annex are installed+rsync is in the path, user with permissions is able to run it++What version of git-annex are you using? On what operating system?+4.20130227 OSX++Please provide any additional information below.+ssh keys were installed to allow login, when ssh-askpass was not found on osx version++[[!meta title="webapp rsync probe command failed on FreeNAS box"]]+[[!tag /design/assistant]]
− doc/bugs/host_with_rysnc_installed__44___not_recognized.txt 
@@ -1,12 +0,0 @@-What steps will reproduce the problem?-Set up a remote server using ssh to a FreeNAS box--What is the expected output? What do you see instead?-Neither rsync nor git-annex are installed-rsync is in the path, user with permissions is able to run it--What version of git-annex are you using? On what operating system?-4.20130227 OSX--Please provide any additional information below.-ssh keys were installed to allow login, when ssh-askpass was not found on osx version
doc/bugs/long_running_assistant_causes_resource_starvation_on_OSX.mdwn view
@@ -24,3 +24,7 @@ I'm really not sure what to look for next. Happy to take suggestions.  [!tag /design/assistant]]++> [[done]], I found the zombie leak; the ConfigMonitor was +> leaving one zombie every time it checked a push/pull.+> Not a fast leak, but over time they would add up. --[[Joey]]
doc/bugs/map_not_respecting_annex_ssh_options__63__.mdwn view
@@ -35,3 +35,4 @@     supported repository versions: 3     upgrade supported from repository versions: 0 1 2 +> [[done]], see comment --[[Joey]]
− doc/bugs/optinally_transfer_file_unencryptedly.mdwn 
@@ -1,3 +0,0 @@-I have a git-annex repository on a NSLU 2, and transfers are much slower over ssh compared to unencrypted transfers (no wonder at that CPU speed). For the files that I am transferring, no encryption would be necessary. Unfortunately, ssh in Debian does not support "-c none" to disable encryption.--It would be nice if git-annex would have a way of conveniently transferring files in another way than SSH. I’m not sure what a good way would be – maybe launching a one-shot HTTP-server on the sending end? Haskell libraries for that would be available... Of course it is not always the case that the host reachable with "ssh foo" is also reachable via TCP at "foo:1234"... And there are surely more problem. But still, it would be nice :-)
+ doc/bugs/ssh_connection_caching_broken_on_NTFS.mdwn view
@@ -0,0 +1,63 @@+TL;DNR ssh connection caching seems to cause git-annex to not work on NTFS volumes.  Setting `annex.sshcaching` to `false` seems to solve the problem.++## What version of git-annex are you using? On what operating system? Please provide any additional information below.++* git-annex version: 3.20120629 on Debian Testing.+* `the-repo` is located on an NTFS volume on a USB HDD.+* `the-remote` is on the server `example.com`.+* `example.com` is running gitolite3 v3.2-19-gb9bbb78, git 1.7.2.5, and git-annex 3.20120629~bpo60+2+++## What steps will reproduce the problem? What is the expected output? What do you see instead?++Create or clone a repo onto an NTFS volume.  +Make sure `git annex` is initialized.  +Run some regular git operations.  These always seem to work.  +Try git-annex operations.  ++Some operations work despite the error messages:++    $ git annex sync+    Control socket connect(/media/NTFSVOL/the-repo/.git/annex/ssh/git@example.com): Connection refused+    Failed to connect to new control master+    Command ssh ["-S","/media/NTFSVOL/the-repo/.git/annex/ssh/git@example.com","-o","ControlMaster=auto","-o","ControlPersist=yes","git@example.com","git-annex-shell 'configlist' '/~/the-repo.git'"] failed; exit code 255+    Control socket connect(/media/NTFSVOL/the-repo/.git/annex/ssh/git@example.com): Connection refused+    Failed to connect to new control master+    Command ssh ["-S","/media/NTFSVOL/the-repo/.git/annex/ssh/git@example.com","-o","ControlMaster=auto","-o","ControlPersist=yes","git@example.com","git-annex-shell 'configlist' '/~/the-repo'"] failed; exit code 255+    commit  +    # On branch master+    nothing to commit (working directory clean)+    ok+    pull the-remote +    ok+    pull origin +    ok++Other operations fail:++    $ git annex copy -t the-remote the-file.jpg+    Control socket connect(/media/NTFSVOL/the-repo/.git/annex/ssh/git@example.com): Connection refused+    Failed to connect to new control master+    Command ssh ["-S","/media/NTFSVOL/the-repo/.git/annex/ssh/git@example.com","-o","ControlMaster=auto","-o","ControlPersist=yes","git@example.com","git-annex-shell 'configlist' '/~/the-repo.git'"] failed; exit code 255+    Control socket connect(/media/NTFSVOL/the-repo/.git/annex/ssh/git@example.com): Connection refused+    Failed to connect to new control master+    Command ssh ["-S","/media/NTFSVOL/the-repo/.git/annex/ssh/git@example.com","-o","ControlMaster=auto","-o","ControlPersist=yes","git@example.com","git-annex-shell 'configlist' '/~/the-repo'"] failed; exit code 255+    copy the-file.jpg (checking the-remote...) Control socket connect(/media/NTFSVOL/the-repo/.git/annex/ssh/git@example.com): Connection refused+    Failed to connect to new control master+    (unable to check the-remote) failed+    git-annex: copy: 1 failed++Some googling revealed the errors to be stale socket files.  +- [Three SSH Tips](http://shallowsky.com/blog/tags/ssh/)  +- [Improving SSH (OpenSSH) connection speed with shared connections](http://protempore.net/~calvins/howto/ssh-connection-sharing/#section-03)  ++It appears that SSH connection caching was implemented in response to this wishlist item:  +[wishlist: Prevent repeated password prompts for one command](http://git-annex.branchable.com/todo/wishlist:_Prevent_repeated_password_prompts_for_one_command/)++However ssh connection caching breaks things on NTFS volumes.  If I turn off connection caching, it seems to work fine++    $ git config annex.sshcaching false++but it would be nifty if git-annex could detect the filesystem type and do The Right Thing.++Thanks for all the work on git-annex -- it's an awesome project!
+ doc/bugs/uploads_queued_to_annex-ignore_remotes.mdwn view
@@ -0,0 +1,34 @@+## What steps will reproduce the problem?++After the assistant idles for a while, it queues many transfers to remotes configured annex-ignore=true++##What is the expected output? What do you see instead?++No attempts to upload to repos marked 'annex-ignore=true'++Instead I see many queued transfers to the remote 'origin'++[Screenshot](https://www.evernote.com/shard/s1/sh/ea0de76c-4b68-4266-b9f6-8a9c343997b6/72baab4a3ce73b0915b151829bbeaf75/res/8a8ab1fb-3173-47ea-875d-b0e320cb827b/skitch.png)++##What version of git-annex are you using? On what operating system?++    %  > git annex version+    git-annex version: 4.20130315+    local repository version: 3+    default repository version: 3+    supported repository versions: 3 4+    upgrade supported from repository versions: 0 1 2+    build flags: Assistant Webapp Pairing Testsuite S3 WebDAV FsEvents XMPP DNS++Mac OSX 10.8.2 Build 12C3006++##Please provide any additional information below.++The remote in question:++    [remote "origin"]+      url = git@git.example.com:annex-home+      fetch = +refs/heads/*:refs/remotes/origin/*+      annex-ignore = true++> belived to be [[fixed|done]] --[[Joey]]
doc/bugs/watcher_commits_unlocked_files.mdwn view
@@ -28,3 +28,10 @@   how to find the file to unlock it.  [[!meta title="assistant: watcher_commits_unlocked_files"]]++> [[done]]; I just tested and somehow this no longer happens;+> the watcher/assistant leaves the unlocked file alone, and then+> as soon as it's modified re-adds it.+> +> Also, of course, there is direct mode, which avoids needing to unlock...+> --[[Joey]]
doc/bugs/webapp_hang.mdwn view
@@ -139,3 +139,6 @@ 	0x0020:  8010 0800 fe28 0000 0101 080a 004a dfe0  .....(.......J.. 	0x0030:  004a b3da                                .J.. </pre>++[[!tag /design/assistant]]+[[done]]
+ doc/design/assistant/blog/day_215__dashboard_UI_refresh.mdwn view
@@ -0,0 +1,25 @@+I've reworked the UI of the webapp's dashboard. Now the repository list is+included, above the transfers. I found I was spending a lot of time+switching between the dashboard and repository list, so might as well+combine them into a single screen. Yesod's type safe urls and widgets+made this quite easy to do, despite it being a thousand line commit.+Liking the result ... Even though it does make all my screencasts dated.++[[!img /assistant/dashboard.png]]++----++Rest of my time was spent on XMPP pairing UI. Using the same pages for both+pairing with a friend and for self-pairing was confusing, so now the two+options are split.++Now every time an XMPP git push is received or sent, it checks if there's+a cloud repository configured, which is needed to send the contents of+files. If not, it'll display this alert. Hopefully this+will be enough to get users fully set up.++[[!img /assistant/cloudnudge.png]]++At this point I'm finally happy enough with the XMPP pairing + cloud+repository setup process to film a screencast of it. As soon as I have+some time & bandwidth someplace quiet. Expect one by the end of the month.
+ doc/design/assistant/blog/day_216__more_bugfixes.mdwn view
@@ -0,0 +1,42 @@+A long time ago I made Remote be an instance of the Ord typeclass, with an+implementation that compared the costs of Remotes. That seemed like a good+idea at the time, as it saved typing.. But at the time I was still making+custom Read and Show instances too. I've since learned that this is *not* a+good idea, and neither is making custom Ord instances, without deep thought+about the possible sets of values in a type.++This Ord instance came around and bit me when I put Remotes into a Set,+because now remotes with the same cost appeared to be in the Set even if +they were not. Also affected putting Remotes into a Map. I noticed this+when the webapp got confused about which Remotes were paused.++Rarely does a bug go this deep. I've fixed it comprehensively, first+removing the Ord instance entirely, and fixing the places that wanted to+order remotes by cost to do it explicitly. Then adding back an Ord instance+that is much more sane. Also by checking the rest of the Ord (and Eq) +instances in the code base (which were all ok).++While doing that, I found lots of places that kept remotes in Maps and+Sets. All of it was probably subtly broken in one way or another before+this fix, but it would be hard to say exactly how the bugs would+manifest.++-----++Also fought some with Google Talk today. Seem to be missing presence+messages sometimes. Ugh. May have fixed it, but I've thought that before..++Made --debug include a sanitized dump of the XMPP protocol.++Made UI changes to encourage user to install git-annex on the server when+adding a ssh server, rather than just funneling them through to rsync.++Fixed UI glitches in XMPP username/password prompt.++Switched all forms in the webapp to use POST, to avoid sensitive+information leaking on the url bar.++----++Added an incremental backup group. Repositories in this group only want+files that have not been backed up somewhere else yet.
+ doc/design/assistant/blog/day_217__nothing.mdwn view
@@ -0,0 +1,2 @@+Is what I planned to do on git-annex today. Instead I fixed several bugs,+but I'm drawing the line at blogging. Oops.
+ doc/design/assistant/blog/day_219__bug_triage.mdwn view
@@ -0,0 +1,14 @@+Triaged some of the older bugs and was able to close a lot of them.++-----++Should mention that I will be in Boston this weekend, attending+[LibrePlanet 2013](http://libreplanet.org/wiki/LibrePlanet:Conference/2013).+Drop by and find me, I'll have git-annex stickers! ;)++-----++Did some UI work on the webapp. Minor stuff, but stuff that needed to be+fixed up. Like inserting zero-width spaces into filenames displayed in it+so very long filenames always get reasonably wrapped by the browser.+(Perhaps there's a better way to do that with CSS?)
+ doc/design/assistant/blog/day_220__performance.mdwn view
@@ -0,0 +1,40 @@+I've been running some large transfers with the assistant, and looking at+ways to improve performance. (I also found and fixed a zombie process+leak.)++----++One thing I noticed is that the assistant pushes changes to the git-annex+location log quite frequently during a batch transfer. If the files being+transferred are reasonably sized, it'll be pushing once per file transfer. +It would be good to reduce the number of pushes, but the pushes are+important in some network topologies to inform other nodes+when a file gets near to them, so they can get the file too.++Need to see if I can find a smart way to avoid some of the pushes.+For example, if we've just downloaded a file, and are queuing uploads+of the file to a remote, we probably don't need to push the git-annex+branch to the remote.++----++Another performance problem is that having the webapp open while transfers+are running uses significant CPU just for the browser to update the progress+bar. Unsurprising, since the webapp is sending the browser a new `<div>`+each time. Updating the DOM instead from javascript would avoid that;+the webapp just needs to send the javascript either a full `<div>` or a+changed percentage and quantity complete to update a single progress bar.++I'd prefer to wait on doing that until I'm able to use Fay to generate+Javascript from Haskell, because it would be much more pleasant.. will see.++----++Also a performance problem when performing lots of transfers, particularly+of small files, is that the assistant forks off a `git annex transferkey`+for each transfer, and that has to in turn start up several git commands.++Today I have been working to change that, so the assistant maintains a+pool of transfer processes, and dispatches each transfer it wants to make+to a process from the pool. I just got all that to build, although untested+so far, in the `transferpools` branch.
+ doc/design/assistant/blog/day_221__this_and_that.mdwn view
@@ -0,0 +1,28 @@+Was unsure yesterday if my transferrer pools code would just work, or+would be horribly broken and need a lot of work to get going. It was a+complex change involving both high-level STM code and low-level pipes and+fds. Well, it almost worked 100% first time, I just had a minor issue in+my fd setup to fix. Everything else seems to work perfectly.+Very happy how that went!++----++Improved support and documentation for using the OSX app and Linux+standalone tarball at the command line. Now it's sufficient to just put+their directory into `PATH`, rather than using `runshell`.++----++The webapp's form for adding a removable drive now allows specifying the+directory to use within the drive (default "annex").++When the drive's repository already exists, and it's not a repository+that git-annex knows about, it confirms that the user wants+to combine its contents into their repository.+++(Should probably implement this same check when adding a ssh remote.)++----++Off to Boston!
doc/design/assistant/inotify.mdwn view
@@ -6,14 +6,11 @@  ## known bugs -* When you `git annex unlock` a file, it will immediately be re-locked.-  See [[bugs/watcher_commits_unlocked_files]].- * Kqueue has to open every directory it watches, so too many directories   will run it out of the max number of open files (typically 1024), and fail.   I may need to fork off multiple watcher processes to handle this.   See [[bug|bugs/Issue_on_OSX_with_some_system_limits]]. (Does not affect-  OSX any longer).+  OSX any longer, only other BSDs).  ## todo @@ -28,7 +25,7 @@ * There needs to be a way for a new version of git-annex, when installed,   to restart any running watch or assistant daemons. Or for the daemons   to somehow detect it's been upgraded and restart themselves. Needed-  to allow for imcompatable changes and, I suppose, for security upgrades..+  to allow for incompatable changes and, I suppose, for security upgrades..  ## beyond Linux @@ -203,3 +200,5 @@ - If a file is checked into git as a normal file and gets modified   (or merged, etc), it will be converted into an annexed file.   See [[blog/day_7__bugfixes]]. **done**; we always check ls-files now+- When you `git annex unlock` a file, it will immediately be re-locked.+  See [[bugs/watcher_commits_unlocked_files]]. Seems fixed now?
doc/design/assistant/leftovers.mdwn view
@@ -8,7 +8,8 @@   are not kept synced, but in some situations (ie, low disk space phones),   that is likely. * Drop files that have not been used lately, or meet some other criteria-  (as long as there's a copy elsewhere).+  (as long as there's a copy elsewhere). **done** (via preferred content;+  eg archive directories) * Perhaps automatically dropunused files that have been deleted,   although I cannot see a way to do that, since by the time the inotify   deletion event arrives, the file is deleted, and we cannot see what
doc/design/assistant/syncing.mdwn view
@@ -1,19 +1,27 @@ Once files are added (or removed or moved), need to send those changes to all the other git clones, at both the git level and the key/value level. -## bugs+## efficiency -* Rename detection code is now pretty good, but can occasionally fail-  due to eg system load causing the wait for the delete+add pair to-  not collect them together. Want to avoid making the delay longer-  (and any length might not be enough in all cases), but in direct mode-  a failure can mean an expensive re-checksum.+Currently after each file transfer (upload or download), a git sync is done+to all remotes. This is rather a lot of work, also it prevents collecting+presence changes to the git-annex branch into larger commits, which would+save disk space over time. -  Idea: Keep a ring buffer map (what data structure?) of the last-  N delete events, and look through it to determine if the current-  event matches one of those. This assumes that delete events come first,-  which they do.+In many cases, this sync is necessary. For example, when a file is uploaded+to a transfer remote, the location change needs to be synced out so that+other clients know to grab it. +Or, when downloading a file from a drive, the sync lets other locally+paired repositories know we got it, so they can download it from us. +OTOH, this is also a case where a sync is sometimes unnecessary, since+if we're going to upload the file to them after getting it, the sync+only perhaps lets them start downloading it before our transfer queue+reaches a point where we'd upload it.++Do we need all the mapping stuff discussed below to know when we can avoid+syncs?+ ## TODO  * Test MountWatcher on LXDE.@@ -42,11 +50,6 @@   working copy and checks each file. That probably needs to be done once,   but further calls to the TransferScanner could eg, look at the delta   between the last scan and the current one in the git-annex branch.-* After git sync, identify new content that we don't have that is now available-  on remotes, and transfer. (Needed when we have a uni-directional connection-  to a remote, so it won't be uploading content to us.) Note: Does not-  need to use the TransferScanner, if we get and check a list of the changed-  files. done? * [[use multiple transfer slots|todo/Slow_transfer_for_a_lot_of_small_files.]] * The TransferQueue's list of deferred downloads could theoretically   grow without bounds in memory. Limit it to a given number of entries,
doc/design/assistant/webapp.mdwn view
@@ -1,15 +1,17 @@ The webapp is a web server that displays a shiny interface. -## interface+## performance -* Combine the replist with the dashboard. Put the list of repos or nudge-  to make repos on top, and the transfers below. Make a "+ Add repo" button-  on the list of repos that expands a hidden div, showing the repo creation-  choices. Only one problem: If I have 20 repositories, all-  I can see on the dashboard w/o scrolling is my repos..+Having the webapp open while transfers are+running uses significant CPU just for the browser to update the progress +bar. Unsurprising, since the webapp is sending the browser a new `<div>`+each time. Updating the DOM instead from javascript would avoid that;+the webapp just needs to send the javascript either a full `<div>` or a +changed percentage and quantity complete to update a single progress bar. -* drag and drop to reorder-* keep it accessible to blind, etc+(Another reason to do this is it'll cut down on the refreshes, which +sometimes make browsers ignore clicks on UI elements like the pause button, +if the transfer display refreshes just as the click is made.)  ## other features
+ doc/forum/Check_if_remote_is_using_GPG__63__.mdwn view
@@ -0,0 +1,1 @@+Is there a way to check if a special remote is setup to use GPG? And, if so, see the ID of keys that it is encrypting to?
+ doc/forum/Direct_special_remotes.mdwn view
@@ -0,0 +1,26 @@+I have a NAS at home which I access both as AFP/SMB shares and thru ssh/rsync.  Now, I'd like to keep on using the shares as before, i.e., browsable via AFP/SMB with conventional file names.  Ideally, I'd also like to git-annex some NAS shares, preferably, in direct mode. However, it seems out of the question to install git-annex on the NAS (hopefully, I'm wrong about this in the long run).++Two **non-special remote setups** would be:++1. Mount the share and turn it into a direct mode git annex repo.  Does anybody have experience with this?  I'd suspect this to be very inefficient due to the use of all the files in .git over AFP/SMB.  Configuration as a WORM backend seems to be advised? (Edit: Well, I just tried this and 'git annex init' failed as described in this [forum post](http://git-annex.branchable.com/forum/Can__39__t_init_git_annex/).  So AFP/SMB seem to be non-starters. :-(  Furthermore, AFP/SMB are immediately detected as crippled and set to direct mode automatically.)+2. Same as 1. but with a local GIT_DIR.  This should work by having .git on the NAS link to the local GIT_DIR.++Alternatively, I could treat my NAS as a [**web special remote**](http://git-annex.branchable.com/tips/using_the_web_as_a_special_remote/).  Some URL schemes come to mind:++* **file:**  This would benefit from some wish list items ([recursive directory remote setup/addurl](http://git-annex.branchable.com/todo/wishlist:_recursive_directory_remote_setup__47__addurl/)).+* **rsync:** AFAIK not implemented (yet?) as an option for web special remotes.+* **sftp:** (Might also include ssh access.)++The problem is that the "web semantics" don't really work in my use case:++* Files might change/move on the NAS.+* I'd like changes (e.g., renamed files) in my local repo to propagate to the NAS.  Currently, git-annex would use git push for this purpose IIUC, however that's not available on the NAS...+* the web semantics seem to imply that there is exactly one "web" repository (and the URL is fixed)++All of these indicate a mismatch between my use case and web special remotes.++Hence my question: **Would something like a "direct special remote" make sense?**++As a starting point I'd look at a setup similar to 2. above, i.e., a remote "working copy" with local GIT_DIR.  Except that instead of a whole local .git directory a branch in an existing .git dir might be more appropriate...++--Chris
+ doc/forum/Howto_remove_a_repository__63__.mdwn view
@@ -0,0 +1,4 @@+Hello,++I have added a few repositories for testing purpose and would like to remove them.+Is it possible to remove a repository through assistant?
+ doc/forum/Local_and_remote_in_direct_mode.mdwn view
@@ -0,0 +1,7 @@+I have two machines (A and B ) both have a directory called "inbox"+I want to sync these two directories. So I ran git annex assistant on machine A and set up a remote to B with **ssh** and selected **client: a repository on your computer**.++The end result is that I have something that looks like a git bare repo on machine B and I have no files on A from machine B.++What am I doing wrong? What shall I do to achieve my goal?+It is kind of dropbox functionality what I want. (Which I never used for security/policy reasons.)
+ doc/forum/Managing_multiple_repositories_concurrently__63__.mdwn view
@@ -0,0 +1,5 @@+I have the webapp setup to manage 4 different repositories.++One repository had many gigabytes to upload to a remote. As this was moving along, I wanted to check on the status of one of the other repositories. I knew that this second repository had a lot of data to download. When I switched to the second repo in the webapp, I noticed in my network monitor that the amount of upstream bandwidth I was using dropped and the amount of downstream bandwidth increased. I switched back to the first repo, and my downstream bandwidth dropped and the upstream bandwidth increased.++It looks like git-annex stopped uploading data from the first repo when I switched to the second, and stopped downloading data to the second repo when I switched to the first. Is this correct? I was under the impression that switching repositories in the webapp simply changed the view that I was looking at, but that the assistant would still be managing all the repositories I had setup -- uploading/downloading/syncing concurrently.
+ doc/forum/Post-Kickstarter.mdwn view
@@ -0,0 +1,5 @@+We're nearing the end of the year of development funded by Kickstarter. I'm curious to know what the future of the project looks like.++I assume that development will decrease from its current levels as you focus more of your energy on activities that put bread on the table, but is git-annex still something that you foresee actively working on or will it be in more of a feature-freeze-bug-fix stage?++As a backer my only regret is that during the campaign I wasn't able to donate as much as I would have liked. The project has exceeded my expectations since then. I don't know that another Kickstarter campaign is worth the effort, but if you were to ask for donations to fund another month or two or three I would gladly donate. Or perhaps implement a feature-bounty program where users could donate money toward development of a particular feature they would like to see added. Or perhaps you're sick of working for the Internet!
doc/git-annex.mdwn view
@@ -508,7 +508,7 @@  	git annex dropkey SHA1-s10-7da006579dd64330eb2456001fd01948430572f2 -* transferkey key+* transferkeys    This plumbing-level command is used by the assistant to transfer data.
doc/install/Linux_standalone.mdwn view
@@ -8,7 +8,12 @@ [download tarball](http://downloads.kitenet.net/git-annex/linux/current/)  To use, just unpack the tarball, `cd git-annex.linux` and run `./runshell`--- this sets up an environment where you can use `git annex`+-- this sets up an environment where you can use `git annex`, as well+as everything else included in the bundle.++Alternatively, you can unpack the tarball, and add the directory to your+`PATH`. This lets you use `git annex`, without overriding your system's+own versions of git, etc.  Warning: This is a last resort. Most Linux users should instead [[install]] git-annex from their distribution of choice.
doc/install/OSX.mdwn view
@@ -1,9 +1,21 @@ ## git-annex.app +[[!img /assistant/osx-app.png align=right link=/assistant]] For easy installation, use the [beta release of git-annex.app](http://downloads.kitenet.net/git-annex/OSX/current/).  Be sure to select the build matching your version of OSX.++If you want to run the [[git-annex_assistant|/assistant]], just+install the app, look for the icon, and start it up. ++To use git-annex at the command line, you can add+`git-annex.app/Contents/MacOS` to your `PATH`++Alternatively, from the command line you can run+`git-annex.app/Contents/MacOS/runshell`, which makes your shell use all the+programs bundled inside the app, including not just git-annex, but git, and+several more. Handy if you don't otherwise have git installed.  This is still a work in progress. See [[/bugs/OSX_app_issues]] for problem reports.
doc/install/openSUSE.mdwn view
@@ -1,12 +1,3 @@-Unfortunately there is currently no git-annex rpm available for openSUSE;-however it is possible to build it via cabal or from source as described on-the [[install]] page.  Fulfilling the dependencies listed on that page-should not be a problem, except for obtaining a suitable version of the-Haskell library.+Haskell Platform 2012.4 is now [officially available for openSUSE](http://software.opensuse.org/package/haskell-platform) via 1-Click Install.  -The last [official release of Haskell for openSUSE](https://build.opensuse.org/project/show?project=devel:languages:haskell)-is quite old, and may not satisfy the dependencies needed by git-annex.-Fortunately [searching the openSUSE build service](http://software.opensuse.org/search?q=cabal&baseproject=openSUSE%3A11.4&lang=en&include_home=true&exclude_debug=true)-reveals that Peter Trommler has built a [newer Haskell suite](https://build.opensuse.org/project/show?project=home%3Aptrommler%3Adevel%3Alanguages%3Ahaskell)-based on ghc 7.2. To install this, simply click on the relevant-"1-Click Install" link in the openSUSE build service search results.+At the time of writing, there are [unofficial packages of git-annex](http://software.opensuse.org/package/git-annex) available for openSUSE 12.2.  It should also be possible to build it via cabal or from source as described on the [[install]] page.
− doc/news/version_3.20130124.mdwn 
@@ -1,28 +0,0 @@-git-annex 3.20130124 released with [[!toggle text="these changes"]]-[[!toggleable text="""-   * Added source repository group, that only retains files until they've-     been transferred to another repository. Useful for things like-     repositories on cameras.-   * Added manual repository group. Use to prevent the assistant from-     downloading any file contents to keep things in sync. Instead-     `git annex get`, `git annex drop` etc can be used manually as desired.-   * webapp: More adjustments to longpoll code to deal with changes in-     variable quoting in different versions of shakespeare-js.-   * webapp: Avoid an error if a transfer is stopped just as it finishes.-     Closes: #[698184](http://bugs.debian.org/698184)-   * webapp: Now always logs to .git/annex/daemon.log-   * webapp: Has a page to view the log, accessed from the control menu.-   * webapp: Fix crash adding removable drive that has an annex directory-     in it that is not a git repository.-   * Deal with incompatability in gpg2, which caused prompts for encryption-     passphrases rather than using the supplied --passphrase-fd.-   * bugfix: Union merges involving two or more repositories could sometimes-     result in data from one repository getting lost. This could result-     in the location log data becoming wrong, and fsck being needed to fix it.-   * sync: Automatic merge conflict resolution now stages deleted files.-   * Depend on git 1.7.7.6 for --no-edit. Closes: #[698399](http://bugs.debian.org/698399)-   * Fix direct mode mapping code to always store direct mode filenames-     relative to the top of the repository, even when operating inside a-     subdirectory.-   * fsck: Detect and fix consistency errors in direct mode mapping files.-   * Avoid filename encoding errors when writing direct mode mappings."""]]
+ doc/news/version_4.20130323.mdwn view
@@ -0,0 +1,37 @@+git-annex 4.20130323 released with [[!toggle text="these changes"]]+[[!toggleable text="""+   * webapp: Repository list is now included in the dashboard, and other+     UI tweaks.+   * webapp: Improved UI for pairing your own devices together using XMPP.+   * webapp: Display an alert when there are XMPP remotes, and a cloud+     transfer repository needs to be configured.+   * Add incrementalbackup repository group.+   * webapp: Encourage user to install git-annex on a server when adding+     a ssh server, rather than just funneling them through to rsync.+   * xmpp: --debug now enables a sanitized dump of the XMPP protocol+   * xmpp: Try harder to detect presence of clients when there's a git push+     to send.+   * xmpp: Re-enable XA flag, since disabling it did not turn out to help+     with the problems Google Talk has with not always sending presence+     messages to clients.+   * map: Combine duplicate repositories, for a nicer looking map.+   * Fix several bugs caused by a bad Ord instance for Remote.+   * webapp: Switch all forms to POST.+   * assistant: Avoid syncing with annex-ignored remotes when reconnecting+     to the network, or connecting a drive.+   * assistant: Fix OSX bug that prevented committing changed files to a+     repository when in indirect mode.+   * webapp: Improved alerts displayed when syncing with remotes, and+     when syncing with a remote fails.+   * webapp: Force wrap long filenames in transfer display.+   * assistant: The ConfigMonitor left one zombie behind each time+     it checked for changes, now fixed.+   * get, copy, move: Display an error message when an identical transfer+     is already in progress, rather than failing with no indication why.+   * assistant: Several optimisations to file transfers.+   * OSX app and standalone Linux tarball now both support being added to+     PATH; no need to use runshell to start git-annex.+   * webapp: When adding a removable drive, you can now specify the+     directory inside it to use.+   * webapp: Confirm whether user wants to combine repositories when+     adding a removable drive that already has a repository on it."""]]
doc/preferred_content.mdwn view
@@ -56,7 +56,7 @@ So, for example, `copies=2` in a preferred content expression lets content be dropped only when there are currently 3 copies of it, including the repo it's being dropped from. This is different than running `git annex-drop --copies=2`, which will drop files that current have 2 copies.+drop --copies=2`, which will drop files that currently have 2 copies.  ### difference: "present" @@ -108,6 +108,13 @@ All content is preferred.  `include=*`++### incremental backup++Only prefers content that's not already backed up to another backup+or incremental backup repository.++`include=* and (not copies=backup:1) and (not copies=incrementalbackup:1)`  ### small archive
+ doc/special_remotes/comment_10_e9881290486a1770bd260f8650ada9c6._comment view
@@ -0,0 +1,8 @@+[[!comment format=mdwn+ username="https://www.google.com/accounts/o8/id?id=AItOawkQqKSVY98PVGDIaYZdK9CodJdbh7cFfhY"+ nickname="Ashwin"+ subject="Rackspace Cloud Files support"+ date="2013-03-22T08:20:40Z"+ content="""+It'd be really cool to have Rackspace cloud files support. Like the guy above me said, I would submit a patch but not if I have to learn Haskell first :)+"""]]
+ doc/todo/optinally_transfer_file_unencryptedly.mdwn view
@@ -0,0 +1,3 @@+I have a git-annex repository on a NSLU 2, and transfers are much slower over ssh compared to unencrypted transfers (no wonder at that CPU speed). For the files that I am transferring, no encryption would be necessary. Unfortunately, ssh in Debian does not support "-c none" to disable encryption.++It would be nice if git-annex would have a way of conveniently transferring files in another way than SSH. I’m not sure what a good way would be – maybe launching a one-shot HTTP-server on the sending end? Haskell libraries for that would be available... Of course it is not always the case that the host reachable with "ssh foo" is also reachable via TCP at "foo:1234"... And there are surely more problem. But still, it would be nice :-)
git-annex.1 view
@@ -458,7 +458,7 @@ .IP  git annex dropkey SHA1\-s10\-7da006579dd64330eb2456001fd01948430572f2 .PP-.IP "transferkey key"+.IP "transferkeys" This plumbing\-level command is used by the assistant to transfer data. .IP .IP "rekey [file key ...]"
git-annex.cabal view
@@ -1,5 +1,5 @@ Name: git-annex-Version: 4.20130314+Version: 4.20130323 Cabal-Version: >= 1.8 License: GPL Maintainer: Joey Hess <joey@kitenet.net>
standalone/linux/README view
@@ -1,16 +1,18 @@-To start the git-annex webapp, run the git-annex-webapp script in this-directory.+You can put this directory into your PATH, and use git-annex the same+as if you'd installed it using a package manager. -To enter an environment with git-annex in PATH, use runshell+Or, you can use the runshell script in this directory to start a shell+that is configured to use git-annex and the other utilities included in+this bundle, including git, gpg, rsync, ssh, etc.  This should work on any Linux system of the appropriate architecture. More or less. There are no external dependencies, except for glibc. Any recent-ish version of glibc should work (2.13 is ok; so is 2.11).  -How it works: This directory contains a lot of libraries and programs-that git-annex needs. But it's not a chroot. Instead, runshell sets-PATH and LD_LIBRARY_PATH to point to the stuff in this directory.+How it works: This directory tree contains a lot of libraries and programs+that git-annex needs. But it's not a chroot. Instead, runshell sets PATH+and LD_LIBRARY_PATH to point to the stuff in here.  The glibc libs are not included. Instead, it runs with the host system's glibc. We trust that glibc's excellent backwards and forward compatability
standalone/linux/git-annex view
@@ -1,5 +1,5 @@ #!/bin/sh-base="$(dirname $0)"+base="$(dirname "$0")" if [ ! -d "$base" ]; then 	echo "** cannot find base directory (I seem to be $0)" >&2 	exit 1
standalone/linux/git-annex-webapp view
@@ -1,5 +1,5 @@ #!/bin/sh-base="$(dirname $0)"+base="$(dirname "$0")" if [ ! -d "$base" ]; then 	echo "** cannot find base directory (I seem to be $0)" >&2 	exit 1
standalone/linux/runshell view
@@ -4,7 +4,7 @@  set -e -base="$(dirname $0)"+base="$(dirname "$0")"  if [ ! -d "$base" ]; then 	echo "** cannot find base directory (I seem to be $0)" >&2
+ standalone/osx/git-annex.app/Contents/MacOS/README view
@@ -0,0 +1,9 @@+This is a app bundle for git-annex. Most users are going to want to+just click on the icon to start up the git-annex webapp.++To use git-annex at the command line, you can put the directory containing+this README into your PATH.++Or, you can use the runshell script in this directory to start a shell+that is configured to use git-annex and the other utilities included in+this bundle, including git, gpg, rsync, ssh, etc.
standalone/osx/git-annex.app/Contents/MacOS/git-annex view
@@ -1,5 +1,5 @@ #!/bin/sh-base="$(dirname $0)"+base="$(dirname "$0")" if [ ! -d "$base" ]; then 	echo "** cannot find base directory (I seem to be $0)" >&2 	exit 1
standalone/osx/git-annex.app/Contents/MacOS/git-annex-webapp view
@@ -1,5 +1,5 @@ #!/bin/sh-base="$(dirname $0)"+base="$(dirname "$0")" if [ ! -d "$base" ]; then 	echo "** cannot find base directory (I seem to be $0)" >&2 	exit 1
standalone/osx/git-annex.app/Contents/MacOS/runshell view
@@ -4,19 +4,21 @@  set -e -base="$(dirname $0)"+base="$(dirname "$0")"  if [ ! -d "$base" ]; then 	echo "** cannot find base directory (I seem to be $0)" >&2 	exit 1 fi -if [ ! -e "$base/git-annex" ]; then-	echo "** base directory $base does not contain git-annex" >&2+bundle="$base/bundle"++if [ ! -e "$bundle/git-annex" ]; then+	echo "** bundle directory $bundle does not contain git-annex" >&2 	exit 1 fi-if [ ! -e "$base/git" ]; then-	echo "** base directory $base does not contain git" >&2+if [ ! -e "$bundle/git" ]; then+	echo "** bundle directory $bundle does not contain git" >&2 	exit 1 fi @@ -43,17 +45,17 @@ # system binaries. ORIG_PATH="$PATH" export ORIG_PATH-PATH=$base:$PATH+PATH=$bundle:$PATH export PATH  ORIG_GIT_EXEC_PATH="$GIT_EXEC_PATH" export ORIG_GIT_EXEC_PATH-GIT_EXEC_PATH=$base+GIT_EXEC_PATH=$bundle export GIT_EXEC_PATH  ORIG_GIT_TEMPLATE_DIR="$GIT_TEMPLATE_DIR" export ORIG_GIT_TEMPLATE_DIR-GIT_TEMPLATE_DIR="$base/templates"+GIT_TEMPLATE_DIR="$bundle/templates" export GIT_TEMPLATE_DIR  # Indicate which variables were exported above.
templates/configurators/addbox.com.hamlet view
@@ -8,7 +8,7 @@     Even a small amount of free storage is useful, as a transfer point #     between your repositories.   <p>-    <form .form-horizontal enctype=#{enctype}>+    <form method="post" .form-horizontal enctype=#{enctype}>       <fieldset>         ^{form}         ^{webAppFormAuthToken}
templates/configurators/adddrive.hamlet view
@@ -22,18 +22,11 @@         <a .btn .btn-primary href="@{AddDriveR}">           Rescan for removable drives   $else-    <form enctype=#{enctype}>+    <form method="post" enctype=#{enctype}>       <fieldset>         ^{form}         ^{webAppFormAuthToken}         <button .btn .btn-primary type=submit onclick="$('#clonemodal').modal('show');">Use this drive</button> #         <a .btn href="@{AddDriveR}">           Rescan for removable drives-<div .modal .fade #clonemodal>-  <div .modal-header>-    <h3>-      Cloning to drive-  <div .modal-body>-    <p>-      Cloning the repository to the drive. This may take a few minutes; #-      do not remove the drive.+^{cloneModal}
+ templates/configurators/adddrive/clonemodal.hamlet view
@@ -0,0 +1,8 @@+<div .modal .fade #clonemodal>+  <div .modal-header>+    <h3>+      Cloning to drive+  <div .modal-body>+    <p>+      Cloning the repository to the drive. This may take a few minutes; #+      do not remove the drive.
+ templates/configurators/adddrive/confirm.hamlet view
@@ -0,0 +1,19 @@+<div .span9 .hero-unit>+  <h2>+    Combine repositories?+  <p>+    The removable drive at <tt>#{mountPoint drive}</tt> already+    has files in its repository <tt>#{driveRepoPath drive}</tt>+  <p>+    Do you want to combine these files into your repository?+  <p>+    <a .btn href="@{FinishAddDriveR drive}">+      <i .icon-resize-small></i> Combine the repositories #+    The combined repositories will sync and share their files.+  <p>+  <p>+    <a .btn href="@{AddDriveR}">+      <i .icon-resize-full></i> Go back #+    Use a different directory than <tt>#{driveRepoPath drive}</tt> to #+    avoid combining the repositories.+^{cloneModal}
templates/configurators/addglacier.hamlet view
@@ -16,7 +16,7 @@     <a href="http://aws.amazon.com/glacier/pricing/">       Pricing details   <p>-    <form .form-horizontal enctype=#{enctype}>+    <form method="post" .form-horizontal enctype=#{enctype}>       <fieldset>         ^{form}         ^{webAppFormAuthToken}
+ templates/configurators/addrepository.hamlet view
@@ -0,0 +1,14 @@+<div .span9>+  ^{repolist}+  <div .row-fluid>+    <div .span6>+      <h2>+        Add more repositories++      ^{makeMiscRepositories}++    <div .span6>+      <h2>+        Store your data in the cloud++      ^{makeCloudRepositories False}
+ templates/configurators/addrepository/cloud.hamlet view
@@ -0,0 +1,31 @@+<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+<p>+  Works very well with git-annex.++<h3>+  <a href="@{AddS3R}">+    <i .icon-plus-sign></i> Amazon S3+<p>+  Good choice for professional quality storage.++$if not onlyTransfer+  <h3>+    <a href="@{AddGlacierR}">+      <i .icon-plus-sign></i> Amazon Glacier+  <p>+    Low cost offline data archival.++<h3>+  <a href="@{AddSshR}">+    <i .icon-plus-sign></i> Remote server+<p>+  Set up a repository on a remote server using #+  <tt>ssh</tt>.
+ templates/configurators/addrepository/misc.hamlet view
@@ -0,0 +1,45 @@+<h3>+  <a href="@{AddDriveR}">+    <i .icon-plus-sign></i> Removable drive+<p>+  Add a USB drive, memory stick, or other removable media. #+  For offline archiving, backups, or to #+  <a href="http://en.wikipedia.org/wiki/Sneakernet">SneakerNet</a> #+  between computers. ++<h3>+  <a href="@{StartXMPPPairSelfR}">+    <i .icon-plus-sign></i> Share with your other devices+<p>+  Keep files in sync between your devices running git-annex.++<h3>+  <a href="@{StartXMPPPairFriendR}">+    <i .icon-plus-sign></i> Share with a friend+<p>+  Combine your repository with a friend's repository, and share your files.++<h3>+  <a href="@{StartLocalPairR}">+    <i .icon-plus-sign></i> Local computer+<p>+  Pair with a computer to keep files in sync quickly, #+  over your local network.++<h3>+  <a href="@{NewRepositoryR}">+    <i .icon-plus-sign></i> Add another repository+<p>+  Make another repository on your computer.++<h3>+  <i .icon-plus-sign></i> Phone+<p>+  Save photos and recordings from your phone.+<p>+  Send selected files to your phone.++<h3>+  <i .icon-plus-sign></i> Network Attached Storage+<p>+  Connect to a local storage appliance (NAS).
templates/configurators/addrsync.net.hamlet view
@@ -17,7 +17,7 @@         <div>           Your data will be encrypted before it is sent to Rsync.net.   <p>-    <form .form-horizontal enctype=#{enctype}>+    <form method="post" .form-horizontal enctype=#{enctype}>       <fieldset>         ^{form}         ^{webAppFormAuthToken}
templates/configurators/adds3.hamlet view
@@ -12,7 +12,7 @@     <a href="http://aws.amazon.com/s3/pricing/">       Pricing details, including one year Free Usage Tier promotion   <p>-    <form .form-horizontal enctype=#{enctype}>+    <form method="post" .form-horizontal enctype=#{enctype}>       <fieldset>         ^{form}         ^{webAppFormAuthToken}
templates/configurators/editrepository.hamlet view
@@ -13,14 +13,14 @@         right choice if you'll use it to shuttle data back and forth #         between other repositories. Otherwise, pick one of the other groups.   <p>-    <form .form-horizontal enctype=#{enctype}>+    <form method="post" .form-horizontal enctype=#{enctype}>       <fieldset>         ^{form}         ^{webAppFormAuthToken}         <div .form-actions>           <button .btn .btn-primary type=submit>             Save Changes-          <a .btn href="@{RepositoriesR}">+          <a .btn href="@{DashboardR}">             Cancel   $if new     <p>
templates/configurators/enableaws.hamlet view
@@ -14,7 +14,7 @@     <a href="https://console.aws.amazon.com/iam/home">       IAM Management Console.   <p>-    <form .form-horizontal enctype=#{enctype}>+    <form method="post" .form-horizontal enctype=#{enctype}>       <fieldset>         ^{form}         ^{webAppFormAuthToken}
templates/configurators/enabledirectory.hamlet view
@@ -6,5 +6,5 @@   <p>     <a .btn href="@{AddDriveR}">       On a removable drive-    <a .btn href="@{RepositoriesR}">+    <a .btn href="@{DashboardR}">       Cancel
templates/configurators/enablewebdav.hamlet view
@@ -6,7 +6,7 @@     <a href="#{url}">       #{url}   <p>-    <form .form-horizontal enctype=#{enctype}>+    <form method="post" .form-horizontal enctype=#{enctype}>       <fieldset>         ^{form}         ^{webAppFormAuthToken}
− templates/configurators/intro.hamlet 
@@ -1,24 +0,0 @@-<div .span9 ##{ident} .hero-unit>-  $maybe reldir <- relDir webapp-   <h2>-      git-annex is watching over your files in <small><tt>#{reldir}</tt></small>-    <p>-      It will automatically notice changes, and keep files in sync #-      $if (null repolist)-        with repositories elsewhere ...-        <h2>-          But no other repositories are set up yet.-        <a .btn .btn-primary .btn-large href="@{RepositoriesR}">Add another repository</a>-      $else-        \ with these repositories:-        <table .table .table-striped .table-condensed>-          <tbody>-            $forall (num, name, _, _) <- repolist-              <tr>-                <td>-                  #{num}-                <td>-                  #{name}-        <a .btn .btn-primary .btn-large href="@{RepositoriesR}">Add another repository</a>-        <p>-          Or just sit back, watch the magic, and get on with using your files.
templates/configurators/main.hamlet view
@@ -2,6 +2,12 @@   <div .row-fluid>     <div .span4>       <h3>+        <a href="@{AddRepositoryR}">+          Repositories+      <p>+        Configure the repositories that git-annex syncs with.+    <div .span4>+      <h3>         <a href="@{PreferencesR}">           Preferences       <p>
templates/configurators/newrepository.hamlet view
@@ -3,5 +3,5 @@     Add another local repository   <p>     Where do you want to put this new repository?-    <form .form-inline enctype=#{enctype}>+    <form method="post" .form-inline enctype=#{enctype}>       ^{form}
templates/configurators/newrepository/first.hamlet view
@@ -10,5 +10,5 @@     Files in this repository will managed by git-annex, #     and kept in sync with your repositories on other devices.   <p>-    <form .form-inline enctype=#{enctype}>+    <form method="post" .form-inline enctype=#{enctype}>       ^{form}
templates/configurators/pairing/local/prompt.hamlet view
@@ -26,7 +26,7 @@     <div .alert .alert-error>       <i .icon-warning-sign></i> #{problem}   <p>-    <form .form-horizontal enctype=#{enctype}>+    <form method="post" .form-horizontal enctype=#{enctype}>       <fieldset>         ^{form}         ^{webAppFormAuthToken}
− templates/configurators/pairing/xmpp/confirm.hamlet 
@@ -1,11 +0,0 @@-<div .span9 .hero-unit>-  <h2>-    Pair request received from #{name}-  <p>-    Pairing with #{name} will combine your two git annex #-    repositories into one, allowing you to share files.-  <p>-    <a .btn .btn-primary .btn-large href="@{FinishXMPPPairR pairkey}">-      Accept pair request-    <a .btn .btn-large href="@{DashboardR}">-      No thanks
templates/configurators/pairing/xmpp/end.hamlet view
@@ -9,8 +9,7 @@       $nothing         A pair request has been sent to all other devices that #         have been configured to use your jabber account. #-        It will be answered automatically by any that see it; #-        no action is required on your part.+        It will be answered automatically by any devices that see it.   $else     Pair request accepted.   <h2>@@ -27,7 +26,7 @@       Make sure that your other devices are configured to access a #       cloud repository, and that the same repository is enabled here #       too.-  ^{cloudrepolist}+  ^{cloudRepoList}   <h2>     Add a cloud repository   ^{makeCloudRepositories True}
+ templates/configurators/pairing/xmpp/friend/confirm.hamlet view
@@ -0,0 +1,11 @@+<div .span9 .hero-unit>+  <h2>+    Pair request received from #{name}+  <p>+    Pairing with #{name} will combine your two git annex #+    repositories into one, allowing you to share files.+  <p>+    <a .btn .btn-primary .btn-large href="@{FinishXMPPPairFriendR pairkey}">+      Accept pair request+    <a .btn .btn-large href="@{DashboardR}">+      No thanks
+ templates/configurators/pairing/xmpp/friend/prompt.hamlet view
@@ -0,0 +1,12 @@+<div .span9 .hero-unit>+  <h2>+    Share with a friend+  <p>+    You can combine your repository with a friend's repository #+    to share your files. Your repositories will automatically be kept in #+    sync. Only do this if you want your friend to see all the files #+    in this repository!+  <p>+    Here are the friends currently available via your Jabber account.+    <p>+      ^{buddyListDisplay}
− templates/configurators/pairing/xmpp/prompt.hamlet 
@@ -1,11 +0,0 @@-<div .span9 .hero-unit>-  <h2>-    Pairing with another computer-  <p>-    Pairing with a another computer combines both git-annex repositories #-    into a single shared repository, with changes kept in sync.-  <p>-    You can pair with any of your friends using jabber, or with another #-    device that shares your own jabber account.-    <p>-      ^{buddyListDisplay}
+ templates/configurators/pairing/xmpp/self/prompt.hamlet view
@@ -0,0 +1,18 @@+<div .span9 .hero-unit>+  <h2>+    Sharing with your other devices+  <p>+    If you have multiple devices, all running git-annex, and using #+    your Jabber account #{account}, you can configure them to share #+    your files between themselves.+  <p>+    For example, you can have a computer at home, one at work, and a #+    laptop, and their repositories will automatically be kept in sync.+  <p>+    Make sure your other devices are online and configured to use #+    your Jabber account before continuing.+  <p>+    <a .btn .btn-primary .btn-large href="@{RunningXMPPPairSelfR}">+      Start sharing with my other devices #+    <a .btn .btn-large href="@{DashboardR}">+      Cancel
+ templates/configurators/pairing/xmpp/self/retry.hamlet view
@@ -0,0 +1,11 @@+<div .span9 .hero-unit>+  <h2>+    Unable to get in touch with any other devices.+  <p>+    Make sure your other devices are online and configured to use #+    your Jabber account before continuing.+  <p>+    <a .btn .btn-primary .btn-large href="@{RunningXMPPPairSelfR}">+      Start sharing with my other devices #+    <a .btn .btn-large href="@{DashboardR}">+      Cancel
templates/configurators/preferences.hamlet view
@@ -2,7 +2,7 @@   <h2>     Preferences   <p>-    <form .form-horizontal enctype=#{enctype}>+    <form method="post" .form-horizontal enctype=#{enctype}>       <fieldset>         ^{form}         ^{webAppFormAuthToken}
− templates/configurators/repositories.hamlet 
@@ -1,14 +0,0 @@-<div .span9>-  ^{repolist}-  <div .row-fluid>-    <div .span6>-      <h2>-        Add more repositories--      ^{makeMiscRepositories}--    <div .span6>-      <h2>-        Store your data in the cloud--      ^{makeCloudRepositories False}
− templates/configurators/repositories/cloud.hamlet 
@@ -1,31 +0,0 @@-<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-<p>-  Works very well with git-annex.--<h3>-  <a href="@{AddS3R}">-    <i .icon-plus-sign></i> Amazon S3-<p>-  Good choice for professional quality storage.--$if not onlyTransfer-  <h3>-    <a href="@{AddGlacierR}">-      <i .icon-plus-sign></i> Amazon Glacier-  <p>-    Low cost offline data archival.--<h3>-  <a href="@{AddSshR}">-    <i .icon-plus-sign></i> Remote server-<p>-  Set up a repository on a remote server using #-  <tt>ssh</tt>.
− templates/configurators/repositories/list.hamlet 
@@ -1,35 +0,0 @@-<div ##{ident}>-  $if onlyCloud reposelector-    $if not (null repolist)-      <h2>-        Cloud repositories-    $else-      No cloud repositories are configured yet.-  $else-    $if not (null repolist)-      <h2>-        Repositories-  <table .table .table-condensed>-    <tbody #costsortable>-      $forall (_num, name, uuid, actions) <- repolist-        <tr .repoline ##{fromUUID uuid}>-          <td .handle>-            <i .icon-resize-vertical></i>-            #{name}-          <td .draghide>-            $if needsEnabled actions-              <a href="@{setupRepoLink actions}">-                <i .icon-warning-sign></i> not enabled-            $else-              <a href="@{syncToggleLink actions}">-                $if notSyncing actions-                  <i .icon-pause></i> syncing paused-                $else-                  <i .icon-refresh></i> syncing enabled-          <td .draghide>-            $if needsEnabled actions-              <a href="@{setupRepoLink actions}">-                enable-            $else-              <a href="@{setupRepoLink actions}">-                configure
− templates/configurators/repositories/list.julius 
@@ -1,27 +0,0 @@-$(function() {-	var setup = function() {-		$("#costsortable").sortable({-			handle: ".handle",-			cursor: "move",-			forceHelperSize: true,-			start: function(event, ui) {-				ui.item.children(".draghide").hide();-			},-			stop: function(event, ui) {-				ui.item.children(".draghide").show();-				var list = $("#costsortable").sortable("toArray");-				var moved = ui.item.attr("id");-				$.ajax({-					'url': "@{RepositoriesReorderR}",-					'data': {-						'moved': moved,-						'list': list-					}-				});-			},-		});-	};-	longpollcallbacks.add(setup);-	setup();--});
− templates/configurators/repositories/misc.hamlet 
@@ -1,48 +0,0 @@-<h3>-  <a href="@{AddDriveR}">-    <i .icon-plus-sign></i> Removable drive-<p>-  Clone this repository to a USB drive, memory stick, or other #-  removable media.-<p>-  For offline archiving, backups, or to #-  <a href="http://en.wikipedia.org/wiki/Sneakernet">SneakerNet</a> #-  between computers. --<h3>-  <a href="@{StartLocalPairR}">-    <i .icon-plus-sign></i> Local computer-<p>-  Pair with a computer to automatically keep files in sync #-  over your local network.-<p>-  For easy sharing with friends and devices in the same location.--<h3>-  <a href="@{StartXMPPPairR}">-    <i .icon-plus-sign></i> Share with a friend-<p>-  Pair with a friend's computer, to combine your repositories and #-  share files.--<p>--  For easy sharing with friends and devices, over the internet.--<h3>-  <a href="@{NewRepositoryR}">-    <i .icon-plus-sign></i> Add a local repository-<p>-  Make another repository on your computer.--<h3>-  <i .icon-plus-sign></i> Phone-<p>-  Save photos and recordings from your phone.-<p>-  Send selected files to your phone.--<h3>-  <i .icon-plus-sign></i> Network Attached Storage-<p>-  Connect to a local storage appliance (NAS).
templates/configurators/ssh/add.hamlet view
@@ -13,19 +13,11 @@           <i .icon-warning-sign></i> #{msg}       $of _   <p>-    <form .form-horizontal enctype=#{enctype}>+    <form method="post" .form-horizontal enctype=#{enctype}>       <fieldset>         ^{form}         ^{webAppFormAuthToken}         <div .form-actions>           <button .btn .btn-primary type=submit onclick="$('#testmodal').modal('show');">             Check this server-<div .modal .fade #testmodal>-  <div .modal-header>-    <h3>-      Testing server ...-  <div .modal-body>-    <p>-      Checking ssh connection to the server. This could take a minute.-    <p>-      You may be prompted for your password to log into the server.+^{sshTestModal}
templates/configurators/ssh/confirm.hamlet view
@@ -2,22 +2,31 @@   <h2>     Ready to add remote server   <div .row-fluid>-    <div .span8>+    <div .span9>       <p>         The server #{sshHostName sshdata} has been verified to be usable.-      $if not (rsyncOnly sshdata)-        <p>-          You have two options for how to use the server:-        <p>+      <p>+        You have two options for how to use the server:+      <p>+        $if not (rsyncOnly sshdata)           <a .btn .btn-primary href="@{MakeSshGitR sshdata}" onclick="$('#setupmodal').modal('show');">             Use a git repository on the server+        $else+          <a .btn .disabled .btn-warning href="@{RetrySshR sshdata}" onclick="$('#testmodal').modal('show');">+            Use a git repository on the server (not available) #+          <a .btn .btn-primary href="@{RetrySshR sshdata}" onclick="$('#testmodal').modal('show');">+            Retry           <br>-          All your data will be uploaded to the server, including the full #-          git repository. This is a great choice if you want to set up #-          other devices to use the same server, or share the repository with #-          others.-        <p style="text-align: center">-          -or-+          <i .icon-warning-sign></i> #+          <i>+            The server needs git and git-annex installed to use this option.+        <br>+        All your data will be uploaded to the server, including the full #+        git repository. This is a great choice if you want to set up #+        other devices to use the same server, or share the repository with #+        others.+      <p style="text-align: center">+        -or-       <p>         <a .btn .btn-primary href="@{MakeSshRsyncR sshdata}" onclick="$('#setupmodal').modal('show');">           Use an encrypted rsync repository on the server@@ -32,6 +41,7 @@           <i .icon-info-sign></i> #           A ssh key will be installed on the server, allowing git-annex to #           access it securely without a password.+^{sshTestModal} <div .modal .fade #setupmodal>   <div .modal-header>     <h3>
templates/configurators/ssh/enable.hamlet view
@@ -7,7 +7,7 @@     usable here.   <p>   <p>-    <form .form-horizontal enctype=#{enctype}>+    <form method="post" .form-horizontal enctype=#{enctype}>       <fieldset>         <div .form-actions>           <button .btn .btn-primary type=submit onclick="$('#testmodal').modal('show');">
+ templates/configurators/ssh/testmodal.hamlet view
@@ -0,0 +1,9 @@+<div .modal .fade #testmodal>+  <div .modal-header>+    <h3>+      Testing server ...+  <div .modal-body>+    <p>+      Checking ssh connection to the server. This could take a minute.+    <p>+      You may be prompted for your password to log into the server.
templates/configurators/xmpp.hamlet view
@@ -18,7 +18,7 @@       <small>(<tt>you@gmail.com</tt>)</small> #       and password below.   <p>-    <form .form-horizontal enctype=#{enctype}>+    <form method="post" .form-horizontal enctype=#{enctype}>       <fieldset>         ^{form}         ^{webAppFormAuthToken}
templates/configurators/xmpp/buddylist.hamlet view
@@ -7,17 +7,19 @@           $if isNothing myjid             Not connected to the jabber server. Check your network connection ...           $else-            Nobody is currently available.+            Searching...     $else       $forall (name, away, canpair, paired, buddyid) <- buddies         <tr>           <td>-            <i .icon-user></i> #-            $if away-              <span .muted>-                #{name}+            $if isself buddyid+              <i .icon-star></i> #+              <span :away:.muted>+                your other devices             $else-              #{name}+              <i .icon-user></i> #+              <span :away:.muted>+                  #{name}           <td>             $if away               <span .muted>@@ -28,7 +30,11 @@                   paired               $else                 $if canpair-                  <a .btn .btn-primary .btn-small href="@{RunningXMPPPairR buddyid}">-                    Start pairing+                  $if isself buddyid+                    <a .btn .btn-primary .btn-small href="@{RunningXMPPPairSelfR}">+                      Start pairing+                  $else+                    <a .btn .btn-primary .btn-small href="@{RunningXMPPPairFriendR buddyid}">+                      Start pairing                 $else                   not using git-annex
+ templates/configurators/xmpp/needcloudrepo.hamlet view
@@ -0,0 +1,17 @@+<div .span9 .hero-unit>+  <h2>+    &#9730; Configure a shared cloud repository+  $maybe name <- buddyname+    <p>+      You and #{name} have combined your repositores. But you can't open #+      each other's files yet. To start sharing files with #{name}, #+      you need a repository in the cloud, that you both can access.+  $nothing+    <p>+      You've combined the repositories on two or more of your devices. #+      But files are not flowing yet. To start sharing files #+      between your devices, you should set up a repository in the cloud.+  ^{cloudRepoList}+  <h2>+    Add a cloud repository+  ^{makeCloudRepositories True}
templates/dashboard/main.hamlet view
@@ -1,10 +1,12 @@-^{content}-  $if warnNoScript-    <noscript>-      <div .navbar .navbar-fixed-bottom>-        <div .navbar-inner>-          <div .container>-            Javascript is disabled; cannot update in real-time.-            <div .btn-group>-              <a .btn .btn-primary href="@{NoScriptAutoR}">Auto-refresh every 3 seconds #-              <a .btn .btn-primary href="@{NoScriptR}">Manually refresh+<div .span9>+  ^{repolist}+  ^{transferlist}+$if warnNoScript+  <noscript>+    <div .navbar .navbar-fixed-bottom>+      <div .navbar-inner>+        <div .container>+          Javascript is disabled; cannot update in real-time.+          <div .btn-group>+            <a .btn .btn-primary href="@{NoScriptAutoR}">Auto-refresh every 3 seconds #+            <a .btn .btn-primary href="@{NoScriptR}">Manually refresh
+ templates/dashboard/transfers.cassius view
@@ -0,0 +1,2 @@+.forcewrap+  word-wrap: break-word
templates/dashboard/transfers.hamlet view
@@ -1,21 +1,12 @@-<div .span9 ##{ident}>-  $maybe reldir <- relDir webapp-    <div .alert .alert-info>-      <p>-        git-annex is watching over your files in #-        <small><tt>#{reldir}</tt></small>, #-        and keeping them in sync with #-        <a href="@{RepositoriesR}">-          other repositories.-  $if null transfers-  $else-    <h2>Transfers+<div ##{ident}>+  <h2>Transfers+  $if transfersrunning     $forall (transfer, info) <- transfers       $with percent <- maybe "unknown" (showPercentage 0) $ percentComplete transfer info         <div .row-fluid>           <div .span10>             <div .row-fluid>-              <h3>+              <h3 .forcewrap>                 $maybe file <- associatedFile info                   #{file}                 $nothing@@ -45,3 +36,9 @@             $else               ^{actionButton (StartTransferR transfer) Nothing (Just "continue") "btn" "icon-play"}             ^{actionButton (CancelTransferR transfer) Nothing (Just "cancel") "btn" "icon-remove"}+  $else+    $if scanrunning+      <i .icon-refresh></i> Scanning for files to transfer+    $else+      <i>+        (No file transfers running)
templates/documentation/repogroup.hamlet view
@@ -19,9 +19,14 @@     hold the files that need to be synced to other repositories, so they #     are relatively small.   <p>-    You can get along without any <b>backup repositories</b>, but they're #-    a useful safeguard. These repositories accumulate every file they can #-    get ahold of. A large removable drive makes a good backup repository.+    You can get along without any <b>full backup repositories</b>, but #+    they're a useful safeguard. These repositories accumulate every file+    they can get ahold of. A large removable drive makes a good full backup #+    repository.+  <p>+    Similarly, the <b>incremental backup repositories</b> try to back up #+    every file, but these only accumulate files that are not already #+    present in a full or incremental backup.   <p>     Next we come to the <b>archive repositories</b>.     The archive repositories coordinate together, so that each file is #
+ templates/repolist.hamlet view
@@ -0,0 +1,48 @@+<div ##{ident}>+  $if onlyCloud reposelector+    $if not (null repolist)+      <h2>+        Cloud repositories+    $else+      No cloud repositories are configured yet.+  $else+    $if not (null repolist)+      <h2>+        Repositories+  <table .table .table-condensed>+    <tbody #costsortable>+      $forall (name, uuid, actions) <- repolist+        <tr .repoline ##{fromUUID uuid}>+          <td .handle>+            <a .btn .btn-mini .disabled>+              <i .icon-resize-vertical></i>+            &nbsp; #{name}+          <td .draghide>+            $if needsEnabled actions+              <a href="@{setupRepoLink actions}">+                <i .icon-warning-sign></i> not enabled+            $else+              <a href="@{syncToggleLink actions}">+                $if notSyncing actions+                  <i .icon-ban-circle></i> syncing disabled+                $else+                  <i .icon-refresh></i> syncing enabled+          <td .draghide>+            $if needsEnabled actions+              <a href="@{setupRepoLink actions}">+                enable+            $else+              <a href="@{setupRepoLink actions}">+                configure+      $if addmore+        <tr>+          <td colspan="3">+            $if nootherrepos+              <a .btn .btn-primary .btn-large href="@{AddRepositoryR}">+                <i .icon-plus-sign></i> Add another repository+            $else+              <a .btn .btn-small href="@{AddRepositoryR}">+                <i .icon-plus-sign></i> Add another repository+            <span>+              &nbsp; Sync your files with another drive, device, or #+              share with a friend.
+ templates/repolist.julius view
@@ -0,0 +1,28 @@+$(function() {+	var setup = function() {+		$("#costsortable").sortable({+			items: ".repoline",+			handle: ".handle",+			cursor: "move",+			forceHelperSize: true,+			start: function(event, ui) {+				ui.item.children(".draghide").hide();+			},+			stop: function(event, ui) {+				ui.item.children(".draghide").show();+				var list = $("#costsortable").sortable("toArray");+				var moved = ui.item.attr("id");+				$.ajax({+					'url': "@{RepositoriesReorderR}",+					'data': {+						'moved': moved,+						'list': list+					}+				});+			},+		});+	};+	longpollcallbacks.add(setup);+	setup();++});