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