webapp: Improve UI around remote that have no annex.uuid set, either because setup of them is incomplete, or because the remote git repository is not a git-annex repository.
Complicated by such repositories potentially being repos that should have an annex.uuid, but it failed to be gotten, perhaps due to the past ssh repo setup bugs. This is handled now by an Upgrade Repository button.
This commit is contained in:
parent
b7c15f3b60
commit
958312885f
26 changed files with 209 additions and 156 deletions
|
@ -20,6 +20,7 @@ import qualified Command.InitRemote
|
|||
import Logs.UUID
|
||||
import Logs.Remote
|
||||
import Git.Remote
|
||||
import Git.Types (RemoteName)
|
||||
import Creds
|
||||
import Assistant.Gpg
|
||||
import Utility.Gpg (KeyId)
|
||||
|
|
|
@ -12,6 +12,7 @@ import Assistant.WebApp as X
|
|||
import Assistant.WebApp.Page as X
|
||||
import Assistant.WebApp.Form as X
|
||||
import Assistant.WebApp.Types as X
|
||||
import Assistant.WebApp.RepoId as X
|
||||
import Utility.Yesod as X hiding (textField, passwordField, insertBy, replace, joinPath, deleteBy, delete, insert, Key, Option)
|
||||
|
||||
import Data.Text as X (Text)
|
||||
|
|
|
@ -23,7 +23,7 @@ import Types.Remote (RemoteConfig)
|
|||
import Types.StandardGroups
|
||||
import Creds
|
||||
import Assistant.Gpg
|
||||
import Git.Remote
|
||||
import Git.Types (RemoteName)
|
||||
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Map as M
|
||||
|
|
|
@ -38,6 +38,8 @@ import Remote.Helper.Encryptable (extractCipher)
|
|||
import Types.Crypto
|
||||
import Utility.Gpg
|
||||
import Annex.UUID
|
||||
import Assistant.Ssh
|
||||
import Config
|
||||
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Map as M
|
||||
|
@ -158,26 +160,26 @@ editRepositoryAForm ishere def = RepoConfig
|
|||
Nothing -> aopt hiddenField "" Nothing
|
||||
Just d -> aopt textField "Associated directory" (Just $ Just d)
|
||||
|
||||
getEditRepositoryR :: UUID -> Handler Html
|
||||
getEditRepositoryR :: RepoId -> Handler Html
|
||||
getEditRepositoryR = postEditRepositoryR
|
||||
|
||||
postEditRepositoryR :: UUID -> Handler Html
|
||||
postEditRepositoryR :: RepoId -> Handler Html
|
||||
postEditRepositoryR = editForm False
|
||||
|
||||
getEditNewRepositoryR :: UUID -> Handler Html
|
||||
getEditNewRepositoryR = postEditNewRepositoryR
|
||||
|
||||
postEditNewRepositoryR :: UUID -> Handler Html
|
||||
postEditNewRepositoryR = editForm True
|
||||
postEditNewRepositoryR = editForm True . RepoUUID
|
||||
|
||||
getEditNewCloudRepositoryR :: UUID -> Handler Html
|
||||
getEditNewCloudRepositoryR = postEditNewCloudRepositoryR
|
||||
|
||||
postEditNewCloudRepositoryR :: UUID -> Handler Html
|
||||
postEditNewCloudRepositoryR uuid = xmppNeeded >> editForm True uuid
|
||||
postEditNewCloudRepositoryR uuid = xmppNeeded >> editForm True (RepoUUID uuid)
|
||||
|
||||
editForm :: Bool -> UUID -> Handler Html
|
||||
editForm new uuid = page "Edit repository" (Just Configuration) $ do
|
||||
editForm :: Bool -> RepoId -> Handler Html
|
||||
editForm new (RepoUUID uuid) = page "Edit repository" (Just Configuration) $ do
|
||||
mremote <- liftAnnex $ Remote.remoteFromUUID uuid
|
||||
when (mremote == Nothing) $
|
||||
whenM ((/=) uuid <$> liftAnnex getUUID) $
|
||||
|
@ -196,7 +198,13 @@ editForm new uuid = page "Edit repository" (Just Configuration) $ do
|
|||
config <- liftAnnex $ M.lookup uuid <$> readRemoteLog
|
||||
let repoInfo = getRepoInfo mremote config
|
||||
let repoEncryption = getRepoEncryption mremote config
|
||||
$(widgetFile "configurators/editrepository")
|
||||
$(widgetFile "configurators/edit/repository")
|
||||
editForm new r@(RepoName _) = page "Edit repository" (Just Configuration) $ do
|
||||
mr <- liftAnnex (repoIdRemote r)
|
||||
let repoInfo = getRepoInfo mr Nothing
|
||||
g <- liftAnnex gitRepo
|
||||
let sshrepo = maybe False (remoteLocationIsSshUrl . flip parseRemoteLocation g . Git.repoLocation . Remote.repo) mr
|
||||
$(widgetFile "configurators/edit/nonannexremote")
|
||||
|
||||
{- Makes any directory associated with the repository. -}
|
||||
checkAssociatedDirectory :: RepoConfig -> Maybe Remote -> Annex ()
|
||||
|
@ -245,3 +253,17 @@ encrypted using gpg key:
|
|||
^{gpgKeyDisplay k (M.lookup k knownkeys)}
|
||||
|]
|
||||
getRepoEncryption _ _ = return () -- local repo
|
||||
|
||||
getUpgradeRepositoryR :: RepoId -> Handler ()
|
||||
getUpgradeRepositoryR (RepoUUID _) = redirect DashboardR
|
||||
getUpgradeRepositoryR r = go =<< liftAnnex (repoIdRemote r)
|
||||
where
|
||||
go Nothing = redirect DashboardR
|
||||
go (Just rmt) = do
|
||||
liftIO fixSshKeyPair
|
||||
liftAnnex $ setConfig
|
||||
(remoteConfig (Remote.repo rmt) "ignore")
|
||||
(Git.Config.boolConfig False)
|
||||
liftAssistant $ syncRemote rmt
|
||||
liftAnnex $ void Remote.remoteListRefresh
|
||||
redirect DashboardR
|
||||
|
|
|
@ -200,7 +200,7 @@ getCombineRepositoryR :: FilePath -> UUID -> Handler Html
|
|||
getCombineRepositoryR newrepopath newrepouuid = do
|
||||
r <- combineRepos newrepopath remotename
|
||||
liftAssistant $ syncRemote r
|
||||
redirect $ EditRepositoryR newrepouuid
|
||||
redirect $ EditRepositoryR $ RepoUUID newrepouuid
|
||||
where
|
||||
remotename = takeFileName newrepopath
|
||||
|
||||
|
|
|
@ -20,7 +20,7 @@ import Types.StandardGroups
|
|||
import Utility.UserInfo
|
||||
import Utility.Gpg
|
||||
import Types.Remote (RemoteConfig)
|
||||
import Git.Remote
|
||||
import Git.Types (RemoteName)
|
||||
import qualified Remote.GCrypt as GCrypt
|
||||
import Annex.UUID
|
||||
import Logs.UUID
|
||||
|
|
|
@ -18,7 +18,7 @@ import qualified Remote
|
|||
import Types.Remote (RemoteConfig)
|
||||
import Types.StandardGroups
|
||||
import Logs.Remote
|
||||
import Git.Remote
|
||||
import Git.Types (RemoteName)
|
||||
|
||||
import qualified Data.Map as M
|
||||
#endif
|
||||
|
|
|
@ -18,6 +18,7 @@ import qualified Git.Construct
|
|||
import qualified Annex.Branch
|
||||
import qualified Git.GCrypt
|
||||
import qualified Remote.GCrypt as GCrypt
|
||||
import Git.Types (RemoteName)
|
||||
import Assistant.WebApp.MakeRemote
|
||||
import Logs.Remote
|
||||
|
||||
|
@ -63,7 +64,7 @@ withNewSecretKey use = do
|
|||
- branch from the gcrypt remote and merges it in, and then looks up
|
||||
- the name.
|
||||
-}
|
||||
getGCryptRemoteName :: UUID -> String -> Annex Git.Remote.RemoteName
|
||||
getGCryptRemoteName :: UUID -> String -> Annex RemoteName
|
||||
getGCryptRemoteName u repoloc = do
|
||||
tmpremote <- uniqueRemoteName "tmpgcryptremote" 0 <$> gitRepo
|
||||
void $ inRepo $ Git.Command.runBool
|
||||
|
|
|
@ -17,7 +17,7 @@ import qualified Remote
|
|||
import qualified Config
|
||||
import Config.Cost
|
||||
import Types.StandardGroups
|
||||
import Git.Remote
|
||||
import Git.Types (RemoteName)
|
||||
import Logs.PreferredContent
|
||||
import Assistant.MakeRemote
|
||||
|
||||
|
|
40
Assistant/WebApp/RepoId.hs
Normal file
40
Assistant/WebApp/RepoId.hs
Normal file
|
@ -0,0 +1,40 @@
|
|||
{- git-annex assistant webapp RepoId type
|
||||
-
|
||||
- Copyright 2012,2013 Joey Hess <joey@kitenet.net>
|
||||
-
|
||||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
||||
module Assistant.WebApp.RepoId where
|
||||
|
||||
import Common.Annex
|
||||
import Git.Types (RemoteName)
|
||||
import qualified Remote
|
||||
|
||||
{- Parts of the webapp need to be able to act on repositories that may or
|
||||
- may not have a UUID. -}
|
||||
data RepoId
|
||||
= RepoUUID UUID
|
||||
| RepoName RemoteName
|
||||
deriving (Eq, Ord, Show, Read)
|
||||
|
||||
mkRepoId :: Remote -> RepoId
|
||||
mkRepoId r = case Remote.uuid r of
|
||||
NoUUID -> RepoName (Remote.name r)
|
||||
u -> RepoUUID u
|
||||
|
||||
|
||||
describeRepoId :: RepoId -> Annex String
|
||||
describeRepoId (RepoUUID u) = Remote.prettyUUID u
|
||||
describeRepoId (RepoName n) = return n
|
||||
|
||||
repoIdRemote :: RepoId -> Annex (Maybe Remote)
|
||||
repoIdRemote (RepoUUID u) = Remote.remoteFromUUID u
|
||||
repoIdRemote (RepoName n) = Remote.byNameOnly n
|
||||
|
||||
lacksUUID :: RepoId -> Bool
|
||||
lacksUUID r = asUUID r == NoUUID
|
||||
|
||||
asUUID :: RepoId -> UUID
|
||||
asUUID (RepoUUID u) = u
|
||||
asUUID _ = NoUUID
|
|
@ -12,7 +12,6 @@ module Assistant.WebApp.RepoList where
|
|||
import Assistant.WebApp.Common
|
||||
import Assistant.DaemonStatus
|
||||
import Assistant.WebApp.Notifications
|
||||
import Assistant.Ssh
|
||||
import qualified Annex
|
||||
import qualified Remote
|
||||
import qualified Types.Remote as Remote
|
||||
|
@ -22,20 +21,22 @@ import Logs.Remote
|
|||
import Logs.Trust
|
||||
import Logs.Group
|
||||
import Config
|
||||
import Git.Config
|
||||
import Git.Remote
|
||||
import Assistant.Sync
|
||||
import Config.Cost
|
||||
import Utility.NotificationBroadcaster
|
||||
import qualified Git
|
||||
#ifdef WITH_XMPP
|
||||
#endif
|
||||
|
||||
import qualified Data.Map as M
|
||||
import qualified Data.Set as S
|
||||
import qualified Data.Text as T
|
||||
import Data.Function
|
||||
|
||||
type RepoList = [(RepoDesc, RepoId, Actions)]
|
||||
|
||||
type RepoDesc = String
|
||||
|
||||
{- Actions that can be performed on a repo in the list. -}
|
||||
data Actions
|
||||
= DisabledRepoActions
|
||||
{ setupRepoLink :: Route WebApp }
|
||||
|
@ -50,21 +51,21 @@ data Actions
|
|||
| UnwantedRepoActions
|
||||
{ setupRepoLink :: Route WebApp }
|
||||
|
||||
mkSyncingRepoActions :: UUID -> Actions
|
||||
mkSyncingRepoActions u = SyncingRepoActions
|
||||
{ setupRepoLink = EditRepositoryR u
|
||||
, syncToggleLink = DisableSyncR u
|
||||
mkSyncingRepoActions :: RepoId -> Actions
|
||||
mkSyncingRepoActions repoid = SyncingRepoActions
|
||||
{ setupRepoLink = EditRepositoryR repoid
|
||||
, syncToggleLink = DisableSyncR repoid
|
||||
}
|
||||
|
||||
mkNotSyncingRepoActions :: UUID -> Actions
|
||||
mkNotSyncingRepoActions u = NotSyncingRepoActions
|
||||
{ setupRepoLink = EditRepositoryR u
|
||||
, syncToggleLink = EnableSyncR u
|
||||
mkNotSyncingRepoActions :: RepoId -> Actions
|
||||
mkNotSyncingRepoActions repoid = NotSyncingRepoActions
|
||||
{ setupRepoLink = EditRepositoryR repoid
|
||||
, syncToggleLink = EnableSyncR repoid
|
||||
}
|
||||
|
||||
mkUnwantedRepoActions :: UUID -> Actions
|
||||
mkUnwantedRepoActions u = UnwantedRepoActions
|
||||
{ setupRepoLink = EditRepositoryR u
|
||||
mkUnwantedRepoActions :: RepoId -> Actions
|
||||
mkUnwantedRepoActions repoid = UnwantedRepoActions
|
||||
{ setupRepoLink = EditRepositoryR repoid
|
||||
}
|
||||
|
||||
needsEnabled :: Actions -> Bool
|
||||
|
@ -122,9 +123,6 @@ repoListDisplay reposelector = do
|
|||
$(widgetFile "repolist")
|
||||
where
|
||||
ident = "repolist"
|
||||
unfinished uuid = uuid == NoUUID
|
||||
|
||||
type RepoList = [(String, UUID, Actions)]
|
||||
|
||||
{- A list of known repositories, with actions that can be taken on them. -}
|
||||
repoList :: RepoSelector -> Handler RepoList
|
||||
|
@ -133,27 +131,27 @@ repoList reposelector
|
|||
| otherwise = list =<< (++) <$> configured <*> unconfigured
|
||||
where
|
||||
configured = do
|
||||
syncing <- S.fromList . map Remote.uuid . syncRemotes
|
||||
<$> liftAssistant getDaemonStatus
|
||||
syncremotes <- syncRemotes <$> liftAssistant getDaemonStatus
|
||||
let syncing = S.fromList $ map mkRepoId syncremotes
|
||||
liftAnnex $ do
|
||||
unwanted <- S.fromList
|
||||
<$> filterM inUnwantedGroup (S.toList syncing)
|
||||
<$> filterM inUnwantedGroup (map Remote.uuid syncremotes)
|
||||
rs <- filter selectedrepo . concat . Remote.byCost
|
||||
<$> Remote.remoteList
|
||||
let us = map Remote.uuid rs
|
||||
let maker u
|
||||
| u `S.member` unwanted = mkUnwantedRepoActions u
|
||||
| u `S.member` syncing = mkSyncingRepoActions u
|
||||
| otherwise = mkNotSyncingRepoActions u
|
||||
let l = zip us $ map (maker . Remote.uuid) rs
|
||||
let l = flip map (map mkRepoId rs) $ \r -> case r of
|
||||
(RepoUUID u)
|
||||
| u `S.member` unwanted -> (r, mkUnwantedRepoActions r)
|
||||
_
|
||||
| r `S.member` syncing -> (r, mkSyncingRepoActions r)
|
||||
| otherwise -> (r, mkNotSyncingRepoActions r)
|
||||
if includeHere reposelector
|
||||
then do
|
||||
u <- getUUID
|
||||
r <- RepoUUID <$> getUUID
|
||||
autocommit <- annexAutoCommit <$> Annex.getGitConfig
|
||||
let hereactions = if autocommit
|
||||
then mkSyncingRepoActions u
|
||||
else mkNotSyncingRepoActions u
|
||||
let here = (u, hereactions)
|
||||
then mkSyncingRepoActions r
|
||||
else mkNotSyncingRepoActions r
|
||||
let here = (r, hereactions)
|
||||
return $ here : l
|
||||
else return l
|
||||
unconfigured = liftAnnex $ do
|
||||
|
@ -164,7 +162,9 @@ repoList reposelector
|
|||
<$> trustExclude DeadTrusted (M.keys m)
|
||||
selectedrepo r
|
||||
| Remote.readonly r = False
|
||||
| onlyCloud reposelector = Git.repoIsUrl (Remote.repo r) && not (isXMPPRemote r)
|
||||
| onlyCloud reposelector = Git.repoIsUrl (Remote.repo r)
|
||||
&& Remote.uuid r /= NoUUID
|
||||
&& not (isXMPPRemote r)
|
||||
| otherwise = True
|
||||
selectedremote Nothing = False
|
||||
selectedremote (Just (iscloud, _))
|
||||
|
@ -190,23 +190,23 @@ repoList reposelector
|
|||
_ -> Nothing
|
||||
where
|
||||
getconfig k = M.lookup k =<< M.lookup u m
|
||||
val iscloud r = Just (iscloud, (u, DisabledRepoActions $ r u))
|
||||
list l = liftAnnex $ do
|
||||
let l' = nubBy ((==) `on` fst) l
|
||||
l'' <- zip
|
||||
<$> Remote.prettyListUUIDs (map fst l')
|
||||
<*> pure l'
|
||||
return $ map (\(name, (uuid, actions)) -> (name, uuid, actions)) l''
|
||||
val iscloud r = Just (iscloud, (RepoUUID u, DisabledRepoActions $ r u))
|
||||
list l = liftAnnex $
|
||||
forM (nubBy ((==) `on` fst) l) $ \(repoid, actions) ->
|
||||
(,,)
|
||||
<$> describeRepoId repoid
|
||||
<*> pure repoid
|
||||
<*> pure actions
|
||||
|
||||
getEnableSyncR :: UUID -> Handler ()
|
||||
getEnableSyncR :: RepoId -> Handler ()
|
||||
getEnableSyncR = flipSync True
|
||||
|
||||
getDisableSyncR :: UUID -> Handler ()
|
||||
getDisableSyncR :: RepoId -> Handler ()
|
||||
getDisableSyncR = flipSync False
|
||||
|
||||
flipSync :: Bool -> UUID -> Handler ()
|
||||
flipSync enable uuid = do
|
||||
mremote <- liftAnnex $ Remote.remoteFromUUID uuid
|
||||
flipSync :: Bool -> RepoId -> Handler ()
|
||||
flipSync enable repoid = do
|
||||
mremote <- liftAnnex $ repoIdRemote repoid
|
||||
liftAssistant $ changeSyncable mremote enable
|
||||
redirectBack
|
||||
|
||||
|
@ -238,29 +238,3 @@ reorderCosts remote rs = zip rs'' (insertCostAfter costs i)
|
|||
costs = map Remote.cost rs'
|
||||
rs'' = (\(x, y) -> x ++ [remote] ++ y) $ splitAt (i + 1) rs'
|
||||
|
||||
{- Checks to see if any repositories with NoUUID have annex-ignore set.
|
||||
- That could happen if there's a problem contacting a ssh remote
|
||||
- soon after it was added. -}
|
||||
getCheckUnfinishedRepositoriesR :: Handler Html
|
||||
getCheckUnfinishedRepositoriesR = page "Unfinished repositories" (Just Configuration) $ do
|
||||
stalled <- liftAnnex findStalled
|
||||
$(widgetFile "configurators/checkunfinished")
|
||||
|
||||
findStalled :: Annex [Remote]
|
||||
findStalled = filter isstalled <$> remoteListRefresh
|
||||
where
|
||||
isstalled r = Remote.uuid r == NoUUID
|
||||
&& remoteAnnexIgnore (Remote.gitconfig r)
|
||||
|
||||
getRetryUnfinishedRepositoriesR :: Handler ()
|
||||
getRetryUnfinishedRepositoriesR = do
|
||||
liftAssistant $ mapM_ unstall =<< liftAnnex findStalled
|
||||
redirect DashboardR
|
||||
where
|
||||
unstall r = do
|
||||
liftIO fixSshKeyPair
|
||||
liftAnnex $ setConfig
|
||||
(remoteConfig (Remote.repo r) "ignore")
|
||||
(boolConfig False)
|
||||
syncRemote r
|
||||
liftAnnex $ void remoteListRefresh
|
||||
|
|
|
@ -24,6 +24,7 @@ import Logs.Transfer
|
|||
import Utility.Gpg (KeyId)
|
||||
import Build.SysConfig (packageversion)
|
||||
import Types.ScheduledActivity
|
||||
import Assistant.WebApp.RepoId
|
||||
|
||||
import Yesod.Static
|
||||
import Text.Hamlet
|
||||
|
@ -216,3 +217,7 @@ instance PathPiece ThreadName where
|
|||
instance PathPiece ScheduledActivity where
|
||||
toPathPiece = pack . show
|
||||
fromPathPiece = readish . unpack
|
||||
|
||||
instance PathPiece RepoId where
|
||||
toPathPiece = pack . show
|
||||
fromPathPiece = readish . unpack
|
||||
|
|
|
@ -29,13 +29,12 @@
|
|||
/config/repository/switcher RepositorySwitcherR GET
|
||||
/config/repository/switchto/#FilePath SwitchToRepositoryR GET
|
||||
/config/repository/combine/#FilePath/#UUID CombineRepositoryR GET
|
||||
/config/repository/edit/#UUID EditRepositoryR GET POST
|
||||
/config/repository/edit/#RepoId 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/unfinished/check CheckUnfinishedRepositoriesR GET
|
||||
/config/repository/unfinished/retry RetryUnfinishedRepositoriesR GET
|
||||
/config/repository/sync/disable/#RepoId DisableSyncR GET
|
||||
/config/repository/sync/enable/#RepoId EnableSyncR GET
|
||||
/config/repository/upgrade/#RepoId UpgradeRepositoryR GET
|
||||
|
||||
/config/repository/add/drive AddDriveR GET POST
|
||||
/config/repository/add/drive/confirm/#RemovableDrive ConfirmAddDriveR GET
|
||||
|
|
|
@ -22,7 +22,7 @@ import Logs.UUID
|
|||
import Annex.UUID
|
||||
import qualified Option
|
||||
import qualified Annex
|
||||
import Git.Remote
|
||||
import Git.Types (RemoteName)
|
||||
|
||||
def :: [Command]
|
||||
def = [noCommit $ withOptions [allrepos] $ command "list" paramPaths seek
|
||||
|
|
|
@ -15,7 +15,6 @@ import Git.Construct
|
|||
import qualified Git.Config as Config
|
||||
import qualified Git.Command as Command
|
||||
import Utility.Gpg
|
||||
import Git.Remote
|
||||
|
||||
urlPrefix :: String
|
||||
urlPrefix = "gcrypt::"
|
||||
|
|
|
@ -11,6 +11,7 @@ module Git.Remote where
|
|||
|
||||
import Common
|
||||
import Git
|
||||
import Git.Types
|
||||
import qualified Git.Command
|
||||
import qualified Git.BuildVersion
|
||||
|
||||
|
@ -21,8 +22,6 @@ import Network.URI
|
|||
import Git.FilePath
|
||||
#endif
|
||||
|
||||
type RemoteName = String
|
||||
|
||||
{- Construct a legal git remote name out of an arbitrary input string.
|
||||
-
|
||||
- There seems to be no formal definition of this in the git source,
|
||||
|
@ -62,6 +61,10 @@ remoteLocationIsUrl :: RemoteLocation -> Bool
|
|||
remoteLocationIsUrl (RemoteUrl _) = True
|
||||
remoteLocationIsUrl _ = False
|
||||
|
||||
remoteLocationIsSshUrl :: RemoteLocation -> Bool
|
||||
remoteLocationIsSshUrl (RemoteUrl u) = "ssh://" `isPrefixOf` u
|
||||
remoteLocationIsSshUrl _ = False
|
||||
|
||||
{- Determines if a given remote location is an url, or a local
|
||||
- path. Takes the repository's insteadOf configuration into account. -}
|
||||
parseRemoteLocation :: String -> Repo -> RemoteLocation
|
||||
|
|
|
@ -36,13 +36,15 @@ data Repo = Repo
|
|||
, fullconfig :: M.Map String [String]
|
||||
, remotes :: [Repo]
|
||||
-- remoteName holds the name used for this repo in remotes
|
||||
, remoteName :: Maybe String
|
||||
, remoteName :: Maybe RemoteName
|
||||
-- alternate environment to use when running git commands
|
||||
, gitEnv :: Maybe [(String, String)]
|
||||
-- global options to pass to git when running git commands
|
||||
, gitGlobalOpts :: [CommandParam]
|
||||
} deriving (Show, Eq)
|
||||
|
||||
type RemoteName = String
|
||||
|
||||
{- A git ref. Can be a sha1, or a branch or tag name. -}
|
||||
newtype Ref = Ref String
|
||||
deriving (Eq, Ord)
|
||||
|
|
|
@ -24,6 +24,7 @@ module Remote (
|
|||
remoteMap,
|
||||
uuidDescriptions,
|
||||
byName,
|
||||
byNameOnly,
|
||||
byNameWithUUID,
|
||||
byCost,
|
||||
prettyPrintUUIDs,
|
||||
|
@ -58,7 +59,7 @@ import Logs.Trust
|
|||
import Logs.Location hiding (logStatus)
|
||||
import Remote.List
|
||||
import Config
|
||||
import Git.Remote
|
||||
import Git.Types (RemoteName)
|
||||
|
||||
{- Map from UUIDs of Remotes to a calculated value. -}
|
||||
remoteMap :: (Remote -> a) -> Annex (M.Map UUID a)
|
||||
|
@ -104,6 +105,12 @@ byName' n = handle . filter matching <$> remoteList
|
|||
handle (match:_) = Right match
|
||||
matching r = n == name r || toUUID n == uuid r
|
||||
|
||||
{- Only matches remote name, not UUID -}
|
||||
byNameOnly :: RemoteName -> Annex (Maybe Remote)
|
||||
byNameOnly n = headMaybe . filter matching <$> remoteList
|
||||
where
|
||||
matching r = n == name r
|
||||
|
||||
{- Looks up a remote by name (or by UUID, or even by description),
|
||||
- and returns its UUID. Finds even remotes that are not configured in
|
||||
- .git/config. -}
|
||||
|
|
|
@ -18,7 +18,7 @@ import Types.UUID
|
|||
import Types.GitConfig
|
||||
import Config.Cost
|
||||
import Utility.Metered
|
||||
import Git.Remote
|
||||
import Git.Types
|
||||
import Utility.SafeCommand
|
||||
|
||||
type RemoteConfigKey = String
|
||||
|
|
3
debian/changelog
vendored
3
debian/changelog
vendored
|
@ -16,6 +16,9 @@ git-annex (5.20131102) UNRELEASED; urgency=low
|
|||
* watcher: Avoid loop when adding a file owned by someone else fails
|
||||
in indirect mode because its permissions cannot be modified.
|
||||
* webapp: Avoid encoding problems when displaying the daemon log file.
|
||||
* webapp: Improve UI around remote that have no annex.uuid set,
|
||||
either because setup of them is incomplete, or because the remote
|
||||
git repository is not a git-annex repository.
|
||||
|
||||
-- Joey Hess <joeyh@debian.org> Sat, 02 Nov 2013 14:54:36 -0400
|
||||
|
||||
|
|
|
@ -21,3 +21,5 @@ Start the webapp.
|
|||
upgrade supported from repository versions: 0 1 2
|
||||
|
||||
Kubuntu 13.10 x86_64
|
||||
|
||||
> [[fixed|done]] --[[Joey]]
|
||||
|
|
|
@ -1,16 +0,0 @@
|
|||
<div .span9 .hero-unit>
|
||||
$if null stalled
|
||||
<h2>
|
||||
The repository is still not finished being set up. Patience..
|
||||
<p>
|
||||
If you suspect something is wrong, you might want to take a look #
|
||||
at the
|
||||
<a href="@{LogR}">
|
||||
Log
|
||||
$else
|
||||
<h2>
|
||||
Setting up this repository seems to have stalled!
|
||||
<p>
|
||||
Make sure the remote system is available and
|
||||
<a .btn .btn-primary href="@{RetryUnfinishedRepositoriesR}">
|
||||
Retry
|
18
templates/configurators/edit/nonannexremote.hamlet
Normal file
18
templates/configurators/edit/nonannexremote.hamlet
Normal file
|
@ -0,0 +1,18 @@
|
|||
<div .span9 .hero-unit>
|
||||
<h2>
|
||||
Just a git repository
|
||||
<p>
|
||||
This repository is not currently set up as a git annex; #
|
||||
only git metadata is synced with this repository.
|
||||
$if sshrepo
|
||||
<p>
|
||||
If this repository's ssh server has git-annex installed, you can #
|
||||
upgrade this repository to a full git annex, which will store the
|
||||
contents of your files, not only their metadata.
|
||||
<p>
|
||||
<a .btn href="@{UpgradeRepositoryR r}">
|
||||
Upgrade Repository
|
||||
<h2>
|
||||
Repository information
|
||||
<p>
|
||||
^{repoInfo}
|
|
@ -17,7 +17,7 @@
|
|||
$of Download
|
||||
←
|
||||
<small>
|
||||
<a href="@{EditRepositoryR $ transferUUID transfer}">
|
||||
<a href="@{EditRepositoryR $ RepoUUID $ transferUUID transfer}">
|
||||
#{maybe "unknown" Remote.name $ transferRemote info}
|
||||
$with size <- maybe "unknown" (roughSize dataUnits True) $ keySize $ transferKey transfer
|
||||
$if isJust $ startedTime info
|
||||
|
|
|
@ -11,52 +11,44 @@
|
|||
Repositories
|
||||
<table .table .table-condensed>
|
||||
<tbody #costsortable>
|
||||
$forall (name, uuid, actions) <- repolist
|
||||
$if unfinished uuid
|
||||
<tr .repoline>
|
||||
<td>
|
||||
<a .btn .btn-mini .disabled>
|
||||
<i .icon-time></i>
|
||||
unfinished repository
|
||||
<td>
|
||||
<a href="@{CheckUnfinishedRepositoriesR}">
|
||||
<i .icon-question-sign></i> check status
|
||||
<td>
|
||||
$else
|
||||
<tr .repoline ##{fromUUID uuid}>
|
||||
<td .handle>
|
||||
<a .btn .btn-mini .disabled>
|
||||
<i .icon-resize-vertical></i>
|
||||
#{name}
|
||||
<td .draghide>
|
||||
$if needsEnabled actions
|
||||
<a href="@{setupRepoLink actions}">
|
||||
<i .icon-warning-sign></i> not enabled
|
||||
$forall (name, repoid, actions) <- repolist
|
||||
<tr .repoline ##{show repoid}>
|
||||
<td .handle>
|
||||
<a .btn .btn-mini .disabled>
|
||||
<i .icon-resize-vertical></i>
|
||||
#{name}
|
||||
<td .draghide>
|
||||
$if needsEnabled actions
|
||||
<a href="@{setupRepoLink actions}">
|
||||
<i .icon-warning-sign></i> not enabled
|
||||
$else
|
||||
$if notWanted actions
|
||||
<i .icon-trash></i> cleaning out..
|
||||
$else
|
||||
$if notWanted actions
|
||||
<i .icon-trash></i> cleaning out..
|
||||
$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
|
||||
<span .dropdown #menu-#{fromUUID uuid}>
|
||||
<a .dropdown-toggle data-toggle="dropdown" href="#menu-#{fromUUID uuid}">
|
||||
<i .icon-cog></i> settings
|
||||
<b .caret></b>
|
||||
<ul .dropdown-menu>
|
||||
<li>
|
||||
<a href="@{setupRepoLink actions}">
|
||||
<i .icon-pencil></i> Edit
|
||||
<a href="@{DisableRepositoryR uuid}">
|
||||
<a href="@{syncToggleLink actions}">
|
||||
$if notSyncing actions
|
||||
<i .icon-ban-circle></i> syncing disabled
|
||||
$else
|
||||
<i .icon-refresh></i> syncing enabled #
|
||||
$if lacksUUID repoid
|
||||
(metadata only)
|
||||
<td .draghide>
|
||||
$if needsEnabled actions
|
||||
<a href="@{setupRepoLink actions}">
|
||||
enable
|
||||
$else
|
||||
<span .dropdown #menu-#{show repoid}>
|
||||
<a .dropdown-toggle data-toggle="dropdown" href="#menu-#{show repoid}">
|
||||
<i .icon-cog></i> settings
|
||||
<b .caret></b>
|
||||
<ul .dropdown-menu>
|
||||
<li>
|
||||
<a href="@{setupRepoLink actions}">
|
||||
<i .icon-pencil></i> Edit
|
||||
$if not (lacksUUID repoid)
|
||||
<a href="@{DisableRepositoryR $ asUUID repoid}">
|
||||
<i .icon-minus></i> Disable
|
||||
<a href="@{DeleteRepositoryR uuid}">
|
||||
<a href="@{DeleteRepositoryR $ asUUID repoid}">
|
||||
<i .icon-trash></i> Delete
|
||||
$if addmore
|
||||
<tr>
|
||||
|
|
Loading…
Reference in a new issue