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