source: companies/celepar/phpgwapi/doc/xmlrpc/perl.txt @ 763

Revision 763, 5.7 KB checked in by niltonneto, 15 years ago (diff)

Importação inicial do Expresso da Celepar

Line 
1
2Perl interfacing to egroupware:
3
4The Frontier::RPC module available at CPAN is capable of logging into an
5egroupware server.  To authenticate your session after the initial login,
6however, requires a patch to Frontier.  This patch causes Frontier to create
7an Authentication header using username/password values.  We use the assigned
8sessionid and kp3 for this.
9
10NOTE: sessionid/kp3 values in this file are not valid.
11
12TODO:
13
141. Apply the patch at the end of this file to Frontier-RPC-0.06.
152. Install Frontier.
163. Try the following method using rpc-client.pl in the examples subdirectory for
17  the Frontier source:
18
19        rpc-client.pl \
20        http://www.egroupware.org/egroupware/xmlrpc.php \
21        system.login \
22        "{domain => '',username => 'demo', password => 'guest'}"
23
244. Take the returned sessionid and kp3, e.g.:
25
26$result = HASH(0x826d4b0)
27   'domain' => 'default'
28   'kp3' => 'e0219714614769x25bc92286016c60c2'
29   'sessionid' => '36f9ec1e4ad78bxd8bc902b1c38d3e14'
30
315. Place these on the commandline for a new request:
32
33        rpc-client.pl \
34        http://www.egroupware.org/egroupware/xmlrpc.php \
35        --username 36f9ec1e4ad78bxd8bc902b1c38d3e14 \
36        --password e0219714614769x25bc92286016c60c2 \
37        service.contacts.read \
38        "{ id => '4'}"
39
406. This should return record #4 from the addressbook application.
41
42
43Here is the patch:
44
45----CUT HERE----
46--- Frontier-RPC-0.06/lib/Frontier/Client.pm    Sat Nov 20 18:13:21 1999
47+++ Frontier-RPC-0.06-me/lib/Frontier/Client.pm Wed Aug 22 15:25:36 2001
48@@ -24,22 +24,27 @@
49     bless $self, $class;
50 
51     die "Frontier::RPC::new: no url defined\n"
52-       if !defined $self->{'url'};
53+    if !defined $self->{'url'};
54 
55     $self->{'ua'} = LWP::UserAgent->new;
56     $self->{'ua'}->proxy('http', $self->{'proxy'})
57-       if(defined $self->{'proxy'});
58+    if(defined $self->{'proxy'});
59     $self->{'rq'} = HTTP::Request->new (POST => $self->{'url'});
60+    if(defined $self->{'username'} and defined $self->{'password'})
61+    {
62+        use MIME::Base64;
63+        $self->{'rq'}->header('Authorization: Basic', encode_base64($self->{'username'} . ":" . $self->{'password'}));
64+    }
65     $self->{'rq'}->header('Content-Type' => 'text/xml');
66 
67     my @options;
68 
69     if(defined $self->{'encoding'}) {
70-       push @options, 'encoding' => $self->{'encoding'};
71+        push @options, 'encoding' => $self->{'encoding'};
72     }
73 
74     if (defined $self->{'use_objects'} && $self->{'use_objects'}) {
75-       push @options, 'use_objects' => $self->{'use_objects'};
76+        push @options, 'use_objects' => $self->{'use_objects'};
77     }
78 
79     $self->{'enc'} = Frontier::RPC2->new(@options);
80@@ -53,8 +58,8 @@
81     my $text = $self->{'enc'}->encode_call(@_);
82 
83     if ($self->{'debug'}) {
84-       print "---- request ----\n";
85-       print $text;
86+        print "---- request ----\n";
87+        print $text;
88     }
89 
90     $self->{'rq'}->content($text);
91@@ -62,21 +67,21 @@
92     my $response = $self->{'ua'}->request($self->{'rq'});
93 
94     if (substr($response->code, 0, 1) ne '2') {
95-       die $response->status_line . "\n";
96+        die $response->status_line . "\n";
97     }
98 
99     my $content = $response->content;
100 
101     if ($self->{'debug'}) {
102-       print "---- response ----\n";
103-       print $content;
104+        print "---- response ----\n";
105+        print $content;
106     }
107 
108     my $result = $self->{'enc'}->decode($content);
109 
110     if ($result->{'type'} eq 'fault') {
111-       die "Fault returned from XML RPC Server, fault code " . $result->{'value'}[0]{'faultCode'} . ": "
112-           . $result->{'value'}[0]{'faultString'} . "\n";
113+        die "Fault returned from XML RPC Server, fault code " . $result->{'value'}[0]{'faultCode'} . ": "
114+        . $result->{'value'}[0]{'faultString'} . "\n";
115     }
116 
117     return $result->{'value'}[0];
118--- Frontier-RPC-0.06/examples/rpc-client.pl    Thu Sep  2 15:16:49 1999
119+++ Frontier-RPC-0.06-me/examples/rpc-client.pl Wed Aug 22 15:32:07 2001
120@@ -1,3 +1,4 @@
121+#!/usr/bin/perl
122 #
123 # Copyright (C) 1998 Ken MacLeod
124 # See the file COPYING for distribution terms.
125@@ -11,7 +12,7 @@
126 
127 =head1 SYNOPSIS
128 
129- rpc-client [--debug] [--encoding ENCODING] [--proxy PROXY] \
130+ rpc-client [--debug] [--username] [--password] [--encoding ENCODING] [--proxy PROXY] \
131      URL METHOD ["ARGLIST"]
132 
133 =head1 DESCRIPTION
134@@ -31,6 +32,12 @@
135 The `C<--debug>' option will cause the client to print the XML request
136 sent to and XML response received from the server.
137 
138+The `C<--username>' option will force an Authorization:Basic header
139+to be generated, if used in conjunction with the `C<--password>' option
140+
141+The `C<--password>' option will force an Authorization:Basic header
142+to be generated, if used in conjunction with the `C<--username>' option
143+
144 The `C<--encoding>' option will supply an alternate encoding for the
145 XML request.  The default is none, which uses XML 1.0's default of
146 UTF-8.
147@@ -57,9 +64,11 @@
148 my $encoding = undef;
149 my $proxy = undef;
150 
151-GetOptions( 'debug' => \$debug,
152+GetOptions( 'debug'      => \$debug,
153             'encoding=s' => \$encoding,
154-            'proxy=s' => \$proxy );
155+            'proxy=s'    => \$proxy,
156+            'username=s' => \$username,
157+            'password=s' => \$password);
158 
159 die "usage: rpc-client URL METHOD [\"ARGLIST\"]\n"
160     if ($#ARGV != 1 && $#ARGV != 2);
161@@ -68,10 +77,12 @@
162 my $method = shift @ARGV;
163 my $arglist = shift @ARGV;
164 
165-$server = Frontier::Client->new( 'url' => $url,
166-                                 'debug' => $debug,
167+$server = Frontier::Client->new( 'url'      => $url,
168+                                 'debug'    => $debug,
169                                  'encoding' => $encoding,
170-                                 'proxy' => $proxy );
171+                                 'proxy'    => $proxy,
172+                                 'username' => $username,
173+                                 'password' => $password);
174 
175 my @arglist;
176 eval "\@arglist = ($arglist)";
Note: See TracBrowser for help on using the repository browser.