mirror of
https://github.com/EGroupware/egroupware.git
synced 2024-11-07 16:44:07 +01:00
Updated patch for latest Frontier-RPC-0.07b4, also fixing the creation of the authorization header
This commit is contained in:
Miles Lott
parent
58f462f6b7
commit
763126626c
@ -1,6 +1,6 @@
|
||||
/* $Id$ */
|
||||
|
||||
Perl interfacing to egroupware:
|
||||
Perl interfacing to egroupware updated for Frontier-RPC-0.07b4:
|
||||
|
||||
The Frontier::RPC module available at CPAN is capable of logging into an
|
||||
egroupware server. To authenticate your session after the initial login,
|
||||
@ -12,7 +12,7 @@ NOTE: sessionid/kp3 values in this file are not valid.
|
||||
|
||||
TODO:
|
||||
|
||||
1. Apply the patch at the end of this file to Frontier-RPC-0.06.
|
||||
1. Apply the patch at the end of this file to Frontier-RPC-0.07b4.
|
||||
2. Install Frontier.
|
||||
3. Try the following method using rpc-client.pl in the examples subdirectory for
|
||||
the Frontier source:
|
||||
@ -29,7 +29,8 @@ $result = HASH(0x826d4b0)
|
||||
'kp3' => 'e0219714614769x25bc92286016c60c2'
|
||||
'sessionid' => '36f9ec1e4ad78bxd8bc902b1c38d3e14'
|
||||
|
||||
5. Place these on the commandline for a new request:
|
||||
5. Place these on the commandline for a new request, with sessionid for
|
||||
username and kp3 for password:
|
||||
|
||||
rpc-client.pl \
|
||||
http://www.egroupware.org/egroupware/xmlrpc.php \
|
||||
@ -40,117 +41,25 @@ $result = HASH(0x826d4b0)
|
||||
|
||||
6. This should return record #4 from the addressbook application.
|
||||
|
||||
Other requests may require different types on the command line, e.g.:
|
||||
|
||||
preferences.bosettings.read "addressbook,'','user'"
|
||||
|
||||
Here is the patch:
|
||||
|
||||
----CUT HERE----
|
||||
--- Frontier-RPC-0.06/lib/Frontier/Client.pm Sat Nov 20 18:13:21 1999
|
||||
+++ Frontier-RPC-0.06-me/lib/Frontier/Client.pm Wed Aug 22 15:25:36 2001
|
||||
@@ -24,22 +24,27 @@
|
||||
bless $self, $class;
|
||||
|
||||
die "Frontier::RPC::new: no url defined\n"
|
||||
- if !defined $self->{'url'};
|
||||
+ if !defined $self->{'url'};
|
||||
|
||||
$self->{'ua'} = LWP::UserAgent->new;
|
||||
$self->{'ua'}->proxy('http', $self->{'proxy'})
|
||||
- if(defined $self->{'proxy'});
|
||||
+ if(defined $self->{'proxy'});
|
||||
$self->{'rq'} = HTTP::Request->new (POST => $self->{'url'});
|
||||
+ if(defined $self->{'username'} and defined $self->{'password'})
|
||||
+ {
|
||||
+ use MIME::Base64;
|
||||
+ $self->{'rq'}->header('Authorization: Basic', encode_base64($self->{'username'} . ":" . $self->{'password'}));
|
||||
+ }
|
||||
$self->{'rq'}->header('Content-Type' => 'text/xml');
|
||||
|
||||
my @options;
|
||||
|
||||
if(defined $self->{'encoding'}) {
|
||||
- push @options, 'encoding' => $self->{'encoding'};
|
||||
+ push @options, 'encoding' => $self->{'encoding'};
|
||||
}
|
||||
|
||||
if (defined $self->{'use_objects'} && $self->{'use_objects'}) {
|
||||
- push @options, 'use_objects' => $self->{'use_objects'};
|
||||
+ push @options, 'use_objects' => $self->{'use_objects'};
|
||||
}
|
||||
|
||||
$self->{'enc'} = Frontier::RPC2->new(@options);
|
||||
@@ -53,8 +58,8 @@
|
||||
my $text = $self->{'enc'}->encode_call(@_);
|
||||
|
||||
if ($self->{'debug'}) {
|
||||
- print "---- request ----\n";
|
||||
- print $text;
|
||||
+ print "---- request ----\n";
|
||||
+ print $text;
|
||||
}
|
||||
|
||||
$self->{'rq'}->content($text);
|
||||
@@ -62,21 +67,21 @@
|
||||
my $response = $self->{'ua'}->request($self->{'rq'});
|
||||
|
||||
if (substr($response->code, 0, 1) ne '2') {
|
||||
- die $response->status_line . "\n";
|
||||
+ die $response->status_line . "\n";
|
||||
}
|
||||
|
||||
my $content = $response->content;
|
||||
|
||||
if ($self->{'debug'}) {
|
||||
- print "---- response ----\n";
|
||||
- print $content;
|
||||
+ print "---- response ----\n";
|
||||
+ print $content;
|
||||
}
|
||||
|
||||
my $result = $self->{'enc'}->decode($content);
|
||||
|
||||
if ($result->{'type'} eq 'fault') {
|
||||
- die "Fault returned from XML RPC Server, fault code " . $result->{'value'}[0]{'faultCode'} . ": "
|
||||
- . $result->{'value'}[0]{'faultString'} . "\n";
|
||||
+ die "Fault returned from XML RPC Server, fault code " . $result->{'value'}[0]{'faultCode'} . ": "
|
||||
+ . $result->{'value'}[0]{'faultString'} . "\n";
|
||||
}
|
||||
|
||||
return $result->{'value'}[0];
|
||||
--- Frontier-RPC-0.06/examples/rpc-client.pl Thu Sep 2 15:16:49 1999
|
||||
+++ Frontier-RPC-0.06-me/examples/rpc-client.pl Wed Aug 22 15:32:07 2001
|
||||
@@ -1,3 +1,4 @@
|
||||
diff -aur Frontier-RPC-0.07b4/examples/rpc-client.pl Frontier-RPC-0.07b4-milos/examples/rpc-client.pl
|
||||
--- Frontier-RPC-0.07b4/examples/rpc-client.pl 1999-09-02 15:16:49.000000000 -0500
|
||||
+++ Frontier-RPC-0.07b4-milos/examples/rpc-client.pl 2005-07-30 05:25:36.309201144 -0500
|
||||
@@ -1,4 +1,4 @@
|
||||
-#
|
||||
+#!/usr/bin/perl
|
||||
#
|
||||
# Copyright (C) 1998 Ken MacLeod
|
||||
# See the file COPYING for distribution terms.
|
||||
@@ -11,7 +12,7 @@
|
||||
#
|
||||
@@ -59,7 +59,9 @@
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
- rpc-client [--debug] [--encoding ENCODING] [--proxy PROXY] \
|
||||
+ rpc-client [--debug] [--username] [--password] [--encoding ENCODING] [--proxy PROXY] \
|
||||
URL METHOD ["ARGLIST"]
|
||||
|
||||
=head1 DESCRIPTION
|
||||
@@ -31,6 +32,12 @@
|
||||
The `C<--debug>' option will cause the client to print the XML request
|
||||
sent to and XML response received from the server.
|
||||
|
||||
+The `C<--username>' option will force an Authorization:Basic header
|
||||
+to be generated, if used in conjunction with the `C<--password>' option
|
||||
+
|
||||
+The `C<--password>' option will force an Authorization:Basic header
|
||||
+to be generated, if used in conjunction with the `C<--username>' option
|
||||
+
|
||||
The `C<--encoding>' option will supply an alternate encoding for the
|
||||
XML request. The default is none, which uses XML 1.0's default of
|
||||
UTF-8.
|
||||
@@ -57,9 +64,11 @@
|
||||
my $encoding = undef;
|
||||
my $proxy = undef;
|
||||
|
||||
-GetOptions( 'debug' => \$debug,
|
||||
+GetOptions( 'debug' => \$debug,
|
||||
GetOptions( 'debug' => \$debug,
|
||||
'encoding=s' => \$encoding,
|
||||
- 'proxy=s' => \$proxy );
|
||||
+ 'proxy=s' => \$proxy,
|
||||
@ -159,19 +68,40 @@ Here is the patch:
|
||||
|
||||
die "usage: rpc-client URL METHOD [\"ARGLIST\"]\n"
|
||||
if ($#ARGV != 1 && $#ARGV != 2);
|
||||
@@ -68,10 +77,12 @@
|
||||
my $method = shift @ARGV;
|
||||
my $arglist = shift @ARGV;
|
||||
|
||||
-$server = Frontier::Client->new( 'url' => $url,
|
||||
- 'debug' => $debug,
|
||||
+$server = Frontier::Client->new( 'url' => $url,
|
||||
+ 'debug' => $debug,
|
||||
@@ -71,12 +73,18 @@
|
||||
$server = Frontier::Client->new( 'url' => $url,
|
||||
'debug' => $debug,
|
||||
'encoding' => $encoding,
|
||||
- 'proxy' => $proxy );
|
||||
+ 'proxy' => $proxy,
|
||||
+ 'username' => $username,
|
||||
+ 'password' => $password);
|
||||
+
|
||||
+use Data::Dumper;
|
||||
+print Dumper($server);
|
||||
|
||||
my @arglist;
|
||||
eval "\@arglist = ($arglist)";
|
||||
|
||||
$result = $server->call ($method, @arglist);
|
||||
+print Dumper($result);
|
||||
|
||||
-require 'dumpvar.pl';
|
||||
-dumpvar ('main', 'result');
|
||||
+#require 'dumpvar.pl';
|
||||
+#dumpvar ('main', 'result');
|
||||
diff -aur Frontier-RPC-0.07b4/lib/Frontier/Client.pm Frontier-RPC-0.07b4-milos/lib/Frontier/Client.pm
|
||||
--- Frontier-RPC-0.07b4/lib/Frontier/Client.pm 2002-08-02 19:48:06.000000000 -0500
|
||||
+++ Frontier-RPC-0.07b4-milos/lib/Frontier/Client.pm 2005-07-30 04:52:35.000000000 -0500
|
||||
@@ -42,6 +42,11 @@
|
||||
push @options, 'use_objects' => $self->{'use_objects'};
|
||||
}
|
||||
|
||||
+ if(defined $self->{'username'} and defined $self->{'password'})
|
||||
+ {
|
||||
+ use MIME::Base64;
|
||||
+ $self->{'rq'}->header('Authorization' => 'Basic ' . encode_base64($self->{'username'} . ":" . $self->{'password'}));
|
||||
+ }
|
||||
$self->{'enc'} = Frontier::RPC2->new(@options);
|
||||
|
||||
return $self;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user