hasufell/ghcup-hs
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Use os-release package

Browse Source
This commit is contained in:
Julian Ospald 2020-07-04 23:28:30 +02:00
parent 3ddc719d8a
commit 9717a1c00f
No known key found for this signature in database
GPG Key ID: 511B62C09D50CD28
39 changed files with 1168 additions and 168 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
3rdparty/os-release/.gitattributes vendored Normal file
View File

@ -0,0 +1 @@
*.golden -text

1
3rdparty/os-release/.gitignore vendored Normal file
View File

@ -0,0 +1 @@
dist-newstyle/

16
3rdparty/os-release/ChangeLog.rst vendored Normal file
View File

@ -0,0 +1,16 @@
1.0.0
=====
- Redo of the entire API
0.2.2
=====
- Fixes builds failing just due to -Werror
- README.rst and ChangeLog.rst are distributed with cabal package
0.2.1
=====
- Initial release

26
3rdparty/os-release/LICENSE vendored Normal file
View File

@ -0,0 +1,26 @@
Copyright (c) 2014, Jan Matejka <yac@blesmrt.net>
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
1. Redistributions of source code must retain the above copyright notice,
this list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.
3. Neither the name of the cbugzilla nor the names of its
contributors may be used to endorse or promote products derived from
this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
POSSIBILITY OF SUCH DAMAGE.

17
3rdparty/os-release/README.rst vendored Normal file
View File

@ -0,0 +1,17 @@
##########
os-release
##########
http://www.freedesktop.org/software/systemd/man/os-release.html
Usage
#####
.. code-block:: haskell
import System.OsRelease
main = readOs >>= print
.. code-block::
Right (fromList [(OsReleaseKey "ANSI_COLOR",OsReleaseValue "1;32"),(OsReleaseKey "BUG_REPORT_URL",OsReleaseValue "https://bugs.gentoo.org/"),(OsReleaseKey "HOME_URL",OsReleaseValue "http://www.gentoo.org/"),(OsReleaseKey "ID",OsReleaseValue "gentoo"),(OsReleaseKey "NAME",OsReleaseValue "Gentoo"),(OsReleaseKey "PRETTY_NAME",OsReleaseValue "Gentoo/Linux"),(OsReleaseKey "SUPPORT_URL",OsReleaseValue "http://www.gentoo.org/main/en/support.xml")])

2
3rdparty/os-release/Setup.hs vendored Normal file
View File

@ -0,0 +1,2 @@
import Distribution.Simple
main = defaultMain

192
3rdparty/os-release/library/System/OsRelease.hs vendored Normal file
View File

