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