use strict;
use warnings;
use vars qw($VERSION);
$VERSION = "0.015";



=head1 NAME

Shared - Shared variables across processes that are either local or
remote.

=head1 SYNOPSIS

use Shared;

my $listen         = new Shared::Retriever;

my $new_shared     = new Shared::Local  (
                                         name=>"new_shared",
                                         accept=>['127.0.0.1','164.107
+.70.126']
                                        );

my $old_shared     = new Shared::Local  (name=>"old_shared");

my $remote_shared  = new Shared::Remote (
                                         name=>"remote_shared",
                                         ref=>"new_shared",
                                         port=>$new_shared->port,
                                         address=>'127.0.0.1'
                                        );

$listen->add(\$new_shared, \$old_shared, \$remote_shared);

$listen->store($new_shared, "One ");
print $listen->retrieve($new_shared);
$listen->store($old_shared, "two ");
print $listen->retrieve($old_shared);
$listen->store($old_shared, [qw(three four)]);
print @{$listen->retrieve($old_shared)};
$listen->store($remote_shared, " and five.");
print $listen->retrieve($remote_shared);

$listen->destroy_all;

=head1 DESCRIPTION

I<Shared> gives you the ability to share variables across processes th
+at
are either local or remote.  No functions are exported by Shared; the
interface is entirely OO. C<Shared::Local> and C<Shared::Remote> objec
+ts are created
and interfaced with a C<Shared::Retriever> object.  Here is a descript
+ion of
the objects:

=head2 Shared::Local

C<Shared::Local> is the initial class that is used to share the data; 
+it
is also the object that actually stores the data as well.  You'll almo
+st
never have to interface with C<Shared::Local> objects; most interfacin
+g will be
done with C<Shared::Retriever>.  However, C<Shared::Local> does provid
+e 2
useful methods: lock and port.  Lock functions like a file lock, and p
+ort
returns the port number that the object is listening on.  See the meth
+ods
section for more details.  The constructor to C<Shared::Local> takes 1
argument: a hash.  The hash can be configured to provide a number of
options:

=over 3

=item C<name>

The name that you will use to refer to the variable; it is the only
required option.  It can be anything; it does not have to be the same 
+as the
variable itself.  However, note that if C<Shared::Remote> is going to 
+be used on
another machine, it will have to know the name of the variable it need
+s in order
to access it.

=item C<access>

access is an optional field used to designate which address to allow
access to the variable.  Assign either a reference to an array or an a
+nyonomous
array to access.  access will default to localhost if it is not define
+d.

=item C<port>

If you really want to, you can specify which port to listen from; howe
+ver,
its probably best to let the OS pick on unless you are going to use
C<Shared::Remote> at some other Location.

=item C<debug>

Set to a true value to turn on debuging for the object, which makes it
spew out all sorts of possibly useful info.

=back

As stated earlier, there are also 2 methods that can be called: port a
+nd
lock.

=over 3

=item c<port()>

Returns the port number that the Shared::Local object is listening on.

=item c<lock()>

Works like a file lock; 0=not locked; 1=temp lock used during storage,
and 2=completely lock.

=back

=head2 Shared::Remote

C<Shared::Remote> is basically a front end to accessing data stored by
Shared::Local objects on remote machines.  C<Shared::Remote> also take
+s
a hash as an argument, similarily to C<Shared::Local>.  However,
C<Shared::Remote> can take many more elements, and all of which are
required (except debug).

=over 3

=item C<name>

The name that you will be using to reference this object.

=item C<ref>

Ref will be the name of the Shared::Local object on the machine that
you are accessing.  You B<MUST> correctly specify ref (think of it as
a "password") or you will be unable to access the data.

=item C<address>

The address of the machine where the data that you want to access is
located.

=item C<port>

The port number where the data is stored on the machine which you are
accessing

=item C<debug>

Set to a true value to turn on debuging for the object, which makes it
spew out all sorts of possibly useful info.

=back

There are no methods that you can access with C<Shared::Remote>.

=head1 Shared::Retriever

Shared::Retriever

C<Shared::Retriever> is the object with which you will use to interfac
+e
with C<Shared::Local> and C<Shared::Remote> objects.  You can think of
C<Shared::Retriever> as the class that actually all of the work: stori
+ng
the data, retrieving the data, and managing the objects.  It has 5 met
+hods
available for you to use: add, remove, store, retrieve, and destroy_al
+l
(see method descriptions below for more info).  New accepts 1 argument
+,
and when set to a true value debugging is turned on (only for the
Retriever object, however).  Methods:

=over 3

=item C<add(@list)>

Adds a list of C<Shared::Local> / C<Shared::Remote> objects so that th
+ey
can be "managed."  Nothing (storing/retrieving/etc) can be done with t
+he
objects until they have been added, so don't forget to do it!

=item C<remove(@list)>

Remove effectively kills any objects in C<@list> and all data in them,
+ as
well as remove them from the management scheme.

=item C<store($object, \$data)>

Stores the data in C<$object>, whether it be a C<Shared::Local> object
+ or
C<Shared::Remote> object.  The data needs to be a reference so that it
+ can
be serialized and shipped away.  Returns the number of bytes sent.

=item C<retrieve($object)>

Grabs the data out of C<$object>, and returns the value.  Note that it
will be the derefferenced value of the data that you stored (in other 
+words,
you pass C<\$data> to store, and retrieve returns C<$data>).

=item C<destroy_all()>

Your standard janitorial method.  Call it at the end of every program 
+in
which you use I<Shared>, or else you will have legions of zombie proce
+ss
lurking, waiting to eat you and your children...

=back

=head1 CAVEAT

As of right now, there is no default encryption on the data, so if you
want to make sure your data is secure you should encrypt it prior to s
+torage.
There still is address and name checking, so its not like your data is
+ waving in
the wind, but the data won't be protected during transmission.

=head1 TODO

=over 3

=item Testing

This module is brand new and needs LOTS of testing. :)

=item Encryption

It would be nice for the user to be able to pass a subroutine defining
+ an
encryption scheme to use, or even to use C<Crypt::RC5> to automaticall
+y
encrypt the data if a flag is turned on.  However, as of now, data is 
+still sent
in plaintext
(if you would call data that has been C<Storable>ified and then serial
+ized
for transmission plaintext), so it is up to you to encrypt the data if
+ you are
paranoid about security.

=back

=head1 AUTHOR

Joseph F. Ryan, ryan.311@osu.edu

=cut



package Shared::Local;
use IO::Socket;
use Storable qw(freeze thaw);
use Carp;

sub REAPER
{
    my $waitedpid = wait;
    $SIG{CHLD} = \&REAPER;
}
$SIG{CHLD} = \&REAPER;

sub new
{
    my ($proto, %config) = @_;

    my $class = ref($proto) || $proto;
    my $self  = {};

    $self->{debug}  = exists($config{debug}) ? $config{name} : 0;
    $self->{name}   = crypt($config{name}, $config{name});
    $self->{ref}    = $config{name};
    $self->{data}   = ();
    $self->{port}   = 0;
    $self->{lock}   = 0;

    $self->{accept} = defined(@{$config{accept}}) ? [@{$config{accept}
+}] : [qw(127.0.0.1)];

    my $sock = IO::Socket::INET->new
                                 (
                                  LocalAddr => 'localhost',
                                  Listen    => SOMAXCONN,
                                  Reuse     => 1,
                                  Proto     => 'tcp'
                                 );

    $sock->sockopt (SO_REUSEADDR, 1);
    $sock->sockopt (SO_LINGER, 0);

    $self->{port} = $sock->sockport;
    $self->{port} = $config{port} if exists($config{port});
    $sock->close;
    undef $sock;
    $sock = IO::Socket::INET->new
                                 (
                                  LocalPort => $self->{port},
                                  Listen    => SOMAXCONN,
                                  Reuse     => 1,
                                  Proto     => 'tcp'
                                 );
    $sock->autoflush(1);
    if ($config{debug})
    {
        print "Constructor for ", $config{name}, ":\n";
        print "\tType of class: ", $class, "\n";
        print "\tListening on port: ", $self->{port}, "\n";
        print "\tAccepting from addresses:\n";
        foreach my $address (@{$self->{accept}})
        {
            print "\t\t", $address, "\n";
        }
        print "\n";
    }
    croak "Can't fork: $!" unless defined ($self->{child} = fork());
    if ($self->{child} == 0)
    {
        while (my $connection = $sock->accept)
        {
            if ($config{debug})
            {
                print $config{name}, " recieved a connection:\n";
                print "\tPeerhost: ", $connection->peerhost, "\n";
                print "\tPeerport: ", $connection->peerport, "\n";
                print "\tLocalhost: ", $connection->sockhost, "\n";
                print "\tLocalport: ", $connection->sockport, "\n\n";
            }
            do
            {
                my $incoming = <$connection>;
                my $check = crypt($self->{name}, $config{name});
                if (substr($incoming, 0, length $check) ne $check)
                {
                    $connection->close;
                    last;
                }
                if ($self->{lock} > 1)
                {
                    $connection->close;
                    last;
                }
                redo if ($self->{lock} > 0);

                $self->{lock} = 1;
                last unless verify(\@{$self->{accept}}, \$connection);

                my $real_data = substr($incoming, length $check, lengt
+h($incoming) - length($check));
                if ($real_data ne "\bl\b")
                {
                    $self->{data} = $real_data;
                }
                else
                {
                    send_data($self, \$connection);
                }
                $self->{lock} = 0;
                $connection->close if $connection;
            }
        }
        $sock->close if defined $sock;
        exit 0;
    }
    bless ($self, $class);
}

sub send_data
{
    my ($self, $connection) = @_;
    my $address = eval{$$connection->peerhost};
    my $port = eval{$$connection->peerport};
    $$connection->close;
    my $sock;
    while()
    {
         $sock = IO::Socket::INET->new(
                                      Proto    => 'tcp',
                                       PeerAddr => $address,
                                       PeerPort => $port
                                      );
        eval{$sock->connected};
        last unless $@;
    }
    $sock->autoflush(1);

    if ($self->{debug})
    {
        print $self->{debug},  " is sending data...\n";
        print "\tPeerhost: ",  $sock->peerhost, "\n";
        print "\tPeerport: ",  $sock->peerport, "\n";
        print "\tLocalhost: ", $sock->sockhost, "\n";
        print "\tLocalport: ", $sock->sockport, "\n\n";
    }

    syswrite($sock, $self->{data}, length($self->{data}));
    $sock->close;

}

sub destroy_variable
{
    my $self = shift;
    kill (9, $self->{child});
    undef $self;
}

sub verify
{
    my ($accept_ref, $connection) = @_;
    my $check = 0;
    foreach my $accept (@$accept_ref)
    {
        $check = 1 if ($accept eq $$connection->peeraddr || $accept eq
+ $$connection->peerhost);
    }
    return $check;
}

sub cleanup
{
    my ($self, $error_value) = @_;
    $self->destroy_variable;
    return $error_value;
}

sub lock
{
    my ($self, $status) = @_;
    $$self->{lock} = $status;
}

sub port
{
    my $self = shift;
    return $self->{port};
}

sub DESTROY
{
    my $self = shift;
    $self->destroy_variable;
}


package Shared::Remote;
use IO::Socket;

sub new
{
    my ($proto, %config) = @_;
    my $class = ref($proto) || $proto;
    my $self  = {};
    $self->{name}    = crypt($config{name}, $config{name});
    $self->{ref}     = $config{ref};
    $self->{port}    = exists($config{port})    ? $config{port}    : 0
+;
    $self->{address} = exists($config{address}) ? $config{address} : '
+127.0.0.1';
    $self->{debug}   = exists($config{debug})   ? $config{name}    : 0
+;

    if ($config{debug})
    {
        print "Constructor for ", $config{name}, ":\n";
        print "\tType of class: ", $class, "\n";
        print "\tReferring to Variable: ", $config{ref}, "\n";
        print "\tAddress ", $config{address}, "\n";
        print "\tPort: ", $self->{port}, "\n";
        print "\n";
    }

    bless ($self, $class);
}

sub set_port
{
    my ($self, $port) = @_;
    $self->{port} = $port;
}

sub set_addr
{
    my ($self, $addr) = @_;
    $self->{addr} = $addr;
}

sub destroy_variable
{
    my $self = shift;
    undef $self;
}


package Shared::Retriever;
use IO::Socket;
use Storable qw(freeze thaw);
use Carp;

sub new
{
    my $proto = shift;
    my $class = ref($proto) || $proto;

    my $self       = {};
    $self->{vars}  = {};
    $self->{debug} = scalar @_ ? shift : 0;
    if ($self->{debug})
    {
        print "Constructor for Retriever.\n\n";
    }
    bless ($self, $class);
}

sub cleanup
{
    my ($self, $return_value) = @_;
    $self->destroy_all;
    return $return_value;
}

sub add
{
    my ($self, @vars) = @_;
    print "Adding Objects:\n" if ($self->{debug});
    foreach my $var (@vars)
    {
        $self->{vars}->{$$var->{name}.$$var->{ref}} = $var;
        print "\t", $$var->{debug}, " added.\n" if ($self->{debug});
    }
    print "\n" if ($self->{debug});
}

