January 2008 - Haskell-Cafe

Comments and suggestions on code
by Andre Nathan 13 Jan '08

13 Jan '08

Hello I've just found time to finish writing my first "real world" program, so I thought I'd post it here and ask for insight on general issues such as if there's anything that isn't done "the Haskell way", or if there's something that could be done more efficiently. The code is at the bottom of this message and also at http://hpaste.org/4893. I realize it's a bit long, so if anyone could just skim through it and see if there's anything really ugly or stupid and point it out, it would be of great help :) Just to make it easier to follow the code, its idea is simple: - Build a process tree by reading entries from /proc (represented as a map); - Compare each child of the init process against a whitelist (which comes from a configuration file); - For each child not in the whitelist, send it a KILL signal. The idea here is to run this on webservers and try to catch bad customers who try to run daemons from their accounts, the typical script kiddie stuff. Anyway, there's one specific question I'd like to ask. I'm using "StateT PsTree IO" to keep program state (the process tree). IO is necessary because all information is read from /proc files. Now consider the following function: appendChild :: Pid -> Pid -> StateT PsTree IO Bool appendChild ppid pid = do tree <- get let PsInfo psData children = mapLookup ppid tree put $ Map.insert ppid (PsInfo psData (pid:children)) tree return True It changes the program state by modifying a process tree entry, but it does no I/O at all. The return type is there basically to match the return type of the function which calls it (insertParent), which calls functions that do I/O. Is there anyway to avoid the "IO" in appendChild's signature (other than making it a pure function by passing the process tree as a parameter and returning a modified map)? I would also like to try ways to improve efficiency, maybe trying a hash table instead of a map for the state, and also using bytestrings. I guess I could try making it parallel, since each child of init can be checked independently. Anyway, this is already longer than I thought it would be (I hope I'm not abusing too much :) The code follows. Thanks in advance for any comments or suggestions. Andre module Main where import qualified Data.Map as Map import Directory import Control.Monad.State import Maybe import System.Environment import System.IO import System.Posix.Files import System.Posix.Signals import System.Posix.Unistd import System.Posix.User import Text.Printf import Text.Regex import Text.Regex.Posix type Pid = FilePath type Uid = String type PsData = Map.Map String String type PsChildren = [Pid] type KillFunction = PsTree -> Pid -> IO () data PsInfo = PsInfo PsData PsChildren type PsTree = Map.Map Pid PsInfo type Whitelist = Map.Map FilePath String mapLookup :: (Ord a) => a -> Map.Map a b -> b mapLookup k = fromJust . Map.lookup k -- Process Tree construction parentPid :: PsInfo -> Pid parentPid (PsInfo psData _) = mapLookup "PPid" psData getProcInfo :: String -> PsData -> PsData getProcInfo line psData = do case line =~~ "^([A-Za-z]+):[[:space:]]+(.*)$" of Nothing -> psData Just ([_, key, value]:_) -> Map.insert key value psData getIds :: String -> PsData -> (String, String) getIds id psData = (rId, eId) where (rId:eId:_) = words (mapLookup id psData) processData :: String -> PsData processData procData = addIds psData where psData = foldr getProcInfo Map.empty (lines procData) addIds psData = Map.union psData (idMap psData) idMap psData = Map.fromList [("RUid", rUid), ("EUid", eUid), ("RGid", rGid), ("EGid", eGid)] (rUid, eUid) = getIds "Uid" psData (rGid, eGid) = getIds "Gid" psData readLink :: String -> IO String readLink link = catch (readSymbolicLink link) (\e -> return "?") procInfo :: Pid -> IO PsInfo procInfo pid = do let dir = "/proc/" ++ pid ++ "/" procData <- readFile $ dir ++ "status" exe <- readLink $ dir ++ "exe" cwd <- readLink $ dir ++ "cwd" cmd <- readFile $ dir ++ "cmdline" let cmd' = subRegex (mkRegex "[^a-zA-z[:space:]\\/\\.-]") cmd " " info = processData procData adminInfo = Map.fromList [("Exe", exe), ("Cwd", cwd), ("Cmd", cmd')] return $ PsInfo (Map.union info adminInfo) [] addProc :: Pid -> StateT PsTree IO PsInfo addProc pid = do info <- lift $ procInfo pid modify (Map.insert pid info) return info appendChild :: Pid -> Pid -> StateT PsTree IO Bool appendChild ppid pid = do tree <- get let PsInfo psData children = mapLookup ppid tree put $ Map.insert ppid (PsInfo psData (pid:children)) tree return True insertParent :: Pid -> Pid -> StateT PsTree IO Bool insertParent ppid pid = do tree <- get if Map.member ppid tree then appendChild ppid pid else do built <- insertInTree ppid if built then appendChild ppid pid else return False insertPid :: Pid -> StateT PsTree IO Bool insertPid "1" = do info <- addProc "1" return True insertPid pid = do info <- addProc pid let ppid = parentPid info if ppid == "0" then return False else insertParent ppid pid insertInTree :: Pid -> StateT PsTree IO Bool insertInTree pid = do tree <- get if Map.member pid tree then return True else insertPid pid buildTree :: FilePath -> StateT PsTree IO Bool buildTree entry | entry =~ "^[0-9]+$" = insertInTree entry | otherwise = return False createTree :: IO PsTree createTree = do entries <- getDirectoryContents "/proc" execStateT (mapM_ buildTree entries) Map.empty -- Process Tree pretty-printing treeStr :: PsTree -> PsChildren -> Int -> String -> String treeStr tree children level str = foldr append str children where append pid s = treeStr tree children' (level + 1) newstr where PsInfo _ children' = mapLookup pid tree pad = take (4 * level) [' ', ' ' ..] newstr = s ++ "\n" ++ pad ++ pid printTree :: PsTree -> Pid -> IO () printTree tree pid = putStrLn (treeStr tree children 1 pid) where PsInfo _ children = mapLookup pid tree -- Process killing tryToKill :: PsTree -> KillFunction -> Pid -> Uid -> Uid -> Bool -> IO Bool tryToKill tree killFun pid "0" allowedUid killed = do -- The process may be starting, give it a second chance. sleep 10 -- conservative value. let PsInfo psData _ = mapLookup pid tree if allowedUid /= mapLookup "EUid" psData then killFun tree pid >> return True else return (killed || False) tryToKill tree killFun pid _ _ _ = killFun tree pid >> return True buildWhitelist :: String -> Whitelist -> Whitelist buildWhitelist line whitelist = do case line =~~ "^[ \t]*([^: \t]+)[ \t]*:[ \t]*([^ \t]+)[ \t]*$" of Nothing -> error "Invalid configuration file" Just ([_, exe, user]:_) -> Map.insert exe user whitelist readWhiteList :: FilePath -> IO Whitelist readWhiteList file = do contents <- readFile file return $ foldr buildWhitelist Map.empty (lines contents) allowedUidForExecutable :: Whitelist -> FilePath -> IO Uid allowedUidForExecutable whitelist exe = do case Map.lookup exe whitelist of Nothing -> return "0" Just user -> do entry <- getUserEntryForName user return $ show (userID entry) processBastard :: PsTree -> Whitelist -> KillFunction -> Bool -> Pid -> IO Bool processBastard tree whitelist killFun killed pid = do let PsInfo psData _ = mapLookup pid tree euid = mapLookup "EUid" psData exe = mapLookup "Exe" psData allowedUid <- allowedUidForExecutable whitelist exe if euid /= allowedUid then tryToKill tree killFun pid euid allowedUid killed else return killed withEachBastard :: PsTree -> Whitelist -> KillFunction -> IO Bool withEachBastard tree whitelist killFun = foldM (processBastard tree whitelist killFun) False children where (PsInfo _ children) = mapLookup "1" tree printWarnings :: Pid -> PsData -> IO () printWarnings pid psData = do let exe = mapLookup "Exe" psData let cmd = mapLookup "Cmd" psData let cwd = mapLookup "Cwd" psData let ppid = mapLookup "PPid" psData let euid = mapLookup "EUid" psData let ruid = mapLookup "RUid" psData let egid = mapLookup "EGid" psData if ruid /= euid then hPrintf stderr "PID %s: RUID=%s, EUID=%s\n" pid ruid euid else return () hPrintf stderr "Killing proc %s (%s, UID=%s, GID=%s), child of %s\n" pid exe euid egid ppid hPrintf stderr " Process command line: %s\n" cmd hPrintf stderr " Process working directory: %s\n" cwd killTree :: KillFunction killTree tree pid = do let PsInfo psData children = mapLookup pid tree printWarnings pid psData signalProcess sigKILL (read pid) mapM_ (killTree tree) children killBastards :: PsTree -> Whitelist -> Int -> IO () killBastards tree whitelist n = do runAgain <- withEachBastard tree whitelist killTree if runAgain && n > 1 then do sleep 2 killBastards tree whitelist (n - 1) else return () -- Configuration printConfig :: KillFunction printConfig tree pid = do let PsInfo psData _ = mapLookup pid tree exe = mapLookup "Exe" psData euid = mapLookup "EUid" psData entry <- getUserEntryForID (read euid) putStrLn $ exe ++ ": " ++ (userName entry) -- main helpers config :: PsTree -> IO () config tree = do withEachBastard tree Map.empty printConfig return () pstree :: PsTree -> IO () pstree tree = do printTree tree "1" -- In newer kernels, process 2 is kthreadd, which is not a child -- of init. let info = mapLookup "2" tree if parentPid info /= "1" then printTree tree "2" else return () kill :: PsTree -> IO () kill tree = do whitelist <- readWhiteList "killbastards.conf" killBastards tree whitelist 5 main :: IO () main = do args <- getArgs tree <- createTree case args of ["config"] -> config tree ["pstree"] -> pstree tree [] -> kill tree

