extern/egroupware
1
0
Fork 1
mirror of https://github.com/EGroupware/egroupware.git synced 2024-12-26 16:48:49 +01:00
Code Issues Packages Projects Releases Wiki Activity

Updated patch for latest Frontier-RPC-0.07b4, also fixing the creation of the authorization header

Browse Source
This commit is contained in:
Miles Lott 2005-07-30 10:31:46 +00:00
parent 58f462f6b7
commit 763126626c
1 changed files with 46 additions and 116 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

162
phpgwapi/doc/xmlrpc/perl.txt
View File

@ -1,6 +1,6 @@
/* $Id$ */ /* $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 The Frontier::RPC module available at CPAN is capable of logging into an
egroupware server. To authenticate your session after the initial login, 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: 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. 2. Install Frontier.
3. Try the following method using rpc-client.pl in the examples subdirectory for 3. Try the following method using rpc-client.pl in the examples subdirectory for
the Frontier source: the Frontier source:
@ -29,7 +29,8 @@ $result = HASH(0x826d4b0)
'kp3' => 'e0219714614769x25bc92286016c60c2' 'kp3' => 'e0219714614769x25bc92286016c60c2'
'sessionid' => '36f9ec1e4ad78bxd8bc902b1c38d3e14' '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 \ rpc-client.pl \
http://www.egroupware.org/egroupware/xmlrpc.php \ http://www.egroupware.org/egroupware/xmlrpc.php \
@ -40,138 +41,67 @@ $result = HASH(0x826d4b0)
6. This should return record #4 from the addressbook application. 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: Here is the patch:
----CUT HERE---- ----CUT HERE----
--- Frontier-RPC-0.06/lib/Frontier/Client.pm Sat Nov 20 18:13:21 1999 diff -aur Frontier-RPC-0.07b4/examples/rpc-client.pl Frontier-RPC-0.07b4-milos/examples/rpc-client.pl
+++ Frontier-RPC-0.06-me/lib/Frontier/Client.pm Wed Aug 22 15:25:36 2001 --- Frontier-RPC-0.07b4/examples/rpc-client.pl 1999-09-02 15:16:49.000000000 -0500
@@ -24,22 +24,27 @@ +++ Frontier-RPC-0.07b4-milos/examples/rpc-client.pl 2005-07-30 05:25:36.309201144 -0500
bless $self, $class; @@ -1,4 +1,4 @@
-#
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 @@
+#!/usr/bin/perl +#!/usr/bin/perl
#
# Copyright (C) 1998 Ken MacLeod # Copyright (C) 1998 Ken MacLeod
# See the file COPYING for distribution terms. # See the file COPYING for distribution terms.
@@ -11,7 +12,7 @@ #
@@ -59,7 +59,9 @@
=head1 SYNOPSIS GetOptions( 'debug' => \$debug,
- 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,
'encoding=s' => \$encoding, 'encoding=s' => \$encoding,
- 'proxy=s' => \$proxy ); - 'proxy=s' => \$proxy );
+ 'proxy=s' => \$proxy, + 'proxy=s' => \$proxy,
+ 'username=s' => \$username, + 'username=s' => \$username,
+ 'password=s' => \$password); + 'password=s' => \$password);
die "usage: rpc-client URL METHOD [\"ARGLIST\"]\n" die "usage: rpc-client URL METHOD [\"ARGLIST\"]\n"
if ($#ARGV != 1 && $#ARGV != 2); if ($#ARGV != 1 && $#ARGV != 2);
@@ -68,10 +77,12 @@ @@ -71,12 +73,18 @@
my $method = shift @ARGV; $server = Frontier::Client->new( 'url' => $url,
my $arglist = shift @ARGV; 'debug' => $debug,
-$server = Frontier::Client->new( 'url' => $url,
- 'debug' => $debug,
+$server = Frontier::Client->new( 'url' => $url,
+ 'debug' => $debug,
'encoding' => $encoding, 'encoding' => $encoding,
- 'proxy' => $proxy ); - 'proxy' => $proxy );
+ 'proxy' => $proxy, + 'proxy' => $proxy,
+ 'username' => $username, + 'username' => $username,
+ 'password' => $password); + 'password' => $password);
+
+use Data::Dumper;
+print Dumper($server);
my @arglist; my @arglist;
eval "\@arglist = ($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;