module Facter where
import Data.Char
import Text.Printf
import qualified Data.HashSet as HS
import qualified Data.HashMap.Strict as HM
import Puppet.Interpreter.Types
import qualified Data.Text as T
import Control.Arrow
import qualified Data.Either.Strict as S
import Control.Lens
import System.Posix.User
import System.Posix.Unistd (getSystemID, SystemID(..))
import Data.List.Split (splitOn)
import Data.List (intercalate,stripPrefix)
import System.Environment
import System.Directory (doesFileExist)
import Data.Maybe (mapMaybe)
storageunits :: [(String, Int)]
storageunits = [ ("", 0), ("K", 1), ("M", 2), ("G", 3), ("T", 4) ]
getPrefix :: Int -> String
getPrefix n | null fltr = error $ "Could not get unit prefix for order " ++ show n
| otherwise = fst $ head fltr
where fltr = filter (\(_, x) -> x == n) storageunits
getOrder :: String -> Int
getOrder n | null fltr = error $ "Could not get order for unit prefix " ++ show n
| otherwise = snd $ head fltr
where
nu = map toUpper n
fltr = filter (\(x, _) -> x == nu) storageunits
normalizeUnit :: (Double, Int) -> Double -> (Double, Int)
normalizeUnit (unit, order) base | unit > base = normalizeUnit (unit/base, order + 1) base
| otherwise = (unit, order)
storagedesc :: (String, String) -> String
storagedesc (ssize, unit) = let
size = read ssize :: Double
uprefix | unit == "B" = ""
| otherwise = [head unit]
uorder = getOrder uprefix
(osize, oorder) = normalizeUnit (size, uorder) 1024
in printf "%.2f %sB" osize (getPrefix oorder)
factRAM :: IO [(String, String)]
factRAM = do
meminfo <- fmap (map words . lines) (readFile "/proc/meminfo")
let memtotal = ginfo "MemTotal:"
memfree = ginfo "MemFree:"
swapfree = ginfo "SwapFree:"
swaptotal = ginfo "SwapTotal:"
ginfo st = sdesc $ head $ filter ((== st) . head) meminfo
sdesc [_, size, unit] = storagedesc (size, unit)
sdesc _ = storagedesc ("1","B")
return [("memorysize", memtotal), ("memoryfree", memfree), ("swapfree", swapfree), ("swapsize", swaptotal)]
factNET :: IO [(String, String)]
factNET = return [("ipaddress", "192.168.0.1")]
factOS :: IO [(String, String)]
factOS = do
islsb <- doesFileExist "/etc/lsb-release"
isdeb <- doesFileExist "/etc/debian_version"
case (islsb, isdeb) of
(True, _) -> factOSLSB
(_, True) -> factOSDebian
_ -> return []
factOSDebian :: IO [(String, String)]
factOSDebian = fmap (toV . head . lines) (readFile "/etc/debian_version")
where
toV v = [ ("lsbdistid" , "Debian")
, ("operatingsystem" , "Debian")
, ("lsbdistrelease" , v)
, ("operatingsystemrelease" , v)
, ("lsbmajdistrelease" , takeWhile (/='.') v)
, ("osfamily" , "Debian")
, ("lsbdistcodename" , codename v)
, ("lsbdistdescription" , "Debian GNU/Linux " ++ v ++ " (" ++ codename v ++ ")")
]
codename v | null v = "unknown"
| h '7' = "wheezy"
| h '6' = "squeeze"
| h '5' = "lenny"
| h '4' = "etch"
| v == "3.1" = "sarge"
| v == "3.0" = "woody"
| v == "2.2" = "potato"
| v == "2.1" = "slink"
| v == "2.0" = "hamm"
| otherwise = "unknown"
where h x = head v == x
factOSLSB :: IO [(String, String)]
factOSLSB = do
lsb <- fmap (map (break (== '=')) . lines) (readFile "/etc/lsb-release")
let getval st | null filterd = "?"
| otherwise = rvalue
where filterd = filter (\(k,_) -> k == st) lsb
value = (tail . snd . head) filterd
rvalue | head value == '"' = read value
| otherwise = value
lrelease = getval "DISTRIB_RELEASE"
distid = getval "DISTRIB_ID"
maj | lrelease == "?" = "?"
| otherwise = fst $ break (== '.') lrelease
osfam | distid == "Ubuntu" = "Debian"
| otherwise = distid
return [ ("lsbdistid" , distid)
, ("operatingsystem" , distid)
, ("lsbdistrelease" , lrelease)
, ("operatingsystemrelease" , lrelease)
, ("lsbmajdistrelease" , maj)
, ("osfamily" , osfam)
, ("lsbdistcodename" , getval "DISTRIB_CODENAME")
, ("lsbdistdescription" , getval "DISTRIB_DESCRIPTION")
]
factMountPoints :: IO [(String, String)]
factMountPoints = do
mountinfo <- fmap (map words . lines) (readFile "/proc/mounts")
let ignorefs = HS.fromList
["NFS", "nfs", "nfs4", "nfsd", "afs", "binfmt_misc", "proc", "smbfs",
"autofs", "iso9660", "ncpfs", "coda", "devpts", "ftpfs", "devfs",
"mfs", "shfs", "sysfs", "cifs", "lustre_lite", "tmpfs", "usbfs", "udf",
"fusectl", "fuse.snapshotfs", "rpc_pipefs", "configfs", "devtmpfs",
"debugfs", "securityfs", "ecryptfs", "fuse.gvfs-fuse-daemon", "rootfs"
]
goodlines = filter (\x -> not $ HS.member (x !! 2) ignorefs) mountinfo
goodfs = map (!! 1) goodlines
return [("mountpoints", unwords goodfs)]
fversion :: IO [(String, String)]
fversion = return [("facterversion", "0.1"),("environment","test")]
factUser :: IO [(String, String)]
factUser = do
username <- getEffectiveUserName
return [("id",username)]
factUName :: IO [(String, String)]
factUName = do
SystemID sn nn rl _ mc <- getSystemID
let vparts = splitOn "." (takeWhile (/='-') rl)
return [ ("kernel" , sn)
, ("kernelmajversion" , intercalate "." (take 2 vparts))
, ("kernelrelease" , rl)
, ("kernelversion" , intercalate "." (take 3 vparts))
, ("hardwareisa" , mc)
, ("hardwaremodel" , mc)
, ("hostname" , nn)
]
fenv :: IO [(String,String)]
fenv = do
path <- getEnv "PATH"
return [ ("path", path) ]
factProcessor :: IO [(String,String)]
factProcessor = do
cpuinfo <- readFile "/proc/cpuinfo"
let cpuinfos = zip [ "processor" ++ show (n :: Int) | n <- [0..]] modelnames
modelnames = mapMaybe (fmap (dropWhile (`elem` "\t :")) . stripPrefix "model name") (lines cpuinfo)
return $ ("processorcount", show (length cpuinfos)) : cpuinfos
puppetDBFacts :: T.Text -> PuppetDBAPI IO -> IO (Container PValue)
puppetDBFacts ndename pdbapi =
getFacts pdbapi (QEqual FCertname ndename) >>= \case
S.Right facts@(_:_) -> return (HM.fromList (map (\f -> (f ^. factname, f ^. factval)) facts))
_ -> do
rawFacts <- fmap concat (sequence [factNET, factRAM, factOS, fversion, factMountPoints, factOS, factUser, factUName, fenv, factProcessor])
let ofacts = genFacts $ map (T.pack *** T.pack) rawFacts
(hostname, ddomainname) = T.break (== '.') ndename
domainname = if T.null ddomainname
then ""
else T.tail ddomainname
nfacts = genFacts [ ("fqdn", ndename)
, ("hostname", hostname)
, ("domain", domainname)
, ("rootrsa", "xxx")
, ("operatingsystem", "Ubuntu")
, ("puppetversion", "language-puppet")
, ("virtual", "xenu")
, ("clientcert", ndename)
, ("is_virtual", "true")
, ("concat_basedir", "/var/lib/puppet/concat")
]
allfacts = nfacts `HM.union` ofacts
genFacts = HM.fromList
return (allfacts & traverse %~ PString)