File Coverage

blib/lib/Ceph/RadosGW/Admin.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             package Ceph::RadosGW::Admin;
2             $Ceph::RadosGW::Admin::VERSION = '0.4';
3 2     2   202393 use strict;
  2         6  
  2         90  
4 2     2   10 use warnings;
  2         2  
  2         75  
5              
6 2     2   835 use LWP::UserAgent;
  2         59331  
  2         79  
7 2     2   1135 use Ceph::RadosGW::Admin::HTTPRequest;
  0            
  0            
8             use JSON;
9             use Moose;
10             use URI;
11             use URI::QueryParam;
12             use Ceph::RadosGW::Admin::User;
13             use namespace::autoclean;
14              
15             =head1 NAME
16              
17             Ceph::RadosGW::Admin - Bindings for the rados gateway admin api.
18              
19             =head1 VERSION
20              
21             version 0.4
22              
23             =head1 SYNOPSIS
24            
25             my $admin = Ceph::RadosGW::Admin->new(
26             access_key => 'not really secret',
27             secret_key => 'actually secret',
28             url => 'https://your.rados.gateway.com/',
29             );
30            
31             my $user = $admin->create_user(
32             uid => 'myusername',
33             display_name => 'my user name',
34             );
35            
36             # they're really evil, suspending them should be enough
37             $user->suspended(1);
38             $user->save;
39            
40             # nah, they're really evil
41             $user->delete;
42            
43             my $otheruser = $admin->get_user(uid => 'other');
44            
45             my @keys = $otheruser->keys();
46             my @keys_plus_one = $otheruser->create_key();
47            
48             $otheruser->delete_key(access_key => $keys[0]->{access_key});
49            
50             my @buckets = $otheruser->get_bucket_info();
51            
52              
53             =head1 DESCRIPTION
54              
55             This module provides an interface to the
56             L<Admin OPs|http://docs.ceph.com/docs/master/radosgw/adminops/> interface of a
57             ceph rados gateway. It is at this time incomplete, with only the parts needed
58             by the authors implemented. Patches for the rest of the functionality are
59             encouraged.
60              
61             =cut
62              
63             has secret_key => ( is => 'ro', required => 1 );
64             has access_key => ( is => 'ro', required => 1 );
65             has url => ( is => 'ro', required => 1 );
66             has useragent => (
67             is => 'ro',
68             builder => 'build_useragent',
69             );
70              
71             __PACKAGE__->meta->make_immutable;
72              
73             =head1 METHODS
74              
75             =head2 get_user
76              
77             Returns a L<Ceph::RadosGW::Admin::User> object representing the given C<uid>.
78              
79             Dies if the user does not exist.
80              
81             Example:
82              
83             my $user = $admin->get_user(uid => 'someuserhere');
84            
85             =cut
86              
87             sub get_user {
88             my ($self, %args) = @_;
89            
90             my %user_data = $self->_request(GET => 'user', %args);
91            
92             return Ceph::RadosGW::Admin::User->new(
93             %user_data,
94             _client => $self
95             );
96             }
97              
98             =head2 create_user
99              
100             Makes a new user on the rados gateway, and returns a
101             L<Ceph::RadosGW::Admin::User> object representing that user.
102              
103             Dies on failure.
104              
105             Example:
106              
107             my $new_user = $admin->create_user(
108             uid => 'username',
109             display_name => 'Our New User',
110             );
111              
112             =cut
113              
114             sub create_user {
115             my ($self, %args) = @_;
116            
117             my %user_data = $self->_request(PUT => 'user', %args);
118            
119             return Ceph::RadosGW::Admin::User->new(
120             %user_data,
121             _client => $self
122             );
123             }
124              
125             sub build_useragent {
126             require LWP::UserAgent;
127             return LWP::UserAgent->new;
128             }
129              
130             sub _debug {
131             if ($ENV{DEBUG_CEPH_CALLS}) {
132             require Data::Dumper;
133             warn Data::Dumper::Dumper(@_);
134             }
135             }
136              
137             sub _request {
138             my ($self, $method, $path, %args) = @_;
139            
140             my $content = '';
141              
142             my $query_string = _make_query(%args, format => 'json');
143            
144             my $request_builder = Ceph::RadosGW::Admin::HTTPRequest->new(
145             method => $method,
146             path => "admin/$path?$query_string",
147             content => '',
148             url => $self->url,
149             access_key => $self->access_key,
150             secret_key => $self->secret_key,
151             );
152              
153             my $req = $request_builder->http_request();
154            
155             my $res = $self->useragent->request($req);
156            
157             _debug($res);
158            
159             unless ($res->is_success) {
160             die sprintf("%s - %s (%s)", $res->status_line, $res->content, $req->as_string);
161             }
162            
163             if ($res->content) {
164             my $data = eval {
165             JSON::decode_json($res->content);
166             };
167            
168             if (my $e = $@) {
169             die "Could not deserialize server response: $e\nContent: " . $res->content . "\n";
170             }
171            
172             if (ref($data) eq 'HASH') {
173             return %$data;
174             }
175             elsif (ref($data) eq 'ARRAY') {
176             return @$data;
177             }
178             else {
179             die "Didn't get an array or hash reference\n";
180             }
181             } else {
182             return;
183             }
184             }
185              
186             sub _make_query {
187             my %args = @_;
188            
189             my %fixed;
190             while (my ($key, $val) = each %args) {
191             $key =~ s/_/-/g;
192             $fixed{$key} = $val;
193             }
194            
195             my $u = URI->new("", "http");
196            
197             foreach my $key (sort keys %fixed) {
198             $u->query_param($key, $fixed{$key});
199             }
200            
201            
202             return $u->query;
203              
204             }
205              
206              
207             =head1 TODO
208              
209             =over 2
210              
211             =item *
212              
213             The docs are pretty middling at the moment.
214              
215             =item *
216              
217             This module has only been tested against the Dumpling release of ceph.
218              
219             =back
220              
221             =head1 AUTHORS
222              
223             Chris Reinhardt
224             crein@cpan.org
225              
226             Mark Ng
227             cpan@markng.co.uk
228            
229             =head1 COPYRIGHT
230              
231             This program is free software; you can redistribute
232             it and/or modify it under the same terms as Perl itself.
233              
234             The full text of the license can be found in the
235             LICENSE file included with this module.
236              
237             =head1 SEE ALSO
238              
239             perl(1), L<Admin OPs API|http://docs.ceph.com/docs/master/radosgw/adminops/>
240             L<Ceph|http://www.ceph.com/>
241              
242             =cut
243              
244              
245             1;
246             __END__