summaryrefslogtreecommitdiff
path: root/Utility/Lsof.hs
blob: 1aa620e2d198249fc4516773283b61208fc5c867 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
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