ネットワーク接続されたプリンタのステータスを取得するHaskellプログラム
[Ruby] ネットワーク接続されたプリンタのステータスを取得するプログラム
http://qiita.com/saltheads/items/69da23a5fd0013da21dc
をそのままHaskellに移植しました。
Haskellで以下のことをやっています。
- 16進文字列からByteStringに変換する処理
- UDPクライアントプログラム
- レスポンスがなかったときのタイムアウト処理
- ByteStringからIntやStringを取り出す処理
- 一定時間待ちをするsleep処理
- 指定した回数、IO aを繰り返し実行する処理
- アプリカティブを使用してできるだけdo構文を使わない書き方
- {-# OPTIONS -Wall -Werror #-}と hlint
ソースコード
SnmpClient.hs
{-# OPTIONS -Wall -Werror #-}
module Main where
---------------------------------------------------------------
-- | アプリカティブ
import Control.Applicative hiding ((<|>),many)
import Control.Monad (when)
-- | パケットの送受信に ByteString.Char8 を使用する
import Network.Socket hiding (sendTo,recvFrom)
import Network.Socket.ByteString
import qualified Data.ByteString.Char8 as B
import Data.Char (chr, ord)
import System.Timeout (timeout)
import Control.Concurrent (threadDelay)
import Numeric (readHex)
---------------------------------------------------------------
-- | SNMPパケットの型と処理
type HexPacket = String
-- | 16進文字列を バイナリパケットに変換する
encodeRequest :: HexPacket -> B.ByteString
encodeRequest = B.pack . hexPacket2str
where hexPacket2str = map (chr . fst . head . readHex) . words
-- | convert big-endian ByteString to Int
big :: B.ByteString -> Int
big = B.foldl (\a c -> a*256 + ord c) 0
-----------------------------------
-- | SNMP GetRequest パケット
sysName :: HexPacket
sysName = "30 27 "
++ "02 01 00 "
++ "04 06 70 75 62 6c 69 63 "
++ "a0 1a "
++ "02 02 03 e8 "
++ "02 01 00 "
++ "02 01 00 "
++ "30 0e "
++ "30 0c "
++ "06 08 2b 06 01 02 01 01 05 00 "
++ "05 00 "
-- | SNMP レスポンスからsysNameを得てStringにして返す
decodeSysName :: B.ByteString -> String
decodeSysName s =
"sysName[" ++ name ++ "]"
where n = big . B.take 1 $ B.drop 40 s
name = B.unpack . B.take n $ B.drop 41 s
-----------------------------------
-- | SNMP GetRequest パケット
sysUpTime :: HexPacket
sysUpTime = "30 27 "
++ "02 01 00 "
++ "04 06 70 75 62 6c 69 63 "
++ "a0 1a "
++ "02 02 03 e9 "
++ "02 01 00 "
++ "02 01 00 "
++ "30 0e "
++ "30 0c "
++ "06 08 2b 06 01 02 01 01 03 00 "
++ "05 00 "
-- | SNMP レスポンスからsysUpTimeを得てStringにして返す
decodeSysUpTime :: B.ByteString -> String
decodeSysUpTime s =
"sysUpTime[" ++ show time ++ "]"
where time = big . B.take 3 $ B.drop 41 s
-----------------------------------
-- | SNMP GetRequest パケット
hrDeviceStatus :: HexPacket
hrDeviceStatus = "30 2A "
++ "02 01 00 "
++ "04 06 70 75 62 6c 69 63 "
++ "a0 1d "
++ "02 02 03 ea "
++ "02 01 00 "
++ "02 01 00 "
++ "30 11 "
++ "30 0f "
++ "06 0b 2b 06 01 02 01 19 03 02 01 05 01 "
++ "05 00 "
-- | SNMP レスポンスからhrDeviceStatusを得てStringにして返す
decodeHrDeviceStatus :: B.ByteString -> String
decodeHrDeviceStatus s =
"deviceStatus[" ++ status ++ "]"
where st = big . B.take 1 $ B.drop 44 s
status = case st of
1 -> "unknown(1)"
2 -> "running(2)"
3 -> "warning(3)"
4 -> "testing(4)"
5 -> "down(5)"
_ -> "other(" ++ show st ++ ")"
-----------------------------------
-- | SNMP GetRequest パケット
hrPrinterStatus :: HexPacket
hrPrinterStatus = "30 2A "
++ "02 01 00 "
++ "04 06 70 75 62 6c 69 63 "
++ "a0 1d "
++ "02 02 03 eb "
++ "02 01 00 "
++ "02 01 00 "
++ "30 11 "
++ "30 0f "
++ "06 0b 2b 06 01 02 01 19 03 05 01 01 01 "
++ "05 00 "
-- | SNMP レスポンスからhrDeviceStatusを得てStringにして返す
decodeHrPrinterStatus :: B.ByteString -> String
decodeHrPrinterStatus s =
"printerStatus[" ++ status ++ "]"
where st = big . B.take 1 $ B.drop 44 s
status = case st of
1 -> "other(1) (error)"
3 -> "idle(3)"
4 -> "printing(4)"
5 -> "warmup(5)"
_ -> "unknown(" ++ show st ++ ")"
-----------------------------------
-- | printerアドレス (SNMPサーバ)
lp2500,pxb750f :: String
lp2500 = "10.0.1.99" -- LP-2500 laser
pxb750f = "10.0.1.98" -- PX-B750F inkjet
printer :: IO String
printer = return lp2500
-- | SNMPポート
port :: PortNumber
port = 161
-- | SNMPクライアント (UDPクライアント)
snmpClient :: String -> HexPacket -> (B.ByteString -> String) -> IO String
snmpClient server hexPacket decoder = withSocketsDo $ do
(serveraddr:_) <- getAddrInfo Nothing (Just server) (Just "snmp")
let host = takeWhile (/=':') . show $ addrAddress serveraddr
hostAddr <- inet_addr host
soc <- socket AF_INET Datagram defaultProtocol
let req = encodeRequest hexPacket
_ <- sendTo soc req (SockAddrInet port hostAddr)
tpl <- timeout (3*1000*1000) $ recvFrom soc 256
close soc
case tpl of
Just (response, _) -> return $ decoder response
Nothing -> return "Timeout Error"
-- | SNMPで３つの値を取得して表示する
getThree :: IO ()
getThree = printer >>= (\server ->
glue <$> snmpClient server sysUpTime decodeSysUpTime
<*> snmpClient server hrDeviceStatus decodeHrDeviceStatus
<*> snmpClient server hrPrinterStatus decodeHrPrinterStatus
) >>= putStrLn
where glue a b c = unwords [a,b,c]
-- | SNMPでsysNameを取得して表示する
getName :: IO ()
getName = printer
>>= (\server -> snmpClient server sysName decodeSysName)
>>= putStrLn
-- | IO aなmをn回繰り返し実行する
times :: Int -> IO a -> IO ()
times n m = when (n > 0) $ m >> times (n-1) m
-- | メイン
main :: IO ()
main = getName
>> times 10 (getThree >> threadDelay (1000*1000))
実行例
紙ありから、紙切れにしたあと、紙をセットし、印刷したようす。
result.txt
sysUpTime[3421] deviceStatus[running(2)] printerStatus[idle(3)]
sysUpTime[3523] deviceStatus[running(2)] printerStatus[idle(3)]
sysUpTime[3625] deviceStatus[running(2)] printerStatus[idle(3)]
sysUpTime[35036] deviceStatus[down(5)] printerStatus[other(1) (error)]
sysUpTime[35138] deviceStatus[down(5)] printerStatus[other(1) (error)]
sysUpTime[35241] deviceStatus[down(5)] printerStatus[other(1) (error)]
sysUpTime[261970] deviceStatus[running(2)] printerStatus[warmup(5)]
sysUpTime[262071] deviceStatus[running(2)] printerStatus[warmup(5)]
sysUpTime[262173] deviceStatus[running(2)] printerStatus[warmup(5)]
sysUpTime[263456] deviceStatus[running(2)] printerStatus[printing(4)]
sysUpTime[263560] deviceStatus[running(2)] printerStatus[printing(4)]
sysUpTime[263661] deviceStatus[running(2)] printerStatus[printing(4)]
sysUpTime[263763] deviceStatus[running(2)] printerStatus[printing(4)]
sysUpTime[263865] deviceStatus[running(2)] printerStatus[idle(3)]
sysUpTime[263966] deviceStatus[running(2)] printerStatus[idle(3)]
私の手持ちのプリンター EPSON LP-2500では、
印刷できないときに、deviceStatusがdown(5)となり、
印刷中か印刷すべきものが残っているときに、printerStatusがprinting(4)となる。
1dcf80440d00