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::INotify;
  10 use PVE::RPCEnvironment;
  11
  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
  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 };
  50
  51 my $readdata = sub {
  52     my ($fh, $expect_result) = @_;
  53
  54     my $head = '';
  55
  56     local $SIG{PIPE} = 'IGNORE';
  57
  58     while (length($head) < 5) {
  59         last if !sysread $fh, $head, 5 - length($head), length($head);
  60     }
  61     die "partial read\n" if length($head) < 5;
  62
  63     my ($cmd, $len) = unpack "a L", $head;
  64
  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     }
  75
  76     return wantarray ? ($cmd, $data) : $data;
  77 };
  78
  79 sub new {
  80     my ($class, %params) = @_;
  81
  82     my $rpcenv = PVE::RPCEnvironment::get();
  83
  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';
 106
 107         PVE::INotify::inotify_close();
 108
 109         if (my $atfork = $rpcenv->{atfork}) {
 110             &$atfork();
 111         }
 112
 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     }
 166
 167     return $self;
 168 }
 169
 170 sub DESTROY {
 171     my ($self) = @_;
 172
 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     }
 182 }
 183
 184 sub cluster_stat {
 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     }
 194 }
 195
 196 # example1: { prefix => 'get_command_descriptions'})
 197 # example2: { prefix => 'mon dump', format => 'json' }
 198 sub mon_command {
 199     my ($self, $cmd) = @_;
 200
 201     $cmd->{format} = 'json' if !$cmd->{format};
 202
 203     my $json = encode_json($cmd);
 204
 205     &$writedata($self->{child}, 'M', $json);
 206
 207     my $raw = &$readdata($self->{child}, 1);
 208
 209     if ($cmd->{format} && $cmd->{format} eq 'json') {
 210         return length($raw) ? decode_json($raw) : undef;
 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