I2P Address: [http://git.idk.i2p]

Skip to content
Snippets Groups Projects
Commit fc858bc9 authored by jrandom's avatar jrandom Committed by zzz
Browse files

replaced the old nonfunctional perl SAM lib with postman's new

implementation (thanks postman!)
parent dbb4b3d0
No related branches found
No related tags found
No related merge requests found
#!/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 POSIX;
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 readprocesswrite {
my $self = shift;
$self->readprocess();
$self->dowrite();
}
sub doread {
my $self = shift;
my $rv;
my $data;
$rv = $self->recv($data, $POSIX::BUFSIZE, 0);
if ( defined($rv) && ( length($data) >= 1 ) ) {
# We received some data. Put it in our buffer.
${*$self}->{inbuffer} += $data;
} else {
# No data. Either we're on a non-blocking socket, or there
# was an error or EOF
if ( $!{EAGAIN} ) {
return 1;
} else {
# I suppose caller can look at $! for details
return undef;
}
}
}
sub dowrite {
my $self = shift;
my $rv;
my $data;
$rv = $self->send(${*$self}->{outbuffer}, 0);
if ( ! defined($rv) ) {
warn "SAM::dowrite - Couldn't write for no apparent reason.\n";
return undef;
}
if ( $rv == length(${*$self}->{outbuffer}) || $!{EWOULDBLOCK} ) {
substr(${*$self}->{outbuffer},0, $rv) = ''; # Remove from buffer
# Nuke buffer if empty
delete ${*$self}->{outbuffer} unless length(${*$self}->{outbuffer});
} else {
# Socket closed on us or something?
return undef;
}
}
sub messages {
my $self = shift;
return @{ ${*$self}->{messages} };
}
sub queuemessage {
my $self = shift;
my $message = shift;
push @{ ${*$self}->{messages} } , $message;
}
sub unqueuemessage {
my $self = shift;
return unshift(@{ ${*$self}->{messages} } );
}
sub readprocess {
my $self = shift;
$self->doread();
$self->process();
}
sub process {
my $self = shift;
my %tvhash;
my $payload;
# Before we can read any new messages, if an existing message has payload
# we must read it in. Otherwise we'll create garbage messages containing
# the payload of previous messages.
if ( ${*$self}->{payloadrequired} >= 1 ) {
if ( length( ${*$self}->{inbuffer} ) >= ${*$self}->{payloadrequired} ) {
# Scarf payload from inbuffer into $payload
$payload = substr(${*$self}->{inbuffer}, 0,
${*$self}->{payloadrequired});
# Nuke payload from inbuffer
substr(${*$self}->{inbuffer}, 0,
${*$self}->{payloadrequired} ) = '';
# Put message with payload into spool
push @{ ${*$self}->{messages} } ,
${*$self}->{messagerequiringpayload}.$payload;
# Delete the saved message requiring payload
delete ${*$self}->{messagerequiringpayload};
} else {
# Insufficient payload in inbuffer. Try again later.
return 1;
}
}
if ( ${*$self}->{inbuffer} =~ s/(.*\n)// ) {
%tvhash = $self->_hashtv($1); # Returns a tag/value hash
if ( $tvhash{SIZE} ) {
# We've got a message with payload on our hands. :(
${*$self}->{payloadrequired} = $tvhash{SIZE};
${*$self}->{messagerequiringpayload} = $1;
return 1; # Could call ourself here, but we'll get called again.
} else {
push @{ ${*$self}->{messages} } , $1;
}
}
return 1;
}
# sub junk {
# 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 $tvstring = shift;
my $tvhash;
while ( $tvstring =~ m/(\S+)=(\S+)/sg ) {
$tvhash->{$1}=$2;
print "hashtv: $1=$2\n"
}
return $tvhash;
}
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;
#!/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;
#!/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;
#!/usr/bin/perl
1;
# BASIC Perl SAM Module
# created 2005 by postman (postman@i2pmail.org)
1. What does it do?
The SAM module is a little Perl add-on that - on one side -
establishes communication with a I2P router's (http://www.i2p.net) SAM bridge
(Simple anonymous messaging ( http://www.i2p.net/sam)). On the
other side it exposes a simple socket like interface to the user.
Over this interface the user can send or receive datastreams from I2P
destinations as if he would communicate with a normal IP socket.
The SAM module can be integrated into perl scripts that
want to communicate with I2P services.
2. Is this code usable?
This perl module should be considered as proof-of-concept
quality. It did surely work for me and my test setups, but
it might not work at all on your system. If you run into problems
you can contact me.
3. Does ist support DATAGRAM and RAW sessions?
No, at the moment the module only supports STREAM sessions.
Support for other session types might be added in the future.
4. How to install it?
Create a Subfolder called I2P in your Perl Installation's Net Module
folder (i.e. /usr/lib/perl5/5.8.4./Net/I2P ) and copy the module there.
You can now use it with use Net::I2P::SAM.
The module only depends on Net::IO::Socket for operations. This
should be already installed.
5. How to debug?
You can switch on debugging with the constructor ( see below ).
6. How to use it?
$sam = new Net::I2P::SAM('127.0.0.1','7656',1);
# you can omit host/port - then the defult is assumed
# the 3rd argument is the debugging switch. If you switched it on
# there'll be a default debug in /tmp/sam-debug
# $sam will now either contain a object reference or 0
# if it's 0 then we coudl not talk to the SAM bridge at all ( connect failed)
# or we could not agree to a version
# next we can tune the tunnel settings we want for this session:
# The syntax is just like the one used on www.i2p.net/sam
$sam->change_settings("inbound.length=1,inbound.lenghVariance=0,outbound.length=1,outbound.lengthVariance=0,inbound.nickname=fun,outbound.nickname=fun");
# next we open a new session.
# only stream is supported
# most of the time we use a transient destination
# otherwise state the hosts.txt name you want to use as in your session
# direction is most of the times both :)
# this cab return 1 for success or 0 for failure
$sam->create_session("STREAM","TRANSIENT","BOTH");
# now connect to our service
$sam->connect($sam->lookup("myservice.i2p"));
# or
$sam->connect("I2PDESTINATIONKEY.....AAAA");
# if this returns 1 - we got a stream session and can now receive and send data
# otherwise consult the debug.
# Send data is just like the the raw perl send
# we send the data as scalar var and optional flags (most of the times 0)
$sam->send($data,0);
# receiving data is similar to the perl recv
# we define the mac number of bytes and optional flags
$indata = $sam->receive(512,0);
# close the session
$sam->close();
# that's the most important things to know.
This diff is collapsed.
#!/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";
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment