git-annex-shell is complete

still not used
This commit is contained in:
Joey Hess 2010-12-31 13:39:30 -04:00
parent f38aa3e83a
commit 60df4e5728
7 changed files with 134 additions and 20 deletions

38
Command/SendKey.hs Normal file
View file

@ -0,0 +1,38 @@
{- git-annex command
-
- Copyright 2010 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Command.SendKey where
import Control.Monad (when)
import Control.Monad.State (liftIO)
import System.Exit
import Locations
import qualified Annex
import Command
import Types
import Core
import qualified Backend
import RsyncFile
command :: [Command]
command = [Command "sendkey" paramKey seek
"runs rsync in server mode to send content"]
seek :: [CommandSeek]
seek = [withKeys start]
start :: CommandStartString
start keyname = do
backends <- Backend.list
let key = genKey (head backends) keyname
present <- inAnnex key
g <- Annex.gitRepo
let file = annexLocation g key
when present $
liftIO $ rsyncServerSend file
liftIO exitFailure