summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJoey Hess2017-02-04 17:07:32 -0400
committerJoey Hess2017-02-04 17:07:32 -0400
commit8f37ddf53da31987f3db01d51fd9119d1e0c8a1d (patch)
tree786d557ab7d083137e1bf0a18a5eae1c5fd9d18d /src
parent5ff45a37b1ffde8fe9150815d81236354c89e20b (diff)
parent25f6871e1dda3de252fbc6c8ac6962eb0cd9311a (diff)
Merge remote-tracking branch 'wzhd/archlinux'
Diffstat (limited to 'src')
-rw-r--r--src/Propellor/Bootstrap.hs23
-rw-r--r--src/Propellor/Info.hs5
-rw-r--r--src/Propellor/Property/Debootstrap.hs1
-rw-r--r--src/Propellor/Property/DiskImage.hs10
-rw-r--r--src/Propellor/Property/Docker.hs5
-rw-r--r--src/Propellor/Property/OS.hs2
-rw-r--r--src/Propellor/Property/Pacman.hs68
-rw-r--r--src/Propellor/Property/Parted.hs7
-rw-r--r--src/Propellor/Property/Reboot.hs2
-rw-r--r--src/Propellor/Property/Rsync.hs9
-rw-r--r--src/Propellor/Property/SiteSpecific/JoeySites.hs2
-rw-r--r--src/Propellor/Property/User.hs2
-rw-r--r--src/Propellor/Types.hs1
-rw-r--r--src/Propellor/Types/MetaTypes.hs26
-rw-r--r--src/Propellor/Types/OS.hs3
15 files changed, 146 insertions, 20 deletions
diff --git a/src/Propellor/Bootstrap.hs b/src/Propellor/Bootstrap.hs
index 2c8fa95a..045e5256 100644
--- a/src/Propellor/Bootstrap.hs
+++ b/src/Propellor/Bootstrap.hs
@@ -60,6 +60,7 @@ depsCommand msys = "( " ++ intercalate " ; " (concat [osinstall, cabalinstall])
where
osinstall = case msys of
Just (System (FreeBSD _) _) -> map pkginstall fbsddeps
+ Just (System (ArchLinux) _) -> map pacmaninstall archlinuxdeps
Just (System (Debian _ _) _) -> useapt
Just (System (Buntish _) _) -> useapt
-- assume a debian derived system when not specified
@@ -74,6 +75,7 @@ depsCommand msys = "( " ++ intercalate " ; " (concat [osinstall, cabalinstall])
aptinstall p = "DEBIAN_FRONTEND=noninteractive apt-get -qq --no-upgrade --no-install-recommends -y install " ++ p
pkginstall p = "ASSUME_ALWAYS_YES=yes pkg install " ++ p
+ pacmaninstall p = "pacman -S --noconfirm --needed " ++ p
-- This is the same deps listed in debian/control.
debdeps =
@@ -112,6 +114,25 @@ depsCommand msys = "( " ++ intercalate " ; " (concat [osinstall, cabalinstall])
, "hs-text"
, "gmake"
]
+ archlinuxdeps =
+ [ "gnupg"
+ , "ghc"
+ , "cabal-install"
+ , "haskell-async"
+ , "haskell-missingh"
+ , "haskell-hslogger"
+ , "haskell-unix-compat"
+ , "haskell-ansi-terminal"
+ , "haskell-hackage-security"
+ , "haskell-ifelse"
+ , "haskell-network"
+ , "haskell-mtl"
+ , "haskell-transformers-base"
+ , "haskell-exceptions"
+ , "haskell-stm"
+ , "haskell-text"
+ , "make"
+ ]
installGitCommand :: Maybe System -> ShellCommand
installGitCommand msys = case msys of
@@ -121,6 +142,8 @@ installGitCommand msys = case msys of
[ "ASSUME_ALWAYS_YES=yes pkg update"
, "ASSUME_ALWAYS_YES=yes pkg install git"
]
+ (Just (System (ArchLinux) _)) -> use
+ [ "pacman -S --noconfirm --needed git"]
-- assume a debian derived system when not specified
Nothing -> use apt
where
diff --git a/src/Propellor/Info.hs b/src/Propellor/Info.hs
index 3d7f07a5..49ca689f 100644
--- a/src/Propellor/Info.hs
+++ b/src/Propellor/Info.hs
@@ -3,6 +3,7 @@
module Propellor.Info (
osDebian,
osBuntish,
+ osArchLinux,
osFreeBSD,
setInfoProperty,
addInfoProperty,
@@ -106,6 +107,10 @@ osBuntish release arch = tightenTargets $ os (System (Buntish release) arch)
osFreeBSD :: FreeBSDRelease -> Architecture -> Property (HasInfo + FreeBSD)
osFreeBSD release arch = tightenTargets $ os (System (FreeBSD release) arch)
+-- | Specifies that a host's operating system is Arch Linux
+osArchLinux :: Architecture -> Property (HasInfo + ArchLinux)
+osArchLinux arch = tightenTargets $ os (System (ArchLinux) arch)
+
os :: System -> Property (HasInfo + UnixLike)
os system = pureInfoProperty ("Operating " ++ show system) (InfoVal system)
diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs
index db114e01..e21bcdff 100644
--- a/src/Propellor/Property/Debootstrap.hs
+++ b/src/Propellor/Property/Debootstrap.hs
@@ -96,6 +96,7 @@ built' installprop target system@(System _ arch) config =
extractSuite :: System -> Maybe String
extractSuite (System (Debian _ s) _) = Just $ Apt.showSuite s
extractSuite (System (Buntish r) _) = Just r
+extractSuite (System (ArchLinux) _) = Nothing
extractSuite (System (FreeBSD _) _) = Nothing
-- | Ensures debootstrap is installed.
diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs
index 06dfa69c..c828211b 100644
--- a/src/Propellor/Property/DiskImage.hs
+++ b/src/Propellor/Property/DiskImage.hs
@@ -81,16 +81,16 @@ type DiskImage = FilePath
-- chroot while the disk image is being built, which should prevent any
-- daemons that are included from being started on the system that is
-- building the disk image.
-imageBuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty (HasInfo + Linux) Linux
+imageBuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty (HasInfo + DebianLike) Linux
imageBuilt = imageBuilt' False
-- | Like 'built', but the chroot is deleted and rebuilt from scratch each
-- time. This is more expensive, but useful to ensure reproducible results
-- when the properties of the chroot have been changed.
-imageRebuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty (HasInfo + Linux) Linux
+imageRebuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty (HasInfo + DebianLike) Linux
imageRebuilt = imageBuilt' True
-imageBuilt' :: Bool -> DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty (HasInfo + Linux) Linux
+imageBuilt' :: Bool -> DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty (HasInfo + DebianLike) Linux
imageBuilt' rebuild img mkchroot tabletype final partspec =
imageBuiltFrom img chrootdir tabletype final partspec
`requires` Chroot.provisioned chroot
@@ -124,7 +124,7 @@ cachesCleaned = "cache cleaned" ==> (Apt.cacheCleaned `pickOS` skipit)
skipit = doNothing :: Property UnixLike
-- | Builds a disk image from the contents of a chroot.
-imageBuiltFrom :: DiskImage -> FilePath -> TableType -> Finalization -> [PartSpec] -> RevertableProperty (HasInfo + Linux) UnixLike
+imageBuiltFrom :: DiskImage -> FilePath -> TableType -> Finalization -> [PartSpec] -> RevertableProperty (HasInfo + DebianLike) UnixLike
imageBuiltFrom img chrootdir tabletype final partspec = mkimg <!> rmimg
where
desc = img ++ " built from " ++ chrootdir
@@ -150,7 +150,7 @@ imageBuiltFrom img chrootdir tabletype final partspec = mkimg <!> rmimg
imageFinalized final mnts mntopts devs parttable
rmimg = File.notPresent img
-partitionsPopulated :: FilePath -> [Maybe MountPoint] -> [MountOpts] -> [LoopDev] -> Property Linux
+partitionsPopulated :: FilePath -> [Maybe MountPoint] -> [MountOpts] -> [LoopDev] -> Property DebianLike
partitionsPopulated chrootdir mnts mntopts devs = property' desc $ \w ->
mconcat $ zipWith3 (go w) mnts mntopts devs
where
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index 2ef97438..0bfcc781 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -55,6 +55,7 @@ import Propellor.Container
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Cmd as Cmd
+import qualified Propellor.Property.Pacman as Pacman
import qualified Propellor.Shim as Shim
import Utility.Path
import Utility.ThreadScheduler
@@ -68,8 +69,8 @@ import Data.List.Utils
import qualified Data.Map as M
import System.Console.Concurrent
-installed :: Property DebianLike
-installed = Apt.installed ["docker.io"]
+installed :: Property (DebianLike + ArchLinux)
+installed = Apt.installed ["docker.io"] `pickOS` Pacman.installed ["docker"]
-- | Configures docker with an authentication file, so that images can be
-- pushed to index.docker.io. Optional.
diff --git a/src/Propellor/Property/OS.hs b/src/Propellor/Property/OS.hs
index d974cfbc..10d7afc0 100644
--- a/src/Propellor/Property/OS.hs
+++ b/src/Propellor/Property/OS.hs
@@ -64,7 +64,7 @@ import Control.Exception (throw)
-- > & User.accountFor "joey"
-- > & User.hasSomePassword "joey"
-- > -- rest of system properties here
-cleanInstallOnce :: Confirmation -> Property Linux
+cleanInstallOnce :: Confirmation -> Property DebianLike
cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $
go `requires` confirmed "clean install confirmed" confirmation
where
diff --git a/src/Propellor/Property/Pacman.hs b/src/Propellor/Property/Pacman.hs
new file mode 100644
index 00000000..60ed4bea
--- /dev/null
+++ b/src/Propellor/Property/Pacman.hs
@@ -0,0 +1,68 @@
+-- | Maintainer: Zihao Wang <dev@wzhd.org>
+--
+-- Support for the Pacman package manager <https://www.archlinux.org/pacman/>
+
+module Propellor.Property.Pacman where
+
+import Propellor.Base
+
+runPacman :: [String] -> UncheckedProperty ArchLinux
+runPacman ps = tightenTargets $ cmdProperty "pacman" ps
+
+-- | Have pacman update its lists of packages, but without upgrading anything.
+update :: Property ArchLinux
+update = combineProperties ("pacman update") $ props
+ & runPacman ["-Sy", "--noconfirm"]
+ `assume` MadeChange
+
+upgrade :: Property ArchLinux
+upgrade = combineProperties ("pacman upgrade") $ props
+ & runPacman ["-Syu", "--noconfirm"]
+ `assume` MadeChange
+
+type Package = String
+
+installed :: [Package] -> Property ArchLinux
+installed = installed' ["--noconfirm"]
+
+installed' :: [String] -> [Package] -> Property ArchLinux
+installed' params ps = check (not <$> isInstalled' ps) go
+ `describe` unwords ("pacman installed":ps)
+ where
+ go = runPacman (params ++ ["-S"] ++ ps)
+
+removed :: [Package] -> Property ArchLinux
+removed ps = check (any (== IsInstalled) <$> getInstallStatus ps)
+ (runPacman (["-R", "--noconfirm"] ++ ps))
+ `describe` unwords ("pacman removed":ps)
+
+isInstalled :: Package -> IO Bool
+isInstalled p = isInstalled' [p]
+
+isInstalled' :: [Package] -> IO Bool
+isInstalled' ps = all (== IsInstalled) <$> getInstallStatus ps
+
+data InstallStatus = IsInstalled | NotInstalled
+ deriving (Show, Eq)
+
+{- Returns the InstallStatus of packages that are installed
+ - or known and not installed. If a package is not known at all to apt
+ - or dpkg, it is not included in the list. -}
+getInstallStatus :: [Package] -> IO [InstallStatus]
+getInstallStatus ps = mapMaybe id <$> mapM status ps
+ where
+ status :: Package -> IO (Maybe InstallStatus)
+ status p = do
+ ifM (succeeds "pacman" ["-Q", p])
+ (return (Just IsInstalled),
+ ifM (succeeds "pacman" ["-Sp", p])
+ (return (Just NotInstalled),
+ return Nothing))
+
+succeeds :: String -> [String] -> IO Bool
+succeeds cmd args = (quietProcess >> return True)
+ `catchIO` (\_ -> return False)
+ where
+ quietProcess :: IO ()
+ quietProcess = withQuietOutput createProcessSuccess p
+ p = (proc cmd args)
diff --git a/src/Propellor/Property/Parted.hs b/src/Propellor/Property/Parted.hs
index bc8a256d..40af3357 100644
--- a/src/Propellor/Property/Parted.hs
+++ b/src/Propellor/Property/Parted.hs
@@ -23,6 +23,7 @@ module Propellor.Property.Parted (
import Propellor.Base
import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.Pacman as Pacman
import qualified Propellor.Property.Partition as Partition
import Utility.DataUnits
import Data.Char
@@ -192,12 +193,12 @@ partitioned eep disk (PartTable tabletype parts) = property' desc $ \w -> do
--
-- Parted is run in script mode, so it will never prompt for input.
-- It is asked to use cylinder alignment for the disk.
-parted :: Eep -> FilePath -> [String] -> Property DebianLike
+parted :: Eep -> FilePath -> [String] -> Property (DebianLike + ArchLinux)
parted YesReallyDeleteDiskContents disk ps = p `requires` installed
where
p = cmdProperty "parted" ("--script":"--align":"cylinder":disk:ps)
`assume` MadeChange
-- | Gets parted installed.
-installed :: Property DebianLike
-installed = Apt.installed ["parted"]
+installed :: Property (DebianLike + ArchLinux)
+installed = Apt.installed ["parted"] `pickOS` Pacman.installed ["parted"]
diff --git a/src/Propellor/Property/Reboot.hs b/src/Propellor/Property/Reboot.hs
index 31731dc2..3781cd7b 100644
--- a/src/Propellor/Property/Reboot.hs
+++ b/src/Propellor/Property/Reboot.hs
@@ -59,7 +59,7 @@ atEnd force resultok = property "scheduled reboot at end of propellor run" $ do
-- See 'Propellor.Property.HostingProvider.DigitalOcean'
-- for an example of how to do this.
toDistroKernel :: Property DebianLike
-toDistroKernel = check (not <$> runningInstalledKernel) now
+toDistroKernel = tightenTargets $ check (not <$> runningInstalledKernel) now
`describe` "running installed kernel"
-- | Given a kernel version string @v@, reboots immediately if the running
diff --git a/src/Propellor/Property/Rsync.hs b/src/Propellor/Property/Rsync.hs
index b40396de..53baa74e 100644
--- a/src/Propellor/Property/Rsync.hs
+++ b/src/Propellor/Property/Rsync.hs
@@ -2,6 +2,7 @@ module Propellor.Property.Rsync where
import Propellor.Base
import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.Pacman as Pacman
type Src = FilePath
type Dest = FilePath
@@ -16,7 +17,7 @@ filesUnder d = Pattern (d ++ "/*")
-- | Ensures that the Dest directory exists and has identical contents as
-- the Src directory.
-syncDir :: Src -> Dest -> Property DebianLike
+syncDir :: Src -> Dest -> Property (DebianLike + ArchLinux)
syncDir = syncDirFiltered []
data Filter
@@ -43,7 +44,7 @@ newtype Pattern = Pattern String
-- Rsync checks each name to be transferred against its list of Filter
-- rules, and the first matching one is acted on. If no matching rule
-- is found, the file is processed.
-syncDirFiltered :: [Filter] -> Src -> Dest -> Property DebianLike
+syncDirFiltered :: [Filter] -> Src -> Dest -> Property (DebianLike + ArchLinux)
syncDirFiltered filters src dest = rsync $
[ "-av"
-- Add trailing '/' to get rsync to sync the Dest directory,
@@ -56,7 +57,7 @@ syncDirFiltered filters src dest = rsync $
, "--quiet"
] ++ map toRsync filters
-rsync :: [String] -> Property DebianLike
+rsync :: [String] -> Property (DebianLike + ArchLinux)
rsync ps = cmdProperty "rsync" ps
`assume` MadeChange
- `requires` Apt.installed ["rsync"]
+ `requires` Apt.installed ["rsync"] `pickOS` Pacman.installed ["rsync"]
diff --git a/src/Propellor/Property/SiteSpecific/JoeySites.hs b/src/Propellor/Property/SiteSpecific/JoeySites.hs
index 4f8b48af..445bce07 100644
--- a/src/Propellor/Property/SiteSpecific/JoeySites.hs
+++ b/src/Propellor/Property/SiteSpecific/JoeySites.hs
@@ -892,7 +892,7 @@ userDirHtml = File.fileProperty "apache userdir is html" (map munge) conf
-- <http://joeyh.name/blog/entry/a_programmable_alarm_clock_using_systemd/>
--
-- oncalendar example value: "*-*-* 7:30"
-alarmClock :: String -> User -> String -> Property DebianLike
+alarmClock :: String -> User -> String -> Property Linux
alarmClock oncalendar (User user) command = combineProperties "goodmorning timer installed" $ props
& "/etc/systemd/system/goodmorning.timer" `File.hasContent`
[ "[Unit]"
diff --git a/src/Propellor/Property/User.hs b/src/Propellor/Property/User.hs
index 76eae647..0c7e48f2 100644
--- a/src/Propellor/Property/User.hs
+++ b/src/Propellor/Property/User.hs
@@ -43,7 +43,7 @@ systemAccountFor' (User u) mhome mgroup = tightenTargets $ check nouser go
]
-- | Removes user home directory!! Use with caution.
-nuked :: User -> Eep -> Property DebianLike
+nuked :: User -> Eep -> Property Linux
nuked user@(User u) _ = tightenTargets $ check hashomedir go
`describe` ("nuked user " ++ u)
where
diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
index 6d6b14ea..23066c18 100644
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -24,6 +24,7 @@ module Propellor.Types (
, DebianLike
, Debian
, Buntish
+ , ArchLinux
, FreeBSD
, HasInfo
, type (+)
diff --git a/src/Propellor/Types/MetaTypes.hs b/src/Propellor/Types/MetaTypes.hs
index e064d76f..2b347185 100644
--- a/src/Propellor/Types/MetaTypes.hs
+++ b/src/Propellor/Types/MetaTypes.hs
@@ -7,6 +7,7 @@ module Propellor.Types.MetaTypes (
DebianLike,
Debian,
Buntish,
+ ArchLinux,
FreeBSD,
HasInfo,
MetaTypes,
@@ -35,14 +36,24 @@ data MetaType
deriving (Show, Eq, Ord)
-- | Any unix-like system
-type UnixLike = MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish, 'Targeting 'OSFreeBSD ]
+type UnixLike = MetaTypes '[ 'Targeting 'OSDebian
+ , 'Targeting 'OSBuntish
+ , 'Targeting 'OSArchLinux
+ , 'Targeting 'OSFreeBSD
+ ]
+
-- | Any linux system
-type Linux = MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish ]
+type Linux = MetaTypes '[ 'Targeting 'OSDebian
+ , 'Targeting 'OSBuntish
+ , 'Targeting 'OSArchLinux
+ ]
+
-- | Debian and derivatives.
type DebianLike = MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish ]
type Debian = MetaTypes '[ 'Targeting 'OSDebian ]
type Buntish = MetaTypes '[ 'Targeting 'OSBuntish ]
type FreeBSD = MetaTypes '[ 'Targeting 'OSFreeBSD ]
+type ArchLinux = MetaTypes '[ 'Targeting 'OSArchLinux ]
-- | Used to indicate that a Property adds Info to the Host where it's used.
type HasInfo = MetaTypes '[ 'WithInfo ]
@@ -58,16 +69,19 @@ data instance Sing (x :: MetaType) where
OSDebianS :: Sing ('Targeting 'OSDebian)
OSBuntishS :: Sing ('Targeting 'OSBuntish)
OSFreeBSDS :: Sing ('Targeting 'OSFreeBSD)
+ OSArchLinuxS :: Sing ('Targeting 'OSArchLinux)
WithInfoS :: Sing 'WithInfo
instance SingI ('Targeting 'OSDebian) where sing = OSDebianS
instance SingI ('Targeting 'OSBuntish) where sing = OSBuntishS
instance SingI ('Targeting 'OSFreeBSD) where sing = OSFreeBSDS
+instance SingI ('Targeting 'OSArchLinux) where sing = OSArchLinuxS
instance SingI 'WithInfo where sing = WithInfoS
instance SingKind ('KProxy :: KProxy MetaType) where
type DemoteRep ('KProxy :: KProxy MetaType) = MetaType
fromSing OSDebianS = Targeting OSDebian
fromSing OSBuntishS = Targeting OSBuntish
fromSing OSFreeBSDS = Targeting OSFreeBSD
+ fromSing OSArchLinuxS = Targeting OSArchLinux
fromSing WithInfoS = WithInfo
-- | Convenience type operator to combine two `MetaTypes` lists.
@@ -186,6 +200,14 @@ type instance EqT 'OSBuntish 'OSDebian = 'False
type instance EqT 'OSBuntish 'OSFreeBSD = 'False
type instance EqT 'OSFreeBSD 'OSDebian = 'False
type instance EqT 'OSFreeBSD 'OSBuntish = 'False
+type instance EqT 'OSArchLinux 'OSArchLinux = 'True
+type instance EqT 'OSArchLinux 'OSDebian = 'False
+type instance EqT 'OSArchLinux 'OSBuntish = 'False
+type instance EqT 'OSArchLinux 'OSFreeBSD = 'False
+type instance EqT 'OSDebian 'OSArchLinux = 'False
+type instance EqT 'OSBuntish 'OSArchLinux = 'False
+type instance EqT 'OSFreeBSD 'OSArchLinux = 'False
+
-- More modern version if the combinatiorial explosion gets too bad later:
--
-- type family Eq (a :: MetaType) (b :: MetaType) where
diff --git a/src/Propellor/Types/OS.hs b/src/Propellor/Types/OS.hs
index 43371af1..696c36b0 100644
--- a/src/Propellor/Types/OS.hs
+++ b/src/Propellor/Types/OS.hs
@@ -33,6 +33,7 @@ data System = System Distribution Architecture
data Distribution
= Debian DebianKernel DebianSuite
| Buntish Release -- ^ A well-known Debian derivative founded by a space tourist. The actual name of this distribution is not used in Propellor per <http://joeyh.name/blog/entry/trademark_nonsense/>
+ | ArchLinux
| FreeBSD FreeBSDRelease
deriving (Show, Eq)
@@ -41,12 +42,14 @@ data Distribution
data TargetOS
= OSDebian
| OSBuntish
+ | OSArchLinux
| OSFreeBSD
deriving (Show, Eq, Ord)
systemToTargetOS :: System -> TargetOS
systemToTargetOS (System (Debian _ _) _) = OSDebian
systemToTargetOS (System (Buntish _) _) = OSBuntish
+systemToTargetOS (System (ArchLinux) _) = OSArchLinux
systemToTargetOS (System (FreeBSD _) _) = OSFreeBSD
-- | Most of Debian ports are based on Linux. There also exist hurd-i386,