linux upgrade code debugged and working
This commit is contained in:
parent
fdc10b9436
commit
fead2941cd
3 changed files with 29 additions and 12 deletions
|
@ -91,9 +91,9 @@ onDel file = case parseTransferFile file of
|
||||||
minfo <- removeTransfer t
|
minfo <- removeTransfer t
|
||||||
|
|
||||||
-- Run transfer hook.
|
-- Run transfer hook.
|
||||||
void $ maybe noop (\hook -> void $ forkIO $ hook t)
|
m <- transferHook <$> getDaemonStatus
|
||||||
. M.lookup (transferKey t)
|
maybe noop (\hook -> void $ liftIO $ forkIO $ hook t)
|
||||||
. transferHook <$> getDaemonStatus
|
(M.lookup (transferKey t) m)
|
||||||
|
|
||||||
finished <- asIO2 finishedTransfer
|
finished <- asIO2 finishedTransfer
|
||||||
void $ liftIO $ forkIO $ do
|
void $ liftIO $ forkIO $ do
|
||||||
|
|
|
@ -93,10 +93,13 @@ startDistributionDownload d = do
|
||||||
-}
|
-}
|
||||||
distributionDownloadComplete :: GitAnnexDistribution -> Assistant () -> Transfer -> Assistant ()
|
distributionDownloadComplete :: GitAnnexDistribution -> Assistant () -> Transfer -> Assistant ()
|
||||||
distributionDownloadComplete d cleanup t
|
distributionDownloadComplete d cleanup t
|
||||||
| transferDirection t == Download =
|
| transferDirection t == Download = do
|
||||||
|
debug ["finished downloading git-annex distribution"]
|
||||||
maybe cleanup (upgradeToDistribution d cleanup)
|
maybe cleanup (upgradeToDistribution d cleanup)
|
||||||
=<< liftAnnex (withObjectLoc k fsckit (getM fsckit))
|
=<< liftAnnex (withObjectLoc k fsckit (getM fsckit))
|
||||||
| otherwise = cleanup
|
| otherwise = do
|
||||||
|
debug ["finished downloading git-annex distribution 2"]
|
||||||
|
cleanup
|
||||||
where
|
where
|
||||||
k = distributionKey d
|
k = distributionKey d
|
||||||
fsckit f = case Backend.maybeLookupBackendName (Types.Key.keyBackendName k) of
|
fsckit f = case Backend.maybeLookupBackendName (Types.Key.keyBackendName k) of
|
||||||
|
@ -122,15 +125,24 @@ upgradeToDistribution d cleanup f = do
|
||||||
#else
|
#else
|
||||||
{- Linux uses a tarball, so untar it (into a temp directory)
|
{- Linux uses a tarball, so untar it (into a temp directory)
|
||||||
- and move the directory into place. -}
|
- and move the directory into place. -}
|
||||||
olddir <- parentDir <$> liftIO programFile
|
olddir <- parentDir <$> liftIO readProgramFile
|
||||||
let topdir = parentDir olddir
|
let topdir = parentDir olddir
|
||||||
let newdir = topdir </> "git-annex.linux." ++ distributionVersion d
|
let newdir = topdir </> "git-annex.linux." ++ distributionVersion d
|
||||||
liftIO $ void $ tryIO $ removeDirectoryRecursive newdir
|
liftIO $ void $ tryIO $ removeDirectoryRecursive newdir
|
||||||
liftIO $ withTmpDirIn topdir "git-annex.upgrade" $ \tmpdir -> do
|
liftIO $ withTmpDirIn topdir "git-annex.upgrade" $ \tmpdir -> do
|
||||||
|
let tarball = tmpdir </> "tar"
|
||||||
|
-- Cannot rely on filename extension, and this also
|
||||||
|
-- avoids problems if tar doesn't support transparent
|
||||||
|
-- decompression.
|
||||||
|
void $ boolSystem "sh"
|
||||||
|
[ Param "-c"
|
||||||
|
, Param $ "zcat < " ++ shellEscape f ++
|
||||||
|
" > " ++ shellEscape tarball
|
||||||
|
]
|
||||||
tarok <- boolSystem "tar"
|
tarok <- boolSystem "tar"
|
||||||
[ Param "--directory", File tmpdir
|
[ Param "xf"
|
||||||
, Param "xf"
|
, Param tarball
|
||||||
, Param f
|
, Param "--directory", File tmpdir
|
||||||
]
|
]
|
||||||
unless tarok $
|
unless tarok $
|
||||||
error $ "failed to untar " ++ f
|
error $ "failed to untar " ++ f
|
||||||
|
@ -158,9 +170,6 @@ upgradeToDistribution d cleanup f = do
|
||||||
pf <- programFile
|
pf <- programFile
|
||||||
liftIO $ writeFile pf program
|
liftIO $ writeFile pf program
|
||||||
|
|
||||||
usingDistribution :: IO Bool
|
|
||||||
usingDistribution = isJust <$> getEnv "GIT_ANNEX_STANDLONE_ENV"
|
|
||||||
|
|
||||||
{- This is a file that the UpgradeWatcher can watch for modifications to
|
{- This is a file that the UpgradeWatcher can watch for modifications to
|
||||||
- detect when git-annex has been upgraded.
|
- detect when git-annex has been upgraded.
|
||||||
-}
|
-}
|
||||||
|
@ -192,3 +201,6 @@ upgradeSanityCheck = ifM usingDistribution
|
||||||
. filter (`elem` [Lsof.OpenReadWrite, Lsof.OpenWriteOnly])
|
. filter (`elem` [Lsof.OpenReadWrite, Lsof.OpenWriteOnly])
|
||||||
. map snd3
|
. map snd3
|
||||||
<$> Lsof.query [f]
|
<$> Lsof.query [f]
|
||||||
|
|
||||||
|
usingDistribution :: IO Bool
|
||||||
|
usingDistribution = isJust <$> getEnv "GIT_ANNEX_STANDLONE_ENV"
|
||||||
|
|
|
@ -45,6 +45,11 @@ bundledPrograms = catMaybes
|
||||||
, SysConfig.sha512
|
, SysConfig.sha512
|
||||||
, SysConfig.sha224
|
, SysConfig.sha224
|
||||||
, SysConfig.sha384
|
, SysConfig.sha384
|
||||||
|
#ifdef linux_HOST_OS
|
||||||
|
-- used to unpack the tarball when upgrading
|
||||||
|
, Just "gunzip"
|
||||||
|
, Just "tar"
|
||||||
|
#endif
|
||||||
-- nice and ionice are not included in the bundle; we rely on the
|
-- nice and ionice are not included in the bundle; we rely on the
|
||||||
-- system's own version, which may better match its kernel
|
-- system's own version, which may better match its kernel
|
||||||
]
|
]
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue