-
Notifications
You must be signed in to change notification settings - Fork 10
/
Copy pathswarmmode.tcl
1155 lines (1076 loc) · 44.2 KB
/
swarmmode.tcl
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
##################
## Module Name -- swarmmode.tcl
## Original Author -- Emmanuel Frécon - [email protected]
## Description:
##
## This module focuses on the new Swarm Mode available as part of the Docker
## Engine. The main procedure is called 'join': given a set of (declared
## masters/managers) it will arrange for a node to join the Swarm cluster,
## which inclused initialisation of the Swarm.
##
##################
package require cluster::tooling
package require cluster::extend
package require cluster::utils
package require cluster::unix
package require cluster::environment
package require procfs; # To automate HW information
package require sysfs; # To automate HW information
package require huddle; # To parse and operate on stack files
package require atExit; # Nice cleanup of remote files
namespace eval ::cluster::swarmmode {
# Encapsulates variables global to this namespace under their own
# namespace, an idea originating from http://wiki.tcl.tk/1489.
# Variables which name start with a dash are options and which
# values can be changed to influence the behaviour of this
# implementation.
namespace eval vars {
# Extension for token cache file
variable -ext .swt
# Prefix for labels
variable -prefix "com.docker-machinery"
# Auto-labels sections
variable -autolabel "os cpu storage"
# Name of autolabel sub-sections for # of cpus and storage devices,
# empty to turn off, leading . optional.
variable -autocpu ".cpus"
variable -autostorage ".devices"
# Characters to keep
variable keepCharacters "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_"
# Remote /proc cache
variable pseudofs {}
variable exitHook 0
# Replacement mapper for lsblk keys, the Docker documentation mentions
# that only dashes and regular characters should be used
variable lsblk { RA read-ahead
RO read-only
RM removable
ROTA rotational
RAND randomness
MIN-IO minimum-IO-size
OPT-IO optimal-IO-size
PHY-SEC physical-sector-size
LOG-SEC logical-sector-size
RQ-SIZE request-queue-size
DISC-ALN discard-alignment-offset
DISC-GRAN discard-granularity
DISC-MAX discard-max-bytes
DISC-ZERO discard-zeroes-data
WSAME write-same-max-bytes
REV revision
ZONED zone
SECTOR sector-size}
}
# Export all lower case procedure, arrange to be able to access
# commands from the parent (cluster) namespace from here and
# create an ensemble command called swarmmode (note the leading :: to make
# this a top-level command!) to ease API calls.
namespace export {[a-z]*}
namespace path [namespace parent]
namespace ensemble create -command ::swarmmode
namespace import [namespace parent]::Machines \
[namespace parent]::IsRunning \
[namespace parent]::CacheFile \
[namespace parent]::AbsolutePath
namespace import [namespace parent]::utils::log
}
# ::cluster::swarmmode::masters -- Masters description
#
# This procedure looks up the swarm masters out of a cluster
# description and returns their vm description.
#
# Arguments:
# cluster List of machine description dictionaries.
# alive Only return machines that are running.
#
# Results:
# List of virtual machine description of swarm masters, empty if none.
#
# Side Effects:
# None.
proc ::cluster::swarmmode::masters { cluster { alive 0 } } {
set masters [list]
foreach vm [Machines $cluster] {
if { [mode $vm] eq "manager" } {
if { ($alive && [IsRunning $vm]) || !$alive} {
lappend masters $vm
}
}
}
return $masters
}
# ::cluster::swarmmode::mode -- Node mode
#
# Return the mode of the node as of the Swarm Mode terminology. This respects
# the clustering mode (as we still support the old Docker Swarm), and the
# ability to turn off swarming for machines (including the ability to specify
# swarming options).
#
# Arguments:
# vm Virtual machine description dictionary.
#
# Results:
# manager, worker or empty string
#
# Side Effects:
# None
proc ::cluster::swarmmode::mode { vm } {
# Check if running new swarm mode
if { [string match -nocase "swarm*mode" \
[dict get $vm cluster -clustering]] } {
# Check if we haven't turned off swarming for that node, this is
# convoluted because we both access swarm as a boolean, but also as a
# dictionary containing swarming options.
if { ([dict exists $vm -swarm] \
&& (([string is boolean -strict [dict get $vm -swarm]] \
&& ![string is false [dict get $vm -swarm]])
|| ![string is boolean -strict [dict get $vm -swarm]])) \
|| ![dict exists $vm -swarm] } {
# Check node mode, master or not
if { [dict exists $vm -master] && [dict get $vm -master] } {
return "manager"
} else {
return "worker"
}
}
}
return ""; # Catch all for all non-cases
}
# ::cluster::swarmmode::join -- join/initiate swarm
#
# Provided a number of possible masters (marked with the master key in the
# YAML description), this procedure will arrange for the machine which
# description is passed as a parameter to join the swarm. If the maching
# should be a manager and no masters are alive, then the swarm is deemed
# non-initiated and will be iniitiated on that machine.
#
# Arguments:
# vm Virtual machine description dictionary.
# masters List of possible masters (dictionaries themselves)
#
# Results:
# Return the node ID inside the Swarm of the machine that was attached to the
# swarm, or an empty string.
#
# Side Effects:
# None
proc ::cluster::swarmmode::join { vm masters } {
# Construct a list of the running managers that are not the machine that we
# want to make part of the cluster
set managers [Managers $masters $vm]
# Now initialise or join (in most cases) the cluster
if { [llength $managers] == 0 } {
# No running managers and the machine we are "joining" is a manager
# itself, then we deem the cluster to be uninitialise and initialise it.
if { [mode $vm] eq "manager" } {
log INFO "No running managers, initialising cluster"
return [Init $vm]
} else {
log WARN "Cannot join a non-running cluster!"
}
} else {
# Pick a manager to use when joining the cluster
set mgr [PickManager $managers]
if { [dict exists $mgr -name] } {
# Get the (cached?) tokens for joining the cluster
lassign [Tokens $mgr] tkn_mngr tkn_wrkr
if { $tkn_mngr eq "" || $tkn_wrkr eq "" } {
log WARN "Cannot join swarm without available tokens!"
} else {
# Get the swarm address to use for the manager
set mnm [dict get $mgr -name]
set addr [tooling machine -return -- \
-s [storage $vm] ssh $mnm \
"docker node inspect --format '{{ .ManagerStatus.Addr }}' self"]
set addr [string trim $addr]
if { $addr ne "" } {
set nm [dict get $vm -name]
# Construct joining command
set cmd [list docker swarm join]
Options cmd join $vm
# Add token and ip address of master that we communicate with
set mode [mode $vm]
if { $mode eq "manager" } {
lappend cmd --token $tkn_mngr $addr
} else {
lappend cmd --token $tkn_wrkr $addr
}
# Join and check result
set res [tooling machine -return -- -s [storage $vm] ssh $nm $cmd]
if { [string match "*swarm*${mode}*" $res] } {
# Ask manager about whole swarm state and find out the
# identifier of the newly created node.
set state [tooling machine -return -- -s [storage $vm] ssh $mnm "docker node ls"]
foreach m [tooling parser $state [list "MANAGER STATUS" "MANAGER_STATUS"]] {
if { [dict exists $m id] && [dict exists $m hostname] } {
if { [dict get $m hostname] eq $nm } {
set id [string trim [dict get $m id] " *"]
log NOTICE "Machine $nm joined swarm as $mode as node $id"
return $id
}
}
}
log WARN "Machine $nm not visible in swarm (yet?)"
} else {
log WARN "Machine $nm could not join swarm as $mode: $res"
}
} else {
log WARN "Cannot find swarm address of manager: [dict get $mgr -name]"
}
}
} else {
log WARN "No running manager available to join swarm cluster!"
}
}
return ""; # Catch all for errors
}
proc ::cluster::swarmmode::autolabel { vm masters } {
set nm [dict get $vm -name]
set labels [list]; # List of non-namespaced labels to add
foreach s ${vars::-autolabel} {
set s [string tolower [string trim $s .]]
switch -- $s {
"os" {
log INFO "Collecting OS information for $nm"
# OS Information
dict for {k v} [unix release $vm] {
lappend labels $s.[CleanString $k] $v
}
}
"cpu" {
log INFO "Collecting CPU information for $nm"
set hook [pseudofs configure -hook]
pseudofs configure -hook [list [namespace current]::PseudoFS $vm]
set cpus [procfs cpuinfo]
dict for {k v} [lindex $cpus 0] {
lappend labels $s.[CleanString $k] $v
}
if { ${vars::-autocpu} ne "" } {
lappend labels $s.[string trimleft ${vars::-autocpu} .] [llength $cpus]
}
pseudofs configure -hook $hook
}
"storage" {
log INFO "Collecting storage information for $nm"
set hook [pseudofs configure -hook]
pseudofs configure -hook [list [namespace current]::PseudoFS $vm]
set devices [sysfs lsblk -deny loop*]
set names [list]
foreach dev $devices {
dict for {k v} $dev {
if { [dict exists $vars::lsblk $k] } {
set k [dict get $vars::lsblk $k]
} else {
set k [string tolower $k]
}
if { $k eq "name" } {
lappend names $v
} else {
lappend labels $s.[dict get $dev NAME].[CleanString $k] $v
}
}
}
if { ${vars::-autostorage} ne "" } {
lappend labels $s.[string trimleft ${vars::-autostorage} .] $names
}
pseudofs configure -hook $hook
}
}
}
if { [llength $labels] } {
set human ""
set labelling {}
foreach {k v} $labels {
lappend labelling \
--label-add \
[string trimright ${vars::-prefix} .].$k=\"[environment quote $v]\"
append human "\n$k = $v"
}
log NOTICE "Automatically labelling $nm within ${vars::-autolabel} namespace"
log INFO "Labelling $nm with:$human"
node $masters update {*}$labelling $nm
}
}
# ::cluster::swarmmode::leave -- Leave swarm
#
# Arrange for the machine passed as a parameter to leave the swarm. Leaving is
# done in gentle form, i.e. managers are first demoted and are only forced out
# whenever Docker says so. This leaves a chance to other managers to pick up
# the state and for other workers to pick up the tasks.
#
# Arguments:
# vm Virtual machine description dictionary.
#
# Results:
# None
#
# Side Effects:
# None
proc ::cluster::swarmmode::leave { vm masters } {
set nm [dict get $vm -name]
switch -- [mode $vm] {
"manager" {
# Demote the manager from the swarm so it can gracefully handover state
# to other managers.
tooling machine -- -s [storage $vm] ssh $nm "docker node demote $nm"
set response [tooling machine -return -stderr \
-- -s [storage $vm] ssh $nm "docker swarm leave"]
if { [string match "*`--force`*" $response] } {
log NOTICE "Forcing node $nm out of swarm!"
tooling machine -- -s [storage $vm] ssh $nm "docker swarm leave --force"
}
}
"worker" {
tooling machine -- -s [storage $vm] ssh $nm "docker swarm leave"
}
}
}
# ::cluster::swarmmode::network -- create/destroy networks
#
# This procedure will arrange for the creation/deletion of cluster-wide
# networks. These are usually overlay networks that can be declared as
# external in stack definition files so that several stacks can exchange
# information. Creation and deletion occurs via a randomly chosen running
# managers among the possible masters.
#
# Arguments:
# cmd command: create or delete (aliases are available.)
# net Dictionary describing the network, mostly options to docker
# masters List of possible masters (dictionaries themselves)
#
# Results:
# None
#
# Side Effects:
# None
proc ::cluster::swarmmode::network { masters cmd net } {
# Pick a manager to use for network operations
set managers [Managers $masters]
set mgr [PickManager $managers]
if { [dict exists $mgr -name] } {
set nm [dict get $mgr -name]
switch -nocase -- $cmd {
"up" -
"create" {
set id [NetworkID $mgr [dict get $net -name]]
if { $id eq "" } {
# Construct network creation command out of network definition
set cmd [list docker network create]
dict for {k v} $net {
if { $k ne "-name" && [string match -* $k] } {
lappend cmd --[string trimleft $k -]=$v
}
}
lappend cmd [dict get $net -name]
set id [tooling machine -return -- -s [storage $mgr] ssh $nm $cmd]
log NOTICE "Created swarm-wide network $id"
}
return $id
}
"destroy" -
"delete" -
"rm" -
"remove" -
"down" {
tooling machine -- -s [storage $mgr] ssh $nm "docker network rm $net"
}
}
} else {
log WARN "No running manager to pick for network operation: $cmd"
}
return 0
}
# ::cluster::swarmmode::node -- pure docker node relay
#
# Relays docker node command randomly to one of the masters.
#
# Arguments:
# masters List of masters
# cmd docker node sub-command to relay
# args Arguments to sub-command
#
# Results:
# None.
#
# Side Effects:
# Calls docker node on one of the masters and relays its output.
proc ::cluster::swarmmode::node { masters cmd args } {
# Pick a manager to use for stack operations
set managers [Managers $masters]
set mgr [PickManager $managers]
if { [dict exists $mgr -name] } {
set nm [dict get $mgr -name]
tooling machine -- -s [storage $mgr] ssh $nm \
docker node $cmd {*}$args
} else {
log WARN "No running manager to pick for node operation: $cmd"
}
}
# ::cluster::swarmmode::stack -- docker stack relay
#
# Relays docker stack command randomly to one of the masters. Most
# sub-commands are blindly relayed to the elected master for execution, but
# deploy goes through some extra processing. First, this implementatio will
# linearise the YAML content so that it is still possible to use 'extends'
# constructs (from v2 format) in v3 format. Secondly all files that are
# pointed at by the compose file will be copied to the manager. Finally,
# the YAML file for deployment is sent over, but modified in order to point
# at the local copies of the depending files.
#
# Arguments:
# masters List of masters
# cmd docker stack sub-command to relay
# args Arguments to sub-command
#
# Results:
# None.
#
# Side Effects:
# Calls docker stack on one of the masters and relays its output.
proc ::cluster::swarmmode::stack { masters cmd args } {
# Pick a manager to use for stack operations
set managers [Managers $masters]
set mgr [PickManager $managers]
if { [dict exists $mgr -name] } {
set nm [dict get $mgr -name]
# Recognise dot-led commands as commands that we should execute and
# return results for (instead of regular terminal output). This is
# a bit of a hack...
set return 0
if { [string match .* $cmd] } {
set return 1
set cmd [string range $cmd 1 end]
}
switch -nocase -- $cmd {
"up" -
"deploy" {
# Capture up and deploy (they are aliases within the set of
# docker stack commands). This is in order to benefit from some
# of the compose v2 features in v3 formatted files, but also to
# be able to forward all underlying files to the manager
# (temporarily) before deployment.
# Immediate bypassed if we hade requested for return
if { $return } {
return [tooling machine -return -- -s [storage $mgr] ssh $nm \
docker stack $cmd {*}$args]
}
# Start by detecting the compose file that is used for
# deployment.
set fname ""
if { ![utils getopt args -c fname] } {
utils getopt args --compose-file fname
}
if { $fname ne "" } {
# Resolve file to absolute location
set c_fname [AbsolutePath $mgr $fname]
if { [catch {open $c_fname} fd] } {
log WARN "Cannot open stack description file: $fd"
} else {
# Prepare a directory for (temporary) storage of related
# files at the manager. We use the name of the directory
# holding the compose file together with the name of the
# compose file to make this something we can easily
# understand and debug in.
set dirbase [file tail [file dirname $c_fname]]-[file rootname [file tail $c_fname]]
set tmp_dirname [utils temporary [file join [utils tmpdir] $dirbase]]
log INFO "Temporarily copying all files included by $c_fname to $nm in $tmp_dirname"
tooling machine -stderr -- -s [storage $mgr] ssh $nm mkdir -p $tmp_dirname
# Linearise content of compose file into a huddle
# representation that does not contain any 'extends'
# references (this is what our friend-tool baclin does)
set hdl [extend linearise2huddle [read $fd] [file dirname $c_fname]]
close $fd
# Now detects all files that are pointed at by the
# compose file and collect then so we will be copying
# them.
set copies [list]
set services [huddle get $hdl "services"]
foreach name [huddle keys $services] {
set service [huddle get $services $name]
foreach k [huddle keys $service] {
switch -- $k {
"env_file" {
set v [huddle get $service $k]
if { [string match "str*" [huddle type $v]] } {
set fname [huddle get_stripped $service $k]
set dst_fname [SCopy $mgr [file dirname $c_fname] $fname $tmp_dirname]
huddle set service $k $dst_fname
} else {
# Empty v (which will keep its type)
while {[huddle llength $v]} {
huddle remove $v 0
}
# Copy files to destination and
# account for location in v
# again.
foreach fname [huddle get stripped $service $k] {
huddle append v [SCopy $mgr [file dirname $c_fname] $fname $tmp_dirname]
}
# Set back into service.
huddle set service $k $v
}
}
}
}
huddle set services $name $service
}
huddle set hdl services $services
Inline $mgr hdl "configs" [file dirname $c_fname] $fname $tmp_dirname
Inline $mgr hdl "secrets" [file dirname $c_fname] $fname $tmp_dirname
# Now create local temporary file to host manipulated
# content in and copy it to the remote host.
set tmp_fname [utils temporary [file join [utils tmpdir] [file rootname [file tail $c_fname]].yml]]
log INFO "Linearising content into $tmp_fname"
set yaml [extend huddle2yaml $hdl]
if { [catch {open $tmp_fname w} ofd] } {
log WARN "Cannot create temporary file for linearised content: $fd"
} else {
puts $ofd $yaml
close $ofd
log NOTICE "Deploying stack [lindex $args end] from files at $tmp_dirname"
set dst_fname [file join $tmp_dirname [file tail $tmp_fname]]
tooling machine -stderr -- -s [storage $mgr] scp $tmp_fname ${nm}:$dst_fname
tooling machine -- -s [storage $mgr] ssh $nm \
docker stack deploy --compose-file $dst_fname {*}$args
tooling machine -stderr -- -s [storage $mgr] ssh $nm rm -rf $tmp_dirname
file delete -force -- $tmp_fname
}
}
} else {
log WARN "No compose file specified!"
tooling machine -- -s [storage $mgr] ssh $nm \
docker stack $cmd --help
}
}
"__truename" {
set truenames [list]
# This is an internal command!
set stacks [tooling parser [stack $masters .ls]]
foreach name $args {
lappend truenames $name
foreach running $stacks {
if { [dict exists $running name] \
&& [NameCmp [dict get $running name] $name] } {
set truenames [lreplace $truenames end end [dict get $running name]]
break
}
}
}
return $truenames
}
"ps" -
"services" {
# Trying resolving last argument (the stack name) to something
# that really runs.
set stack [stack $masters __truename [lindex $args end]]
set args [lreplace $args end end $stack]
# In all other cases, we simply forward everything to docker
# stack, which allows us to be forward compatible with any
# command that it provides now and might provide in the future.
if { $return } {
return [tooling machine -return -- -s [storage $mgr] ssh $nm \
docker stack $cmd {*}$args]
} else {
tooling machine -- -s [storage $mgr] ssh $nm \
docker stack $cmd {*}$args
}
}
"remove" -
"down" -
"rm" {
# All arguments are stack names, trying resolving all of them
set args [stack $masters __truename {*}$args]
# In all other cases, we simply forward everything to docker
# stack, which allows us to be forward compatible with any
# command that it provides now and might provide in the future.
if { $return } {
return [tooling machine -return -- -s [storage $mgr] ssh $nm \
docker stack $cmd {*}$args]
} else {
tooling machine -- -s [storage $mgr] ssh $nm \
docker stack $cmd {*}$args
}
}
default {
# In all other cases, we simply forward everything to docker
# stack, which allows us to be forward compatible with any
# command that it provides now and might provide in the future.
if { $return } {
return [tooling machine -return -- -s [storage $mgr] ssh $nm \
docker stack $cmd {*}$args]
} else {
tooling machine -- -s [storage $mgr] ssh $nm \
docker stack $cmd {*}$args
}
}
}
} else {
log WARN "No running manager to pick for stack operation: $cmd"
}
}
####################################################################
#
# Procedures below are internal to the implementation, they shouldn't
# be changed unless you wish to help...
#
####################################################################
proc ::cluster::swarmmode::RemoveCache { } {
if { [dict size $vars::pseudofs] } {
log INFO "Cleaning residual HW inventory cache"
dict for {fd fpath} $vars::pseudofs {
file delete -force -- $fpath
}
set vars::pseudofs [dict create]
}
}
proc ::cluster::swarmmode::PseudoFS { vm cmd args } {
set nm [dict get $vm -name]
# Install an atExit hook to clean away the copy of the various HW inventory
# files that we are going to bring in from the remote machine. Normally,
# the cache will be empty as we remove at once (see close implementation
# below). It will only execute and remove temporary files whenever machinery
# is interrupted for quiting.
if { ! $vars::exitHook } {
atExit [namespace current]::RemoveCache
set vars::exitHook 1
}
# This is the procfs hook that will pick the files from the remote locations instead.
switch -nocase -- $cmd {
"open" {
set fpath [lindex $args 0]
set tmp_fname [utils temporary [file join [utils tmpdir] [file rootname [file tail $fpath]]]]
log DEBUG "Temporary getting $fpath from $nm"
# Copy to local temporary file first through using cat as we need
# access to the pseudo filesystems on the remote side (and these do
# not exist when running scp). Note that this is hardly generic
# enough and will only work on text files, but these are the target
# of this implemenation so we are safe for now.
set content [tooling machine -return -keepblanks -- -s [storage $vm] ssh $nm cat ${fpath}]
set fd [open $tmp_fname w]
foreach l $content {
puts $fd $l
}
close $fd
# Now open the local copy as requested, i.e. with the requested
# arguments and return the file descriptor. We remember about the
# association in a global dictionary.
set fd [open $tmp_fname {*}[lrange $args 1 end]]
dict set vars::pseudofs $fd $tmp_fname
return $fd
}
"close" {
set fd [lindex $args 0]
# Close descriptor and clean away temporary file from disk.
if { [dict exists $vars::pseudofs $fd] } {
close $fd
file delete -force -- [dict get $vars::pseudofs $fd]
dict unset vars::pseudofs $fd
}
}
"glob" {
# The following is basically a reimplementation of the glob Tcl
# command on top of the minimal subset of ls command options.
# Get arguments as specified
lassign $args dirname pattern
set args [lrange $args 2 end]
# Collect glob options to reimplement on top of ls
set tails [utils getopt args -tails]
utils getopt args -types types {b c d f l p s r w x}
set fpaths [list]
foreach fpath [tooling machine -return -- -s [storage $vm] ssh $nm \
ls -1FdL ${dirname}/${pattern}] {
set last [string index $fpath end]
switch -- $last {
"*" {
if { "x" in $types } {
set fpath [string range $fpath 0 end-1]
}
}
"/" {
if { "d" in $types } {
set fpath [string range $fpath 0 end-1]
}
}
"=" {
if { "s" in $types } {
set fpath [string range $fpath 0 end-1]
}
}
"@" {
if { "l" in $types } {
set fpath [string range $fpath 0 end-1]
}
}
"|" {
if { "p" in $types } {
set fpath [string range $fpath 0 end-1]
}
}
default {
set fpath ""
}
}
if { $tails } {
set fpath [file tail $fpath]
}
if { $fpath ne "" } {
lappend fpaths $fpath
}
}
return $fpaths
}
default {
log ERROR "$cmd not yet implemented"
}
}
}
# ::cluster::swarmmode::Inline -- Huddle inlining
#
# Detects if a main key in the huddle representation of a YAML file
# contains a specific subkey (defaults to 'file'). Whenver that sub-key
# exists, the file that it points at is copied to a swarm manager and the
# huddle representation is modified so as to point at the path to the copy
# at the manager.
#
# Arguments:
# mgr Representation of the manager machine
# hdl_ Huddle representation to look into and possibly modify
# mainkey Main key to address
# dir Local directory hosting the file
# fname Name of file source of the huddle representation
# tmp_dirname Name of the remote directory at the manager where to copy files to
# subkey Children key to enquire and possibly modify in huddle representation
#
# Results:
# None.
#
# Side Effects:
# Modifies the huddle representation so that it points at the remote file instead
proc ::cluster::swarmmode::Inline { mgr hdl_ mainkey dir fname tmp_dirname { subkey "file" } } {
upvar $hdl_ hdl
if { $mainkey in [huddle keys $hdl] } {
set configs [huddle get $hdl $mainkey]
foreach name [huddle keys $configs] {
set config [huddle get $configs $name]
if { "$subkey" in [huddle keys $config] } {
set v [huddle get $config $subkey]
set fname [huddle get_stripped $config $subkey]
set dst_fname [SCopy $mgr $dir $fname $tmp_dirname]
set config [string map [list [huddle get_stripped $config $subkey] $dst_fname] $config]
#huddle set config $subkey $dst_fname
}
huddle set configs $name $config
}
huddle set hdl $mainkey $configs
} else {
log DEBUG "No key $mainkey found, but this is ok!"
}
}
# ::cluster::swarmmode::SCopy -- Temporary manager file copy
#
# Copy a file to a manager within a dedicated directory. A temporary name
# for the destination file will be generated in a way that makes it easy to
# detect the name of the source file.
#
# Arguments:
# mgr Representation of the manager machine
# dir Local directory hosting the file
# fname Name of file to copy
# tmp_dirname Name of the remote directory at the manager where to copy files to
#
# Results:
# The full path to the remote copy or an empty string on errors.
#
# Side Effects:
# None.
proc ::cluster::swarmmode::SCopy { mgr dir fname tmp_dirname } {
set nm [dict get $mgr -name]
set src_fname [file join $dir $fname]
if { [file exists $src_fname] } {
set dst_fname [utils temporary [file join $tmp_dirname [file rootname [file tail $fname]]]]
tooling machine -stderr -- -s [storage $mgr] scp $src_fname ${nm}:$dst_fname
return $dst_fname
} else {
log WARN "Cannot access file at $src_fname!"
}
return ""
}
# ::cluster::swarmmode::Init -- Initialise first node of swarm
#
# Initialise the swarm, arranging for the virtual machine passed as an
# argument to be the (first) manager in the swarm.
#
# Arguments:
# vm Virtual machine description dictionary.
#
# Results:
# Return the swarm node identifier of the (first) manager.
#
# Side Effects:
# None
proc ::cluster::swarmmode::Init { vm } {
if { [mode $vm] eq "manager" } {
set nm [dict get $vm -name]
set cmd [list docker swarm init]
Options cmd init $vm
set res [tooling machine -return -- -s [storage $vm] ssh $nm $cmd]
if { [regexp {.*\(([a-z0-9]+)\).*manager.*} $res mtch id] } {
log NOTICE "Initialised machine $nm as node $id in swarm"
# Arrange to cache information abount manager and swarm
if { [TokenStore $vm] } {
lassign [TokenCache $vm] mngr wrkr
log INFO "Generated swarm tokens -- Managers: $mngr, Workers: $wrkr"
}
return $res
} else {
log WARN "Could not initialise swarm on $nm: $res"
}
}
return ""; # Catch all errors
}
# ::cluster::swarmmode::NetworkID -- Get Swarm network ID
#
# Actively ask a manager for the node identifier of a machine in the cluster.
#
# Arguments:
# mgr Virtual machine description dictionary of a manager.
# name Name of the machine to query
#
# Results:
# Return the complete node identifier of the machine within the swarm, or an
# empty string.
#
# Side Effects:
# None
proc ::cluster::swarmmode::NetworkID { mgr name } {
set nm [dict get $mgr -name]
set networks [tooling machine -return -- -s [storage $mgr] ssh $nm "docker network ls --no-trunc=true"]
foreach n [tooling parser $networks [list "NETWORK ID" NETWORK_ID]] {
if { [dict exists $n name] && [dict get $n name] eq $name } {
return [dict get $n network_id]
}
}
return ""
}
# ::cluster::swarmmode::Options -- Append command with swarm options.
#
# Pick swarm specific options for join/initialisation from virtual machine and
# append these to a command (being constructed).
#
# Arguments:
# cmd_ "POinter" to command to modify
# mode Mode: join or init supported in YAML right now.
# vm Virtual machine description dictionary, containing swarm-specific options..
#
# Results:
# None
#
# Side Effects:
# Modifies the command!
proc ::cluster::swarmmode::Options { cmd_ mode vm } {
upvar $cmd_ cmd
# Pick init options if there are some from swarm
if { [dict exists $vm -swarm] \
&& ![string is boolean -strict [dict get $vm -swarm]] } {
if { [dict exists $vm -swarm $mode] } {
dict for {o v} [dict get $vm -swarm $mode] {
lappend cmd --[string trimleft $o -] $v
}
}
}
}
# ::cluster::swarmmode::PickManager -- Pick a manager
#
# Pick a manager at random
#
# Arguments:
# managers List of managers to pick from
# ptn Pattern to match on names to restrict set of candidates.
#
# Results:
# The dictionary representing the managers that was chosen.
#
# Side Effects:
# None
proc ::cluster::swarmmode::PickManager { managers { ptn * } } {
# Build a list of possible candidates based on the name pattern
set candidates {}
foreach vm $managers {
if { [string match $ptn [dict get $vm -name]] } {
lappend candidates $vm
}
}
# Choose one!
set len [llength $candidates]
if { $len > 0 } {
set vm [lindex $candidates [expr {int(rand()*$len)}]]
log INFO "Picked manager [dict get $vm -name] to operate on swarm"
return $vm
} else {
log WARN "Cannot find any manager matching $ptn!"
}
return [list]
}
# ::cluster::swarmmode::Managers -- Running managers
#
# Return the list of possible managers out of a number of declared masters.
# Managers need to be running and this procedure will check their status.This
# procedure is also able to avoid a virtual machine from the set of returned
# managers.
#
# Arguments:
# masters List of possible managers.
# vm Virtual machine to exclude from the list.
#
# Results:
# List of running managers that are candidates for swarm mode operations.
#
# Side Effects:
# None
proc ::cluster::swarmmode::Managers { masters {vm {}}} {
# Construct a list of the running managers that are not the machine that we
# want to make part of the cluster
set managers [list]
foreach mch $masters {
if { (![dict exists $vm -name] \
|| [dict get $mch -name] ne [dict get $vm -name]) \
&& [IsRunning $mch] } {
lappend managers $mch