@ -0,0 +1,192 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeOperators #-}
-- | A module to retrieve os-release information according to the
-- freedesktop standard:
-- https://www.freedesktop.org/software/systemd/man/os-release.html
--
-- Usage example:
--
-- @
-- do
-- Just (OsRelease {..}) <- fmap osRelease <$\> parseOsRelease
-- putStrLn name
-- @
module System.OsRelease
(
-- * data types
OsReleaseResult(..)
, OsRelease(..)
-- * read/parse os-release
, parseOsRelease
, readOsRelease
-- * defaults
, defaultOsRelease
, defaultAssignments
-- * low-level
, parseAssignments
, parseAssignment
, getAllAssignments
, getOsRelease
, parseOsRelease'
)
where
import System.OsRelease.Megaparsec
import Control.Applicative
import Control.Monad
import Control.Exception.Safe
import Data.Aeson
import Data.Aeson.TH
import Data.Char
import Data.Either
import Data.List
import Data.Maybe
import Data.Void
import GHC.Generics
import Prelude hiding ( id
)
import qualified Data.HashMap.Strict as HM
import qualified Data.Text as T
import qualified Text.Megaparsec as MP
data OsReleaseResult = OsReleaseResult {
osRelease :: !OsRelease
, unknown_fields :: [(String, String)]
, parse_errors :: [MP.ParseError String Void]
} deriving (Show)
-- | All the explicitly documented fields of @os-release@.
data OsRelease = OsRelease {
name :: !(String)
, version :: !(Maybe String)
, id :: !(String)
, id_like :: !(Maybe String)
, version_codename :: !(Maybe String)
, version_id :: !(Maybe String)
, pretty_name :: !(String)
, ansi_color :: !(Maybe String)
, cpe_name :: !(Maybe String)
, home_url :: !(Maybe String)
, documentation_url :: !(Maybe String)
, support_url :: !(Maybe String)
, bug_report_url :: !(Maybe String)
, privacy_policy_url :: !(Maybe String)
, build_id :: !(Maybe String)
, variant :: !(Maybe String)
, variant_id :: !(Maybe String)
, logo :: !(Maybe String)
} deriving (Generic, Show)
class GetRecords a where
getRecords :: a -> [String]
instance {-# OVERLAPPABLE #-} GetRecords (f p) => GetRecords (M1 i c f p) where
getRecords (M1 x) = getRecords x
instance {-# OVERLAPPING #-} Selector c => GetRecords (M1 S c f p) where
getRecords x = [selName x]
instance (GetRecords (a p), GetRecords (b p)) => GetRecords ((a :*: b) p) where
getRecords (a :*: b) = getRecords a ++ getRecords b
-- | The defaults as per the spec:
--
-- @
-- NAME=Linux
-- ID=linux
-- PRETTY_NAME=Linux
-- @
defaultOsRelease :: OsRelease
defaultOsRelease = OsRelease { name = "Linux"
, version = Nothing
, id = "linux"
, id_like = Nothing
, version_codename = Nothing
, version_id = Nothing
, pretty_name = "Linux"
, ansi_color = Nothing
, cpe_name = Nothing
, home_url = Nothing
, documentation_url = Nothing
, support_url = Nothing
, bug_report_url = Nothing
, privacy_policy_url = Nothing
, build_id = Nothing
, variant = Nothing
, variant_id = Nothing
, logo = Nothing
}
-- | Like `defaultOsRelease`, except as key-value pair.
defaultAssignments :: [(String, String)]
defaultAssignments =
[("NAME", "Linux"), ("ID", "linux"), ("PRETTY_NAME", "Linux")]
-- | Get all allAssignments as @(key, val)@ from the @os-release@
-- file contents.
getAllAssignments :: String -- ^ file contents of os-release
-> [Either (MP.ParseError String Void) (String, String)]
getAllAssignments = fromRight [] . MP.parse parseAssignments "os-release"
-- | Parse the assignments into `OsRelease`. This is merged with the
-- defaults as per the spec. In case of no assignments, also returns
-- the defaults.
getOsRelease :: [(String, String)] -- ^ assignments
-> OsRelease
getOsRelease =
(\case
Error _ -> defaultOsRelease
Success v -> v
)
. fromJSON
. Object
. (\x -> HM.union x (HM.fromList . aesonify $ defaultAssignments))
. HM.fromList
. aesonify
where
aesonify = fmap (\(k, v) -> (T.toLower . T.pack $ k, String . T.pack $ v))
-- | Tries to read @\"\/etc\/os-release\"@ and @\"\/usr\/lib\/os_release\"@ in order.
--
-- Throws @IOError@ if both files could not be read.
readOsRelease :: IO String
readOsRelease = readFile "/etc/os-release" <|> readFile "/usr/lib/os-release"
-- | Tries to read @\"\/etc\/os-release\"@ and @\"\/usr\/lib\/os_release\"@ in order
-- and parses into `OsReleaseResult`. Returns @Nothing@ if both files could
-- not be read.
parseOsRelease :: IO (Maybe OsReleaseResult)
parseOsRelease =
handleIO (\_ -> pure Nothing) . fmap (Just . parseOsRelease') $ readOsRelease
-- | Like `parseOsRelease`, except taking the input String explicitly.
-- Primarily for tests.
parseOsRelease' :: String -> OsReleaseResult
parseOsRelease' s =
let (errs, ass) = partitionEithers . getAllAssignments $ s
osr = getOsRelease ass
unknown_fields' =
HM.toList
. foldr (\x y -> HM.delete (fmap toUpper x) y) (HM.fromList ass)
$ (init . getRecords . from $ defaultOsRelease)
in OsReleaseResult osr unknown_fields' errs
deriveJSON defaultOptions ''OsRelease

102
3rdparty/os-release/library/System/OsRelease/Megaparsec.hs vendored Normal file
View File

@ -0,0 +1,102 @@
{-# LANGUAGE CPP #-}
module System.OsRelease.Megaparsec where
import Control.Applicative
import Control.Monad
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
import Data.Char
import Data.Functor
import Data.Void
import qualified Text.Megaparsec as MP
import qualified Text.Megaparsec.Char as MP
-- | Parse the entire file, handling newlines and comments gracefully.
--
-- This parser generally shouldn't fail, but instead report a failed
-- parsed line as @Left@ value.
parseAssignments :: MP.Parsec
Void
String
[Either (MP.ParseError String Void) (String, String)]
parseAssignments =
(\xs x -> join xs ++ x) <$> many (line MP.eol) <*> line MP.eof
where
line eol = choice'
[ comment $> []
, blank $> []
, fmap
(: [])
( MP.withRecovery (\e -> parseUntil eol $> Left e)
. fmap Right
$ (parseAssignment <* eol)
)
]
where
comment = pWs *> MP.char '#' *> parseUntil eol *> eol
blank = pWs *> eol
-- | Parse a single line assignment and extract the right hand side.
-- This is only a subset of a shell parser, refer to the spec for
-- details.
parseAssignment :: MP.Parsec Void String (String, String)
parseAssignment =
(,) <$> (pWs *> key) <*> (MP.char '=' *> (MP.try qval <|> mempty) <* pWs)
where
dropSpace :: String -> String
dropSpace = reverse . dropWhile (\x -> x == ' ' || x == '\t') . reverse
key :: MP.Parsec Void String String
key = some (MP.try MP.alphaNumChar <|> MP.char '_')
qval :: MP.Parsec Void String String
qval = do
c <- MP.lookAhead MP.printChar
case c of
' ' -> pure ""
'"' -> MP.char c *> val c <* MP.char c
'\'' -> MP.char c *> val c <* MP.char c
-- no quote, have to drop trailing spaces
_ -> fmap
dropSpace
(some $ MP.satisfy (\x -> isAlphaNum x || (x `elem` ['_', '-', '.']))) -- this is more lax than the spec
val :: Char -> MP.Parsec Void String String
val !q = many (qspecial q <|> MP.noneOf (specials q)) -- noneOf may be too lax
qspecial :: Char -> MP.Parsec Void String Char
qspecial !q =
fmap (!! 1)
. (\xs -> choice' xs)
. fmap (\s -> MP.try . MP.chunk $ ['\\', s])
$ (specials q)
specials :: Char -> [Char]
specials !q = [q, '\\', '$', '`']
parseUntil :: MP.Parsec Void String a -> MP.Parsec Void String String
parseUntil !p = do
(MP.try (MP.lookAhead p) $> [])
<|> (do
c <- MP.anySingle
c2 <- parseUntil p
pure ([c] `mappend` c2)
)
-- | Parse one or more white spaces or tabs.
pWs :: MP.Parsec Void String ()
pWs = many (MP.satisfy (\x -> x == ' ' || x == '\t')) $> ()
-- | Try all parses in order, failing if all failed. Also fails
-- on empty list.
choice' :: (MonadFail f, MP.MonadParsec e s f) => [f a] -> f a
choice' = \case
[] -> fail "Empty list"
xs -> foldr1 (\x y -> MP.try x <|> MP.try y) xs

131
3rdparty/os-release/os-release.cabal vendored Normal file
View File

@ -0,0 +1,131 @@
cabal-version: 3.0
author: Jan Matějka
category: System
license-file: LICENSE
build-type: Simple
copyright: 2014 Jan Matějka <yac@blesmrt.net>
license: BSD-3-Clause
maintainer: Julian Ospald <hasufell@posteo.de>
homepage: https://github.com/yaccz/os-release
name: os-release
synopsis: /etc/os-release helpers
version: 1.0.0
description:
\/etc\/os-release helpers as per the freedesktop spec: https://www.freedesktop.org/software/systemd/man/os-release.html
extra-doc-files:
ChangeLog.rst
README.rst
extra-source-files: tests/Golden/data/*.golden tests/Golden/data/*.in
flag devel
description: Enables -Werror
default: False
manual: True
source-repository head
type: git
location: https://github.com/yaccz/os-release.git
common base
build-depends: base >=4.11 && <5
common bytestring
build-depends: bytestring
common aeson
build-depends: aeson >=1.4
common filepath
build-depends: filepath >=1.4.2.1
common hspec
build-depends: hspec >=2.7.1
common hspec-megaparsec
build-depends: hspec-megaparsec >=2.1.0
common megaparsec
build-depends: megaparsec >=8.0.0
common pretty-simple
build-depends: pretty-simple >=1.0.0.0
common safe-exceptions
build-depends: safe-exceptions >=0.1.7.0
common tasty
build-depends: tasty >=1.3
common tasty-golden
build-depends: tasty-golden >=2.3.4
common tasty-hspec
build-depends: tasty-hspec >=1.1.5.1
common text
build-depends: text >=1.2
common unordered-containers
build-depends: unordered-containers >=0.2.10.0
common config
default-language: Haskell2010
if flag(devel)
ghc-options:
-Werror -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns
-fwarn-incomplete-record-updates
else
ghc-options:
-Wall -fwarn-tabs -fwarn-incomplete-uni-patterns
-fwarn-incomplete-record-updates
default-extensions:
BangPatterns
LambdaCase
OverloadedStrings
QuasiQuotes
TemplateHaskell
TupleSections
TypeFamilies
library
import:
config
, base
, aeson
, megaparsec
, safe-exceptions
, text
, unordered-containers
exposed-modules: System.OsRelease
other-modules: System.OsRelease.Megaparsec
hs-source-dirs: library
test-suite tests
import:
config
, base
, bytestring
, filepath
, hspec
, hspec-megaparsec
, megaparsec
, pretty-simple
, tasty
, tasty-golden
, tasty-hspec
, text
build-depends: os-release
hs-source-dirs: tests
main-is: Main.hs
other-modules:
Golden.Real
Specs.Megaparsec
type: exitcode-stdio-1.0

35
3rdparty/os-release/tests/Golden/Real.hs vendored Normal file
View File

@ -0,0 +1,35 @@
{-# LANGUAGE CPP #-}
module Golden.Real where
import System.OsRelease
import System.FilePath
import Text.Pretty.Simple
import Test.Tasty
import Test.Tasty.Golden
import qualified Data.ByteString.Lazy as B
import qualified Data.Text.Lazy as L
import qualified Data.Text.Encoding as E
goldenTests :: IO TestTree
goldenTests = do
files <- findByExtension [".in"] (takeDirectory (__FILE__) </> "data")
return $ testGroup
"Parse os-release into OsRelease"
(flip fmap files $ \file ->
let out = replaceExtension file ".golden"
in goldenVsString (takeBaseName file) out (parse file)
)
where
parse f = do
c <- readFile f
pure
. B.fromStrict
. E.encodeUtf8
. L.toStrict
. pShowNoColor
. parseOsRelease'
$ c

24
3rdparty/os-release/tests/Golden/data/alpine.golden vendored Normal file
View File

@ -0,0 +1,24 @@
OsReleaseResult
{ osRelease = OsRelease
{ name = "Alpine Linux"
, version = Nothing
, id = "alpine"
, id_like = Nothing
, version_codename = Nothing
, version_id = Just "3.11.3"
, pretty_name = "Alpine Linux v3.11"
, ansi_color = Nothing
, cpe_name = Nothing
, home_url = Just "https://alpinelinux.org/"
, documentation_url = Nothing
, support_url = Nothing
, bug_report_url = Just "https://bugs.alpinelinux.org/"
, privacy_policy_url = Nothing
, build_id = Nothing
, variant = Nothing
, variant_id = Nothing
, logo = Nothing
}
, unknown_fields = []
, parse_errors = []
}

7
3rdparty/os-release/tests/Golden/data/alpine.in vendored Normal file
View File

@ -0,0 +1,7 @@
NAME="Alpine Linux"
ID=alpine
VERSION_ID=3.11.3
PRETTY_NAME="Alpine Linux v3.11"
HOME_URL="https://alpinelinux.org/"
BUG_REPORT_URL="https://bugs.alpinelinux.org/"

29
3rdparty/os-release/tests/Golden/data/arch.golden vendored Normal file
View File

@ -0,0 +1,29 @@
OsReleaseResult
{ osRelease = OsRelease
{ name = "Arch Linux"
, version = Nothing
, id = "arch"
, id_like = Nothing
, version_codename = Nothing
, version_id = Nothing
, pretty_name = "Arch Linux"
, ansi_color = Just "38;2;23;147;209"
, cpe_name = Nothing
, home_url = Just "https://www.archlinux.org/"
, documentation_url = Just "https://wiki.archlinux.org/"
, support_url = Just "https://bbs.archlinux.org/"
, bug_report_url = Just "https://bugs.archlinux.org/"
, privacy_policy_url = Nothing
, build_id = Just "rolling"
, variant = Nothing
, variant_id = Nothing
, logo = Just "archlinux"
}
, unknown_fields =
[
( "LOGO"
, "archlinux"
)
]
, parse_errors = []
}

11
3rdparty/os-release/tests/Golden/data/arch.in vendored Normal file
View File

@ -0,0 +1,11 @@
NAME="Arch Linux"
PRETTY_NAME="Arch Linux"
ID=arch
BUILD_ID=rolling
ANSI_COLOR="38;2;23;147;209"
HOME_URL="https://www.archlinux.org/"
DOCUMENTATION_URL="https://wiki.archlinux.org/"
SUPPORT_URL="https://bbs.archlinux.org/"
BUG_REPORT_URL="https://bugs.archlinux.org/"
LOGO=archlinux

45
3rdparty/os-release/tests/Golden/data/centos.golden vendored Normal file
View File

@ -0,0 +1,45 @@
OsReleaseResult
{ osRelease = OsRelease
{ name = "CentOS Linux"
, version = Just "8 (Core)"
, id = "centos"
, id_like = Just "rhel fedora"
, version_codename = Nothing
, version_id = Just "8"
, pretty_name = "CentOS Linux 8 (Core)"
, ansi_color = Just "0;31"
, cpe_name = Just "cpe:/o:centos:centos:8"
, home_url = Just "https://www.centos.org/"
, documentation_url = Nothing
, support_url = Nothing
, bug_report_url = Just "https://bugs.centos.org/"
, privacy_policy_url = Nothing
, build_id = Nothing
, variant = Nothing
, variant_id = Nothing
, logo = Nothing
}
, unknown_fields =
[
( "REDHAT_SUPPORT_PRODUCT_VERSION"
, "8"
)
,
( "CENTOS_MANTISBT_PROJECT"
, "CentOS-8"
)
,
( "REDHAT_SUPPORT_PRODUCT"
, "centos"
)
,
( "PLATFORM_ID"
, "platform:el8"
)
,
( "CENTOS_MANTISBT_PROJECT_VERSION"
, "8"
)
]
, parse_errors = []
}

17
3rdparty/os-release/tests/Golden/data/centos.in vendored Normal file
View File

@ -0,0 +1,17 @@
NAME="CentOS Linux"
VERSION="8 (Core)"
ID="centos"
ID_LIKE="rhel fedora"
VERSION_ID="8"
PLATFORM_ID="platform:el8"
PRETTY_NAME="CentOS Linux 8 (Core)"
ANSI_COLOR="0;31"
CPE_NAME="cpe:/o:centos:centos:8"
HOME_URL="https://www.centos.org/"
BUG_REPORT_URL="https://bugs.centos.org/"
CENTOS_MANTISBT_PROJECT="CentOS-8"
CENTOS_MANTISBT_PROJECT_VERSION="8"
REDHAT_SUPPORT_PRODUCT="centos"
REDHAT_SUPPORT_PRODUCT_VERSION="8"

24
3rdparty/os-release/tests/Golden/data/debian.golden vendored Normal file
View File

@ -0,0 +1,24 @@
OsReleaseResult
{ osRelease = OsRelease
{ name = "Debian GNU/Linux"
, version = Just "8 (jessie)"
, id = "debian"
, id_like = Nothing
, version_codename = Nothing
, version_id = Just "8"
, pretty_name = "Debian GNU/Linux 8 (jessie)"
, ansi_color = Nothing
, cpe_name = Nothing
, home_url = Just "http://www.debian.org/"
, documentation_url = Nothing
, support_url = Just "http://www.debian.org/support/"
, bug_report_url = Just "https://bugs.debian.org/"
, privacy_policy_url = Nothing
, build_id = Nothing
, variant = Nothing
, variant_id = Nothing
, logo = Nothing
}
, unknown_fields = []
, parse_errors = []
}

8
3rdparty/os-release/tests/Golden/data/debian.in vendored Normal file
View File

@ -0,0 +1,8 @@
PRETTY_NAME="Debian GNU/Linux 8 (jessie)"
NAME="Debian GNU/Linux"
VERSION_ID="8"
VERSION="8 (jessie)"
ID=debian
HOME_URL="http://www.debian.org/"
SUPPORT_URL="http://www.debian.org/support/"
BUG_REPORT_URL="https://bugs.debian.org/"

24
3rdparty/os-release/tests/Golden/data/empty.golden vendored Normal file
View File

@ -0,0 +1,24 @@
OsReleaseResult
{ osRelease = OsRelease
{ name = "Linux"
, version = Nothing
, id = "linux"
, id_like = Nothing
, version_codename = Nothing
, version_id = Nothing
, pretty_name = "Linux"
, ansi_color = Nothing
, cpe_name = Nothing
, home_url = Nothing
, documentation_url = Nothing
, support_url = Nothing
, bug_report_url = Nothing
, privacy_policy_url = Nothing
, build_id = Nothing
, variant = Nothing
, variant_id = Nothing
, logo = Nothing
}
, unknown_fields = []
, parse_errors = []
}

1
3rdparty/os-release/tests/Golden/data/empty.in vendored Normal file
View File

@ -0,0 +1 @@

24
3rdparty/os-release/tests/Golden/data/exherbo.golden vendored Normal file
View File

@ -0,0 +1,24 @@
OsReleaseResult
{ osRelease = OsRelease
{ name = "Exherbo"
, version = Nothing
, id = "exherbo"
, id_like = Nothing
, version_codename = Nothing
, version_id = Nothing
, pretty_name = "Exherbo Linux"
, ansi_color = Just "0;32"
, cpe_name = Nothing
, home_url = Just "https://www.exherbo.org/"
, documentation_url = Nothing
, support_url = Just "irc://irc.freenode.net/#exherbo"
, bug_report_url = Just "https://bugs.exherbo.org/"
, privacy_policy_url = Nothing
, build_id = Nothing
, variant = Nothing
, variant_id = Nothing
, logo = Nothing
}
, unknown_fields = []
, parse_errors = []
}

9
3rdparty/os-release/tests/Golden/data/exherbo.in vendored Normal file
View File

@ -0,0 +1,9 @@
NAME="Exherbo"
PRETTY_NAME="Exherbo Linux"
ID="exherbo"
# comment
ANSI_COLOR="0;32"
HOME_URL="https://www.exherbo.org/"
SUPPORT_URL="irc://irc.freenode.net/#exherbo"
BUG_REPORT_URL="https://bugs.exherbo.org/"

49
3rdparty/os-release/tests/Golden/data/fedora.golden vendored Normal file
View File

@ -0,0 +1,49 @@
OsReleaseResult
{ osRelease = OsRelease
{ name = "Fedora"
, version = Just "31 (Container Image)"
, id = "fedora"
, id_like = Nothing
, version_codename = Just ""
, version_id = Just "31"
, pretty_name = "Fedora 31 (Container Image)"
, ansi_color = Just "0;34"
, cpe_name = Just "cpe:/o:fedoraproject:fedora:31"
, home_url = Just "https://fedoraproject.org/"
, documentation_url = Just "https://docs.fedoraproject.org/en-US/fedora/f31/system-administrators-guide/"
, support_url = Just "https://fedoraproject.org/wiki/Communicating_and_getting_help"
, bug_report_url = Just "https://bugzilla.redhat.com/"
, privacy_policy_url = Just "https://fedoraproject.org/wiki/Legal:PrivacyPolicy"
, build_id = Nothing
, variant = Just "Container Image"
, variant_id = Just "container"
, logo = Just "fedora-logo-icon"
}
, unknown_fields =
[
( "REDHAT_SUPPORT_PRODUCT_VERSION"
, "31"
)
,
( "REDHAT_BUGZILLA_PRODUCT"
, "Fedora"
)
,
( "REDHAT_SUPPORT_PRODUCT"
, "Fedora"
)
,
( "PLATFORM_ID"
, "platform:f31"
)
,
( "REDHAT_BUGZILLA_PRODUCT_VERSION"
, "31"
)
,
( "LOGO"
, "fedora-logo-icon"
)
]
, parse_errors = []
}

21
3rdparty/os-release/tests/Golden/data/fedora.in vendored Normal file
View File

@ -0,0 +1,21 @@
NAME=Fedora
VERSION="31 (Container Image)"
ID=fedora
VERSION_ID=31
VERSION_CODENAME=""
PLATFORM_ID="platform:f31"
PRETTY_NAME="Fedora 31 (Container Image)"
ANSI_COLOR="0;34"
LOGO=fedora-logo-icon
CPE_NAME="cpe:/o:fedoraproject:fedora:31"
HOME_URL="https://fedoraproject.org/"
DOCUMENTATION_URL="https://docs.fedoraproject.org/en-US/fedora/f31/system-administrators-guide/"
SUPPORT_URL="https://fedoraproject.org/wiki/Communicating_and_getting_help"
BUG_REPORT_URL="https://bugzilla.redhat.com/"
REDHAT_BUGZILLA_PRODUCT="Fedora"
REDHAT_BUGZILLA_PRODUCT_VERSION=31
REDHAT_SUPPORT_PRODUCT="Fedora"
REDHAT_SUPPORT_PRODUCT_VERSION=31
PRIVACY_POLICY_URL="https://fedoraproject.org/wiki/Legal:PrivacyPolicy"
VARIANT="Container Image"
VARIANT_ID=container

24
3rdparty/os-release/tests/Golden/data/gentoo.golden vendored Normal file
View File

@ -0,0 +1,24 @@
OsReleaseResult
{ osRelease = OsRelease
{ name = "Gentoo"
, version = Nothing
, id = "gentoo"
, id_like = Nothing
, version_codename = Nothing
, version_id = Nothing
, pretty_name = "Gentoo/Linux"
, ansi_color = Just "1;32"
, cpe_name = Nothing
, home_url = Just "https://www.gentoo.org/"
, documentation_url = Nothing
, support_url = Just "https://www.gentoo.org/support/"
, bug_report_url = Just "https://bugs.gentoo.org/"
, privacy_policy_url = Nothing
, build_id = Nothing
, variant = Nothing
, variant_id = Nothing
, logo = Nothing
}
, unknown_fields = []
, parse_errors = []
}

8
3rdparty/os-release/tests/Golden/data/gentoo.in vendored Normal file
View File

@ -0,0 +1,8 @@
NAME=Gentoo
ID=gentoo
PRETTY_NAME="Gentoo/Linux"
ANSI_COLOR="1;32"
HOME_URL="https://www.gentoo.org/"
SUPPORT_URL="https://www.gentoo.org/support/"
BUG_REPORT_URL="https://bugs.gentoo.org/"

29
3rdparty/os-release/tests/Golden/data/mint.golden vendored Normal file
View File

@ -0,0 +1,29 @@
OsReleaseResult
{ osRelease = OsRelease
{ name = "Linux Mint"
, version = Just "18.2 (Sonya)"
, id = "linuxmint"
, id_like = Just "ubuntu"
, version_codename = Just "sonya"
, version_id = Just "18.2"
, pretty_name = "Linux Mint 18.2"
, ansi_color = Nothing
, cpe_name = Nothing
, home_url = Just "http://www.linuxmint.com/"
, documentation_url = Nothing
, support_url = Just "http://forums.linuxmint.com/"
, bug_report_url = Just "http://bugs.launchpad.net/linuxmint/"
, privacy_policy_url = Nothing
, build_id = Nothing
, variant = Nothing
, variant_id = Nothing
, logo = Nothing
}
, unknown_fields =
[
( "UBUNTU_CODENAME"
, "xenial"
)
]
, parse_errors = []
}

12
3rdparty/os-release/tests/Golden/data/mint.in vendored Normal file
View File

@ -0,0 +1,12 @@
NAME="Linux Mint"
VERSION="18.2 (Sonya)"
ID=linuxmint
ID_LIKE=ubuntu
PRETTY_NAME="Linux Mint 18.2"
VERSION_ID="18.2"
HOME_URL="http://www.linuxmint.com/"
SUPPORT_URL="http://forums.linuxmint.com/"
BUG_REPORT_URL="http://bugs.launchpad.net/linuxmint/"
VERSION_CODENAME=sonya
UBUNTU_CODENAME=xenial

41
3rdparty/os-release/tests/Golden/data/red-hat.golden vendored Normal file
View File

@ -0,0 +1,41 @@
OsReleaseResult
{ osRelease = OsRelease
{ name = "Red Hat Enterprise Linux Server"
, version = Just "7.6 (Maipo)"
, id = "rhel"
, id_like = Just "fedora"
, version_codename = Nothing
, version_id = Just "7.6"
, pretty_name = "Red Hat Enterprise Linux"
, ansi_color = Just "0;31"
, cpe_name = Just "cpe:/o:redhat:enterprise_linux:7.6:GA:server"
, home_url = Just "https://www.redhat.com/"
, documentation_url = Nothing
, support_url = Nothing
, bug_report_url = Just "https://bugzilla.redhat.com/"
, privacy_policy_url = Nothing
, build_id = Nothing
, variant = Just "Server"
, variant_id = Just "server"
, logo = Nothing
}
, unknown_fields =
[
( "REDHAT_SUPPORT_PRODUCT_VERSION"
, "7.6"
)
,
( "REDHAT_BUGZILLA_PRODUCT"
, "Red Hat Enterprise Linux 7"
)
,
( "REDHAT_SUPPORT_PRODUCT"
, "Red Hat Enterprise Linux"
)
,
( "REDHAT_BUGZILLA_PRODUCT_VERSION"
, "7.6"
)
]
, parse_errors = []
}

17
3rdparty/os-release/tests/Golden/data/red-hat.in vendored Normal file
View File

@ -0,0 +1,17 @@
NAME="Red Hat Enterprise Linux Server"
VERSION="7.6 (Maipo)"
ID="rhel"
ID_LIKE="fedora"
VARIANT="Server"
VARIANT_ID="server"
VERSION_ID="7.6"
PRETTY_NAME="Red Hat Enterprise Linux"
ANSI_COLOR="0;31"
CPE_NAME="cpe:/o:redhat:enterprise_linux:7.6:GA:server"
HOME_URL="https://www.redhat.com/"
BUG_REPORT_URL="https://bugzilla.redhat.com/"
REDHAT_BUGZILLA_PRODUCT="Red Hat Enterprise Linux 7"
REDHAT_BUGZILLA_PRODUCT_VERSION=7.6
REDHAT_SUPPORT_PRODUCT="Red Hat Enterprise Linux"
REDHAT_SUPPORT_PRODUCT_VERSION="7.6"

49
3rdparty/os-release/tests/Golden/data/red-hat_parseErrors.golden vendored Normal file
View File

@ -0,0 +1,49 @@
OsReleaseResult
{ osRelease = OsRelease
{ name = "Red Hat Enterprise Linux Server"
, version = Just "7.6 (Maipo)"
, id = "rhel"
, id_like = Just "fedora"
, version_codename = Nothing
, version_id = Just "7.6"
, pretty_name = "Red Hat Enterprise Linux"
, ansi_color = Just "0;31"
, cpe_name = Just "cpe:/o:redhat:enterprise_linux:7.6:GA:server"
, home_url = Just "https://www.redhat.com/"
, documentation_url = Nothing
, support_url = Nothing
, bug_report_url = Just "https://bugzilla.redhat.com/"
, privacy_policy_url = Nothing
, build_id = Nothing
, variant = Just "Server"
, variant_id = Just "server"
, logo = Nothing
}
, unknown_fields =
[
( "REDHAT_SUPPORT_PRODUCT_VERSION"
, "7.6"
)
,
( "REDHAT_BUGZILLA_PRODUCT"
, "Red Hat Enterprise Linux 7"
)
,
( "REDHAT_SUPPORT_PRODUCT"
, "Red Hat Enterprise Linux"
)
,
( "REDHAT_BUGZILLA_PRODUCT_VERSION"
, "7.6"
)
]
, parse_errors =
[ TrivialError 520
( Just
( Tokens ( '\'' :| "" ) )
)
( fromList
[ Label ( 'e' :| "nd of line" ) ]
)
]
}

18
3rdparty/os-release/tests/Golden/data/red-hat_parseErrors.in vendored Normal file
View File

@ -0,0 +1,18 @@
NAME="Red Hat Enterprise Linux Server"
VERSION="7.6 (Maipo)"
ID="rhel"
ID_LIKE="fedora"
VARIANT="Server"
VARIANT_ID="server"
VERSION_ID="7.6"
PRETTY_NAME="Red Hat Enterprise Linux"
ANSI_COLOR="0;31"
CPE_NAME="cpe:/o:redhat:enterprise_linux:7.6:GA:server"
HOME_URL="https://www.redhat.com/"
BUG_REPORT_URL="https://bugzilla.redhat.com/"
REDHAT_BUGZILLA_PRODUCT="Red Hat Enterprise Linux 7"
REDHAT_BUGZILLA_PRODUCT_VERSION=7.6
REDHAT_SUPPORT_PRODUCT="Red Hat Enterprise Linux"
REDHAT_SUPPORT_PRODUCT_VERSION="7.6"
foo=1.'

29
3rdparty/os-release/tests/Golden/data/ubuntu.golden vendored Normal file
View File

@ -0,0 +1,29 @@
OsReleaseResult
{ osRelease = OsRelease
{ name = "Ubuntu"
, version = Just "20.04 LTS (Focal Fossa)"
, id = "ubuntu"
, id_like = Just "debian"
, version_codename = Just "focal"
, version_id = Just "20.04"
, pretty_name = "Ubuntu 20.04 LTS"
, ansi_color = Nothing
, cpe_name = Nothing
, home_url = Just "https://www.ubuntu.com/"
, documentation_url = Nothing
, support_url = Just "https://help.ubuntu.com/"
, bug_report_url = Just "https://bugs.launchpad.net/ubuntu/"
, privacy_policy_url = Just "https://www.ubuntu.com/legal/terms-and-policies/privacy-policy"
, build_id = Nothing
, variant = Nothing
, variant_id = Nothing
, logo = Nothing
}
, unknown_fields =
[
( "UBUNTU_CODENAME"
, "focal"
)
]
, parse_errors = []
}

13
3rdparty/os-release/tests/Golden/data/ubuntu.in vendored Normal file
View File

@ -0,0 +1,13 @@
NAME="Ubuntu"
VERSION="20.04 LTS (Focal Fossa)"
ID=ubuntu
ID_LIKE=debian
PRETTY_NAME="Ubuntu 20.04 LTS"
VERSION_ID="20.04"
HOME_URL="https://www.ubuntu.com/"
SUPPORT_URL="https://help.ubuntu.com/"
BUG_REPORT_URL="https://bugs.launchpad.net/ubuntu/"
PRIVACY_POLICY_URL="https://www.ubuntu.com/legal/terms-and-policies/privacy-policy"
VERSION_CODENAME=focal
UBUNTU_CODENAME=focal

16
3rdparty/os-release/tests/Main.hs vendored Normal file
View File

@ -0,0 +1,16 @@
import Golden.Real
import Specs.Megaparsec
import Test.Tasty
import Test.Tasty.Hspec
main :: IO ()
main = do
ms <- testSpec "megaparsec spec" megaparsecSpec
gs <- goldenTests
defaultMain (tests [ms, gs])
tests :: [TestTree] -> TestTree
tests ts = testGroup "Tests" (ts++[])

88
3rdparty/os-release/tests/Specs/Megaparsec.hs vendored Normal file
View File

@ -0,0 +1,88 @@
module Specs.Megaparsec where
import System.OsRelease
import Data.Either
import Data.Void
import Test.Hspec
import Test.Hspec.Megaparsec
import qualified Text.Megaparsec as MP
megaparsecSpec :: Spec
megaparsecSpec = do
describe "parseAssignment" $ do
it "parses simple value" $ shouldParse' "foo=bar" ("foo", "bar")
it "parses single quoted value" $ shouldParse' "foo='bar'" ("foo", "bar")
it "parses double quoted value" $ shouldParse' "foo=\"bar\"" ("foo", "bar")
it "parses _ var" $ shouldParse' "f_x=''" ("f_x", "")
-- this is not valid per spec, but many files do this
it "parses ._- in unquoted assignment"
$ shouldParse' "VERSION_ID=bar-1.9_rc2" ("VERSION_ID", "bar-1.9_rc2")
it "parses quoted space" $ shouldParse' "f='a b'" ("f", "a b")
it "parses quoted -" $ shouldParse' "f='a-b'" ("f", "a-b")
it "parses special \\" $ shouldParse' "foo='ba\\\\r'" ("foo", "ba\\r")
it "parses special `" $ shouldParse' "foo='ba\\`r'" ("foo", "ba`r")
it "parses special '" $ shouldParse' "foo='ba\\'r'" ("foo", "ba'r")
it "parses special $" $ shouldParse' "foo='ba\\$r'" ("foo", "ba$r")
it "parses special \"" $ shouldParse' "foo=\"ba\\\"r\"" ("foo", "ba\"r")
it "parses empty val noquotes" $ shouldParse' "foo=" ("foo", "")
it "parses empty val quote \"" $ shouldParse' "foo=\"\"" ("foo", "")
it "parses empty val quote '" $ shouldParse' "foo=''" ("foo", "")
it "breaks on comments" $ shouldFail' "# foo=\"bar'"
it "breaks on misquoting 1" $ shouldFail' "foo=\"bar'"
it "breaks on misquoting 2" $ shouldFail' "foo='bar\""
it "breaks on unquoted $" $ shouldFail' "foo='ba$r'"
it "breaks on unquoted `" $ shouldFail' "foo='ba`r'"
it "breaks on unquoted \"" $ shouldFail' "foo=\"ba\"r\""
it "breaks on unquoted '" $ shouldFail' "foo='ba'r'"
it "breaks on unquoted \\" $ shouldFail' "foo='ba\\r'"
it "breaks on unquoted val with space" $ shouldFail' "foo=ba r"
it "breaks on unquoted val with ;" $ shouldFail' "foo=ba;r"
it "breaks on unquoted val with \\" $ shouldFail' "foo=ba\\r"
it "breaks on trailing NL" $ shouldFail' "foo=bar\n"
describe "parseAssignments" $ do
it "parses simple values" $ shouldParseMany "foo=bar" [("foo", "bar")]
it "parses multiple values"
$ shouldParseMany "foo=bar\nbar=baz" [("foo", "bar"), ("bar", "baz")]
it "parses multiple values with comments" $ shouldParseMany
"foo=bar\n# comment\nbar=baz"
[("foo", "bar"), ("bar", "baz")]
it "parses gracefully" $ shouldParseMany "foo=bar\nbar=baz\"" [("foo", "bar")]
it "parses empty files" $ shouldParseMany "" []
it "parses empty files with newlines" $ shouldParseMany "\n\n" []
it "parses empty files with newlines and comments"
$ shouldParseMany "\n\n#\n" []
it "parses comments with leading spaces" $ shouldParseMany " #" []
parse :: String -> Either (MP.ParseErrorBundle String Void) (String, String)
parse = MP.parse (parseAssignment <* MP.eof) ""
shouldParse' :: String -> (String, String) -> Expectation
shouldParse' s s' = parse s `shouldParse` s'
shouldFail' :: String -> Expectation
shouldFail' s = parse `shouldFailOn` s
parseMany :: String
-> Either (MP.ParseErrorBundle String Void) [(String, String)]
parseMany = fmap rights . MP.parse parseAssignments ""
shouldParseMany :: String -> [(String, String)] -> Expectation
shouldParseMany s s' = parseMany s `shouldParse` s'
shouldFailMany :: String -> Expectation
shouldFailMany s = parseMany `shouldFailOn` s

5
ghcup.cabal
View File

@ -173,6 +173,9 @@ common time
common transformers
build-depends: transformers >=0.5
common os-release
build-depends: os-release >=1.0.0
common unix
build-depends: unix >=2.7
@ -261,6 +264,7 @@ library
, text
, time
, transformers
, os-release
, unix
, unix-bytestring
, unordered-containers
@ -285,7 +289,6 @@ library
GHCup.Types.JSON
GHCup.Types.Optics
GHCup.Utils
GHCup.Utils.OsRelease
GHCup.Utils.Dirs
GHCup.Utils.File
GHCup.Utils.Logger

7
lib/GHCup/Platform.hs
View File

@ -12,7 +12,6 @@ module GHCup.Platform where
import GHCup.Errors
import GHCup.Types
import GHCup.Types.JSON ( )
import GHCup.Utils.OsRelease
import GHCup.Utils.File
import GHCup.Utils.Prelude
import GHCup.Utils.String.QQ
@ -36,6 +35,7 @@ import Prelude hiding ( abs
, writeFile
)
import System.Info
import System.OsRelease
import Text.Regex.Posix
import qualified Data.Text as T
@ -148,8 +148,9 @@ getLinuxDistro = do
try_os_release :: IO (Text, Maybe Text)
try_os_release = do
OsRelease { name = Just n, version_id = v } <- parseOsRelease
pure (T.pack n, fmap T.pack v)
Just (OsRelease { name = name, version_id = version_id }) <-
fmap osRelease <$> parseOsRelease
pure (T.pack name, fmap T.pack version_id)
try_lsb_release_cmd :: IO (Text, Maybe Text)
try_lsb_release_cmd = do

164
lib/GHCup/Utils/OsRelease.hs
View File

@ -1,164 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
-- | A module to retrieve os-release information according to the
-- freedesktop standard:
-- https://www.freedesktop.org/software/systemd/man/os-release.html
--
-- Some of it is stolen from:
-- https://hackage.haskell.org/package/os-release-0.2.2/docs/src/System-OsRelease.html
module GHCup.Utils.OsRelease where
import GHCup.Utils.MegaParsec
import Control.Applicative
import Control.Monad
import Data.Aeson
import Data.Aeson.TH
import Data.Char
import Data.Either
import Data.List
import Data.Maybe
import Data.Void
import HPath
import HPath.IO
import Prelude hiding ( abs
, readFile
)
import qualified Data.ByteString.Lazy.UTF8 as UTF8
import qualified Data.HashMap.Strict as HM
import qualified Data.Text as T
import qualified Text.Megaparsec as MP
import qualified Text.Megaparsec.Char as MP
-- | All the explicitly documented fields of `os-release`.
data OsRelease = OsRelease {
name :: Maybe String
, version :: Maybe String
, id :: Maybe String
, id_like :: Maybe String
, version_codename :: Maybe String
, version_id :: Maybe String
, pretty_name :: Maybe String
, ansi_color :: Maybe String
, cpe_name :: Maybe String
, home_url :: Maybe String
, documentation_url :: Maybe String
, support_url :: Maybe String
, bug_report_url :: Maybe String
, privacy_policy_url :: Maybe String
, build_id :: Maybe String
, variant :: Maybe String
, variant_id :: Maybe String
, logo :: Maybe String
} deriving (Show)
emptyOsRelease :: OsRelease
emptyOsRelease = OsRelease { name = Nothing
, version = Nothing
, id = Nothing
, id_like = Nothing
, version_codename = Nothing
, version_id = Nothing
, pretty_name = Nothing
, ansi_color = Nothing
, cpe_name = Nothing
, home_url = Nothing
, documentation_url = Nothing
, support_url = Nothing
, bug_report_url = Nothing
, privacy_policy_url = Nothing
, build_id = Nothing
, variant = Nothing
, variant_id = Nothing
, logo = Nothing
}
-- | Parse a single line assignment and extract the right hand side.
-- This is only a subset of a shell parser, see
-- https://www.freedesktop.org/software/systemd/man/os-release.html
parseAssignment :: MP.Parsec Void String (String, String)
parseAssignment =
(,)
<$> (MP.space *> key)
<*> (MP.char '=' *> (MP.try qval <|> mempty) <* MP.space <* MP.eof)
where
dropSpace :: String -> String
dropSpace = reverse . dropWhile (\x -> x == ' ' || x == '\t') . reverse
key :: MP.Parsec Void String String
key = some (MP.try MP.alphaNumChar <|> MP.char '_')
qval :: MP.Parsec Void String String
qval = do
c <- MP.lookAhead MP.printChar
case c of
' ' -> pure ""
'"' -> MP.char c *> val c <* MP.char c
'\'' -> MP.char c *> val c <* MP.char c
-- no quote, have to drop trailing spaces
_ -> fmap dropSpace (some MP.alphaNumChar)
val :: Char -> MP.Parsec Void String String
val q = many (qspecial q <|> MP.noneOf (specials q)) -- noneOf may be too lax
qspecial :: Char -> MP.Parsec Void String Char
qspecial q =
fmap (!! 1)
. choice'
. fmap (\s -> MP.try . MP.chunk $ ['\\', s])
$ (specials q)
specials :: Char -> [Char]
specials q = [q, '\\', '$', '`']
-- | Get all allAssignments as `(key, val)` from the `os-release`
-- file contents.
allAssignments :: String -- ^ file contents of os-release
-> [(String, String)]
allAssignments = rights . fmap (MP.parse parseAssignment "") . lines
-- | Parse the assignments into OsRelease.
--
-- This can't fail and will create an "empty" product type instead on
-- failure.
osRelease :: [(String, String)] -- ^ assignments
-> OsRelease
osRelease =
(\case
Error _ -> emptyOsRelease
Success v -> v
)
. fromJSON
. Object
. HM.fromList
. fmap (\(k, v) -> (T.toLower . T.pack $ k, String . T.pack $ v))
-- | Tries to read `/etc/os-release` and `/usr/lib/os_release` in order.
-- Throws an exception if both files do not exist.
readOsRelease :: IO String
readOsRelease = do
let os_release1 :: Path Abs
os_release1 = [abs|/etc/os-release|]
let os_release2 :: Path Abs
os_release2 = [abs|/usr/lib/os-release|]
bs <- readFile os_release1 <|> readFile os_release2
-- os-release is utf8
pure . UTF8.toString $ bs
-- | Tries to read `/etc/os-release` and `/usr/lib/os_release` in order
-- and parses into `OsRelease`. Throws an exception if both files do not
-- exist.
parseOsRelease :: IO OsRelease
parseOsRelease = fmap (osRelease . allAssignments) readOsRelease
deriveJSON defaultOptions ''OsRelease