first pass at using new keys

It compiles. It sorta works. Several subcommands are FIXME marked and
broken, because things that used to accept separate --backend and --key
params need to be changed to accept just a --key that encodes all the key
info, now that there is metadata in keys.
This commit is contained in:
Joey Hess 2011-03-15 21:34:13 -04:00
parent 675ee89749
commit 9d49fe2c17
20 changed files with 116 additions and 123 deletions

View file

@ -26,8 +26,10 @@ seek = [withKeys start]
start :: CommandStartString
start keyname = do
backends <- Backend.list
let key = genKey (head backends) keyname
present <- inAnnex key
let key = error "fixme!!"
--let key = genKey (head backends) keyname --TODO FIXME
let present = error "fixme!!"
--present <- inAnnex key
force <- Annex.getState Annex.force
if not present
then return Nothing

View file

@ -11,6 +11,7 @@ import Control.Monad (when)
import Control.Monad.State (liftIO)
import qualified Data.Map as M
import System.Directory
import Data.Maybe
import Command
import Types
@ -19,6 +20,7 @@ import Locations
import qualified Annex
import qualified Command.Drop
import Backend
import Key
command :: [Command]
command = [Command "dropunused" (paramRepeating paramNumber) seek
@ -55,7 +57,6 @@ readUnusedLog = do
return $ M.fromList $ map parse $ lines l
else return $ M.empty
where
parse line = (head ws, tokey $ unwords $ tail ws)
parse line = (head ws, fromJust $ readKey $ unwords $ tail ws)
where
ws = words line
tokey s = read s :: Key

View file

@ -16,9 +16,9 @@ import Command
import qualified Annex
import Utility
import qualified Backend
import Types
import Content
import Messages
import Key
command :: [Command]
command = [Command "fromkey" paramPath seek

View file

@ -11,9 +11,10 @@ import Control.Monad.State (liftIO)
import System.Exit
import Command
import Types
import Content
import qualified Backend
import qualified BackendTypes
import Key
command :: [Command]
command = [Command "inannex" (paramRepeating paramKey) seek
@ -25,7 +26,11 @@ seek = [withKeys start]
start :: CommandStartString
start keyname = do
backends <- Backend.list
let key = genKey (head backends) keyname
let key = stubKey {
keyName = keyname,
keyBackendName = BackendTypes.name (head backends)
}
error "BROKEN. fixme!"
present <- inAnnex key
if present
then return Nothing

View file

@ -20,7 +20,8 @@ import qualified Remotes
import UUID
import Messages
import Utility
import Key
command :: [Command]
command = [Command "move" paramPath seek
"move content of files to/from another repository"]
@ -136,7 +137,7 @@ fromCleanup :: Git.Repo -> Bool -> Key -> CommandCleanup
fromCleanup src True key = do
ok <- Remotes.onRemote src (boolSystem, False) "dropkey"
[ Params "--quiet --force"
, Param $ "--backend=" ++ backendName key
, Param $ "--backend=" ++ keyBackendName key
, Param $ keyName key
]
-- better safe than sorry: assume the src dropped the key

View file

@ -27,6 +27,8 @@ seek = [withKeys start]
start :: CommandStartString
start keyname = do
error "BROKEN FIXME!"
{-
backends <- Backend.list
let key = genKey (head backends) keyname
present <- inAnnex key
@ -41,3 +43,4 @@ start keyname = do
_ <- shutdown
liftIO exitSuccess
else liftIO exitFailure
-}

View file

@ -28,6 +28,8 @@ seek = [withKeys start]
start :: CommandStartString
start keyname = do
error "BROKEN FIXME!"
{-
backends <- Backend.list
let key = genKey (head backends) keyname
present <- inAnnex key
@ -36,3 +38,4 @@ start keyname = do
when present $
liftIO $ rsyncServerSend file
liftIO exitFailure
-}

View file

@ -126,4 +126,4 @@ tmpKeys = do
contents <- liftIO $ getDirectoryContents tmp
files <- liftIO $ filterM doesFileExist $
map (tmp </>) contents
return $ map (fileKey . takeFileName) files
return $ catMaybes $ map (fileKey . takeFileName) files