1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
|
#!/bin/bash
# -*- scheme -*-
exec guile --debug -l $0 -e main -- "$@"
!#
;; GStreamer
;; Copyright (C) 2005 Andy Wingo <wingo at pobox.com>
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2 of
;; the License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, contact:
;;
;; Free Software Foundation Voice: +1-617-542-5942
;; 59 Temple Place - Suite 330 Fax: +1-617-542-2652
;; Boston, MA 02111-1307, USA gnu@gnu.org
;;; Commentary:
;;
;; Network clock simulator.
;;
;; Simulates the attempts of one clock to synchronize with another over
;; the network. Packets are sent out with a local timestamp, and come
;; back with the remote time added on to the packet. The remote time is
;; assumed to have been observed at the local time in between sending
;; the query and receiving the reply.
;;
;; The local clock will attempt to adjust its rate and offset by fitting
;; a line to the last N datapoints on hand, by default 32. A better fit,
;; as measured by the correlation coefficient, will result in a longer
;; time before the next query. Bad fits or a not-yet-full set of data
;; will result in many queries in quick succession.
;;
;; The rate and offset are set directly to the slope and intercept from
;; the linear regression. This results in discontinuities in the local
;; time. As clock times must be monotonically increasing, a jump down in
;; time will result instead in time standing still for a while. Smoothly
;; varying the rate such that no discontinuities are present has not
;; been investigated.
;;
;; Implementation-wise, this simulator processes events and calculates
;; times discretely. Times are represented as streams, also known as
;; lazy lists. This is an almost-pure functional simulator. The thing to
;; remember while reading is that stream-cons does not evaluate its
;; second argument, rather deferring that calculation until stream-cdr
;; is called. In that way all times are actually infinite series.
;;
;; Usage: See network-clock.scm --help.
;;
;;; Code:
(use-modules (ice-9 popen))
(load "network-clock-utils.scm")
(define (time->samples t)
(iround (* t *sample-frequency*)))
(define (schedule-event events e time)
(let lp ((response-time (time->samples time))
(stream events))
(if (zero? response-time)
(if (not (stream-car stream))
(stream-cons e (stream-cdr stream))
(stream-cons (stream-car stream) (lp 0 (stream-cdr stream))))
(stream-cons (stream-car stream) (lp (1- response-time) (stream-cdr stream))))))
(define (schedule-send-time-query events time)
(schedule-event events (list 'send-time-query) time))
(define (schedule-time-query events l)
(schedule-event events (list 'time-query l)
(+ *send-delay* (random *send-jitter*))))
(define (schedule-time-response events l r)
(schedule-event events (list 'time-response l r)
(+ *recv-delay* (random *recv-jitter*))))
(define (network-time remote-time local-time events m b x y t)
(let ((r (stream-car remote-time))
(l (stream-car local-time))
(event (stream-car events))
(events (stream-cdr events)))
(define (next events m b x y t)
(stream-cons
(+ (* m l) b)
(network-time
(stream-cdr remote-time) (stream-cdr local-time) events m b x y t)))
(case (and=> event car)
((send-time-query)
(cond
((< (random 1.0) *packet-loss*)
(debug "; dropped time query: ~a\n" l)
(print-event 'packet-lost l (+ (* m l) b))
(next events m b x y (time->samples *timeout*)))
(else
(debug "; sending time query: ~a\n" l)
(print-event 'packet-sent l (+ (* m l) b))
(next (schedule-time-query events l) m b x y (time->samples *timeout*)))))
((time-query)
(debug "; time query received, replying with ~a\n" r)
(next (schedule-time-response events (cadr event) r) m b x y (and t (1- t))))
((time-response)
(let ((x (q-push x (avg (cadr event) l)))
(y (q-push y (caddr event))))
(call-with-values
(lambda () (least-squares (q-head x) (q-head y)))
(lambda (m b r-squared)
(define (next-time)
(max
(if (< (length (q-head x)) *queue-length*)
0
(/ 1 (- 1 (min r-squared 0.99999)) 1000))
0.10))
(debug "; new slope and offset: ~a ~a (~a)\n" m b r-squared)
(print-event 'packet-observed (avg (cadr event) l) (caddr event))
(print-event 'packet-received l (+ (* m l) b))
(next (schedule-send-time-query events (next-time)) m b x y #f)))))
(else
(cond
((not t)
;; not waiting for a response
(next events m b x y t))
((<= t 0)
;; we timed out
(next (schedule-send-time-query events 0.0) m b x y 0))
(else
(next events m b x y (1- t))))))))
(define (run-simulation remote-speed local-speed)
(let ((absolute-time (arithmetic-series 0.0 (/ 1.0 *sample-frequency*)))
(event-stream (stream-of #f)))
(let ((remote-time (scale-stream absolute-time remote-speed))
(local-time (scale-stream absolute-time local-speed)))
(values
absolute-time
remote-time
local-time
(network-time
remote-time
local-time
(schedule-send-time-query event-stream 0.0)
1.0
(stream-car local-time)
(make-q (list (stream-car local-time)))
(make-q (list (stream-car remote-time)))
#f)))))
(define (print-simulation)
(display "Absolute time; Remote time; Local time; Network time\n")
(call-with-values
(lambda () (run-simulation *remote-rate* *local-rate*))
(lambda streams
(apply
stream-while
(lambda (a r l n) (<= a *total-time*))
(lambda (a r l n) (format #t "~a ~a ~a ~a\n" a r l n))
streams))))
(define (plot-simulation)
(let ((port (open-output-pipe "./plot-data Network Clock Simulation")))
(with-output-to-port port
print-simulation)
(close-pipe port)))
(define-parameter *sample-frequency* 40)
(define-parameter *send-delay* 0.1)
(define-parameter *recv-delay* 0.1)
(define-parameter *packet-loss* 0.01)
(define-parameter *send-jitter* 0.1)
(define-parameter *recv-jitter* 0.1)
(define-parameter *queue-length* 32)
(define-parameter *local-rate* 1.0)
(define-parameter *remote-rate* 1.1)
(define-parameter *total-time* 5.0)
(define-parameter *timeout* 1.0)
(define-parameter *debug* #f)
(define-parameter *with-graph* #t)
(define (main args)
(parse-parameter-arguments (cdr args))
(if *with-graph*
(plot-simulation)
(print-simulation))
(quit))
|
