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
72
73
74
75
76
77
78
79
80
|
module Magicloud.Jobs where
import Control.Concurrent
import Control.Exception
import qualified Data.Map as M
import qualified Magicloud.Map as Map
import qualified Control.Concurrent.MVar.ReadOnly as ROMVar
data JobInfo a e = JobInfo { jobId :: ThreadId
, status :: ROMVar.ReadOnlyMVar (Either e a) }
type Jobs k e a = M.Map k (JobInfo a e)
type JobArgs k a = M.Map k a
type JobResults k e a = M.Map k (Either e a)
start :: (Ord k, Exception e) => JobArgs k a -> (a -> IO b) -> IO (Jobs k e b)
start args worker = mask_ $ do
arg <- newEmptyMVar
Map.mapM (\a -> do
putMVar arg a
res <- newEmptyMVar
tId <- forkIOWithUnmask $ \unmask -> do
arg_ <- takeMVar arg
res_ <- try $ unmask $ worker arg_
putMVar res res_
return $ JobInfo tId $ ROMVar.toReadOnlyMVar res
) args
wait :: (Ord k, Exception e) => Jobs k e a -> IO (M.Map k (Either e a))
wait = Map.mapM (ROMVar.takeMVar . status)
module Magicloud.Snmp where
import Control.Exception
import Data.Char
import Network (PortNumber, HostName)
import Network.Protocol.NetSNMP
import Data.List
import Data.Typeable
import Magicloud.Jobs
import qualified Data.Map as M
data Service = Service { protocol :: Protocol
, host :: HostName
, port :: PortNumber }
instance Show Service where
show (Service pro hos por) = intercalate ":" [ map toLower $ show pro
, hos
, show por ]
data Protocol = UDP
| TCP
deriving (Show)
type OID = [Int]
instance Show OID where
show o = intercalate "." $ map show o
data SnmpException = SnmpException { message :: String }
deriving (Show, Typeable)
instance Exception SnmpException
get :: Service -> SnmpVersion -> Community -> OID -> IO SnmpResult
get ser ver com oid_ = do
result <- snmpGet ver (show ser) com (show oid_)
case result of
Left msg -> throw (SnmpException msg)
Right result_ -> return result_
pGet :: Service -> SnmpVersion -> Community -> [OID] -> IO (M.Map OID (Either SnmpException SnmpResult))
pGet ser ver com oids =
(start ((M.fromList $ zip oids oids) :: JobArgs OID OID) $ get ser ver com) >>=
wait
|