1
1
-module (grisp_connect_ntp ).
2
2
3
- % API
3
+ -behaviour (gen_statem ).
4
+
5
+ -include_lib (" kernel/include/logger.hrl" ).
6
+
7
+
8
+ % --- Exports -------------------------------------------------------------------
9
+
10
+ % API functions
4
11
-export ([start_link /0 ]).
5
12
-export ([get_time /0 , get_time /1 ]).
6
13
7
- -behaviour (gen_statem ).
8
- -export ([init /1 , terminate /3 , code_change /4 , callback_mode /0 , handle_event /4 ]).
14
+ % Behaviour gen_statem callback functions
15
+ -export ([callback_mode /0 ]).
16
+ -export ([init /1 ]).
9
17
10
- - define ( NTP_PORT , 123 ). % udp
11
- -define ( SERVER_TIMEOUT , 5000 ). % ms
12
- -define ( EPOCH , 2208988800 ). % offset yr 1900 to unix epochù
13
- -define ( RETRY_TIMEOUT , 1000 ).
18
+ % Behaviour gen_statem states callback functions
19
+ -export ([ waiting_ip / 3 ]).
20
+ -export ([ refresh_time / 3 ]).
21
+ -export ([ ready / 3 ] ).
14
22
15
- -include_lib (" kernel/include/logger.hrl" ).
16
23
24
+ % --- Types ---------------------------------------------------------------------
25
+
26
+ -record (data , {
27
+ retry_count = 0 :: non_neg_integer ()
28
+ }).
29
+
30
+
31
+ % --- Macros --------------------------------------------------------------------
32
+
33
+ -define (NTP_PORT , 123 ). % NTP's UDP port
34
+ -define (EPOCH , 2208988800 ). % offset yr 1900 to unix epochù
35
+
36
+ -define (HANDLE_COMMON ,
37
+ ? FUNCTION_NAME (EventType , EventContent , Data ) ->
38
+ handle_common (EventType , EventContent , ? FUNCTION_NAME , Data )).
17
39
18
40
19
- % API
41
+ % --- API FUNCTIONS -------------------------------------------------------------
20
42
21
43
start_link () ->
22
44
gen_statem :start_link ({local , ? MODULE }, ? MODULE , [], []).
@@ -27,82 +49,134 @@ get_time() ->
27
49
get_time (Host ) ->
28
50
gen_statem :call (? MODULE , {? FUNCTION_NAME , Host }).
29
51
30
- % gen_statem CALLBACKS ---------------------------------------------------------
31
52
32
- init ([]) -> { ok , waiting_ip , []}.
53
+ % --- BEHAVIOUR gen_statem CALLBACK FUNCTIONS -----------------------------------
33
54
34
- terminate ( _Reason , _State , _Data ) -> ok .
55
+ callback_mode ( ) -> [ state_functions , state_enter ] .
35
56
36
- code_change ( _Vsn , State , Data , _Extra ) -> {ok , State , Data }.
57
+ init ([] ) -> {ok , waiting_ip , # data {} }.
37
58
38
- callback_mode () -> [handle_event_function , state_enter ].
39
59
40
- % %% STATE CALLBACKS ------------------------------------------------------------
41
60
42
- handle_event ({call , From }, {get_time , _ }, State , Data ) when State =/= ready ->
43
- {keep_state , Data , [{reply , From , {error , State }}]};
61
+ % --- BEHAVIOUR gen_statem STATES CALLBACK FUNCTIONS -----------------------------
44
62
45
- handle_event (enter , _OldState , ready , Data ) ->
46
- {keep_state , Data };
47
- handle_event ({call , From }, {get_time , Host }, ready , Data ) ->
48
- {keep_state , Data , [{reply , From , do_get_time (Host )}]};
49
-
50
- handle_event (enter , _OldState , waiting_ip , Data ) ->
51
- {next_state , waiting_ip , Data , [{state_timeout , ? RETRY_TIMEOUT , retry }]};
52
- handle_event (state_timeout , retry , waiting_ip , Data ) ->
53
- case check_inet_ipv4 () of
54
- true ->
55
- ? LOG_INFO (" ip detected, tryng to contact ntp server..." ),
56
- {next_state , waiting_server , Data };
57
- false ->
58
- {next_state , waiting_ip , Data ,
59
- [{state_timeout , ? RETRY_TIMEOUT , retry }]}
63
+ waiting_ip (enter , _OldState , _Data ) ->
64
+ % First IP check do not have any delay
65
+ {keep_state_and_data , [{state_timeout , 0 , check_ip }]};
66
+ waiting_ip (state_timeout , check_ip , Data ) ->
67
+ case grisp_connect_utils :check_inet_ipv4 () of
68
+ {ok , _IP } -> {next_state , refresh_time , Data };
69
+ invalid -> {keep_state_and_data , [{state_timeout , 1000 , check_ip }]}
60
70
end ;
61
-
62
- handle_event (enter , _OldState , waiting_server , Data ) ->
63
- {next_state , waiting_server , Data ,
64
- [{state_timeout , ? RETRY_TIMEOUT , retry }]};
65
- handle_event (state_timeout , retry , waiting_server , Data ) ->
66
- try
67
- set_current_time (),
68
- ? LOG_INFO (" Grisp clock set!" ),
69
- {next_state , ready , Data }
70
- catch
71
- Ex :Er ->
72
- ? LOG_ERROR (" ntp request failed: ~p , ~p " ,[Ex ,Er ]),
73
- {next_state , waiting_server , Data ,
74
- [{state_timeout , ? RETRY_TIMEOUT , retry }]}
71
+ ? HANDLE_COMMON .
72
+
73
+ refresh_time (enter , _OldState , # data {retry_count = RetryCount }) ->
74
+ Delay = grisp_connect_utils :retry_delay (RetryCount ),
75
+ {keep_state_and_data , [{state_timeout , Delay , request_time }]};
76
+ refresh_time (state_timeout , request_time ,
77
+ Data = # data {retry_count = RetryCount }) ->
78
+ NTPServer = random_ntp_server (),
79
+ case refresh_current_time (NTPServer ) of
80
+ {error , Reason } ->
81
+ ? LOG_INFO (" Failed to get time from NTP server ~s : ~w " ,
82
+ [NTPServer , Reason ]),
83
+ {next_state , waiting_ip , Data # data {retry_count = RetryCount + 1 }};
84
+ {ok , Datetime } ->
85
+ ? LOG_NOTICE (" GRiSP clock set from NTP to ~s " ,
86
+ [format_datetime (Datetime )]),
87
+ {next_state , ready , Data # data {retry_count = 0 }}
75
88
end ;
76
-
77
- handle_event ( E , OldS , NewS , Data ) ->
78
- ? LOG_WARNING (" Unhandled Event = ~p , OldS = ~p , NewS = ~p " ,[E , OldS , NewS ]),
79
- {keep_state , Data }.
80
-
81
- % INTERNALS --------------------------------------------------------------------
82
-
83
- set_current_time () ->
84
- Time = do_get_time (random_ntp_server ()),
85
- RefTS1970 = round (proplists :get_value (receiveTimestamp , (tuple_to_list (Time )))),
86
- CurrSecs = calendar :datetime_to_gregorian_seconds ({{1970 , 1 , 1 }, {0 , 0 , 0 }}) + RefTS1970 ,
87
- CurrDateTime = calendar :gregorian_seconds_to_datetime (CurrSecs ),
88
- grisp_rtems :clock_set ({CurrDateTime , 0 }).
89
+ ? HANDLE_COMMON .
90
+
91
+ ready (enter , _OldState , _Data ) ->
92
+ Period = refresh_period (),
93
+ ? LOG_DEBUG (" Schedule NTP time refresh in ~w seconds" , [Period ]),
94
+ {keep_state_and_data , [{state_timeout , Period * 1000 , refresh_time }]};
95
+ ready ({call , From }, {get_time , Host }, _Data ) ->
96
+ Reply = case do_get_time (Host ) of
97
+ {error , _Reason } = Error -> Error ;
98
+ {ok , Time } -> {ok , Time }
99
+ end ,
100
+ {keep_state_and_data , [{reply , From , Reply }]};
101
+ ready (state_timeout , refresh_time , Data ) ->
102
+ {next_state , refresh_time , Data };
103
+ ? HANDLE_COMMON .
104
+
105
+ handle_common ({call , _From }, {get_time , _Host }, _State , _Data ) ->
106
+ {keep_state_and_data , [postpone ]};
107
+ handle_common ({call , From }, Msg , State , _Data ) ->
108
+ ? LOG_WARNING (" Unexpected call from ~w in state ~w : ~w " ,
109
+ [From , State , Msg ]),
110
+ {keep_state_and_data , [{reply , From , {error , unexpected_call }}]};
111
+ handle_common (cast , Msg , State , _Data ) ->
112
+ ? LOG_WARNING (" Unexpected cast in state ~w : ~w " , [State , Msg ]),
113
+ keep_state_and_data ;
114
+ handle_common (info , Msg , State , _Data ) ->
115
+ ? LOG_DEBUG (" Unexpected message in state ~w : ~w " , [State , Msg ]),
116
+ keep_state_and_data .
117
+
118
+
119
+ % --- INTERNAL FUNCTIONS --------------------------------------------------------
120
+
121
+ format_datetime ({{Year , Month , Day }, {Hour , Min , Sec }}) ->
122
+ iolist_to_binary (io_lib :format (
123
+ " ~4..0B -~2..0B -~2..0B ~2..0B :~2..0B :~2..0B " ,
124
+ [Year , Month , Day , Hour , Min , Sec ]
125
+ )).
126
+
127
+ refresh_current_time (NTPServer ) ->
128
+ case do_get_time (NTPServer ) of
129
+ {error , _Reason } = Error -> Error ;
130
+ {ok , Time } ->
131
+ try
132
+ RefTS1970 = round (proplists :get_value (receiveTimestamp , (tuple_to_list (Time )))),
133
+ CurrSecs = calendar :datetime_to_gregorian_seconds ({{1970 , 1 , 1 }, {0 , 0 , 0 }}) + RefTS1970 ,
134
+ CurrDateTime = calendar :gregorian_seconds_to_datetime (CurrSecs ),
135
+ grisp_rtems :clock_set ({CurrDateTime , 0 }),
136
+ {ok , CurrDateTime }
137
+ catch
138
+ _ :Reason -> {error , Reason }
139
+ end
140
+ end .
89
141
90
142
ntp_servers () ->
91
- [" 0.europe.pool.ntp.org" ].
143
+ {ok , NTPServers } = application :get_env (grisp_connect , ntp_servers ),
144
+ NTPServers .
145
+
146
+ % NTP refresh perido in seconds
147
+ refresh_period () ->
148
+ {ok , Period } = application :get_env (grisp_connect , ntp_refresh_period ),
149
+ Period .
92
150
93
151
random_ntp_server () ->
94
152
lists :nth (rand :uniform (length (ntp_servers ())), ntp_servers ()).
95
153
96
154
do_get_time (Host ) ->
97
- Resp = ntp_request (Host , create_ntp_request ()),
98
- process_ntp_response (Resp ) .
155
+ case ntp_request (Host , create_ntp_request ()) of
156
+ {error , _Reason } = Error -> Error ;
157
+ {ok , Resp } ->
158
+ try process_ntp_response (Resp ) of
159
+ Time -> {ok , Time }
160
+ catch _ :Reason ->
161
+ {error , Reason }
162
+ end
163
+ end .
99
164
100
165
ntp_request (Host , Binary ) ->
101
- {ok , Socket } = gen_udp :open (0 , [binary , {active , false }]),
102
- gen_udp :send (Socket , Host , ? NTP_PORT , Binary ),
103
- {ok , {_Address , _Port , Resp }} = gen_udp :recv (Socket , 0 , 500 ),
104
- gen_udp :close (Socket ),
105
- Resp .
166
+ case gen_udp :open (0 , [binary , {active , false }]) of
167
+ {error , _Reason } = Error -> Error ;
168
+ {ok , Socket } ->
169
+ try gen_udp :send (Socket , Host , ? NTP_PORT , Binary ) of
170
+ {error , _Reason } = Error -> Error ;
171
+ ok ->
172
+ case gen_udp :recv (Socket , 0 , 500 ) of
173
+ {error , _Reason } = Error -> Error ;
174
+ {ok , {_Address , _Port , Resp }} -> {ok , Resp }
175
+ end
176
+ after
177
+ gen_udp :close (Socket )
178
+ end
179
+ end .
106
180
107
181
process_ntp_response (Ntp_response ) ->
108
182
<<LI :2 , Version :3 , Mode :3 , Stratum :8 , Poll :8 /signed , Precision :8 /signed ,
@@ -131,41 +205,3 @@ binfrac(0, _, Frac) ->
131
205
Frac ;
132
206
binfrac (Bin , N , Frac ) ->
133
207
binfrac (Bin bsr 1 , N * 2 , Frac + (Bin band 1 )/ N ).
134
-
135
- % INET IP CHECK UTILS ----------------------------------------------------------
136
-
137
- check_inet_ipv4 () ->
138
- case get_ip_of_valid_interfaces () of
139
- {_ ,_ ,_ ,_ } = IP when IP =/= {127 ,0 ,0 ,1 } -> true ;
140
- _ -> false
141
- end .
142
-
143
- get_ipv4_from_opts ([]) ->
144
- undefined ;
145
- get_ipv4_from_opts ([{addr , {_1 , _2 , _3 , _4 }} | _ ]) ->
146
- {_1 , _2 , _3 , _4 };
147
- get_ipv4_from_opts ([_ | TL ]) ->
148
- get_ipv4_from_opts (TL ).
149
-
150
- has_ipv4 (Opts ) ->
151
- get_ipv4_from_opts (Opts ) =/= undefined .
152
-
153
- flags_are_ok (Flags ) ->
154
- lists :member (up , Flags ) and
155
- lists :member (running , Flags ) and
156
- not lists :member (loopback , Flags ).
157
-
158
- get_valid_interfaces () ->
159
- {ok , Interfaces } = inet :getifaddrs (),
160
- [
161
- Opts
162
- || {_Name , [{flags , Flags } | Opts ]} <- Interfaces ,
163
- flags_are_ok (Flags ),
164
- has_ipv4 (Opts )
165
- ].
166
-
167
- get_ip_of_valid_interfaces () ->
168
- case get_valid_interfaces () of
169
- [Opts | _ ] -> get_ipv4_from_opts (Opts );
170
- _ -> undefined
171
- end .
0 commit comments