Jobs

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
{-# LANGUAGE ImpredicativeTypes #-}
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)

-----------------------------------------------------------------------------------

{-# LANGUAGE DeriveDataTypeable, TypeSynonymInstances, FlexibleInstances, OverlappingInstances #-}
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