add

Utility/Lsof.hs

@@ -0,0 +1,71 @@
+{- lsof interface
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+{-# LANGUAGE BangPatterns #-}
+
+module Utility.Lsof where
+
+import Common
+
+import System.Cmd.Utils
+import System.Posix.Types
+
+data OpenMode = ReadWrite | ReadOnly | WriteOnly | Unknown
+
+type CmdLine = String
+
+data ProcessInfo = ProcessInfo ProcessID CmdLine
+
+query :: FilePath -> IO [(FilePath, OpenMode, ProcessInfo)]
+query p = do
+	(h, s) <- pipeFrom "lsof" ["-F0can", "--", p]
+	!r <- parse s
+	forceSuccess h
+	return r
+
+{- Parsing null-delimited output like:
+ -
+ - pPID\0cCMDLINE\0
+ - aMODE\0nFILE\0
+ - aMODE\0nFILE\0
+ - pPID\0[...]
+ -
+ - Where each new process block is started by a pid, and a process can
+ - have multiple files open.
+ -}
+parse :: String -> [(FilePath, OpenMode, ProcessInfo)]
+parse s = go [] $ lines s
+	where
+		go c [] = c
+		go c (l@(t:r):ls)
+			| t == 'p' = parseprocess r
+			| otherwise = parsefail
+		go _ _ = parsefail
+
+		parseprocess l =
+			case splitnull l of
+				[pid, 'c':cmdline] ->
+					case readish pid of
+						(Just n) -> ProcessInfo n cmdline
+						Nothing -> parsefail
+				_ -> parsefail
+
+		parsefile l =
+			case splitnull l of
+				['a':mode, 'n':file] -> (file, parsemode mode)
+				_ -> parsefail
+
+		parsemode ('r':_) = ReadOnly
+		parsemode ('w':_) = WriteOnly
+		parsemode ('u':_) = ReadWrite
+		parsemode _ = Unknown
+
+		ls = lines s
+
+		splitnull = split "\0"
+
+		parsefail = error "failed to parse lsof output: " ++ show s