Author: dylan
Date: 2004-07-23 02:11:30 -0400 (Fri, 23 Jul 2004)
New Revision: 324
Added:
trunk/jarverd/
trunk/jarverd/lib/
trunk/jarverd/lib/Jarver/
trunk/jarverd/lib/Jarver/Connection.pm
trunk/jarverd/lib/Jarver/Haver.pm
trunk/jarverd/lib/Jarver/Listener.pm
trunk/jarverd/run.pl
Log:
I present: Jarverd, a proxy between JRC clients and haver servers.
Please pronounce it either Harverd or Jay Ar Verd.
Added: trunk/jarverd/lib/Jarver/Connection.pm
===================================================================
--- trunk/jarverd/lib/Jarver/Connection.pm 2004-07-21 01:44:50 UTC (rev
323)
+++ trunk/jarverd/lib/Jarver/Connection.pm 2004-07-23 06:11:30 UTC (rev
324)
@@ -0,0 +1,412 @@
+# Jarver::Connection,
+# this creates a session, which represents the user...
+#
+# Copyright (C) 2003 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
+
+# TODO, write POD. Soon.
+package Jarver::Connection;
+use strict;
+use Carp qw(croak confess carp cluck);
+use Jarver::Haver;
+use POE qw(
+ Wheel::ReadWrite
+ Driver::SysRW
+ Preprocessor
+ Filter::Haver
+);
+our $ID = 1;
+
+#use Jarver::Globals qw( $Registry $Config );
+
+our $RELOAD = 1;
+my $debug = 6;
+sub _dprint {
+ my ($thresh, @stuff) = @_;
+ return unless $thresh <= $debug;
+ print STDERR @stuff, "\n";
+}
+
+sub create {
+ my ($class, @args) = @_;
+
+ POE::Session->create(
+ package_states => [
+ $class => [qw(
+ _start
+ _stop
+ jrc_input
+ jrc_flush
+ jrc_error
+ shutdown
+ cleanup
+ _default
+ login
+ haver_connect
+ haver_fail
+ haver_flush
+ haver_input
+ haver_error
+ cmd_WANT
+ cmd_ACCEPT
+ cmd_IN
+ cmd_OF
+ cmd_JOIN
+ cmd_MSG
+ cmd_USERS
+ cmd_CHANS
+ cmd_QUIT
+ cmd_PART
+ cmd_MARK
+ cmd_INFO
+ )],
+ ],
+ heap => {
+ },
+ args => [EMAIL PROTECTED],
+ );
+}
+
+sub _start {
+ my ($heap, $session, $kernel, $socket, $address, $port ) =
+ @_[ HEAP, SESSION, KERNEL, ARG0, ARG1, ARG2];
+ $address = Socket::inet_ntoa($address);
+
+ $kernel->post('Logger', 'note', 'Socket Birth');
+ $kernel->post('Logger', 'note', "Connection from ${address}:$port");
+
+
+ binmode $socket, ":utf8";
+ my $sock = new POE::Wheel::ReadWrite(
+ Handle => $socket,
+ Driver => new POE::Driver::SysRW,
+ Filter => new POE::Filter::Line(
+ OutputLiteral => chr(10),
+ ),
+ InputEvent => 'jrc_input',
+ FlushedEvent => 'jrc_flush',
+ ErrorEvent => 'jrc_error',
+ );
+
+ $heap->{jrc} = $sock;
+
+}
+sub _stop {
+ my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION];
+
+ my ($address, $port) = @$heap{qw(address port)};
+ $kernel->call('Logger', 'note', 'Socket Death');
+ $kernel->call('Logger', 'note', "Lost connection from
${address}:$port");
+}
+
+sub jrc_input {
+ my ($kernel, $heap, $line) = @_[KERNEL, HEAP, ARG0];
+ my $cmd;
+
+# return unless exists $heap->{haver};
+# return unless exists $heap->{jrc};
+
+ my $did =0;
+ local $_ = $line;
+ if (/^\^(.+?)\tA(.+?)$/) {
+ $kernel->yield('login', $2, $1);
+ } elsif (/^A(.+?)$/) {
+ $kernel->yield('login', $1, "JRC");
+ } elsif (/^D(.+)$/) {
+ if ($heap->{channel}) {
+ $heap->{haver}->put(['PART', $heap->{channel}]);
+ }
+ $heap->{channel} = $1;
+ $heap->{haver}->put(['JOIN', $1]);
+ } elsif (/^Hc$/ or /^Hc\t(.+)$/) {
+ $heap->{haver}->put(['IN', $1 || $heap->{channel}, 'USERS']);
+ } elsif (/^Hb$/) {
+ $heap->{haver}->put(['CHANS']);
+ } elsif (/^Ha$/) {
+ $heap->{haver}->put(['USERS']);
+ } elsif (/^E(.+)$/) {
+ my $msg = $1;
+ my $kind;
+ if ($msg =~ s/^\.me //) {
+ $kind = ':';
+ } else {
+ $kind = '"';
+ }
+ $heap->{haver}->put(['IN', $heap->{channel}, 'MSG', $kind,
$msg]);
+ } elsif (/^F([^\t]+)\t(.+)$/) {
+ my $to = $1;
+ my $msg = $2;
+ my $kind;
+ if ($msg =~ s/^\.me //) {
+ $kind = ':';
+ } else {
+ $kind = '"';
+ }
+ $heap->{haver}->put(['TO', $to, 'MSG', $kind, $msg]);
+ $heap->{jrc}->put(join("\t", "F$heap->{name}", $to, $msg.'F'));
+ } elsif (/^\^(.+)\t(.+)$/) {
+ my ($type, $data) = ($1, $2);
+ if ($data =~ /^Ic$/) {
+ $heap->{haver}->put(['MARK', $type, 'TO', '*', 'IN',
$heap->{channel}, 'INFO']);
+ } elsif ($data =~ /^Ia\t?(.+)$/) {
+ $heap->{haver}->put(['MARK', $type, 'TO', $1, 'IN',
$heap->{channel}, 'INFO']);
+ } else {
+ $kernel->post('Logger', 'error', "Unknown whois:
$data");
+ }
+ } else {
+ $did++;
+ print ":: $line\n";
+ }
+}
+
+sub jrc_flush {
+ my ($kernel, $heap) = @_[KERNEL, HEAP];
+
+ if ($heap->{shutdown}) {
+ $heap->{jrc} = undef;
+ }
+}
+sub jrc_error {
+ my ($kernel, $heap, $operation, $errnum, $errstr) = @_[KERNEL, HEAP,
ARG0..ARG3];
+
+ $kernel->post('Logger', 'error',
+ "Socket generated $operation error ${errnum}: $errstr");
+
+ $heap->{jrc} = undef;
+ $kernel->yield('cleanup', 'DISCON');
+}
+
+
+sub shutdown {
+ my ($kernel, $heap, $session, @args) = @_[KERNEL, HEAP, SESSION, ARG0
.. $#_];
+ return if $heap->{shutdown};
+
+# $heap->{socket}->put(['BYE', @args]);
+ $heap->{shutdown} = 1;
+ $kernel->yield('cleanup', @args);
+}
+
+sub cleanup {
+ my ($kernel, $heap, @args) = @_[KERNEL, HEAP, ARG0 .. $#_];
+
+ if (!$heap->{cleanup}) {
+ $kernel->call('Logger', 'note', 'Shutting down client
session.');
+
+ } else {
+ $kernel->post('Logger', 'error', "Trying to run cleanup more
than once! @args");
+ }
+}
+
+sub _default {
+ my ($kernel, $heap, $event, $args) = @_[KERNEL, HEAP, ARG0, ARG1];
+
+
+ $kernel->post('Logger', 'error', "Unknown event: $event");
+
+ return 0;
+}
+
+sub login {
+ my ($kernel, $heap, $name, $version) = @_[KERNEL,HEAP,ARG0..$#_];
+ $heap->{name} = $name;
+ $heap->{version} = $version;
+
+ # Connecting Internet domain socket.
+ my $wheel = POE::Wheel::SocketFactory->new(
+ RemoteAddress => "localhost", # Sets the connect() addre
+ RemotePort => "7071", # Sets the connect() port
+ SuccessEvent => 'haver_connect', # Event to emit on
connection
+ FailureEvent => 'haver_fail', # Event to emit on error
+ );
+ $heap->{connect} = $wheel;
+ $heap->{jrc}->put('[EMAIL PROTECTED]');
+ $kernel->post('Logger', 'note', "Logging into haver as $heap->{name}");
+}
+
+sub haver_flush {
+ my ($kernel, $heap) = @_[KERNEL, HEAP];
+
+ if ($heap->{shutdown}) {
+ $heap->{haver} = undef;
+ }
+}
+sub haver_connect {
+ my ($kernel, $heap, $sock) = @_[KERNEL, HEAP, ARG0..$#_];
+
+ delete $heap->{conn};
+
+ binmode $sock, ':utf8';
+ my $wheel = new POE::Wheel::ReadWrite(
+ Handle => $sock,
+ Driver => new POE::Driver::SysRW,
+ Filter => new POE::Filter::Haver,
+ InputEvent => 'haver_input',
+ FlushedEvent => 'haver_flush',
+ ErrorEvent => 'haver_error',
+ );
+
+ $heap->{haver} = $wheel;
+}
+
+sub haver_fail {
+ my ($kernel, $heap, $enum, $estr) = @_[KERNEL,HEAP,ARG0,ARG1];
+
+ $kernel->post('Logger', 'error', "Connection Error: ($enum) $estr");
+ delete $heap->{conn};
+}
+
+sub haver_input {
+ my ($kernel, $heap, $args) = @_[KERNEL,HEAP,ARG0];
+ my $event = shift @$args;
+ my $cmd = "cmd_$event";
+
+ return unless exists $heap->{haver};
+ return unless exists $heap->{jrc};
+
+ $kernel->yield($cmd, $args);
+}
+
+sub haver_error {
+ my ($kernel, $heap, $operation, $errnum, $errstr) = @_[KERNEL, HEAP,
ARG0..ARG3];
+
+ $kernel->post('Logger', 'error',
+ "Socket generated $operation error ${errnum}: $errstr");
+
+ $heap->{haver} = undef;
+ $kernel->yield('cleanup', 'DISCON');
+}
+
+sub cmd_IN {
+ my ($kernel, $heap, $args) = @_[KERNEL,HEAP,ARG0];
+ my ($in, $event, @rest) = @$args;
+ my $cmd = "cmd_$event";
+
+
+ print "Calling $cmd...\n";
+ $heap->{in} = $in;
+ $kernel->call($_[SESSION], $cmd, [EMAIL PROTECTED]);
+ $heap->{in} = undef;
+}
+
+sub cmd_MARK {
+ my ($kernel, $heap, $args) = @_[KERNEL,HEAP,ARG0];
+ my ($mark, $event, @rest) = @$args;
+ my $cmd = "cmd_$event";
+
+
+ print "Calling $cmd...\n";
+ $heap->{mark} = $mark;
+ $kernel->call($_[SESSION], $cmd, [EMAIL PROTECTED]);
+ $heap->{mark} = undef;
+}
+
+sub cmd_OF {
+ my ($kernel, $heap, $args) = @_[KERNEL,HEAP,ARG0];
+ my ($of, $event, @rest) = @$args;
+ my $cmd = "cmd_$event";
+
+
+ print "Calling $cmd...\n";
+ $heap->{of} = $of;
+ $kernel->call($_[SESSION], $cmd, [EMAIL PROTECTED]);
+ $heap->{of} = undef;
+}
+
+sub cmd_JOIN {
+ my ($kernel, $heap, $args) = @_[KERNEL,HEAP,ARG0];
+
+ eval { $heap->{jrc}->put('D'.$heap->{of}."\t".$heap->{in}.'D') };
+}
+
+sub cmd_WANT {
+ my ($kernel, $heap, $args) = @_[KERNEL,HEAP,ARG0];
+ my $want = shift @$args;
+
+ if ($want eq 'IDENT') {
+ $heap->{haver}->put(['IDENT', $heap->{name}, 'user', "Jarver +
$heap->{version}"]);
+ } else {
+ $heap->{haver}->put(['CANT', $want]);
+ }
+}
+
+sub cmd_ACCEPT {
+ my ($kernel, $heap, $args) = @_[KERNEL,HEAP,ARG0];
+ my $uid = shift @$args;
+
+ $heap->{jrc}->put('wA'.$uid.'w', 'w~75424w');
+}
+
+sub cmd_MSG {
+ my ($kernel, $heap, $args) = @_[KERNEL,HEAP,ARG0];
+ my ($type, $msg) = @$args;
+
+ if ($type eq ':') {
+ $msg = ".me $msg";
+ }
+
+ if ($type ne '"' && $type ne ':') {
+ return;
+ }
+
+ if ($heap->{in}) {
+ $heap->{jrc}->put('E'.$heap->{of}."\t".$msg.'E');
+ } else {
+ $heap->{jrc}->put('F'.$heap->{of}."\t".$msg.'F');
+ }
+}
+
+sub cmd_USERS {
+ my ($kernel, $heap, $args) = @_[KERNEL,HEAP,ARG0];
+
+ if ($heap->{in}) {
+ $heap->{jrc}->put('H'.$heap->{name}."\tc$heap->{in}\t" .
join("\t", @$args) . 'H');
+ } else {
+ $heap->{jrc}->put('H'.$heap->{name}."\ta".join("\t", @$args) .
'H');
+ }
+}
+
+sub cmd_CHANS {
+ my ($kernel, $heap, $args) = @_[KERNEL,HEAP,ARG0];
+ $heap->{jrc}->put('H'.$heap->{name}."\tb" . join("\t", @$args) . 'H');
+}
+
+sub cmd_QUIT {
+ my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
+ $heap->{jrc}->put('C'.$heap->{of}."\t".$heap->{channel}.'C');
+}
+
+sub cmd_PART {
+ my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
+ $heap->{jrc}->put('C'.$heap->{of}."\t".$heap->{in}.'C');
+}
+
+sub cmd_INFO {
+ my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
+ my $msg = "^$heap->{name}\t$heap->{mark}\tIa$heap->{of}\t";
+ my %hash = @$args;
+ $hash{Access} = delete($hash{Role}) . "\t" . delete($hash{Rank});
+
+ foreach my $key (keys %hash) {
+ $msg .= "$key\cB$hash{$key}\cC";
+ }
+ $msg .= "\cD^";
+
+ $heap->{jrc}->put($msg);
+}
+
+
+1;
+
Added: trunk/jarverd/lib/Jarver/Haver.pm
===================================================================
--- trunk/jarverd/lib/Jarver/Haver.pm 2004-07-21 01:44:50 UTC (rev 323)
+++ trunk/jarverd/lib/Jarver/Haver.pm 2004-07-23 06:11:30 UTC (rev 324)
@@ -0,0 +1,127 @@
+# Copyright (C) 2003 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
+
+# TODO, write POD. Soon.
+package Jarver::Haver;
+use strict;
+use warnings;
+use Carp;
+use POE qw(
+ Wheel::SocketFactory
+);
+
+use Haver::Preprocessor;
+use Jarver::Connection;
+
+sub create {
+ my ($class, %opts) = @_;
+ my $ses = POE::Session->create(
+ package_states =>
+ [
+ $class => [
+ '_start',
+ '_stop',
+ 'socket_connect',
+ 'socket_fail',
+ 'socket_input',
+ 'login',
+ qw(
+ cmd_WANT
+ cmd_ACCEPT
+ ),
+ ]
+ ],
+ heap => {
+ %opts,
+ },
+ );
+
+ return $ses->ID;
+}
+
+sub _start {
+ my ($kernel, $heap) = @_[KERNEL, HEAP];
+
+
+}
+
+sub _stop {
+ my ($kernel, $heap) = @_[KERNEL,HEAP];
+}
+
+sub login {
+ my ($kernel, $heap, $name, $version) = @_[KERNEL,HEAP,ARG0..$#_];
+ $heap->{name} = $name;
+ $heap->{version} = $version;
+
+ # Connecting Internet domain socket.
+ my $wheel = POE::Wheel::SocketFactory->new(
+ RemoteAddress => $heap->{address}, # Sets the connect()
addre
+ RemotePort => $heap->{port}, # Sets the connect()
port
+ SuccessEvent => 'socket_connect', # Event to emit on
connection
+ FailureEvent => 'socket_fail', # Event to emit on error
+ );
+ $heap->{connect} = $wheel;
+}
+
+sub socket_connect {
+ my ($kernel, $heap, $sock) = @_[KERNEL, HEAP, ARG0..$#_];
+
+ delete $heap->{conn};
+
+ binmode $sock, ':utf8';
+ my $wheel = new POE::Wheel::ReadWrite(
+ Handle => $sock,
+ Driver => new POE::Driver::SysRW,
+ Filter => new POE::Filter::Haver,
+ InputEvent => 'socket_input',
+ FlushedEvent => 'socket_flush',
+ ErrorEvent => 'socket_error',
+ );
+
+ $heap->{sock} = $wheel;
+}
+
+sub socket_fail {
+ my ($kernel, $heap, $enum, $estr) = @_[KERNEL,HEAP,ARG0,ARG1];
+
+ $kernel->post('Logger', 'error', "Connection Error: ($enum) $estr");
+ delete $heap->{conn};
+}
+
+sub socket_input {
+ my ($kernel, $heap, $args) = @_[KERNEL,HEAP,ARG0];
+ my $event = shift @$args;
+ my $cmd = "cmd_$event";
+
+
+ $kernel->yield($cmd, $args);
+}
+
+sub cmd_WANT {
+ my ($kernel, $heap, $args) = @_[KERNEL,HEAP,ARG0];
+ my $want = shift @$args;
+
+ if ($want eq 'IDENT') {
+ $heap->{sock}->put(['IDENT', lc $heap->{name}, 'user', "Jarver
+ $heap->{version}"]);
+ } else {
+ $heap->{sock}->put(['CANT', $want]);
+ }
+}
+
+
+
+1;
Added: trunk/jarverd/lib/Jarver/Listener.pm
===================================================================
--- trunk/jarverd/lib/Jarver/Listener.pm 2004-07-21 01:44:50 UTC (rev
323)
+++ trunk/jarverd/lib/Jarver/Listener.pm 2004-07-23 06:11:30 UTC (rev
324)
@@ -0,0 +1,92 @@
+# Jarver::Listener,
+# this creates a session that listens for connections,
+# and when something connects, it spawns
+# a Jarver::Connection session.
+#
+# Copyright (C) 2003 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
+
+# TODO, write POD. Soon.
+package Jarver::Listener;
+use strict;
+use warnings;
+use Carp;
+use POE qw(
+ Wheel::SocketFactory
+);
+
+use Haver::Preprocessor;
+use Jarver::Connection;
+
+sub create {
+ my ($class, %opts) = @_;
+ POE::Session->create(
+ package_states =>
+ [
+ $class => [
+ '_start',
+ '_stop',
+ 'socket_birth',
+ 'socket_fail',
+ ]
+ ],
+ heap => {
+ port => $opts{port},
+ },
+ args => [EMAIL PROTECTED],
+ );
+}
+
+sub _start {
+ my ($kernel, $heap) = @_[KERNEL, HEAP];
+ my $port = $heap->{port};
+
+
+ DEBUG: "Listener starts.";
+ $kernel->post('Logger', 'note', "Listening on port $port.");
+
+ $heap->{listener} = POE::Wheel::SocketFactory->new(
+ #BindAddress => '127.0.0.1',
+ BindPort => $port,
+ Reuse => 1,
+ SuccessEvent => 'socket_birth',
+ FailureEvent => 'socket_fail',
+ );
+ $kernel->alias_set('Listener');
+}
+sub _stop {
+ my ($kernel, $heap) = @_[KERNEL,HEAP];
+ delete $heap->{listener};
+ delete $heap->{session};
+ DEBUG: "Listener stops.";
+}
+
+sub socket_birth {
+ my ($kernel, $socket, $address, $port) = @_[ KERNEL, ARG0, ARG1, ARG2 ];
+
+
+ create Jarver::Connection ($socket, $address, $port);
+}
+sub socket_fail {
+ my ($kernel, $heap, $operation, $errnum, $errstr, $wheel_id) =
@_[KERNEL, HEAP, ARG0..ARG3];
+ die "Listener: '$operation' failed: $errstr";
+}
+
+sub shutdown {
+ $_[KERNEL]->alias_remove('Listener');
+}
+
+1;
Added: trunk/jarverd/run.pl
===================================================================
--- trunk/jarverd/run.pl 2004-07-21 01:44:50 UTC (rev 323)
+++ trunk/jarverd/run.pl 2004-07-23 06:11:30 UTC (rev 324)
@@ -0,0 +1,36 @@
+#!/usr/bin/perl
+# haverd.pl, This is a haver-compatible server.
+# This really doesn't do much, except load a few modules and start everything.
+# Copyright (C) 2003 Dylan William Hardison
+#
+# This program 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 program 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 program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+use strict;
+use warnings;
+BEGIN {
+ $Haver::Preprocessor::ASSERT = 1;
+ $Haver::Preprocessor::DUMP = 1;
+ $Haver::Preprocessor::DEBUG = 2;
+ $Haver::Preprocessor::VERBOSE = 1;
+ $Haver::Preprocessor::IF = 1;
+}
+
+use Jarver::Listener;
+use Haver::Util::Logger;
+use Jarver::Haver;
+create Haver::Util::Logger(levels => {} );
+create Jarver::Listener(port => 41528);
+
+POE::Kernel->run;
+
Property changes on: trunk/jarverd/run.pl
___________________________________________________________________
Name: svn:executable
+ *
