]> git.proxmox.com Git - librados2-perl.git/blob - PVE/RADOS.pm
76c9d7b9d0d9477067b143880206e7f7fa642ba7
[librados2-perl.git] / PVE / RADOS.pm
1 package PVE::RADOS;
2
3 use 5.014002;
4 use strict;
5 use warnings;
6 use Carp;
7 use JSON;
8 use Socket;
9 use PVE::Tools;
10 use PVE::INotify;
11 use PVE::RPCEnvironment;
12
13 require Exporter;
14
15 my $rados_default_timeout = 5;
16
17
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
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 };
52
53 my $readdata = sub {
54 my ($fh) = @_;
55
56 my $head = '';
57
58 local $SIG{PIPE} = 'IGNORE';
59
60 while (length($head) < 5) {
61 last if !sysread $fh, $head, 5 - length($head), length($head);
62 }
63 die "partial read\n" if length($head) < 5;
64
65 my ($cmd, $len) = unpack "a L", $head;
66
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
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
86 kill(9, $self->{cpid});
87 waitpid($self->{cpid}, 0);
88 };
89
90 my $sendcmd = sub {
91 my ($self, $cmd, $data, $expect_tag) = @_;
92
93 $expect_tag = '>' if !$expect_tag;
94
95 my ($restag, $raw);
96 my $code = sub {
97 &$writedata($self->{child}, $cmd, $data) if $expect_tag ne 'S';
98 ($restag, $raw) = &$readdata($self->{child});
99 };
100 eval { PVE::Tools::run_with_timeout($self->{timeout}, $code); };
101 if (my $err = $@) {
102 &$kill_worker($self);
103 die $err;
104 }
105 if ($restag eq 'E') {
106 die $raw if $raw;
107 die "unknown error\n";
108 }
109
110 die "got unexpected result\n" if $restag ne $expect_tag;
111
112 return $raw;
113 };
114
115 sub new {
116 my ($class, %params) = @_;
117
118 my $rpcenv = PVE::RPCEnvironment::get();
119
120 socketpair(my $child, my $parent, AF_UNIX, SOCK_STREAM, PF_UNSPEC)
121 || die "socketpair: $!";
122
123 my $cpid = fork();
124
125 die "unable to fork - $!\n" if !defined($cpid);
126
127 my $self = bless {};
128
129 my $timeout = delete $params{timeout} || $rados_default_timeout;
130
131 $self->{timeout} = $timeout;
132
133 if ($cpid) { # parent
134 close $parent;
135
136 $self->{cpid} = $cpid;
137 $self->{child} = $child;
138
139 &$sendcmd($self, undef, undef, 'S'); # wait for sync
140
141 } else { # child
142 $0 = 'pverados';
143
144 PVE::INotify::inotify_close();
145
146 if (my $atfork = $rpcenv->{atfork}) {
147 &$atfork();
148 }
149
150 # fixme: timeout?
151
152 close $child;
153
154 my $conn;
155 eval {
156 $conn = pve_rados_create() ||
157 die "unable to create RADOS object\n";
158
159 pve_rados_conf_set($conn, 'client_mount_timeout', $timeout);
160
161 foreach my $k (keys %params) {
162 pve_rados_conf_set($conn, $k, $params{$k});
163 }
164
165 pve_rados_connect($conn);
166 };
167 if (my $err = $@) {
168 &$writedata($parent, 'E', $err);
169 die $err;
170 }
171 &$writedata($parent, 'S');
172
173 $self->{conn} = $conn;
174
175 for (;;) {
176 my ($cmd, $data) = &$readdata($parent);
177
178 last if $cmd eq 'Q';
179
180 my $res;
181 eval {
182 if ($cmd eq 'M') { # rados monitor commands
183 $res = pve_rados_mon_command($self->{conn}, [ $data ]);
184 } elsif ($cmd eq 'C') { # class methods
185 my $aref = decode_json($data);
186 my $method = shift @$aref;
187 $res = encode_json($self->$method(@$aref));
188 } else {
189 die "invalid command\n";
190 }
191 };
192 if (my $err = $@) {
193 &$writedata($parent, 'E', $err);
194 die $err;
195 }
196 &$writedata($parent, '>', $res);
197 }
198
199 exit(0);
200 }
201
202 return $self;
203 }
204
205 sub DESTROY {
206 my ($self) = @_;
207
208 if ($self->{cpid}) {
209 #print "$$: DESTROY WAIT0\n";
210 &$kill_worker($self);
211 #print "$$: DESTROY WAIT\n";
212 } else {
213 #print "$$: DESTROY SHUTDOWN\n";
214 pve_rados_shutdown($self->{conn}) if $self->{conn};
215 }
216 }
217
218 sub cluster_stat {
219 my ($self, @args) = @_;
220
221 if ($self->{cpid}) {
222 my $data = encode_json(['cluster_stat', @args]);
223 my $raw = &$sendcmd($self, 'C', $data);
224 return decode_json($raw);
225 } else {
226 return pve_rados_cluster_stat($self->{conn});
227 }
228 }
229
230 # example1: { prefix => 'get_command_descriptions'})
231 # example2: { prefix => 'mon dump', format => 'json' }
232 sub mon_command {
233 my ($self, $cmd) = @_;
234
235 $cmd->{format} = 'json' if !$cmd->{format};
236
237 my $json = encode_json($cmd);
238
239 my $raw = &$sendcmd($self, 'M', $json);
240
241 if ($cmd->{format} && $cmd->{format} eq 'json') {
242 return length($raw) ? decode_json($raw) : undef;
243 }
244 return $raw;
245 }
246
247
248 1;
249 __END__
250
251 =head1 NAME
252
253 PVE::RADOS - Perl bindings for librados
254
255 =head1 SYNOPSIS
256
257 use PVE::RADOS;
258
259 my $rados = PVE::RADOS::new();
260 my $stat = $rados->cluster_stat();
261 my $res = $rados->mon_command({ prefix => 'mon dump', format => 'json' });
262
263 =head1 DESCRIPTION
264
265 Perl bindings for librados.
266
267 =head2 EXPORT
268
269 None by default.
270
271 =head1 AUTHOR
272
273 Dietmar Maurer, E<lt>dietmar@proxmox.com<gt>
274
275 =cut