Author: dylan
Date: 2005-11-11 18:19:12 -0500 (Fri, 11 Nov 2005)
New Revision: 918
Modified:
trunk/
trunk/docs/spec/lib/Haver/Spec.pod
trunk/perl/server/lib/Haver/Server/Entity.pm
trunk/perl/server/lib/Haver/Server/Entity/Avatar.pm
trunk/perl/server/lib/Haver/Server/Entity/Channel.pm
trunk/perl/server/lib/Haver/Server/Store.pm
trunk/perl/server/lib/Haver/Server/Talker.pm
trunk/perl/server/lib/Haver/Server/Wheel/Auth.pm
trunk/perl/server/lib/Haver/Server/Wheel/Login.pm
Log:
Added GHOST to the server.
Doesn't work for auth-supporting clients yet.
Property changes on: trunk
___________________________________________________________________
Name: svk:merge
- 1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/havercurs-objc:43089
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk:11166
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk-merge-10131:11178
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/winch/trunk:43192
27e50396-46e3-0310-8b22-ae223a1f35ce:/local:212
e9404bb1-7af0-0310-a7ff-e22194cd388b:/haver/local:1560
edfcd8bd-4ce7-0310-a97e-bb1efd40edf3:/local:238
+ 1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/havercurs-objc:43089
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk:11166
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk-merge-10131:11178
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/winch/trunk:43192
27e50396-46e3-0310-8b22-ae223a1f35ce:/local:212
e9404bb1-7af0-0310-a7ff-e22194cd388b:/haver/local:1569
edfcd8bd-4ce7-0310-a97e-bb1efd40edf3:/local:238
Modified: trunk/docs/spec/lib/Haver/Spec.pod
===================================================================
--- trunk/docs/spec/lib/Haver/Spec.pod 2005-11-10 12:58:04 UTC (rev 917)
+++ trunk/docs/spec/lib/Haver/Spec.pod 2005-11-11 23:19:12 UTC (rev 918)
@@ -258,7 +258,10 @@
Tried to part a channel you're not in.
+=head2 ip.mismatch
+Tried to GHOST with a different IP.
+
=head1 I MEAN, HI
I could describe the messages here in greater detail, but I think that belongs
in the
Modified: trunk/perl/server/lib/Haver/Server/Entity/Avatar.pm
===================================================================
--- trunk/perl/server/lib/Haver/Server/Entity/Avatar.pm 2005-11-10 12:58:04 UTC
(rev 917)
+++ trunk/perl/server/lib/Haver/Server/Entity/Avatar.pm 2005-11-11 23:19:12 UTC
(rev 918)
@@ -9,11 +9,13 @@
field -weak => 'wheel';
+field sid => undef;
field _access => {};
field passcode => undef;
field address => '0.0.0.*';
field version => 'unknown';
field email => '';
+field authenticated => 0;
sub initialize {
my ($self) = @_;
@@ -22,6 +24,11 @@
}
}
+sub call {
+ my $self = shift;
+ $POE::Kernel::poe_kernel->call($self->sid, @_);
+}
+
sub put {
my ($self, $msg) = @_;
Modified: trunk/perl/server/lib/Haver/Server/Entity/Channel.pm
===================================================================
--- trunk/perl/server/lib/Haver/Server/Entity/Channel.pm 2005-11-10
12:58:04 UTC (rev 917)
+++ trunk/perl/server/lib/Haver/Server/Entity/Channel.pm 2005-11-11
23:19:12 UTC (rev 918)
@@ -70,7 +70,7 @@
sub fetch {
my $self = shift;
- carp "fetch() is deprecated";
+ carp "fetch() is deprecated use get()";
$self->get(@_);
}
Modified: trunk/perl/server/lib/Haver/Server/Entity.pm
===================================================================
--- trunk/perl/server/lib/Haver/Server/Entity.pm 2005-11-10 12:58:04 UTC
(rev 917)
+++ trunk/perl/server/lib/Haver/Server/Entity.pm 2005-11-11 23:19:12 UTC
(rev 918)
@@ -34,7 +34,7 @@
sub load {
- my ($this, $data) = @_;
+ my ($this, $data, $store) = @_;
my $self = $this->new;
$self->name($data->{name});
$self->attr($data->{attr});
@@ -42,7 +42,7 @@
}
sub dump {
- my ($self) = @_;
+ my ($self, $store) = @_;
return {
name => $self->name,
attr => $self->attr,
Modified: trunk/perl/server/lib/Haver/Server/Store.pm
===================================================================
--- trunk/perl/server/lib/Haver/Server/Store.pm 2005-11-10 12:58:04 UTC (rev
917)
+++ trunk/perl/server/lib/Haver/Server/Store.pm 2005-11-11 23:19:12 UTC (rev
918)
@@ -10,6 +10,8 @@
our $VERSION = 0.01;
+field locks => {};
+
sub initialize {
my $self = shift;
$self->{storedir} ||= File::Spec->curdir;
@@ -30,18 +32,38 @@
}
}
+sub lock {
+ my ($self, $ns, $name) = @_;
+ $self->{locks}{"$ns/$name"} = 1;
+}
+
+sub unlock {
+ my ($self, $ns, $name) = @_;
+ delete $self->{locks}{"$ns/$name"};
+}
+
+sub is_locked {
+ my ($self, $ns, $name) = @_;
+ exists $self->{locks}{"$ns/$name"};
+}
+
sub insert {
my ($self, $entity) = @_;
my $data = $entity->dump($self);
my $file = $self->filename($entity->namespace, $entity->name);
-
+
+ $self->unlock($entity->namespace, $entity->name);
$self->_save_file($file, ref($entity), $data);
}
sub fetch {
my ($self, $ns, $name) = @_;
my $file = $self->filename($ns, $name);
+ if ($self->is_locked($ns, $name)) {
+ die "can't fetch $ns/$name: locked.";
+ }
my ($class, $data) = @{ $self->_load_file($file) };
+ $self->lock($ns, $name);
return $class->load($data, $self);
}
Modified: trunk/perl/server/lib/Haver/Server/Talker.pm
===================================================================
--- trunk/perl/server/lib/Haver/Server/Talker.pm 2005-11-10 12:58:04 UTC
(rev 917)
+++ trunk/perl/server/lib/Haver/Server/Talker.pm 2005-11-11 23:19:12 UTC
(rev 918)
@@ -65,7 +65,7 @@
Log('warning', 'Probably a search engine...');
$heap->{error} = 1;
$heap->{client} = undef;
- post('shutdown');
+ call('shutdown');
} else {
Log('warning', "Client isseud unknown command $cmd");
call('fail', 'unknown.cmd');
Modified: trunk/perl/server/lib/Haver/Server/Wheel/Auth.pm
===================================================================
--- trunk/perl/server/lib/Haver/Server/Wheel/Auth.pm 2005-11-10 12:58:04 UTC
(rev 917)
+++ trunk/perl/server/lib/Haver/Server/Wheel/Auth.pm 2005-11-11 23:19:12 UTC
(rev 918)
@@ -23,6 +23,7 @@
my ($kernel, $heap, $user) = @_[KERNEL, HEAP, ARG0];
Log('notice', "client is authorized as $heap->{name}");
$heap->{loader}->unload_wheel(__PACKAGE__);
+ $user->authenticated(1);
$kernel->yield('accept', delete $heap->{name}, $user);
}
Modified: trunk/perl/server/lib/Haver/Server/Wheel/Login.pm
===================================================================
--- trunk/perl/server/lib/Haver/Server/Wheel/Login.pm 2005-11-10 12:58:04 UTC
(rev 917)
+++ trunk/perl/server/lib/Haver/Server/Wheel/Login.pm 2005-11-11 23:19:12 UTC
(rev 918)
@@ -34,8 +34,38 @@
$heap->{extensions} = \%ext;
$self->undefine('msg_HAVER');
$self->define('msg_IDENT', 'msg_IDENT');
+ $self->define('msg_GHOST', 'msg_GHOST');
}
+sub msg_GHOST {
+ my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
+ my ($name) = @$args;
+ my $ns = 'user';
+ my $lobby = $heap->{lobby};
+ my $store = $heap->{store};
+
+ if ($lobby->contains($ns, $name)) {
+ if (exists $heap->{extensions}{auth}) {
+ Log("notice", "not supported");
+ call('fail', "unsupported");
+ } else {
+ my $user = $lobby->get($ns, $name);
+ if ((not $user->authenticated) and $user->address eq
$heap->{address}) {
+ Log('notice', "Removing $ns/$name from &lobby");
+ $lobby->remove($ns, $name);
+ $user->call('shutdown', 'ghost');
+ call('msg_IDENT', [$name]);
+ } else {
+ Log('notice', "$user->{address} ne
$heap->{address}");
+ call('fail', "ip.mismatch", $heap->{address});
+ }
+ }
+ } else {
+ Log("notice", "GHOST Passthrough");
+ call('msg_IDENT', [$name]);
+ }
+}
+
sub msg_IDENT {
my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
my ($name) = @$args;
@@ -71,6 +101,7 @@
$user->wheel($heap->{client});
+ $user->sid($_[SESSION]->ID);
$user->version($heap->{version});
$user->address($heap->{address});
$lobby->add($user);
