cadey
/
propellor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

propellor spin

This commit is contained in:
Joey Hess 2014-11-19 21:03:06 -04:00
parent 025c7c4b8e
commit 4de7d4295c
Failed to extract signature
1 changed files with 10 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
src/Propellor/Property/Debootstrap.hs
View File

@ -41,9 +41,9 @@ built target system@(System _ arch) extraparams =
setupprop = property ("debootstrapped " ++ target) $ liftIO $ do setupprop = property ("debootstrapped " ++ target) $ liftIO $ do
createDirectoryIfMissing True target createDirectoryIfMissing True target
let suite = case extractSuite system of suite <- case extractSuite system of
Nothing -> error $ "don't know how to debootstrap " ++ show system Nothing -> errorMessage $ "don't know how to debootstrap " ++ show system
Just s -> s Just s -> pure s
let params = extraparams ++ let params = extraparams ++
[ Param suite [ Param suite
, Param target , Param target
@ -63,7 +63,7 @@ built target system@(System _ arch) extraparams =
<$> mountPoints <$> mountPoints
forM_ submnts $ \mnt -> forM_ submnts $ \mnt ->
unlessM (boolSystem "umount" [ Param "-l", Param mnt ]) $ do unlessM (boolSystem "umount" [ Param "-l", Param mnt ]) $ do
error $ "failed unmounting " ++ mnt errorMessage $ "failed unmounting " ++ mnt
removeDirectoryRecursive target removeDirectoryRecursive target
return MadeChange return MadeChange
@ -108,7 +108,7 @@ sourceInstall' :: IO Result
sourceInstall' = withTmpDir "debootstrap" $ \tmpd -> do sourceInstall' = withTmpDir "debootstrap" $ \tmpd -> do
let indexfile = tmpd </> "index.html" let indexfile = tmpd </> "index.html"
unlessM (download baseurl indexfile) $ unlessM (download baseurl indexfile) $
error $ "Failed to download " ++ baseurl errorMessage $ "Failed to download " ++ baseurl
urls <- reverse . sort -- highest version first urls <- reverse . sort -- highest version first
. filter ("debootstrap_" `isInfixOf`) . filter ("debootstrap_" `isInfixOf`)
. filter (".tar." `isInfixOf`) . filter (".tar." `isInfixOf`)
@ -120,15 +120,15 @@ sourceInstall' = withTmpDir "debootstrap" $ \tmpd -> do
(tarurl:_) -> do (tarurl:_) -> do
let f = tmpd </> takeFileName tarurl let f = tmpd </> takeFileName tarurl
unlessM (download tarurl f) $ unlessM (download tarurl f) $
error $ "Failed to download " ++ tarurl errorMessage $ "Failed to download " ++ tarurl
return f return f
_ -> error $ "Failed to find any debootstrap tarballs listed on " ++ baseurl _ -> errorMessage $ "Failed to find any debootstrap tarballs listed on " ++ baseurl
createDirectoryIfMissing True localInstallDir createDirectoryIfMissing True localInstallDir
bracket getWorkingDirectory changeWorkingDirectory $ \_ -> do bracket getWorkingDirectory changeWorkingDirectory $ \_ -> do
changeWorkingDirectory localInstallDir changeWorkingDirectory localInstallDir
unlessM (boolSystem "tar" [Param "xf", File tarfile]) $ unlessM (boolSystem "tar" [Param "xf", File tarfile]) $
error "Failed to extract debootstrap tar file" errorMessage "Failed to extract debootstrap tar file"
nukeFile tarfile nukeFile tarfile
l <- dirContents "." l <- dirContents "."
case l of case l of
@ -137,7 +137,7 @@ sourceInstall' = withTmpDir "debootstrap" $ \tmpd -> do
makeDevicesTarball makeDevicesTarball
makeWrapperScript (localInstallDir </> subdir) makeWrapperScript (localInstallDir </> subdir)
return MadeChange return MadeChange
_ -> error "debootstrap tar file did not contain exactly one dirctory" _ -> errorMessage "debootstrap tar file did not contain exactly one dirctory"
sourceRemove :: Property sourceRemove :: Property
sourceRemove = property "debootstrap not installed from source" $ liftIO $ sourceRemove = property "debootstrap not installed from source" $ liftIO $
@ -183,7 +183,7 @@ makeDevicesTarball = do
ok <- boolSystem "sh" [Param "-c", Param tarcmd] ok <- boolSystem "sh" [Param "-c", Param tarcmd]
nukeFile foreignDevFlag nukeFile foreignDevFlag
unless ok $ unless ok $
error "Failed to tar up /dev to generate devices.tar.gz" errorMessage "Failed to tar up /dev to generate devices.tar.gz"
where where
tarcmd = "(cd / && tar cf - dev) | gzip > devices.tar.gz" tarcmd = "(cd / && tar cf - dev) | gzip > devices.tar.gz"