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

minor refactoring

Browse source
This commit is contained in:
Joey Hess 2013-03-30 19:05:51 -04:00
parent 553e9dc736
commit acd6a150e5
3 changed files with 10 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
Command/RecvKey.hs
View file

@ -20,8 +20,6 @@ import qualified Types.Key
import qualified Types.Backend import qualified Types.Backend
import qualified Backend import qualified Backend
import System.Console.GetOpt
def :: [Command] def :: [Command]
def = [noCommit $ command "recvkey" paramKey seek def = [noCommit $ command "recvkey" paramKey seek
SectionPlumbing "runs rsync in server mode to receive content"] SectionPlumbing "runs rsync in server mode to receive content"]
@ -44,8 +42,8 @@ start key = ifM (inAnnex key)
) )
where where
go tmp = do go tmp = do
(opts,_,_) <- getOpt Permute rsyncSafeOptions <$> opts <- filterRsyncSafeOptions . maybe [] words
maybe [] words <$> getField "RsyncOptions" <$> getField "RsyncOptions"
ifM (liftIO $ rsyncServerReceive (map Param opts) tmp) ifM (liftIO $ rsyncServerReceive (map Param opts) tmp)
( ifM (isJust <$> Fields.getField Fields.direct) ( ifM (isJust <$> Fields.getField Fields.direct)
( directcheck tmp ( directcheck tmp

6
Command/SendKey.hs
View file

@ -16,8 +16,6 @@ import Logs.Transfer
import qualified Fields import qualified Fields
import Utility.Metered import Utility.Metered
import System.Console.GetOpt
def :: [Command] def :: [Command]
def = [noCommit $ command "sendkey" paramKey seek def = [noCommit $ command "sendkey" paramKey seek
SectionPlumbing "runs rsync in server mode to send content"] SectionPlumbing "runs rsync in server mode to send content"]
@ -27,8 +25,8 @@ seek = [withKeys start]
start :: Key -> CommandStart start :: Key -> CommandStart
start key = do start key = do
(opts,_,_) <- getOpt Permute rsyncSafeOptions <$> opts <- filterRsyncSafeOptions . maybe [] words
maybe [] words <$> getField "RsyncOptions" <$> getField "RsyncOptions"
ifM (inAnnex key) ifM (inAnnex key)
( fieldTransfer Upload key $ \_p -> ( fieldTransfer Upload key $ \_p ->
sendAnnex key rollback $ liftIO . rsyncServerSend (map Param opts) sendAnnex key rollback $ liftIO . rsyncServerSend (map Param opts)

14
Utility/Rsync.hs
View file

@ -12,6 +12,7 @@ import Utility.Metered
import Data.Char import Data.Char
import System.Console.GetOpt import System.Console.GetOpt
import Data.Tuple.Utils
{- Generates parameters to make rsync use a specified command as its remote {- Generates parameters to make rsync use a specified command as its remote
- shell. -} - shell. -}
@ -130,13 +131,10 @@ parseRsyncProgress = go [] . reverse . progresschunks
(_, []) -> Nothing (_, []) -> Nothing
(b, _) -> readish b (b, _) -> readish b
{- Rsync options that are safe to pass to rsync in server mode, without {- Filters options to those that are safe to pass to rsync in server mode,
- causing it to eg, expose files. - without causing it to eg, expose files. -}
- filterRsyncSafeOptions :: [String] -> [String]
- Note: Ensure that when calling getopt, the first component of the filterRsyncSafeOptions = fst3 . getOpt Permute
- output is a subset of the input. [ Option [] ["bwlimit"] (reqArgLong "bwlimit") "" ]
-}
rsyncSafeOptions :: [OptDescr String]
rsyncSafeOptions = [ Option [] ["bwlimit"] (reqArgLong "bwlimit") "" ]
where where
reqArgLong x = ReqArg (\v -> "--" ++ x ++ "=" ++ v) "" reqArgLong x = ReqArg (\v -> "--" ++ x ++ "=" ++ v) ""