Find file
Fetching contributors…
Cannot retrieve contributors at this time
132 lines (117 sloc) 6.03 KB
module Facter where
import Data.Char
import Data.List
import Text.Printf
import qualified Data.Set as Set
import qualified Data.Map as Map
import Puppet.Interpreter.Types
import Puppet.Init
import PuppetDB.Rest
import System.Info
import qualified Data.Text as T
import Control.Arrow (first,second)
import Data.Monoid
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 = do
meminfo <- readFile "/proc/meminfo" >>= return . map words . lines
let memtotal = ginfo "MemTotal:"
memfree = ginfo "MemFree:"
swapfree = ginfo "SwapFree:"
swaptotal = ginfo "SwapTotal:"
ginfo st = sdesc $ head $ filter (\(x:xs) -> x == st) meminfo
sdesc [_, size, unit] = storagedesc (size, unit)
return [("memorysize", memtotal), ("memoryfree", memfree), ("swapfree", swapfree), ("swapsize", swaptotal)]
factNET = do
return [("ipaddress", "192.168.0.1")]
factOS :: IO [(String, String)]
factOS = do
lsb <- readFile "/etc/lsb-release" >>= return . map (break (== '=')) . lines
hostname <- readFile "/proc/sys/kernel/hostname" >>= return . head . lines
let getval st | null filtered = "?"
| otherwise = rvalue
where filtered = filter (\(k,_) -> k == st) lsb
value = (tail . snd . head) filtered
rvalue | head value == '"' = read value
| otherwise = value
release = getval "DISTRIB_RELEASE"
distid = getval "DISTRIB_ID"
maj | release == "?" = "?"
| otherwise = fst $ break (== '.') release
osfam | distid == "Ubuntu" = "Debian"
| otherwise = distid
return [ ("lsbdistid" , distid)
, ("operatingsystem" , distid)
, ("lsbdistrelease" , release)
, ("operatingsystemrelease" , release)
, ("lsbmajdistrelease" , maj)
, ("osfamily" , osfam)
, ("hostname" , hostname)
, ("lsbdistcodename" , getval "DISTRIB_CODENAME")
, ("lsbdistdescription" , getval "DISTRIB_DESCRIPTION")
, ("hardwaremodel" , arch)
, ("architecture" , arch)
]
factMountPoints :: IO [(String, String)]
factMountPoints = do
mountinfo <- readFile "/proc/mounts" >>= return . map words . lines
let ignorefs = Set.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 $ Set.member (x !! 2) ignorefs) mountinfo
goodfs = map (\x -> x !! 1) goodlines
return [("mountpoints", intercalate " " goodfs)]
version = return [("facterversion", "0.1"),("environment","test")]
allFacts :: T.Text -> IO (Map.Map T.Text ResolvedValue)
allFacts nodename = puppetDBFacts (T.unpack nodename) "http://localhost:8080"
puppetDBFacts :: String -> String -> IO (Map.Map T.Text ResolvedValue)
puppetDBFacts nodename url = do
puppetDBFacts <- rawRequest (T.pack url) "facts" (T.pack nodename)
case puppetDBFacts of
Right (ResolvedHash xs) ->
let myhash = case (filter ((=="facts") . fst) xs) of
[(_, ResolvedHash pfacts)] -> Map.fromList $ concatMap (\(a,b) -> [(a,b), ("::" <> a, b)]) pfacts
_ -> error $ "Bad facts format: " ++ show xs
in return myhash
_ -> do
rawFacts <- mapM id [factNET, factRAM, factOS, version, factMountPoints, factOS] >>= return . concat
let ofacts = genFacts $ map (second T.pack . first T.pack) rawFacts
(hostname, ddomainname) = break (== '.') nodename
domainname = if null ddomainname
then []
else tail $ ddomainname
nfacts = genFacts $ map (second T.pack) [ ("fqdn", nodename)
, ("hostname", hostname)
, ("domain", domainname)
, ("rootrsa", "xxx")
, ("operatingsystem", "Ubuntu")
, ("puppetversion", "language-puppet")
, ("virtual", "xenu")
, ("clientcert", nodename)
]
allfacts = Map.union nfacts ofacts
return allfacts