1 ! Copyright (C) 2010 John Benediktsson
2 ! See http://factorcode.org/license.txt for BSD license
4 USING: accessors arrays calendar combinators destructors
5 fry formatting kernel io io.sockets math pack random
12 CONSTANT: REQUEST B{ 0x1b 0 0 0 0 0 0 0
13 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
14 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
17 : (time) ( sequence -- timestamp )
18 [ first ] [ second 32 2^ / ] bi + seconds
19 1900 1 1 0 0 0 instant <timestamp> time+ ;
21 : (leap) ( leap -- string/f )
23 { 0 [ "no warning" ] }
24 { 1 [ "last minute has 61 seconds" ] }
25 { 2 [ "last minute has 59 seconds" ] }
26 { 3 [ "alarm condition (clock not synchronized)" ] }
30 : (mode) ( mode -- string )
32 { 0 [ "unspecified" ] }
33 { 1 [ "symmetric active" ] }
34 { 2 [ "symmetric passive" ] }
38 { 6 [ "reserved for NTP control message" ] }
39 { 7 [ "reserved for private use" ] }
43 : (stratum) ( stratum -- string )
45 { 0 [ "unspecified or unavailable" ] }
46 { 1 [ "primary reference (e.g., radio clock)" ] }
48 [ 1 > ] [ 255 < ] bi and
49 [ "secondary reference (via NTP or SNTP)" ]
50 [ "invalid stratum" throw ] if
54 : (ref-id) ( ref-id stratum -- string )
57 [ -24 shift 0xff bitand ]
58 [ -16 shift 0xff bitand ]
59 [ -8 shift 0xff bitand ]
63 { 0 [ "%c%c%c%c" sprintf ] }
64 { 1 [ "%c%c%c%c" sprintf ] }
66 [ 1 > ] [ 255 < ] bi and
67 [ "%d.%d.%d.%d" sprintf ]
68 [ "invalid stratum" throw ] if
72 TUPLE: ntp leap version mode stratum poll precision
73 root-delay root-dispersion ref-id ref-timestamp
74 orig-timestamp recv-timestamp tx-timestamp ;
76 : (ntp) ( payload -- ntp )
77 "CCCcIIIIIIIIIII" unpack-be {
78 [ first -6 shift 0x3 bitand ] ! leap
79 [ first -3 shift 0x7 bitand ] ! version
80 [ first 0x7 bitand ] ! mode
83 [ [ 3 ] dip nth ] ! precision
84 [ [ 4 ] dip nth 16 2^ / ] ! root-delay
85 [ [ 5 ] dip nth 16 2^ / ] ! root-dispersion
86 [ [ 6 ] dip nth ] ! ref-id
87 [ [ { 7 8 } ] dip nths (time) ] ! ref-timestamp
88 [ [ { 9 10 } ] dip nths (time) ] ! orig-timestamp
89 [ [ { 11 12 } ] dip nths (time) ] ! recv-timestamp
90 [ [ { 13 14 } ] dip nths (time) ] ! tx-timestamp
92 dup stratum>> '[ _ (ref-id) ] change-ref-id
93 [ dup (leap) 2array ] change-leap
94 [ dup (mode) 2array ] change-mode
95 [ dup (stratum) 2array ] change-stratum ;
101 ! - format request properly?
102 ! - strftime should format millis?
103 ! - why does <inet4> resolve-host not work?
105 : <ntp> ( host -- ntp )
106 123 <inet> resolve-host [ inet4? ] filter random
107 f 0 <inet4> <datagram> [
108 [ REQUEST ] 2dip [ send ] [ receive drop ] bi (ntp)
111 : default-ntp ( -- ntp )
112 "pool.ntp.org" <ntp> ;
114 : local-ntp ( -- ntp )