more OsPath conversion (602/749)
Sponsored-by: Brock Spratlen
This commit is contained in:
parent
2d1db7986c
commit
a5d48edd94
25 changed files with 227 additions and 187 deletions
|
@ -28,7 +28,6 @@ import Utility.Hash
|
|||
import Utility.Tmp
|
||||
import Utility.Tmp.Dir
|
||||
import Utility.Process.Transcript
|
||||
import qualified Utility.RawFilePath as R
|
||||
|
||||
import Data.Char
|
||||
import qualified Data.ByteString.Lazy.UTF8 as B8
|
||||
|
@ -85,9 +84,9 @@ genAddress = starting "gen-address" (ActionItemOther Nothing) (SeekInput []) $ d
|
|||
(s, ok) <- case k of
|
||||
KeyContainer s -> liftIO $ genkey (Param s)
|
||||
KeyFile f -> do
|
||||
createAnnexDirectory (toRawFilePath (takeDirectory f))
|
||||
liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath f)
|
||||
liftIO $ protectedOutput $ genkey (File f)
|
||||
createAnnexDirectory (takeDirectory f)
|
||||
liftIO $ removeWhenExistsWith removeFile f
|
||||
liftIO $ protectedOutput $ genkey (File (fromOsPath f))
|
||||
case (ok, parseFingerprint s) of
|
||||
(False, _) -> giveup $ "uftp_keymgt failed: " ++ s
|
||||
(_, Nothing) -> giveup $ "Failed to find fingerprint in uftp_keymgt output: " ++ s
|
||||
|
@ -130,19 +129,18 @@ send ups fs = do
|
|||
-- the names of keys, and would have to be copied, which is too
|
||||
-- expensive.
|
||||
starting "sending files" (ActionItemOther Nothing) (SeekInput []) $
|
||||
withTmpFile (toOsPath "send") $ \t h -> do
|
||||
withTmpFile (literalOsPath "send") $ \t h -> do
|
||||
let ww = WarnUnmatchLsFiles "multicast"
|
||||
(fs', cleanup) <- seekHelper id ww LsFiles.inRepo
|
||||
=<< workTreeItems ww fs
|
||||
matcher <- Limit.getMatcher
|
||||
let addlist f o = whenM (matcher $ MatchingFile $ FileInfo f f Nothing) $
|
||||
liftIO $ hPutStrLn h o
|
||||
liftIO $ hPutStrLn h (fromOsPath o)
|
||||
forM_ fs' $ \(_, f) -> do
|
||||
mk <- lookupKey f
|
||||
case mk of
|
||||
Nothing -> noop
|
||||
Just k -> withObjectLoc k $
|
||||
addlist f . fromRawFilePath
|
||||
Just k -> withObjectLoc k $ addlist f
|
||||
liftIO $ hClose h
|
||||
liftIO $ void cleanup
|
||||
|
||||
|
@ -161,9 +159,9 @@ send ups fs = do
|
|||
, Param "-k", uftpKeyParam serverkey
|
||||
, Param "-U", Param (uftpUID u)
|
||||
-- only allow clients on the authlist
|
||||
, Param "-H", Param ("@"++authlist)
|
||||
, Param "-H", Param ("@"++fromOsPath authlist)
|
||||
-- pass in list of files to send
|
||||
, Param "-i", File (fromRawFilePath (fromOsPath t))
|
||||
, Param "-i", File (fromOsPath t)
|
||||
] ++ ups
|
||||
liftIO (boolSystem "uftp" ps) >>= showEndResult
|
||||
next $ return True
|
||||
|
@ -178,9 +176,9 @@ receive ups = starting "receiving multicast files" ai si $ do
|
|||
(callback, environ, statush) <- liftIO multicastCallbackEnv
|
||||
tmpobjdir <- fromRepo gitAnnexTmpObjectDir
|
||||
createAnnexDirectory tmpobjdir
|
||||
withTmpDirIn (fromRawFilePath tmpobjdir) (toOsPath "multicast") $ \tmpdir -> withAuthList $ \authlist -> do
|
||||
abstmpdir <- liftIO $ absPath (toRawFilePath tmpdir)
|
||||
abscallback <- liftIO $ searchPath callback
|
||||
withTmpDirIn tmpobjdir (literalOsPath "multicast") $ \tmpdir -> withAuthList $ \authlist -> do
|
||||
abstmpdir <- liftIO $ absPath tmpdir
|
||||
abscallback <- liftIO $ searchPath (fromOsPath callback)
|
||||
let ps =
|
||||
-- Avoid it running as a daemon.
|
||||
[ Param "-d"
|
||||
|
@ -189,42 +187,43 @@ receive ups = starting "receiving multicast files" ai si $ do
|
|||
, Param "-k", uftpKeyParam clientkey
|
||||
, Param "-U", Param (uftpUID u)
|
||||
-- Only allow servers on the authlist
|
||||
, Param "-S", Param authlist
|
||||
, Param "-S", Param (fromOsPath authlist)
|
||||
-- Receive files into tmpdir
|
||||
-- (it needs an absolute path)
|
||||
, Param "-D", File (fromRawFilePath abstmpdir)
|
||||
, Param "-D", File (fromOsPath abstmpdir)
|
||||
-- Run callback after each file received
|
||||
-- (it needs an absolute path)
|
||||
, Param "-s", Param (fromMaybe callback abscallback)
|
||||
, Param "-s", Param (fromOsPath $ fromMaybe callback abscallback)
|
||||
] ++ ups
|
||||
runner <- liftIO $ async $
|
||||
hClose statush
|
||||
`after` boolSystemEnv "uftpd" ps (Just environ)
|
||||
mapM_ storeReceived . lines =<< liftIO (hGetContents statush)
|
||||
mapM_ storeReceived . map toOsPath . lines
|
||||
=<< liftIO (hGetContents statush)
|
||||
showEndResult =<< liftIO (wait runner)
|
||||
next $ return True
|
||||
where
|
||||
ai = ActionItemOther Nothing
|
||||
si = SeekInput []
|
||||
|
||||
storeReceived :: FilePath -> Annex ()
|
||||
storeReceived :: OsPath -> Annex ()
|
||||
storeReceived f = do
|
||||
case deserializeKey (takeFileName f) of
|
||||
case deserializeKey' (fromOsPath (takeFileName f)) of
|
||||
Nothing -> do
|
||||
warning $ "Received a file " <> QuotedPath (toRawFilePath f) <> " that is not a git-annex key. Deleting this file."
|
||||
liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath f)
|
||||
warning $ "Received a file " <> QuotedPath f <> " that is not a git-annex key. Deleting this file."
|
||||
liftIO $ removeWhenExistsWith removeFile f
|
||||
Just k -> void $ logStatusAfter NoLiveUpdate k $
|
||||
getViaTmpFromDisk RetrievalVerifiableKeysSecure AlwaysVerify k (AssociatedFile Nothing) $ \dest -> unVerified $
|
||||
liftIO $ catchBoolIO $ do
|
||||
R.rename (toRawFilePath f) dest
|
||||
renameFile f dest
|
||||
return True
|
||||
|
||||
-- Under Windows, uftp uses key containers, which are not files on the
|
||||
-- filesystem.
|
||||
data UftpKey = KeyFile FilePath | KeyContainer String
|
||||
data UftpKey = KeyFile OsPath | KeyContainer String
|
||||
|
||||
uftpKeyParam :: UftpKey -> CommandParam
|
||||
uftpKeyParam (KeyFile f) = File f
|
||||
uftpKeyParam (KeyFile f) = File (fromOsPath f)
|
||||
uftpKeyParam (KeyContainer s) = Param s
|
||||
|
||||
uftpKey :: Annex UftpKey
|
||||
|
@ -233,7 +232,7 @@ uftpKey = do
|
|||
u <- getUUID
|
||||
return $ KeyContainer $ "annex-" ++ fromUUID u
|
||||
#else
|
||||
uftpKey = KeyFile <$> credsFile "multicast"
|
||||
uftpKey = KeyFile <$> credsFile (literalOsPath "multicast")
|
||||
#endif
|
||||
|
||||
-- uftp needs a unique UID for each client and server, which
|
||||
|
@ -242,13 +241,13 @@ uftpKey = KeyFile <$> credsFile "multicast"
|
|||
uftpUID :: UUID -> String
|
||||
uftpUID u = "0x" ++ (take 8 $ show $ sha2_256 $ B8.fromString (fromUUID u))
|
||||
|
||||
withAuthList :: (FilePath -> Annex a) -> Annex a
|
||||
withAuthList :: (OsPath -> Annex a) -> Annex a
|
||||
withAuthList a = do
|
||||
m <- knownFingerPrints
|
||||
withTmpFile (toOsPath "authlist") $ \t h -> do
|
||||
withTmpFile (literalOsPath "authlist") $ \t h -> do
|
||||
liftIO $ hPutStr h (genAuthList m)
|
||||
liftIO $ hClose h
|
||||
a (fromRawFilePath (fromOsPath t))
|
||||
a t
|
||||
|
||||
genAuthList :: M.Map UUID Fingerprint -> String
|
||||
genAuthList = unlines . map fmt . M.toList
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue