Author: dylan
Date: 2004-10-26 12:01:16 -0400 (Tue, 26 Oct 2004)
New Revision: 409
Added:
trunk/main/server/lib/Haver/Server/Commands/Login.pm
Removed:
trunk/main/server/lib/Haver/Server/Commands/Connection.pm
Log:
renamed Connection.pm to Login.pm, as this is a clearer name.
Deleted: trunk/main/server/lib/Haver/Server/Commands/Connection.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/Commands/Connection.pm 2004-10-26
04:14:54 UTC (rev 408)
+++ trunk/main/server/lib/Haver/Server/Commands/Connection.pm 2004-10-26
16:01:16 UTC (rev 409)
@@ -1,214 +0,0 @@
-# vim: set ft=perl ts=4 sw=4:
-# Commands::Basic - description
-#
-# Copyright (C) 2004 Dylan William Hardison.
-#
-# This module is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 2 of the License, or
-# (at your option) any later version.
-#
-# This module is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this module; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-package Haver::Server::Commands::Connection;
-use strict;
-use warnings;
-
-use Haver::Formats qw( :duration );
-use Digest::SHA1 qw( sha1_base64 );
-use Haver::Server::Registry qw( $Registry );
-use base 'Haver::Server::Commands';
-
-our $VERSION = '0.01';
-
-sub states {
- qw(
- want
- accept
- auth
- unknown_cmd
- init
- timeout
- );
-}
-
-sub commands {
- qw(
- HAVER
- IDENT
- CANT
- AUTH
- AUTH:PASS
- );
-}
-
-sub cmd_HAVER {
- my ($me, $kernel, $heap, $args) = @_[OBJECT, KERNEL, HEAP, ARG0];
- my $client = $args->[0];
-
- if (exists $me->{version}) {
- $kernel->yield('oops', 'repeat', ['HAVER']);
- return;
- }
-
- eval {
- $heap->{client}->put(['HAVER',
"Haver::Server/$Haver::Server::VERSION"]);
- };
- $me->{version} = $client;
- $kernel->yield('want', 'IDENT');
-}
-
-sub cmd_IDENT {
- my ($me, $kernel, $heap, $args) = @_[OBJECT, KERNEL, HEAP, ARG0];
- my ($id, $ns) = @$args;
-
- $ns ||= 'user';
-
- # This may only be called once.
- if ($me->{did}{IDENT}++) {
- $kernel->yield('oops', "repeat", ['IDENT']);
- return;
- }
-
- # We don't support other types of clients right now.
- if ($ns ne 'user') {
- $kernel->yield('fail', 'IDENT', 'unsupported.ns', [$ns]);
- $kernel->yield('want', 'IDENT');
- return;
- }
-
- # Make sure it's a valid id.
- if (not Haver::Server::Object->is_valid_id($id)) {
- $kernel->yield('fail', 'IDENT', 'syntax.id', [$id]);
- $kernel->yield('want', 'IDENT');
- return;
- }
-
- # users arn't allowed to have names that begin with
- # & or @ in them.
- if ($ns eq 'user' and ($id =~ /^&/ or $id =~ /@/)) {
- $kernel->yield('fail', 'IDENT', 'reserved.id', [$id]);
- $kernel->yield('want', 'IDENT');
- return;
- }
-
- # Check if we already have a user by that name.
- if ($Registry->contains('user', $id)) {
- $kernel->yield('fail', 'IDENT', 'used.id', [$id]);
- $kernel->yield('want', 'IDENT');
- return;
- }
-
- my $user = new Haver::Server::Object::User (
- id => $id,
- wheel => $heap->{client},
- sid => $_[SESSION]->ID,
- );
- $user->set (
- Client => $heap->{version},
- Rank => 0,
- Role => 'User',
- _info => [qw( Rank Role Client IP Login Idle )],
- );
-
- $kernel->yield('accept', $id, $user);
-}
-
-sub cmd_AUTH {
- my ($me, $kernel, $heap, $args) = @_[OBJECT, KERNEL, HEAP, ARG0];
- my $method = $args->[0];
-
- if ($me->{did}{AUTH}++) {
- $kernel->yield('oops', 'repeat', ['AUTH']);
- return;
- }
-
- if ($method eq 'PASS') {
- $kernel->yield('want', 'AUTH:PASS');
- } else {
- $kernel->yield('fail', 'AUTH', 'unknown.method', [$method]);
- $kernel->yield('want', 'IDENT');
- }
-}
-
-sub cmd_AUTH_PASS {
- my ($me, $kernel, $heap, $args) = @_[OBJECT, KERNEL, HEAP, ARG0];
- my ($pass) = @$args;
- my $user = delete $heap->{user};
- my $id = delete $heap->{uid};
-
- if ($heap->{did}{'AUTH:PASS'}++) {
- $kernel->yield('oops', 'repeat', ['AUTH:PASS']);
- return;
- }
-
- if ($pass eq $user->get('.password')) {
- $kernel->yield('accept');
- } else {
- $kernel->yield('fail', 'AUTH:PASS', 'nomatch.passhash', []);
- $kernel->yield('bye', 'monkeys');
- }
-}
-
-#-------------------------------- Events
--------------------------------------#
-
-sub on_init {
- my ($me, $kernel, $heap) = @_[OBJECT, KERNEL, HEAP];
-
- $me->{timeout} = $kernel->alarm_set('timeout', time + (60 * 3));
-}
-
-sub on_timeout {
- my ($kernel, $heap) = @_[KERNEL, HEAP];
-
- delete $heap->{client};
- $kernel->yield('shutdown');
-}
-
-sub on_want {
- my ($kernel, $heap, $want) = @_[KERNEL, HEAP, ARG0];
-
- delete $me->{did}{$want};
- $heap->{client}->put(['WANT', $want]);
-}
-
-sub since {
- my ($then, $now) = @_;
-
- $now ||= time;
- format_duration($now - $then);
-}
-
-sub on_accept {
- my ($me, $kernel, $heap, $uid, $user) = @_[OBJECT, KERNEL, HEAP, ARG0,
ARG1];
-
- $kernel->alarm_remove(delete $me->{timeout});
-
- $Registry->add($user);
- my $addr = join('.', (split(/\./, $heap->{address}))[0,1,2]) .
'.*';
- my $login_time = time;
-
- $user->set(
- IP => $addr,
- Login => sub {
- since($login_time);
- },
- _lastmsg => $login_time,
- Idle => sub {
- my ($u) = @_;
- since($u->get('_lastmsg'));
- },
- '.IP' => $heap->{address},
- );
-
- $kernel->call($_[SESSION], 'ready', $uid, $user);
- $heap->{client}->put(['ACCEPT', $uid]);
-}
-
-1;
Copied: trunk/main/server/lib/Haver/Server/Commands/Login.pm (from rev 408,
trunk/main/server/lib/Haver/Server/Commands/Connection.pm)