sub remove
{
    my ($self, @vars) = @_;
    foreach my $var (@vars)
    {
        my $temp = $$var->{name}.$$var->{ref};
        $$var->destroy_variable;
        delete $self->{vars}->{$temp};
    }
}

sub store
{
    my ($self, $var, $data) = @_;
    $var = $self->{vars}->{$var->{name}.$var->{ref}};
    my $address = exists($$var->{address}) ? $$var->{address} : '127.0
+.0.1';

    my $send = IO::Socket::INET->new
                                   (
                                     Proto    => 'tcp',
                                     PeerAddr => $address,
                                     PeerPort => $$var->{port}
                                   ) or croak ( $self->cleanup($!) );

    $send->autoflush(1);

    if ($$var->{debug})
    {
        print "Connected to ", $$var->{ref}, " for storing:\n";
        print "\tPeerhost: ",  $send->peerhost, "\n";
        print "\tPeerport: ",  $send->peerport, "\n";
        print "\tLocalhost: ", $send->sockhost, "\n";
        print "\tLocalport: ", $send->sockport, "\n\n";
    }

    my $header = crypt(crypt($$var->{ref},$$var->{ref}),$$var->{ref});
    my $serialized_data = freeze(\$data);
    $serialized_data = join('*',map(ord,split(//,$serialized_data)));
    my $bytes = syswrite($send, $header.$serialized_data, length($seri
+alized_data) + length($header));
    $send->close;
    return $bytes;
}

sub retrieve
{
    my ($self, $var) = @_;
    $var = $self->{vars}->{$var->{name}.$var->{ref}};

    my $address = exists($$var->{address}) ? $$var->{address} : '127.0
+.0.1';
    my $message = IO::Socket::INET->new
                                    (
                                     Proto     => 'tcp',
                                     PeerPort  => $$var->{port},
                                     PeerAddr  => $address
                                    ) or die ( $self->cleanup($!) );

    $message->sockopt (SO_REUSEADDR, 1);
    $message->sockopt (SO_LINGER, 0);

    $message->autoflush(1);
    my $port = $message->sockport;
    if ($$var->{debug})
    {
        print "Connected to ", $$var->{ref}, " for retrieving:\n";
        print "\tPeerhost: ",  $message->peerhost, "\n";
        print "\tPeerport: ",  $message->peerport, "\n";
        print "\tLocalhost: ", $message->sockhost, "\n";
        print "\tLocalport: ", $message->sockport, "\n\n";
    }

    my $header = crypt(crypt($$var->{ref},$$var->{ref}),$$var->{ref});
    syswrite($message, $header."\bl\b", 3+length($header));
    $message->close;
    $message = IO::Socket::INET->new
                                 (
                                  Listen    => SOMAXCONN,
                                  LocalPort => $port,
                                  Reuse     => 1,
                                  LocalAddr => '127.0.0.1',
                                 ) or croak ( $self->cleanup($!) );
    if ($$var->{debug})
    {
        print "Listening for ", $$var->{ref}, ":\n";
        print "\tLocalport: ",  $message->sockport, "\n\n";
    }

    while (my $connection = $message->accept)
    {

        if ($$var->{debug})
        {
            print "Recieved a connection from ", $$var->{ref}, ":\n";
            print "\tPeerhost: ",  $connection->peerhost, "\n";
            print "\tPeerport: ",  $connection->peerport, "\n";
            print "\tLocalhost: ", $connection->sockhost, "\n";
            print "\tLocalport: ", $connection->sockport, "\n\n";
        }

        my $sent = <$connection>;
        $connection->close if $connection;
        $sent = join('',map(chr,split(/\*/,$sent)));
        $sent = thaw($sent);
        $message->close;
        return $$sent;
    }
    $message->close if $message;
}

sub set_remote_port
{
    my ($self, $var, $port) = shift;
    $$var->set_port ($port);
}

sub set_remote_addr
{
    my ($self, $var, $addr) = shift;
    $$var->set_addr ($addr);
}

sub destroy_all
{
    my $self=shift;
    print "Destroying variables: \n" if $self->{debug};
    while ( my($key,$value) = each(%{$self->{vars}}) )
    {
        my $temp = $$value->{name}.$$value->{ref};
        my $temp1 = $$value->{debug} if $self->{debug};
        $$value->destroy_variable;
        delete $self->{vars}->{$temp};
        print "\t", $temp1, " destroyed.\n" if $self->{debug};
    }
    print "\n" if $self->{debug};
}

sub DESTROY
{
    my $self = shift;
    $self->destroy_all;
}

"JAPH";