[Ruby][Haskell] SNTPクライアントを書くその１ #Ruby

同じことをするプログラムを２つの言語で書いてみるといろいろ発見があって面白い。

echoサーバ/クライアントやhttpクライアントなどテキストデータでやりとりするネットワークプログラムはネットに多く見つかる。

そこで今回はバイナリデータを扱うネットワークプログラムを書いてみようと思い、もっとも簡単な例として、日本標準時を取得するSNTPクライアントを書いてみることにした。バイナリデータを送受信するUDPクライアントである。

まず、SNTPプロトコルの仕様をRFCで読んで理解し、Rubyで書いて動作を確認する。

QiitaSntpClient.rb

# coding: utf-8
# sntp sample program

require 'socket'

# send udp packet to ntp server and receive a response
us = UDPSocket.open()
host = "ntp.nict.jp" # 日本標準時 NTPサーバ
port = 123
us.connect(host,port)
request = "\x0b" +  "\x00" * 47
us.send(request, 0)
a = select([us],nil,nil,3)
if not a then  # Timeout
  us.close
  raise "Timeout" 
end
response = us.recv(256,0)
us.close

# transmit_timestamp_seconds
# 4文字のStringをビッグエンディアンで32ビット整数に
secs = response[40..43].unpack("N1")[0]    

# SNTPでは1900年からの秒数が返ってくるので、
# それを1970年からの秒数に変換するために70年分引く
seventy_years = Time.utc(1970,1,1).to_i - Time.utc(1900,1,1).to_i
epoc_time = secs - seventy_years   # 1970/01/01からの秒数に変換
printf("epoc_time [#{epoc_time}]\n")

# 1970年からの秒数でTimeオブジェクトを作る。時差は環境が知っている。
utc = Time.at(epoc_time)
printf("utc       [#{utc}]\n")
ntp_time = utc.strftime("%Y/%m/%d %H:%M:%S %z")
printf("format    [#{ntp_time}]\n")

# 比較のためPC時刻を取得する
pc_time = Time.now.strftime("%Y/%m/%d %H:%M:%S %z")
printf("pc_time   [#{pc_time}]\n")

動作確認 (Windows 7)

C:\>ruby -v
ruby 2.0.0p481 (2014-05-08) [i386-mingw32]

C:\>ruby -w qiita_sntp_client.rb
epoc_time [1409664608]
utc       [2014-09-02 22:30:08 +0900]
format    [2014/09/02 22:30:08 +0900]
pc_time   [2014/09/02 22:30:07 +0900]

動作確認 (MacOS 10.9.4)

$ ruby -v
ruby 2.0.0p451 (2014-02-24 revision 45167) [universal.x86_64-darwin13]

$ ruby -w qiita_sntp_client.rb 
epoc_time [1409664827]
utc       [2014-09-02 22:33:47 +0900]
format    [2014/09/02 22:33:47 +0900]
pc_time   [2014/09/02 22:33:47 +0900]

SNTPはSimple NTPで、48バイトのリクエストを送り、48バイトのレスポンスを受け取るだけのSimpleプロトコルである。これをHaskellに移植する。

NonApplicativeSntpClient.hs