3 18

ANNOUNCE: pcre-light, a light, portable regular expression library for Haskell
by Don Stewart 12 Jan '08

12 Jan '08

pcre-light A light regular expression library, using Perl 5 compatible regexes I'm pleased to announce the first release of pcre-light. This library provides a simple, efficient interface to PCRE regular expressions, via either strict ByteStrings or classical Strings. Compilation and matching of regular expressions is done via two functions: compile :: ByteString -> [PCREOption] -> Either String Regex match :: Regex -> ByteString -> [PCREExecOption] -> Maybe [ByteString] A convenience interface for 'Char8' Strings is also provided. == Examples == Although the operations by default take ByteStrings, we can avoid unnecessary 'pack' calls using GHC's support for ByteStrings literals, enabled with -XOverloadedStrings: > :m + Text.Regex.PCRE.Light > :m + Data.ByteString.Char8 > :set -XOverloadedStrings > let Right r = compile "the quick brown fox" [] > match r "the quick brown fox" [] Just ["the quick brown fox"] > match r "the quick brown FOX" [] Nothing We can also enable various matching extensions, > let Right r = compile "the quick brown fox" [caseless] > match r "the quick brown FOX" [] Just ["the quick brown FOX"] Subpatterns, and fancy Perl regex extensions are happily supported: > let Right r = compile "^(abc){1,2}zz" [] > match r "abczz" [] Just ["abczz","abc"] Where the subpattern bound by ( ) was returned as the second element of the list. > let Right r = compile "\\w+(?=\t)" [] > match r "the quick brown\t fox" [] Just ["brown"] You can do lots of silly things with this: > let Right r = compile "^(a()+)+" [] > match r "aaaa" Just ["aaaa", "a", ""] The full set of compile and runtime PCRE extensions are supported. == Get it == * Stable tarballs, (on Hackage, of course): http://hackage.haskell.org/cgi-bin/hackage-scripts/package/pcre-light * Cabal install it! Using the new 'cabal-install', you can automatically download, build and install the package: $ cabal update $ cabal install pcre-light Downloading 'pcre-light-0.1'... Configuring pcre-light-0.1... Preprocessing library pcre-light-0.1... Building pcre-light-0.1... Registering pcre-light-0.1.. And off we go! For more information about cabal-install, see the hackage page for this excellent tool. * Darcs repository: http://code.haskell.org/~dons/code/pcre-light/ * Documentation: http://code.haskell.org/~dons/docs/pcre-light/ * Stability The library takes correctness seriously, and comes with a reasonable testsuite (with plans to greatly extend it), and code coverage data for those tests (using GHC's new -fhpc flag). You can see the test coverage results here: http://code.haskell.org/~dons/tests/pcre-light/hpc_index.html Yours in code, Don P.S. I'd like to encourage other authors to distribute code coverage results for their libraries! hpc is an invaluable tool to ensure high quality libraries for the Haskell community. P.P.S. Consider consider contributing your own light bindings to useful C libraries. The more we have, the more certain and sustainable Haskell development will be :) P.P.P.S. Thanks to #haskell for testing and advice.

