]>
Commit | Line | Data |
---|---|---|
f83e7e6e TL |
1 | package PVE::HA::FenceConfig; |
2 | ||
3 | use strict; | |
4 | use warnings; | |
5 | use PVE::Tools; | |
6 | use PVE::Cluster qw(cfs_register_file cfs_read_file cfs_write_file); | |
7 | use Data::Dumper; | |
8 | ||
9 | my $__die = sub { | |
10 | my ($fn, $lineno, $error_message) = @_; | |
11 | ||
12 | die "error in '$fn' at $lineno: $error_message\n"; | |
13 | }; | |
14 | ||
15 | sub parse_config { | |
16 | my ($fn, $raw) = @_; | |
17 | ||
18 | $raw = '' if !$raw; | |
19 | ||
20 | my $config = {}; | |
21 | ||
22 | my $lineno = 0; | |
23 | my $priority = 0; | |
24 | ||
25 | while ($raw =~ /^\h*(.*?)\h*$/gm) { | |
26 | my $line = $1; | |
27 | $lineno++; | |
28 | ||
29 | next if !$line || $line =~ /^#/; | |
30 | ||
31 | if ($line =~ m/^(device|connect)\s+(\S+)\s+(\S+)\s+(.+)$/) { | |
32 | my ($command, $dev_name, $target) = ($1, $2, $3); | |
33 | ||
34 | # allow spaces, and other special chars inside of quoted strings | |
35 | # with escape support | |
36 | my @arg_array = $4 =~ /(\w+(?:=(?:(?:\"(?:[^"\\]|\\.)*\")|\S+))?)/g; | |
37 | ||
38 | my $dev_number = 1; # default | |
39 | ||
40 | # check for parallel devices | |
41 | if ($dev_name =~ m/^(\w+)(:(\d+))?/) { | |
42 | $dev_name = $1; | |
43 | $dev_number = $3 if $3; | |
44 | } | |
45 | ||
46 | if ($command eq "device") { | |
47 | ||
48 | my $dev = $config->{$dev_name} || {}; | |
49 | ||
50 | &$__die($fn, $lineno, "device '$dev_name:$dev_number' already declared") | |
51 | if ($dev && $dev->{sub_devs}->{$dev_number}); | |
52 | ||
53 | $dev->{sub_devs}->{$dev_number} = { | |
54 | agent => $target, | |
55 | args => [ @arg_array ] | |
56 | }; | |
57 | $dev->{priority} = $priority++ if !$dev->{priority}; | |
58 | ||
59 | $config->{$dev_name} = $dev; | |
60 | ||
61 | } else { # connect nodes to devices | |
62 | ||
63 | &$__die($fn, $lineno, "device '$dev_name' must be declared before" . | |
64 | " you can connect to it") if !$config->{$dev_name}; | |
65 | ||
66 | &$__die($fn, $lineno, "No parallel device '$dev_name:$dev_number' found") | |
67 | if !$config->{$dev_name}->{sub_devs}->{$dev_number}; | |
68 | ||
69 | my $sdev = $config->{$dev_name}->{sub_devs}->{$dev_number}; | |
70 | ||
71 | my ($node) = $target =~ /node=(\w+)/; | |
72 | &$__die($fn, $lineno, "node=nodename needed to connect device ". | |
73 | "'$dev_name' to node") if !$node; | |
74 | ||
75 | &$__die($fn, $lineno, "node '$node' already connected to device ". | |
76 | "'$dev_name:$dev_number'") if $sdev->{node_args}->{$node}; | |
77 | ||
78 | $sdev->{node_args}->{$node} = [ @arg_array ]; | |
79 | ||
80 | $config->{$dev_name}->{sub_devs}->{$dev_number} = $sdev; | |
81 | ||
82 | } | |
83 | ||
84 | } else { | |
85 | warn "$fn ignore line $lineno: $line\n" | |
86 | } | |
87 | } | |
88 | ||
89 | return $config; | |
90 | ||
91 | } | |
92 | ||
93 | sub write_config { | |
94 | my ($fn, $data) = @_; | |
95 | ||
96 | my $raw = ''; | |
97 | ||
98 | foreach my $dev_name (sort {$a->{priority} <=> $b->{priority}} keys %$data) { | |
99 | my $d = $data->{$dev_name}; | |
100 | ||
101 | foreach my $sub_dev_nr (sort keys %{$d->{sub_devs}}) { | |
102 | my $sub_dev = $d->{sub_devs}->{$sub_dev_nr}; | |
103 | my $dev_arg_str = join (' ', @{$sub_dev->{args}}); | |
104 | ||
105 | $raw .= "\ndevice $dev_name:$sub_dev_nr $sub_dev->{agent} $dev_arg_str\n"; | |
106 | ||
107 | foreach my $node (sort keys %{$sub_dev->{node_args}}) { | |
108 | my $node_arg_str = join (' ', @{$sub_dev->{node_args}->{$node}}); | |
109 | ||
110 | $raw .= "connect $dev_name:$sub_dev_nr $node_arg_str\n"; | |
111 | } | |
112 | } | |
113 | } | |
114 | ||
115 | return $raw; | |
116 | } | |
117 | ||
118 | ||
119 | ||
120 | sub gen_arg_str { | |
121 | my (@arguments) = @_; | |
122 | ||
123 | my @shell_args = (); | |
124 | foreach my $arg (@arguments) { | |
125 | # we need to differ long and short opts! | |
126 | my $prefix = (length($arg) == 1) ? '-' : '--'; | |
127 | push @shell_args, "$prefix$arg"; | |
128 | } | |
129 | ||
130 | return join (' ', @shell_args); | |
131 | } | |
132 | ||
133 | ||
134 | # returns command list to execute, | |
135 | # can be more than one command if parallel devices are configured | |
136 | # 'try' denotes the number of devices we should skip and normaly equals to | |
137 | # failed fencing tries | |
138 | sub get_commands { | |
139 | my ($node, $try, $config) = @_; | |
140 | ||
141 | return undef if !$node || !$config; | |
142 | ||
143 | $try = 0 if !$try || $try<0; | |
144 | ||
145 | foreach my $device (sort {$a->{priority} <=> $b->{priority}} values %$config) { | |
146 | my @commands; | |
147 | ||
148 | #foreach my $sub_dev (values %{$device->{sub_devs}}) { | |
149 | foreach my $sub_dev_nr (sort keys %{$device->{sub_devs}}) { | |
150 | my $sub_dev = $device->{sub_devs}->{$sub_dev_nr}; | |
151 | ||
152 | if (my $node_args = $sub_dev->{node_args}->{$node}) { | |
153 | push @commands, { agent=>$sub_dev->{agent}, | |
154 | sub_dev => $sub_dev_nr, | |
155 | param => [@{$sub_dev->{args}}, @{$node_args}]}; | |
156 | } | |
157 | ||
158 | } | |
159 | ||
160 | if (@commands>0) { | |
161 | $try--; | |
162 | return [ @commands ] if $try<0; | |
163 | } | |
164 | } | |
165 | ||
166 | # out of tries or no device for this node | |
167 | return undef; | |
168 | } | |
169 | ||
170 | ||
171 | sub count_devices { | |
172 | my ($node, $config) = @_; | |
173 | ||
174 | my $count = 0; | |
175 | ||
176 | return 0 if !$config; | |
177 | ||
178 | foreach my $device (values %$config) { | |
179 | foreach my $sub_dev (values %{$device->{sub_devs}}) { | |
180 | if ($sub_dev->{node_args}->{$node}) { | |
181 | $count++; | |
182 | last; # no need to count parallel devices | |
183 | } | |
184 | } | |
185 | } | |
186 | ||
187 | return $count; | |
188 | } | |
189 | ||
190 | 1; |