{-# OPTIONS -Wall -Werror #-}
module Main where
-- | NTPパケットの送受信に 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 Data.Time.Clock
import Data.Time.Format
import Data.Time.Calendar
import Data.Time.LocalTime
import System.Locale

-- | convert big-endian ByteString to Int
big :: B.ByteString -> Int
big = B.foldl (\a c -> a*256 + ord c) 0

-- | NTP リクエスト
request :: B.ByteString
request = B.pack $ map chr (0x0b:replicate 47 0)

-- | NTP レスポンスからtransmit_timestamp_secondsを得る
getSeconds :: B.ByteString -> Int
getSeconds = big . B.take 4 . B.drop 40

-- | 70年分の秒数
seventyYears :: Int
seventyYears = (*) (24*60*60::Int) (fromInteger days)
                where days = diffDays (fromGregorian 1970 1 1) 
                                      (fromGregorian 1900 1 1)

-- | サーバ名型
type ServerName = String

-- | NTPサーバ
server1 :: ServerName
server1 = "ntp.nict.jp" -- | 日本標準時 NTPサーバ
-- server1 = "10.8.24.1"   -- intranet router

-- | NTPポート
port1 :: PortNumber
port1 = 123

-- | 名前解決
getHostAddr :: ServerName -> IO HostAddress
getHostAddr server = do
        (serveraddr:_) <- getAddrInfo Nothing (Just server) (Just "ntp")
        let host = takeWhile (/=':') . show $ addrAddress serveraddr
        inet_addr host

-- | SNTPクライアント (UDPクライアント)
-- | withSocketsDo :: IO a -> IO a
sntpClient :: ServerName -> PortNumber -> IO ()
sntpClient server port = withSocketsDo $ do
        hostAddr <- getHostAddr server
        soc <- socket AF_INET Datagram defaultProtocol
        _ <- sendTo soc request (SockAddrInet port hostAddr)
        (response,　_) <- recvFrom soc 256
        close soc
        -- | SNTPでは1900年からの秒数が返ってくるので、
        -- | それを1970年からの秒数に変換するために70年分引く
        let epocTime = getSeconds response - seventyYears
        showTime epocTime

-- | 時刻表示フォーマット
format :: UTCTime -> String
format = formatTime defaultTimeLocale "%Y/%m/%d %H:%M:%S"

-- | 時刻表示
showTime :: Int -> IO ()
showTime epocTime = do
        putStrLn $ "epocTime   [" ++ show epocTime ++ "]"
        -- | UTCTimeを作る
        -- | readTime :: ParseTime t => TimeLocale -> String -> String -> t
        let utcTime = readTime defaultTimeLocale "%s" (show epocTime) :: UTCTime
        putStrLn $ "utc        [" ++ show utcTime ++ "]"
        -- | Asia/Tokyoの時差9時間を足す
        -- | addUTCTime :: NominalDiffTime -> UTCTime -> UTCTime
        let zoned = addUTCTime (9*60*60) utcTime
        putStrLn $ "format     [" ++ format zoned ++ "]"

-- | PCの時刻取得
-- | formatTime :: FormatTime t => TimeLocale -> String -> t -> String
zonedTime :: IO String
zonedTime = do z <- getZonedTime
               return $ formatTime defaultTimeLocale "%Y/%m/%d %H:%M:%S %z" z

-- | PCの時刻取得
currentTime :: IO String
currentTime = do z <- getCurrentTime
                 return $ formatTime defaultTimeLocale "%Y/%m/%d %H:%M:%S %z" z

-- | メイン
main  :: IO ()
main  = do sntpClient server1 port1
           z <- zonedTime
           putStrLn $ "pc_zoned   [" ++ z ++ "]"
           c <- currentTime
           putStrLn $ "pc_current [" ++ c ++ "]"

動作確認 (Windows 7)


C:\>runghc --version
runghc 7.8.3

C:\>runghc NonApplicativeSntpClient.hs
epocTime   [1409665324]
utc        [2014-09-02 13:42:04 UTC]
format     [2014/09/02 22:42:04]
pc_zoned   [2014/09/02 22:42:03 +0900]
pc_current [2014/09/02 13:42:03 +0000]

この時送信したネットワークパケット
00000000: 0B 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00   ................
00000010: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00   ................
00000020: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00   ................

この時受信したネットワークパケット
00000000: 0C 01 00 EC 00 00 00 00 00 00 00 00 4E 49 43 54   ............NICT
00000010: D7 B0 47 AC 00 00 00 00 00 00 00 00 00 00 00 00   ..G.............
00000020: D7 B0 47 AC 1A 29 FE C5 D7 B0 47 AC 1A 2A 0C 42   ..G..)....G..*.B

動作確認 (MacOS 10.9.4)


$ hlint NonApplicativeSntpClient.hs 
No suggestions

$ runghc --version
runghc 7.8.3

$ runghc NonApplicativeSntpClient.hs
epocTime   [1409665697]
utc        [2014-09-02 13:48:17 UTC]
format     [2014/09/02 22:48:17]
pc_zoned   [2014/09/02 22:48:17 +0900]
pc_current [2014/09/02 13:48:17 +0000]

わかったこと

初めてByteStringを使ったプログラムを書いた。Network.Socket にある sendTo,recvFrom はStringを送受信するものだが、Network.Socket.ByteString にある sendTo,recvFrom を使えばByteStringを送受信できる。

できていないところ

サーバの名前解決ができなくて例外が投げられたときの処理や、一定時間以内にレスポンスが返ってこなかったときの処理や、そもそも例外じゃなくてMaybeモナドとか使って美しくHaskellらしく書くこと。

わからないところ

Rubyでは、メインプログラム部分を「if __FILE__ == $0 ～ end」で囲むとコマンドとしてもライブラリとしても使えるrbファイルを作ることができる。これと同等のことをHaskellでやりたいが、他のプログラムからimportされても、単独でもrunghcで実行できるhsファイルを書く方法がわからなかった。
Haskellで、UTCTimeを時差付きで、+0900付きで表示させる方法がわからなかった。プログラムでは9時間分足してごまかしたが、UTCをシステムが知っている時差で表示する方法がわからない。
Qiitaの投稿画面で、この文章を書いている下に、「画像を選択またはドラッグ＆ドロップ-100MB/100MB」と表示されている。状態マシン図の記事で画像を貼り付けすぎたため100%になっちゃったらしいが、私はもう画像を貼り付けた記事が書けないのだろうか。

前もってありがとうございます。

[Ruby][Haskell] SNTPクライアントを書く その１

[Ruby][Haskell] SNTPクライアントを書くその１