1 0

the trivial monad- thoughts and a question
by Brian Hurt 12 Jan '08

12 Jan '08

So, I've been playing around with what I call the trivial monad: module TrivialMonad where data TrivialMonad a = M a recover :: TrivialMonad a -> a recover (M x) = x instance Monad TrivialMonad where (M x) >>= f = f x (M x) >> f = f return x = M x fail s = undefined This is actually a surprisingly usefull little sucker- it allows you to "demonadify" code. Which is usefull when you have some places where you want to use the code within a monad, and some places where you don't. You write the base bit of code monadically, and then demonadify it as needed. The first question I have is it is possible to implement this guy without wrapping the value in a constructor? What I'd like to do is replace the: data TrivialMonad a = M a with something like: type TrivialMonad a = a and then be able to junk the recover function. The second question I have is: is there any hope of getting something like this into the standard library? Thanks, Brian

5 4

ANN: Haskell Cryptographic Library 4.1.0
by Dominic Steinitz 12 Jan '08

12 Jan '08

I'd like to announce the release of a new version of the library following various contributions (contributors are bcc'd). Additions include: BubbleBabble, TEA, HMAC and more large word support. It no longer includes Base64. This is provided by http://hackage.haskell.org/cgi-bin/hackage-scripts/package/dataenc-0.10.1. Many thanks to all contributors. Dominic. PS I always mention this but the library really needs to be reviewed holistically and possibly restructured given the advent of bytestrings. If anyone would like to volunteer to do this or take over as library maintainer, please let me know.

