mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

webapp automatic grouping

Browse source 
webapp: Adds newly created repositories to one of these groups:
clients, drives, servers

This is heuristic, but it's a pretty good heuristic, and can always be
configured.
This commit is contained in:
Joey Hess 2012-10-09 14:24:17 -04:00
parent 8eb1ba4cfe
commit a5781fd9ba
7 changed files with 73 additions and 43 deletions
Download patch file Download diff file Expand all files Collapse all files

24
Assistant/WebApp/Configurators/Local.hs
View file

@ -28,10 +28,13 @@ import Utility.DiskFree
import Utility.DataUnits
import Utility.Network
import Remote (prettyListUUIDs)
import Logs.Group
import Annex.UUID
import Yesod
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Set as S
import Data.Char
import System.Posix.Directory
import qualified Control.Exception as E
@ -142,10 +145,10 @@ getNewRepositoryR = bootstrap (Just Config) $ do
case res of
FormSuccess (RepositoryPath p) -> lift $ do
let path = T.unpack p
liftIO $ do
makeRepo path False
initRepo path Nothing
addAutoStart path
liftIO $ makeRepo path False
u <- liftIO $ initRepo path Nothing
runAnnex () $ groupSet u (S.singleton "clients")
liftIO $ addAutoStart path
redirect $ SwitchToRepositoryR path
_ -> $(widgetFile "configurators/newrepository")
@ -191,8 +194,9 @@ getAddDriveR = bootstrap (Just Config) $ do
where
go mountpoint = do
liftIO $ makerepo dir
liftIO $ initRepo dir $ Just remotename
u <- liftIO $ initRepo dir $ Just remotename
r <- addremote dir remotename
runAnnex () $ groupSet u (S.singleton "drives")
syncRemote r
where
dir = mountpoint </> gitAnnexAssistantDefaultDir
@ -260,9 +264,10 @@ driveList = mapM (gen . mnt_dir) =<< filter sane <$> getMounts
startFullAssistant :: FilePath -> Handler ()
startFullAssistant path = do
webapp <- getYesod
liftIO $ makeRepo path False
u <- liftIO $ initRepo path Nothing
runAnnex () $ groupSet u (S.singleton "clients")
url <- liftIO $ do
makeRepo path False
initRepo path Nothing
addAutoStart path
changeWorkingDirectory path
fromJust $ postFirstRun webapp
@ -286,10 +291,11 @@ inDir dir a = do
Annex.eval state a
{- Initializes a git-annex repository in a directory with a description. -}
initRepo :: FilePath -> Maybe String -> IO ()
initRepo dir desc = inDir dir $
initRepo :: FilePath -> Maybe String -> IO UUID
initRepo dir desc = inDir dir $ do
unlessM isInitialized $
initialize desc
getUUID
{- Adds a directory to the autostart file. -}
addAutoStart :: FilePath -> IO ()