-
Notifications
You must be signed in to change notification settings - Fork 0
/
sqm-autorate.pl
4563 lines (3843 loc) · 156 KB
/
sqm-autorate.pl
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
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
#!/usr/bin/perl
#
# Introduction
# ============
#
# This script automatically adjusts the SQM bandwidth according to
# latency and load. It is designed to be run as a daemon / service.
#
# Bandwidth rests at a "standard" value, which should be a reasonable
# estimate of how much bandwidth capacity the WAN link can reliably
# deliver at most times. Bandwidth increases and decreases are
# limited by maxima and minima, and subject to various conditions
# (see below).
#
# Algorithm Outline
# =================
#
# Measure upload/download latency using a set of reflectors
# |
# |-> If latency is good
# | |-> If average load is greater than $increase_load_threshold_pc
# | | '-> If the last increase/decrease occurred sufficiently
# | | long ago (see $increase_delay_after_increase and
# | | $increase_delay_after_decrease)
# | | '-> If at least $max_recent_results have been done
# | | since the last bandwidth change
# | | '-> If all recent pings were good
# | | '-> If bandwidth is not at maximum
# | | '-> Increase the bandwidth
# | |
# | '-> If average load is less than $relax_load_threshold_pc
# | '-> If bandwidth is not at the standard bandwidth
# | |-> If the current bandwidth is less than the standard
# | | bandwidth
# | | '-> If the last increase/decrease occurred sufficiently
# | | long ago (see $increase_delay_after_increase and
# | | $increase_delay_after_decrease)
# | | '-> If at least $max_recent_results have been done
# | | since the last bandwidth change
# | | '-> If all recent pings were good
# | | '-> Relax the bandwidth
# | |
# | |-> If the last bandwidth change was an increase
# | | '-> If the increase occurred sufficiently long ago
# | | (see $increase_delay_after_increase and
# | | $relax_delay)
# | | '-> Relax the bandwidth
# | |
# | '-> If the last bandwidth change was a decrease
# | '-> If the decrease occurred sufficiently long ago
# | (see $increase_delay_after_decrease and
# | $relax_delay)
# | '-> Relax the bandwidth
# |
# '-> If latency is bad
# '-> If internet connection is not completely down
# '-> If load is greater than minimum bandwidth limit
# '-> If bandwidth is not at minimum
# '-> If the last decrease occurred sufficiently long ago
# (see $decrease_delay_after_decrease)
# '-> Decrease the bandwidth
#
#
# Latency measurement
# ===================
#
# Upload and download latencies are measured separately using ICMP type
# 13 (timestamp) messages, so the target hosts ("reflectors") must
# respond to ICMP type 13 requests. Lists of reflectors for different
# regions can be downloaded from here:
# https://github.com/tievolu/timestamp-reflectors
#
# ICMP requests are sent on the ICMP Sender thread at regular intervals
# which, by default, are set according to load (see the "icmp_adaptive",
# "icmp_interval_idle", "icmp_interval_loaded", and
# "icmp_adaptive_idle_delay" properties), while the ICMP Receiver thread
# listens for responses. The results are stored in a shared array and
# the contents are periodically evaluated and acted upon on the main
# thread. See the "latency_check_interval" property.
#
# The targets for the ICMP messages, or "reflectors", are chosen at
# random from the CSV file specified in the "reflectors_csv" property.
#
# If a reflector performs poorly, it will be replaced with a new random
# reflector from the CSV file. Performing "poorly" means timing out too
# often, responding too slowly, or returning nonsensical ICMP timestamps.
# This behaviour is controlled with the "reflector_strikeout_threshold",
# "reflector_strike_ttl", "ul_max_idle_latency", and "dl_max_idle_latency"
# properties. "reflector_strikeout_threshold" can be set to 0 to disable
# strikes completely and use a static set of reflectors. This is useful
# if you want to use a known good set of reflectors.
#
# Latency results are cleared after every bandwidth change.
#
# Bandwidth usage measurement
# ===========================
#
# Bandwidth usage is measured on the main thread every time we conduct a
# latency check. The average bandwidth usage between each latency check
# is stored, and when ICMP results are evaluated the bandwidth usage for
# the approprate time period is used to assess whether latency is likely
# to be caused by bufferbloat, which in turn determines if/how the SQM
# bandwidth should be changed (see algorithm description above).
#
# Bandwidth decreases
# ===================
#
# The logic behind the bandwidth decrease conditions shown above is that
# if there is no significant bandwidth usage, the bad pings are not
# caused by bufferbloat, and decreasing the bandwidth won't help. "Bad"
# pings that are not associated with significant bandwidth usage are
# ignored when evaluating latency.
#
# A delay between decreases is needed to ensure that a decrease in SQM
# bandwidth has enough time to take effect before we consider
# decreasing it again. This is especially important (maybe *only*
# important?) in the download direction, because it takes time for
# remote senders to realise that they need to slow down the rate at
# which they are sending packets. The delay is controlled by the
# "decrease_delay_after_decrease" property.
#
# The amount by which the bandwidth is decreased is calculated based on
# the average bandwidth usage at the times when bad pings were detected.
# The bandwidth will be decreased to that average "bad" bandwidth usage
# plus a small "overshoot" controlled by the "decrease_overshoot_pc"
# property (default 5%).
#
# Bandwidth increases
# ===================
#
# Bandwidth will only be increased when we have a full set of clean
# ICMP results (i.e. no bad results). For example, if $max_recent_results
# is 20 and the ICMP interval is 0.1s, the minimum interval between
# bandwidth increases will be 2 seconds. Increases can be delayed further
# by adjusting the "increase_delay_after_decrease" and
# "increase_delay_after_increase" properties.
#
# The amount by which the bandwidth is increased is proportional to the
# the difference between the average good ping result and the "bad ping"
# threshold:
#
# ([ping threshold] - [average good ping time]) * increase_factor
#
# The increase is also tapered as we approach the maximum bandwidth.
#
# Bandwidth relaxations
# =====================
#
# The SQM bandwidth will "relax" back to the standard bandwidth after any
# increases or decreases. The size of each relaxation step and the delay
# between them can be configured with the "relax_pc" and "relax_delay"
# properties. After a bandwidth decrease, relaxations will also be delayed
# by "increase_delay_after_decrease" to avoid an inappropriate increase
# after a relaxation.
use strict;
use warnings;
#######################################################################################
# Signal handlers
#######################################################################################
$SIG{INT} = \&signal_handler;
$SIG{TERM} = \&signal_handler;
#######################################################################################
# Modules
#######################################################################################
use threads;
use threads::shared;
use POSIX qw(mktime strftime);
use Time::HiRes qw(gettimeofday);
use Time::Local qw(timegm);
use List::Util qw(shuffle min max sum);
use Socket qw(SOCK_RAW AF_INET MSG_DONTWAIT inet_ntoa inet_aton sockaddr_in pack_sockaddr_in unpack_sockaddr_in);
##################################################################################
# Constants
##################################################################################
# ICMP constants
use constant ICMP_PROTOCOL => 1;
use constant ICMP_TIMESTAMP => 13;
use constant ICMP_TIMESTAMP_REPLY => 14;
use constant ICMP_TIMESTAMP_STRUCT => "C2 n3 N3"; # Structure of a ICMP timestamp packet
use constant ICMP_PAYLOAD_OFFSET => 20;
# Constants for latency results
use constant LATENCY_OK => 1;
use constant LATENCY_BAD => 2;
use constant LATENCY_BOTH_OK => 3;
use constant LATENCY_UL_BAD => 4;
use constant LATENCY_DL_BAD => 5;
use constant LATENCY_BOTH_BAD => 6;
use constant LATENCY_DOWN => -1;
use constant LATENCY_INVALID => -2;
# Special constants to use in place of genuine ICMP times
use constant ICMP_INVALID => 88888;
use constant ICMP_TIMED_OUT => 99999;
##################################################################################
# Shared global variables
##################################################################################
my $pid :shared; # Process ID
my $cid :shared; # Latency check cycle ID (incremented with each latency check)
my $output_lock :shared; # Controls access to output streams to avoid interleaving
my $warmup_request_threshold :shared; # Minimum number of pings required for warmup phase
my $suspend_icmp_sender :shared; # Tells the ICMP Sender thread to suspend/resume itself
my $suspend_icmp_receiver :shared; # Tells the ICMP Receiver thread to suspend/resume itself
my $sender_suspended :shared; # Indicates that the ICMP Sender thread is suspended
my $receiver_suspended :shared; # Indicates that the ICMP Receiver thread is suspended
my $icmp_interval :shared; # ICMP interval
my $icmp_request_count :shared;
my $icmp_request_bytes :shared;
my $icmp_response_count :shared;
my $icmp_response_bytes :shared;
my %icmp_timeout_times :shared; # Time at which a pending ICMP request will time out
my %icmp_sent_times :shared; # Time at which an ICMP request was sent
my @recent_results :shared; # Recent ICMP results
my %reflector_ips :shared; # ICMP reflector IP addresses
my %reflector_packet_ids :shared; # Packet ID for each ICMP reflector
my %reflector_seqs :shared; # Current sequence ID for each ICMP reflector
my %reflector_offsets :shared; # Time offset for each ICMP reflector
my %reflector_minimum_rtts :shared; # Minimum RTT time seen for each ICMP reflector (used when calculating the offset)
# Initialise the process ID and cycle ID
$pid = "$$";
$cid = sprintf("%010d", 0);
#######################################################################################
# Configuration
#######################################################################################
# Read the configuration properties file and use them to populate global variables
# Configuration file can be located in the same directory as the script, or /etc
my $config_file = substr($0, 0, rindex($0, "/")) . "/sqm-autorate.conf";
if (! -e $config_file) {
$config_file = "/etc/sqm-autorate.conf";
}
my %config_properties = &get_config_properties($config_file);
# Upload interfaces
my $index = 0;
my @ul_interfaces = ();
while(
exists($config_properties{"ul_interface." . $index})
) {
my $if_name = $config_properties{"ul_interface." . $index};
push(@ul_interfaces, $if_name);
$index++
}
# Download interfaces
$index = 0;
my @dl_interfaces = ();
while(
exists($config_properties{"dl_interface." . $index})
) {
my $if_name = $config_properties{"dl_interface." . $index};
push(@dl_interfaces, $if_name);
$index++;
}
# Normal configuration properties with defaults
my $wan_interface = &get_config_property("wan_interface", undef);
my $dl_bw_minimum = &get_config_property("dl_bw_minimum", undef);
my $dl_bw_standard = &get_config_property("dl_bw_standard", undef);
my $dl_bw_maximum = &get_config_property("dl_bw_maximum", undef);
my $dl_bw_warmup = &get_config_property("dl_bw_warmup", $dl_bw_minimum);
my $ul_bw_minimum = &get_config_property("ul_bw_minimum", undef);
my $ul_bw_standard = &get_config_property("ul_bw_standard", undef);
my $ul_bw_maximum = &get_config_property("ul_bw_maximum", undef);
my $ul_bw_warmup = &get_config_property("ul_bw_warmup", $ul_bw_minimum);
my $increase_factor = &get_config_property("increase_factor", 1);
my $increase_min_pc = &get_config_property("increase_min_pc", 1);
my $increase_max_pc = &get_config_property("increase_max_pc", 25);
my $increase_load_threshold_pc = &get_config_property("increase_load_threshold_pc", 70);
my $increase_delay_after_decrease = &get_config_property("increase_delay_after_decrease", 600);
my $increase_delay_after_increase = &get_config_property("increase_delay_after_increase", 0);
my $decrease_min_pc = &get_config_property("decrease_min_pc", 10);
my $decrease_overshoot_pc = &get_config_property("decrease_overshoot_pc", 5);
my $relax_pc = &get_config_property("relax_pc", 5);
my $relax_load_threshold_pc = &get_config_property("relax_load_threshold_pc", 50);
my $relax_delay = &get_config_property("relax_delay", 60);
my $icmp_adaptive = &get_config_property("icmp_adaptive", 1);
my $icmp_adaptive_idle_delay = &get_config_property("icmp_adaptive_idle_delay", 10);
my $icmp_interval_idle = &get_config_property("icmp_interval_idle", 1);
my $icmp_interval_loaded = &get_config_property("icmp_interval_loaded", &get_config_property("icmp_interval", 0.1));
my $icmp_timeout = &get_config_property("icmp_timeout", 1);
my $latency_check_interval = &get_config_property("latency_check_interval", 0.5);
my $max_recent_results = &get_config_property("max_recent_results", 20);
my $bad_ping_pc = &get_config_property("bad_ping_pc", 25);
my $decrease_delay_after_decrease = &get_config_property("decrease_delay_after_decrease", ($icmp_interval_loaded * $max_recent_results) + 1);
my $ul_max_loaded_latency = &get_config_property("ul_max_loaded_latency", undef);
my $ul_max_idle_latency = &get_config_property("ul_max_idle_latency", $ul_max_loaded_latency);
my $dl_max_loaded_latency = &get_config_property("dl_max_loaded_latency", undef);
my $dl_max_idle_latency = &get_config_property("dl_max_idle_latency", $dl_max_loaded_latency);
my $ul_bw_idle_threshold = &get_config_property("ul_bw_idle_threshold", $ul_bw_minimum);
my $dl_bw_idle_threshold = &get_config_property("dl_bw_idle_threshold", $dl_bw_minimum);
my $reflectors_csv_file = &get_config_property("reflectors_csv_file", undef);
my $number_of_reflectors = &get_config_property("number_of_reflectors", undef);
my $reflector_strikeout_threshold = &get_config_property("reflector_strikeout_threshold", 3);
my $reflector_strike_ttl = &get_config_property("reflector_strike_ttl", "auto");
my $tmp_folder = &get_config_property("tmp_folder", "/tmp");
my $log_file = &get_config_property("log_file", undef);
my $use_syslog = &get_config_property("use_syslog", 1);
my $latency_check_summary_interval = &get_config_property("latency_check_summary_interval", "auto");
my $status_summary_interval = &get_config_property("status_summary_interval", "auto");
my $log_bw_changes = &get_config_property("log_bw_changes", 1);
my $log_details_on_bw_changes = &get_config_property("log_details_on_bw_changes", 1);
# Debug configuration properties, all disabled by default
my $debug_icmp = &get_config_property("debug_icmp", 0);
my $debug_icmp_timeout = &get_config_property("debug_icmp_timeout", 0);
my $debug_icmp_correction = &get_config_property("debug_icmp_correction", 0);
my $debug_icmp_suspend = &get_config_property("debug_icmp_suspend", 0);
my $debug_icmp_adaptive = &get_config_property("debug_icmp_adaptive", 0);
my $debug_strike = &get_config_property("debug_strike", 0);
my $debug_latency_check = &get_config_property("debug_latency_check", 0);
my $debug_sys_commands = &get_config_property("debug_sys_commands", 0);
my $debug_bw_changes = &get_config_property("debug_bw_changes", 0);
my $debug_offsets = &get_config_property("debug_offsets", 0);
# Make sure all bandwidth change info is logged if $debug_bw_changes is enabled
if ($debug_bw_changes) {
$log_bw_changes = 1;
$log_details_on_bw_changes = 1;
}
# Make sure ICMP timestamp correction debug information is logged if $debug_icmp is enabled
if ($debug_icmp) {
$debug_icmp_correction = 1;
}
#######################################################################################
# Variables controlled by command line arguments
#######################################################################################
# If $dryrun == 1 the script runs as normal, but bandwidth changes are not applied
my $dryrun = 0;
# If $reset == 1 we will simply reset everything to defaults and exit
my $reset = 0;
#######################################################################################
# Global variables - don't mess with these
#######################################################################################
# Flag to indicate whether we should suspend ICMP threads when idle
my $icmp_adaptive_idle_suspend = $icmp_adaptive && $icmp_interval_idle == 0 ? 1 : 0;
# Number of bad pings required to trigger a "bad" latency result
my $max_bad_pings = &round($max_recent_results * ($bad_ping_pc / 100)) - 1;
# Maximum number of historical bandwidth usage statistics samples to retain.
# We use these samples to check whether the connection is idle, and to check bandwidth
# usage at the time of each request and response, so we need to make sure we have enough
# samples for both.
#
# We calculate what should be the maximum number of samples required for each type of
# usage, plus 50% more to make sure, then select the largest number. Note that a
# couple of extra samples does not impact performance because we always search backwards
# starting with the most recent sample. Redundant samples at the end of the array have
# no impact beyond a *tiny* increase in memory usage.
my $max_for_adaptive_idle_delay = $icmp_adaptive ? &round_up($icmp_adaptive_idle_delay / $latency_check_interval) * 1.5 : 0;
my $max_for_icmp_results = &round_up( (((max($icmp_interval_loaded, $icmp_interval_idle, 1) * $max_recent_results * 1.5) + $icmp_timeout) / $latency_check_interval) );
my $max_recent_bandwidth_usages = max($max_for_icmp_results, $max_for_adaptive_idle_delay);
# Create an array to store the recent bandwidth usage statistics, and initialise it
my @recent_bandwidth_usages = ();
&update_bandwidth_usage_stats();
# Hashes to store the number of upload/download strikes for each reflector
my %reflector_strikes_ul;
my %reflector_strikes_dl;
# Connection state and the most recent bandwidth changes for each direction
my $connection_down = 0;
my %last_change;
$last_change{"upload"} = "";
$last_change{"download"} = "";
my %last_change_time;
$last_change_time{"upload"} = 0;
$last_change_time{"download"} = 0;
# Current bandwidth values. Read from UCI during initialisation,
# then updated every time we change the bandwidth.
my $current_bandwidth_ul;
my $current_bandwidth_dl;
# Average good latency times. Used to calculate increase steps.
my $average_good_latency_ul;
my $average_good_latency_dl;
# Average bandwidth usage for all recent results.
my $average_bandwidth_usage_ul;
my $average_bandwidth_usage_dl;
# Average bandwidth usage at the time that bad pings were detected.
# Used to calculate decrease steps.
my $average_bad_bandwidth_usage_ul;
my $average_bad_bandwidth_usage_dl;
# Increase/decrease step percentages. These are calculated automatically in response to ping results.
my $increase_step_pc_ul;
my $increase_step_pc_dl;
my $decrease_step_pc_ul;
my $decrease_step_pc_dl;
# Log line separator
my $log_line_separator = "--------------------------------------------------------------------------------";
my $last_log_line_was_separator = 0;
# Variables used to control when status summaries and latency check summaries are logged
my $force_status_summary = 1;
my $next_status_summary_time = gettimeofday();
my $next_latency_check_summary_time = gettimeofday();
my $status_summary_auto_frequency = 30; # i.e. one status summary for every 20 latency summaries
# Number of reflectors that have been struckout
my $struckout_count = 0;
# Flag to indicate whether the reflector pool has ever been exhausted and reloaded
my $reflectors_reloaded_ever = 0;
# Flag to indicate whether the ICMP/reflector warmup has completed.
# This will be set during initialisation.
my $icmp_warmup_done;
#######################################################################################
# Initialisation
#######################################################################################
STDOUT->autoflush(1);
STDERR->autoflush(1);
# Process command line arguments
&process_args();
# Record start time
my $script_start_time = gettimeofday();
&output(1, "SQM Autorate started", 1);
# Initialize adaptive ICMP start/total times
my $icmp_adaptive_idle_start_time = $script_start_time;
my $icmp_adaptive_loaded_start_time = $script_start_time;
my $icmp_adaptive_idle_total_time = 0;
my $icmp_adaptive_loaded_total_time = 0;
# Display configuration properties
&output(0, "INIT: Read " . scalar(keys(%config_properties)) . " configuration properties from $config_file: ");
foreach my $key (sort {$a cmp $b} keys(%config_properties)) {
&output(0, "INIT:\t$key = " . $config_properties{$key});
}
# Get the reflector pool
my @reflector_pool = &get_reflector_pool($reflectors_csv_file);
my $initial_reflector_pool_size = scalar(@reflector_pool);
&output(0, "INIT: Reflector pool size: " . scalar(@reflector_pool));
{
lock(%reflector_ips);
%reflector_ips = &get_reflectors($number_of_reflectors);
&output(0, "INIT: Initial reflector list ($number_of_reflectors):");
foreach my $reflector_ip (keys(%reflector_ips)) {
&output(0, "INIT:\t$reflector_ip");
}
}
# Check the configuration
&check_config();
# Set the ICMP interval - default to / start with the "loaded" interval
# This will be modified when idle if adaptive ICMP is enabled
$icmp_interval = $icmp_interval_loaded;
&output(0, "INIT: ICMP interval set to $icmp_interval_idle" . "s");
# If necessary, set the latency check summary interval
if ($latency_check_summary_interval eq "auto") {
$latency_check_summary_interval = $max_recent_results * $icmp_interval;
}
# If necessary, set the status summary interval
if ($status_summary_interval eq "auto") {
$status_summary_interval = $latency_check_summary_interval * 30;
}
# If necessary, set the initial strike TTL.
if ($reflector_strike_ttl eq "auto") {
&update_reflector_strike_ttl();
&output(0, "INIT: Reflector strike TTL set to " . $reflector_strike_ttl . "s");
}
# Set the number of ICMP requests required to ensure that obviously
# bad reflectors can be eliminated during the warmup phase.
# We shouldn't need to lock this here because we haven't created the
# ICMP sender thread yet, but do it anyway.
{
lock($warmup_request_threshold);
$warmup_request_threshold = $number_of_reflectors * ($reflector_strikeout_threshold + 1);
}
# Initialize ICMP packet/byte counters
$icmp_request_count = 0;
$icmp_request_bytes = 0;
$icmp_response_count = 0;
$icmp_response_bytes = 0;
# Create a socket on which to send the ping requests
my $fd = &create_icmp_socket();
&output(0, "INIT: Created ICMP socket on FD " . $fd->fileno());
# Create the ICMP receiver thread
my $receiver_thread = &create_receiver_thread($fd);
&output(0, "INIT: Created ICMP Receiver thread: " . $receiver_thread->tid);
# Create the ICMP Sender thread
my $sender_thread = &create_sender_thread($fd);
&output(0, "INIT: Created ICMP Sender thread: " . $sender_thread->tid);
# Get the current bandwidth values from tc
$current_bandwidth_ul = &get_current_bandwidth_from_tc("upload");
$current_bandwidth_dl = &get_current_bandwidth_from_tc("download");
if (!$icmp_adaptive || $reflector_strikeout_threshold == 0) {
# Don't warmup if adaptive ICMP isn't enabled, or if reflector strikes aren't enabled.
# Check whether the current bandwidths are within the min/max range, and if
# not, fix them. This can happen if the min/max settings are modified
# manually outside of this script.
&ensure_within_min_max();
$icmp_warmup_done = 1;
} else {
# Print a message and set bandwidth for warmup phase
&output(0, "Starting warmup phase - setting warmup bandwidths");
&set_bandwidth("download", $dl_bw_warmup);
&set_bandwidth("upload", $ul_bw_warmup);
$icmp_warmup_done = 0;
}
#######################################################################################
# Main latency checking loop
#######################################################################################
while (1) {
# Pause for $latency_check_interval. We do this first to give the ICMP
# Sender/Receiver threads a chance to start up before the first latency check.
select(undef, undef, undef, $latency_check_interval);
# Update latency check cycle ID
{
lock($cid);
$cid = sprintf("%010d", ++$cid);
}
# Print summary of current bandwidth settings if necessary
if (gettimeofday() >= $next_status_summary_time || $force_status_summary) {
&print_status_summary();
# Set the time that the next status summary is due
$next_status_summary_time = gettimeofday() + $status_summary_interval;
$force_status_summary = 0;
}
# If reset is specified, reset bandwidths to standard then finish
if ($reset) {
&reset_bandwidth();
&finish();
}
# Now check the latency and get the results
my ($latency_result, $summary_results_array_ref, $detailed_results_array_ref) = &check_latency();
# Check for and handle changes in connection state
my $connection_state_changed = 0;
if ($latency_result == LATENCY_DOWN) {
$connection_state_changed = &handle_connection_down($summary_results_array_ref, $detailed_results_array_ref);
} else {
$connection_state_changed = &handle_connection_up($summary_results_array_ref, $detailed_results_array_ref);
}
# Only consider a bandwidth change if we have some valid results
# and the connection state hasn't just changed
my $bandwidth_changed = 0;
if (!$connection_state_changed && $latency_result != LATENCY_INVALID) {
foreach my $direction ("upload", "download") {
if (&is_latency_ok($latency_result, $direction)) {
# Consider whether we should increase, and if not, consider a relax step
$bandwidth_changed = &increase_if_appropriate($direction, $summary_results_array_ref, $detailed_results_array_ref)
|| &relax_if_appropriate($direction, $summary_results_array_ref, $detailed_results_array_ref)
|| $bandwidth_changed;
} else {
$bandwidth_changed = &decrease_if_appropriate($direction, $summary_results_array_ref, $detailed_results_array_ref)
|| $bandwidth_changed;
}
}
}
if ($bandwidth_changed) {
# Print a status summary on the next cycle
$force_status_summary = 1;
} else {
# Print appropriate output if the bandwidth hasn't changed
if ($debug_latency_check) { &print_latency_results_details(@{$detailed_results_array_ref}); }
# Print latency check results summary if necessary
if ($latency_check_summary_interval > 0 && gettimeofday() >= $next_latency_check_summary_time) {
&print_latency_results_summary(@{$summary_results_array_ref});
$next_latency_check_summary_time = gettimeofday() + $latency_check_summary_interval;
}
}
if ($debug_latency_check) { &output(0, "LATENCY CHECK DEBUG: overall result = $latency_result"); }
} # End of main loop
#######################################################################################
# Threads
#######################################################################################
# Thread to send ICMP timestamp requests
sub create_sender_thread {
my ($fd) = @_;
return threads->create(sub {
my $thr_id = threads->self->tid;
my @reflector_ips;
while (1) {
{
lock(%reflector_ips);
@reflector_ips = keys(%reflector_ips);
}
foreach my $reflector_ip (@reflector_ips) {
&suspend_self_if_required("sender");
# Go through the requests hash and record/clear any requests that have timed out
# We need to do this here (i.e. instead of on the receiver thread) to ensure that
# requests time out promptly when the connection is in a really bad way or
# completely down. Under normal circumstances this operation is very cheap because
# there will be a very small number of pending requests (usually zero in fact).
&process_icmp_timeouts();
# Get the current time
my $current_time = gettimeofday();
# Send an ICMP timestamp request
my ($id, $seq) = &send_icmp_timestamp_request($reflector_ip, $fd);
my $request_sig = "$reflector_ip $id $seq";
# Store the time at which we sent this request
# We'll use this to calculate bandwidth usage when we process the result
{
lock(%icmp_sent_times);
$icmp_sent_times{$request_sig} = $current_time;
}
{
# Calculate and store the time at which this request will timeout
lock(%icmp_timeout_times);
$icmp_timeout_times{$request_sig} = $current_time + $icmp_timeout;
}
select(undef, undef, undef, $icmp_interval);
}
}
});
}
# Thread to receive ICMP timestamp replies
sub create_receiver_thread {
my ($fd) = @_;
return threads->create(sub {
my $thr_id = threads->self->tid;
my $rin = "";
vec($rin, $fd->fileno(), 1) = 1;
while (1) {
&suspend_self_if_required("receiver");
# Block and wait for a packet to arrive
# TODO: This never actually seems to block? It always returns
# instantly and we block in recv() instead...
my $nfound = select((my $rout = $rin), undef, undef, 0);
if ($nfound != -1) {
# Receive the packet and get the packed address.
my $recv_msg;
my $packed_addr = recv($fd, $recv_msg, 1500, 0);
if (defined($packed_addr)) {
# Unpack the socket address info (port will always be zero)
my ($from_port, $from_ip) = unpack_sockaddr_in($packed_addr);
# Get the ICMP type from the packet
my $reply_type = unpack("C", substr($recv_msg, ICMP_PAYLOAD_OFFSET, 1));
# If this is a timestamp reply, handle it
if ($reply_type == ICMP_TIMESTAMP_REPLY) {
&handle_icmp_reply(inet_ntoa($from_ip), $recv_msg);
}
}
}
}
});
}
# Suspend ICMP sender and receiver threads
# The threads will remain suspended until &resume_icmp_threads() is called
sub suspend_icmp_threads {
# Check we are running on the main thread
my $thread_id = threads->self->tid;
if ($thread_id != 0) {
&fatal_error("suspend_icmp_threads() called from thread $thread_id");
}
# We will suspend the ICMP Receiver thread first. If we suspend the Sender first
# the Receiver will hang briefly in recv() waiting for an ICMP response.
if (defined($receiver_thread) && $receiver_thread->is_running()) {
# Set flag to signal that the ICMP Receiver thread needs to suspend itself
{
lock($suspend_icmp_receiver);
$suspend_icmp_receiver = 1;
if ($debug_icmp_suspend) { &output(0, "ICMP SUSPEND DEBUG: ICMP Receiver suspend requested"); }
}
# Wait for the ICMP Receiver thread to suspend itself
{
lock($receiver_suspended);
while (!$receiver_suspended) {
cond_wait($receiver_suspended);
}
if ($debug_icmp_suspend) { &output(0, "ICMP SUSPEND DEBUG: ICMP Receiver suspend confirmed"); }
}
} else {
if ($debug_icmp_suspend) { &output(0, "ICMP SUSPEND DEBUG: ICMP Receiver not running"); }
}
if (defined($sender_thread) && $sender_thread->is_running()) {
# Set flag to signal that the ICMP Sender thread needs to suspend itself
{
lock($suspend_icmp_sender);
$suspend_icmp_sender = 1;
if ($debug_icmp_suspend) { &output(0, "ICMP SUSPEND DEBUG: ICMP Sender suspend requested"); }
}
# Wait for the ICMP Sender thread to suspend itself
{
lock($sender_suspended);
while (!$sender_suspended) {
cond_wait($sender_suspended);
}
if ($debug_icmp_suspend) { &output(0, "ICMP SUSPEND DEBUG: ICMP Sender suspend confirmed"); }
}
} else {
if ($debug_icmp_suspend) { &output(0, "ICMP SUSPEND DEBUG: ICMP Sender not running"); }
}
}
# Resume suspended ICMP sender and receiver threads
sub resume_icmp_threads {
# Check we are running on the main thread
my $thread_id = threads->self->tid;
if ($thread_id != 0) {
&fatal_error("resume_icmp_threads() called from thread $thread_id");
}
# We will resume the ICMP Receiver thread first. If we resumed the Sender first
# the Receiver might miss some ICMP responses.
if (defined($receiver_thread) && $receiver_thread->is_running()) {
# Set flag to signal that the ICMP Receiver thread can resume itself
{
lock($suspend_icmp_receiver);
$suspend_icmp_receiver = 0;
cond_broadcast($suspend_icmp_receiver);
if ($debug_icmp_suspend) { &output(0, "ICMP SUSPEND DEBUG: ICMP Receiver resume requested"); }
}
# Wait for the ICMP Receiver thread to resume
{
lock($receiver_suspended);
while ($receiver_suspended) {
if ($debug_icmp_suspend) { &output(0, "ICMP SUSPEND DEBUG: Waiting for ICMP Receiver to resume"); }
cond_wait($receiver_suspended);
}
}
if ($debug_icmp_suspend) { &output(0, "ICMP SUSPEND DEBUG: ICMP Receiver resume confirmed"); }
} else {
if ($debug_icmp_suspend) { &output(0, "ICMP SUSPEND DEBUG: ICMP Receiver not running"); }
}
if (defined($sender_thread) && $sender_thread->is_running()) {
# Set flag to signal that the ICMP Sender thread can resume itself
{
lock($suspend_icmp_sender);
$suspend_icmp_sender = 0;
cond_broadcast($suspend_icmp_sender);
if ($debug_icmp_suspend) { &output(0, "ICMP SUSPEND DEBUG: ICMP Sender resume requested"); }
}
# Wait for the ICMP Sender thread to resume
{
lock($sender_suspended);
while ($sender_suspended) {
if ($debug_icmp_suspend) { &output(0, "ICMP SUSPEND DEBUG: Waiting for ICMP Sender to resume"); }
cond_wait($sender_suspended);
}
if ($debug_icmp_suspend) { &output(0, "ICMP SUSPEND DEBUG: ICMP Sender resume confirmed"); }
}
} else {
if ($debug_icmp_suspend) { &output(0, "ICMP SUSPEND DEBUG: ICMP Sender not running"); }
}
}
# Called by the ICMP Sender and Receiver threads to suspend themselves
sub suspend_self_if_required {
my ($thread_type) = @_;
# Check we are not running on the main thread
my $thread_id = threads->self->tid;
if ($thread_id == 0) {
&fatal_error("ERROR: suspend_self_if_required() called from main thread");
}
# Code for ICMP Sender thread
if ($thread_type eq "sender") {
lock($suspend_icmp_sender);
if ($suspend_icmp_sender) {
# Broadcast the fact that we are suspended
{
lock($sender_suspended);
$sender_suspended = 1;
if ($debug_icmp_suspend) { &output(0, "ICMP SUSPEND DEBUG: ICMP Sender suspended"); }
cond_broadcast($sender_suspended);
}
# Wait until safepoint no longer required
while($suspend_icmp_sender) {
if ($debug_icmp_suspend) { &output(0, "ICMP SUSPEND DEBUG: ICMP Sender waiting to resume"); }
cond_wait($suspend_icmp_sender);
}
if ($debug_icmp_suspend) { &output(0, "ICMP SUSPEND DEBUG: Resuming ICMP Sender"); }
{
lock($sender_suspended);
$sender_suspended = 0;
if ($debug_icmp_suspend) { &output(0, "ICMP SUSPEND DEBUG: ICMP Sender resumed"); }
cond_broadcast($sender_suspended);
}
}
}
# Code for ICMP Receiver thread
if ($thread_type eq "receiver") {
lock($suspend_icmp_receiver);
if ($suspend_icmp_receiver) {
# Broadcast the fact that we are suspended
{
lock($receiver_suspended);
$receiver_suspended = 1;
if ($debug_icmp_suspend) { &output(0, "ICMP SUSPEND DEBUG: ICMP Receiver suspended"); }
cond_broadcast($receiver_suspended);
}
# Wait until safepoint no longer required
while($suspend_icmp_receiver) {
if ($debug_icmp_suspend) { &output(0, "ICMP SUSPEND DEBUG: ICMP Receiver waiting to resume"); }
cond_wait($suspend_icmp_receiver);
}
if ($debug_icmp_suspend) { &output(0, "ICMP SUSPEND DEBUG: Resuming ICMP Receiver"); }
{
lock($receiver_suspended);
$receiver_suspended = 0;
if ($debug_icmp_suspend) { &output(0, "ICMP SUSPEND DEBUG: ICMP Receiver resumed"); }
cond_broadcast($receiver_suspended);
}
}
}
}
sub are_icmp_threads_suspended {
# Check we are running on the main thread
my $thread_id = threads->self->tid;
if ($thread_id != 0) {
&fatal_error("ERROR: are_icmp_threads_suspended() called from thread $thread_id");
}
lock($suspend_icmp_sender);
lock($suspend_icmp_receiver);
lock($sender_suspended);
lock($receiver_suspended);
if ($suspend_icmp_sender && $suspend_icmp_receiver && $sender_suspended && $receiver_suspended) {
return 1;
} else {
return 0;
}
}
#######################################################################################
# Error handlers
#######################################################################################
sub signal_handler {
&output(0, "Caught signal: $!");
&output(0, "Suspending ICMP threads\n");
suspend_icmp_threads();
&finish();
}
# Handle a fatal error.
# This should only be called from the main thread.
sub fatal_error {
my ($msg) = @_;
&finish("FATAL ERROR: $msg");
}
# Print a message to the log and the syslog indicating that the script
# stopped, then exit. This should only be called from the main thread, but
# we'll do our best if it was somehow called from one of the ICMP threads.
# An optional additional log message can also be passed as an argument.
sub finish {
my ($msg) = @_;
# Send finish message(s) to the syslog by default
my $send_to_syslog = 1;
# Check we are running on the main thread
# If this isn't the main thread, don't send the log messages
# to the syslog. This is to avoid a deadlock when we fork the
# logger command, because we can't suspend the other threads.
my $thread_id = threads->self->tid;
if ($thread_id != 0) {
&output(0, "WARNING: finish() called from thread $thread_id");
$send_to_syslog = 0;
}
# Print additional message if one was given to us
if (defined($msg) && $msg ne "") {
&output($send_to_syslog, $msg, 1);
}
&output($send_to_syslog, "SQM Autorate stopped", 1);
if (defined($sender_thread)) { $sender_thread->detach(); }
if (defined($receiver_thread)) { $receiver_thread->detach(); }
exit();
}
#######################################################################################
# Subroutines
#######################################################################################
# Process command line arguments
sub process_args {
foreach my $arg (@ARGV) {
if ($arg eq "dryrun") {
$dryrun = 1;
}
if ($arg eq "reset") {
$reset = 1;
}
}
}
# Get the configuration properties from the specified file
# Returns a hash of the property keys and values
sub get_config_properties {
my ($config_file) = @_;
my %properties;
open(PROPERTIES_FILE, '<', $config_file) || &fatal_error("Failed to open configuration file \"$config_file\"");
foreach my $line (<PROPERTIES_FILE>) {
# Remove all whitespace
$line =~ s/\s+//g;
# Remove comments
$line =~ s/#.*//g;
if ($line =~ /^(.+)=(.+)$/) {
my $key = $1;
my $value = $2;