display error on failure
[opensuse:sxkeeper.git] / perl / SXKeeper / Access.pm
1  # -----------------------------------------------------------
2 # SUSE Inttools Codebase
3 # (c)2005 SUSE LINUX Products GmbH, Nuernberg
4 # -----------------------------------------------------------
5 # Contributor(s):
6 # Christopher Hofmann <cwh@suse.de>
7 # Andreas Bauer <abauer@suse.de>
8 # Klaas Freitag <freitag@suse.de>
9 # -----------------------------------------------------------
10 package SXKeeper::Access;
11
12 use strict;
13 use URI;
14 use Carp;
15 use LWP::UserAgent;
16 use Encode qw( encode _utf8_off );
17 use Params::Validate qw( :all );
18 use Regexp::Common qw( URI );
19
20 use vars qw( $VERSION );
21
22 $VERSION = 0.95;
23
24 #----------------------------------------------------
25 # new()
26 #----------------------------------------------------
27 # constructor
28 #
29 # named parameters:
30 #       url:    location of keeper
31 #       logger: Log::Dispatch object to log output to
32 #       debug:  log also debug messages
33 #       agent:  Set user-agent string sent to server; default: "KeeperAccess/$VERSION"
34
35 sub new
36 {
37     my $class = shift;
38     my $self = {};
39     bless( $self, $class );
40     
41     my %params = validate( @_,
42                            { url => { type      => SCALAR,
43                                       optional => 0 },
44                              logger => { type => OBJECT,
45                                          optional => 1 },
46                              debug => { optional => 1 },
47                              agent => { default => "KeeperAccess/$VERSION" },
48                              charset => { default => 'UTF-8' },
49                              username => { optional => 1 },
50                              password => { optional => 1 },
51                              return_response_object => { type => SCALAR,
52                                                          default => 0 } } );
53
54     $self->{ua} = LWP::UserAgent->new( agent => $params{'agent'},
55                                        timeout => 60,
56                                        env_proxy => 0 );
57
58     $self->{charset} = $params{'charset'};
59
60     $self->{ua_default_header} = { 'Accept' => 'text/*; charset='.$self->{charset} };
61
62     $self->{ua_default_header}->{'x-username'} = $params{'username'} if( defined($params{'username'}) );
63
64     unless( $params{url} =~ /$RE{URI}{HTTP}/ )
65     {
66         croak( "Invalid URL: '$params{url}'" );
67     }
68
69     if( exists $params{logger} && $params{logger}->isa("Log::Dispatch") )
70     {
71         $self->{logger} = $params{logger};
72     }
73
74     foreach( 'url', 'debug', 'username', 'password', 'return_response_object' )
75     {
76         $self->{$_} = $params{$_};
77     }
78
79     $self->{url} .= '/' unless( $params{url} =~ /\/$/ );
80
81     $self->log("debug", "created object") if( $self->{debug} );
82
83     $self->{metafiles} = ();
84
85     return $self;
86 }
87
88 #----------------------------------------------------
89 # getStaticContent($path)
90 #----------------------------------------------------
91
92 sub getStaticContent
93 {
94     my ( $self, $path, $username, $password ) = validate_pos( @_,
95                                                               { isa => __PACKAGE__ },            # $self
96                                                               { type => SCALAR, optional => 0 }, # path
97                                                               { optional => 1 },
98                                                               { optional => 1 } );
99
100     my $uri = URI->new( $self->{url}.$path );
101
102     return $self->askKeeper( $uri, $username, $password );
103 }
104
105 sub getMetaFile
106 {
107   my ( $self, $id, $username, $password ) = validate_pos( @_,
108                                                           { isa => __PACKAGE__ },            # $self
109                                                           { type => SCALAR, optional => 0 }, # id
110                                                           { optional => 1 },
111                                                           { optional => 1 } );
112
113   $self->loadMetaDescriptor( $username, $password ); # do that always, because meta revisions can change always.
114
115   my $descriptorRef = $self->{metafiles}{$id};
116   if ( $descriptorRef ) {
117       my $tmp = $self->getStaticContent( $descriptorRef->{location}, $username, $password );
118       #print STDERR $tmp;
119       return $tmp;
120   } else {
121       $self->log( 'error', "Meta file $id not found in servers meta file." );
122   }
123 }
124
125 sub loadMetaDescriptor
126 {
127     my ( $self, $username, $password ) = validate_pos( @_,
128                                                        { isa => __PACKAGE__ },
129                                                        { optional => 1 },
130                                                        { optional => 1 } );
131
132   my $uri = URI->new( $self->{url} . "meta/feature" );
133   $self->log( 'debug', "fetching meta description $uri" );
134   my $content = $self->askKeeper( $uri, $username, $password )->decoded_content();
135
136   #print STDERR $content;
137
138   # Parse xml and build a id -> static_path map
139   my $xmlParser = XML::LibXML->new();
140   my $dom = $xmlParser->parse_string( $content );
141
142   my $res = $dom->findnodes( 'meta/resource' );
143   $self->{metafiles} = () if( $res );
144
145   foreach my $resource ( $res->get_nodelist ) {
146     my $id = $resource->getAttribute( 'id' );
147     my $rev = $resource->getAttribute( 'revision' );
148     my $location  = $resource->getAttribute( 'location' );
149
150     $self->{metafiles}{$id} = { id => $id,
151                                 revision => $rev,
152                                 location => $location };
153   }
154 }
155
156 #----------------------------------------------------
157 # getSingleDocument( $container, $xquery )
158 #----------------------------------------------------
159 # Parameters:
160 #    $container - name of the container, e.g. 'feature'
161 #    $id - optional - id of the wanted document or empty string for all documents
162 #
163 # Return Value:
164 #    string containing XML; root element depends on result's content (root element = name of container)
165 #
166 #
167
168 sub getSingleDocument
169 {
170     my ( $self, $container, $id, $rev, $username, $password ) = validate_pos( @_,
171                                                                               { isa => __PACKAGE__ },              # $self
172                                                                               { type => SCALAR, optional => 0 },   # Container
173                                                                               { type => SCALAR, optional => 0 },   # ID
174                                                                               { type => SCALAR | UNDEF, optional => 1 },  # Revision
175                                                                               { optional => 1 },
176                                                                               { optional => 1 } );
177     
178     my $url = $self->{url}."$container/$id";
179     $url .= "/$rev" if( defined $rev );
180
181     my $uri = URI->new( $url );
182
183     return $self->askKeeper( $uri, $username, $password );
184 }
185
186 #----------------------------------------------------
187 # getDocuments( $container [, $query ] )
188 #----------------------------------------------------
189 # Parameters:
190 #    $container - name of the container, e.g. 'feature'
191 #    $xquery - optional
192 #    $revisionquery - only request id-revision pairs
193 #
194 # Return Value:
195 #    string containing XML; root element: <k:collection>...</k:collection>
196 #
197
198 sub getDocuments
199 {
200     my $self = shift;
201     croak('Has to be called as a method.') if( ref( $self ) ne __PACKAGE__ );
202     my %params = validate( @_,
203                { container => { type => SCALAR, optional => 0 },
204                  query => { type => SCALAR, optional => 1 },
205                  revisionquery => { type => SCALAR, optional => 0 },
206                  username => { type => SCALAR, optional => 1 } }  );
207
208     my ( $container, $query, $revisionquery, $username ) =
209     @params{ 'container', 'query', 'revisionquery', 'username' };
210     my $uri = URI->new( $self->{url}."$container/" );
211     $uri->query_form( 'revisionquery' => $revisionquery );
212     if( $query ) { $uri->query_form( 'revisionquery' => $revisionquery, 'query' => $query ); }
213     return $self->askKeeper( $uri, $username );
214 }
215
216
217 #----------------------------------------------------
218 # updateDocument( %params )
219 #----------------------------------------------------
220
221 sub updateDocument
222 {
223     my $self = shift;
224
225     croak('Has to be called as a method.') if( ref( $self ) ne __PACKAGE__ );
226
227     my %params = validate( @_,
228                            { container => { type => SCALAR, optional => 0 },
229                              id => { type => SCALAR, optional => 0 },
230                              data => { type => SCALAR, optional => 0 },
231                              params => { type => HASHREF, optional => 1 },
232                              username => { type => SCALAR, optional => 1 },
233                              password => { type => SCALAR, optional => 1 } }  );
234
235     my ( $container, $id, $data, $query_params, $username, $password ) =
236         @params{ 'container', 'id', 'data', 'params', 'username', 'password' };
237
238     my $uri = URI->new( $self->{url}."$container/$id" );
239
240     if( $query_params )
241     {
242         $uri->query_form( $query_params );
243     }
244
245     $self->log( 'debug', "PUT '$uri'" ) if( $self->{debug} );
246
247     my $request = HTTP::Request->new( "PUT", $uri );
248
249     my $header = $request->headers;
250     $header->authorization_basic( $username, $password );
251     $header->header( %{$self->{ua_default_header}} );
252     $header->header( 'Content_Type' => 'text/xml; charset='.$self->{charset} );
253     $header->header( 'x-username' => $username );
254
255     #print STDERR $header->as_string."\n";
256
257     # fill the data in the request to be sent to the keeper:
258
259     # There are problems with "wide characters in syswrite. To fix that I see 2
260     # possible solutions. However I'm not sure which one makes the correct encoding.
261
262     # 1:
263     _utf8_off($data);
264     #$request->content( $data );
265     # --
266
267     # 2:
268     encode( $self->{charset}, $data);
269     $request->content( $data );
270     # --
271
272     my $response = $self->{ua}->request( $request );
273
274     $self->log( 'debug', "responsecode: ".$response->code() ) if( $self->{debug} );
275
276     if( $self->{return_response_object} )
277     {
278         return $response;
279     }
280     else
281     {
282         if( $response->is_success )
283         {
284             $self->log( 'debug', $response->status_line ) if( $self->{debug} );
285             return $response->content();
286         }
287         else
288         {
289             if( $response->content_type() eq 'text/xml' )
290             {
291                 $self->log( 'debug', $response->status_line ) if( $self->{debug} );
292                 $self->log( 'debug', $response->content() ) if( $self->{debug} );
293                 return $response->decoded_content();
294             }
295             else
296             {
297                 $self->log( 'error', $response->status_line );
298                 $self->log( 'debug', $response->content() ) if( $self->{debug} );
299                 croak( $response->status_line );
300             }
301         }
302     }
303 }
304
305
306
307 #----------------------------------------------------
308 # postKeeper( $url, $data )
309 #----------------------------------------------------
310 # Send a post request to the keeper. Password and User are used
311 # from the self variables.
312 #
313 # Parameters:
314 #    $url - url to send to the keeper
315 #   $data - data to send as message content
316 #
317 # Return Value:
318 #
319 #
320 #
321 sub postKeeper
322 {
323     my ( $self, $uri, $data, $username ) = validate_pos( @_, 
324                                         { isa => __PACKAGE__ }, 
325                                         { type => SCALAR, optional => 0 },
326                                         { type => SCALAR, optional => 0 },
327                                         { optional => 1 } );
328
329
330     my $postTo = $self->{url} . "$uri";
331     $self->log( 'debug', "POST $postTo" ) if( $self->{debug} );
332
333     my $request = HTTP::Request->new( "POST", $postTo );
334
335     $request->headers->header( %{$self->{ua_default_header}} );
336     $request->headers->header( 'x-username' => $username ) if( $username );
337     $request->headers->header( 'Content_Type' => 'text/xml; charset='.$self->{charset} );
338
339     # fill the data in the request to be sent to the keeper:
340     $request->content( encode( $self->{charset}, $data) );
341
342     my $response = $self->{ua}->request( $request );
343
344     $self->log( 'debug', "responsecode: ".$response->code() ) if( $self->{debug} );
345
346     if( $self->{return_response_object} )
347     {
348         return $response;
349     }
350     else
351     {
352         if( $response->is_success )
353         {
354             # $self->log( 'debug', "Content-type: ".$response->content_type() ) if( $self->{debug} );
355             if( $self->{return_response_object} ) {
356               return $response;
357             } else {
358               return $response->decoded_content();
359             }
360         }
361         else
362         {
363             $self->log( 'debug', "Getting $uri failed." ) if( $self->{debug} );
364
365             #print STDERR $response->decoded_content();
366
367             if( $response->content_type() eq 'text/xml' )
368             {
369                 return $response->decoded_content();
370             }
371             else
372             {
373                 croak( $response->status_line );
374             }
375         }
376     }
377 }
378
379
380 #----------------------------------------------------
381 # askKeeper( $url )
382 #----------------------------------------------------
383 # Internal method
384 #
385 # Parameters:
386 #    $url - url to send to the keeper
387 #
388 # Return Value: response string
389 #
390
391 sub askKeeper
392 {
393     my ( $self, $uri, $username, $password ) = validate_pos( @_, { isa => __PACKAGE__ }, 1, 0, 0 );
394
395     $self->log( 'debug', "GET '$uri'" ) if( $self->{debug} );
396
397     my $request = HTTP::Request->new( "GET", $uri );
398     $request->headers->header( %{$self->{ua_default_header}} );
399     $request->headers->authorization_basic( $username, $password) if( $username );
400     $request->headers->header( 'x-username' => $username ) if( $username );
401
402     my $response = $self->{ua}->request( $request );
403     
404     $self->log( 'debug', "responsecode: ".$response->code() ) if( $self->{debug} );
405
406     if( $self->{return_response_object} )
407     {
408         return $response;
409     }
410     else
411     {
412         if( $response->is_success )
413         {
414             $self->log( 'debug', "Content-type: ".$response->content_type() ) if( $self->{debug} );
415             return $response->decoded_content();
416         }
417         else
418         {
419             $self->log( 'debug', "Getting $uri failed." ) if( $self->{debug} );
420
421             #print STDERR $response->decoded_content();
422
423             if( $response->content_type() eq 'text/xml' )
424             {
425                 return $response->decoded_content();
426             }
427             else
428             {
429                 croak( $response->status_line );
430             }
431         }
432     }
433 }
434
435 #############################
436 # helper functions
437 #############################
438
439 sub log
440 {
441     my ( $self, $level, $msg ) = validate_pos( @_,
442                                                { isa => __PACKAGE__ },
443                                                { type => SCALAR,
444                                                  optional => 0 },
445                                                { type => SCALAR,
446                                                  optional => 0 } );
447     
448     if( exists $self->{logger} )
449     {
450         $self->{logger}->log( $level, $msg );
451     }
452     else
453     {
454         print STDERR "[$level] KeeperAccess: $msg\n";
455     }
456 }