From 6003b2902f1451cd334abe77b12b4695713bba7e Mon Sep 17 00:00:00 2001 From: brianr Date: Sun, 16 May 2004 21:35:46 +0000 Subject: [PATCH] Preliminary checkin of (mostly useless) Net::SAM perl module. Net::SAM::StreamSession is currently unimplemented. Net::Sam::[Datagram|Raw]Session block when they shouldn't and are buggy. --- apps/sam/perl/Net/SAM.pm | 189 +++++++++++++++++++++++ apps/sam/perl/Net/SAM/DatagramSession.pm | 48 ++++++ apps/sam/perl/Net/SAM/RawSession.pm | 45 ++++++ apps/sam/perl/Net/SAM/StreamSession.pm | 3 + apps/sam/perl/samcat.pl | 18 +++ 5 files changed, 303 insertions(+) create mode 100644 apps/sam/perl/Net/SAM.pm create mode 100644 apps/sam/perl/Net/SAM/DatagramSession.pm create mode 100644 apps/sam/perl/Net/SAM/RawSession.pm create mode 100644 apps/sam/perl/Net/SAM/StreamSession.pm create mode 100644 apps/sam/perl/samcat.pl diff --git a/apps/sam/perl/Net/SAM.pm b/apps/sam/perl/Net/SAM.pm new file mode 100644 index 000000000..3507e82cd --- /dev/null +++ b/apps/sam/perl/Net/SAM.pm @@ -0,0 +1,189 @@ +#!/usr/bin/perl + +## Copyright 2004 Brian Ristuccia. This program is Free Software; +## You can redistribute it and/or modify it under the same terms as +## Perl itself. + +package Net::SAM; + +@ISA = ( "IO::Socket::INET" ); + +use strict; + +use Switch; + +use IO::Socket; +use IO::Select; + +#use Net::SAM::StreamSession; +#use Net::SAM::DatagramSession; +#use Net::SAM::RawSession; + +sub new { + my ($class) = shift; + my $type = ref($class) || $class; + my $self = $type->SUPER::new("127.0.0.1:7656"); + + + ${*$self}->{incomingraw} = []; + + # Connect us to the local SAM proxy. + # my $samsock = IO::Socket::INET->new('127.0.0.1:7657'); + #$self->{samsock}=$samsock; + + # Say hello, read response. + $self->SUPER::send("HELLO VERSION MIN=1.0 MAX=1.0\n"); + + while (! ${*$self}->{greeted}) { + $self->readprocess(); + } + print "Created SAM object\n"; + return $self; +} + +sub lookup { + my $self = shift; + my $name= shift; + + $self->SUPER::send("NAMING LOOKUP NAME=$name\n"); + undef ${*$self}->{RESULT}; + while (! ${*$self}->{RESULT}) { + $self->readprocess(); + } + if ( ${*$self}->{RESULT} == "OK" ) { + return ${*$self}->{VALUE}; + } else { + return undef; + } +} + +#sub createsession { +# my ($self) = shift; +# my ($sesstype) = shift; +# print $self->{samsock} "SESSION CREATE STYLE=$SESSTYPE DESTINATION=$DEST, DIRECTION= +#} + +#sub waitfor { +# my ($self) = shift; +# my ($prefix) = shift; +# my ($response) = <$samsock>;# + + # if $response =~ + + +#} + +sub readprocess { + my $self = shift; + my $chunk; + my $payload; + + print "readprocess: " . $self->connected() . "\n"; + + # May block if the SAM bridge gets hosed + my $response = <$self>; + + print "readprocess: $!" . $self->connected() . "\n"; + + chomp $response; + my ($primative, $more, $extra) = split (' ', $response, 3); + + $primative = uc($primative); + + print "readprocess: " . $self->connected() . " -- $primative -- $more -- $extra\n"; + + switch ($primative) { + + case "HELLO" { + if ($more !~ m/REPLY/ ) { die ("Bogus HELLO response") } + if ($extra =~ m/NOVERSION/ ) { + die("SAM Bridge Doesn't support my version") ; + } + $self->_hashtv($extra); + ${*$self}->{greeted} = 1; + }; + case "SESSION" { + if ( $more !~ m/STATUS/ ) { + die("Bogus SESSION response"); + } + $self->_hashtv($extra); + } + case "STREAM" {}; + case "DATAGRAM" { + if ( $more !~ m/RECEIVE/ ) { + die("Bogus DATAGRAM response."); + } + $self->_hashtv($extra); + push @{ ${*$self}->{incomingdatagram } }, + [ ${*$self}->{DESTINATION}, + $self->_readblock(${*$self}->{SIZE}) ]; + + }; + case "RAW" { + if ( $more !~ m/RECEIVE/ ) { + die("Bogus RAW response."); + } + $self->_hashtv($extra); + + push @{ $self->{incomingraw} }, $self->_readblock($self->{SIZE}); + }; + case "NAMING" { + if ( $more !~ m/REPLY/ ) { + die("Bogus NAMING response"); + } + $self->_hashtv($extra); + }; + case "DEST" {}; + } + return 1; +} + +sub getfh { + # Return the FH of the SAM socket so apps can select() or poll() on it + my $self = shift; + return $self->{samsock}; +} + +sub _readblock { + my $self = shift; + my $size = shift; + my $chunk; + my $payload; + + while ( $size > 1 ) { + # XXX: May block. No error checking. + print "readblock: $size\n"; + $size -= $self->SUPER::recv($chunk, $size); + $payload .= $chunk; + } + return $payload; +} + +sub _hashtv { + my $self = shift; + my $extra = shift; + + while ( $extra=~ m/(\S+)=(\S+)/sg ) { + ${*$self}->{$1}=$2; + print "$1=$2\n" + } +} + +sub DESTROY { + # Do nothing yet. +} + +#sub StreamSession { +# my $self = shift; +# return Net::SAM::StreamSession->new($self); +#} + +#sub DatagramSession { +# return Net::SAM::DatagramSession->new($self); +#} + +#sub RawSession { +# return Net::SAM::RawSession->new($self); +#} + +1; diff --git a/apps/sam/perl/Net/SAM/DatagramSession.pm b/apps/sam/perl/Net/SAM/DatagramSession.pm new file mode 100644 index 000000000..ba583d0fc --- /dev/null +++ b/apps/sam/perl/Net/SAM/DatagramSession.pm @@ -0,0 +1,48 @@ +#!/usr/bin/perl + +package Net::SAM::DatagramSession; + +use Net::SAM; + +@ISA = ("Net::SAM"); + +sub new { + my ($class) = shift; + my ($dest , $direction, $options) = shift; + + my $self = $class->SUPER::new(@_); + + $self->SUPER::send("SESSION CREATE STYLE=DATAGRAM DESTINATION=$dest DIRECTION=$direction $options\n"); + + undef ${*$self}->{RESULT}; + + while ( ! ${*$self}->{RESULT} ) { + $self->readprocess() || return undef; + + } + + if ( ${*$self}->{RESULT} == "OK" ) { + return $self; + } else { + return undef; # sorry. + } +} + +sub send { + my $self = shift; + my $destination = shift; + my $message = shift; + my $size = length($message); + $self->SUPER::send("DATAGRAM SEND DESTINATION=$destination SIZE=$size\n$message"); +} + +sub receive { + my $self = shift; + + # Shift one off the fifo array. Returns undef if none wait. + return shift @{ $self->{incomingdatagram} }; +} + + + +1; diff --git a/apps/sam/perl/Net/SAM/RawSession.pm b/apps/sam/perl/Net/SAM/RawSession.pm new file mode 100644 index 000000000..971d405df --- /dev/null +++ b/apps/sam/perl/Net/SAM/RawSession.pm @@ -0,0 +1,45 @@ +#!/usr/bin/perl + +package Net::SAM::RawSession; + +use Net::SAM; + +@ISA = ("Net::SAM"); + +sub new { + my ($class) = shift; + my ($dest , $direction, $options) = shift; + + my $self = $class->SUPER::new(@_); + + $self->send("SESSION CREATE STYLE=RAW DESTINATION=$dest DIRECTION=$direction $options\n"); + + undef $self->{result}; + while ( ! $self->{RESULT} ) { + $self->readprocess(); + } + + if ( $self->{RESULT} == "OK" ) { + return $self; + } else { + return 0; # sorry. + } +} + +sub send { + my $self = shift; + my $destination = shift; + my $message = shift; + my $samsock = $self->{samsock}; + my $size = length($message); + print $samsock "RAW SEND DESTINATION=$destination SIZE=$size\n$message"; +} + +sub receive { + my $self = shift; + + # Shift one off the fifo array. Returns undef if none wait. + return shift @{ $self->{incomingraw} }; +} + +1; diff --git a/apps/sam/perl/Net/SAM/StreamSession.pm b/apps/sam/perl/Net/SAM/StreamSession.pm new file mode 100644 index 000000000..562ec880d --- /dev/null +++ b/apps/sam/perl/Net/SAM/StreamSession.pm @@ -0,0 +1,3 @@ +#!/usr/bin/perl + +1; diff --git a/apps/sam/perl/samcat.pl b/apps/sam/perl/samcat.pl new file mode 100644 index 000000000..f5b51362e --- /dev/null +++ b/apps/sam/perl/samcat.pl @@ -0,0 +1,18 @@ +#!/usr/bin/perl + +use Net::SAM::RawSession; +use Net::SAM::DatagramSession; + +$sam=Net::SAM::DatagramSession->new($ARGV[0], "BOTH", "tunnels.depthInbound=0"); +print "Connected? " . $sam->connected() . "\n"; + +$me = $sam->lookup("ME"); +print "Sending to $me.\n"; +$sam->send($me,"fooquux"); + +$sam->readprocess(); +($source, $message) = @{ $sam->receive() }; +print "$source -- $message"; + + +