diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,16 @@ +propellor (5.10.2) unstable; urgency=medium + + * Fix build with ghc 8.6.3. + Thanks, Robin Munn + * Bootstrap: Fix typo in Arch Linux dependencies. + Thanks, Robin Munn + * Bootstrap: Add haskell-type-errors package on Arch Linux. + Thanks, Robin Munn + * Apt.buildDepIn: Run build-dep command in a temporary directory, + since it may sometimes not clean up all the files it creates. + + -- Joey Hess Fri, 01 May 2020 16:47:31 -0400 + propellor (5.10.1) unstable; urgency=medium [ Joey Hess ] diff --git a/debian/changelog b/debian/changelog --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,16 @@ +propellor (5.10.2) unstable; urgency=medium + + * Fix build with ghc 8.6.3. + Thanks, Robin Munn + * Bootstrap: Fix typo in Arch Linux dependencies. + Thanks, Robin Munn + * Bootstrap: Add haskell-type-errors package on Arch Linux. + Thanks, Robin Munn + * Apt.buildDepIn: Run build-dep command in a temporary directory, + since it may sometimes not clean up all the files it creates. + + -- Joey Hess Fri, 01 May 2020 16:47:31 -0400 + propellor (5.10.1) unstable; urgency=medium [ Joey Hess ] diff --git a/joeyconfig.hs b/joeyconfig.hs --- a/joeyconfig.hs +++ b/joeyconfig.hs @@ -59,6 +59,7 @@ , peregrine , pell , keysafe + , quarantimer ] ++ monsters darkstar :: Host @@ -104,9 +105,7 @@ & User.hasPassword (User "root") & Ssh.hostKeys hostContext - [ (SshDsa, "ssh-dss AAAAB3NzaC1kc3MAAACBAI3WUq0RaigLlcUivgNG4sXpso2ORZkMvfqKz6zkc60L6dpxvWDNmZVEH8hEjxRSYG07NehcuOgQqeyFnS++xw1hdeGjf37JqCUH49i02lra3Zxv8oPpRxyeqe5MmuzUJhlWvBdlc3O/nqZ4bTUfnxMzSYWyy6++s/BpSHttZplNAAAAFQC1DE0vzgVeNAv9smHLObQWZFe2VQAAAIBECtpJry3GC8NVTFsTHDGWksluoFPIbKiZUFFztZGdM0AO2VwAbiJ6Au6M3VddGFANgTlni6d2/9yS919zO90TaFoIjywZeXhxE2CSuRfU7sx2hqDBk73jlycem/ER0sanFhzpHVpwmLfWneTXImWyq37vhAxatJANOtbj81vQ3AAAAIBV3lcyTT9xWg1Q4vERJbvyF8mCliwZmnIPa7ohveKkxlcgUk5d6dnaqFfjVaiXBPN3Qd08WXoQ/a9k3chBPT9nW2vWgzzM8l36j2MbHLmaxGwevAc9+vx4MXqvnGHzd2ex950mC33ct3j0fzMZlO6vqEsgD4CYmiASxhfefj+JCQ==") - , (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQDJybAjUPUWIhvVMmer8K5ZgdfI54DM6vc8Mzw+5KmVKL0TwkvzbR1HAB4heyMGtN1F8YzkWhsI3/Txh+MQUJ+i4u8SvSYc6D1q3j3ZyCi06wZ3DJS25tZrOM/thOOA1DFA4Hhb0uI/1Kg8PguNNNSMXn8F7q3F6cFQizYgszs6z6ktiST/BTC+IXWovhcnn2vQXXU8FTcTsqBFqA5dEjZbp1WDzqp3km84ZyXGmoVlpqzXeMvlkWTIshYiQjXIwPOkALzlGYjp1lw1OaxPVI1IGFcgCbIWQQWoCReb+genX2VaR+odAYXjaOdRx0lQj7UCPTBCpqMyzBMLtT5Yiaqh") - , (SshEcdsa, "ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBPhfvcOuw0Yt+MnsFc4TI2gWkKi62Eajxz+TgbHMO/uRTYF8c5V8fOI3o+J/3m5+lT0S5o8j8a7xIC3COvi+AVw=") + [ (SshEcdsa, "ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBPhfvcOuw0Yt+MnsFc4TI2gWkKi62Eajxz+TgbHMO/uRTYF8c5V8fOI3o+J/3m5+lT0S5o8j8a7xIC3COvi+AVw=") ] & Apt.unattendedUpgrades @@ -192,6 +191,9 @@ & Ssh.hostKeys hostContext [ (SshEd25519, "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIIS/hDYq1MAxfOBf49htym3BOYlx4Gk9SDpiHjv7u6IC") ] + & Ssh.userKeys (User "joey") hostContext + [ (SshEd25519, "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIAYgEgsDmN26goPBGPN0HIvtkZfxlc996nPfBPDWxGuh") + ] & JoeySites.house (User "joey") @@ -266,7 +268,7 @@ `requires` Ssh.knownHost hosts "usw-s002.rsync.net" (User "root") `requires` Ssh.userKeys (User "root") (Context "kite.kitenet.net") - [ (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQC5Gza2sNqSKfNtUN4dN/Z3rlqw18nijmXFx6df2GtBoZbkIak73uQfDuZLP+AXlyfHocwdkdHEf/zrxgXS4EokQMGLZhJ37Pr3edrEn/NEnqroiffw7kyd7EqaziA6UOezcLTjWGv+Zqg9JhitYs4WWTpNzrPH3yQf1V9FunZnkzb4gJGndts13wGmPEwSuf+QHbgQvjMOMCJwWSNcJGdhDR66hFlxfG26xx50uIczXYAbgLfHp5W6WuR/lcaS9J6i7HAPwcsPDA04XDinrcpl29QwsMW1HyGS/4FSCgrDqNZ2jzP49Bka78iCLRqfl1efyYas/Zo1jQ0x+pxq2RMr root@kite") + [ (SshEd25519, "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIKyciu8E8qspcO8lnTSUBAxUdYfmk7FaFlvT5yxUaP+0 root@kite") ] & alias "smtp.kitenet.net" @@ -328,6 +330,7 @@ & myDnsPrimary "olduse.net" [ (RelDomain "article", CNAME $ AbsDomain "virgil.koldfront.dk") ] + & myDnsPrimary "quarantimer.app" [] & alias "ns4.branchable.com" & branchableSecondary & Dns.secondaryFor ["animx"] hosts "animx.eu.org" @@ -460,6 +463,36 @@ , "&& rsync -a --delete --max-delete 3 ", backupdir , rsyncnetbackup ] +quarantimer :: Host +quarantimer = host "quarantimer.app" $ props + & ipv4 "45.33.73.207" + & Hostname.sane + & Hostname.mailname + & osDebian (Stable "buster") X86_64 + & Apt.stdSourcesList `onChange` Apt.upgrade + & Apt.unattendedUpgrades + & Cron.runPropellor (Cron.Times "30 * * * *") + & Apt.installed ["etckeeper", "sudo"] + & JoeySites.noExim + + & User.hasSomePassword (User "root") + & User.accountFor (User "joey") + & User.hasSomePassword (User "joey") + & Sudo.enabledFor (User "joey") + & Ssh.installed + & Ssh.randomHostKeys + & User "root" `Ssh.authorizedKeysFrom` (User "joey", darkstar) + & User "joey" `Ssh.authorizedKeysFrom` (User "joey", darkstar) + & Ssh.noPasswords + + & LetsEncrypt.letsEncrypt (LetsEncrypt.AgreeTOS (Just "id@joeyh.name")) + "quarantimer.app" "/home/joey/quarantimer/static" + & Apt.installed ["screen", "git", "ghc"] + & Apt.installed ["zlib1g-dev", "imagemagick"] + -- (Installing quarantimer not yet automated) + + + --' __|II| ,. ---- __|II|II|__ ( \_,/\ --'-------'\o/-'-.-'-.-'-.- __|II|II|II|II|___/ __/ -'-.-'-.-'-.-'-.-'-.-'- @@ -541,13 +574,6 @@ & Apt.unattendedUpgrades & Apt.cacheCleaned -myDnsSecondary :: Property (HasInfo + DebianLike) -myDnsSecondary = propertyList "dns secondary for all my domains" $ props - & Dns.secondary hosts "kitenet.net" - & Dns.secondary hosts "joeyh.name" - & Dns.secondary hosts "ikiwiki.info" - & Dns.secondary hosts "olduse.net" - branchableSecondary :: RevertableProperty (HasInfo + DebianLike) DebianLike branchableSecondary = Dns.secondaryFor ["branchable.com"] hosts "branchable.com" @@ -569,10 +595,6 @@ monsters = [ host "usw-s002.rsync.net" $ props & Ssh.hostPubKey SshEd25519 "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIB7yTEBGfQYdwG/oeL+U9XPMIh/dW7XNs9T+M79YIOrd" - , host "github.com" $ props - & Ssh.hostPubKey SshRsa "ssh-rsa AAAAB3NzaC1yc2EAAAABIwAAAQEAq2A7hRGmdnm9tUDbO9IDSwBK6TbQa+PXYPCPy6rbTrTtw7PHkccKrpp0yVhp5HdEIcKr6pLlVDBfOLX9QUsyCOV0wzfjIJNlGEYsdlLJizHhbn2mUjvSAHQqZETYP81eFzLQNnPHt4EVVUh7VfDESU84KezmD5QlWpXLmvU31/yMf+Se8xhHTvKSCZIFImWwoG6mbUoWf9nzpIoaSjB+weqqUUmpaaasXVal72J+UX2B+2RPW3RcT0eOzQgqlJL3RKrTJvdsjE3JEAvGq3lGHSZXy28G3skua2SmVi/w4yCE6gbODqnTWlg7+wC604ydGXA8VJiS5ap43JXiUFFAaQ==" - , host "gitlab.com" $ props - & Ssh.hostPubKey SshEcdsa "ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBFSMqzJeV9rUzU4kWitGjeR4PWSa29SPqJ1fVkhtj3Hw9xjLVXVYrU9QlYWrOLXBpQ6KWjbjTDTdDkoohFzgbEY=" , host "ns6.gandi.net" $ props & ipv4 "217.70.177.40" , host "animx" $ props diff --git a/propellor.cabal b/propellor.cabal --- a/propellor.cabal +++ b/propellor.cabal @@ -1,5 +1,5 @@ Name: propellor -Version: 5.10.1 +Version: 5.10.2 Cabal-Version: 1.20 License: BSD2 Maintainer: Joey Hess diff --git a/src/Propellor/Bootstrap.hs b/src/Propellor/Bootstrap.hs --- a/src/Propellor/Bootstrap.hs +++ b/src/Propellor/Bootstrap.hs @@ -200,7 +200,8 @@ , "haskell-exceptions" , "haskell-stm" , "haskell-text" - , "hashell-hashable" + , "haskell-hashable" + , "haskell-type-errors" ] archlinuxdeps Stack = [ "gnupg" diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs --- a/src/Propellor/Property/Apt.hs +++ b/src/Propellor/Property/Apt.hs @@ -16,6 +16,7 @@ import qualified Propellor.Property.Service as Service import Propellor.Property.File (Line) import Propellor.Types.Info +import Utility.SafeCommand data HostMirror = HostMirror Url deriving (Eq, Show, Typeable) @@ -308,11 +309,22 @@ -- in the specifed directory, with a dummy package also -- installed so that autoRemove won't remove them. buildDepIn :: FilePath -> Property DebianLike -buildDepIn dir = cmdPropertyEnv "sh" ["-c", cmd] noninteractiveEnv +buildDepIn dir = go `changesFile` dpkgStatus `requires` installedMin ["devscripts", "equivs"] where - cmd = "cd '" ++ dir ++ "' && mk-build-deps debian/control --install --tool 'apt-get -y --no-install-recommends' --remove" + -- mk-build-deps may leave files behind sometimes, eg on failure, + -- so run it in a temp directory, passing the path to the control + -- file + go :: UncheckedProperty DebianLike + go = unchecked $ property ("build-dep in " ++ dir) $ liftIO $ + withTmpDir "build-dep" $ \tmpdir -> do + cmdResult <$> boolSystem' "mk-build-deps" + [ File $ dir "debian" "control" + , Param "--install" + , Param "--tool" + , Param "apt-get -y --no-install-recommends" + ] (\p -> p { cwd = Just tmpdir }) -- | The name of a package, a glob to match the names of packages, or a regexp -- surrounded by slashes to match the names of packages. See diff --git a/src/Propellor/Property/Installer/Target.hs b/src/Propellor/Property/Installer/Target.hs --- a/src/Propellor/Property/Installer/Target.hs +++ b/src/Propellor/Property/Installer/Target.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE TypeOperators, RankNTypes, TypeFamilies, FlexibleContexts #-} -- | Installation to a target disk. -- diff --git a/src/Propellor/Property/Obnam.hs b/src/Propellor/Property/Obnam.hs --- a/src/Propellor/Property/Obnam.hs +++ b/src/Propellor/Property/Obnam.hs @@ -35,7 +35,7 @@ -- > & Obnam.backup "/srv/git" "33 3 * * *" -- > [ "--repository=sftp://2318@usw-s002.rsync.net/~/mygitrepos.obnam" -- > ] Obnam.OnlyClient --- > `requires` Ssh.keyImported SshRsa "root" (Context hostname) +-- > `requires` Ssh.keyImported SshEd25519 "root" (Context hostname) -- -- How awesome is that? -- diff --git a/src/Propellor/Property/SiteSpecific/Branchable.hs b/src/Propellor/Property/SiteSpecific/Branchable.hs --- a/src/Propellor/Property/SiteSpecific/Branchable.hs +++ b/src/Propellor/Property/SiteSpecific/Branchable.hs @@ -30,6 +30,8 @@ & Ssh.hostKeys (Context "branchable.com") [ (SshDsa, "ssh-dss AAAAB3NzaC1kc3MAAACBAK9HnfpyIm8aEhKuF5oz6KyaLwFs2oWeToVkqVuykyy5Y8jWDZPtkpv+1TeOnjcOvJSZ1cCqB8iXlsP9Dr5z98w5MfzsRQM2wIw0n+wvmpPmUhjVdGh+wTpfP9bcyFHhj/f1Ymdq9hEWB26bnf4pbTbJW2ip8ULshMvn5CQ/ugV3AAAAFQCAjpRd1fquRiIuLJMwej0VcyoZKQAAAIBe91Grvz/icL3nlqXYrifXyr9dsw8bPN+BMu+hQtFsQXNJBylxwf8FtbRlmvZXmRjdVYqFVyxSsrL2pMsWlds51iXOr9pdsPG5a4OgJyRHsveBz3tz6HgYYPcr3Oxp7C6G6wrzwsaGK862SgRp/bbD226k9dODRBy3ogMhk/MvAgAAAIEApfknql3vZbDVa88ZnwbNKDOv8L1hb6blbKAMt2vJbqJMvu3EP9CsP9hGyEQh5YCAl2F9KEU3bJXN1BG76b7CiYtWK95lpL1XmCCWnJBCcdEhw998GfJS424frPw7qGmXLxJKYxEyioB90/IDp2dC+WaLcLOYHM9SroCQTIK5A1g= root@pell") , (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAABIwAAAQEA1M0aNLgcgcgf0tkmt/8vCDZLok8Xixz7Nun9wB6NqVXxfzAR4te+zyO7FucVwyTY5QHmiwwpmyNfaC21AAILhXGm12SUKSAirF9BkQk7bhQuz4T/dPlEt3d3SxQ3OZlXtPp4LzXWOyS0OXSzIb+HeaDA+hFXlQnp/gE7RyAzR1+xhWPO7Mz1q5O/+4dXANnW32t6P7Puob6NsglVDpLrMRYjkO+0RgCVbYMzB5+UnkthkZsIINaYwsNhW2GKMKbRZeyp5en5t1NJprGXdw0BqdBqd/rcBpOxmhHE1U7rw+GS1uZwCFWWv0aZbaXEJ6wY7mETFkqs0QXi5jtoKn95Gw== root@pell") + , (SshEcdsa, "ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBLRRZ3Ew6eq6d8+ID1CXwF0hLjObNM2XwCIOFI4Wml2iP5NIHwtUCg2hlVUal6v1bO+VPjvx3dkf5Y00GI2BVSY= root@pell") + , (SshEd25519, "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIG5gaqToi0NtZH+vxXqW8E/reJW2tMHOEs2ycieMYkng root@pell") ] & Apt.installed ["procmail", "bsd-mailx"] @@ -60,7 +62,7 @@ , Borg.KeepYears 1 ] & Ssh.userKeys (User "root") (Context "branchable.com") - [ (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQC2PqTSupwncqeffNwZQXacdEWp7L+TxllIxH7WjfRMb3U74mQxWI0lwqLVW6Fox430DvhSqF1y5rJBvTHh4i49Tc9lZ7mwAxA6jNOP6bmdfteaKKYmUw5qwtJW0vISBFu28qBO11Nq3uJ1D3Oj6N+b3mM/0D3Y3NoGgF8+2dLdi81u9+l6AQ5Jsnozi2Ni/Osx2oVGZa+IQDO6gX8VEP4OrcJFNJe8qdnvItcGwoivhjbIfzaqNNvswKgGzhYLOAS5KT8HsjvIpYHWkyQ5QUX7W/lqGSbjP+6B8C3tkvm8VLXbmaD+aSkyCaYbuoXC2BoJdS7Jh8phKMwPJmdYVepn") + [ (SshEd25519, "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIC20PCLAgkD6tK0vYsl0Pdpho+y7fNay8Fo8SXWrZojs root@pell") ] & Ssh.knownHost hosts "usw-s002.rsync.net" (User "root") diff --git a/src/Propellor/Property/SiteSpecific/JoeySites.hs b/src/Propellor/Property/SiteSpecific/JoeySites.hs --- a/src/Propellor/Property/SiteSpecific/JoeySites.hs +++ b/src/Propellor/Property/SiteSpecific/JoeySites.hs @@ -150,7 +150,7 @@ `requires` Ssh.userKeyAt (Just keyfile) (User "root") (Context "olduse.net") - (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQD0F6L76SChMCIGmeyGhlFMUTgZ3BoTbATiOSs0A7KXQoI1LTE5ZtDzzUkrQRJVpJ640pfMR7cQZyBm8tv+kYIPp0238GrX43c1vgm0L78agDnBU7r2iNMyWIwhssK8O3ZAhp8Q4KCz1r8hP2nIiD0y1D1VWW8h4KWOS7I1XCEAjOTvFvEjTh6a9MyHrcIkv7teUUzTBRjNrsyijCFRk1+pEET54RueoOmEjQcWd/sK1tYRiMZjegRLBOus2wUWsUOvznJ2iniLONUTGAWRnEV+O7hLN6CD44osJ+wkZk8bPAumTS0zcSLckX1jpdHJicmAyeniWSd4FCqm1YE6/xDD") + (SshEd25519, "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIGtHhNuO/abNTrc5pyWkwXz/F8FAHw8VcET0Yh4mjgOk root@kite") `requires` Ssh.knownHost hosts "usw-s002.rsync.net" (User "root") borgrepo = rsyncNetBorgRepo "olduse.net.borg" [Borg.UseSshKey keyfile] keyfile = "/root/.ssh/olduse.net.key" @@ -198,7 +198,7 @@ `requires` Ssh.userKeyAt (Just sshkey) (User "root") (Context "git.kitenet.net") - (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQDLwUUkpkI9c2Wcnv/E4v9bJ7WcpiNkToltXfzRDd1F31AYrucfSMgzu3rtDpEL+wSnQLua/taJkWUWT/pyXOAh+90K6O/YeBZmY5CK01rYDz3kSTAtwHkMqednsRjdQS6NNJsuWc1reO8a4pKtsToJ3G9VAKufCkt2b8Nhqz0yLvLYwwU/mdI8DmfX6IgXhdy9njVEG/jsQnLFXY6QEfwKbIPs9O6qo4iFJg3defXX+zVMLsh3NE1P2i2VxMjxJEQdPdy9Z1sVpkiQM+mgJuylQQ5flPK8sxhO9r4uoK/JROkjPJNYoJMlsN+QlK04ABb7JV2JwhAL/Y8ypjQ13JdT") + (SshEd25519, "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIOvgBVYP6srImGbJ+kg1K68HeUQqxHEBQswMWSqu9WOu root@kite") `requires` Ssh.knownHost hosts "usw-s002.rsync.net" (User "root") & Ssh.authorizedKeys (User "family") (Context "git.kitenet.net") & User.accountFor (User "family") @@ -936,7 +936,7 @@ user (userGroup user) `requires` File.dirExists (takeDirectory sshkeyfile) `requires` Ssh.knownHost hosts "kitenet.net" user - & File.hasPrivContentExposed "/etc/darksky-forecast-url" anyContext + & File.hasPrivContentExposed "/etc/darksky-forecast-url" anyContext where d = "/home/joey/house" sshkeyfile = d ".ssh/key" @@ -1238,53 +1238,42 @@ [ "# let users power control startech hub with uhubctl" , "ATTR{idVendor}==\"" ++ hubvendor ++ "\", ATTR{idProduct}==\"005a\", MODE=\"0666\"" ] - & autoMountDrive "archive-10" (USBHubPort hubvendor 1) (Just "archive-oldest") - & autoMountDrive "archive-11" (USBHubPort hubvendor 2) (Just "archive-older") - & autoMountDrive "archive-12" (USBHubPort hubvendor 3) (Just "archive-old") - & autoMountDrive "archive-13" (USBHubPort hubvendor 4) (Just "archive") + & autoMountDrivePort "archive-10" (USBHubPort hubvendor hubloc 1) + (Just "archive-oldest") + & autoMountDrivePort "archive-11" (USBHubPort hubvendor hubloc 2) + (Just "archive-older") + & autoMountDrivePort "archive-12" (USBHubPort hubvendor hubloc 3) + (Just "archive-old") + & autoMountDrivePort "archive-13" (USBHubPort hubvendor hubloc 4) + (Just "archive") + & autoMountDrive "passport" Nothing & Apt.installed ["git-annex", "borgbackup"] where hubvendor = "0409" + hubloc = "4-1.6" -data USBHubPort = USBHubPort String Int +data USBHubPort = USBHubPort + { hubVendor :: String + , hubLocation :: String + , hubPort :: Int + } -- 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. -autoMountDrive :: Mount.Label -> USBHubPort -> Maybe FilePath -> Property DebianLike -autoMountDrive label (USBHubPort hubvendor port) malias = propertyList desc $ props - & File.ownerGroup mountpoint (User "joey") (Group "joey") - `requires` File.dirExists mountpoint - & case malias of - Just t -> ("/media/joey/" ++ t) `File.isSymlinkedTo` - File.LinkTarget mountpoint - Nothing -> doNothing doNothing - & File.hasContent ("/etc/systemd/system/" ++ mount) - [ "[Unit]" - , "Description=" ++ label - , "Requires=" ++ hub - , "After=" ++ hub - , "[Mount]" - -- avoid mounting whenever the block device is available, - -- only want to automount on demand - , "Options=noauto" - , "What=" ++ devfile - , "Where=" ++ mountpoint - , "[Install]" - , "WantedBy=" - ] - `onChange` Systemd.daemonReloaded +autoMountDrivePort :: Mount.Label -> USBHubPort -> Maybe FilePath -> Property DebianLike +autoMountDrivePort label hp malias = propertyList desc $ props & File.hasContent ("/etc/systemd/system/" ++ hub) [ "[Unit]" - , "Description=Startech usb hub port " ++ show port + , "Description=Startech usb hub port " ++ show (hubPort hp) , "PartOf=" ++ mount , "[Service]" , "Type=oneshot" , "RemainAfterExit=true" - , "ExecStart=/usr/sbin/uhubctl -a on -p " ++ show port ++ " --vendor " ++ hubvendor - , "ExecStop=/bin/sh -c 'uhubctl -a off -p " ++ show port ++ " --vendor " ++ hubvendor + , "ExecStart=/usr/sbin/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 -- be added back after the drive next spins up @@ -1297,6 +1286,50 @@ , "WantedBy=" ] `onChange` Systemd.daemonReloaded + & autoMountDrive' + [ "Requires=" ++ hub + , "After=" ++ hub + ] label malias + where + devfile = "/dev/disk/by-label/" ++ label + mountpoint = "/media/joey/" ++ label + desc = "auto mount with hub port power control " ++ mountpoint + hub = "startech-hub-port-" ++ show (hubPort hp) ++ ".service" + mount = svcbase ++ ".mount" + svcbase = Systemd.escapePath mountpoint + selecthubport = unwords + [ "-p", show (hubPort hp) + , "-n", hubVendor hp + , "-l", hubLocation hp + ] + +-- Makes a USB drive with the given label automount, and unmount after idle +-- for a while. +autoMountDrive :: Mount.Label -> Maybe FilePath -> Property DebianLike +autoMountDrive = autoMountDrive' [] + +autoMountDrive' :: [String] -> Mount.Label -> Maybe FilePath -> Property DebianLike +autoMountDrive' mountunitadd label malias = propertyList desc $ props + & File.ownerGroup mountpoint (User "joey") (Group "joey") + `requires` File.dirExists mountpoint + & case malias of + Just t -> ("/media/joey/" ++ t) `File.isSymlinkedTo` + File.LinkTarget mountpoint + Nothing -> doNothing doNothing + & File.hasContent ("/etc/systemd/system/" ++ mount) + ([ "[Unit]" + , "Description=" ++ label + ] ++ mountunitadd ++ + [ "[Mount]" + -- avoid mounting whenever the block device is available, + -- only want to automount on demand + , "Options=noauto" + , "What=" ++ devfile + , "Where=" ++ mountpoint + , "[Install]" + , "WantedBy=" + ]) + `onChange` Systemd.daemonReloaded & File.hasContent ("/etc/systemd/system/" ++ automount) [ "[Unit]" , "Description=Automount " ++ label @@ -1316,7 +1349,6 @@ devfile = "/dev/disk/by-label/" ++ label mountpoint = "/media/joey/" ++ label desc = "auto mount " ++ mountpoint - hub = "startech-hub-port-" ++ show port ++ ".service" automount = svcbase ++ ".automount" mount = svcbase ++ ".mount" svcbase = Systemd.escapePath mountpoint