]>
Commit | Line | Data |
---|---|---|
27bfc7c6 DM |
1 | package PVE::RADOS; |
2 | ||
3 | use 5.014002; | |
4 | use strict; | |
5 | use warnings; | |
6 | use Carp; | |
7 | use JSON; | |
9539bd37 | 8 | use Socket; |
8172535c | 9 | use PVE::Tools; |
e2171b36 DM |
10 | use PVE::INotify; |
11 | use PVE::RPCEnvironment; | |
12 | ||
27bfc7c6 DM |
13 | require Exporter; |
14 | ||
8172535c DM |
15 | my $rados_default_timeout = 5; |
16 | ||
17 | ||
27bfc7c6 DM |
18 | our @ISA = qw(Exporter); |
19 | ||
20 | # Items to export into callers namespace by default. Note: do not export | |
21 | # names by default without a very good reason. Use EXPORT_OK instead. | |
22 | # Do not simply export all your public functions/methods/constants. | |
23 | ||
24 | # This allows declaration use PVE::RADOS ':all'; | |
25 | # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK | |
26 | # will save memory. | |
27 | our %EXPORT_TAGS = ( 'all' => [ qw( | |
28 | ||
29 | ) ] ); | |
30 | ||
31 | our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); | |
32 | ||
33 | our @EXPORT = qw( | |
34 | ||
35 | ); | |
36 | ||
37 | our $VERSION = '1.0'; | |
38 | ||
39 | require XSLoader; | |
40 | XSLoader::load('PVE::RADOS', $VERSION); | |
41 | ||
9539bd37 DM |
42 | my $writedata = sub { |
43 | my ($fh, $cmd, $data) = @_; | |
44 | ||
45 | local $SIG{PIPE} = 'IGNORE'; | |
46 | ||
47 | my $bin = pack "a L/a*", $cmd, $data || ''; | |
48 | my $res = syswrite $fh, $bin; | |
49 | ||
50 | die "write data failed - $!\n" if !defined($res); | |
51 | }; | |
612779b1 | 52 | |
9539bd37 | 53 | my $readdata = sub { |
8172535c | 54 | my ($fh) = @_; |
27bfc7c6 | 55 | |
9539bd37 | 56 | my $head = ''; |
612779b1 | 57 | |
9539bd37 | 58 | local $SIG{PIPE} = 'IGNORE'; |
612779b1 | 59 | |
9539bd37 DM |
60 | while (length($head) < 5) { |
61 | last if !sysread $fh, $head, 5 - length($head), length($head); | |
612779b1 | 62 | } |
9539bd37 DM |
63 | die "partial read\n" if length($head) < 5; |
64 | ||
65 | my ($cmd, $len) = unpack "a L", $head; | |
612779b1 | 66 | |
9539bd37 DM |
67 | my $data = ''; |
68 | while (length($data) < $len) { | |
69 | last if !sysread $fh, $data, $len - length($data), length($data); | |
70 | } | |
71 | die "partial data read\n" if length($data) < $len; | |
72 | ||
8172535c DM |
73 | return wantarray ? ($cmd, $data) : $data; |
74 | }; | |
75 | ||
76 | my $kill_worker = sub { | |
77 | my ($self) = @_; | |
78 | ||
79 | return if !$self->{cpid}; | |
80 | return if $self->{__already_killed}; | |
81 | ||
82 | $self->{__already_killed} = 1; | |
83 | ||
84 | close($self->{child}) if defined($self->{child}); | |
85 | ||
187aea70 DM |
86 | # only kill if we created the process |
87 | return if $self->{pid} != $$; | |
88 | ||
8172535c DM |
89 | kill(9, $self->{cpid}); |
90 | waitpid($self->{cpid}, 0); | |
91 | }; | |
92 | ||
93 | my $sendcmd = sub { | |
94 | my ($self, $cmd, $data, $expect_tag) = @_; | |
95 | ||
96 | $expect_tag = '>' if !$expect_tag; | |
97 | ||
187aea70 DM |
98 | die "detected forked connection" if $self->{pid} != $$; |
99 | ||
8172535c DM |
100 | my ($restag, $raw); |
101 | my $code = sub { | |
102 | &$writedata($self->{child}, $cmd, $data) if $expect_tag ne 'S'; | |
103 | ($restag, $raw) = &$readdata($self->{child}); | |
104 | }; | |
105 | eval { PVE::Tools::run_with_timeout($self->{timeout}, $code); }; | |
106 | if (my $err = $@) { | |
107 | &$kill_worker($self); | |
108 | die $err; | |
109 | } | |
110 | if ($restag eq 'E') { | |
111 | die $raw if $raw; | |
112 | die "unknown error\n"; | |
9539bd37 | 113 | } |
27bfc7c6 | 114 | |
8172535c DM |
115 | die "got unexpected result\n" if $restag ne $expect_tag; |
116 | ||
117 | return $raw; | |
9539bd37 DM |
118 | }; |
119 | ||
120 | sub new { | |
121 | my ($class, %params) = @_; | |
122 | ||
e2171b36 DM |
123 | my $rpcenv = PVE::RPCEnvironment::get(); |
124 | ||
9539bd37 DM |
125 | socketpair(my $child, my $parent, AF_UNIX, SOCK_STREAM, PF_UNSPEC) |
126 | || die "socketpair: $!"; | |
127 | ||
128 | my $cpid = fork(); | |
129 | ||
130 | die "unable to fork - $!\n" if !defined($cpid); | |
131 | ||
132 | my $self = bless {}; | |
133 | ||
8172535c DM |
134 | my $timeout = delete $params{timeout} || $rados_default_timeout; |
135 | ||
136 | $self->{timeout} = $timeout; | |
187aea70 | 137 | $self->{pid} = $$; |
8172535c | 138 | |
9539bd37 DM |
139 | if ($cpid) { # parent |
140 | close $parent; | |
141 | ||
142 | $self->{cpid} = $cpid; | |
143 | $self->{child} = $child; | |
144 | ||
8172535c | 145 | &$sendcmd($self, undef, undef, 'S'); # wait for sync |
9539bd37 DM |
146 | |
147 | } else { # child | |
148 | $0 = 'pverados'; | |
e2171b36 DM |
149 | |
150 | PVE::INotify::inotify_close(); | |
151 | ||
152 | if (my $atfork = $rpcenv->{atfork}) { | |
153 | &$atfork(); | |
154 | } | |
155 | ||
9539bd37 DM |
156 | # fixme: timeout? |
157 | ||
158 | close $child; | |
159 | ||
9539bd37 DM |
160 | my $conn; |
161 | eval { | |
162 | $conn = pve_rados_create() || | |
163 | die "unable to create RADOS object\n"; | |
164 | ||
165 | pve_rados_conf_set($conn, 'client_mount_timeout', $timeout); | |
166 | ||
167 | foreach my $k (keys %params) { | |
168 | pve_rados_conf_set($conn, $k, $params{$k}); | |
169 | } | |
170 | ||
171 | pve_rados_connect($conn); | |
172 | }; | |
173 | if (my $err = $@) { | |
174 | &$writedata($parent, 'E', $err); | |
175 | die $err; | |
176 | } | |
177 | &$writedata($parent, 'S'); | |
178 | ||
179 | $self->{conn} = $conn; | |
180 | ||
181 | for (;;) { | |
182 | my ($cmd, $data) = &$readdata($parent); | |
183 | ||
184 | last if $cmd eq 'Q'; | |
185 | ||
186 | my $res; | |
187 | eval { | |
188 | if ($cmd eq 'M') { # rados monitor commands | |
189 | $res = pve_rados_mon_command($self->{conn}, [ $data ]); | |
190 | } elsif ($cmd eq 'C') { # class methods | |
191 | my $aref = decode_json($data); | |
192 | my $method = shift @$aref; | |
193 | $res = encode_json($self->$method(@$aref)); | |
194 | } else { | |
195 | die "invalid command\n"; | |
196 | } | |
197 | }; | |
198 | if (my $err = $@) { | |
199 | &$writedata($parent, 'E', $err); | |
200 | die $err; | |
201 | } | |
202 | &$writedata($parent, '>', $res); | |
203 | } | |
204 | ||
205 | exit(0); | |
206 | } | |
27bfc7c6 DM |
207 | |
208 | return $self; | |
209 | } | |
210 | ||
211 | sub DESTROY { | |
212 | my ($self) = @_; | |
213 | ||
9539bd37 DM |
214 | if ($self->{cpid}) { |
215 | #print "$$: DESTROY WAIT0\n"; | |
8172535c DM |
216 | &$kill_worker($self); |
217 | #print "$$: DESTROY WAIT\n"; | |
9539bd37 DM |
218 | } else { |
219 | #print "$$: DESTROY SHUTDOWN\n"; | |
220 | pve_rados_shutdown($self->{conn}) if $self->{conn}; | |
221 | } | |
27bfc7c6 DM |
222 | } |
223 | ||
224 | sub cluster_stat { | |
9539bd37 DM |
225 | my ($self, @args) = @_; |
226 | ||
227 | if ($self->{cpid}) { | |
228 | my $data = encode_json(['cluster_stat', @args]); | |
8172535c DM |
229 | my $raw = &$sendcmd($self, 'C', $data); |
230 | return decode_json($raw); | |
9539bd37 DM |
231 | } else { |
232 | return pve_rados_cluster_stat($self->{conn}); | |
233 | } | |
27bfc7c6 DM |
234 | } |
235 | ||
f5996c62 DM |
236 | # example1: { prefix => 'get_command_descriptions'}) |
237 | # example2: { prefix => 'mon dump', format => 'json' } | |
27bfc7c6 DM |
238 | sub mon_command { |
239 | my ($self, $cmd) = @_; | |
240 | ||
b2a25d5d DM |
241 | $cmd->{format} = 'json' if !$cmd->{format}; |
242 | ||
27bfc7c6 | 243 | my $json = encode_json($cmd); |
9539bd37 | 244 | |
8172535c | 245 | my $raw = &$sendcmd($self, 'M', $json); |
9539bd37 | 246 | |
27bfc7c6 | 247 | if ($cmd->{format} && $cmd->{format} eq 'json') { |
23c2cb25 | 248 | return length($raw) ? decode_json($raw) : undef; |
27bfc7c6 DM |
249 | } |
250 | return $raw; | |
251 | } | |
252 | ||
253 | ||
254 | 1; | |
255 | __END__ | |
256 | ||
257 | =head1 NAME | |
258 | ||
259 | PVE::RADOS - Perl bindings for librados | |
260 | ||
261 | =head1 SYNOPSIS | |
262 | ||
263 | use PVE::RADOS; | |
264 | ||
265 | my $rados = PVE::RADOS::new(); | |
266 | my $stat = $rados->cluster_stat(); | |
267 | my $res = $rados->mon_command({ prefix => 'mon dump', format => 'json' }); | |
268 | ||
269 | =head1 DESCRIPTION | |
270 | ||
271 | Perl bindings for librados. | |
272 | ||
273 | =head2 EXPORT | |
274 | ||
275 | None by default. | |
276 | ||
277 | =head1 AUTHOR | |
278 | ||
279 | Dietmar Maurer, E<lt>dietmar@proxmox.com<gt> | |
280 | ||
281 | =cut |