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