Author: muffin
Date: 2005-11-19 23:30:01 -0500 (Sat, 19 Nov 2005)
New Revision: 931
Modified:
trunk/perl/client/lib/Haver/Client.pm
Log:
Haver::Client now has a 'debug' option in create(). Incidentally, AUTH:CANT is
not a real command ;)
Modified: trunk/perl/client/lib/Haver/Client.pm
===================================================================
--- trunk/perl/client/lib/Haver/Client.pm 2005-11-19 04:57:35 UTC (rev
930)
+++ trunk/perl/client/lib/Haver/Client.pm 2005-11-20 04:30:01 UTC (rev
931)
@@ -101,11 +101,12 @@
sub on__start {
my ($kernel, $heap, $opt) = @_[KERNEL, HEAP, ARG0];
croak "No alias" unless $opt->{alias};
- $heap->{reg} = {};
+ $heap->{reg} = {};
$heap->{state} = S_IDLE;
$heap->{alias} = $opt->{alias};
$heap->{resolver} = $opt->{resolver};
- $heap->{version} = $opt->{version} || "Haver::Client/$VERSION";
+ $heap->{version} = $opt->{version} || "Haver::Client/$VERSION";
+ $heap->{debug} = $opt->{debug};
$kernel->alias_set($opt->{alias});
}
@@ -228,7 +229,7 @@
my ($kernel, $heap, $arg) = @_[KERNEL,HEAP,ARG0];
return if (ref $arg ne 'ARRAY' || @$arg == 0);
- if (DEBUG) {
+ if ($heap->{debug}) {
print STDERR "S: ", join "\t", @$arg;
print STDERR "\n";
}
@@ -276,7 +277,7 @@
$heap->{state} == S_DYING) {
return;
}
- if (DEBUG) {
+ if ($heap->{debug}) {
print STDERR "C: ", join("\t", @args), "\n";
}
$heap->{wheel}->put([EMAIL PROTECTED]);
@@ -382,7 +383,9 @@
if (grep(/^AUTH:BASIC$/, @types)) {
call('send_raw', qw( AUTH:TYPE AUTH:BASIC ));
} else {
- call('send_raw', qw( AUTH:CANT ));
+ # This really oughtn't to happen. Try it anyway, we might be
lucky.
+ # XXX - Something more appropriate should happen here.
+ call('send_raw', qw( AUTH:TYPE AUTH:BASIC ));
}
}
@@ -390,18 +393,20 @@
my ($kernel, $heap, $nonce, @types) = @_[KERNEL, HEAP, ARG1 .. $#_];
my ($type, $response);
+ # Generate a passcode as per Haver::Spec::Auth.
+
my $passcode = sha1_base64($heap->{password} .
lc("$heap->{host}$heap->{name}"));
if (grep(/^sha1$/, @types)) {
$type = "sha1";
$response = sha1_base64($nonce . $passcode);
} else {
- #Surely, *surely* the server has MD5 if nothing else...
+ # Surely, *surely* the server has MD5 if nothing else...
$type = "md5";
$response = md5_base64($nonce . $passcode);
}
- $kernel->yield('send_raw', 'AUTH:BASIC', $type, $response);
+ call('send_raw', 'AUTH:BASIC', $type, $response);
}
sub msg_PING {
@@ -503,16 +508,18 @@
There is only one method, create(), which is a class method.
-=head2 create(alias => $alias, resolver => $resolver, version => $version)
+=head2 create(alias => $alias, [ resolver => $resolver ], [ version =>
$version ], [ debug => 1 ])
This creates a new Haver::Client session. The only required parameter
is $alias, which is how you'll talk to the client session using
L<POE::Kernel>'s post().
If given, $resolver should be a L<POE::Component::Client::DNS> object.
-Finally, $version is what we will advertize as the client name and version
number to the
+If specified, $version is what we will advertize as the client name and
version number to the
server. It defaults to C<Haver::Client/0.09>.
+Finally, specifying debug will cause the module to print the protocol exchange
with the server to STDOUT.
+
=head1 STATES
While these are listed just like methods, you must post() to them, and not
call them