1 0

Gtk2HS and GHC 6.8.2
by Peter Verswyvelen 12 Jan '08

12 Jan '08

It seems GHC 6.8.2 fixes a couple of bugs in GHC 6.8.1. Gtk2HS does not yet detect my GHC 6.8.2 installation, but I guess it is 100% compatible. Is it possible to get the Gtk2HS installer detect GHC 6.8.2? I'm on Windows. Thanks, Peter

2 2

Linq (FP in C#)
by Hugh Perkins 12 Jan '08

12 Jan '08

Linq went live in C# in November, as part of .Net 3.5. It adds lots of FP-things to C#. It's really fun to be able to use Haskell-ish things in C#. Manipulating lists and collections just got *much* easier. Things it does: - map, fold, filter are all there (they're called "select", "agregate", "where") - limited support for laziness (since .Net 2.0; you can write a lazy "zip" function; I couldnt figure out how to write a lazy "unzip" function) - you can extend the methods available on all lists and collections - lambda expressions - type inferrence (technically, this is part of .Net 3.x, rather than specific to Linq). Things it doesnt do: - recursion doesnt seem particularly optimized (quick 2 minute test, I could be wrong) - no way to enforce purity It's an interesting vindication of the ideas in Haskell that C#, a big mainstream language, has integrated ideas from it, and that they're in production today.

2 1

Typo in ByteString documentation
by Johan Tibell 12 Jan '08

12 Jan '08

In Data.ByteString.Unsafe in the documentation of unsafePackAddress the documentation reads: "Use unsafePackAddress if you know the length of the string statically." I assume that unsafePackAddressLen is the being function referred to here. If I was sitting in front of my laptop I would send you a patch. :) -- Johan

1 0

where is the FFI glue code for STM?
by Galchin Vasili 11 Jan '08

11 Jan '08

Hello, I see where the top level code (written in Haskell)for STM. I have found STM.c;however, I can't seem to find the FFI glue code.? Thanks, Vasili

2 1

Not to load Prelude
by Maurício 11 Jan '08

11 Jan '08

Hi, Is it possible not to load Prelude module when compiling a Haskell module? Or instruct ghc to “unload” it? Thanks, Maurício

8 11

Next PDXFunc Meeting (Portland/Oregon FP Group): Monday, January 14, 7pm, CubeSpace
by Don Stewart 11 Jan '08

11 Jan '08

Join us at the next meeting of pdxfunc, the Portland Functional Programming Study Group, on Monday, 14th January, at CubeSpace. ------------------------------------------------------------------------ We'll have presentations, demos and discussions. We welcome programmers interested in all functional languages and our meetings have content for coders of all skill levels. If interested, please also subscribe to our mailing list at http://groups.google.com/group/pdxfunc PRESENTATIONS (1) Justin Bailey: Exploring Haskell's space and time profiling tools A presentation on the space and time profiling tools available for GHC Haskell, featuring slides and interactive demos. Heap profiling tools and methods will be discussed, along with a demonstration of how to use them to detect a space leak. Time profiling tactics will be covered using "cost-centre" annotations to help select candidates for optimization. Recommendations will be given on how to read the "Core" language with an eye for optimization. Justin Bailey (jgbailey(a)gmail.com) has been programming professionally for 12 years, and is currently a Computer Science master's student at Portland State University. Until 2006, he coded exclusively with object-oriented languages like Java and C#, but then discovered Haskell and hasn't looked back. He's released a Haskell library for building command-line applications called HCL, made contributions to several other Haskell libraries, and continues to hack Haskell every day he can. (2) Iavor Diatchki: Writing parsing combinators with Haskell A presentation on parsing combinators, given as a hands-on demonstration for developing a small library to parse JSON data using Haskell. The entire process will be shown from scratch, starting with defining the concept of JSON values, using pretty-printer combinators to turn values into strings, and finally using parser combinators to turn strings into values. Iavor S. Diatchki is an engineer at Galois Inc., where he uses functional programming for the development of high assurance software. Iavor obtained his PhD degree in 2007. His research focused on various aspect of using functional languages for the development of low-level systems software such as OS kernels.

1 0