summaryrefslogtreecommitdiff
path: root/src/Propellor
diff options
context:
space:
mode:
Diffstat (limited to 'src/Propellor')
-rw-r--r--src/Propellor/Bootstrap.hs34
-rw-r--r--src/Propellor/Property/SiteSpecific/JoeySites.hs44
-rw-r--r--src/Propellor/Types/Dns.hs2
-rw-r--r--src/Propellor/Wrapper.hs1
4 files changed, 54 insertions, 27 deletions
diff --git a/src/Propellor/Bootstrap.hs b/src/Propellor/Bootstrap.hs
index d772d7c7..6aa5720c 100644
--- a/src/Propellor/Bootstrap.hs
+++ b/src/Propellor/Bootstrap.hs
@@ -81,13 +81,21 @@ buildCommand bs = intercalate " && " (go (getBuilder bs))
go Cabal =
[ "cabal configure"
, "cabal build -j1 propellor-config"
- , "ln -sf dist/build/propellor-config/propellor-config propellor"
+ , "ln -sf" `commandCabalBuildTo` "propellor"
]
go Stack =
[ "stack build :propellor-config"
, "ln -sf $(stack path --dist-dir)/build/propellor-config/propellor-config propellor"
]
+commandCabalBuildTo :: ShellCommand -> FilePath -> ShellCommand
+commandCabalBuildTo cmd dest = intercalate "; "
+ [ "if [ -d dist-newstyle ]"
+ , "then " ++ cmd ++ " $(cabal exec -- sh -c 'command -v propellor-config') " ++ shellEscape dest
+ , "else " ++ cmd ++ " dist/build/propellor-config/propellor-config " ++ shellEscape dest
+ , "fi"
+ ]
+
-- Check if all dependencies are installed; if not, run the depsCommand.
checkDepsCommand :: Bootstrapper -> Maybe System -> ShellCommand
checkDepsCommand bs sys = go (getBuilder bs)
@@ -257,32 +265,28 @@ buildPropellor mh = unlessM (actionMessage "Propellor build" build) $
-- dependencies and retries.
cabalBuild :: Maybe System -> IO Bool
cabalBuild msys = do
- make "dist/setup-config" ["propellor.cabal"] cabal_configure
+ make "configured" ["propellor.cabal"] cabal_configure
unlessM cabal_build $
unlessM (cabal_configure <&&> cabal_build) $
error "cabal build failed"
- -- For safety against eg power loss in the middle of the build,
- -- make a copy of the binary, and move it into place atomically.
- -- This ensures that the propellor symlink only ever points at
- -- a binary that is fully built. Also, avoid ever removing
- -- or breaking the symlink.
- --
- -- Need cp -pfRL to make build timestamp checking work.
- unlessM (boolSystem "cp" [Param "-pfRL", Param cabalbuiltbin, Param (tmpfor safetycopy)]) $
+ -- Make a copy of the binary, and move it into place atomically.
+ let safetycopy = "propellor.built"
+ let cpcmd = "cp -pfL" `commandCabalBuildTo` safetycopy
+ unlessM (boolSystem "sh" [Param "-c", Param cpcmd]) $
error "cp of binary failed"
- rename (tmpfor safetycopy) safetycopy
- symlinkPropellorBin safetycopy
+ rename safetycopy "propellor"
return True
where
- cabalbuiltbin = "dist/build/propellor-config/propellor-config"
- safetycopy = cabalbuiltbin ++ ".built"
cabal_configure = ifM (cabal ["configure"])
- ( return True
+ ( do
+ writeFile "configured" ""
+ return True
, case msys of
Nothing -> return False
Just sys ->
boolSystem "sh" [Param "-c", Param (depsCommand (Robustly Cabal) (Just sys))]
<&&> cabal ["configure"]
+ <&&> (writeFile "configured" "" >> return True)
)
-- The -j1 is to only run one job at a time -- in some situations,
-- eg in qemu, ghc does not run reliably in parallel.
diff --git a/src/Propellor/Property/SiteSpecific/JoeySites.hs b/src/Propellor/Property/SiteSpecific/JoeySites.hs
index 9b8a7e70..64bee99d 100644
--- a/src/Propellor/Property/SiteSpecific/JoeySites.hs
+++ b/src/Propellor/Property/SiteSpecific/JoeySites.hs
@@ -1238,33 +1238,46 @@ homeNAS = propertyList "home NAS" $ props
[ "# let users power control startech hub with uhubctl"
, "ATTR{idVendor}==\"" ++ hubvendor ++ "\", ATTR{idProduct}==\"005a\", MODE=\"0666\""
]
- & autoMountDrivePort "archive-10" (USBHubPort hubvendor hubloc 1)
+ & autoMountDrivePort "archive-10"
+ (USBHubPort hubvendor 1)
+ (USBDriveId wd "1230")
(Just "archive-oldest")
- & autoMountDrivePort "archive-11" (USBHubPort hubvendor hubloc 2)
+ & autoMountDrivePort "archive-11"
+ (USBHubPort hubvendor 2)
+ (USBDriveId wd "25ee")
(Just "archive-older")
- & autoMountDrivePort "archive-12" (USBHubPort hubvendor hubloc 3)
+ & autoMountDrivePort "archive-12"
+ (USBHubPort hubvendor 3)
+ (USBDriveId seagate "3322")
(Just "archive-old")
- & autoMountDrivePort "archive-13" (USBHubPort hubvendor hubloc 4)
+ & autoMountDrivePort "archive-13"
+ (USBHubPort hubvendor 4)
+ (USBDriveId wd "25a3")
(Just "archive")
& autoMountDrive "passport" Nothing
& Apt.installed ["git-annex", "borgbackup"]
where
hubvendor = "0409"
- hubloc = "4-1.6"
+ wd = "1058"
+ seagate = "0bc2"
data USBHubPort = USBHubPort
{ hubVendor :: String
- , hubLocation :: String
, hubPort :: Int
}
+data USBDriveId = USBDriveId
+ { driveVendorId :: String
+ , driveProductId :: String
+ }
+
-- Makes a USB drive with the given label automount, and unmount after idle
-- for a while.
--
-- The hub port is turned on and off automatically as needed, using
-- uhubctl.
-autoMountDrivePort :: Mount.Label -> USBHubPort -> Maybe FilePath -> Property DebianLike
-autoMountDrivePort label hp malias = propertyList desc $ props
+autoMountDrivePort :: Mount.Label -> USBHubPort -> USBDriveId -> Maybe FilePath -> Property DebianLike
+autoMountDrivePort label hp drive malias = propertyList desc $ props
& File.hasContent ("/etc/systemd/system/" ++ hub)
[ "[Unit]"
, "Description=Startech usb hub port " ++ show (hubPort hp)
@@ -1272,7 +1285,7 @@ autoMountDrivePort label hp malias = propertyList desc $ props
, "[Service]"
, "Type=oneshot"
, "RemainAfterExit=true"
- , "ExecStart=/usr/sbin/uhubctl -a on " ++ selecthubport
+ , "ExecStart=/bin/sh -c 'uhubctl -a on " ++ selecthubport ++ "'"
, "ExecStop=/bin/sh -c 'uhubctl -a off " ++ selecthubport
-- Powering off the port does not remove device
-- files, so ask udev to remove the devfile; it will
@@ -1300,7 +1313,18 @@ autoMountDrivePort label hp malias = propertyList desc $ props
selecthubport = unwords
[ "-p", show (hubPort hp)
, "-n", hubVendor hp
- , "-l", hubLocation hp
+ , "-l", concat
+ -- The hub's location id, eg "1-1.4", does not seem
+ -- as stable as uhubctl claims it will be,
+ -- and the vendor is not sufficient since I have 2
+ -- hubs from the same vendor. So search for the
+ -- drive lsusb to find that. This works even if the
+ -- port is powered off, as long as it's been on at
+ -- some point before.
+ [ "$(lsusb -tvv | perl -lne \"if (\\\\$h && m!/sys/bus/usb/devices/(.*?) !) {\\\\$v=\\\\$1}; if (m/Hub/) { \\\\$h=1 } else { \\\\$h=0 }; if (/"
+ , driveVendorId drive ++ ":" ++ driveProductId drive
+ ++ "/) { print \\\\$v; last}\")"
+ ]
]
-- Makes a USB drive with the given label automount, and unmount after idle
diff --git a/src/Propellor/Types/Dns.hs b/src/Propellor/Types/Dns.hs
index 30302a7d..e9902513 100644
--- a/src/Propellor/Types/Dns.hs
+++ b/src/Propellor/Types/Dns.hs
@@ -181,7 +181,7 @@ newtype NamedConfMap = NamedConfMap (M.Map Domain NamedConf)
instance IsInfo NamedConfMap where
propagateInfo _ = PropagateInfo False
--- | Adding a Master NamedConf stanza for a particulr domain always
+-- | Adding a Master NamedConf stanza for a particular domain always
-- overrides an existing Secondary stanza for that domain, while a
-- Secondary stanza is only added when there is no existing Master stanza.
instance Sem.Semigroup NamedConfMap where
diff --git a/src/Propellor/Wrapper.hs b/src/Propellor/Wrapper.hs
index f399b2cf..1bef651c 100644
--- a/src/Propellor/Wrapper.hs
+++ b/src/Propellor/Wrapper.hs
@@ -2,7 +2,6 @@
-- distribution.
--
-- Distributions should install this program into PATH.
--- (Cabal builds it as dist/build/propellor/propellor).
--
-- This is not the propellor main program (that's config.hs).
-- This bootstraps ~/.propellor/config.hs, builds it if