File Coverage

blib/lib/Ceph/RadosGW/Admin.pm
Criterion Covered Total %
statement 65 69 94.2
branch 9 12 75.0
condition n/a
subroutine 16 16 100.0
pod 2 3 66.6
total 92 100 92.0


line stmt bran cond sub pod time code
1             package Ceph::RadosGW::Admin;
2             $Ceph::RadosGW::Admin::VERSION = '0.3';
3 2     2   237482 use strict;
  2         5  
  2         96  
4 2     2   11 use warnings;
  2         3  
  2         74  
5              
6 2     2   650 use LWP::UserAgent;
  2         45450  
  2         95  
7 2     2   1446 use Ceph::RadosGW::Admin::HTTPRequest;
  2         10  
  2         170  
8 2     2   2270 use JSON;
  2         77448  
  2         20  
9 2     2   24739 use Moose;
  2         6  
  2         26  
10 2     2   15803 use URI;
  2         6  
  2         64  
11 2     2   15 use URI::QueryParam;
  2         3  
  2         53  
12 2     2   1582 use Ceph::RadosGW::Admin::User;
  2         8  
  2         101  
13 2     2   20 use namespace::autoclean;
  2         5  
  2         14  
14              
15             =head1 NAME
16              
17             Ceph::RadosGW::Admin - Bindings for the rados gateway admin api.
18              
19             =head1 VERSION
20              
21             version 0.3
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 20     20 1 14459 my ($self, %args) = @_;
89            
90 20         136 my %user_data = $self->_request(GET => 'user', %args);
91            
92 17         1012 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 8     8 1 52 my ($self, %args) = @_;
116            
117 8         51 my %user_data = $self->_request(PUT => 'user', %args);
118            
119 8         390 return Ceph::RadosGW::Admin::User->new(
120             %user_data,
121             _client => $self
122             );
123             }
124              
125             sub build_useragent {
126 14     14 0 122 require LWP::UserAgent;
127 14         111 return LWP::UserAgent->new;
128             }
129              
130             sub _debug {
131 47 50   47   204 if ($ENV{DEBUG_CEPH_CALLS}) {
132 0         0 require Data::Dumper;
133 0         0 warn Data::Dumper::Dumper(@_);
134             }
135             }
136              
137             sub _request {
138 47     47   150 my ($self, $method, $path, %args) = @_;
139            
140 47         100 my $content = '';
141              
142 47         219 my $query_string = _make_query(%args, format => 'json');
143            
144 47         2783 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 47         259 my $req = $request_builder->http_request();
154            
155 47         2225 my $res = $self->useragent->request($req);
156            
157 47         65999 _debug($res);
158            
159 47 100       255 unless ($res->is_success) {
160 3         50 die sprintf("%s - %s (%s)", $res->status_line, $res->content, $req->as_string);
161             }
162            
163 44 100       700 if ($res->content) {
164 29         517 my $data = eval {
165 29         97 JSON::decode_json($res->content);
166             };
167            
168 29 50       1086 if (my $e = $@) {
169 0         0 die "Could not deserialize server response: $e\nContent: " . $res->content . "\n";
170             }
171            
172 29 100       125 if (ref($data) eq 'HASH') {
    50          
173 27         2060 return %$data;
174             }
175             elsif (ref($data) eq 'ARRAY') {
176 2         121 return @$data;
177             }
178             else {
179 0         0 die "Didn't get an array or hash reference\n";
180             }
181             } else {
182 15         1077 return;
183             }
184             }
185              
186             sub _make_query {
187 47     47   153 my %args = @_;
188            
189 47         73 my %fixed;
190 47         244 while (my ($key, $val) = each %args) {
191 110         232 $key =~ s/_/-/g;
192 110         377 $fixed{$key} = $val;
193             }
194            
195 47         275 my $u = URI->new("", "http");
196            
197 47         10185 foreach my $key (sort keys %fixed) {
198 110         9769 $u->query_param($key, $fixed{$key});
199             }
200            
201            
202 47         7031 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__