blob: f25de23a2c61a0b49cea7c35e1f63e5bba1526ab (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
|
{- git-annex command
-
- Copyright 2010 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Command.FromKey where
import Control.Monad.State (liftIO)
import System.Posix.Files
import System.Directory
import Control.Monad (when, unless)
import Command
import qualified Annex
import Utility
import qualified Backend
import Types
import Core
import Messages
seek :: [SubCmdSeek]
seek = [withFilesMissing start]
{- Adds a file pointing at a manually-specified key -}
start :: SubCmdStartString
start file = do
keyname <- Annex.flagGet "key"
when (null keyname) $ error "please specify the key with --key"
backends <- Backend.list
let key = genKey (backends !! 0) keyname
inbackend <- Backend.hasKey key
unless (inbackend) $ error $
"key ("++keyname++") is not present in backend"
showStart "fromkey" file
return $ Just $ perform file key
perform :: FilePath -> Key -> SubCmdPerform
perform file key = do
link <- calcGitLink file key
liftIO $ createDirectoryIfMissing True (parentDir file)
liftIO $ createSymbolicLink link file
return $ Just $ cleanup file
cleanup :: FilePath -> SubCmdCleanup
cleanup file = do
Annex.queue "add" ["--"] file
return True
|
